!-------------------------------------- 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 set_schm - initialize the parameters controlling the
* schemes used in the model
*
#include "model_macros_f.h"
*
subroutine set_schm 1,1
implicit none
*
*author
* M. Desgagne - V. Lee ( after version v1_03 of setschm )
*
*revision
* v2_00 - Desgagne/Lee - initial MPI version
* v2_10 - Desgagne M. - removed MITH (not used)
* v2_30 - Desgagne M. - entry vertical interpolator in gemdm
* v2_30 - Desgagne M. - entry vertical interpolator in gemdm
* v3_11 - Gravel S. - modify for theoretical cases
* v3_30 - Desgagne M. - simplification
*
*object
*
*arguments
* none
*
*implicits
#include "glb_ld.cdk"
#include "lun.cdk"
#include "offc.cdk"
#include "cstv.cdk"
#include "dcst.cdk"
#include "schm.cdk"
*
*notes
*
real*8 ZERO_8, ONE_8, gamma_8
parameter( ZERO_8 = 0.0 )
parameter( ONE_8 = 1.0 )
**
* _________________________________________________________________
*
if (lun_out.gt.0) write(lun_out,1000)
* 1.2 Validate and correct Schm_xwvt3 if necessary
if ( (Schm_xwvt3 .lt. 0) .or. (Schm_xwvt3 .gt. 2) ) then
if (lun_out.gt.0) write(lun_out,1200)
call gem_stop("SET_SCHM",-1)
elseif ( (Schm_modcn .eq. 1) .and. (Schm_xwvt3 .ne. 0) ) then
if (lun_out.gt.0) write(lun_out, 1201)
if (lun_out.gt.0) write(lun_out, 1202)
Schm_xwvt3=0
endif
* 1.3 Set the number of vertical modes treated implicitly
Schm_nith = G_nk - 1
* 1.5 Validate non-hydrostatic parameter
Schm_nonhy_8 = min(max(Schm_nonhy_8,ZERO_8),ONE_8)
*
Cstv_tau_8 = Cstv_dt_8 * ( Offc_b0_8/Offc_a0_8 )
Cstv_hco0_8 = Dcst_rayt_8 *Dcst_rayt_8/(Dcst_rgasd_8*
$ Dcst_cappa_8*Cstv_tau_8*Cstv_tau_8*Cstv_tstr_8)
Cstv_hco1_8 = ZERO_8
*
if ( .not. Schm_hydro_L) then
gamma_8 = Schm_nonhy_8 * Dcst_rgasd_8*Cstv_tstr_8
% /(Dcst_cappa_8 * (Dcst_grav_8 *Cstv_tau_8)**2 )
gamma_8 = ONE_8 / (gamma_8 + ONE_8)
Cstv_hco0_8 = gamma_8 * Cstv_hco0_8
Cstv_hco1_8 = - Schm_nonhy_8 * Dcst_rayt_8*Dcst_rayt_8
% * (ONE_8 - Dcst_cappa_8)*gamma_8
% /( Dcst_cappa_8*(Dcst_grav_8**2)*(Cstv_tau_8**4) )
endif
*
1000 format(
%/,'INITIALIZE SCHEMES CONTROL PARAMETERS (S/R SET_SCHM)',
%/,'===================================================')
1200 format(
%'THE TYPE OF EXTRAPOLATION TO OBTAIN WIND AT TIME Th MUST BE ',
%'EITHER 0, 1 or 2,',
%/,'CORRECT THE VALUE OF Schm_xwvt3 IN THE DRIVER.')
1201 format(
%'SINCE THE CRANK-NICHOLSON PROCEDURE IS REQUESTED AT EACH EVERY ',
%'TIMESTEP (Schm_modcn=1),')
1202 format(
%'THE PARAMETER CONTROLING THE TYPE OF WIND EXTRAPOLATION IS ',
%'VOID (Schm_xwvt3) AND WILL THEN BE RESET TO 0.')
*
* _________________________________________________________________
*
return
end