Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
SourceIMP/utilities/RocfracPrep/RocfracPrep.f90
Go to the documentation of this file.
1 !*********************************************************************
2 !* Illinois Open Source License *
3 !* *
4 !* University of Illinois/NCSA *
5 !* Open Source License *
6 !* *
7 !* Copyright@2008, University of Illinois. All rights reserved. *
8 !* *
9 !* Developed by: *
10 !* *
11 !* Center for Simulation of Advanced Rockets *
12 !* *
13 !* University of Illinois *
14 !* *
15 !* www.csar.uiuc.edu *
16 !* *
17 !* Permission is hereby granted, free of charge, to any person *
18 !* obtaining a copy of this software and associated documentation *
19 !* files (the "Software"), to deal with the Software without *
20 !* restriction, including without limitation the rights to use, *
21 !* copy, modify, merge, publish, distribute, sublicense, and/or *
22 !* sell copies of the Software, and to permit persons to whom the *
23 !* Software is furnished to do so, subject to the following *
24 !* conditions: *
25 !* *
26 !* *
27 !* @ Redistributions of source code must retain the above copyright *
28 !* notice, this list of conditions and the following disclaimers. *
29 !* *
30 !* @ Redistributions in binary form must reproduce the above *
31 !* copyright notice, this list of conditions and the following *
32 !* disclaimers in the documentation and/or other materials *
33 !* provided with the distribution. *
34 !* *
35 !* @ Neither the names of the Center for Simulation of Advanced *
36 !* Rockets, the University of Illinois, nor the names of its *
37 !* contributors may be used to endorse or promote products derived *
38 !* from this Software without specific prior written permission. *
39 !* *
40 !* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, *
41 !* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES *
42 !* OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *
43 !* NONINFRINGEMENT. IN NO EVENT SHALL THE CONTRIBUTORS OR *
44 !* COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *
45 !* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, *
46 !* ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE *
47 !* USE OR OTHER DEALINGS WITH THE SOFTWARE. *
48 !*********************************************************************
49 !* Please acknowledge The University of Illinois Center for *
50 !* Simulation of Advanced Rockets in works and publications *
51 !* resulting from this software or its derivatives. *
52 !*********************************************************************
53 PROGRAM rocfracprep
54 
55  USE commglobal
56  USE meshdata
57  USE linked_list2
58  USE linked_list
59 
60  IMPLICIT NONE
61 
62  include 'roccomf90.h'
63 
64 ! Type definition
65 
66  TYPE nodebc
67  INTEGER :: node,bc
68  END TYPE nodebc
69 
70  TYPE nodebc_lst
71  INTEGER :: node_lst,bc_lst
72  END TYPE nodebc_lst
73 
74  TYPE sndrcv_buf
75  INTEGER :: sndn,rcvn,nodes
76  END TYPE sndrcv_buf
77 
78  TYPE(sndrcv_buf), ALLOCATABLE, DIMENSION(:) :: sndrcvnod
79  TYPE(sndrcv_buf), ALLOCATABLE, DIMENSION(:) :: sndrcvnod_lst
80 
81 !-- number of nodes for triangle
82  INTEGER :: numvertx2d
83 !-- dummy variables
84  INTEGER :: i,ii,j,jj,k,kk
85  INTEGER :: iaux,iaux1,iaux2,iaux3,n,mm
86  REAL*8 :: aux
87  INTEGER :: ntime
88 
89  INTEGER :: nk
90 !-- Stores the material number associated with lst
91  INTEGER, ALLOCATABLE, DIMENSION(:) :: iaux89
92 !-- Stores the cohesive material number associated with cohesive
93  INTEGER :: flag
94 
95  INTEGER :: numbcss
96  INTEGER :: indx,jndx
97  INTEGER :: edgecut,nn,nprocs,iunit
98  CHARACTER*3 :: ai4
99  CHARACTER*4 :: ichr4,ai1
100  INTEGER :: i1,i2,i3
101  INTEGER :: NumNeighProcs
102 
103 
104  INTEGER, ALLOCATABLE, DIMENSION(:) :: ncoor
105 
106 !-- Element Neighbor array from triangle
107  INTEGER, ALLOCATABLE, DIMENSION(:,:) :: lmtri_2d
108 !-- Connectivity array (OUTPUT) for cohesive elements
109 !----- dimension: <1> 6 nodes <2> local element id <3> processor
110  INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: lmcoh
111 !-- Tempory holding array of cohesive and no-cohesive (input to METIS)
112  INTEGER, ALLOCATABLE, DIMENSION(:) :: elmnts
113 !-- Tempory holding array of partitioned 'elmnts' array
114  INTEGER, ALLOCATABLE, DIMENSION(:) :: epart_p
115 !-- Number of nodal points & elements on each processor
116  INTEGER, ALLOCATABLE, DIMENSION(:) :: numnp
117  INTEGER, ALLOCATABLE, DIMENSION(:,:) :: numel
118 !-- Number of cohesive elements on each processor
119  INTEGER, ALLOCATABLE, DIMENSION(:) :: numclst
120 !-- For the lst: relates the old node numbering to the new nodes
121 
122  INTEGER, ALLOCATABLE, DIMENSION(:,:) :: jk1
123 !-- Number of nodal b.c. for each processor
124  INTEGER, ALLOCATABLE, DIMENSION(:) :: numbc
125 !-- Number of nodal mesh motionb.c. for each processor
126  INTEGER, ALLOCATABLE, DIMENSION(:) :: numbc_mm
127 !-- Number of nodal mesh motionb.c. for each processor
128  INTEGER, ALLOCATABLE, DIMENSION(:) :: numbc_ht
129 !-- Number of cohesive elements on processor boundary for each processor
130  INTEGER, ALLOCATABLE, DIMENSION(:) :: num_border_coh
131 !-- Number of neighboring processors for R_co
132  INTEGER, ALLOCATABLE, DIMENSION(:) :: nproc_neigh
133 !-- Number of neighboring processors for R_in
134  INTEGER, ALLOCATABLE, DIMENSION(:) :: nproc_neigh_lst
135 !-- Number of neighboring processors for R_co on No/cohesive boundary
136  INTEGER, ALLOCATABLE, DIMENSION(:) :: nproc_neigh_rco
137 !-- Stores the neighboring processors that I'm communcating with.
138  INTEGER, ALLOCATABLE, DIMENSION(:) :: my_neigh
139 !-- Stores if node is on the processor boundary
140  INTEGER, ALLOCATABLE, DIMENSION(:) :: bord_node_org
141 !--
142  INTEGER :: err
143  INTEGER, ALLOCATABLE, DIMENSION(:) :: matclst,lmtemp
144  INTEGER, ALLOCATABLE, DIMENSION(:,:) :: nnntemp_lst
145  INTEGER, ALLOCATABLE, DIMENSION(:,:) :: nnntemp_rco
146 
147  TYPE proclist
148  INTEGER, DIMENSION(:), POINTER :: proc_list
149  END TYPE proclist
150  TYPE proclistrco
151  INTEGER, DIMENSION(:), POINTER :: proc_list_rco
152  END TYPE proclistrco
153 !-- wave properties and stability varibles
154  REAL*8 :: xx,yy,zz,size1,size2,size3,size4,size5,size6
155  REAL*8 :: dhmin,dt_courant
156  REAL*8 :: dh_courant,cd_courant
157  INTEGER :: maxdim
158 !-
159 
160  INTEGER :: numnp_total,nface
161 
162  INTEGER, ALLOCATABLE,DIMENSION(:,:) :: NumNp2D
163  INTEGER, ALLOCATABLE,DIMENSION(:,:,:) :: jk1_2D
164  INTEGER, ALLOCATABLE,DIMENSION(:,:,:) :: ik1_2D
165 
166  CHARACTER*3 :: ai3
167  CHARACTER*1 ichr1
168  CHARACTER*12 ichr12
169  INTEGER :: num_zones,numcoh_zone,numelv_prmry_zone
170  INTEGER, ALLOCATABLE, DIMENSION(:) :: numelv_prmry_zones, ik1_z
171  INTEGER, ALLOCATABLE, DIMENSION(:) :: MapGlbEl2LocEl
172 
173  INTEGER :: numel_z,numnp_z,p2max_lst,num_rco_border,ip,icount
174 
175  INTEGER iaux23
176  INTEGER :: num_vol,num_coh
177  INTEGER :: iflag
178  INTEGER, DIMENSION(1:4) :: iflag89
179  INTEGER :: ntri
180  INTEGER :: ios
181  INTEGER :: jk1_size
182 
183  TYPE(coh_info_type), POINTER :: coh_item
184  TYPE(coh_list_type), TARGET, ALLOCATABLE, DIMENSION(:) :: coh_list
185  TYPE(coh_comm_info_type), POINTER :: coh_comm_item
186  TYPE(coh_comm_list_type), TARGET, ALLOCATABLE, DIMENSION(:,:) :: coh_comm_list
187  TYPE(vol_info_type), POINTER :: vol_item
188  TYPE(vol_list_type), TARGET, ALLOCATABLE, DIMENSION(:) :: vol_list
189  TYPE(vol_box_point), ALLOCATABLE, DIMENSION(:) :: ik1_c4
190 
191  INTEGER ni,node1,node2,node3,node4,gnode1,gnode2,gnode3,gnode4
192 
193  TYPE(bcvalues), DIMENSION(16) :: bc_mshmtn
194 
195 
196  INTEGER :: numploadelem
197  INTEGER, ALLOCATABLE, DIMENSION(:,:) :: idpressload
198  INTEGER, ALLOCATABLE, DIMENSION(:) :: ipressflag
199  REAL*8, ALLOCATABLE, DIMENSION(:,:) :: pressload
200 
201  LOGICAL :: ElOnPartBndry
202 
203  INTEGER, ALLOCATABLE, DIMENSION(:,:) :: icnt
204  INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NumBorderVol
205 
206  INTEGER :: myid
207  REAL*8 :: shift
208  INTEGER :: iargc
209  CHARACTER*3 chr_arg
210  CHARACTER*4 chr_procs
211  CHARACTER*20 chr_units
212 
213  INTEGER :: imat, itmp1, itmp2
214  INTEGER, POINTER :: tmpptr
215 
216  INTEGER, DIMENSION(1:10) :: NdHistoryFlag
217  INTEGER, ALLOCATABLE, DIMENSION(:) :: NumNdHistoryP
218  INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NdHistoryP
219  INTEGER :: GlbNd
220  INTEGER :: ielem, ElemCount
221 
222  TYPE(link_ptr_type) :: Link
223 
224  TYPE(procelemlist_data_ptr), POINTER :: ptr2
225  TYPE(bc_ptr), POINTER :: ptr_BC
226 
227  CHARACTER(*), PARAMETER :: volWin = "vfrac"
228 
229  REAL*8, POINTER, DIMENSION(:,:) :: MeshCoor
230 
231  INTEGER :: MaxNumNodesComm, icounter
232 
233  INTEGER :: write_attr, set_option, vol_all, errFlg, comp_pconn
234 
235  INTEGER :: IMP_val
236 
237  convertunit = 1.d0
238 
239  n = iargc()
240  IF(n.LE.1) goto 554
241 
242  j = 1
243  DO i = 1, n/2
244  CALL getarg( j, chr_arg)
245  IF(chr_arg.EQ.'-np')THEN
246  CALL getarg( j+1, chr_procs)
247  READ(chr_procs,*) nprocs
248  j = j +2
249  ELSE IF(chr_arg.EQ.'-un')THEN ! units
250  CALL getarg( j+1, chr_units)
251  READ(chr_units,*) convertunit
252  j = j + 2
253  print*,'UNITS CONVERSION'
254  print*,' multiply by ', convertunit
255 
256  ELSE
257  goto 554
258  ENDIF
259  ENDDO
260 
261  goto 555
262 
263 554 CONTINUE
264  print*,'Usage:'
265  print*,' MeshTran -np #'
266  print*,' - where # is the number of processors'
267  stop
268 
269 555 CONTINUE
270 
271  myid = 0
272 
273  CALL readinp(ntime)
274 
275  print*,'numvertx=',numvertx
276 
277  ! CALL system('\rm -f -r '//prefx(1:prefx_lngth))
278 
279 
280 ! -- mesh motion boundary conditions
281 
282 
283  dhmin = 1000000000.d0
284 
285  IF(iansys.EQ.1)THEN
286  print*,'ANSYS NO LONGER SUPPORTED'
287  print*,'STOPPING'
288  stop
289 ! CALL read_ansys(numbcss, dhmin)
290  ELSE IF(ipatran.EQ.1)THEN
291  CALL read_patran(numvertx2d,dhmin,nprocs)
292  numbcss = numnp_prmry
293 !$$$ ELSE IF(ipatcohin.EQ.1)THEN
294 !$$$ CALL read_patran_cohin(numbcss,numvertx2d,dhmin,nprocs)
295 !$$$ ELSE IF(itetcohin.EQ.1)THEN
296 !$$$ CALL read_tetmesh_cohin(numbcss,numvertx2d,dhmin,nprocs)
297 !$$$ numbcss = numnp_prmry
298 !$$$ ELSE IF(itetmesh.EQ.1)THEN
299 !NOTE:
300 !IF both ascii and binary temesh input files exist,then
301 ! the binary file will be the one that gets read.
302 !$$$ CALL read_tetmesh(numbcss,numvertx2d,dhmin,nprocs)
303 !$$$ numbcss = numnp_prmry
304  ENDIF
305 !
306 ! -- Checking Courant condition for time step
307 !
308  dt_courant = dhmin/cd_fastest
309  cd_courant = cd_fastest
310  dh_courant = dhmin
311 
312  print*,' --------------------------------------'
313  print*,' ---- COURANT STABILITY CONDITION -----'
314  print*,' --------------------------------------'
315  print*,' dt_courant =',dt_courant
316  print*,' cd_courant =',cd_courant
317  print*,' h_courant =',dh_courant
318  print*,' --------------------------------------'
319 
320  iaux = 1
321  print*,'Allocate(numel)'
322  ALLOCATE(numel(1:nummat,1:nprocs))
323 
324  print*,'Allocate(numel).finish'
325  numel(:,:) = 0
326 
327  DO n = 1, numelv_prmry ! Loop over the tetrahedra elements
328  imat = matid(n)
329  numel(imat,epart(n)) = numel(imat,epart(n)) + 1
330  ENDDO
331 
332  ALLOCATE(numnp(1:nprocs))
333 
334  ii = 0
335 
336  numnp(1:nprocs) = 0
337  numel(1:nummat,1:nprocs) = 0
338  ALLOCATE(vol_item)
339  ALLOCATE(vol_list(1:nummat))
340 
341 
342 !
343 ! -- RENUMBER THE VOLUMETRIC ELEMENTS USING LOCAL NUMBERING
344  print*,'RENUMBERING VOLUMETRIC ELEMENTS'
345 
346 ! allocate(MapGlbEl2LocEl(1:numelv_prmry))
347 ! allocate(icnt(1:NumMat,1:2))
348 ! icnt(:,:) = 0
349 ! allocate(ElOnPartBndry(1:numelv_prmry))
350 
351  ALLOCATE(procnodelist(1:nprocs))
352 
353  DO i = 1, nprocs
354  CALL li_init_list(procnodelist(i))
355  ENDDO
356 
357  ALLOCATE(nodeflag(1:numnp_prmry))
358  ALLOCATE(elflag(1:numelv_prmry))
359 
360 !
361 ! Write each processor's input file
362 !
363  ALLOCATE(nproc_neigh_lst(1:nprocs)) ! does not need to keep track of processors
364  nproc_neigh_lst(:) = 0
365 
366 
367 
368  CALL com_init
369 
370 ! - load Rocout module
371  CALL com_set_verbose( 10)
372  CALL rocout_load_module( 'OUT')
373 
374 ! Surface boundary meshes
375 
376 !!$ OPEN(4001,FILE=prefx(1:prefx_lngth)//'/fracSF.im',STATUS='replace',FORM='formatted')
377 !!$ OPEN(4002,FILE=prefx(1:prefx_lngth)//'/fracS.im',STATUS='replace',FORM='formatted')
378 !!$
379 !!$ WRITE(4001,*) nprocs,MeshType2D
380 !!$ WRITE(4002,*) nprocs,MeshType2D
381 
382 
383  OPEN(4005,file='Rocin/isolid_in_00.000000.txt',status='replace',form='formatted')
384  WRITE(4005,*) '@Proc: *'
385  WRITE(4005,*) '@Files: Rocfrac/Rocin/SurfMesh.%4p.hdf'
386  WRITE(4005,*) '@Panes: @BlockCyclic 100 100'
387  close(4005)
388 
389  OPEN(4005,file='Rocin/solid_in_00.000000.txt',status='replace',form='formatted')
390  WRITE(4005,*) '@Proc: *'
391  WRITE(4005,*) '@Files: Rocfrac/Rocin/'//prefx(1:prefx_lngth)//'.%4p.hdf'
392  WRITE(4005,*) '@Panes: @Cyclic 1'
393  close(4005)
394 
395 
396 
397 
398 ! -------------------------------------
399 ! MAIN LOOP OVER PROCESSORS
400 ! ------------------------------------------------
401 
402  DO ip = 1, nprocs
403 
404  CALL com_new_window( volwin )
405 
406 ! -- Initialize link list variables
407 
408  vol_list(1:nummat)%num_border_vol = 0
409  DO i = 1, nummat
410  nullify(vol_list(i)%vol_head)
411  nullify(vol_list(i)%vol_tail)
412  ENDDO
413 
414  print*,'Processor id =',ip
415 
416  WRITE(ichr4,'(i4.4)') ip - 1
417 
418 
419 ! --------------------------
420 ! Nodes
421 !-----------------------------------
422 
423 ! Renumber nodes locally, keep track of which node already renumbered
424  nodeflag(:) = 0
425  elflag(:) = 0
426 
427 ! go through the Processor's element link list
428 
429 
430  ptr2 => procelemlist(ip)%head
431 
432 
433  iaux = 0
434 
435  DO WHILE(ASSOCIATED(ptr2))
436 
437  ielem = ptr2%GlbElNum
438  imat = matid(ielem)
439  numel(imat,ip) = numel(imat,ip) + 1
440  elonpartbndry = .false.
441  DO k = 1, eltypeid(ielem)
442  nk = lmelv_prmry(k,ielem)
443 
444  IF(numprocpernd(nk).GT.1) elonpartbndry =.true.
445 
446  IF(nodeflag(nk).EQ.0)THEN
447  numnp(ip) = numnp(ip) + 1
448  iaux = iaux + 1
449  nodeflag(nk) = numnp(ip)
450  ENDIF
451 
452  vol_item%mat_vol = imat
453  vol_item%lmvol(k) = nodeflag(nk)
454 
455  ENDDO
456 
457 
458  ptr2 => ptr2%next
459 
460  vol_item%iface = 0
461  vol_item%press = ielem ! 0.d0
462 
463 ! Add item to volumetric element list
464 !
465 
466  IF(elonpartbndry)THEN ! Element contains a node that is on the partition boundary
467  CALL vol_insert_head(vol_list(imat),vol_item)
468 ! icnt(imat,1) = icnt(imat,1) + 1
469 ! ElFlag(ielem) = icnt(imat,1)
470 ! MapGlbEl2LocEl(ip) = icnt(imat,1)
471  ELSE
472  CALL vol_insert_tail(vol_list(imat),vol_item)
473 ! icnt(imat,2) = icnt(imat,2) + 1
474 ! ElFlag(ielem) = icnt(imat,2)
475 ! MapGlbEl2LocEl(ip) = icnt(imat,2)
476  ENDIF
477 
478  ENDDO
479 
480 
481  ALLOCATE(meshcoor(1:3,1:numnp(ip))) !**
482 
483  DO i = 1, numnp_prmry
484  IF(nodeflag(i).NE.0) then
485  meshcoor(1:3,nodeflag(i)) = coor(1:3,i)
486 
487  endif
488  END DO
489 
490  CALL com_new_attribute( volwin//'.nc', 'n', com_double, 3, 'm')
491  CALL com_set_size( volwin//'.nc', ip, numndperproc(ip) )
492  CALL com_set_array(volwin//'.nc', ip, meshcoor, 3)
493 
494 
495  print*,'registered Coordinates'
496 
497  IF(iaux.NE.numndperproc(ip))THEN
498  print*,'Test failed when renumbering'
499  print*,'iaux=',iaux
500  print*,'NumNdPerProc',numndperproc(ip)
501  stop
502  ENDIF
503 
504 ! BOUNDARY CONDITIONS
505 ! 10000*MeshMotionBC + 100*ThermalBC + StructuralBC
506 
507  print*,'Boundary Conditions'
508 
509  IF(numbc_flag(ip).NE.0)THEN
510 
511  ALLOCATE( nodeflag_str(1:2,1:numbc_flag(ip)) )
512 
513 
514  iaux = 0
515 
516  DO i = 1, numnp_prmry
517  IF(nodeflag(i).NE.0.AND.bc_flag(1,i).NE.0)THEN
518  iaux = iaux + 1
519  nodeflag_str(1,iaux) = nodeflag(i)
520  nodeflag_str(2,iaux) = bc_flag(1,i)
521  ENDIF
522  IF(nodeflag(i).NE.0.AND.bc_flag(2,i).NE.0)THEN
523  iaux = iaux + 1
524  nodeflag_str(1,iaux) = nodeflag(i)
525  nodeflag_str(2,iaux) = bc_flag(2,i)
526  ENDIF
527  IF(nodeflag(i).NE.0.AND.bc_flag(3,i).NE.0)THEN
528  iaux = iaux + 1
529  nodeflag_str(1,iaux) = nodeflag(i)
530  nodeflag_str(2,iaux) = bc_flag(3,i)
531  ENDIF
532  enddo
533 
534  IF(iaux.NE.numbc_flag(ip))THEN
535  print*,'ERROR, number of BCs in partitioned mesh',iaux
536  print*,' inconsistant with that of serial mesh',numbc_flag(ip)
537  print*, 'stopping'
538  stop
539  ENDIF
540 
541  CALL com_new_attribute( volwin//'.bcnode', 'p', com_integer, 2, '')
542  CALL com_set_size( volwin//'.bcnode', ip, numbc_flag(ip) )
543  CALL com_set_array(volwin//'.bcnode', ip, nodeflag_str, 2)
544 
545 
546  allocate(bcvalue(1:numbc_flag(ip)*6))
547  bcvalue(:) = 0.d0
548  CALL com_new_attribute( volwin//'.BCValue', 'p', com_double, 1, '')
549  CALL com_set_size( volwin//'.BCValue', ip,numbc_flag(ip)*6 )
550  CALL com_set_array(volwin//'.BCValue', ip, bcvalue, 1)
551  ENDIF
552 
553 !!$ CALL COM_new_attribute( volWin//'.NumBC_str', 'p', COM_INTEGER, 1, '')
554 !!$ CALL COM_set_size( volWin//'.NumBC_str', ip, 1 )
555 !!$ CALL COM_set_array(volWin//'.NumBC_str', ip, NumBC_structural(ip), 1)
556 !!$
557 !!$ CALL COM_new_attribute( volWin//'.NumBC_mm', 'p', COM_INTEGER, 1, '')
558 !!$ CALL COM_set_size( volWin//'.NumBC_mm', ip, 1 )
559 !!$ CALL COM_set_array(volWin//'.NumBC_mm', ip, NumBC_meshmotion(ip), 1)
560 !!$
561 !!$ CALL COM_new_attribute( volWin//'.NumBC_th', 'p', COM_INTEGER, 1, '')
562 !!$ CALL COM_set_size( volWin//'.NumBC_th', ip, 1 )
563 !!$ CALL COM_set_array(volWin//'.NumBC_th', ip, NumBC_thermal(ip), 1)
564 
565 !!$! ------------------------------
566 !!$!
567 !!$! STRUCTURAL BOUNDARY CONDITIONS
568 !!$! --------------------------------------------
569 !!$
570 !!$! WRITE(4000,*) 3
571 !!$! WRITE(4000,*) NumBC_structural(ip),0
572 !!$
573 !!$ IF(NumBC_structural(ip).NE.0)THEN
574 !!$
575 !!$
576 !!$ ALLOCATE( NodeFlag_str(1:2,1:NumBC_structural(ip)) )
577 !!$
578 !!$ ptr_BC => BC_structural_head
579 !!$ iaux = 0
580 !!$ DO WHILE(ASSOCIATED(ptr_BC))
581 !!$
582 !!$ GlbNd = ptr_BC%BC_nodeGlb
583 !!$ iflag = ptr_BC%BC_flagGlb
584 !!$ IF(NodeFlag(GlbNd).NE.0)THEN
585 !!$ iaux = iaux + 1
586 !!$ NodeFlag_str(1,iaux) = NodeFlag(GlbNd)
587 !!$ NodeFlag_str(2,iaux) = iflag
588 !!$ ENDIF
589 !!$ ptr_BC => ptr_BC%next
590 !!$ ENDDO
591 !!$
592 !!$ IF(iaux.NE.NumBC_structural(ip))THEN
593 !!$ PRINT*,'ERROR, number of structural BCs in linked list'
594 !!$ PRINT*,' inconsistant with that of serierial mesh'
595 !!$ PRINT*, 'stopping'
596 !!$ ENDIF
597 !!$
598 !!$ CALL COM_new_attribute( volWin//'.NodeFlag_str', 'p', COM_INTEGER, 2, '')
599 !!$ CALL COM_set_size( volWin//'.NodeFlag_str', ip, NumBC_structural(ip) )
600 !!$ CALL COM_set_array(volWin//'.NodeFlag_str', ip, NodeFlag_str, 2)
601 !!$ ENDIF
602 !!$
603 !!$
604 !!$! ------------------------------
605 !!$!
606 !!$! MESH MOTION BOUNDARY CONDITIONS
607 !!$! --------------------------------------------
608 !!$
609 !!$! WRITE(4000,*) 4
610 !!$! WRITE(4000,*) NumBC_meshmotion(ip),0
611 !!$
612 !!$ IF(NumBC_meshmotion(ip).NE.0)THEN
613 !!$
614 !!$ ALLOCATE( NodeFlag_mm(1:2,1:NumBC_meshmotion(ip)) )
615 !!$
616 !!$
617 !!$ ptr_BC => BC_meshmotion_head
618 !!$ iaux = 0
619 !!$ DO WHILE(ASSOCIATED(ptr_BC))
620 !!$
621 !!$ GlbNd = ptr_BC%BC_nodeGlb
622 !!$ iflag = ptr_BC%BC_flagGlb
623 !!$ IF(NodeFlag(GlbNd).NE.0)THEN
624 !!$ iaux = iaux + 1
625 !!$ NodeFlag_mm(1,iaux) = NodeFlag(GlbNd)
626 !!$ NodeFlag_mm(2,iaux) = iflag
627 !!$ ENDIF
628 !!$ ptr_BC => ptr_BC%next
629 !!$ ENDDO
630 !!$
631 !!$ IF(iaux.NE.NumBC_meshmotion(ip))THEN
632 !!$ PRINT*,'ERROR, number of mesh motion BCs in linked list'
633 !!$ PRINT*,' inconsistant with that of serierial mesh'
634 !!$ PRINT*, 'stopping'
635 !!$ ENDIF
636 !!$
637 !!$ CALL COM_new_attribute( volWin//'.NodeFlag_mm', 'p', COM_INTEGER, 2, '')
638 !!$ CALL COM_set_size( volWin//'.NodeFlag_mm', ip, NumBC_meshmotion(ip) )
639 !!$ CALL COM_set_array(volWin//'.NodeFlag_mm', ip, NodeFlag_mm, 2)
640 !!$
641 !!$ ENDIF
642 !!$
643 !!$! ------------------------------
644 !!$!
645 !!$! THERMAL BOUNDARY CONDITIONS
646 !!$! --------------------------------------------
647 !!$
648 !!$! WRITE(4000,*) 8
649 !!$! WRITE(4000,*) NumBC_thermal(ip),0
650 !!$
651 !!$ IF(NumBC_thermal(ip).NE.0)THEN
652 !!$
653 !!$ ALLOCATE( NodeFlag_th(1:2, 1:NumBC_thermal(ip) ) )
654 !!$
655 !!$ ptr_BC => BC_thermal_head
656 !!$ iaux = 0
657 !!$ DO WHILE(ASSOCIATED(ptr_BC))
658 !!$
659 !!$ GlbNd = ptr_BC%BC_nodeGlb
660 !!$ iflag = ptr_BC%BC_flagGlb
661 !!$ IF(NodeFlag(GlbNd).NE.0)THEN
662 !!$ iaux = iaux + 1
663 !!$ NodeFlag_th(1,iaux) = NodeFlag(GlbNd)
664 !!$ NodeFlag_th(2,iaux) = iflag
665 !!$ ENDIF
666 !!$ ptr_BC => ptr_BC%next
667 !!$ ENDDO
668 !!$
669 !!$ IF(iaux.NE.NumBC_thermal(ip))THEN
670 !!$ PRINT*,'ERROR, number of thermal BCs in linked list'
671 !!$ PRINT*,' inconsistant with that of serierial mesh'
672 !!$ PRINT*, 'stopping'
673 !!$ ENDIF
674 !!$
675 !!$ CALL COM_new_attribute( volWin//'.NodeFlag_th', 'p', COM_INTEGER, 2, '')
676 !!$ CALL COM_set_size( volWin//'.NodeFlag_th', ip, NumBC_thermal(ip) )
677 !!$ CALL COM_set_array(volWin//'.NodeFlag_th', ip, NodeFlag_th, 2)
678 !!$
679 !!$ ENDIF
680 
681 
682 ! ----------------------------------------------------
683 ! -- WRITE VOLUMETRIC ELEMENT CONNECTIVITY ARRAY
684 ! ------------------------------------------------
685 !
686 ! No. of 4-node tetrahedral
687 ! No. of 10-node tetrahedral
688 ! No. of lst on the partioned mesh boundary
689 
690 
691  itmp1 = sum(numel(1:nummat,ip))
692  itmp2 = sum(vol_list(1:nummat)%num_border_vol)
693 
694 
695  ALLOCATE(numelvolmat(1:nummat),numelpartbndrymat(1:nummat))
696 
697  ALLOCATE(mattype(1:itmp1))
698  ALLOCATE(elconntable(1:numvertx,itmp1))
699 
700  ! ... ElemCount added to keep track of elements put into this processors
701  ! ... connectivity table (ElConnTable in Print_vol_list) regardless of the
702  ! ... material. COstoich 10/27/09
703  elemcount = 0
704  DO ii = 1, nummat
705 
706 ! WRITE(4000,'(6i9)') itmp1,itmp2,numel(ii,ip),vol_list(ii)%num_border_vol,numvertx,0
707 
708  numelvolmat(ii) = numel(ii,ip)
709  numelpartbndrymat(ii) = vol_list(ii)%num_border_vol
710 
711  CALL print_vol_list(vol_list(ii),ii,numelvolmat(ii),elemcount)
712  elemcount = elemcount + numel(ii,ip)
713  ENDDO
714 
715  CALL com_new_attribute( volwin//'.NumElPartBndry', 'p', com_integer, 1, '')
716  CALL com_set_size( volwin//'.NumElPartBndry', ip, 1)
717  CALL com_allocate_array(volwin//'.NumElPartBndry', ip, tmpptr)
718  tmpptr = itmp2
719 
720  CALL com_new_attribute( volwin//'.NumElVolMat', 'p', com_integer, 1, '')
721  CALL com_set_size( volwin//'.NumElVolMat', ip, nummat)
722  CALL com_set_array(volwin//'.NumElVolMat', ip, numelvolmat, 1)
723 
724  CALL com_new_attribute( volwin//'.NumElPartBndryMat', 'p', com_integer, 1, '')
725  CALL com_set_size( volwin//'.NumElPartBndryMat', ip, nummat)
726  CALL com_set_array(volwin//'.NumElPartBndryMat', ip, numelpartbndrymat, 1)
727 !
728 ! Registering Element Connectivity
729 !
730  IF(numvertx.EQ.4)THEN
731 
732 !!$ CALL COM_init_mesh( volWin//'.T4', MyId+1, glb%ElConnVol, glb%NumElVol)
733 
734  CALL com_set_size( volwin//'.:T4', ip, itmp1)
735  CALL com_set_array( volwin//'.:T4', ip, elconntable, 4)
736 
737 
738  ELSE IF(numvertx.EQ.10)THEN
739 
740 !!$ CALL COM_init_mesh( volWin//'.T10', MyId+1, glb%ElConnVol, glb%NumElVol)
741 
742  CALL com_set_size( volwin//'.:T10', ip, itmp1)
743  CALL com_set_array( volwin//'.:T10', ip, elconntable, 10)
744 
745  ELSE IF(numvertx.EQ.8)THEN
746 !!$ CALL COM_init_mesh( volWin//'.H8', MyId+1, glb%ElConnVol, glb%NumElVol)
747 
748  CALL com_set_size( volwin//'.:H8', ip, itmp1)
749  CALL com_set_array( volwin//'.:H8', ip, elconntable, 8)
750  ENDIF
751 
752 ! Element Material Type Flag
753  CALL com_new_attribute( volwin//'.MatType', 'e', com_integer, 1, '')
754  CALL com_set_array(volwin//'.MatType', ip, mattype, 1)
755 
756 
757 ! --------------------------------------------------
758 ! -- WRITE NODE NUMBERING FOR IMPLICIT SOLVER
759 ! --------------------------------------------------
760 
761  IF ( imp ) THEN
762 
763  imp_val = 1
764 
765  CALL com_new_attribute( volwin//'.NumNPLocal', 'p', com_integer, 1, '')
766  CALL com_set_size( volwin//'.NumNPLocal', ip, 1)
767  CALL com_set_array(volwin//'.NumNPLocal', ip, numnp_loc_implicit(ip), 1)
768 
769  CALL com_new_attribute( volwin//'.NumNPGlobal', 'p', com_integer, 1, '')
770  CALL com_set_size( volwin//'.NumNPGlobal', ip, 1)
771  CALL com_set_array(volwin//'.NumNPGlobal', ip, numnp_prmry, 1)
772 
773  ALLOCATE(nodenumglobalimp(1:numndperproc(ip)))
774  ALLOCATE(nodeprocimp(1:numndperproc(ip)))
775 
776  DO i = 1, numnp_prmry
777  IF(nodeflag(i).NE.0) THEN
778  ii = nodeflag(i)
779  nodenumglobalimp(ii) = mapnodeimp(i)
780  nodeprocimp(ii) = nodeprocimpglobal(i)
781  END IF
782  END DO
783 
784  CALL com_new_attribute( volwin//'.NodeNumGlobal', 'p', com_integer, 1, '')
785  CALL com_set_size( volwin//'.NodeNumGlobal', ip, numndperproc(ip) )
786  CALL com_set_array(volwin//'.NodeNumGlobal', ip, nodenumglobalimp, 1)
787 
788  CALL com_new_attribute( volwin//'.NodeProc', 'p', com_integer, 1, '')
789  CALL com_set_size( volwin//'.NodeProc', ip, numndperproc(ip) )
790  CALL com_set_array(volwin//'.NodeProc', ip, nodeprocimp, 1)
791 
792  ELSE
793 
794  imp_val = 0
795 
796  END IF
797 
798  CALL com_new_attribute( volwin//'.IMP', 'p', com_integer, 1, '')
799  CALL com_set_size( volwin//'.IMP', ip, 1)
800  CALL com_set_array(volwin//'.IMP', ip, imp_val, 1)
801 
802 
803 
804 
805 ! --------------------------------------------
806 ! -- WRITE MPI COMMUNICATION INFORMATION
807 ! --------------------------------------------------
808 
809 
810 ! Nodeal Force calculaton communciation
811 
812 ! WRITE(4000,*) 6
813 
814 ! Determine the neighbor of processors 'i' is communicating with.
815 
816  numneighprocs = 0
817  maxnumnodescomm = 0
818  DO j = 1,nprocs
819  IF(id_sendto(ip,j)%num_border_comm.NE.0) THEN
820  numneighprocs = numneighprocs + 1
821  maxnumnodescomm = maxnumnodescomm + id_sendto(ip,j)%num_border_comm
822  ENDIF
823  ENDDO
824 
825 ! Number of neighboring proc. involved in R_in calculation
826 
827 ! WRITE(4000,*) NumNeighProcs
828 
829 ! 1D array format:
830 !
831 ! (1) number of communicating panes
832 ! (2) <communicating pane id>
833 ! (3) # shared node between panes (3) List of nodes .. repeat
834 
835 ! ALLOCATE(NumNeighProcs_List(1:NumNeighProcs))
836 ! ALLOCATE(NodesToCommunicate(1:MaxNumNodesComm))
837 ! ALLOCATE(ID_sendto_List(1:NumNeighProcs))
838 
839 ! List these neighboring processors
840 
841 !should this be moved, to you always need to register
842  ALLOCATE(pconn_comm(1:numneighprocs*2+maxnumnodescomm+1))
843  ! print*,'NumNeighProcs*2+MaxNumNodesComm',NumNeighProcs*2+MaxNumNodesComm
844  ! print*,'MaxNumNodesComm',MaxNumNodesComm
845 
846  icounter = 1
847  pconn_comm(icounter) = numneighprocs
848 
849  !NodesToCommunicate_cnt = 0
850  DO j=1,nprocs ! receiving processor
851  IF(id_sendto(j,ip)%num_border_comm.NE.0)THEN
852  ! print*,'ID_sendto(j,ip)%num_border_comm',ID_sendto(j,ip)%num_border_comm
853 ! Number of nodes that need to be communicated for R_in calculation
854 
855 
856 
857 
858  icounter = icounter+1
859  pconn_comm(icounter) = j
860 
861  icounter = icounter+1
862  pconn_comm(icounter) = id_sendto(j,ip)%num_border_comm ! why plus + 1
863 
864 ! List of nodes that need to be communicated for R_in calculation
865  CALL print_comm_list(id_sendto(j,ip),ip,icounter)
866 
867  ENDIF
868  ENDDO
869 
870 
871  IF(icounter.NE.numneighprocs*2+maxnumnodescomm+1)THEN
872  print*,'ERROR in Communication Pack array'
873  stop
874  ENDIF
875 
876 
877  CALL com_new_attribute( volwin//'.pconn', 'p', com_integer, 1, '')
878  CALL com_set_size( volwin//'.pconn', ip, numneighprocs*2+maxnumnodescomm+1)
879  CALL com_set_array(volwin//'.pconn', ip, pconn_comm, 1)
880 
881 !!$ CALL COM_new_attribute( volWin//'.ID_sendto_List', 'p', COM_INTEGER, 1, '')
882 !!$ CALL COM_set_size( volWin//'.ID_sendto_List', ip, NumNeighProcs)
883 !!$ CALL COM_set_array(volWin//'.ID_sendto_List', ip, ID_sendto_List, 1)
884 !!$
885 !!$ CALL COM_new_attribute( volWin//'.NumNeighProcs_List', 'p', COM_INTEGER, 1, '')
886 !!$ CALL COM_set_size( volWin//'.NumNeighProcs_List', ip, NumNeighProcs)
887 !!$ CALL COM_set_array(volWin//'.NumNeighProcs_List', ip, NumNeighProcs_List, 1)
888 
889 
890  CALL com_window_init_done( volwin)
891 
892  ! Load Rocmap using a name "MyPrivateMAP"
893 !!$ CALL COM_load_module( "Rocmap", "MyPrivateMAP")
894 !!$
895 !!$ ! Call compute_pconn
896 !!$ comp_pconn = COM_get_function_handle( "MyPrivateMAP.compute_pconn")
897 !!$ CALL COM_call_function( comp_pconn, 2, &
898 !!$ COM_get_attribute_handle_const( volWin//'.mesh'), &
899 !!$ COM_get_attribute_handle(volWin//'.pconn'))
900 !!$
901 !!$! Unload Rocmap.
902 !!$ CALL COM_unload_module( "Rocmap", "MyPrivateMAP")
903 
904 ! obtain function handle ------------------------------------------------------
905 
906  write_attr = com_get_function_handle( 'OUT.write_attribute')
907  set_option = com_get_function_handle( 'OUT.set_option')
908 
909  CALL com_call_function( set_option, 2, 'mode', 'w')
910 
911 ! do not append process rank -----------------
912 
913  CALL com_call_function( set_option, 2, 'rankwidth', '0')
914 ! write volume window ------------------------
915  vol_all = com_get_attribute_handle( volwin//'.all')
916 
917  CALL com_call_function( write_attr, 4, 'Rocin/'//prefx(1:prefx_lngth)//'.'//ichr4, vol_all,&
918  "solid","00.000000")
919 
920 ! delete volume window ----------
921 
922  CALL com_delete_window( volwin)
923 
924  IF ( imp ) THEN
925  DEALLOCATE(nodenumglobalimp)
926  DEALLOCATE(nodeprocimp)
927  END IF
928 
929  DEALLOCATE(meshcoor)
930 
931  IF(ASSOCIATED(nodeflag_str)) DEALLOCATE(nodeflag_str)
932  IF(ASSOCIATED(nodeflag_mm)) DEALLOCATE(nodeflag_mm)
933  IF(ASSOCIATED(nodeflag_th)) DEALLOCATE(nodeflag_th)
934 
935  IF(ASSOCIATED(bcvalue)) DEALLOCATE(bcvalue)
936 
937  DEALLOCATE(numelvolmat,numelpartbndrymat,mattype,elconntable)
938  !DEALLOCATE(NodesToCommunicate)
939  !deallocate(NumNeighProcs_List,ID_sendto_List)
940 
941  IF(ASSOCIATED(pconn_comm)) deallocate(pconn_comm)
942 
943 
944  IF(interactmesh) CALL mesh2d(nprocs,ip,ichr4)
945 
946 
947 
948  print*,'mesh2dOverlay'
949  IF(overlaymesh) THEN
950  IF(ip.EQ.1) THEN
951  OPEN(456,file ='Rocin/OverlayMappings.txt')
952  ENDIF
953  CALL mesh2doverlay(nprocs,ip,ichr4)
954  print*,'Finsihed mesh2dOverlay', ip
955 
956  ENDIF
957  ENDDO
958 
959  CLOSE(4001)
960  CLOSE(4002)
961 
962 
963 !--START
964 
965 !!$ OPEN(4001,FILE=prefx(1:prefx_lngth)//'/fracSF.im',STATUS='replace',FORM='formatted')
966 !!$ OPEN(4002,FILE=prefx(1:prefx_lngth)//'/fracS.im',STATUS='replace',FORM='formatted')
967 !!$
968 !!$ WRITE(4001,*) nprocs,MeshType2D
969 !!$ WRITE(4002,*) nprocs,MeshType2D
970 !!$
971 !!$ DO ip = 1, nprocs
972 !!$
973 !!$
974 !!$ CALL COM_new_window( volWin )
975 !!$
976 !!$
977 !!$ ! CALL RocstarInitSolution( gridLevel,iReg,regions,wins,winv )
978 !!$
979 !!$ ! CALL RocstarWriteSolution( gridLevel,iReg,regions(iReg),wins,winv )
980 !!$
981 !!$
982 !!$
983 !!$! -- Initialize link list variables
984 !!$
985 !!$ vol_list(1:NumMat)%num_border_vol = 0
986 !!$ DO i = 1, NumMat
987 !!$ NULLIFY(vol_list(i)%vol_head)
988 !!$ NULLIFY(vol_list(i)%vol_tail)
989 !!$ ENDDO
990 !!$
991 !!$ PRINT*,'Processor id =',ip
992 !!$
993 !!$ WRITE(ichr4,'(i4.4)') ip - 1
994 !!$
995 !!$! Output To Each Processors Files
996 !!$
997 !!$ OPEN(4000,FILE= &
998 !!$ prefx(1:prefx_lngth)//'/'//prefx(1:prefx_lngth)//'.'//ichr4//'.inp', &
999 !!$ STATUS='replace',FORM='formatted')
1000 !!$
1001 !!$! --------------------------
1002 !!$! Version of ROCSTAR_DATA
1003 !!$! -----------------------------------
1004 !!$!
1005 !!$ WRITE(4000,*) 1
1006 !!$! WRITE(4000,*) 2.5
1007 !!$! --------------------------
1008 !!$! Nodes
1009 !!$!-----------------------------------
1010 !!$ WRITE(4000,*) 2
1011 !!$ WRITE(4000,*) NumNdPerProc(ip),0,0,0,0
1012 !!$
1013 !!$! Renumber nodes locally, keep track of which node already renumbered
1014 !!$ NodeFlag(:) = 0
1015 !!$ ElFlag(:) = 0
1016 !!$
1017 !!$! go through the Processor's element link list
1018 !!$
1019 !!$ ptr2 => ProcElemList(ip)%head
1020 !!$
1021 !!$ iaux = 0
1022 !!$
1023 !!$ DO WHILE(ASSOCIATED(ptr2))
1024 !!$
1025 !!$ ielem = ptr2%GlbElNum
1026 !!$
1027 !!$ imat = MatId(ielem)
1028 !!$ numel(imat,ip) = numel(imat,ip) + 1
1029 !!$ ElOnPartBndry = .FALSE.
1030 !!$ DO k = 1, ElTypeId(ielem)
1031 !!$ nk = lmelv_prmry(k,ielem)
1032 !!$
1033 !!$ IF(NumProcPerNd(nk).GT.1) ElOnPartBndry =.TRUE.
1034 !!$
1035 !!$ IF(NodeFlag(nk).EQ.0)THEN
1036 !!$ numnp(ip) = numnp(ip) + 1
1037 !!$ WRITE(4000,'(i9,3(1x,e16.9),2i9)') numnp(ip), coor(1:3,nk),0
1038 !!$ iaux = iaux + 1
1039 !!$ NodeFlag(nk) = numnp(ip)
1040 !!$ ENDIF
1041 !!$
1042 !!$
1043 !!$ vol_item%mat_vol = imat
1044 !!$ vol_item%lmvol(k) = NodeFlag(nk)
1045 !!$
1046 !!$ ENDDO
1047 !!$
1048 !!$ ptr2 => ptr2%next
1049 !!$
1050 !!$ vol_item%iface = 0
1051 !!$ vol_item%press = ielem ! 0.d0
1052 !!$
1053 !!$! Add item to volumetric element list
1054 !!$!
1055 !!$
1056 !!$ IF(ElOnPartBndry)THEN ! Element contains a node that is on the partition boundary
1057 !!$ CALL vol_insert_head(vol_list(imat),vol_item)
1058 !!$! icnt(imat,1) = icnt(imat,1) + 1
1059 !!$! ElFlag(ielem) = icnt(imat,1)
1060 !!$! MapGlbEl2LocEl(ip) = icnt(imat,1)
1061 !!$ ELSE
1062 !!$ CALL vol_insert_tail(vol_list(imat),vol_item)
1063 !!$! icnt(imat,2) = icnt(imat,2) + 1
1064 !!$! ElFlag(ielem) = icnt(imat,2)
1065 !!$! MapGlbEl2LocEl(ip) = icnt(imat,2)
1066 !!$ ENDIF
1067 !!$
1068 !!$ ENDDO
1069 !!$
1070 !!$ IF(iaux.NE.NumNdPerProc(ip))THEN
1071 !!$ PRINT*,'Test failed when renumbering'
1072 !!$ PRINT*,'iaux=',iaux
1073 !!$ PRINT*,'NumNdPerProc',NumNdPerProc(ip)
1074 !!$ STOP
1075 !!$ ENDIF
1076 !!$
1077 !!$! ------------------------------
1078 !!$!
1079 !!$! STRUCTURAL BOUNDARY CONDITIONS
1080 !!$! --------------------------------------------
1081 !!$
1082 !!$ WRITE(4000,*) 3
1083 !!$ WRITE(4000,*) NumBC_structural(ip),0
1084 !!$
1085 !!$
1086 !!$ ptr_BC => BC_structural_head
1087 !!$ iaux = 0
1088 !!$ DO WHILE(ASSOCIATED(ptr_BC))
1089 !!$
1090 !!$ GlbNd = ptr_BC%BC_nodeGlb
1091 !!$ iflag = ptr_BC%BC_flagGlb
1092 !!$ IF(NodeFlag(GlbNd).NE.0)THEN
1093 !!$ WRITE(4000,'(4i9)') NodeFlag(GlbNd), iflag, 0
1094 !!$ iaux = iaux + 1
1095 !!$ ENDIF
1096 !!$ ptr_BC => ptr_BC%next
1097 !!$ ENDDO
1098 !!$
1099 !!$ IF(iaux.NE.NumBC_structural(ip))THEN
1100 !!$ PRINT*,'ERROR, number of structural BCs in linked list'
1101 !!$ PRINT*,' inconsistant with that of serierial mesh'
1102 !!$ PRINT*, 'stopping'
1103 !!$ ENDIF
1104 !!$
1105 !!$! ------------------------------
1106 !!$!
1107 !!$! MESH MOTION BOUNDARY CONDITIONS
1108 !!$! --------------------------------------------
1109 !!$ WRITE(4000,*) 4
1110 !!$ WRITE(4000,*) NumBC_meshmotion(ip),0
1111 !!$
1112 !!$ ptr_BC => BC_meshmotion_head
1113 !!$ iaux = 0
1114 !!$ DO WHILE(ASSOCIATED(ptr_BC))
1115 !!$
1116 !!$ GlbNd = ptr_BC%BC_nodeGlb
1117 !!$ iflag = ptr_BC%BC_flagGlb
1118 !!$ IF(NodeFlag(GlbNd).NE.0)THEN
1119 !!$ WRITE(4000,'(4i9)') NodeFlag(GlbNd), iflag, 0
1120 !!$ iaux = iaux + 1
1121 !!$ ENDIF
1122 !!$ ptr_BC => ptr_BC%next
1123 !!$ ENDDO
1124 !!$
1125 !!$ IF(iaux.NE.NumBC_meshmotion(ip))THEN
1126 !!$ PRINT*,'ERROR, number of mesh motion BCs in linked list'
1127 !!$ PRINT*,' inconsistant with that of serierial mesh'
1128 !!$ PRINT*, 'stopping'
1129 !!$ ENDIF
1130 !!$
1131 !!$
1132 !!$! ------------------------------
1133 !!$!
1134 !!$! THERMAL BOUNDARY CONDITIONS
1135 !!$! --------------------------------------------
1136 !!$
1137 !!$ WRITE(4000,*) 8
1138 !!$ WRITE(4000,*) NumBC_thermal(ip),0
1139 !!$
1140 !!$! cycle through list, no longer is nice order as before
1141 !!$
1142 !!$ ptr_BC => BC_thermal_head
1143 !!$ iaux = 0
1144 !!$ DO WHILE(ASSOCIATED(ptr_BC))
1145 !!$
1146 !!$ GlbNd = ptr_BC%BC_nodeGlb
1147 !!$ iflag = ptr_BC%BC_flagGlb
1148 !!$ IF(NodeFlag(GlbNd).NE.0)THEN
1149 !!$ WRITE(4000,'(4i9)') NodeFlag(GlbNd), iflag, 0
1150 !!$ iaux = iaux + 1
1151 !!$ ENDIF
1152 !!$ ptr_BC => ptr_BC%next
1153 !!$ ENDDO
1154 !!$
1155 !!$ IF(iaux.NE.NumBC_thermal(ip))THEN
1156 !!$ PRINT*,'ERROR, number of thermal BCs in linked list'
1157 !!$ PRINT*,' inconsistant with that of serierial mesh'
1158 !!$ PRINT*, 'stopping'
1159 !!$ ENDIF
1160 !!$
1161 !!$
1162 !!$! ----------------------------------------------------
1163 !!$! -- WRITE VOLUMETRIC ELEMENT CONNECTIVITY ARRAY
1164 !!$! ------------------------------------------------
1165 !!$!
1166 !!$! No. of 4-node tetrahedral
1167 !!$! No. of 10-node tetrahedral
1168 !!$! No. of lst on the partioned mesh boundary
1169 !!$
1170 !!$
1171 !!$ itmp1 = SUM(numel(1:NumMat,ip))
1172 !!$ itmp2 = SUM(vol_list(1:NumMat)%num_border_vol)
1173 !!$
1174 !!$ WRITE(4000,*) 5
1175 !!$
1176 !!$ DO ii = 1, NumMat
1177 !!$
1178 !!$ WRITE(4000,'(6i9)') itmp1,itmp2,numel(ii,ip),vol_list(ii)%num_border_vol,numvertx,0
1179 !!$
1180 !!$ CALL print_vol_list(vol_list(ii),ii)
1181 !!$ ENDDO
1182 !!$
1183 !!$
1184 !!$! --------------------------------------------
1185 !!$! -- WRITE MPI COMMUNICATION INFORMATION
1186 !!$! --------------------------------------------------
1187 !!$
1188 !!$! Nodeal Force calculaton communciation
1189 !!$
1190 !!$ WRITE(4000,*) 6
1191 !!$
1192 !!$! Determine the neighbor of processors 'i' is communicating with.
1193 !!$
1194 !!$ NumNeighProcs = 0
1195 !!$ DO j = 1,nprocs
1196 !!$ IF(ID_sendto(ip,j)%num_border_comm.NE.0) &
1197 !!$ NumNeighProcs = NumNeighProcs + 1
1198 !!$ ENDDO
1199 !!$
1200 !!$! Number of neighboring proc. involved in R_in calculation
1201 !!$
1202 !!$ WRITE(4000,*) NumNeighProcs
1203 !!$
1204 !!$! List these neighboring processors
1205 !!$
1206 !!$ DO j=1,nprocs ! receiving processor
1207 !!$ IF(ID_sendto(j,ip)%num_border_comm.NE.0)THEN
1208 !!$! Number of nodes that need to be communicated for R_in calculation
1209 !!$ WRITE(4000,*) j-1,ID_sendto(j,ip)%num_border_comm ! common
1210 !!$! List of nodes that need to be communicated for R_in calculation
1211 !!$ CALL print_comm_list(ID_sendto(j,ip),ip)
1212 !!$ ENDIF
1213 !!$ ENDDO
1214 !!$
1215 !!$ WRITE(4000,*) 99
1216 !!$ CLOSE(4000)
1217 !!$
1218 !!$
1219 !!$ CALL mesh2d(nprocs,ip)
1220 !!$
1221 !!$
1222 !!$ ENDDO
1223 !!$
1224 !!$ CLOSE(4001)
1225 !!$ CLOSE(4002)
1226 
1227 END PROGRAM rocfracprep
1228 
linked_list::coh_comm_list_type
Definition: SourceIMP/utilities/RocfracPrep/linked_list.f90:122
linked_list
Definition: SourceIMP/utilities/RocfracPrep/linked_list.f90:53
cimg_library::CImg::sum
Tfloat sum() const
Return the sum of all the pixel values in an image.
Definition: CImg.h:13022
linked_list::coh_list_type
Definition: SourceIMP/utilities/RocfracPrep/linked_list.f90:118
linked_list::vol_insert_head
subroutine, public vol_insert_head(arg_b, vol_item)
Definition: SourceIMP/utilities/RocfracPrep/linked_list.f90:241
Attribute::status
int status() const
Obtain the status of the attribute.
Definition: Attribute.h:240
linked_list::print_vol_list
subroutine print_vol_list(arg_b, imat, Inum, ElemCount)
Definition: SourceIMP/utilities/RocfracPrep/linked_list.f90:353
linked_list::vol_list_type
Definition: SourceIMP/utilities/RocfracPrep/linked_list.f90:127
nodebc_lst
Definition: SourceIMP/utilities/RocfracPrep/RocfracPrep.f90:70
linked_list::coh_info_type
Definition: SourceIMP/utilities/RocfracPrep/linked_list.f90:59
linked_list2
Definition: SourceIMP/utilities/RocfracPrep/Linked_List2.f90:53
mesh2d
subroutine mesh2d(nprocs, iProcs, ichr4)
Definition: SourceIMP/utilities/RocfracPrep/2Dmesh.f90:53
read_patran
subroutine read_patran(numvertx2d, dhmin, nprocs)
Definition: SourceIMP/utilities/RocfracPrep/read_patran.f90:53
readinp
subroutine readinp(ntime)
Definition: SourceIMP/utilities/RocfracPrep/readinp.f90:53
form
**********************************************************************Rocstar Simulation Suite Illinois Rocstar LLC All rights reserved ****Illinois Rocstar LLC IL **www illinoisrocstar com **sales illinoisrocstar com WITHOUT WARRANTY OF ANY **EXPRESS OR INCLUDING BUT NOT LIMITED TO THE WARRANTIES **OF FITNESS FOR A PARTICULAR PURPOSE AND **NONINFRINGEMENT IN NO EVENT SHALL THE CONTRIBUTORS OR **COPYRIGHT HOLDERS BE LIABLE FOR ANY DAMAGES OR OTHER WHETHER IN AN ACTION OF TORT OR **Arising OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE **USE OR OTHER DEALINGS WITH THE SOFTWARE **********************************************************************INTERFACE SUBROUTINE form
Definition: RFLO_ReadDataFileInt.h:26
generic_list::li_init_list
subroutine, public li_init_list(List)
Definition: SourceIMP/utilities/RocfracPrep/GENII_LinkedList.f90:157
sndrcv_buf
Definition: SourceIMP/utilities/RocfracPrep/RocfracPrep.f90:74
Aff_transformation_repS2::print
virtual std::ostream & print(std::ostream &os) const
Definition: Aff_transformationS2.h:277
linked_list::coh_comm_info_type
Definition: SourceIMP/utilities/RocfracPrep/linked_list.f90:65
mesh2doverlay
subroutine mesh2doverlay(nprocs, iProcs, ichr4)
Definition: SourceIMP/utilities/RocfracPrep/2DmeshOverlay.f90:53
linked_list::print_comm_list
subroutine print_comm_list(arg_b, ip, iaux)
Definition: SourceIMP/utilities/RocfracPrep/linked_list.f90:398
rocstar_rocfrac::bcvalues
Definition: ROCSTAR_RocFrac.f90:75
linked_list::vol_info_type
Definition: SourceIMP/utilities/RocfracPrep/linked_list.f90:69
linked_list::vol_insert_tail
subroutine, public vol_insert_tail(arg_b, vol_item)
Definition: SourceIMP/utilities/RocfracPrep/linked_list.f90:261
linked_list::vol_box_point
Definition: SourceIMP/utilities/RocfracPrep/linked_list.f90:80