1 subroutine itrBC (y,ac, iBC, BC, iper, ilwork) 2c 3c---------------------------------------------------------------------- 4c 5c This program satisfies the boundary conditions on the Y-variables. 6c 7c input: 8c y (nshg,nflow) : y variables 9c iBC (nshg) : Boundary Condition Code 10c BC (nshg,ndofBC) : boundary condition constraint parameters 11c 12c output: 13c y (nshg,nflow) : Adjusted V value(s) corresponding to a 14c constraint d.o.f. 15c 16c 17c Farzin Shakib, Winter 1987. 18c Zdenek Johan, Winter 1991. (Fortran 90) 19c---------------------------------------------------------------------- 20c 21 include "common.h" 22c 23 dimension y(nshg,nflow), iBC(nshg), 24 & ac(nshg,nflow), BC(nshg,ndofBC) 25 26 dimension ilwork(nlwork), iper(nshg) 27c 28c limiting...ugly but sometimes the only way 29c 30 do i=1,nflow 31 if(ylimit(1,i).gt.0) 32 & y(:,i)=min(ylimit(3,i),max(ylimit(2,i),y(:,i))) 33 enddo 34c 35c.... -------------------------> Velocity <-------------------------- 36c.... 3D 37c 38c.... x1-velocity, 3D 39c 40 where (ibits(iBC,3,3) .eq. 1) 41 y(:,1) = BC(:,3) - BC(:,4) * y(:,2) 42 & - BC(:,5) * y(:,3) 43 endwhere 44c 45c.... x2-velocity, 3D 46c 47 where (ibits(iBC,3,3) .eq. 2) 48 y(:,2) = BC(:,3) - BC(:,4) * y(:,1) 49 & - BC(:,5) * y(:,3) 50 endwhere 51c 52c.... x1-velocity and x2-velocity, 3D 53c 54 where (ibits(iBC,3,3) .eq. 3) 55 y(:,1) = BC(:,3) - BC(:,4) * y(:,3) 56 y(:,2) = BC(:,5) - BC(:,6) * y(:,3) 57 endwhere 58c 59c.... x3-velocity, 3D 60c 61 where (ibits(iBC,3,3) .eq. 4) 62 y(:,3) = BC(:,3) - BC(:,4) * y(:,1) 63 & - BC(:,5) * y(:,2) 64 endwhere 65c 66c.... x1-velocity and x3-velocity, 3D 67c 68 where (ibits(iBC,3,3) .eq. 5) 69 y(:,1) = BC(:,3) - BC(:,4) * y(:,2) 70 y(:,3) = BC(:,5) - BC(:,6) * y(:,2) 71 endwhere 72c 73c.... x2-velocity and x3-velocity, 3D 74c 75 where (ibits(iBC,3,3) .eq. 6) 76 y(:,2) = BC(:,3) - BC(:,4) * y(:,1) 77 y(:,3) = BC(:,5) - BC(:,6) * y(:,1) 78 endwhere 79c 80c.... x1-velocity, x2-velocity and x3-velocity, 3D 81c 82 where (ibits(iBC,3,3) .eq. 7) 83 y(:,1) = BC(:,3) 84 y(:,2) = BC(:,4) 85 y(:,3) = BC(:,5) 86 endwhere 87c 88c endif 89c 90c.... end of velocity 91c 92c.... -------------------------> Pressure <-------------------------- 93c 94 if (any(btest(iBC,2))) then 95c 96c.... pressure 97c 98 where (btest(iBC,2)) 99 y(:,4) = BC(:,1) ! pressure here 100 endwhere 101c 102 endif 103c 104c.... local periodic (and axisymmetric) boundary conditions (no communications) 105c 106 do i = 1,nflow 107 y(:,i) = y(iper(:),i) 108 ac(:,i) = ac(iper(:),i) 109 enddo 110c 111c.... communications 112c 113 if (numpe > 1) then 114 call commu (y, ilwork, nflow, 'out') 115 call commu (ac, ilwork, nflow, 'out') 116 endif 117c 118c slave has masters value, for abc we need to rotate it 119c 120 if(iabc==1) then !are there any axisym bc's 121 call rotabc(y, iBC, 'out') 122 call rotabc(ac, iBC, 'out') 123 endif 124 125c 126c.... return 127c 128 return 129 end 130 131 132 subroutine itrBCSclr (y, ac, iBC, BC, iper, ilwork) 133c 134c---------------------------------------------------------------------- 135c 136c This routine satisfies the boundary conditions on the isclr 137c 138c---------------------------------------------------------------------- 139c 140 include "common.h" 141c 142 dimension y(nshg,ndof), iBC(nshg), 143 & ac(nshg,ndof), BC(nshg,ndofBC) 144 145 dimension ilwork(nlwork), iper(nshg) 146 dimension T(nshg) 147 148 if(isclr.eq.0) then ! this is temperature 149 ib=1 150 ibb=2 151 id=5 152 else 153 ib=5+isclr 154 ibb=ib+1 155 id=ib 156 endif 157c 158c limiting...ugly but sometimes the only way 159c 160 if(ylimit(1,id).gt.0) 161 & y(:,id)=min(ylimit(3,id),max(ylimit(2,id),y(:,id))) 162c 163c 164c.... ------------------------> Scalar <------------------------ 165c 166c 167 where (btest(iBC,ib)) 168 y(:,id) = BC(:,ibb) 169 endwhere 170c 171c.... local periodic (and axisymmetric) boundary conditions (no communications) 172c 173 do i = 1,nshg 174 y(i,id) = y(iper(i),id) 175 ac(i,id) = ac(iper(i),id) 176 enddo 177c 178c.... communications 179c 180 if (numpe > 1) then 181 T=y(:,id) 182 call commu (T, ilwork, 1, 'out') 183 y(:,id)=T 184 T=ac(:,id) 185 call commu (T, ilwork, 1, 'out') 186 ac(:,id)=T 187 endif 188 189 return 190 end 191 192