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 68c 69c.... for deformable wall case update iBC from iBCB information 70c 71 729999 if(ideformwall.eq.1) then 73 allocate (iBCpart(nshg)) 74 iBCpart = 0 75 do iblk = 1, nelblb 76 iel = lcblkb(1,iblk) 77 iorder = lcblkb(4,iblk) 78 nenl = lcblkb(5,iblk) ! no. of vertices per element 79 nenbl = lcblkb(6,iblk) ! no. of vertices per bdry. face 80 nshl = lcblkb(9,iblk) 81 nshlb = lcblkb(10,iblk) 82 npro = lcblkb(1,iblk+1) - iel 83 call iBCupdate(iBCpart, mienb(iblk)%p, miBCB(iblk)%p) 84 enddo 85 iBC = iBC + iBCpart 86 deallocate(iBCpart) 87 endif 88 89 deallocate(iBCtmp) 90 91 92 93c 94c.... return 95c 96 return 97c 98c.... end of file error handling 99c 100999 call error ('geniBC ','end file',ibndc) 101c 1021000 format(a80,//, 103 & ' 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',//, 104 & ' Node ',13x,6('dof',i1,:,6x)) 1051100 format(2x,i5,10x,5i10) 106c 107 end 108