Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
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  convertunit = 1.d0
236 
237  n = iargc()
238  IF(n.LE.1) goto 554
239 
240  j = 1
241  DO i = 1, n/2
242  CALL getarg( j, chr_arg)
243  IF(chr_arg.EQ.'-np')THEN
244  CALL getarg( j+1, chr_procs)
245  READ(chr_procs,*) nprocs
246  j = j +2
247  ELSE IF(chr_arg.EQ.'-un')THEN ! units
248  CALL getarg( j+1, chr_units)
249  READ(chr_units,*) convertunit
250  j = j + 2
251  print*,'UNITS CONVERSION'
252  print*,' multiply by ', convertunit
253 
254  ELSE
255  goto 554
256  ENDIF
257  ENDDO
258 
259  goto 555
260 
261 554 CONTINUE
262  print*,'Usage:'
263  print*,' MeshTran -np #'
264  print*,' - where # is the number of processors'
265  stop
266 
267 555 CONTINUE
268 
269  myid = 0
270 
271  CALL readinp(ntime)
272 
273  print*,'numvertx=',numvertx
274 
275  ! CALL system('\rm -f -r '//prefx(1:prefx_lngth))
276 
277 
278 ! -- mesh motion boundary conditions
279 
280 
281  dhmin = 1000000000.d0
282 
283  IF(iansys.EQ.1)THEN
284  print*,'ANSYS NO LONGER SUPPORTED'
285  print*,'STOPPING'
286  stop
287 ! CALL read_ansys(numbcss, dhmin)
288  ELSE IF(ipatran.EQ.1)THEN
289  CALL read_patran(numvertx2d,dhmin,nprocs)
290  numbcss = numnp_prmry
291 !$$$ ELSE IF(ipatcohin.EQ.1)THEN
292 !$$$ CALL read_patran_cohin(numbcss,numvertx2d,dhmin,nprocs)
293 !$$$ ELSE IF(itetcohin.EQ.1)THEN
294 !$$$ CALL read_tetmesh_cohin(numbcss,numvertx2d,dhmin,nprocs)
295 !$$$ numbcss = numnp_prmry
296 !$$$ ELSE IF(itetmesh.EQ.1)THEN
297 !NOTE:
298 !IF both ascii and binary temesh input files exist,then
299 ! the binary file will be the one that gets read.
300 !$$$ CALL read_tetmesh(numbcss,numvertx2d,dhmin,nprocs)
301 !$$$ numbcss = numnp_prmry
302  ENDIF
303 !
304 ! -- Checking Courant condition for time step
305 !
306  dt_courant = dhmin/cd_fastest
307  cd_courant = cd_fastest
308  dh_courant = dhmin
309 
310  print*,' --------------------------------------'
311  print*,' ---- COURANT STABILITY CONDITION -----'
312  print*,' --------------------------------------'
313  print*,' dt_courant =',dt_courant
314  print*,' cd_courant =',cd_courant
315  print*,' h_courant =',dh_courant
316  print*,' --------------------------------------'
317 
318  iaux = 1
319  print*,'Allocate(numel)'
320  ALLOCATE(numel(1:nummat,1:nprocs))
321 
322  print*,'Allocate(numel).finish'
323  numel(:,:) = 0
324 
325  DO n = 1, numelv_prmry ! Loop over the tetrahedra elements
326  imat = matid(n)
327  numel(imat,epart(n)) = numel(imat,epart(n)) + 1
328  ENDDO
329 
330  ALLOCATE(numnp(1:nprocs))
331 
332  ii = 0
333 
334  numnp(1:nprocs) = 0
335  numel(1:nummat,1:nprocs) = 0
336  ALLOCATE(vol_item)
337  ALLOCATE(vol_list(1:nummat))
338 
339 
340 !
341 ! -- RENUMBER THE VOLUMETRIC ELEMENTS USING LOCAL NUMBERING
342  print*,'RENUMBERING VOLUMETRIC ELEMENTS'
343 
344 ! allocate(MapGlbEl2LocEl(1:numelv_prmry))
345 ! allocate(icnt(1:NumMat,1:2))
346 ! icnt(:,:) = 0
347 ! allocate(ElOnPartBndry(1:numelv_prmry))
348 
349  ALLOCATE(procnodelist(1:nprocs))
350 
351  DO i = 1, nprocs
352  CALL li_init_list(procnodelist(i))
353  ENDDO
354 
355  ALLOCATE(nodeflag(1:numnp_prmry))
356  ALLOCATE(elflag(1:numelv_prmry))
357 
358 !
359 ! Write each processor's input file
360 !
361  ALLOCATE(nproc_neigh_lst(1:nprocs)) ! does not need to keep track of processors
362  nproc_neigh_lst(:) = 0
363 
364 
365 
366  CALL com_init
367 
368 ! - load Rocout module
369  CALL com_set_verbose( 10)
370  CALL rocout_load_module( 'OUT')
371 
372 ! Surface boundary meshes
373 
374 !!$ OPEN(4001,FILE=prefx(1:prefx_lngth)//'/fracSF.im',STATUS='replace',FORM='formatted')
375 !!$ OPEN(4002,FILE=prefx(1:prefx_lngth)//'/fracS.im',STATUS='replace',FORM='formatted')
376 !!$
377 !!$ WRITE(4001,*) nprocs,MeshType2D
378 !!$ WRITE(4002,*) nprocs,MeshType2D
379 
380 
381  OPEN(4005,file='Rocin/isolid_in_00.000000.txt',status='replace',form='formatted')
382  WRITE(4005,*) '@Proc: *'
383  !WRITE(4005,*) '@Files: Rocfrac/Rocin/SurfMesh.%4p.hdf'
384  WRITE(4005,*) '@Files: Rocfrac/Rocin/SurfMesh.%4p.cgns'
385  WRITE(4005,*) '@Panes: @BlockCyclic 100 100'
386  close(4005)
387 
388  OPEN(4005,file='Rocin/solid_in_00.000000.txt',status='replace',form='formatted')
389  WRITE(4005,*) '@Proc: *'
390  !WRITE(4005,*) '@Files: Rocfrac/Rocin/'//prefx(1:prefx_lngth)//'.%4p.hdf'
391  WRITE(4005,*) '@Files: Rocfrac/Rocin/'//prefx(1:prefx_lngth)//'.%4p.cgns'
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 
439  imat = matid(ielem)
440  numel(imat,ip) = numel(imat,ip) + 1
441  elonpartbndry = .false.
442  DO k = 1, eltypeid(ielem)
443  nk = lmelv_prmry(k,ielem)
444 
445  IF(numprocpernd(nk).GT.1) elonpartbndry =.true.
446 
447  IF(nodeflag(nk).EQ.0)THEN
448  numnp(ip) = numnp(ip) + 1
449  iaux = iaux + 1
450  nodeflag(nk) = numnp(ip)
451  ENDIF
452 
453  vol_item%mat_vol = imat
454  vol_item%lmvol(k) = nodeflag(nk)
455 
456  ENDDO
457 
458 
459  ptr2 => ptr2%next
460 
461  vol_item%iface = 0
462  vol_item%press = ielem ! 0.d0
463 
464 ! Add item to volumetric element list
465 !
466 
467  IF(elonpartbndry)THEN ! Element contains a node that is on the partition boundary
468  CALL vol_insert_head(vol_list(imat),vol_item)
469 ! icnt(imat,1) = icnt(imat,1) + 1
470 ! ElFlag(ielem) = icnt(imat,1)
471 ! MapGlbEl2LocEl(ip) = icnt(imat,1)
472  ELSE
473  CALL vol_insert_tail(vol_list(imat),vol_item)
474 ! icnt(imat,2) = icnt(imat,2) + 1
475 ! ElFlag(ielem) = icnt(imat,2)
476 ! MapGlbEl2LocEl(ip) = icnt(imat,2)
477  ENDIF
478 
479  ENDDO
480 
481 
482  ALLOCATE(meshcoor(1:3,1:numnp(ip))) !**
483 
484  DO i = 1, numnp_prmry
485  IF(nodeflag(i).NE.0) meshcoor(1:3,nodeflag(i)) = coor(1:3,i)
486  END DO
487 
488  CALL com_new_attribute( volwin//'.nc', 'n', com_double, 3, 'm')
489  CALL com_set_size( volwin//'.nc', ip, numndperproc(ip) )
490  CALL com_set_array(volwin//'.nc', ip, meshcoor, 3)
491 
492  print*,'registerd Coordinates'
493 
494  IF(iaux.NE.numndperproc(ip))THEN
495  print*,'Test failed when renumbering'
496  print*,'iaux=',iaux
497  print*,'NumNdPerProc',numndperproc(ip)
498  stop
499  ENDIF
500 
501 ! BOUNDARY CONDITIONS
502 ! 10000*MeshMotionBC + 100*ThermalBC + StructuralBC
503 
504  print*,'Boundary Conditions'
505 
506  IF(numbc_flag(ip).NE.0)THEN
507 
508  ALLOCATE( nodeflag_str(1:2,1:numbc_flag(ip)) )
509 
510 
511  iaux = 0
512 
513  DO i = 1, numnp_prmry
514  IF(nodeflag(i).NE.0.AND.bc_flag(1,i).NE.0)THEN
515  iaux = iaux + 1
516  nodeflag_str(1,iaux) = nodeflag(i)
517  nodeflag_str(2,iaux) = bc_flag(1,i)
518  ENDIF
519  IF(nodeflag(i).NE.0.AND.bc_flag(2,i).NE.0)THEN
520  iaux = iaux + 1
521  nodeflag_str(1,iaux) = nodeflag(i)
522  nodeflag_str(2,iaux) = bc_flag(2,i)
523  ENDIF
524  IF(nodeflag(i).NE.0.AND.bc_flag(3,i).NE.0)THEN
525  iaux = iaux + 1
526  nodeflag_str(1,iaux) = nodeflag(i)
527  nodeflag_str(2,iaux) = bc_flag(3,i)
528  ENDIF
529  enddo
530 
531  IF(iaux.NE.numbc_flag(ip))THEN
532  print*,'ERROR, number of BCs in partitioned mesh',iaux
533  print*,' inconsistant with that of serial mesh',numbc_flag(ip)
534  print*, 'stopping'
535  stop
536  ENDIF
537 
538  CALL com_new_attribute( volwin//'.bcnode', 'p', com_integer, 2, '')
539  CALL com_set_size( volwin//'.bcnode', ip, numbc_flag(ip) )
540  CALL com_set_array(volwin//'.bcnode', ip, nodeflag_str, 2)
541 
542 
543  allocate(bcvalue(1:numbc_flag(ip)*6))
544  bcvalue(:) = 0.d0
545  CALL com_new_attribute( volwin//'.BCValue', 'p', com_double, 1, '')
546  CALL com_set_size( volwin//'.BCValue', ip,numbc_flag(ip)*6 )
547  CALL com_set_array(volwin//'.BCValue', ip, bcvalue, 1)
548  ENDIF
549 
550 !!$ CALL COM_new_attribute( volWin//'.NumBC_str', 'p', COM_INTEGER, 1, '')
551 !!$ CALL COM_set_size( volWin//'.NumBC_str', ip, 1 )
552 !!$ CALL COM_set_array(volWin//'.NumBC_str', ip, NumBC_structural(ip), 1)
553 !!$
554 !!$ CALL COM_new_attribute( volWin//'.NumBC_mm', 'p', COM_INTEGER, 1, '')
555 !!$ CALL COM_set_size( volWin//'.NumBC_mm', ip, 1 )
556 !!$ CALL COM_set_array(volWin//'.NumBC_mm', ip, NumBC_meshmotion(ip), 1)
557 !!$
558 !!$ CALL COM_new_attribute( volWin//'.NumBC_th', 'p', COM_INTEGER, 1, '')
559 !!$ CALL COM_set_size( volWin//'.NumBC_th', ip, 1 )
560 !!$ CALL COM_set_array(volWin//'.NumBC_th', ip, NumBC_thermal(ip), 1)
561 
562 !!$! ------------------------------
563 !!$!
564 !!$! STRUCTURAL BOUNDARY CONDITIONS
565 !!$! --------------------------------------------
566 !!$
567 !!$! WRITE(4000,*) 3
568 !!$! WRITE(4000,*) NumBC_structural(ip),0
569 !!$
570 !!$ IF(NumBC_structural(ip).NE.0)THEN
571 !!$
572 !!$
573 !!$ ALLOCATE( NodeFlag_str(1:2,1:NumBC_structural(ip)) )
574 !!$
575 !!$ ptr_BC => BC_structural_head
576 !!$ iaux = 0
577 !!$ DO WHILE(ASSOCIATED(ptr_BC))
578 !!$
579 !!$ GlbNd = ptr_BC%BC_nodeGlb
580 !!$ iflag = ptr_BC%BC_flagGlb
581 !!$ IF(NodeFlag(GlbNd).NE.0)THEN
582 !!$ iaux = iaux + 1
583 !!$ NodeFlag_str(1,iaux) = NodeFlag(GlbNd)
584 !!$ NodeFlag_str(2,iaux) = iflag
585 !!$ ENDIF
586 !!$ ptr_BC => ptr_BC%next
587 !!$ ENDDO
588 !!$
589 !!$ IF(iaux.NE.NumBC_structural(ip))THEN
590 !!$ PRINT*,'ERROR, number of structural BCs in linked list'
591 !!$ PRINT*,' inconsistant with that of serierial mesh'
592 !!$ PRINT*, 'stopping'
593 !!$ ENDIF
594 !!$
595 !!$ CALL COM_new_attribute( volWin//'.NodeFlag_str', 'p', COM_INTEGER, 2, '')
596 !!$ CALL COM_set_size( volWin//'.NodeFlag_str', ip, NumBC_structural(ip) )
597 !!$ CALL COM_set_array(volWin//'.NodeFlag_str', ip, NodeFlag_str, 2)
598 !!$ ENDIF
599 !!$
600 !!$
601 !!$! ------------------------------
602 !!$!
603 !!$! MESH MOTION BOUNDARY CONDITIONS
604 !!$! --------------------------------------------
605 !!$
606 !!$! WRITE(4000,*) 4
607 !!$! WRITE(4000,*) NumBC_meshmotion(ip),0
608 !!$
609 !!$ IF(NumBC_meshmotion(ip).NE.0)THEN
610 !!$
611 !!$ ALLOCATE( NodeFlag_mm(1:2,1:NumBC_meshmotion(ip)) )
612 !!$
613 !!$
614 !!$ ptr_BC => BC_meshmotion_head
615 !!$ iaux = 0
616 !!$ DO WHILE(ASSOCIATED(ptr_BC))
617 !!$
618 !!$ GlbNd = ptr_BC%BC_nodeGlb
619 !!$ iflag = ptr_BC%BC_flagGlb
620 !!$ IF(NodeFlag(GlbNd).NE.0)THEN
621 !!$ iaux = iaux + 1
622 !!$ NodeFlag_mm(1,iaux) = NodeFlag(GlbNd)
623 !!$ NodeFlag_mm(2,iaux) = iflag
624 !!$ ENDIF
625 !!$ ptr_BC => ptr_BC%next
626 !!$ ENDDO
627 !!$
628 !!$ IF(iaux.NE.NumBC_meshmotion(ip))THEN
629 !!$ PRINT*,'ERROR, number of mesh motion BCs in linked list'
630 !!$ PRINT*,' inconsistant with that of serierial mesh'
631 !!$ PRINT*, 'stopping'
632 !!$ ENDIF
633 !!$
634 !!$ CALL COM_new_attribute( volWin//'.NodeFlag_mm', 'p', COM_INTEGER, 2, '')
635 !!$ CALL COM_set_size( volWin//'.NodeFlag_mm', ip, NumBC_meshmotion(ip) )
636 !!$ CALL COM_set_array(volWin//'.NodeFlag_mm', ip, NodeFlag_mm, 2)
637 !!$
638 !!$ ENDIF
639 !!$
640 !!$! ------------------------------
641 !!$!
642 !!$! THERMAL BOUNDARY CONDITIONS
643 !!$! --------------------------------------------
644 !!$
645 !!$! WRITE(4000,*) 8
646 !!$! WRITE(4000,*) NumBC_thermal(ip),0
647 !!$
648 !!$ IF(NumBC_thermal(ip).NE.0)THEN
649 !!$
650 !!$ ALLOCATE( NodeFlag_th(1:2, 1:NumBC_thermal(ip) ) )
651 !!$
652 !!$ ptr_BC => BC_thermal_head
653 !!$ iaux = 0
654 !!$ DO WHILE(ASSOCIATED(ptr_BC))
655 !!$
656 !!$ GlbNd = ptr_BC%BC_nodeGlb
657 !!$ iflag = ptr_BC%BC_flagGlb
658 !!$ IF(NodeFlag(GlbNd).NE.0)THEN
659 !!$ iaux = iaux + 1
660 !!$ NodeFlag_th(1,iaux) = NodeFlag(GlbNd)
661 !!$ NodeFlag_th(2,iaux) = iflag
662 !!$ ENDIF
663 !!$ ptr_BC => ptr_BC%next
664 !!$ ENDDO
665 !!$
666 !!$ IF(iaux.NE.NumBC_thermal(ip))THEN
667 !!$ PRINT*,'ERROR, number of thermal BCs in linked list'
668 !!$ PRINT*,' inconsistant with that of serierial mesh'
669 !!$ PRINT*, 'stopping'
670 !!$ ENDIF
671 !!$
672 !!$ CALL COM_new_attribute( volWin//'.NodeFlag_th', 'p', COM_INTEGER, 2, '')
673 !!$ CALL COM_set_size( volWin//'.NodeFlag_th', ip, NumBC_thermal(ip) )
674 !!$ CALL COM_set_array(volWin//'.NodeFlag_th', ip, NodeFlag_th, 2)
675 !!$
676 !!$ ENDIF
677 
678 
679 ! ----------------------------------------------------
680 ! -- WRITE VOLUMETRIC ELEMENT CONNECTIVITY ARRAY
681 ! ------------------------------------------------
682 !
683 ! No. of 4-node tetrahedral
684 ! No. of 10-node tetrahedral
685 ! No. of lst on the partioned mesh boundary
686 
687 
688  itmp1 = sum(numel(1:nummat,ip))
689  itmp2 = sum(vol_list(1:nummat)%num_border_vol)
690 
691 
692  ALLOCATE(numelvolmat(1:nummat),numelpartbndrymat(1:nummat))
693 
694  ALLOCATE(mattype(1:itmp1))
695  ALLOCATE(elconntable(1:numvertx,itmp1))
696 
697  ! ... ElemCount added to keep track of elements put into this processors
698  ! ... connectivity table (ElConnTable in Print_vol_list) regardless of the
699  ! ... material. COstoich 10/27/09
700  elemcount = 0
701  DO ii = 1, nummat
702 
703 ! WRITE(4000,'(6i9)') itmp1,itmp2,numel(ii,ip),vol_list(ii)%num_border_vol,numvertx,0
704 
705  numelvolmat(ii) = numel(ii,ip)
706  numelpartbndrymat(ii) = vol_list(ii)%num_border_vol
707 
708  CALL print_vol_list(vol_list(ii),ii,numelvolmat(ii),elemcount)
709  elemcount = elemcount + numel(ii,ip)
710  ENDDO
711 
712  CALL com_new_attribute( volwin//'.NumElPartBndry', 'p', com_integer, 1, '')
713  CALL com_set_size( volwin//'.NumElPartBndry', ip, 1)
714  CALL com_resize_array(volwin//'.NumElPartBndry', ip, tmpptr)
715  tmpptr = itmp2
716 
717  CALL com_new_attribute( volwin//'.NumElVolMat', 'p', com_integer, 1, '')
718  CALL com_set_size( volwin//'.NumElVolMat', ip, nummat)
719  CALL com_set_array(volwin//'.NumElVolMat', ip, numelvolmat, 1)
720 
721  CALL com_new_attribute( volwin//'.NumElPartBndryMat', 'p', com_integer, 1, '')
722  CALL com_set_size( volwin//'.NumElPartBndryMat', ip, nummat)
723  CALL com_set_array(volwin//'.NumElPartBndryMat', ip, numelpartbndrymat, 1)
724 !
725 ! Registering Element Connectivity
726 !
727  IF(numvertx.EQ.4)THEN
728 
729 !!$ CALL COM_init_mesh( volWin//'.T4', MyId+1, glb%ElConnVol, glb%NumElVol)
730 
731  CALL com_set_size( volwin//'.:T4', ip, itmp1)
732  CALL com_set_array( volwin//'.:T4', ip, elconntable, 4)
733 
734 
735  ELSE IF(numvertx.EQ.10)THEN
736 
737 !!$ CALL COM_init_mesh( volWin//'.T10', MyId+1, glb%ElConnVol, glb%NumElVol)
738 
739  CALL com_set_size( volwin//'.:T10', ip, itmp1)
740  CALL com_set_array( volwin//'.:T10', ip, elconntable, 10)
741 
742  ELSE IF(numvertx.EQ.8)THEN
743 !!$ CALL COM_init_mesh( volWin//'.H8', MyId+1, glb%ElConnVol, glb%NumElVol)
744 
745  CALL com_set_size( volwin//'.:H8', ip, itmp1)
746  CALL com_set_array( volwin//'.:H8', ip, elconntable, 8)
747 
748  ENDIF
749 
750 ! Element Material Type Flag
751  CALL com_new_attribute( volwin//'.MatType', 'e', com_integer, 1, '')
752  CALL com_set_array(volwin//'.MatType', ip, mattype, 1)
753 
754 
755 
756 
757 ! --------------------------------------------
758 ! -- WRITE MPI COMMUNICATION INFORMATION
759 ! --------------------------------------------------
760 
761 
762 ! Nodeal Force calculaton communciation
763 
764 ! WRITE(4000,*) 6
765 
766 ! Determine the neighbor of processors 'i' is communicating with.
767 
768  numneighprocs = 0
769  maxnumnodescomm = 0
770  DO j = 1,nprocs
771  IF(id_sendto(ip,j)%num_border_comm.NE.0) THEN
772  numneighprocs = numneighprocs + 1
773  maxnumnodescomm = maxnumnodescomm + id_sendto(ip,j)%num_border_comm
774  ENDIF
775  ENDDO
776 
777 ! Number of neighboring proc. involved in R_in calculation
778 
779 ! WRITE(4000,*) NumNeighProcs
780 
781 ! 1D array format:
782 !
783 ! (1) number of communicating panes
784 ! (2) <communicating pane id>
785 ! (3) # shared node between panes (3) List of nodes .. repeat
786 
787 ! ALLOCATE(NumNeighProcs_List(1:NumNeighProcs))
788 ! ALLOCATE(NodesToCommunicate(1:MaxNumNodesComm))
789 ! ALLOCATE(ID_sendto_List(1:NumNeighProcs))
790 
791 ! List these neighboring processors
792 
793 !should this be moved, to you always need to register
794  ALLOCATE(pconn_comm(1:numneighprocs*2+maxnumnodescomm+1))
795  ! print*,'NumNeighProcs*2+MaxNumNodesComm',NumNeighProcs*2+MaxNumNodesComm
796  ! print*,'MaxNumNodesComm',MaxNumNodesComm
797 
798  icounter = 1
799  pconn_comm(icounter) = numneighprocs
800 
801  !NodesToCommunicate_cnt = 0
802  DO j=1,nprocs ! receiving processor
803  IF(id_sendto(j,ip)%num_border_comm.NE.0)THEN
804  ! print*,'ID_sendto(j,ip)%num_border_comm',ID_sendto(j,ip)%num_border_comm
805 ! Number of nodes that need to be communicated for R_in calculation
806 
807 
808 
809 
810  icounter = icounter+1
811  pconn_comm(icounter) = j
812 
813  icounter = icounter+1
814  pconn_comm(icounter) = id_sendto(j,ip)%num_border_comm ! why plus + 1
815 
816 ! List of nodes that need to be communicated for R_in calculation
817  CALL print_comm_list(id_sendto(j,ip),ip,icounter)
818 
819  ENDIF
820  ENDDO
821 
822 
823  IF(icounter.NE.numneighprocs*2+maxnumnodescomm+1)THEN
824  print*,'ERROR in Communication Pack array'
825  stop
826  ENDIF
827 
828 
829  CALL com_new_attribute( volwin//'.pconn', 'p', com_integer, 1, '')
830  CALL com_set_size( volwin//'.pconn', ip, numneighprocs*2+maxnumnodescomm+1)
831  CALL com_set_array(volwin//'.pconn', ip, pconn_comm, 1)
832 
833 !!$ CALL COM_new_attribute( volWin//'.ID_sendto_List', 'p', COM_INTEGER, 1, '')
834 !!$ CALL COM_set_size( volWin//'.ID_sendto_List', ip, NumNeighProcs)
835 !!$ CALL COM_set_array(volWin//'.ID_sendto_List', ip, ID_sendto_List, 1)
836 !!$
837 !!$ CALL COM_new_attribute( volWin//'.NumNeighProcs_List', 'p', COM_INTEGER, 1, '')
838 !!$ CALL COM_set_size( volWin//'.NumNeighProcs_List', ip, NumNeighProcs)
839 !!$ CALL COM_set_array(volWin//'.NumNeighProcs_List', ip, NumNeighProcs_List, 1)
840 
841 
842  CALL com_window_init_done( volwin)
843 
844  ! Load Rocmap using a name "MyPrivateMAP"
845 !!$ CALL COM_load_module( "Rocmap", "MyPrivateMAP")
846 !!$
847 !!$ ! Call compute_pconn
848 !!$ comp_pconn = COM_get_function_handle( "MyPrivateMAP.compute_pconn")
849 !!$ CALL COM_call_function( comp_pconn, 2, &
850 !!$ COM_get_attribute_handle_const( volWin//'.mesh'), &
851 !!$ COM_get_attribute_handle(volWin//'.pconn'))
852 !!$
853 !!$! Unload Rocmap.
854 !!$ CALL COM_unload_module( "Rocmap", "MyPrivateMAP")
855 
856 ! obtain function handle ------------------------------------------------------
857 
858  write_attr = com_get_function_handle( 'OUT.write_attribute')
859  set_option = com_get_function_handle( 'OUT.set_option')
860 
861  CALL com_call_function( set_option, 2, 'mode', 'w')
862  ! Masoud: switching to HDF4 for this module
863  !CALL COM_call_function( set_option, 2, 'format', 'HDF4')
864  ! End
865 
866 ! do not append process rank -----------------
867 
868  CALL com_call_function( set_option, 2, 'rankwidth', '0')
869 ! write volume window ------------------------
870  vol_all = com_get_attribute_handle( volwin//'.all')
871 
872  CALL com_call_function( write_attr, 4, 'Rocin/'//prefx(1:prefx_lngth)//'.'//ichr4, vol_all,&
873  "solid","00.000000")
874 
875 ! delete volume window ----------
876 
877  CALL com_delete_window( volwin)
878 
879 
880  DEALLOCATE(meshcoor)
881 
882  IF(ASSOCIATED(nodeflag_str)) DEALLOCATE(nodeflag_str)
883  IF(ASSOCIATED(nodeflag_mm)) DEALLOCATE(nodeflag_mm)
884  IF(ASSOCIATED(nodeflag_th)) DEALLOCATE(nodeflag_th)
885 
886  IF(ASSOCIATED(bcvalue)) DEALLOCATE(bcvalue)
887 
888  DEALLOCATE(numelvolmat,numelpartbndrymat,mattype,elconntable)
889  !DEALLOCATE(NodesToCommunicate)
890  !deallocate(NumNeighProcs_List,ID_sendto_List)
891 
892  IF(ASSOCIATED(pconn_comm)) deallocate(pconn_comm)
893 
894  IF(interactmesh) CALL mesh2d(nprocs,ip,ichr4)
895 
896  print*,'mesh2dOverlay'
897  IF(overlaymesh) THEN
898  IF(ip.EQ.1) THEN
899  OPEN(456,file ='Rocin/OverlayMappings.txt')
900  ENDIF
901  CALL mesh2doverlay(nprocs,ip,ichr4)
902  print*,'Finsihed mesh2dOverlay', ip
903  ENDIF
904  ENDDO
905 
906  CLOSE(4001)
907  CLOSE(4002)
908 
909 
910 !--START
911 
912 !!$ OPEN(4001,FILE=prefx(1:prefx_lngth)//'/fracSF.im',STATUS='replace',FORM='formatted')
913 !!$ OPEN(4002,FILE=prefx(1:prefx_lngth)//'/fracS.im',STATUS='replace',FORM='formatted')
914 !!$
915 !!$ WRITE(4001,*) nprocs,MeshType2D
916 !!$ WRITE(4002,*) nprocs,MeshType2D
917 !!$
918 !!$ DO ip = 1, nprocs
919 !!$
920 !!$
921 !!$ CALL COM_new_window( volWin )
922 !!$
923 !!$
924 !!$ ! CALL RocstarInitSolution( gridLevel,iReg,regions,wins,winv )
925 !!$
926 !!$ ! CALL RocstarWriteSolution( gridLevel,iReg,regions(iReg),wins,winv )
927 !!$
928 !!$
929 !!$
930 !!$! -- Initialize link list variables
931 !!$
932 !!$ vol_list(1:NumMat)%num_border_vol = 0
933 !!$ DO i = 1, NumMat
934 !!$ NULLIFY(vol_list(i)%vol_head)
935 !!$ NULLIFY(vol_list(i)%vol_tail)
936 !!$ ENDDO
937 !!$
938 !!$ PRINT*,'Processor id =',ip
939 !!$
940 !!$ WRITE(ichr4,'(i4.4)') ip - 1
941 !!$
942 !!$! Output To Each Processors Files
943 !!$
944 !!$ OPEN(4000,FILE= &
945 !!$ prefx(1:prefx_lngth)//'/'//prefx(1:prefx_lngth)//'.'//ichr4//'.inp', &
946 !!$ STATUS='replace',FORM='formatted')
947 !!$
948 !!$! --------------------------
949 !!$! Version of ROCSTAR_DATA
950 !!$! -----------------------------------
951 !!$!
952 !!$ WRITE(4000,*) 1
953 !!$! WRITE(4000,*) 2.5
954 !!$! --------------------------
955 !!$! Nodes
956 !!$!-----------------------------------
957 !!$ WRITE(4000,*) 2
958 !!$ WRITE(4000,*) NumNdPerProc(ip),0,0,0,0
959 !!$
960 !!$! Renumber nodes locally, keep track of which node already renumbered
961 !!$ NodeFlag(:) = 0
962 !!$ ElFlag(:) = 0
963 !!$
964 !!$! go through the Processor's element link list
965 !!$
966 !!$ ptr2 => ProcElemList(ip)%head
967 !!$
968 !!$ iaux = 0
969 !!$
970 !!$ DO WHILE(ASSOCIATED(ptr2))
971 !!$
972 !!$ ielem = ptr2%GlbElNum
973 !!$
974 !!$ imat = MatId(ielem)
975 !!$ numel(imat,ip) = numel(imat,ip) + 1
976 !!$ ElOnPartBndry = .FALSE.
977 !!$ DO k = 1, ElTypeId(ielem)
978 !!$ nk = lmelv_prmry(k,ielem)
979 !!$
980 !!$ IF(NumProcPerNd(nk).GT.1) ElOnPartBndry =.TRUE.
981 !!$
982 !!$ IF(NodeFlag(nk).EQ.0)THEN
983 !!$ numnp(ip) = numnp(ip) + 1
984 !!$ WRITE(4000,'(i9,3(1x,e16.9),2i9)') numnp(ip), coor(1:3,nk),0
985 !!$ iaux = iaux + 1
986 !!$ NodeFlag(nk) = numnp(ip)
987 !!$ ENDIF
988 !!$
989 !!$
990 !!$ vol_item%mat_vol = imat
991 !!$ vol_item%lmvol(k) = NodeFlag(nk)
992 !!$
993 !!$ ENDDO
994 !!$
995 !!$ ptr2 => ptr2%next
996 !!$
997 !!$ vol_item%iface = 0
998 !!$ vol_item%press = ielem ! 0.d0
999 !!$
1000 !!$! Add item to volumetric element list
1001 !!$!
1002 !!$
1003 !!$ IF(ElOnPartBndry)THEN ! Element contains a node that is on the partition boundary
1004 !!$ CALL vol_insert_head(vol_list(imat),vol_item)
1005 !!$! icnt(imat,1) = icnt(imat,1) + 1
1006 !!$! ElFlag(ielem) = icnt(imat,1)
1007 !!$! MapGlbEl2LocEl(ip) = icnt(imat,1)
1008 !!$ ELSE
1009 !!$ CALL vol_insert_tail(vol_list(imat),vol_item)
1010 !!$! icnt(imat,2) = icnt(imat,2) + 1
1011 !!$! ElFlag(ielem) = icnt(imat,2)
1012 !!$! MapGlbEl2LocEl(ip) = icnt(imat,2)
1013 !!$ ENDIF
1014 !!$
1015 !!$ ENDDO
1016 !!$
1017 !!$ IF(iaux.NE.NumNdPerProc(ip))THEN
1018 !!$ PRINT*,'Test failed when renumbering'
1019 !!$ PRINT*,'iaux=',iaux
1020 !!$ PRINT*,'NumNdPerProc',NumNdPerProc(ip)
1021 !!$ STOP
1022 !!$ ENDIF
1023 !!$
1024 !!$! ------------------------------
1025 !!$!
1026 !!$! STRUCTURAL BOUNDARY CONDITIONS
1027 !!$! --------------------------------------------
1028 !!$
1029 !!$ WRITE(4000,*) 3
1030 !!$ WRITE(4000,*) NumBC_structural(ip),0
1031 !!$
1032 !!$
1033 !!$ ptr_BC => BC_structural_head
1034 !!$ iaux = 0
1035 !!$ DO WHILE(ASSOCIATED(ptr_BC))
1036 !!$
1037 !!$ GlbNd = ptr_BC%BC_nodeGlb
1038 !!$ iflag = ptr_BC%BC_flagGlb
1039 !!$ IF(NodeFlag(GlbNd).NE.0)THEN
1040 !!$ WRITE(4000,'(4i9)') NodeFlag(GlbNd), iflag, 0
1041 !!$ iaux = iaux + 1
1042 !!$ ENDIF
1043 !!$ ptr_BC => ptr_BC%next
1044 !!$ ENDDO
1045 !!$
1046 !!$ IF(iaux.NE.NumBC_structural(ip))THEN
1047 !!$ PRINT*,'ERROR, number of structural BCs in linked list'
1048 !!$ PRINT*,' inconsistant with that of serierial mesh'
1049 !!$ PRINT*, 'stopping'
1050 !!$ ENDIF
1051 !!$
1052 !!$! ------------------------------
1053 !!$!
1054 !!$! MESH MOTION BOUNDARY CONDITIONS
1055 !!$! --------------------------------------------
1056 !!$ WRITE(4000,*) 4
1057 !!$ WRITE(4000,*) NumBC_meshmotion(ip),0
1058 !!$
1059 !!$ ptr_BC => BC_meshmotion_head
1060 !!$ iaux = 0
1061 !!$ DO WHILE(ASSOCIATED(ptr_BC))
1062 !!$
1063 !!$ GlbNd = ptr_BC%BC_nodeGlb
1064 !!$ iflag = ptr_BC%BC_flagGlb
1065 !!$ IF(NodeFlag(GlbNd).NE.0)THEN
1066 !!$ WRITE(4000,'(4i9)') NodeFlag(GlbNd), iflag, 0
1067 !!$ iaux = iaux + 1
1068 !!$ ENDIF
1069 !!$ ptr_BC => ptr_BC%next
1070 !!$ ENDDO
1071 !!$
1072 !!$ IF(iaux.NE.NumBC_meshmotion(ip))THEN
1073 !!$ PRINT*,'ERROR, number of mesh motion BCs in linked list'
1074 !!$ PRINT*,' inconsistant with that of serierial mesh'
1075 !!$ PRINT*, 'stopping'
1076 !!$ ENDIF
1077 !!$
1078 !!$
1079 !!$! ------------------------------
1080 !!$!
1081 !!$! THERMAL BOUNDARY CONDITIONS
1082 !!$! --------------------------------------------
1083 !!$
1084 !!$ WRITE(4000,*) 8
1085 !!$ WRITE(4000,*) NumBC_thermal(ip),0
1086 !!$
1087 !!$! cycle through list, no longer is nice order as before
1088 !!$
1089 !!$ ptr_BC => BC_thermal_head
1090 !!$ iaux = 0
1091 !!$ DO WHILE(ASSOCIATED(ptr_BC))
1092 !!$
1093 !!$ GlbNd = ptr_BC%BC_nodeGlb
1094 !!$ iflag = ptr_BC%BC_flagGlb
1095 !!$ IF(NodeFlag(GlbNd).NE.0)THEN
1096 !!$ WRITE(4000,'(4i9)') NodeFlag(GlbNd), iflag, 0
1097 !!$ iaux = iaux + 1
1098 !!$ ENDIF
1099 !!$ ptr_BC => ptr_BC%next
1100 !!$ ENDDO
1101 !!$
1102 !!$ IF(iaux.NE.NumBC_thermal(ip))THEN
1103 !!$ PRINT*,'ERROR, number of thermal BCs in linked list'
1104 !!$ PRINT*,' inconsistant with that of serierial mesh'
1105 !!$ PRINT*, 'stopping'
1106 !!$ ENDIF
1107 !!$
1108 !!$
1109 !!$! ----------------------------------------------------
1110 !!$! -- WRITE VOLUMETRIC ELEMENT CONNECTIVITY ARRAY
1111 !!$! ------------------------------------------------
1112 !!$!
1113 !!$! No. of 4-node tetrahedral
1114 !!$! No. of 10-node tetrahedral
1115 !!$! No. of lst on the partioned mesh boundary
1116 !!$
1117 !!$
1118 !!$ itmp1 = SUM(numel(1:NumMat,ip))
1119 !!$ itmp2 = SUM(vol_list(1:NumMat)%num_border_vol)
1120 !!$
1121 !!$ WRITE(4000,*) 5
1122 !!$
1123 !!$ DO ii = 1, NumMat
1124 !!$
1125 !!$ WRITE(4000,'(6i9)') itmp1,itmp2,numel(ii,ip),vol_list(ii)%num_border_vol,numvertx,0
1126 !!$
1127 !!$ CALL print_vol_list(vol_list(ii),ii)
1128 !!$ ENDDO
1129 !!$
1130 !!$
1131 !!$! --------------------------------------------
1132 !!$! -- WRITE MPI COMMUNICATION INFORMATION
1133 !!$! --------------------------------------------------
1134 !!$
1135 !!$! Nodeal Force calculaton communciation
1136 !!$
1137 !!$ WRITE(4000,*) 6
1138 !!$
1139 !!$! Determine the neighbor of processors 'i' is communicating with.
1140 !!$
1141 !!$ NumNeighProcs = 0
1142 !!$ DO j = 1,nprocs
1143 !!$ IF(ID_sendto(ip,j)%num_border_comm.NE.0) &
1144 !!$ NumNeighProcs = NumNeighProcs + 1
1145 !!$ ENDDO
1146 !!$
1147 !!$! Number of neighboring proc. involved in R_in calculation
1148 !!$
1149 !!$ WRITE(4000,*) NumNeighProcs
1150 !!$
1151 !!$! List these neighboring processors
1152 !!$
1153 !!$ DO j=1,nprocs ! receiving processor
1154 !!$ IF(ID_sendto(j,ip)%num_border_comm.NE.0)THEN
1155 !!$! Number of nodes that need to be communicated for R_in calculation
1156 !!$ WRITE(4000,*) j-1,ID_sendto(j,ip)%num_border_comm ! common
1157 !!$! List of nodes that need to be communicated for R_in calculation
1158 !!$ CALL print_comm_list(ID_sendto(j,ip),ip)
1159 !!$ ENDIF
1160 !!$ ENDDO
1161 !!$
1162 !!$ WRITE(4000,*) 99
1163 !!$ CLOSE(4000)
1164 !!$
1165 !!$
1166 !!$ CALL mesh2d(nprocs,ip)
1167 !!$
1168 !!$
1169 !!$ ENDDO
1170 !!$
1171 !!$ CLOSE(4001)
1172 !!$ CLOSE(4002)
1173 
1174 END PROGRAM rocfracprep
1175 
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
Rocout::set_option
void set_option(const char *option_name, const char *option_val)
Set an option for Rocout, such as controlling the output format.
Definition: Rocout.C:552
k
j indices k indices k
Definition: Indexing.h:6
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
node
Definition: adj.h:150
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
write_attr
static void write_attr(std::ostream &os, const COM::Attribute *attr, int i)
Definition: RFC_Window_base_IO_tecplot.C:55
i
blockLoc i
Definition: read.cpp:79
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
n
const NT & n
Definition: rational_rotation.h:72
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
nk
void int int * nk
Definition: read.cpp:74
j
j indices j
Definition: Indexing.h:6
linked_list::coh_comm_info_type
Definition: SourceIMP/utilities/RocfracPrep/linked_list.f90:65
ni
void int int REAL REAL REAL *z blockDim dim * ni
Definition: read.cpp:77
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