!-------------------------------------- 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 nest_update -
*
#include "model_macros_f.h"
*
subroutine nest_update () 2,14
implicit none
*
*author
* Michel Desgagne - Spring 2006
*
*revision
* v3_30 - Lee V. - initial version
*
*object
*
*arguments
* none
*
*implicits
#include "acid.cdk"
#include "glb_ld.cdk"
#include "bcsdim.cdk"
#include "bcsgrds.cdk"
#include "bcsmem.cdk"
#include "nest.cdk"
#include "tr3d.cdk"
#include "schm.cdk"
*
integer vmmlod,vmmget,vmmuld
external vmmlod,vmmget,vmmuld
*
integer err,key(13),nvar,id
integer key1(Tr3d_ntr),key1_,n
real tr,mul(LDIST_SHAPE,G_nk)
pointer (patr, tr(LDIST_SHAPE,*))
*----------------------------------------------------------------------
*
if (north+south+west+east.lt.1) return
*
key(1 )=VMM_KEY(nest_u)
key(2 )=VMM_KEY(nest_v)
key(3 )=VMM_KEY(nest_t)
key(4 )=VMM_KEY(nest_psd)
key(5 )=VMM_KEY(nest_pip)
key(6 )=VMM_KEY(nest_fip)
key(7 )=VMM_KEY(nest_td)
key(8 )=VMM_KEY(nest_fi)
key(9 )=VMM_KEY(nest_q)
key(10)=VMM_KEY(nest_s)
key(11)=VMM_KEY(nest_tp)
nvar = 11
*
if (.not.Schm_hydro_L) then
key(12)=VMM_KEY(nest_w)
key(13)=VMM_KEY(nest_mu)
nvar = 13
endif
*
err = vmmlod(key,nvar)
err = VMM_GET_VAR(nest_u)
err = VMM_GET_VAR(nest_v)
err = VMM_GET_VAR(nest_t)
err = VMM_GET_VAR(nest_psd)
err = VMM_GET_VAR(nest_pip)
err = VMM_GET_VAR(nest_fip)
err = VMM_GET_VAR(nest_td)
err = VMM_GET_VAR(nest_fi)
err = VMM_GET_VAR(nest_q)
err = VMM_GET_VAR(nest_s)
err = VMM_GET_VAR(nest_tp)
if (.not.Schm_hydro_L) then
err = VMM_GET_VAR(nest_w)
err = VMM_GET_VAR(nest_mu)
endif
*
call trnes (nest_u,bcs_u(bcs_is),bcs_u(bcs_in),
$ bcs_u(bcs_iw),bcs_u(bcs_ie),l_minx,l_maxx,l_miny,l_maxy,
$ minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,G_nk,1)
call trnes (nest_v,bcs_v(bcs_is),bcs_v(bcs_in),
$ bcs_v(bcs_iw),bcs_v(bcs_ie),l_minx,l_maxx,l_miny,l_maxy,
$ minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,G_nk,1)
call trnes (nest_t,bcs_t(bcs_is),bcs_t(bcs_in),
$ bcs_t(bcs_iw),bcs_t(bcs_ie),l_minx,l_maxx,l_miny,l_maxy,
$ minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,G_nk,1)
call trnes (nest_pip,bcs_pip(bcs_is),bcs_pip(bcs_in),
$ bcs_pip(bcs_iw),bcs_pip(bcs_ie),l_minx,l_maxx,l_miny,l_maxy,
$ minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,G_nk,1)
call trnes (nest_fip,bcs_fip(bcs_is),bcs_fip(bcs_in),
$ bcs_fip(bcs_iw),bcs_fip(bcs_ie),l_minx,l_maxx,l_miny,l_maxy,
$ minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,G_nk,1)
call trnes (nest_fi,bcs_fi(bcs_is),bcs_fi(bcs_in),
$ bcs_fi(bcs_iw),bcs_fi(bcs_ie),l_minx,l_maxx,l_miny,l_maxy,
$ minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,G_nk,1)
call trnes (nest_q,bcs_q(bcs_is),bcs_q(bcs_in),
$ bcs_q(bcs_iw),bcs_q(bcs_ie),l_minx,l_maxx,l_miny,l_maxy,
$ minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,G_nk,1)
call trnes (nest_s,bcs_s(bcs_is),bcs_s(bcs_in),
$ bcs_s(bcs_iw),bcs_s(bcs_ie),l_minx,l_maxx,l_miny,l_maxy,
$ minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,1,1)
call trnes (nest_tp,bcs_tp(bcs_is),bcs_tp(bcs_in),
$ bcs_tp(bcs_iw),bcs_tp(bcs_ie),l_minx,l_maxx,l_miny,l_maxy,
$ minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,G_nk,1)
call trnes (nest_psd,bcs_psd(bcs_is),bcs_psd(bcs_in),
$ bcs_psd(bcs_iw),bcs_psd(bcs_ie),l_minx,l_maxx,l_miny,l_maxy,
$ minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,G_nk,1)
call trnes (nest_td,bcs_td(bcs_is),bcs_td(bcs_in),
$ bcs_td(bcs_iw),bcs_td(bcs_ie),l_minx,l_maxx,l_miny,l_maxy,
$ minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,G_nk,1)
if (.not.Schm_hydro_L) then
call trnes (nest_w,bcs_w(bcs_is),bcs_w(bcs_in),
$ bcs_w(bcs_iw),bcs_w(bcs_ie),l_minx,l_maxx,l_miny,l_maxy,
$ minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,G_nk,1)
call trnes (nest_mu,bcs_mu(bcs_is),bcs_mu(bcs_in),
$ bcs_mu(bcs_iw),bcs_mu(bcs_ie),l_minx,l_maxx,l_miny,l_maxy,
$ minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,G_nk,1)
endif
err = vmmuld(key,nvar)
*
key1_ = VMM_KEY (nest_tr)
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
id = (n-1)*bcs_sz+1
err = vmmget(key1(n),patr,tr)
call trnes(tr,bcs_tr(id),
$ bcs_tr(id+bcs_in-1),bcs_tr(id+bcs_iw-1),
$ bcs_tr(id+bcs_ie-1),l_minx,l_maxx,l_miny,l_maxy,
$ minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,G_nk,1)
enddo
err = vmmuld(key1,Tr3d_ntr)
endif
*
*----------------------------------------------------------------------
return
end