1 subroutine genbkbPosix (ibksz) 2c 3c---------------------------------------------------------------------- 4c 5c This routine reads the boundary elements, reorders them and 6c generates traces for the gather/scatter operations. 7c 8c Zdenek Johan, Fall 1991. 9c---------------------------------------------------------------------- 10c 11 use dtnmod 12 use pointer_data 13 use phio 14 use iso_c_binding 15 include "common.h" 16 include "mpif.h" !Required to determine the max for itpblk 17 18 integer, target, allocatable :: ientp(:,:),iBCBtp(:,:) 19 real*8, target, allocatable :: BCBtp(:,:) 20 integer materb(ibksz) 21 integer, target :: intfromfile(50) ! integers read from headers 22 character*255 fname1 23 integer :: descriptor, descriptorG, GPID, color, nfields 24 integer :: numparts, nppp, nprocs, writeLock 25 integer :: ierr_io, numprocs, itmp, itmp2 26 integer, target :: itpblktot,ierr 27 character*255 fname2 28 character(len=30) :: dataInt, dataDbl 29 dataInt = c_char_'integer'//c_null_char 30 dataDbl = c_char_'double'//c_null_char 31 32 nfields = nsynciofieldsreadgeombc 33 numparts = numpe !This is the common settings. Beware if you try to compute several parts per process 34 nppp = numparts/numpe 35 ione=1 36 itwo=2 37 ieight=8 38 ieleven=11 39 itmp = int(log10(float(myrank+1)))+1 40 iel=1 41 itpblk=nelblb 42 nelblb=0 43 mattyp=0 44 ndofl = ndof 45 do iblk = 1, itpblk 46 write (fname2,"('connectivity boundary?')") 47 call phio_readheader(fhandle, fname2 // char(0), 48 & c_loc(intfromfile), ieight, dataInt, iotype) 49 neltp =intfromfile(1) 50 nenl =intfromfile(2) 51 ipordl=intfromfile(3) 52 nshl =intfromfile(4) 53 nshlb =intfromfile(5) 54 nenbl =intfromfile(6) 55 lcsyst=intfromfile(7) 56 numnbc=intfromfile(8) 57 58 allocate (ientp(neltp,nshl)) 59 allocate (iBCBtp(neltp,ndiBCB)) 60 allocate (BCBtp(neltp,ndBCB)) 61 iientpsiz=neltp*nshl 62 63 64 call phio_readdatablock(fhandle, fname2 // char(0), 65 & c_loc(ientp),iientpsiz,dataInt,iotype) 66c 67c.... Read the boundary flux codes 68c 69 70 write (fname2,"('nbc codes?')") 71 72 call phio_readheader(fhandle, fname2 // char(0), 73 & c_loc(intfromfile), ieight, dataInt, iotype) 74 iiBCBtpsiz=neltp*ndiBCB 75 call phio_readdatablock(fhandle, fname2 // char(0), 76 & c_loc(iBCBtp),iiBCBtpsiz,dataInt,iotype) 77c 78c.... read the boundary condition data 79c 80 write (fname2,"('nbc values?')") 81 82 call phio_readheader(fhandle, fname2 // char(0), 83 & c_loc(intfromfile), ieight, dataInt, iotype) 84 BCBtp = zero 85 iBCBtpsiz=neltp*ndBCB 86 call phio_readdatablock(fhandle, fname2 // char(0), 87 & c_loc(BCBtp),iBCBtpsiz,dataDbl,iotype) 88c 89c This is a temporary fix until NSpre properly zeros this array where it 90c is not set. DEC has indigestion with these arrays though the 91c result is never used (never effects solution). 92c 93 94 where(.not.btest(iBCBtp(:,1),0)) BCBtp(:,1)=zero 95 where(.not.btest(iBCBtp(:,1),1)) BCBtp(:,2)=zero 96 where(.not.btest(iBCBtp(:,1),3)) BCBtp(:,6)=zero 97 if(ndBCB.gt.6) then 98 do i=6,ndof 99 where(.not.btest(iBCBtp(:,1),i-1)) BCBtp(:,i+1)=zero 100 enddo 101 endif 102 where(.not.btest(iBCBtp(:,1),2)) 103 BCBtp(:,3)=zero 104 BCBtp(:,4)=zero 105 BCBtp(:,5)=zero 106 endwhere 107 108 109 do n=1,neltp,ibksz 110 nelblb=nelblb+1 111 npro= min(IBKSZ, neltp - n + 1) 112c 113 lcblkb(1,nelblb) = iel 114c lcblkb(2,nelblb) = iopen ! available for later use 115 lcblkb(3,nelblb) = lcsyst 116 lcblkb(4,nelblb) = ipordl 117 lcblkb(5,nelblb) = nenl 118 lcblkb(6,nelblb) = nenbl 119 lcblkb(7,nelblb) = mattyp 120 lcblkb(8,nelblb) = ndofl 121 lcblkb(9,nelblb) = nshl 122 lcblkb(10,nelblb) = nshlb ! # of shape functions per elt 123c 124c.... save the element block 125c 126 n1=n 127 n2=n+npro-1 128 materb=1 ! all one material for now 129c 130c.... allocate memory for stack arrays 131c 132 133 allocate (mienb(nelblb)%p(npro,nshl)) 134 allocate (miBCB(nelblb)%p(npro,ndiBCB)) 135 allocate (mBCB(nelblb)%p(npro,nshlb,ndBCB)) 136 allocate (mmatb(nelblb)%p(npro)) 137c 138c.... save the boundary element block 139c 140 call gensvb (ientp(n1:n2,1:nshl), 141 & iBCBtp(n1:n2,:), BCBtp(n1:n2,:), 142 & materb, mienb(nelblb)%p, 143 & miBCB(nelblb)%p, mBCB(nelblb)%p, 144 & mmatb(nelblb)%p) 145c 146 iel=iel+npro 147 enddo 148 deallocate(ientp) 149 deallocate(iBCBtp) 150 deallocate(BCBtp) 151 enddo 152 lcblkb(1,nelblb+1) = iel 153 154c 155c.... return 156c 157 return 158c 159c.... end of file error handling 160c 161 911 call error ('genbcb ','end file',igeom) 162c 1631000 format(a80,//, 164 & ' B o u n d a r y E l e m e n t C o n n e c t i v i t y',//, 165 & ' Elem BC codes',/, 166 & ' Number C P V H ',5x,27('Node',i1,:,2x)) 1671100 format(2x,i5,2x,4i2,3x,27i7) 168c$$$2000 format(a80,//, 169c$$$ & ' B o u n d a r y E l e m e n t B C D a t a ',//, 170c$$$ & ' Node ',3x,'mass',/, 171c$$$ & ' Number ',3x,'flux',6x,'Pressure',6x,'Heat',6x, 172c$$$ & 3('Viscous',i1,:,4x)) 1732100 format(2x,i5,1p,1x,6e12.4) 174c 175 end 176 177 178 179 180