1 subroutine geniBC (iBC) 2c 3c---------------------------------------------------------------------- 4c This routine reads the boundary condition codes. 5c 6c output: 7c iBC (nshg) : Boundary Condition code 8c 9c = 1 * iBC_1 + 2 * iBC_2 + 4 * iBC_3 10c density temperature pressure 11c 12c if nsd = 3: 13c 14c + 8 * iBC_4 + 16 * iBC_5 + 32 * iBC_6 15c x1-velocity x2-velocity x3-velocity 16c 17c + 64 * iBC_7 + 128 * iBC_8 + 256 * iBC_9 + 512 * iBC_10 18c sclr1 sclr2 sclr3 sclr4 19c 20c + 1024 * iBC_11 + 2048* iBC_12 + 4096* iBC_13 + 8192* iBC_14 21c perioidicity spebc axisym deformwall 22c 23c nBC (nshg) : Boundary Condition mapping array 24c 25c 26c Farzin Shakib, Winter 1986. 27c Zdenek Johan, Winter 1991. (Fortran 90) 28c---------------------------------------------------------------------- 29c 30c 31 use readarrays ! used to access iBCtmp 32 use pointer_data 33 include "common.h" 34c 35c Arrays in the following 1 line are now dimensioned in readnblk 36c dimension iBCtmp(numpbc) 37c 38 dimension iBC(nshg) 39 dimension itemp(6) 40 integer, allocatable :: iBCpart(:) 41c 42c.... set the iBC array 43c 44 iBC = 0 45c 46 if(numpbc.eq.0) goto 9999 ! sometimes there are no BC's on a partition 47 where (nBC(:) .ne. 0) iBC(:) = iBCtmp(nBC(:)) 48c 49c.... echo the input iBC array only if other than zero 50c 51 if (necho .lt. 3) then 52 nn = 0 53 do n = 1, nshg 54 if (nBC(n) .ne. 0) then 55 nb = nBC(n) 56 nn = nn + 1 57 if (mod(nn,50).eq.1) write(iecho,1000)ititle,(j,j=1,ndof) 58 itemp( 1) = mod(iBCtmp(nb) ,2) - mod(iBCtmp(nb)/ 4,2) 59 itemp( 2) = mod(iBCtmp(nb)/ 8,2) 60 itemp( 3) = mod(iBCtmp(nb)/16,2) 61 itemp( 4) = mod(iBCtmp(nb)/32,2) 62 itemp(ndof) = mod(iBCtmp(nb)/ 2,2) 63 write(iecho,1100) n,(itemp(i),i=1,ndof) 64 endif 65 enddo 66 endif 67 deallocate(iBCtmp) 68 69c 70c.... for deformable wall case update iBC from iBCB information 71c 72 739999 if(ideformwall.eq.1) then 74 allocate (iBCpart(nshg)) 75 iBCpart = 0 76 do iblk = 1, nelblb 77 iel = lcblkb(1,iblk) 78 iorder = lcblkb(4,iblk) 79 nenl = lcblkb(5,iblk) ! no. of vertices per element 80 nenbl = lcblkb(6,iblk) ! no. of vertices per bdry. face 81 nshl = lcblkb(9,iblk) 82 nshlb = lcblkb(10,iblk) 83 npro = lcblkb(1,iblk+1) - iel 84 call iBCupdate(iBCpart, mienb(iblk)%p, miBCB(iblk)%p) 85 enddo 86 iBC = iBC + iBCpart 87 deallocate(iBCpart) 88 endif 89 90 91 92c 93c.... return 94c 95 return 96c 97c.... end of file error handling 98c 99999 call error ('geniBC ','end file',ibndc) 100c 1011000 format(a80,//, 102 & ' N o d a l B o u n d a r y C o n d i t i o n C o d e',//, 103 & ' Node ',13x,6('dof',i1,:,6x)) 1041100 format(2x,i5,10x,5i10) 105c 106 end 107