1 subroutine genblkPosix (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 nelblk=0 37 mattyp = 0 38 ndofl = ndof 39 nsymdl = nsymdf 40 do iblk = 1, itpblk 41 write (fname2,"('connectivity interior?')") 42 call phio_readheader(fhandle, fname2 // char(0), 43 & c_loc(intfromfile), iseven, dataInt, iotype) 44 neltp =intfromfile(1) 45 nenl =intfromfile(2) 46 ipordl =intfromfile(3) 47 nshl =intfromfile(4) 48 ijunk =intfromfile(5) 49 ijunk =intfromfile(6) 50 lcsyst =intfromfile(7) 51 allocate (ientp(neltp,nshl)) 52 iientpsiz=neltp*nshl 53 call phio_readdatablock(fhandle,fname2 // char(0), 54 & c_loc(ientp), iientpsiz, dataInt, iotype) 55 56 do n=1,neltp,ibksz 57 58 nelblk=nelblk+1 59 npro= min(IBKSZ, neltp - n + 1) 60c 61 lcblk(1,nelblk) = iel 62c lcblk(2,nelblk) = iopen ! available for later use 63 lcblk(3,nelblk) = lcsyst 64 lcblk(4,nelblk) = ipordl 65 lcblk(5,nelblk) = nenl 66 lcblk(6,nelblk) = nfacel 67 lcblk(7,nelblk) = mattyp 68 lcblk(8,nelblk) = ndofl 69 lcblk(9,nelblk) = nsymdl 70 lcblk(10,nelblk) = nshl ! # of shape functions per elt 71c 72c.... allocate memory for stack arrays 73c 74 allocate (mmat(nelblk)%p(npro)) 75c 76 allocate (mien(nelblk)%p(npro,nshl)) 77 allocate (mxmudmi(nelblk)%p(npro,maxsh)) 78 if(usingpetsc.eq.0) then 79 allocate (mienG(nelblk)%p(1,1)) 80 else 81 allocate (mienG(nelblk)%p(npro,nshl)) 82 endif 83 ! note mienG will be passed to gensav but nothing filled if not 84 ! using PETSc so this is safe 85c 86c.... save the element block 87c 88 n1=n 89 n2=n+npro-1 90 mater=1 ! all one material for now 91 call gensav (ientp(n1:n2,1:nshl), 92 & mater, mien(nelblk)%p, 93 & mienG(nelblk)%p, 94 & mmat(nelblk)%p) 95 iel=iel+npro 96 enddo 97 deallocate(ientp) 98 enddo 99 lcblk(1,nelblk+1) = iel 100c 101c.... return 102c 103 104 return 105c 1061000 format(a80,//, 107 & ' N o d a l C o n n e c t i v i t y',//, 108 & ' Elem ',/, 109 & ' Number ',7x,27('Node',i2,:,2x)) 1101100 format(2x,i5,6x,27i8) 111 end 112