!-------------------------------------- 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 itf_chm_vmmprep - load all fields required by the chemistry
*
#include "model_macros_f.h"
*
subroutine itf_chm_vmmprep(P_trp,P_trm,DIST_DIM,Nk) 1
*
implicit none
*
integer DIST_DIM,Nk
integer*8 P_trp(*), P_trm(*)
*
*author
* A. Kallaur - arqi - june 2005
*
*revision
* v3_30 - Kallaur A. - initial version
*
*object
*
*arguments
* Name I/O Description
*----------------------------------------------------------------
* P_trp O Pointers to tracer fields at time t+
* P_trm O Pointers to tracer fields at time t-
*----------------------------------------------------------------
*
*implicits
*
#include "glb_ld.cdk"
#include "lun.cdk"
#include "schm.cdk"
#include "vt1.cdk"
#include "vt0.cdk"
#include "itf_chm_busind.cdk"
#include "itf_phy_busind.cdk"
*
***
*
integer vmmlod,vmmget,vmmuln
external vmmlod,vmmget,vmmuln
integer err,i,j,k,n
integer keyp_,keym_
integer keyp(chmt_maxn),keym(chmt_maxn)
real trp,trm
pointer (patrp, trp(LDIST_SHAPE,Nk,*)),
$ (patrm, trm(LDIST_SHAPE,Nk,*))
*
* ---------------------------------------------------------------
*
if (.not. Schm_chems_L) then
if (Lun_out.gt.0) write(Lun_out,1000)
return
endif
keyp_ = VMM_KEY (trt1)
keym_ = VMM_KEY (trt0)
if (chmt_ntr.le.0) then
if (Lun_out.gt.0) write(Lun_out,1001)
call qqexit(1)
endif
if ((chmt_ntr+phyt_ntr).ge.chmt_maxn) then
if (Lun_out.gt.0) write(Lun_out,1002)
call qqexit(1)
endif
do n=1,chmt_ntr+phyt_ntr
keyp(n) = keyp_ + n
keym(n) = keym_ + n
end do
err = vmmlod(keyp,chmt_ntr+phyt_ntr)
err = vmmlod(keym,chmt_ntr+phyt_ntr)
do n=1,chmt_ntr
err = vmmget(keyp(n+phyt_ntr),patrp,trp)
P_trp(n) = patrp
err = vmmget(keym(n+phyt_ntr),patrm,trm)
P_trm(n) = patrm
enddo
*
1000 format(/'CHEM SWITCH=F, NO CHEM LOAD FROM VMM -> EXITING itf_chm_vmmprep'
$ /60('='))
1001 format(/'MUST HAVE AT LEAST 1 CHEM. SPECIE -> ABORT IN itf_chm_vmmprep'
$ /60('='))
1002 format(/'Asking for more than chmt_maxn -> ABORT IN itf_chm_vmmprep'
$ /60('='))
*
* ---------------------------------------------------------------
*
return
end