!-------------------------------------- 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 gem_run - Performs the integration of the model
*
#include "model_macros_f.h"
*
subroutine gem_run (F_dgtflt_L, F_rstrt_L) 2,31
*
implicit none
*
logical F_dgtflt_L, F_rstrt_L
*
*author
*
*revision
* v2_00 - Desgagne M. - initial MPI version (from rhs v1_03)
* v2_10 - Tanguay M. - control cost function when 4D-Var (conf/100=1)
* v2_20 - Desgagne M. - correction for Step_total=0
* v2_21 - Dugas B. - activate climate mode
* v2_21 - Lee V. - changed calling sequence in p_main
* v2_30 - Dugas B. - add call to gemtim
* v2_31 - Patoine A. - logic of restart around Rstri_sdon
* v2_31 - Tanguay M. - adapt ADJ to diffusion in gem_run
* v3_00 - Tanguay M. - cancel parameter in v4d_ctrlcst
* v3_00 - Laroche S. - adapt for simplified physics
* v3_01 - Tanguay M. - introduce identity option
* v3_01 - Lee V. - introduce horizontal sponge
* v3_02 - Tanguay M. - cosmetics for identity option
* v3_02 - Buehner M. - integration stops at timestep V4dg_steplast
* v3_02 if in V4d mode
* v3_03 - Tanguay M. - Call hdif_phy
* v3_10 - Corbeil & Desgagne & Lee - AIXport+Opti+OpenMP
* v3_11 - Tanguay M. - Extend TRAJ for conversion for DYNOUT2
* - ADJ of digital filter
* v3_20 - Gravel S. - background vertical diffusion
* v3_20 - Tanguay M. - Introduce Hzd_hdif0_L
* v3_20 - Dugas B. - Replace GEMTIM by GEMTIM2(may re-define Step_rsti)
* v3_30 - Desgagne M. - Restructure code, added output for cascade mode
* v3_31 - Desgagne M. - new coupling interface to OASIS
* v3_31 - Desgagne M. - restart with physics BUSPER
*
*object
* Performs the integration of the model
*
* A timestep is composed of a dynamics timestep followed by a
* physics timestep.
*
* During initialization, the digital filter data is collected
* at every timestep.
*
* Output is performed if required.
*
* Diagnostics (zonal or grid point) are extracted if required.
*
*arguments
* Name I/O Description
*----------------------------------------------------------------
* F_dgtflt_L I Digital initiatization mode
* F_rstrt_L O Is a restart required
*----------------------------------------------------------------
*
*implicits
#include "glb_ld.cdk"
#include "init.cdk"
#include "lun.cdk"
#include "step.cdk"
#include "rstr.cdk"
#include "schm.cdk"
#include "lctl.cdk"
#include "v4dg.cdk"
#include "clim.cdk"
#include "vrtd.cdk"
#include "hzd.cdk"
*
logical bkup_L,identity_4dvar_L
integer last_step,fstep,istep,step0,stepf
**
* ---------------------------------------------------------------
*
if (Lun_out.gt.0) write (6,900)
call blocstat (.true.)
fstep = Step_total
**** =====> BLOC 4D - debut
if ( V4dg_conf.ne.0 ) then
if ( Schm_chems_L ) call gem_stop('gem_run Schm_chems_L ',-1)
if ( Vrtd_L ) call gem_stop('gem_run Vrtd_L ',-1)
if ( Schm_offline_L) call gem_stop('gem_run Schm_offline_L',-1)
if ( F_dgtflt_L ) call gem_stop('gem_run F_dgtflt_L' ,-1)
fstep = V4dg_steplast
endif
* ---------------------------------------------------------------
*
identity_4dvar_L = V4dg_conf.ne.0 .and. V4dg_identity_L
*
* 4D-Var: Write trajectory for conversion if requested
* ----------------------------------------------------
if ( V4dg_oktrcv_L ) call v4d_rwconv0
*
*C 4D-Var: Control Cost function at INITIAL time
* ---------------------------------------------
if ( V4dg_conf.ne.0 ) call v4d_ctrlcst ()
**** =====> BLOC 4D - fin
*
if (F_dgtflt_L) fstep = Init_dfnp-1
last_step = min (fstep, Lctl_step + Step_rsti)
*
if (Lctl_step.eq.0) call out_dyn (.false.,2)
call out_dyn (.true.,-1)
*
bkup_L = .false.
*
step0 = Lctl_step+1
stepf = last_step
*
call itf_cpl_fillatm
*
do istep = step0, stepf
*
Lctl_step = istep
*
*C Incrementing timestep
*
Rstri_sdon = Rstri_sdon + 1
*
call gemtim2 ( Lun_out, Clim_climat_L, Rstri_sdon,Step_rsti )
*
if (Lun_out.gt.0) write (Lun_out,1001) Lctl_step,fstep
*
*C (Re-)initialize physics surface forcing increments
* --------------------------------------------------
if ( Clim_inincr_L ) call itf_phy_inincr
*
*C Diffusion, Dynamics and Physics
* -------------------------------
if ( .not.identity_4dvar_L ) then
*
* Horizontal diffusion & Vertical sponge (Initial timestep)
* ---------------------------------------------------------
if ( Lctl_step.eq.1.and.Hzd_hdif0_0_L.and.
$ (.not.schm_offline_l) ) call hdif0
*
* Dynamics timestep
* -----------------
call dynstep
call out_dyn (.false.,1)
*
if (Vrtd_L) call vrtd
*
* Physics timestep & Horizontal diffusion & Vertical sponge
* ---------------------------------------------------------
call hdif_phy
call out_dyn (.false.,2)
*
endif
*
*C Digital filter
* --------------
if ( F_dgtflt_L ) call digflt
*
if (Schm_sfix_L.and.V4dg_conf.ne.0) call surfix
*
* 4D-Var: Write trajectory for conversion if requested
* ----------------------------------------------------
if ( V4dg_oktrcv_L ) call v4d_rwconv0
*
*C 4D-Var: Control Cost function at .NOT.INITIAL time
* --------------------------------------------------
if ( V4dg_conf.ne.0 ) call v4d_ctrlcst
*
*C Perform output if required
* --------------------------
if (Schm_sfix_L.and.V4dg_conf.eq.0) call surfix
*
call out_dyn (.true.,-1)
call blocstat (Lctl_step.eq.last_step)
*
call itf_cpl_fillatm
*
if (Lun_out.gt.0) write(Lun_out,3000) Lctl_step
*
* * Must we stop the current sequence? If yes, must we write
* * a restart file?
*
if (Lctl_step.ne.last_step) call trans_clean
*
bkup_L = (mod( Lctl_step ,Step_bkup ).eq.0) . and.
$ (Lctl_step.lt.stepf)
if ( bkup_L ) call wrrstrt
if ( Lctl_step.eq.Step_spinphy ) call wrrstrt_phy (.true.)
*
end do
*
if (F_dgtflt_L.and.(last_step.eq.Init_dfnp-1)
$ .and.(.not.F_rstrt_L)) call trans_clean
*
call max_rss (' GEMDM',Lun_out.gt.0)
F_rstrt_L = .false.
if ((Lctl_step.lt.fstep).or.(Clim_climat_L)) F_rstrt_L = .true.
*
if (Lun_out.gt.0) write(Lun_out,4000) Lctl_step
*
900 format (/'STARTING THE INTEGRATION WITH THE FOLLOWING DATA:')
1001 format(/,'GEM_RUN: PERFORMING TIMESTEP #',I8,' OUT OF ',I8,
+ /,'================================================')
3000 format(/,'THE TIME STEP ',I8,' IS COMPLETED')
4000 format(/,'END OF THE TIME LOOP (S/R GEM_RUN) AT TIMESTEP',I8,
+/,'===================================================')
*
* ---------------------------------------------------------------
*
return
end