!-------------------------------------- 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 tr_init - Initializes tracers * #include "model_macros_f.h"*
subroutine tr_init ( hu,data_spec,bmf_time1,bmf_time2,nk,pps, 1,1 $ rna_pia,pibb,ps,vterp_lv,ni,nj,nesd ) implicit none * logical nesd integer data_spec(*),nk,bmf_time1,bmf_time2,vterp_lv,ni,nj real hu(ni,nj,*),pps(*),rna_pia(*),ps(*),pibb(*) * *author * Michel Desgagne - Sept 2001 * *revision * v2_31 - Desgagne M. - initial version * v3_00 - Desgagne & Lee - Lam configuration * v3_21 - Lee V. - remove Tr2d * *object * *arguments * *implicits #include "glb_ld.cdk"
#include "tr3d.cdk"
#include "nest.cdk"
#include "vt1.cdk"
#include "schm.cdk"
#include "itf_phy_busind.cdk"
* integer write_db_file,rewind_db_file,vmmlod,vmmget,vmmuld external write_db_file,rewind_db_file,vmmlod,vmmget,vmmuld * integer i,j,k,kk,jjj,n,err,key0,key(Tr3d_ntr) real w1(l_ni,l_nj,nk),w2(l_ni,l_nj,nk),buf(l_ni,G_nk),tr pointer (patr, tr(LDIST_SHAPE,*)) * * --------------------------------------------------------------- * if (nesd) then key0 = VMM_KEY (nest_trf) else key0 = VMM_KEY (trt1) endif do k=1,Tr3d_ntr key(k) = key0 + k end do if (Tr3d_ntr.gt.0) then err = vmmlod(key,Tr3d_ntr) do k=1,Tr3d_ntr err = vmmget(key(k),patr,tr) if (Tr3d_name_S(k).eq.'HU') then * Note that HU Schm_moist test, clipping to zero is already done in readdyn * So copy HU field from readdyn into the tracer vmm var. do n=1,G_nk do j=1,l_nj do i=1,l_ni tr(i,j,n) = hu(i,j,n) end do end do end do else * Get the other variables and interpolate them, clip them call tr_vint
(tr,Tr3d_name_S(k),Tr3d_sval(k),data_spec, $ bmf_time1,bmf_time2,nk,pps, $ rna_pia,pibb,ps,vterp_lv,LDIST_DIM) * If no moist scheme, put humid tracers to zero if (.not.Schm_moist_L) then jjj = -1 do kk = 1,h2o_ntr if (Tr3d_name_S(n).eq.h2o_name_S(kk)) jjj=kk enddo if (jjj.gt.0) then do n=1,G_nk do j=1,l_nj do i=1,l_ni tr(i,j,n)=0.0 enddo enddo enddo endif endif endif end do err = vmmuld(key,Tr3d_ntr) endif * * * --------------------------------------------------------------- * return end