!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
***s/r mirror - mirror boundary condition for BUBBLE theoretical
* case
*
#include "model_macros_f.h"
*
subroutine mirror () 1
implicit none
*author
* Gravel - spring 2003 (after MC2 v_4.9.3)
*
*revision
* v3_11 - Gravel - initial version
*
*object
*
*arguments
* none
*
*implicits
#include "glb_ld.cdk"
#include "vt1.cdk"
#include "tr3d.cdk"
#include "schm.cdk"
#include "lun.cdk"
*
integer vmmlod,vmmget,vmmuld
external vmmlod,vmmget,vmmuld
*
integer err,key(13),i,j,k,nvar
integer ii, iin, jj, jin
integer key1(Tr3d_ntr),key1_,n
real tr1
pointer (patr1,tr1(LDIST_SHAPE,*))
*----------------------------------------------------------------------
*
key(1)=VMM_KEY(ut1)
key(2)=VMM_KEY(vt1)
key(3)=VMM_KEY(tt1)
key(4)=VMM_KEY(psdt1)
key(5)=VMM_KEY(pipt1)
key(6)=VMM_KEY(fipt1)
key(7)=VMM_KEY(tdt1)
key(8)=VMM_KEY(fit1)
key(9)=VMM_KEY(qt1)
key(10)=VMM_KEY(st1)
key(11)=VMM_KEY(tpt1)
nvar = 11
*
if (.not.Schm_hydro_L) then
key(12)=VMM_KEY(wt1)
key(13)=VMM_KEY(mut1)
nvar = 13
endif
*
err = vmmlod(key,nvar)
err = VMM_GET_VAR(ut1)
err = VMM_GET_VAR(vt1)
err = VMM_GET_VAR(tt1)
err = VMM_GET_VAR(psdt1)
err = VMM_GET_VAR(pipt1)
err = VMM_GET_VAR(fipt1)
err = VMM_GET_VAR(tdt1)
err = VMM_GET_VAR(fit1)
err = VMM_GET_VAR(qt1)
err = VMM_GET_VAR(st1)
err = VMM_GET_VAR(tpt1)
if (.not.Schm_hydro_L) then
err = VMM_GET_VAR(wt1)
err = VMM_GET_VAR(mut1)
endif
*
if (l_north) then
do k=1,G_nk
do i=1,l_ni
vt1 (i,l_nj-pil_n,k) = 0.
end do
do j=1,pil_n-1
jin = max(pil_s+1,l_nj-pil_n-j)
jj = l_nj-pil_n+j
do i=1,l_ni
vt1 (i,jj,k) = - vt1 (i,jin,k)
end do
end do
do j=1,pil_n
jin = max(pil_s+1,l_nj-pil_n-j+1)
jj = l_nj-pil_n+j
do i=1,l_ni
tt1 (i,jj,k) = tt1 (i,jin,k)
psdt1(i,jj,k) = psdt1(i,jin,k)
pipt1(i,jj,k) = pipt1(i,jin,k)
fipt1(i,jj,k) = fipt1(i,jin,k)
tdt1 (i,jj,k) = tdt1 (i,jin,k)
fit1 (i,jj,k) = fit1 (i,jin,k)
qt1 (i,jj,k) = qt1 (i,jin,k)
tpt1 (i,jj,k) = tpt1 (i,jin,k)
end do
do i=1,l_niu
ut1 (i,jj,k) = ut1 (i,jin,k)
end do
end do
end do
do j=1,pil_n
jin = max(pil_s+1,l_nj-pil_n-j+1)
jj = l_nj-pil_n+j
do i=1,l_ni
st1 (i,jj) = st1 (i,jin)
end do
end do
if (.not. Schm_hydro_L) then
do k=1,G_nk
do j=1,pil_n
jin = max(pil_s+1,l_nj-pil_n-j+1)
jj = l_nj-pil_n+j
do i=1,l_ni
wt1 (i,jj,k) = wt1 (i,jin,k)
mut1(i,jj,k) = mut1(i,jin,k)
end do
end do
end do
endif
endif
*
if (l_east) then
do k=1,G_nk
do j=1,l_nj
ut1 (l_ni-pil_e,j,k) = 0.
end do
do j=1,l_nj
do i=1,pil_e-1
iin = max(pil_w+1,l_ni-pil_e-i)
ii = l_ni-pil_e+i
ut1 (ii,j,k) = - ut1 (iin,j,k)
end do
end do
do j=1,l_nj
do i=1,pil_e
iin = max(pil_w+1,l_ni-pil_e-i+1)
ii = l_ni-pil_e+i
tt1 (ii,j,k) = tt1 (iin,j,k)
psdt1(ii,j,k) = psdt1(iin,j,k)
pipt1(ii,j,k) = pipt1(iin,j,k)
fipt1(ii,j,k) = fipt1(iin,j,k)
tdt1 (ii,j,k) = tdt1 (iin,j,k)
fit1 (ii,j,k) = fit1 (iin,j,k)
qt1 (ii,j,k) = qt1 (iin,j,k)
tpt1 (ii,j,k) = tpt1 (iin,j,k)
end do
end do
do j=1,l_njv
do i=1,pil_e
iin = max(pil_w+1,l_ni-pil_e-i+1)
ii = l_ni-pil_e+i
vt1 (ii,j,k) = vt1 (iin,j,k)
end do
end do
end do
do j=1,l_nj
do i=1,pil_e
iin = max(pil_w+1,l_ni-pil_e-i+1)
ii = l_ni-pil_e+i
st1 (ii,j) = st1 (iin,j)
end do
end do
if (.not. Schm_hydro_L) then
do k=1,G_nk
do j=1,l_nj
do i=1,pil_e
iin = max(pil_w+1,l_ni-pil_e-i+1)
ii = l_ni-pil_e+i
wt1 (ii,j,k) = wt1 (iin,j,k)
mut1(ii,j,k) = mut1(iin,j,k)
end do
end do
end do
endif
endif
*
if (l_south) then
do k=1,G_nk
do i=1,l_ni
vt1 (i,pil_s,k) = 0.
end do
do j=1,pil_s-1
jin = min(l_nj-pil_n-1,pil_s+j)
jj = pil_s-j
do i=1,l_ni
vt1 (i,jj,k) = - vt1 (i,jin,k)
end do
end do
do j=1,pil_s
jin = min(l_nj-pil_n,pil_s+j)
jj = pil_s-j+1
do i=1,l_ni
tt1 (i,jj,k) = tt1 (i,jin,k)
psdt1(i,jj,k) = psdt1(i,jin,k)
pipt1(i,jj,k) = pipt1(i,jin,k)
fipt1(i,jj,k) = fipt1(i,jin,k)
tdt1 (i,jj,k) = tdt1 (i,jin,k)
fit1 (i,jj,k) = fit1 (i,jin,k)
qt1 (i,jj,k) = qt1 (i,jin,k)
tpt1 (i,jj,k) = tpt1 (i,jin,k)
end do
do i=1,l_niu
ut1 (i,jj,k) = ut1 (i,jin,k)
end do
end do
end do
do j=1,pil_s
jin = min(l_nj-pil_n,pil_s+j)
jj = pil_s-j+1
do i=1,l_ni
st1 (i,jj) = st1 (i,jin)
end do
end do
if (.not. Schm_hydro_L) then
do k=1,G_nk
do j=1,pil_s
jin = min(l_nj-pil_n,pil_s+j)
jj = pil_s-j+1
do i=1,l_ni
wt1 (i,jj,k) = wt1 (i,jin,k)
mut1(i,jj,k) = mut1(i,jin,k)
end do
end do
end do
endif
endif
*
if (l_west) then
do k=1,G_nk
do j=1,l_nj
ut1 (pil_w,j,k) = 0.
end do
do j=1,l_nj
do i=1,pil_w-1
iin = min(l_ni-pil_e-1,pil_w+i)
ii = pil_w-i
ut1 (ii,j,k) = - ut1 (iin,j,k)
end do
end do
do j=1,l_nj
do i=1,pil_w
iin = min(l_ni-pil_e,pil_w+i)
ii = pil_w-i+1
tt1 (ii,j,k) = tt1 (iin,j,k)
psdt1(ii,j,k) = psdt1(iin,j,k)
pipt1(ii,j,k) = pipt1(iin,j,k)
fipt1(ii,j,k) = fipt1(iin,j,k)
tdt1 (ii,j,k) = tdt1 (iin,j,k)
fit1 (ii,j,k) = fit1 (iin,j,k)
qt1 (ii,j,k) = qt1 (iin,j,k)
tpt1 (ii,j,k) = tpt1 (iin,j,k)
end do
end do
do j=1,l_njv
do i=1,pil_w
iin = min(l_ni-pil_e,pil_w+i)
ii = pil_w-i+1
vt1 (ii,j,k) = vt1 (iin,j,k)
end do
end do
end do
do j=1,l_nj
do i=1,pil_w
iin = min(l_ni-pil_e,pil_w+i)
ii = pil_w-i+1
st1 (ii,j) = st1 (iin,j)
end do
end do
if (.not. Schm_hydro_L) then
do k=1,G_nk
do j=1,l_nj
do i=1,pil_w
iin = min(l_ni-pil_e,pil_w+i)
ii = pil_w-i+1
wt1 (ii,j,k) = wt1 (iin,j,k)
mut1(ii,j,k) = mut1(iin,j,k)
end do
end do
end do
endif
endif
*
err = vmmuld(key,nvar)
*
key1_ = VMM_KEY (trt1)
do n=1,Tr3d_ntr
key1(n) = key1_ + n
end do
if (Tr3d_ntr.gt.0) then
err = vmmlod(key1,Tr3d_ntr)
do n=1,Tr3d_ntr
err = vmmget(key1(n),patr1,tr1)
if (l_north) then
do k=1,G_nk
do j=1,pil_n
jin = max(pil_s+1,l_nj-pil_n-j+1)
jj = l_nj-pil_n+j
do i=1,l_ni
tr1 (i,jj,k) = tr1 (i,jin,k)
enddo
enddo
enddo
endif
if (l_east) then
do k=1,G_nk
do j=1,l_nj
do i=1,pil_e
iin = max(pil_w+1,l_ni-pil_e-i+1)
ii = l_ni-pil_e+i
tr1 (ii,j,k) = tr1 (iin,j,k)
enddo
enddo
enddo
endif
if (l_south) then
do k=1,G_nk
do j=1,pil_s
jin = min(l_nj-pil_n,pil_s+j)
jj = pil_s-j+1
do i=1,l_ni
tr1 (i,jj,k) = tr1 (i,jin,k)
enddo
enddo
enddo
endif
if (l_west) then
do k=1,G_nk
do j=1,l_nj
do i=1,pil_w
iin = min(l_ni-pil_e,pil_w+i)
ii = pil_w-i+1
tr1 (ii,j,k) = tr1 (iin,j,k)
enddo
enddo
enddo
endif
enddo
err = vmmuld(key1,Tr3d_ntr)
endif
*
*----------------------------------------------------------------------
return
end