!-------------------------------------- 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 indata_ad - ADJ of indata_tl
*
#include "model_macros_f.h"
*
subroutine indata_ad 3,2
*
#include "impnone.cdk"
*
*author
* M.Tanguay
*
*revision
* v3_03 - Tanguay M. - initial MPI version
* v3_30 - Tanguay M. - adapt to bcs
*
*object
* see id section
*
*#############################################
* REMARK: INPUT TRAJECTORY: tpt1m,st1m,um,vm
*#############################################
*
*arguments
* none
*
*implicits
#include "schm.cdk"
#include "glb_ld.cdk"
#include "v4dg.cdk"
#include "ind.cdk"
#include "indm.cdk"
#include "p_geof.cdk"
#include "vt1.cdk"
#include "vtx.cdk"
#include "vt1m.cdk"
#include "vtxm.cdk"
*
integer vmmlod,vmmget,vmmuld
external vmmlod,vmmget,vmmuld
*
integer key1(50),nvar,err,i,j,k
* ______________________________________________________
*
* ----------------------------------------
* Recover TRAJ initial state
* for Preprocessing of Dependent variables
* ----------------------------------------
call v4d_rwtraj (1)
*
* ADJ of
* -------------------------------------------------
* Performs preprocessing of the dynamics input data
* -------------------------------------------------
*
* Get VMM fields in memory
* ------------------------
key1( 1) = VMM_KEY( fit1)
key1( 2) = VMM_KEY( ut1)
key1( 3) = VMM_KEY( vt1)
key1( 4) = VMM_KEY( tt1)
key1( 5) = VMM_KEY( qt1)
key1( 6) = VMM_KEY(fipt1)
key1( 7) = VMM_KEY( st1)
key1( 8) = VMM_KEY(pipt1)
key1( 9) = VMM_KEY( tpt1)
key1(10) = VMM_KEY(tplt1)
key1(11) = VMM_KEY( gptx)
key1(12) = VMM_KEY(psdt1)
key1(13) = VMM_KEY( tdt1)
key1(14) = VMM_KEY( topo)
nvar=14
*
if (.not. Schm_hydro_L) then
key1(nvar+1) = VMM_KEY(wt1)
key1(nvar+2) = VMM_KEY(mut1)
key1(nvar+3) = VMM_KEY(multx)
key1(nvar+4) = VMM_KEY(qpt1)
nvar=nvar+4
endif
*
* TRAJECTORY
* ----------
key1( nvar+ 1) = VMM_KEY( fit1m)
key1( nvar+ 2) = VMM_KEY( ut1m)
key1( nvar+ 3) = VMM_KEY( vt1m)
key1( nvar+ 4) = VMM_KEY( tt1m)
key1( nvar+ 5) = VMM_KEY( qt1m)
key1( nvar+ 6) = VMM_KEY(fipt1m)
key1( nvar+ 7) = VMM_KEY( st1m)
key1( nvar+ 8) = VMM_KEY(pipt1m)
key1( nvar+ 9) = VMM_KEY( tpt1m)
key1( nvar+10) = VMM_KEY(tplt1m)
key1( nvar+11) = VMM_KEY( gptxm)
key1( nvar+12) = VMM_KEY(psdt1m)
key1( nvar+13) = VMM_KEY( tdt1m)
nvar= nvar+13
*
if (.not. Schm_hydro_L) then
key1(nvar+1) = VMM_KEY(wt1m)
key1(nvar+2) = VMM_KEY(mut1m)
key1(nvar+3) = VMM_KEY(multxm)
key1(nvar+4) = VMM_KEY(qpt1m)
nvar=nvar+4
endif
*
err = vmmlod(key1,nvar)
*
err = VMM_GET_VAR( fit1)
err = VMM_GET_VAR( ut1)
err = VMM_GET_VAR( vt1)
err = VMM_GET_VAR( tt1)
err = VMM_GET_VAR( qt1)
err = VMM_GET_VAR(fipt1)
err = VMM_GET_VAR( st1)
err = VMM_GET_VAR(pipt1)
err = VMM_GET_VAR( tpt1)
err = VMM_GET_VAR(tplt1)
err = VMM_GET_VAR( gptx)
err = VMM_GET_VAR(psdt1)
err = VMM_GET_VAR( tdt1)
err = VMM_GET_VAR( topo)
*
Ind_fi_ = fit1_
Ind_u_ = ut1_
Ind_v_ = vt1_
Ind_t_ = tt1_
Ind_q_ = qt1_
Ind_fip_ = fipt1_
Ind_s_ = st1_
Ind_pip_ = pipt1_
Ind_tp_ = tpt1_
Ind_tpl_ = tplt1_
Ind_gp_ = gptx_
Ind_psd_ = psdt1_
Ind_td_ = tdt1_
Ind_topo_= topo_
*
if (.not. Schm_hydro_L) then
err = VMM_GET_VAR( wt1)
err = VMM_GET_VAR( mut1)
err = VMM_GET_VAR(multx)
err = VMM_GET_VAR( qpt1)
*
Ind_w_ = wt1_
Ind_mu_ = mut1_
Ind_mul_ = multx_
Ind_qp_ = qpt1_
endif
*
* TRAJECTORY
* ----------
err = VMM_GET_VAR( fit1m)
err = VMM_GET_VAR( ut1m)
err = VMM_GET_VAR( vt1m)
err = VMM_GET_VAR( tt1m)
err = VMM_GET_VAR( qt1m)
err = VMM_GET_VAR(fipt1m)
err = VMM_GET_VAR( st1m)
err = VMM_GET_VAR(pipt1m)
err = VMM_GET_VAR( tpt1m)
err = VMM_GET_VAR(tplt1m)
err = VMM_GET_VAR( gptxm)
err = VMM_GET_VAR(psdt1m)
err = VMM_GET_VAR( tdt1m)
*
Indm_fim_ = fit1m_
Indm_um_ = ut1m_
Indm_vm_ = vt1m_
Indm_tm_ = tt1m_
Indm_qm_ = qt1m_
Indm_fipm_ = fipt1m_
Indm_sm_ = st1m_
Indm_pipm_ = pipt1m_
Indm_tpm_ = tpt1m_
Indm_tplm_ = tplt1m_
Indm_gpm_ = gptxm_
Indm_psdm_ = psdt1m_
Indm_tdm_ = tdt1m_
*
if (.not. Schm_hydro_L) then
err = VMM_GET_VAR( wt1m)
err = VMM_GET_VAR( mut1m)
err = VMM_GET_VAR(multxm)
err = VMM_GET_VAR( qpt1m)
*
Indm_wm_ = wt1m_
Indm_mum_ = mut1m_
Indm_mulm_ = multxm_
Indm_qpm_ = qpt1m_
endif
*
* ADJ of
* Set qp=0 explicitly when .not.Schm_hydro_L and 4D-Var
* -----------------------------------------------------
if(.not.Schm_hydro_L) then
*
do k=1,G_nk
do j=1,l_nj
do i=1,l_ni
*
Ind_qp(i,j,k) = 0.0
*
end do
end do
end do
*
endif
*
* ADJ of Preprocessing of Dependent variables only if V4dg_part=3
* ---------------------------------------------------------------
call v4d_predat_ad( )
*
err = vmmuld(-1,0)
*
* ---------------------------------------------------------------
*
return
end