!-------------------------------------- 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 v4d_zero - Zero ALL model variables
*
#include "model_macros_f.h"
*
subroutine v4d_zero 8
*
implicit none
*
*author
* M.Tanguay
*
*revision
* v2_10 - Tanguay M. - initial MPI version
* v2_31 - Tanguay M. - adapt ADJ for new advection code
* - adapt for tracers in tr3d
* v3_03 - Tanguay M. - Adjoint Lam and NoHyd configuration
* v3_11 - Tanguay M. - ADJ of digital filter
* v3_21 - Lee V. - removed Tr2d
* v3_30 - Tanguay M. - Validation for LAM version
* - adapt to bcs
* v3_31 - Tanguay M. - Control BC
* v3_31 - Tanguay M. - Introduce time extrapolation
* v3_31 - Tanguay M. - SETTLS option
*
*object
* see id section
*
*arguments
* none
*
*implicits
#include "lun.cdk"
#include "glb_ld.cdk"
#include "vt0.cdk"
#include "vt1.cdk"
#include "vtw.cdk"
#include "vth.cdk"
#include "vtx.cdk"
#include "vta.cdk"
#include "rhsc.cdk"
#include "orh.cdk"
cvl#include "tr2d.cdk"
#include "tr3d.cdk"
#include "nest.cdk"
#include "schm.cdk"
#include "init.cdk"
#include "bcsdim.cdk"
#include "bcsmem.cdk"
#include "v4dg_bc.cdk"
#include "v4d_bc.cdk"
#include "step.cdk"
*
*modules
integer vmmlod,vmmget,vmmuld
external vmmlod,vmmget,vmmuld
integer pnerr, pnlkey1(50), key1_, key0_, key_,
$ key1(Tr3d_ntr), key0(Tr3d_ntr), key(Tr3d_ntr),
$ pnlod, err, i, j, k, n, keya_, keya(Tr3d_ntr), id
*
real tr,tr0,trf,tra
pointer (patr, tr (LDIST_SHAPE,*)),(patr0, tr0(LDIST_SHAPE,*)),
$ (patrf, trf(LDIST_SHAPE,*)),(patra, tra(LDIST_SHAPE,*))
*
*
#include "v4d_key_bc.cdk"
*
cvl if ( Tr2d_ntr.ne.0 ) call gem_stop ('v4d_zero',-1)
*
if( Lun_debug_L ) then
write(Lun_out,fmt='(/,''V4D_ZERO:Zero ALL model variables'')')
write(Lun_out,fmt='( ''================================='')')
endif
*
* ---------------------------
* Zero comdeck vt0
* ---------------------------
pnlkey1( 1)= VMM_KEY(ut0 )
pnlkey1( 2)= VMM_KEY(vt0 )
pnlkey1( 3)= VMM_KEY(wt0 )
pnlkey1( 4)= VMM_KEY(tdt0 )
pnlkey1( 5)= VMM_KEY(tt0 )
pnlkey1( 6)= VMM_KEY(fit0 )
pnlkey1( 7)= VMM_KEY(qt0 )
pnlkey1( 8)= VMM_KEY(tpt0 )
pnlkey1( 9)= VMM_KEY(fipt0)
pnlkey1(10)= VMM_KEY(qpt0 )
pnlkey1(11)= VMM_KEY(pipt0)
pnlkey1(12)= VMM_KEY(tplt0)
pnlkey1(13)= VMM_KEY(psdt0)
pnlkey1(14)= VMM_KEY(st0 )
pnlod = 14
*
if (.not. Schm_hydro_L) then
pnlkey1(pnlod+1)= VMM_KEY(mut0)
pnlod = pnlod+1
endif
*
pnerr = vmmlod(pnlkey1,pnlod)
pnerr = VMM_GET_VAR(ut0 )
pnerr = VMM_GET_VAR(vt0 )
pnerr = VMM_GET_VAR(wt0 )
pnerr = VMM_GET_VAR(tdt0 )
pnerr = VMM_GET_VAR(tt0 )
pnerr = VMM_GET_VAR(fit0 )
pnerr = VMM_GET_VAR(qt0 )
pnerr = VMM_GET_VAR(tpt0 )
pnerr = VMM_GET_VAR(fipt0)
pnerr = VMM_GET_VAR(qpt0 )
pnerr = VMM_GET_VAR(pipt0)
pnerr = VMM_GET_VAR(tplt0)
pnerr = VMM_GET_VAR(psdt0)
pnerr = VMM_GET_VAR(st0 )
*
if (.not. Schm_hydro_L) then
pnerr = VMM_GET_VAR(mut0)
endif
*
do k=1,l_nk
do j=l_miny,l_maxy
do i=l_minx,l_maxx
ut0 (i,j,k) = 0.
vt0 (i,j,k) = 0.
wt0 (i,j,k) = 0.
tdt0 (i,j,k) = 0.
tt0 (i,j,k) = 0.
fit0 (i,j,k) = 0.
qt0 (i,j,k) = 0.
qpt0 (i,j,k) = 0.
tpt0 (i,j,k) = 0.
fipt0(i,j,k) = 0.
pipt0(i,j,k) = 0.
tplt0(i,j,k) = 0.
psdt0(i,j,k) = 0.
end do
end do
end do
*
if (.not. Schm_hydro_L) then
do k=1,l_nk
do j=l_miny,l_maxy
do i=l_minx,l_maxx
mut0 (i,j,k) = 0.
end do
end do
end do
end if
*
do j=l_miny,l_maxy
do i=l_minx,l_maxx
st0 (i,j) = 0.
end do
end do
*
pnerr = vmmuld( -1, 0 )
*
key0_ = VMM_KEY (trt0)
do n=1,Tr3d_ntr
key0(n) = key0_ + n
end do
if (Tr3d_ntr.gt.0) then
err = vmmlod(key0,Tr3d_ntr)
do n=1,Tr3d_ntr
err = vmmget(key0(n),patr0,tr0)
do k=1,l_nk
do j=l_miny,l_maxy
do i=l_minx,l_maxx
tr0(i,j,k) = 0.
end do
end do
end do
end do
err = vmmuld(key0,Tr3d_ntr)
endif
*
* ---------------------------
* Zero comdeck vt1
* ---------------------------
pnlkey1( 1)= VMM_KEY(ut1 )
pnlkey1( 2)= VMM_KEY(vt1 )
pnlkey1( 3)= VMM_KEY(wt1 )
pnlkey1( 4)= VMM_KEY(tdt1 )
pnlkey1( 5)= VMM_KEY(tt1 )
pnlkey1( 6)= VMM_KEY(fit1 )
pnlkey1( 7)= VMM_KEY(qt1 )
pnlkey1( 8)= VMM_KEY(tpt1 )
pnlkey1( 9)= VMM_KEY(fipt1)
pnlkey1(10)= VMM_KEY(qpt1 )
pnlkey1(11)= VMM_KEY(pipt1)
pnlkey1(12)= VMM_KEY(tplt1)
pnlkey1(13)= VMM_KEY(psdt1)
pnlkey1(14)= VMM_KEY(st1 )
pnlkey1(15)= VMM_KEY(xct1 )
pnlkey1(16)= VMM_KEY(yct1 )
pnlkey1(17)= VMM_KEY(zct1 )
pnlkey1(18)= VMM_KEY(xt1 )
pnlkey1(19)= VMM_KEY(yt1 )
pnlkey1(20)= VMM_KEY(zt1 )
pnlod = 20
*
if (.not. Schm_hydro_L) then
pnlkey1(pnlod+1)= VMM_KEY(mut1)
pnlod = pnlod+1
endif
*
pnerr = vmmlod(pnlkey1,pnlod)
pnerr = VMM_GET_VAR(ut1 )
pnerr = VMM_GET_VAR(vt1 )
pnerr = VMM_GET_VAR(wt1 )
pnerr = VMM_GET_VAR(tdt1 )
pnerr = VMM_GET_VAR(tt1 )
pnerr = VMM_GET_VAR(fit1 )
pnerr = VMM_GET_VAR(qt1 )
pnerr = VMM_GET_VAR(tpt1 )
pnerr = VMM_GET_VAR(fipt1)
pnerr = VMM_GET_VAR(qpt1 )
pnerr = VMM_GET_VAR(pipt1)
pnerr = VMM_GET_VAR(tplt1)
pnerr = VMM_GET_VAR(psdt1)
pnerr = VMM_GET_VAR(st1 )
pnerr = VMM_GET_VAR(xct1 )
pnerr = VMM_GET_VAR(yct1 )
pnerr = VMM_GET_VAR(zct1 )
pnerr = VMM_GET_VAR(xt1 )
pnerr = VMM_GET_VAR(yt1 )
pnerr = VMM_GET_VAR(zt1 )
*
if (.not. Schm_hydro_L) then
pnerr = VMM_GET_VAR(mut1)
endif
*
do k=1,l_nk
do j=l_miny,l_maxy
do i=l_minx,l_maxx
ut1 (i,j,k) = 0.
vt1 (i,j,k) = 0.
wt1 (i,j,k) = 0.
tdt1 (i,j,k) = 0.
tt1 (i,j,k) = 0.
fit1 (i,j,k) = 0.
qt1 (i,j,k) = 0.
tpt1 (i,j,k) = 0.
fipt1(i,j,k) = 0.
qpt1 (i,j,k) = 0.
pipt1(i,j,k) = 0.
tplt1(i,j,k) = 0.
psdt1(i,j,k) = 0.
end do
end do
end do
*
if (.not. Schm_hydro_L) then
do k=1,l_nk
do j=l_miny,l_maxy
do i=l_minx,l_maxx
mut1 (i,j,k) = 0.
end do
end do
end do
end if
*
do j=l_miny,l_maxy
do i=l_minx,l_maxx
st1 (i,j) = 0.
end do
end do
*
do i=1,l_ni*l_nj*l_nk
xct1 (i) = 0.
yct1 (i) = 0.
zct1 (i) = 0.
xt1 (i) = 0.
yt1 (i) = 0.
zt1 (i) = 0.
end do
*
pnerr = vmmuld( -1, 0 )
*
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),patr,tr)
do k=1,l_nk
do j=l_miny,l_maxy
do i=l_minx,l_maxx
tr(i,j,k) = 0.
end do
end do
end do
end do
err = vmmuld(key1,Tr3d_ntr)
endif
*
if (Schm_modcn.eq.Step_total) then
*
* -----------------------------------
* Zero comdeck vtw (tw=t2 work space)
* -----------------------------------
pnlkey1( 1)= VMM_KEY(utw )
pnlkey1( 2)= VMM_KEY(vtw )
pnlkey1( 3)= VMM_KEY(wtw )
pnlkey1( 4)= VMM_KEY(tdtw )
pnlkey1( 5)= VMM_KEY(ttw )
pnlkey1( 6)= VMM_KEY(fitw )
pnlkey1( 7)= VMM_KEY(qtw )
pnlkey1( 8)= VMM_KEY(tptw )
pnlkey1( 9)= VMM_KEY(fiptw)
pnlkey1(10)= VMM_KEY(qptw )
pnlkey1(11)= VMM_KEY(piptw)
pnlkey1(12)= VMM_KEY(tpltw)
pnlkey1(13)= VMM_KEY(psdtw)
pnlkey1(14)= VMM_KEY(stw )
pnlod = 14
*
if (.not. Schm_hydro_L) then
pnlkey1(pnlod+1)= VMM_KEY(mutw)
pnlod = pnlod+1
endif
*
pnerr = vmmlod(pnlkey1,pnlod)
pnerr = VMM_GET_VAR(utw )
pnerr = VMM_GET_VAR(vtw )
pnerr = VMM_GET_VAR(wtw )
pnerr = VMM_GET_VAR(tdtw )
pnerr = VMM_GET_VAR(ttw )
pnerr = VMM_GET_VAR(fitw )
pnerr = VMM_GET_VAR(qtw )
pnerr = VMM_GET_VAR(tptw )
pnerr = VMM_GET_VAR(fiptw)
pnerr = VMM_GET_VAR(qptw )
pnerr = VMM_GET_VAR(piptw)
pnerr = VMM_GET_VAR(tpltw)
pnerr = VMM_GET_VAR(psdtw)
pnerr = VMM_GET_VAR(stw )
*
if (.not. Schm_hydro_L) then
pnerr = VMM_GET_VAR(mutw)
endif
*
utw = 0.
vtw = 0.
wtw = 0.
tdtw = 0.
ttw = 0.
fitw = 0.
qtw = 0.
tptw = 0.
fiptw= 0.
qptw = 0.
piptw= 0.
tpltw= 0.
psdtw= 0.
stw = 0.
*
if (.not. Schm_hydro_L) mutw = 0.
*
pnerr = vmmuld( -1, 0 )
*
key1_ = VMM_KEY (trtw)
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),patr,tr)
do k=1,l_nk
do j=l_miny,l_maxy
do i=l_minx,l_maxx
tr(i,j,k) = 0.
end do
end do
end do
end do
err = vmmuld(key1,Tr3d_ntr)
endif
*
endif
*
* ---------------------------
* Zero comdeck vth
* ---------------------------
pnlkey1(1) = VMM_KEY(uth )
pnlkey1(2) = VMM_KEY(vth )
pnlkey1(3) = VMM_KEY(psdth)
pnlkey1(4) = VMM_KEY(xth )
pnlkey1(5) = VMM_KEY(yth )
pnlkey1(6) = VMM_KEY(zth )
pnlkey1(7) = VMM_KEY(xcth )
pnlkey1(8) = VMM_KEY(ycth )
pnlkey1(9) = VMM_KEY(zcth )
pnlod = 9
*
pnerr = vmmlod(pnlkey1,pnlod)
pnerr = VMM_GET_VAR(uth )
pnerr = VMM_GET_VAR(vth )
pnerr = VMM_GET_VAR(psdth)
pnerr = VMM_GET_VAR(xth )
pnerr = VMM_GET_VAR(yth )
pnerr = VMM_GET_VAR(zth )
pnerr = VMM_GET_VAR(xcth )
pnerr = VMM_GET_VAR(ycth )
pnerr = VMM_GET_VAR(zcth )
*
do k=1,l_nk
do j=l_miny,l_maxy
do i=l_minx,l_maxx
uth (i,j,k) = 0.
vth (i,j,k) = 0.
psdth(i,j,k) = 0.
end do
end do
end do
*
do i=1,l_ni*l_nj*l_nk
xth (i) = 0.
yth (i) = 0.
zth (i) = 0.
xcth (i) = 0.
ycth (i) = 0.
zcth (i) = 0.
end do
*
pnerr = vmmuld( -1, 0 )
*
* ---------------------------
* Zero comdeck vtx
* ---------------------------
pnlkey1(1) = VMM_KEY(gptx)
pnlkey1(2) = VMM_KEY(gxtx)
pnlod = 2
*
if (.not. Schm_hydro_L) then
pnlkey1(pnlod+1) = VMM_KEY(multx)
pnlod = pnlod+1
endif
*
pnerr = vmmlod(pnlkey1,pnlod)
pnerr = VMM_GET_VAR(gptx)
pnerr = VMM_GET_VAR(gxtx)
*
if (.not. Schm_hydro_L) then
pnerr = VMM_GET_VAR(multx)
endif
*
do k=1,l_nk
do j=l_miny,l_maxy
do i=l_minx,l_maxx
gptx(i,j,k) = 0.
gxtx(i,j,k) = 0.
end do
end do
end do
*
if (.not. Schm_hydro_L) then
do k=1,l_nk
do j=l_miny,l_maxy
do i=l_minx,l_maxx
multx(i,j,k) = 0.
end do
end do
end do
endif
*
pnerr = vmmuld( -1, 0 )
*
* ---------------------------
* Zero comdeck rhsc
* ---------------------------
pnlkey1( 1)= VMM_KEY(ru )
pnlkey1( 2)= VMM_KEY(rv )
pnlkey1( 3)= VMM_KEY(rw )
pnlkey1( 4)= VMM_KEY(rvv )
pnlkey1( 5)= VMM_KEY(rcn )
pnlkey1( 6)= VMM_KEY(rth )
pnlkey1( 7)= VMM_KEY(rd )
pnlkey1( 8)= VMM_KEY(r3 )
pnlkey1( 9)= VMM_KEY(rhell)
pnlkey1(10)= VMM_KEY(ruw1 )
pnlkey1(11)= VMM_KEY(rvw1 )
pnlkey1(12)= VMM_KEY(r1 )
pnlkey1(13)= VMM_KEY(r3p )
pnlkey1(14)= VMM_KEY(rheln)
pnlkey1(15)= VMM_KEY(ruw2 )
pnlkey1(16)= VMM_KEY(rvw2 )
pnlod = 16
*
pnerr = vmmlod(pnlkey1,pnlod)
pnerr = VMM_GET_VAR(ru )
pnerr = VMM_GET_VAR(rv )
pnerr = VMM_GET_VAR(rw )
pnerr = VMM_GET_VAR(rvv )
pnerr = VMM_GET_VAR(rcn )
pnerr = VMM_GET_VAR(rth )
pnerr = VMM_GET_VAR(rd )
pnerr = VMM_GET_VAR(r3 )
pnerr = VMM_GET_VAR(rhell)
pnerr = VMM_GET_VAR(ruw1 )
pnerr = VMM_GET_VAR(rvw1 )
pnerr = VMM_GET_VAR(r1 )
pnerr = VMM_GET_VAR(r3p )
pnerr = VMM_GET_VAR(rheln)
pnerr = VMM_GET_VAR(ruw2 )
pnerr = VMM_GET_VAR(rvw2 )
*
do k=1,l_nk
do j=l_miny,l_maxy
do i=l_minx,l_maxx
ru (i,j,k) = 0.
rv (i,j,k) = 0.
rw (i,j,k) = 0.
rvv (i,j,k) = 0.
rcn (i,j,k) = 0.
rth (i,j,k) = 0.
rd (i,j,k) = 0.
r3 (i,j,k) = 0.
rhell(i,j,k) = 0.
ruw1 (i,j,k) = 0.
rvw1 (i,j,k) = 0.
r1 (i,j,k) = 0.
r3p (i,j,k) = 0.
rheln(i,j,k) = 0.
ruw2 (i,j,k) = 0.
rvw2 (i,j,k) = 0.
end do
end do
end do
*
pnerr = vmmuld( -1, 0 )
*
* ---------------------------
* Zero comdeck orh
* ---------------------------
pnlkey1(1)= VMM_KEY(oru )
pnlkey1(2)= VMM_KEY(orv )
pnlkey1(3)= VMM_KEY(orcn)
pnlkey1(4)= VMM_KEY(orth)
pnlod = 4
*
if (.not. Schm_hydro_L) then
pnlkey1(pnlod+1)= VMM_KEY(orw )
pnlkey1(pnlod+2)= VMM_KEY(orvv)
pnlod = pnlod+2
endif
*
pnerr = vmmlod(pnlkey1,pnlod)
pnerr = VMM_GET_VAR(oru )
pnerr = VMM_GET_VAR(orv )
pnerr = VMM_GET_VAR(orcn)
pnerr = VMM_GET_VAR(orth)
*
if (.not. Schm_hydro_L) then
pnerr = VMM_GET_VAR(orw )
pnerr = VMM_GET_VAR(orvv)
endif
*
do k=1,l_nk
do j=l_miny,l_maxy
do i=l_minx,l_maxx
oru (i,j,k) = 0.
orv (i,j,k) = 0.
orcn(i,j,k) = 0.
orth(i,j,k) = 0.
end do
end do
end do
*
if (.not. Schm_hydro_L) then
do k=1,l_nk
do j=l_miny,l_maxy
do i=l_minx,l_maxx
orw (i,j,k) = 0.
orvv(i,j,k) = 0.
end do
end do
end do
endif
*
pnerr = vmmuld( -1, 0 )
*
if(G_lam) then
*
* ---------------------------
* Zero comdeck nest
* ---------------------------
pnlkey1( 1)=VMM_KEY(nest_u )
pnlkey1( 2)=VMM_KEY(nest_v )
pnlkey1( 3)=VMM_KEY(nest_t )
pnlkey1( 4)=VMM_KEY(nest_td )
pnlkey1( 5)=VMM_KEY(nest_fi )
pnlkey1( 6)=VMM_KEY(nest_q )
pnlkey1( 7)=VMM_KEY(nest_tp )
pnlkey1( 8)=VMM_KEY(nest_fip)
pnlkey1( 9)=VMM_KEY(nest_pip)
pnlkey1(10)=VMM_KEY(nest_psd)
pnlkey1(11)=VMM_KEY(nest_s )
pnlod = 11
*
if (.not. Schm_hydro_L) then
pnlkey1(pnlod+1)=VMM_KEY(nest_w )
pnlkey1(pnlod+2)=VMM_KEY(nest_mu)
pnlod = pnlod+2
endif
*
err = vmmlod(pnlkey1,pnlod)
err = VMM_GET_VAR(nest_u )
err = VMM_GET_VAR(nest_v )
err = VMM_GET_VAR(nest_t )
err = VMM_GET_VAR(nest_td )
err = VMM_GET_VAR(nest_fi )
err = VMM_GET_VAR(nest_q )
err = VMM_GET_VAR(nest_tp )
err = VMM_GET_VAR(nest_fip)
err = VMM_GET_VAR(nest_pip)
err = VMM_GET_VAR(nest_psd)
err = VMM_GET_VAR(nest_s )
*
if (.not. Schm_hydro_L) then
err = VMM_GET_VAR(nest_w )
err = VMM_GET_VAR(nest_mu)
endif
*
do k=1,l_nk
do j=l_miny,l_maxy
do i=l_minx,l_maxx
nest_u (i,j,k) = 0.
nest_v (i,j,k) = 0.
nest_t (i,j,k) = 0.
nest_td (i,j,k) = 0.
nest_fi (i,j,k) = 0.
nest_q (i,j,k) = 0.
nest_tp (i,j,k) = 0.
nest_fip(i,j,k) = 0.
nest_pip(i,j,k) = 0.
nest_psd(i,j,k) = 0.
end do
end do
end do
*
if (.not. Schm_hydro_L) then
do k=1,l_nk
do j=l_miny,l_maxy
do i=l_minx,l_maxx
nest_w (i,j,k) = 0.
nest_mu (i,j,k) = 0.
end do
end do
end do
end if
*
do j=l_miny,l_maxy
do i=l_minx,l_maxx
nest_s(i,j) = 0.
end do
end do
*
pnerr = vmmuld( -1, 0 )
*
key_ = VMM_KEY (nest_tr)
do n=1,Tr3d_ntr
key(n) = key_ + n
end do
if (Tr3d_ntr.gt.0) then
err = vmmlod(key,Tr3d_ntr)
do n=1,Tr3d_ntr
err = vmmget(key(n),patrf,trf)
do k=1,l_nk
do j=l_miny,l_maxy
do i=l_minx,l_maxx
trf (i,j,k) = 0.
end do
end do
end do
end do
err = vmmuld(key,Tr3d_ntr)
endif
*
endif
*
if(G_lam) then
*
* ----------------
* Zero comdeck bcs
* ----------------
*
do i=1,bcs_sz
bcs_u (i) = 0.
bcs_v (i) = 0.
bcs_t (i) = 0.
bcs_td (i) = 0.
bcs_fi (i) = 0.
bcs_q (i) = 0.
bcs_tp (i) = 0.
bcs_fip(i) = 0.
bcs_pip(i) = 0.
bcs_psd(i) = 0.
end do
*
if (.not. Schm_hydro_L) then
do i=1,bcs_sz
bcs_w (i) = 0.
bcs_mu (i) = 0.
end do
end if
*
do i=1,bcs_sz
bcs_s(i) = 0.
end do
*
if (Tr3d_ntr.gt.0) then
do n=1,Tr3d_ntr
id = (n-1)*bcs_sz+1
*
do i=1,bcs_sz
bcs_tr (id+i-1) = 0.
end do
end do
endif
*
endif
*
if(G_lam) then
*
* Control BC
* ----------
*
* ---------------------
do ntime=0,Step_total
* ---------------------
*
#include "v4d_lod_bc.cdk"
#include "v4d_get_bc.cdk"
*
do k=1,l_nk
do j=l_miny,l_maxy
do i=l_minx,l_maxx
f_bc_u (i,j,k) = 0.
f_bc_v (i,j,k) = 0.
f_bc_tp (i,j,k) = 0.
end do
end do
end do
*
do j=l_miny,l_maxy
do i=l_minx,l_maxx
f_bc_s (i,j) = 0.
end do
end do
*
do n_tr=1,Tr3d_ntr
*
bc_err = vmmget(key_bc_tr(n_tr),pabc_tr,f_bc_tr)
*
do k=1,l_nk
do j=1,l_nj
do i=1,l_ni
f_bc_tr(i,j,k) = 0.
end do
end do
end do
*
end do
*
#include "v4d_unlod_bc.cdk"
*
* ------
end do
* ------
*
endif
*
if ( Init_balgm_L ) then
*
* ---------------------------
* Zero comdeck vta
* ---------------------------
pnlkey1(1) = VMM_KEY(uta )
pnlkey1(2) = VMM_KEY(vta )
pnlkey1(3) = VMM_KEY(tdta )
pnlkey1(4) = VMM_KEY(fita )
pnlkey1(5) = VMM_KEY(fipta)
pnlkey1(6) = VMM_KEY(tta )
pnlkey1(7) = VMM_KEY(qta )
pnlkey1(8) = VMM_KEY(tpta )
pnlkey1(9) = VMM_KEY(pipta)
pnlkey1(10) = VMM_KEY(tplta)
pnlkey1(11) = VMM_KEY(psdta)
pnlkey1(12) = VMM_KEY(sta )
pnlkey1(13) = VMM_KEY(gpta )
*
err = vmmlod(pnlkey1,13)
*
err = VMM_GET_VAR(uta )
err = VMM_GET_VAR(vta )
err = VMM_GET_VAR(tdta )
err = VMM_GET_VAR(fita )
err = VMM_GET_VAR(fipta)
err = VMM_GET_VAR(tta )
err = VMM_GET_VAR(qta )
err = VMM_GET_VAR(tpta )
err = VMM_GET_VAR(pipta)
err = VMM_GET_VAR(tplta)
err = VMM_GET_VAR(psdta)
err = VMM_GET_VAR(sta )
err = VMM_GET_VAR(gpta )
*
do k=1,l_nk
do j= 1, l_nj
do i= 1, l_ni
uta(i,j,k) = 0.
vta(i,j,k) = 0.
tdta(i,j,k) = 0.
fita(i,j,k) = 0.
fipta(i,j,k) = 0.
tta(i,j,k) = 0.
qta(i,j,k) = 0.
tpta(i,j,k) = 0.
pipta(i,j,k) = 0.
tplta(i,j,k) = 0.
psdta(i,j,k) = 0.
gpta(i,j,k) = 0.
end do
end do
end do
*
do j= 1, l_nj
do i= 1, l_ni
sta(i,j) = 0.
end do
end do
*
err = vmmuld(-1,0)
*
* Non-hydrostatic model fields
* ----------------------------
if ( .not. Schm_hydro_L )then
*
pnlkey1(1) = VMM_KEY(wta )
pnlkey1(2) = VMM_KEY(qpta )
pnlkey1(3) = VMM_KEY(multa)
pnlkey1(4) = VMM_KEY(muta )
*
err = vmmlod(pnlkey1,4)
*
err = VMM_GET_VAR(wta )
err = VMM_GET_VAR(qpta )
err = VMM_GET_VAR(multa)
err = VMM_GET_VAR(muta )
*
do k=1,l_nk
do j= 1, l_nj
do i= 1, l_ni
wta(i,j,k) = 0.
qpta(i,j,k) = 0.
multa(i,j,k) = 0.
muta(i,j,k) = 0.
end do
end do
end do
*
err = vmmuld(-1,0)
*
endif
* Passive tracers Tr3d
* --------------------
keya_ = VMM_KEY (trta)
do n=1,Tr3d_ntr
keya(n) = keya_ + n
end do
if (Tr3d_ntr.gt.0) then
err = vmmlod(keya,Tr3d_ntr)
do n=1,Tr3d_ntr
err = vmmget(keya(n),patra,tra)
do k=1,G_nk
do j=1,l_nj
do i=1,l_ni
tra(i,j,k) = 0.
end do
end do
end do
end do
err = vmmuld(keya,Tr3d_ntr)
endif
*
endif
*
return
end