copyright (C) 2001 MSC-RPN COMM %%%MC2%%% *subroutine mirror 1 implicit none * #include "dynmem.cdk"
* integer i,j,k,n,iin,jin * *---------------------------------------------------------------------- * if (north+south+east+west.eq.0) return * if(north.eq.1) then do k=1,gnk do i=1-hx,ldni+hx vvp(i,ldnj,k) = 0. enddo do j=1,hy * n.b. when ldnj-1<hy, we are in trouble unless in 2-dim. symmetry jin=max(ldnj-j,1) do i=1-hx,ldni+hx vvp(i,ldnj +j,k) = - vvp(i,jin,k) uup(i,ldnj-1+j,k) = uup(i,jin,k) bbp(i,ldnj-1+j,k) = bbp(i,jin,k) ppp(i,ldnj-1+j,k) = ppp(i,jin,k) wwp(i,ldnj-1+j,k) = wwp(i,jin,k) hup(i,ldnj-1+j,k) = hup(i,jin,k) do n = 1, ntr trp(i,ldnj-1+j,k,n) = trp(i,jin,k,n) enddo enddo enddo enddo endif * if(south.eq.1) then do k=1,gnk do i=1-hx,ldni+hx vvp(i,1,k) = 0. enddo do j=1,hy do i=1-hx,ldni+hx vvp(i,1-j,k) = - vvp(i,1+j,k) uup(i,1-j,k) = uup(i, j,k) bbp(i,1-j,k) = bbp(i, j,k) ppp(i,1-j,k) = ppp(i, j,k) wwp(i,1-j,k) = wwp(i, j,k) hup(i,1-j,k) = hup(i, j,k) do n = 1, ntr trp(i,1-j,k,n) = trp(i, j,k,n) enddo enddo enddo enddo endif * if(east.eq.1) then do k=1,gnk do j=1-hy,ldnj+hy uup(ldni,j,k) = 0. enddo do i=1,hx iin=max(ldni-i,1) * n.b. when ldni-1<hx, we are in trouble unless in 2-dim. symmetry do j=1-hy,ldnj+hy uup(ldni +i,j,k) = - uup(iin,j,k) vvp(ldni-1+i,j,k) = vvp(iin,j,k) bbp(ldni-1+i,j,k) = bbp(iin,j,k) ppp(ldni-1+i,j,k) = ppp(iin,j,k) wwp(ldni-1+i,j,k) = wwp(iin,j,k) hup(ldni-1+i,j,k) = hup(iin,j,k) do n = 1, ntr trp(ldni-1+i,j,k,n) = trp(iin,j,k,n) enddo enddo enddo enddo endif * if(west.eq.1) then do k=1,gnk do j=1-hy,ldnj+hy uup(1,j,k) = 0. enddo do i=1,hx do j=1-hy,ldnj+hy uup(1-i,j,k) = - uup(1+i,j,k) vvp(1-i,j,k) = vvp( i,j,k) bbp(1-i,j,k) = bbp( i,j,k) ppp(1-i,j,k) = ppp( i,j,k) wwp(1-i,j,k) = wwp( i,j,k) hup(1-i,j,k) = hup( i,j,k) do n = 1, ntr trp(1-i,j,k,n) = trp( i,j,k,n) enddo enddo enddo enddo endif * *---------------------------------------------------------------------- return end