1 subroutine genbkb (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 13c 14 include "common.h" 15c 16 17 integer, allocatable :: ientp(:,:),iBCBtp(:,:) 18 real*8, allocatable :: BCBtp(:,:) 19 integer materb(ibksz) 20 integer intfromfile(50) ! integers read from headers 21 character*255 fname1 22 iel=1 23 itpblk=nelblb 24 nelblb=0 25 mattyp=0 26 ndofl = ndof 27 do iblk = 1, itpblk 28 ieight=8 29 fname1='connectivity boundary?' 30 call readheader(igeom,fname1,intfromfile,ieight, 31 & 'integer',iotype) 32 neltp =intfromfile(1) 33 nenl =intfromfile(2) 34 ipordl=intfromfile(3) 35 nshl =intfromfile(4) 36 nshlb =intfromfile(5) 37 nenbl =intfromfile(6) 38 lcsyst=intfromfile(7) 39 numnbc=intfromfile(8) 40c 41 allocate (ientp(neltp,nshl)) 42 allocate (iBCBtp(neltp,ndiBCB)) 43 allocate (BCBtp(neltp,ndBCB)) 44 iientpsiz=neltp*nshl 45 call readdatablock(igeom,fname1,ientp,iientpsiz, 46 & 'integer',iotype) 47c 48c.... Read the boundary flux codes 49c 50 fname1='nbc codes?' 51 call readheader(igeom,fname1,intfromfile,ieight, 52 & 'integer',iotype) 53 iiBCBtpsiz=neltp*ndiBCB 54 call readdatablock(igeom,fname1,iBCBtp,iiBCBtpsiz, 55 & 'integer',iotype) 56c 57c.... read the boundary condition data 58c 59 fname1='nbc values?' 60 call readheader(igeom,fname1,intfromfile,ieight, 61 & 'integer',iotype) 62 BCBtp = zero 63 iBCBtpsiz=neltp*ndBCB 64 call readdatablock(igeom,fname1,BCBtp,iBCBtpsiz, 65 & 'double',iotype) 66c 67c This is a temporary fix until NSpre properly zeros this array where it 68c is not set. DEC has indigestion with these arrays though the 69c result is never used (never effects solution). 70c 71 72 where(.not.btest(iBCBtp(:,1),0)) BCBtp(:,1)=zero 73 where(.not.btest(iBCBtp(:,1),1)) BCBtp(:,2)=zero 74 where(.not.btest(iBCBtp(:,1),3)) BCBtp(:,6)=zero 75 if(ndBCB.gt.6) then 76 do i=6,ndof 77 where(.not.btest(iBCBtp(:,1),i-1)) BCBtp(:,i+1)=zero 78 enddo 79 endif 80 where(.not.btest(iBCBtp(:,1),2)) 81 BCBtp(:,3)=zero 82 BCBtp(:,4)=zero 83 BCBtp(:,5)=zero 84 endwhere 85 86 87 do n=1,neltp,ibksz 88 nelblb=nelblb+1 89 npro= min(IBKSZ, neltp - n + 1) 90c 91 lcblkb(1,nelblb) = iel 92c lcblkb(2,nelblb) = iopen ! available for later use 93 lcblkb(3,nelblb) = lcsyst 94 lcblkb(4,nelblb) = ipordl 95 lcblkb(5,nelblb) = nenl 96 lcblkb(6,nelblb) = nenbl 97 lcblkb(7,nelblb) = mattyp 98 lcblkb(8,nelblb) = ndofl 99 lcblkb(9,nelblb) = nshl 100 lcblkb(10,nelblb) = nshlb ! # of shape functions per elt 101c 102c.... save the element block 103c 104 n1=n 105 n2=n+npro-1 106 materb=1 ! all one material for now 107c 108c.... allocate memory for stack arrays 109c 110 111 allocate (mienb(nelblb)%p(npro,nshl)) 112c 113 allocate (miBCB(nelblb)%p(npro,ndiBCB)) 114c 115 allocate (mBCB(nelblb)%p(npro,nshlb,ndBCB)) 116c 117 allocate (mmatb(nelblb)%p(npro)) 118c 119c.... save the boundary element block 120c 121 call gensvb (ientp(n1:n2,1:nshl), 122 & iBCBtp(n1:n2,:), BCBtp(n1:n2,:), 123 & materb, mienb(nelblb)%p, 124 & miBCB(nelblb)%p, mBCB(nelblb)%p, 125 & mmatb(nelblb)%p) 126c 127 iel=iel+npro 128 enddo 129 deallocate(ientp) 130 deallocate(iBCBtp) 131 deallocate(BCBtp) 132 enddo 133 lcblkb(1,nelblb+1) = iel 134 135c 136c.... return 137c 138 return 139c 140c.... end of file error handling 141c 142 911 call error ('genbcb ','end file',igeom) 143c 1441000 format(a80,//, 145 & ' 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',//, 146 & ' Elem BC codes',/, 147 & ' Number C P V H ',5x,27('Node',i1,:,2x)) 1481100 format(2x,i5,2x,4i2,3x,27i7) 149c$$$2000 format(a80,//, 150c$$$ & ' B o u n d a r y E l e m e n t B C D a t a ',//, 151c$$$ & ' Node ',3x,'mass',/, 152c$$$ & ' Number ',3x,'flux',6x,'Pressure',6x,'Heat',6x, 153c$$$ & 3('Viscous',i1,:,4x)) 1542100 format(2x,i5,1p,1x,6e12.4) 155c 156 end 157 158 159 160 161