!-------------------------------------- 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_simul - Controls 4-D variational job
*
#include "model_macros_f.h"
*
subroutine v4d_simul (F_indic,Ndim,F_px,F_pj,F_pgraj) 14,24
*
implicit none
*
integer F_indic,Ndim
real F_pj,F_px(Ndim),F_pgraj(Ndim)
*
*author
* M.Tanguay
*
*revision
* v2_10 - Tanguay M. - initial MPI version
* v2_21 - Desgagne M. - rpn_comm stooge for MPI
* v2_31 - Tanguay M. - adapt for tracers in tr3d
* v3_00 - Laroche S. - adapt for simplified physics
* v3_01 - Morneau J. - run NLM trajectory when V4dg_sensib_L
* and v4dg_status=5
* v3_02 - M.Tanguay - integration stops at Lctl_steplast
* v3_03 - M.Tanguay - introduce V4dg_imguv_L
* - replace v4d_procdyn by indata
* v3_11 M Tanguay - Extend TRAJ for conversion for DYNOUT2
* - ADJ of digital filter
* v3_20 M Tanguay - Replace v4d_dynout by out_dyn_ad
* v3_30 - Tanguay M. - adapt TL/AD to out_dyn
* v3_31 - Tanguay M. - Control BC
*
*object
* Simulator 4D (in minimization language).
* Controls running NLM or TLM and the adjoint.
*
*arguments
* Name I/O Description
*----------------------------------------------------------------
* F_indic I If=4 :set F_pj and F_pgraj
* If=98:set F_pgraj only
* If=99:set F_pj only
* Ndim I Dimension of F_px
* F_px I Control variable at initial time
* F_pj O Cost function value
* F_pgraj O Gradient at initial time
* F_izs - M1QN3 parameter (not used)
* F_rzs - M1QN3 parameter (not used)
* F_dzs_8 - M1QN3 parameter (not used)
*----------------------------------------------------------------
*
*implicits
#include "glb_ld.cdk"
#include "lun.cdk"
#include "v4dg.cdk"
#include "tr3d.cdk"
#include "v4dj.cdk"
#include "v4dm.cdk"
#include "lctl.cdk"
#include "rstr.cdk"
#include "ptopo.cdk"
#include "step.cdk"
#include "schm.cdk"
#include "init.cdk"
#include "v4dg_bc.cdk"
*
*modules
integer vmmlod,vmmget,vmmuld
external vmmlod,vmmget,vmmuld
*
integer ierr,k
real plocal
*
integer lunx
* ______________________________________________________
*
if ( Rstri_rstn_L ) call gem_stop('v4d_simul',-1)
* ______________________________________________________
*
* ----------------
* ADJOINT run only
* ----------------
if (F_indic.eq.98) goto 1000
*
* ---------------
* Initializations
* ---------------
*
* Update V4dm_nsim
* ----------------
if (V4dg_conf/100.eq.1.and.V4dg_status.eq.999)
% V4dm_nsim = V4dm_nsim + 1
*
* Initialize cost function
* ------------------------
if (V4dg_conf/100.eq.1.and.V4dg_status.ne.5) V4dj_pj = 0
*
* Set initial and final time step
* -------------------------------
Lctl_step = 0
V4dg_steplast = Step_total
*
* Initialize all variables to zero
* --------------------------------
call v4d_zero()
*
* Initialize model var. from control var. F_px
* --------------------------------------------
call v4d_cain (Ndim,F_px)
*
* ----------------------
* Run DIRECT integration
* ----------------------
*
if( .not.V4dg_tlm_L .or. (V4dg_sensib_L.and.V4dg_status.eq.5)) then
* ---------------
* NLM integration
* ---------------
*
* Set non-linear direct run
* -------------------------
V4dg_ds_L = .true.
V4dg_nl_L = .true.
V4dg_di_L = V4dg_ds_L.and. V4dg_nl_L
V4dg_tl_L = V4dg_ds_L.and..not.V4dg_nl_L
V4dg_ad_L = .not.V4dg_ds_L.and..not.V4dg_nl_L
*
* Set WRITE option on TRAJ WA file
* --------------------------------
V4dg_rwtr = 1
*
* Set starting ADDRESSES on TRAJ, OBS. and FORC. WA files
* -------------------------------------------------------
V4dg_addtr = 1
V4dg_addob = 1
V4dg_addfr = 1
V4dg_addph = 1 + l_ni*l_nj*l_nk
V4dg_addcv = 1
*
* Initilizations for digital filtering
* ------------------------------------
if( Init_balgm_L ) Rstri_idon_L = .false.
*
* Write trajectory for conversion if requested
* --------------------------------------------
if( V4dg_oktrcv_L ) call v4d_rwconv0
*
* Complete preprocessing
* ----------------------
V4dg_part = 3
call indata()
*
call out_dyn (.true.,-1)
*
* Run NLM model
* -------------
call gem_ctrl()
*
else
* ---------------
* TLM integration
* ---------------
*
* Set linear direct run
* ---------------------
V4dg_ds_L = .true.
V4dg_nl_L = .false.
V4dg_di_L = V4dg_ds_L.and. V4dg_nl_L
V4dg_tl_L = V4dg_ds_L.and..not.V4dg_nl_L
V4dg_ad_L = .not.V4dg_ds_L.and..not.V4dg_nl_L
*
* Set READ option on TRAJ WA file
* -------------------------------
V4dg_rwtr = 0
*
* Set starting ADDRESSES on OBS. and FORC. WA files
* NOTE: TRAJ WA file address is in V4dg_addtab_tl
* -------------------------------------------------
V4dg_addfr = 1
V4dg_addob = 1
V4dg_addph = 1 + l_ni*l_nj*l_nk
V4dg_addcv = 1
*
* Initilizations for digital filtering
* ------------------------------------
if( Init_balgm_L ) Rstri_idon_L = .false.
*
if (G_lam.and.V4dg_bc_variant.eq.1) call v4d_set_bc_0
if (G_lam.and.V4dg_bc_variant.eq.1) call v4d_set_bc_t_from_bc_0
*
* Read trajectory for conversion if requested
* -------------------------------------------
call v4d_rwconv0
*
* Complete preprocessing
* ----------------------
V4dg_part = 3
call indata_tl()
*
call out_dyn (.true.,-1)
*
* Run TLM model
* -------------
call gem_ctrl_tl()
*
endif
*
* ------------------------------
* Synthesis of the cost function
* ------------------------------
if( V4dg_conf/100.eq.1.and.V4dg_status.ne.5 ) then
*
F_pj = V4dj_pj
plocal = F_pj
F_pj = 0.0
call rpn_comm_Allreduce (plocal,F_pj,1,"MPI_REAL","MPI_SUM",
% "grid",ierr)
*
endif
*
if(F_indic.eq.99) return
*
if(F_indic.ne. 4) call gem_stop('v4d_simul',-1)
*
* ----------------------------------------------------------------
* Evaluate gradient of cost function with respect to initial state
* ----------------------------------------------------------------
*
* Set gradients (F_pgraj) to zero
* -------------------------------
do k = 1,Ndim
F_pgraj(k) = 0.
end do
*
1000 continue
*
* Set initial and final time step
* -------------------------------
Lctl_step = Step_total
V4dg_steplast = 0
*
* Set adjoint variables to zero
* -----------------------------
call v4d_zero()
*
* Initialize ADJ variables from control F_pgradj
* ----------------------------------------------
call v4d_cainin_ad (Ndim,F_pgraj)
*
* Set ADJ integration
* -------------------
V4dg_ds_L = .false.
V4dg_nl_L = .false.
V4dg_di_L = V4dg_ds_L.and. V4dg_nl_L
V4dg_tl_L = V4dg_ds_L.and..not.V4dg_nl_L
V4dg_ad_L = .not.V4dg_ds_L.and..not.V4dg_nl_L
*
* Set READ option on TRAJ WA file
* -------------------------------
V4dg_rwtr = 0
*
* ----
* NOTE
* -----------------------------------------
* OBS. WA file address is in V4dg_addob
* FORC.WA file address is in V4dg_addfr
* TRAJ WA file address is in V4dg_addtab_ad
* -----------------------------------------
V4dg_addfr = V4dg_addfr - l_ni*l_nj
V4dg_addob = V4dg_addob - l_ni*l_nj
V4dg_addph = V4dg_addph - l_ni*l_nj*l_nk
V4dg_addcv = V4dg_addcv - l_ni*l_nj
*
* Initilizations for digital filtering
* ------------------------------------
if( Init_balgm_L ) Rstri_idon_L = .true.
*
* Run ADJ model
* -------------
call gem_ctrl_ad()
*
* ADJOINT of
* Complete preprocessing
* ----------------------
V4dg_part = 3
call indata_ad()
*
if (G_lam.and.V4dg_bc_variant.eq.1) call v4d_set_bc_t_from_bc_0_ad
if (G_lam.and.V4dg_bc_variant.eq.1) call v4d_set_bc_0_ad
*
* Read trajectory for conversion at initial time
* ----------------------------------------------
call v4d_rwconv0()
*
* Output adjoint fields knowing that u,v are true winds
* -----------------------------------------------------
if (V4dg_output_L) then
*
V4dg_imguv_L = .false.
*
call v4d_blocstat ()
call out_dyn_ad()
*
V4dg_imguv_L = .true.
*
endif
*
* Initialise control F_pgraj from ADJ variables
* ---------------------------------------------
call v4d_cain_ad (Ndim,F_pgraj)
*
return
end