1 subroutine genblk (IBKSZ) 2c 3c---------------------------------------------------------------------- 4c 5c This routine reads the interior elements and generates the 6c appropriate blocks. 7c 8c Zdenek Johan, Fall 1991. 9c---------------------------------------------------------------------- 10c 11 use pointer_data 12 use phio 13 use iso_c_binding 14 include "common.h" 15 include "mpif.h" !Required to determine the max for itpblk 16 17 integer, target, allocatable :: ientp(:,:) 18 integer mater(ibksz) 19 integer, target :: intfromfile(50) ! integers read from headers 20 character*255 fname1 21 integer :: descriptor, descriptorG, GPID, color 22 integer :: numparts, writeLock 23 integer :: ierr_io, numprocs 24 integer, target :: itpblktot,ierr,iseven 25 character*255 fname2 26 character(len=30) :: dataInt 27 dataInt = c_char_'integer'//c_null_char 28 numparts = numpe !This is the common settings. Beware if you try to compute several parts per process 29 ione=1 30 itwo=2 31 iseven=7 32 ieleven=11 33 iel=1 34 itpblk=nelblk 35 36 ! Get the total number of different interior topologies in the whole domain. 37 ! Try to read from a field. If the field does not exist, scan the geombc file. 38 itpblktot=1 ! hardwired to montopology for now 39 call phio_readheader(fhandle, 40 & c_char_'total number of interior tpblocks' // char(0), 41 & c_loc(itpblktot), ione, dataInt, iotype) 42 43 if (itpblktot == -1) then 44 ! The field 'total number of different interior tpblocks' was not found in the geombc file. 45 ! Scan all the geombc file for the 'connectivity interior' fields to get this information. 46 iblk=0 47 neltp=0 48 do while(neltp .ne. -1) 49 50 ! intfromfile is reinitialized to -1 every time. 51 ! If connectivity interior@xxx is not found, then 52 ! readheader will return intfromfile unchanged 53 54 intfromfile(:)=-1 55 iblk = iblk+1 56 if(input_mode.ge.1) then 57 write (fname2,"('connectivity interior',i1)") iblk 58 else 59 write (fname2,"('connectivity interior linear tetrahedron')") 60 endif 61 62 !write(*,*) 'rank, fname2',myrank, trim(adjustl(fname2)) 63 call phio_readheader(fhandle, fname2 // char(0), 64 & c_loc(intfromfile), iseven, dataInt, iotype) 65 neltp = intfromfile(1) ! -1 if fname2 was not found, >=0 otherwise 66 end do 67 itpblktot = iblk-1 68 end if 69 70 if (myrank == 0) then 71 write(*,*) 'Number of interior topologies: ',itpblktot 72 endif 73 74 nelblk=0 75 mattyp = 0 76 ndofl = ndof 77 nsymdl = nsymdf 78 79 do iblk = 1, itpblktot 80 writeLock=0; 81 if(input_mode.ge.1) then 82 write (fname2,"('connectivity interior',i1)") iblk 83 else 84 write (fname2,"('connectivity interior linear tetrahedron')") 85 endif 86 87 ! Synchronization for performance monitoring, as some parts do not include some topologies 88 call MPI_Barrier(MPI_COMM_WORLD,ierr) 89 call phio_readheader(fhandle, fname2 // char(0), 90 & c_loc(intfromfile), iseven, dataInt, iotype) 91 neltp =intfromfile(1) 92 nenl =intfromfile(2) 93 ipordl =intfromfile(3) 94 nshl =intfromfile(4) 95 ijunk =intfromfile(5) 96 ijunk =intfromfile(6) 97 lcsyst =intfromfile(7) 98 allocate (ientp(neltp,nshl)) 99 iientpsiz=neltp*nshl 100 101 if (neltp==0) then 102 writeLock=1; 103 endif 104 105 call phio_readdatablock(fhandle,fname2 // char(0), 106 & c_loc(ientp), iientpsiz, dataInt, iotype) 107 108 if(writeLock==0) then 109 do n=1,neltp,ibksz 110 nelblk=nelblk+1 111 npro= min(IBKSZ, neltp - n + 1) 112 lcblk(1,nelblk) = iel 113 lcblk(3,nelblk) = lcsyst 114 lcblk(4,nelblk) = ipordl 115 lcblk(5,nelblk) = nenl 116 lcblk(6,nelblk) = nfacel 117 lcblk(7,nelblk) = mattyp 118 lcblk(8,nelblk) = ndofl 119 lcblk(9,nelblk) = nsymdl 120 lcblk(10,nelblk) = nshl ! # of shape functions per elt 121c 122c.... allocate memory for stack arrays 123c 124 allocate (mmat(nelblk)%p(npro)) 125c 126 allocate (mien(nelblk)%p(npro,nshl)) 127 allocate (mxmudmi(nelblk)%p(npro,maxsh)) 128c 129c.... save the element block 130c 131 n1=n 132 n2=n+npro-1 133 mater=1 ! all one material for now 134 call gensav (ientp(n1:n2,1:nshl), 135 & mater, mien(nelblk)%p, 136 & mmat(nelblk)%p) 137 iel=iel+npro 138 enddo 139 endif 140 deallocate(ientp) 141 enddo 142 143 lcblk(1,nelblk+1) = iel 144 return 1451000 format(a80,//, 146 & ' N o d a l C o n n e c t i v i t y',//, 147 & ' Elem ',/, 148 & ' Number ',7x,27('Node',i2,:,2x)) 1491100 format(2x,i5,6x,27i8) 150 end 151