!-------------------------------------- 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 tstpdyn - Performs a dynamical timestep of the model
*
#include "model_macros_f.h"
*
subroutine tstpdyn ( F_fnitraj ) 2,25
*
implicit none
*
integer F_fnitraj
*
*author
* Alain Patoine ( after version v1_93 of tstpdyn2 )
*
*revision
* v2_00 - Desgagne M. - initial MPI version
* v2_10 - Tanguay M. - store TRAJ for 4D-Var
* v2_30 - Edouard S. - introduce Ncn
* v3_00 - Desgagne & Lee - Lam configuration
* v3_03 - Tanguay M. - Adjoint NoHyd configuration
* v3_10 - Corbeil & Desgagne & Lee - AIXport+Opti+OpenMP
* v3_20 - Tanguay M. - Option of storing instead of redoing TRAJ
* v3_21 - Desgagne M. - introduce new timing routines
* v3_31 - Tanguay M. - Introduce time extrapolation
*
*object
*
*arguments
* Name I/O Description
*----------------------------------------------------------------
* F_fnitraj I number of iterations to compute upstream
* positions
*----------------------------------------------------------------
*
*implicits
#include "glb_ld.cdk"
#include "lun.cdk"
#include "cstv.cdk"
#include "schm.cdk"
#include "orh.cdk"
#include "sol.cdk"
#include "nl.cdk"
#include "v4dg.cdk"
#include "v4dr.cdk"
*
integer iln, dim, err
real dth
*
**
* ---------------------------------------------------------------
*
*C rhs: Compute rhs of the governing equations
*C int: Perform Semi-Lagrangian advection
*C pre: Compute non-linear Helmholtz problem (invariant part)
*C nli: Compute non-linear components of the r.h.s. of the
*C Helmholtz problem and linear and nonlinear components
*C of the r.h.s. of the Helmholtz equation
*C solver: Linear Helmholtz solver
*C bac: Backsubtitution
* ---------------------------------------------------------------
*
dth = Cstv_dt_8/2.
*
if (Lun_debug_L) write(Lun_out,1000)
*
* ---------------------------------------------------------------
*
if ( V4dg_conf.ne.0 .and. V4dg_oktr_L ) then
*
* Store TRAJ predictive variables
* -------------------------------
if ( (Orh_crank_L .and. Orh_icn.eq.1) .or. .not.Orh_crank_L ) call v4d_rwtraj (3)
*
endif
*
call tmg_start0 ( 3, 'RHS ' )
call rhs ()
call tmg_stop0 (3)
*
if ( V4dg_conf.ne.0 .and. V4dg_oktr_L ) then
*
* Store TRAJ Positions TH
* -----------------------
call v4d_rwtraj (4)
*
* Store TRAJ Winds TH
* -------------------
call v4d_rwtraj (5)
*
endif
*
call tmg_start0 ( 4, 'ADW ' )
call adw_main ( F_fnitraj )
call tmg_stop0 (4)
*
call tmg_start0 ( 5, 'PRE ' )
call pre ()
call tmg_stop0 (5)
*
if ( Orh_icn.eq.1 ) call frstgss( )
*
if ( Lun_debug_L ) write (Lun_out,1005) Schm_itnlh
*
dim = (l_maxx-l_minx+1)*(l_maxy-l_miny+1)*l_nk
call hpalloc (nl_nu_ , dim, err,1)
call hpalloc (nl_nv_ , dim, err,1)
call hpalloc (nl_nth_ , dim, err,1)
call hpalloc (nl_ncn_ , dim, err,1)
nl_n3_ = 0
nl_n3p_ = 0
if ( .not. Schm_hydro_L ) then
call hpalloc (nl_n3_ , dim, err,1)
call hpalloc (nl_n3p_ , dim, err,1)
endif
*
do 100 iln=1,Schm_itnlh
*
if ( V4dg_conf.ne.0.and.V4dg_oktr_L ) then
*
* Store fields at T0 and TX used as INPUT but changed by updating (subr. BAC)
* ---------------------------------------------------------------------------
if ( Orh_icn.ne.1 .and. iln.eq.1 ) call v4d_rwtraj (6)
*
*
* Store fields at TX used as INPUT but changed by updating (subr. BAC)
* -------------------------------------------------------------------
if ( .not.Schm_hydro_L .and. Orh_icn.eq.1 .and. iln.eq.1 )
$ call v4d_rwtraj (7)
*
endif
*
call tmg_start0 ( 6, 'NLI ' )
call nli ()
call tmg_stop0 (6)
*
call tmg_start0 ( 7, 'SOL ' )
call sol_main (iln)
call tmg_stop0 (7)
*
if ( V4dg_conf.ne.0 .and. V4dg_oktr_L .and. .not.V4dr_redotr_L ) then
*
* Store TRAJ GPTX at end of SOL_MAIN
* ----------------------------------
V4dr_iln = iln
call v4d_rwtraj (9)
*
endif
*
call tmg_start0 ( 8, 'BAC ' )
call bac ( iln, Schm_itnlh )
call tmg_stop0 (8)
*
100 continue
*
call hpdeallc(nl_nu_ , err)
call hpdeallc(nl_nv_ , err)
call hpdeallc(nl_nth_, err)
call hpdeallc(nl_ncn_, err)
if ( .not. Schm_hydro_L ) then
call hpdeallc(nl_n3_ , err)
call hpdeallc(nl_n3p_, err)
endif
*
* ---------------------------------------------------------------
*
1000 format(
+ 3X,'PERFORM A DYNAMICAL STEP: (S/R TSTPDYN)',
+/3X,'========================================',/)
1005 format(
$ 3X,'ITERATING SCHM_ITNLH=',I3,' TIMES TO SOLVE NON-LINEAR ',
$ 'HELMHOLTZ PROBLEM')
return
end