!-------------------------------------- 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_4dvar - Control of Main Event Loop of 4D-Var based on GEM model
*
#include "model_macros_f.h"
*
subroutine v4d_4dvar 1,96
*
*author
* P. Gauthier
*
*revision
* v3_00 P. Gauthier - initial version
* v3_00 M. Tanguay - adapt to Simon's exchange
* v3_01 - M. Tanguay - introduce gem2gauss for singular vectors
* - introduce identity option
* v3_02 - M. Tanguay - address of Physics WA file
* v3_02 M. Buehner - introduce events for SV's: TLMX, ADJX, NLMX
* - loop to divide integrations into a number of segments (for SV job)
* - initialize norm and file for total energy output (for SV job)
* - leave winds as images after 3hr integration
* - do not initialize Pr_nsim4d (read from init.prof)
* - introduce ESRS event for restart of 4dvar/SV job
* v3_03 M. Tanguay - replace v4d_procdyn by indata
* v3_11 M. Tanguay - Extend TRAJ for conversion for DYNOUT2
* - Introduce Pr_nevent=EVN_TLME
* - Introduce V4dg_oktrcv_L
* - Add V4dg_part=2 before first call to indata
* - ADJ of digital filter
* v3_11 S. Pellerin - PROF file opening done by each proc
* v3_20 M. Tanguay - Move getevent before NLM
* - Correction about V4dg_imguv_L when ADJ
* v3_20 A. Zadra - Introduce V4dg_sgvc_dt0
* v3_30 - Tanguay M. - adapt TL/AD to out_dyn
* v3_31 - Tanguay M. - Control BC
*
*object
* Initialize the TLM/Adjoint and set-up an externally controlled Event Loop
*
*arguments
* none
*
*implicits
use v4d_prof, only: Pr_nsim4d,Pr_wopen_L,Pr_ropen_L,Pr_ihdlout,Pr_traj0to9_L,
% Pr_nevent
*
implicit none
*
#include "lun.cdk"
#include "glb_ld.cdk"
#include "v4dg.cdk"
#include "lctl.cdk"
#include "ptopo.cdk"
#include "step.cdk"
#include <prof_f.h>
#include "cstv.cdk"
#include "path.cdk"
#include <clib_interface.cdk>
#include "init.cdk"
#include "rstr.cdk"
#include "v4dg_bc.cdk"
*
integer ierr, nevent, nstatus, keepsteptotal,iseg_steptotal,isv_step
integer fnom,fclos
logical keep_identity_L,done_nlm_L
character(len=8) csimno_S
data done_nlm_L/.false./
save done_nlm_L
*
integer location
*
* ______________________________________________________
*
if(Pr_traj0to9_L.and.(Step_total+nint((3*3600.)/Cstv_dt_8)).gt.Step_rsti) then
write(Lun_out,*) '>>> V4D_4DVAR:: Step_rsti too small'
call gem_stop('v4d_4dvar',-1)
endif
* ______________________________________________________
*
call tmg_start0(29,'EVALL ')
*
call tmg_start0(28,'EVNL0 ')
location = 0
*
* /---------------------------------\
* < Main Event Loop >
* \---------------------------------/
*
nstatus = 0
event_loop: do while (nstatus.eq.0)
*
Call v4d_getevent(Lun_out,nevent,nstatus,Ptopo_myproc)
*
if (location.eq.0) then
call tmg_stop0(28)
endif
*
if (location.eq.1) then
call tmg_stop0(27)
endif
*
if (location.eq.2) then
call tmg_stop0(26)
endif
*
* -------------------------------------
* NLM trajectory done only once (START)
* -------------------------------------
if (.not.done_nlm_L) then
call tmg_start0(25,'EVNLM ')
*
* 1. Creation of reference trajectory
*
* --------------------------------------
* Read given analysis of model variables
* --------------------------------------
write(Lun_out,fmt='(//''-------------------------------------------'')')
write(Lun_out,fmt='( ''V4D_4DVar- 4D-VARIATIONAL JOB with CONF = '',I6)') V4dg_conf
write(Lun_out,fmt='( ''-------------------------------------------'')')
write(Lun_out,fmt='(//''--------------------------------------'')')
write(Lun_out,fmt='( ''READ ANALYSIS for reference trajectory'')')
write(Lun_out,fmt='( ''--------------------------------------'')')
*
V4dg_part = 2
call indata()
*
if(Ptopo_myproc.eq.0.and.V4dg_sgvc_L) then
V4dg_iunenrgy=0
write(csimno_S,fmt='(i4)') Pr_nsim4d
csimno_S=adjustl(csimno_S)
ierr = FNOM(V4dg_iunenrgy,trim(Path_output_S)//
+ '/tlmenergy.dat'//trim(csimno_S),'SEQ+FTN+FMT',0)
write(Lun_out,*) "OPENED ENERGY FILE ",V4dg_iunenrgy,
+ trim(csimno_S)
endif
*
* 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 number of segments to 1 if this is not an SV job
* ----------------------------------------------------
if(.not.V4dg_sgvc_L) V4dg_numseg=1
*
if(Pr_traj0to9_L) then
* -----------------------------------------------------------------------
* NOTE: Done if the giving analysis starts at 0Z instead of 3Z
* Do REFERENCE integration over 3 hr and prepare an additional 6 hr
* -----------------------------------------------------------------------
*
* PART1 = REFERENCE integration over 3 hr without keeping TRAJ
* ------------------------------------------------------------
*
keep_identity_L = V4dg_identity_L
V4dg_identity_L = .false.
*
* Set status of the 0-3 integration period (REFERENCE integration)
* -----------------------------------------------------------------
V4dg_status = 99
*
* Set Step_total to cover a 3 hr period or N hr period (N = V4dg_sgvc_dt0)
* ------------------------------------------------------------------------
keepsteptotal = Step_total
if(.not.V4dg_sgvc_L) Step_total = nint( (3 *3600.)/Cstv_dt_8 )
if( V4dg_sgvc_L) Step_total = nint( (V4dg_sgvc_dt0*3600.)/Cstv_dt_8 )
*
* Set over-riding switch for dynout and blocstat
* ----------------------------------------------
if(.not.V4dg_sgvc_L) V4dg_output_L = .false.
if( V4dg_sgvc_L) V4dg_output_L = .true.
*
* Set initial and final time step
* -------------------------------
Lctl_step = 0
V4dg_steplast = Step_total
*
* Set no WRITE option on TRAJ Vmm WA file
* ---------------------------------------
V4dg_oktr_L = .false.
*
* Set no WRITE option on TRAJ Conversion file
* -------------------------------------------
V4dg_oktrcv_L = .false.
*
* Initilizations for digital filtering
* ------------------------------------
if( Init_balgm_L ) Rstri_idon_L = .false.
*
* Complete the preprocessing (derived fields)
* -------------------------------------------
V4dg_part = 3
call indata
*
* Run NLM model
* -------------
call tmg_start0(70,'NLM ')
call gem_ctrl
call tmg_stop0(70)
*
write(Lun_out,*) '>>> V4D_4DVAR:: End of 3 hr nonlinear integration over 0-3'
*
* PART2 = Prepare REFERENCE integration over an additional 6 hr
* -------------------------------------------------------------
*
V4dg_identity_L = keep_identity_L
*
* Reset original Step_total
* -------------------------
Step_total = keepsteptotal
*
endif
*
* Set status of the nonlinear REFERENCE integration
* -------------------------------------------------
V4dg_status = 9
*
* Set over-riding switch for dynout and blocstat
* ----------------------------------------------
V4dg_output_L = .true.
*
* Initialize addresses of TRAJ Vmm/Conversion WA files
* ----------------------------------------------------
V4dg_addtr = 1
V4dg_addcv = 1
V4dg_addnl = 1
V4dg_addph = 1 + l_ni*l_nj*l_nk
*
* Prepare and Write reference trajectory at initial time for NL evolution of perturbation
* ---------------------------------------------------------------------------------------
if(V4dg_sgvc_L) then
Lctl_step = 0
V4dg_rwnl = 1
call v4d_rwnlpert()
endif
*
* Set WRITE option on TRAJ Vmm WA file
* ------------------------------------
V4dg_oktr_L = .true.
V4dg_rwtr = 1
*
* Set WRITE option on TRAJ Conversion file
* ----------------------------------------
V4dg_oktrcv_L = .true.
*
* Initilizations for digital filtering
* ------------------------------------
if( Init_balgm_L ) Rstri_idon_L = .false.
*
* Set number of timesteps per segment
* -----------------------------------
iseg_steptotal = Step_total/V4dg_numseg
write(Lun_out,*) 'steps=',iseg_steptotal,Step_total,V4dg_numseg
*
* Loop over number of segments in trajectory
* ------------------------------------------
do isv_step=1,V4dg_numseg
*
* Set initial and final time steps
* --------------------------------
Lctl_step = (isv_step-1)*iseg_steptotal
V4dg_steplast = isv_step *iseg_steptotal
write(Lun_out,*) 'first and last steps=',isv_step,Lctl_step,V4dg_steplast
*
* Write trajectory for conversion at initial time
* -----------------------------------------------
V4dg_rwcv = 1
call v4d_rwconv()
*
* Complete the preprocessing (derived fields)
* -------------------------------------------
if(isv_step.eq.1) then
V4dg_part = 3
call indata
else
call v4d_rwtraj (1)
endif
*
call out_dyn (.true.,-1)
*
* Run NLM model
* -------------
call tmg_start0(70,'NLM ' )
call gem_ctrl
call tmg_stop0(70)
*
enddo
*
if(V4dg_sgvc_L) then
*
* Write trajectory for conversion at final time
* ---------------------------------------------
V4dg_rwcv = 1
call v4d_rwconv()
*
* Prepare and Write reference trajectory at final time for NL evolution of perturbation
* -------------------------------------------------------------------------------------
V4dg_rwnl = 1
call v4d_rwnlpert()
*
endif
*
write(Lun_out,*) '>>> V4D_4DVAR:: End of nonlinear integration over assimilation period'
*
done_nlm_L = .true.
*
call tmg_stop0(25)
*
* -----------------------------------
* NLM trajectory done only once (END)
* -----------------------------------
endif
*
if(Ptopo_myproc.eq.0) then
*
* Get the event to know what to do next
* -------------------------------------
*
Pr_nevent = nevent
*
write(Lun_out,*) '>>> V4D_4DVAR:: Processing event = ', nevent,' status = ',nstatus
*
end if
*
call rpn_comm_bcast( nevent, 1,"MPI_INTEGER",0,"GRID",ierr)
call rpn_comm_bcast(Pr_nevent, 1,"MPI_INTEGER",0,"GRID",ierr)
call rpn_comm_bcast(nstatus, 1,"MPI_INTEGER",0,"GRID",ierr)
*
* Select Case ---------------
*
* ------------------------------------
* ===> EVN_TLMO: Integration of TLM model
* ------------------------------------
if(nevent.eq.EVN_TLMO) then
call tmg_start0(24,'EVTLM ')
*
Pr_nsim4d = Pr_nsim4d + 1
*
write(Lun_out,*) '>>> V4D_4DVAR:: Integration of TLM - Nevent = '
% ,nevent,' EVN_TLMO = ',EVN_TLMO,' NSIM4D = ',Pr_nsim4d
*
* Zero variables
* --------------
call v4d_zero()
*
* 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
*
* A. Input: initial conditions and convert variables 3D-Var --> GEM
*
* Set initial and last time step
* ------------------------------
Lctl_step = 0
V4dg_steplast = Step_total
*
* Set READ option on TRAJ Vmm WA file
* -----------------------------------
V4dg_rwtr = 0
*
* Reset addresses of TRAJ Conversion/Physics WA files
* ---------------------------------------------------
V4dg_addcv = 1
V4dg_addph = 1 + l_ni*l_nj*l_nk
*
* Initilizations for digital filtering
* ------------------------------------
if( Init_balgm_L ) Rstri_idon_L = .false.
*
* Read trajectory for conversion at initial time
* ----------------------------------------------
call v4d_rwconv0()
*
* Read increments from 3D-Var and prepare them for GEM
* ----------------------------------------------------
call tmg_start0(23,'GET ')
call v4d_getdx(nstatus)
call tmg_stop0(23)
*
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
*
* B. Run the tangent linear model
*
if(nstatus.eq.0) then
*
* Set status of the integration
* -----------------------------
V4dg_status = 0
*
* Complete the preprocessing (derived fields)
* -------------------------------------------
V4dg_part = 3
call indata_tl()
*
* Set over-riding switch for dynout and blocstat
* ----------------------------------------------
V4dg_output_L = .false.
*
call out_dyn (.true.,-1)
*
* Run TLM model
* -------------
call tmg_start0(71,'TLM ' )
call gem_ctrl_tl()
call tmg_stop0(71)
*
* C. Output to 3D-Var: model profiles interpolated at obs. locations
*
* Close dwyf PROF file to be used by 3D-Var
* -----------------------------------------
write(Lun_out,*) '>>> V4D_4DVAR:: Closing dwyf MODEL-PROFILE output file'
ierr = prof_close(Pr_ihdlout)
*
if(ierr .lt. 0) then
write(Lun_out,*) '>>> V4D_4DVAR:: Error in closing dwyf PROF file'
nstatus = -99
endif
*
* Set write/read flags for the next iteration
* -------------------------------------------
Pr_wopen_L = .false.
Pr_ropen_L = .false.
*
if(nstatus.eq.0) then
write(Lun_out,*) '>>> V4D_4DVAR:: End of TLM integration NSIM4D = ',Pr_nsim4d
*
else
write(Lun_out,*) '>>> V4D_4DVAR:: Problem in writing dwyf PROF file nstatus = ',
% nstatus
nstatus = -99
endif
*
else
write(Lun_out,*) '>>> V4D_4DVAR:: Problem in getting dwgf PROF file at initial time nstatus = ',
% nstatus
nstatus = -99
endif
*
call tmg_stop0(24)
*
call tmg_start0(27,'EVTL0 ')
location = 1
*
* --------------------------------------------------
* ===> EVN_ADJM: Backward integration of Adjoint Model
* --------------------------------------------------
else if (nevent.eq.EVN_ADJM) then
call tmg_start0(22,'EVADM ')
*
write(Lun_out,*) '>>> V4D_4DVAR:: Backward Integration of Adjoint - Nevent = '
% ,nevent,' EVN_ADJM = ',EVN_ADJM,' NSIM4D = ',Pr_nsim4d
*
* A. Input from 3D-Var: adjoint model states interpolated at obs. locations
*
* Set status of the integration
* -----------------------------
V4dg_status = 0
*
* Set initial and final time step
* -------------------------------
Lctl_step = Step_total
V4dg_steplast = 0
*
* Zero adjoint variables
* ----------------------
call v4d_zero()
*
* 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 Vmm WA file
* -----------------------------------
V4dg_rwtr = 0
*
* Reset addresses of TRAJ Conversion/Physics WA files
* ---------------------------------------------------
V4dg_addcv = V4dg_addcv - l_ni*l_nj
V4dg_addph = V4dg_addph - l_ni*l_nj*l_nk
*
* Initilizations for digital filtering
* ------------------------------------
if( Init_balgm_L ) Rstri_idon_L = .true.
*
* B. Run the adjoint model backward
*
if(nstatus.eq.0) then
*
* Set over-riding switch for dynout and blocstat
* ----------------------------------------------
V4dg_output_L = .false.
if(Pr_nsim4d.eq.1) V4dg_output_L = .true.
*
* Run ADJ model
* -------------
call tmg_start0(72,'ADJ ' )
call gem_ctrl_ad()
call tmg_stop0(72)
*
* Read trajectory for conversion at initial time
* ----------------------------------------------
call v4d_rwconv0()
*
* ADJOINT of
* Complete the preprocessing (derived fields)
* -------------------------------------------
V4dg_part = 3
call indata_ad()
*
if (V4dg_output_L) call out_dyn_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
*
* C. Output: (Delta X)^* = grad J_o
*
* Prepare and Write adjoint increments to be read by 3D-Var
* ---------------------------------------------------------
call tmg_start0(21,'PUT ')
call v4d_putdx(nstatus)
call tmg_stop0(21)
*
if(nstatus.eq.0) then
write(Lun_out,*) '>>> V4D_4DVAR:: End of ADJ integration NSIM4D = ',Pr_nsim4d
*
else
write(Lun_out,*) '>>> V4D_4DVAR:: Problem in writing dwga PROF at initial time file nstatus = ',
% nstatus
nstatus = -99
end if
*
else
write(Lun_out,*) '>>> V4D_4DVAR:: Problem in getting dwya PROF file nstatus = ',
% nstatus
nstatus = -99
end if
call tmg_stop0(22)
*
call tmg_start0(26,'EVAD0 ')
location = 2
*
* ----------------------------------------------------------
* ===> EVN_NLMO: Forward Integration of Direct Nonlinear Model
* ----------------------------------------------------------
else if(nevent.eq.EVN_NLMO) then
*
write(Lun_out,*) '>>> V4D_4DVAR:: NOT DONE YET End of Job - Nevent = '
% ,nevent,' EVN_NLMO = ',EVN_NLMO
nstatus = -99
*
* ---------------------------------------------------------
* ===> EVN_TLMX: Integration of TLM model for singular vectors
* ---------------------------------------------------------
else if(nevent.eq.EVN_TLMX) then
*
Pr_nsim4d = Pr_nsim4d + 1
*
write(Lun_out,*) '>>> V4D_4DVAR:: Integration of TLM - Nevent = '
% ,nevent,' EVN_TLMX = ',EVN_TLMX,' NSIM4D = ',Pr_nsim4d
*
* Zero variables
* --------------
call v4d_zero()
*
* 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 over-riding switch for dynout and blocstat
* ----------------------------------------------
V4dg_output_L = .true.
*
* Set READ option on TRAJ Vmm WA file
* -----------------------------------
V4dg_rwtr = 0
*
* Reset addresses of TRAJ Conversion/Physics WA files
* ---------------------------------------------------
V4dg_addcv = 1
V4dg_addph = 1 + l_ni*l_nj*l_nk
*
* Initilizations for digital filtering
* ------------------------------------
if( Init_balgm_L ) Rstri_idon_L = .false.
*
* Read trajectory for conversion at initial time
* ----------------------------------------------
V4dg_rwcv = 0
call v4d_rwconv()
*
if(Ptopo_myproc.eq.0) then
write(V4dg_iunenrgy,*) "INTEGRATION #",Pr_nsim4d
endif
*
* Loop over segments
* ------------------
do isv_step=1,V4dg_numseg
*
* Get Event name if not first time (to make sure file is erased)
*
if(isv_step.gt.1) then
C if(Ptopo_myproc.eq.0) then
Call v4d_getevent(Lun_out,nevent,nstatus,Ptopo_myproc)
write(Lun_out,*) isv_step,' Event = ', nevent,' status = ',nstatus
C endif
endif
*
* Set initial and final time steps
* --------------------------------
Lctl_step = (isv_step-1)*iseg_steptotal
V4dg_steplast = isv_step *iseg_steptotal
write(Lun_out,*) 'first and last steps=',isv_step,Lctl_step,V4dg_steplast
*
* A. Input from 3D-Var: TLM Model state at initial time
*
* Read increments from 3D-Var and prepare them for GEM
* ----------------------------------------------------
call v4d_getdx(nstatus)
*
* B. Run the tangent linear model
*
if(nstatus.eq.0) then
*
* Set status of the integration
* -----------------------------
V4dg_status = 0
*
* Complete the preprocessing (derived fields)
* -------------------------------------------
V4dg_part = 3
call indata_tl()
*
call out_dyn (.true.,-1)
*
* Run TLM model
* -------------
call gem_ctrl_tl()
*
* C. Output to 3D-Var: TLM Model state at final time
*
* Read trajectory for conversion at final time
* --------------------------------------------
V4dg_rwcv = 0
call v4d_rwconv()
*
* Write increments to be read by 3D-Var
* -------------------------------------
call v4d_putdx(nstatus)
*
if(nstatus.eq.0) then
write(Lun_out,*) '>>> V4D_4DVAR:: End of TLM integration NSIM4D = ',Pr_nsim4d
*
else
write(Lun_out,*) '>>> V4D_4DVAR:: Problem in writing dwgf PROF file at final time nstatus = ',
% nstatus
nstatus = -99
endif
*
else
write(Lun_out,*) '>>> V4D_4DVAR:: Problem in getting dwgf PROF file at initial time nstatus = ',
% nstatus
nstatus = -99
endif
*
enddo
*
* ----------------------------------------------------------------------
* ===> EVN_ADJX: Backward integration of Adjoint Model for singular vectors
* ----------------------------------------------------------------------
else if (nevent.eq.EVN_ADJX) then
*
write(Lun_out,*) '>>> V4D_4DVAR:: Backward Integration of Adjoint - Nevent = '
% ,nevent,' EVN_ADJX = ',EVN_ADJX,' NSIM4D = ',Pr_nsim4d
*
* Zero adjoint variables
* ----------------------
call v4d_zero()
*
* 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 over-riding switch for dynout and blocstat
* ----------------------------------------------
V4dg_output_L = .true.
*
* Set READ option on TRAJ Vmm WA file
* -----------------------------------
V4dg_rwtr = 0
*
* Reset addresses of TRAJ Conversion/Physics WA files
* ---------------------------------------------------
V4dg_addcv = V4dg_addcv - l_ni*l_nj
V4dg_addph = V4dg_addph - l_ni*l_nj*l_nk
*
* Initilizations for digital filtering
* ------------------------------------
if( Init_balgm_L ) Rstri_idon_L = .true.
*
* Read trajectory for conversion at final time
* --------------------------------------------
V4dg_rwcv = 0
call v4d_rwconv()
*
* Loop over segments
* ------------------
do isv_step=V4dg_numseg,1,-1
*
* Get Event name if not first time (to make sure file is erased)
*
if(isv_step.lt.V4dg_numseg) then
C if(Ptopo_myproc.eq.0) then
Call v4d_getevent(Lun_out,nevent,nstatus,Ptopo_myproc)
write(Lun_out,*) isv_step,' Event = ', nevent,' status = ',nstatus
C endif
endif
*
* Set initial and final time steps
* --------------------------------
Lctl_step = isv_step *iseg_steptotal
V4dg_steplast = (isv_step-1)*iseg_steptotal
write(Lun_out,*) 'first and last steps=',isv_step,Lctl_step,V4dg_steplast
*
* A. Input from 3D-Var: ADJ model states at final time
*
* Read adjoint increments from 3D-Var and prepare them for GEM
* ------------------------------------------------------------
call v4d_getdx(nstatus)
*
* B. Run the adjoint model backward
*
if(nstatus.eq.0) then
*
* Set status of the integration
* -----------------------------
V4dg_status = 0
*
* Run ADJ model
* -------------
call gem_ctrl_ad()
*
* Read trajectory for conversion at initial time
* ----------------------------------------------
V4dg_rwcv = 0
call v4d_rwconv()
*
* ADJOINT of
* Complete the preprocessing (derived fields)
* -------------------------------------------
V4dg_part = 3
call indata_ad()
*
if (V4dg_output_L) call out_dyn_ad()
*
* C. Output to 3D-Var: ADJ Model state at initial time
*
* Prepare and Write adjoint increments to be read by 3D-Var
* ---------------------------------------------------------
call v4d_putdx(nstatus)
*
if(nstatus.eq.0) then
write(Lun_out,*) '>>> V4D_4DVAR:: End of ADJ integration NSIM4D = ',Pr_nsim4d
*
else
write(Lun_out,*) '>>> V4D_4DVAR:: Problem in writing dwga PROF file at initial time nstatus = ',
% nstatus
nstatus = -99
end if
*
else
write(Lun_out,*) '>>> V4D_4DVAR:: Problem in getting dwga PROF file at final time nstatus = ',
% nstatus
nstatus = -99
end if
*
enddo
*
* ----------------------------------------------------------
* ===> EVN_NLMX: Non-Linear (NL) Evolution of Perturbation
* ----------------------------------------------------------
else if(nevent.eq.EVN_NLMX) then
*
Pr_nsim4d = Pr_nsim4d + 1
*
write(Lun_out,*) '>>> V4D_4DVAR:: NL Evolution of Perturbation - Nevent = '
% ,nevent,' EVN_NLMX = ',EVN_NLMX
*
* Zero variables
* --------------
call v4d_zero()
*
* 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 initial time step
* ---------------------
Lctl_step = 0
*
* Reset address of TRAJ Conversion WA file
* ----------------------------------------
V4dg_addcv = 1
V4dg_addnl = 1
*
* Read trajectory for conversion at initial time
* ----------------------------------------------
V4dg_rwcv = 0
call v4d_rwconv()
*
* Set status of the integration period
* ------------------------------------
V4dg_status = 8
*
* Set over-riding switch for dynout and blocstat
* ----------------------------------------------
V4dg_output_L = .true.
*
* Turn off WRITE option TRAJ Vmm WA file
* --------------------------------------
V4dg_oktr_L = .false.
*
* Turn off WRITE option TRAJ Conversion WA file
* ---------------------------------------------
V4dg_oktrcv_L = .false.
*
* Initilizations for digital filtering
* ------------------------------------
if( Init_balgm_L ) Rstri_idon_L = .false.
*
if(Ptopo_myproc.eq.0) then
write(V4dg_iunenrgy,*) "INTEGRATION #",Pr_nsim4d
endif
*
* Loop over segments
* ------------------
do isv_step=1,V4dg_numseg
*
* ***NOTE***: the NLMX integration only requires a single put and get from the 3Dvar,
* but still performed in a loop to ensure proper handling of rwconv
*
* Set initial and final time steps
* --------------------------------
Lctl_step = (isv_step-1)*iseg_steptotal
V4dg_steplast = isv_step *iseg_steptotal
write(Lun_out,*) 'first and last steps=',isv_step,Lctl_step,V4dg_steplast
*
* A. Input from 3D-Var: TLM Model state ONLY at the initial time
*
if(isv_step.eq.1) then
*
* Read increments from 3D-Var and prepare them for GEM
* ----------------------------------------------------
call v4d_getdx(nstatus)
if(nstatus.ne.0) then
write(Lun_out,*) '>>> V4D_4DVAR:: Problem in getting file from 3Dvar nstatus = ',
% nstatus
nstatus = -99
endif
*
* Read reference trajectory at initial time and add to increment
* --------------------------------------------------------------
V4dg_rwnl = 0
call v4d_rwnlpert()
*
* Complete the preprocessing (derived fields) only at initial timestep
* --------------------------------------------------------------------
V4dg_part = 3
call indata
*
endif
*
* B. Run the non-linear model
*
if(isv_step.eq.1) call out_dyn (.true.,-1)
*
* Run NLM model
* -------------
call gem_ctrl
*
* Read trajectory for conversion at final time
* --------------------------------------------
V4dg_rwcv = 0
call v4d_rwconv()
*
enddo
*
* C. Output to 3D-Var: NL Model state at final time
*
* Read reference trajectory at final time and subtract from state
* ---------------------------------------------------------------
V4dg_rwnl = 0
call v4d_rwnlpert()
*
* Write increments to be read by 3D-Var
* -------------------------------------
call v4d_putdx(nstatus)
*
if(nstatus.ne.0) then
write(Lun_out,*) '>>> V4D_4DVAR:: Problem in writing file for 3Dvar nstatus = ',
% nstatus
nstatus = -99
endif
*
* ------------------------------------------------------------------------------------------
* ===> EVN_TLME: Integration of TLM model without Profiles and with V4dg_output_L=.T. Then STOP
* ------------------------------------------------------------------------------------------
else if (nevent.eq.EVN_TLME) then
call tmg_start0(20,'EVTLE ')
*
Pr_nsim4d = Pr_nsim4d + 1
*
write(Lun_out,*) '>>> V4D_4DVAR:: Integration of TLM - Nevent = '
% ,nevent,' EVN_TLME = ',EVN_TLME,' NSIM4D = ',Pr_nsim4d
*
* Zero variables
* --------------
call v4d_zero()
*
* 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
*
* A. Input: initial conditions and convert variables 3D-Var --> GEM
*
* Set initial and last time step
* ------------------------------
Lctl_step = 0
V4dg_steplast = Step_total
*
* Set READ option on TRAJ Vmm WA file
* -----------------------------------
V4dg_rwtr = 0
*
* Reset addresses of TRAJ Conversion/Physics WA files
* ---------------------------------------------------
V4dg_addcv = 1
V4dg_addph = 1 + l_ni*l_nj*l_nk
*
* Initilizations for digital filtering
* ------------------------------------
if( Init_balgm_L ) Rstri_idon_L = .false.
*
* Read trajectory for conversion at initial time
* ----------------------------------------------
call v4d_rwconv0()
*
* Read increments from 3D-Var and prepare them for GEM
* ----------------------------------------------------
call v4d_getdx(nstatus)
*
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
*
* B. Run the tangent linear model
*
if(nstatus.eq.0) then
*
* Set status of the integration
* -----------------------------
V4dg_status = 0
*
* Complete the preprocessing (derived fields)
* -------------------------------------------
V4dg_part = 3
call indata_tl()
*
* Set over-riding switch for dynout and blocstat
* ----------------------------------------------
V4dg_output_L = .true.
*
call out_dyn (.true.,-1)
*
* Run TLM model
* -------------
call gem_ctrl_tl()
*
write(Lun_out,*) '>>> V4D_4DVAR:: End of TLM integration NSIM4D = ',Pr_nsim4d
*
write(Lun_out,*) '>>> V4D_4DVAR:: End of Job - Nevent = '
% ,nevent,' EVN_TLME = ',EVN_TLME
nstatus = -99
*
else
write(Lun_out,*) '>>> V4D_4DVAR:: Problem in getting dwgf PROF file at initial time nstatus = ',
% nstatus
nstatus = -99
endif
*
call tmg_stop0(20)
*
* ------------------------------------------------
* ===> EVN_ESIM: Nothing more to do. You can go home!!
* ------------------------------------------------
else if(nevent.eq.EVN_ESIM) then
*
write(Lun_out,*) '>>> V4D_4DVAR:: End of Job - Nevent = '
% ,nevent,' EVN_ESIM = ',EVN_ESIM
nstatus = -99
*
* --------------------------------------------------------------------------
* ===> EVN_ESRS: Nothing more to do. You can go home!! But come back for restart.
* --------------------------------------------------------------------------
else if(nevent.eq.EVN_ESRS) then
*
write(Lun_out,*) '>>> V4D_4DVAR:: End of Job with restart - Nevent = '
% ,nevent,' EVN_ESRS = ',EVN_ESRS
call write_status_file2 ('_restart4d=oui')
nstatus = -99
*
* -----------------------------------------------------------------
* ===> EVN_FERR: Something very wrong happened. Close shop and go...
* -----------------------------------------------------------------
else if(nevent.eq.EVN_FERR) then
*
write(Lun_out,*) '>>> V4D_4DVAR:: Aborting - Nevent = '
% ,nevent,' EVN_FERR = ',EVN_FERR
nstatus = -99
*
* ------------------------------
* ===> Default Case: Wrong Event Type
* ------------------------------
else
write(Lun_out,*) '>>> V4D_4DVAR:: wrong event type. Nevent = ',nevent
nstatus = -99
call gem_stop('v4d_4dvar',-1)
end if
*
end do Event_Loop
*
* ----------------------------------\
* End of Main Event Loop >
* ----------------------------------/
*
if(Ptopo_myproc.eq.0.and.V4dg_sgvc_L) ierr = FCLOS(V4dg_iunenrgy)
*
write(Lun_out,*) '>>> V4D_4DVAR:: End of Job'
call tmg_stop0(29)
*
return
*
end subroutine v4d_4dvar