1 subroutine bc3Diag (iBC, BC, res) 2c 3c---------------------------------------------------------------------- 4c 5c This routine satisfies the BC of the diagonal vector for 3D elements. 6c 7c input: 8c iBC (nshg) : Boundary Condition Code 9c BC (nshg,ndofBC) : the boundary condition constraint parameters 10c res (nshg,nflow) : residual before BC is applied 11c 12c output: 13c res (nshg,nflow) : residual after satisfaction of BC 14c 15c 16c Thuc Bui, Winter 1989. 17c Zdenek Johan, Winter 1991. (Fortran 90) 18c---------------------------------------------------------------------- 19c 20 include "common.h" 21c 22 dimension iBC(nshg), BC(nshg,ndofBC), 23 & res(nshg,4) 24c 25c.... pressure 26c 27 where (btest(iBC,2)) 28 res(:,4) = zero 29 endwhere 30c 31c.... velocities 32c 33c ibits(n1,n2,n3) extracts bits n2+1 through n2+n3 (extending to the left 34c as is traditional in binary) of the integer n1 35c and returns the base 10 integer. In examples below x y z a b can 36c be 1 or zero without any effect. 37c 38c.... x1-velocity 39c 40c if iBC=4 bits of ibc =00000100 => ibits(4,3,3)=0 41c if iBC=40 bits of ibc =00101000 => ibits(4,3,3)=5 42c if iBC=40 bits of ibc =00101000 => ibits(4,3,2)=1 43c 44 where (ibits(iBC,3,3) .eq. 1) ! bits of iBC= xy001zab 45c 46c notice that the extracted 3 bits form the number 1. below 47c you will see the combinations which make up 2-7, all of the 48c possible velocity combinations 49c 50 res(:,2) = res(:,2) - BC(:,4) * res(:,1) 51 res(:,3) = res(:,3) - BC(:,5) * res(:,1) 52 res(:,1) = zero 53 endwhere 54c 55c.... x2-velocity 56c 57 where (ibits(iBC,3,3) .eq. 2) ! bits of iBC= xy010zab 58 res(:,1) = res(:,1) - BC(:,4) * res(:,2) 59 res(:,3) = res(:,3) - BC(:,5) * res(:,2) 60 res(:,2) = zero 61 endwhere 62c 63c.... x1-velocity and x2-velocity 64c 65 where (ibits(iBC,3,3) .eq. 3) ! bits of iBC= xy011zab 66 res(:,3) = res(:,3) - BC(:,4) * res(:,1) - BC(:,6) * res(:,2) 67 res(:,1) = zero 68 res(:,2) = zero 69 endwhere 70c 71c.... x3-velocity 72c 73 where (ibits(iBC,3,3) .eq. 4) ! bits of iBC= xy100zab 74 res(:,1) = res(:,1) - BC(:,4) * res(:,3) 75 res(:,2) = res(:,2) - BC(:,5) * res(:,3) 76 res(:,3) = zero 77 endwhere 78c 79c.... x1-velocity and x3-velocity 80c 81 where (ibits(iBC,3,3) .eq. 5) ! bits of iBC= xy101zab 82 res(:,2) = res(:,2) - BC(:,4) * res(:,1) - BC(:,6) * res(:,3) 83 res(:,1) = zero 84 res(:,3) = zero 85 endwhere 86c 87c.... x2-velocity and x3-velocity 88c 89 where (ibits(iBC,3,3) .eq. 6) ! bits of iBC= xy110zab 90 res(:,1) = res(:,1) - BC(:,4) * res(:,2) - BC(:,6) * res(:,3) 91 res(:,2) = zero 92 res(:,3) = zero 93 endwhere 94c 95c.... x1-velocity, x2-velocity and x3-velocity 96c 97 where (ibits(iBC,3,3) .eq. 7) ! bits of iBC= xy111zab 98 res(:,1) = zero 99 res(:,2) = zero 100 res(:,3) = zero 101 endwhere 102c 103c.... scaled plane extraction boundary condition 104c 105 if(intpres.eq.1) then ! interpolating pressure so zero continuity res 106 where (btest(iBC,11)) 107 res(:,1) = zero 108 res(:,2) = zero 109 res(:,3) = zero 110 res(:,4) = zero 111 endwhere 112 else ! leave residual in continuity equation 113 where (btest(iBC,11)) 114 res(:,1) = zero 115 res(:,2) = zero 116 res(:,3) = zero 117 endwhere 118 endif 119 120c.... return 121c 122 return 123 end 124 125 126 subroutine bc3SclrDiag (iBC, res) 127c 128c---------------------------------------------------------------------- 129c 130c This routine satisfies the BC of the diagonal vector for 3D elements. 131c 132c input: 133c iBC (nshg) : Boundary Condition Code 134c BC (nshg,ndofBC) : the boundary condition constraint parameters 135c res (nshg) : residual before BC is applied 136c 137c output: 138c res (nshg) : residual after satisfaction of BC 139c 140c 141c Thuc Bui, Winter 1989. 142c Zdenek Johan, Winter 1991. (Fortran 90) 143c---------------------------------------------------------------------- 144c 145 include "common.h" 146c 147 dimension iBC(nshg), BC(nshg,ndofBC), 148 & res(nshg) 149 150 if(isclr.eq.0) then 151c 152c.... temperature 153c 154 where (btest(iBC,1)) 155 res = zero 156 endwhere 157 else 158c 159c.... scalar 160c 161 ib=5+isclr 162 where (btest(iBC,ib)) 163 res = zero 164 endwhere 165 endif 166c 167c.... return 168c 169 return 170 end 171