!-------------------------------------- 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 e_gemnml - to read 3 namelists for the e_gemntr program,
* namelists: gemnml, grid, ptopo
*
*
#include "model_macros_f.h"
*
subroutine e_gemnml 1,14
implicit none
*
*revision
* v3_11 - Tanguay M. - Introduce Grd_gauss_L
* v3_21 - Desgagne M. - Revision on Dcst read
* v3_21 - Lemonsu A. - add P_pbl_schurb_s
* v3_22 - Lee V. - removed Trvs tracers
* v3_30 - Desgagne M. - rewritten for the new physics
* interface and new LAM I/O piloting
* v3_31 - Lee, V. - offline mode : use full phi grid for winds
* v3_31 - Lee V. - add P_pbl_icelac_L for ICELAC
*
integer ni, nila
integer l_ni,l_nj
parameter (l_ni=1,l_nj=1)
*implicits
#include "e_schm.cdk"
#include "e_grids.cdk"
*
#include "cst_lis.cdk"
#include "dcst.cdk"
#include "grd.cdk"
#include "itf_phy_config.cdk"
#include "itf_cpl.cdk"
#include "pilot.cdk"
#include "modconst.cdk"
#include "hblen.cdk"
#include "path.cdk"
#include "lun.cdk"
#include <clib_interface.cdk>
*
logical set_dcst, set_dcst_8
external set_dcst, set_dcst_8
integer grid_nml, ptopo_nml, e_gement_nml, phy_init, itf_cpl_nml
external grid_nml, ptopo_nml, e_gement_nml, phy_init, itf_cpl_nml
integer wkoffit
external wkoffit
*
integer fnom,fclos
external fnom,fclos
*
logical phy_L
character*120 dumc
integer err,unf,bufcte(10000)
*
*--------------------------------------------------------------------
*
if (clib_isdir(Path_input_S).lt.0) call e_arret('e_gemnml')
call array_from_file (bufcte,size(bufcte),
$ trim(Path_input_S)//'/constantes')
call array_to_file (bufcte,size(bufcte),'constantes' )
Lun_out = 6
if (grid_nml (trim(Path_work_S)//'/model_settings.nml') .ne. 1)
+ stop 'In e_gemnml: After grid_nml'
if (ptopo_nml (trim(Path_work_S)//'/model_settings.nml') .ne. 1)
+ stop 'In e_gemnml: After ptopo_nml'
if (e_gement_nml(trim(Path_work_S)//'/model_settings.nml') .ne. 1)
+ stop 'In e_gemnml: After e_gement_nml '
*
if (phy_init (trim(Path_work_S)//'/model_settings.nml',set_dcst,
$ phy_L,6) .ne. 1) stop 'In e_gemnml: After phy_init'
*
call phy_optc ('SCHMSOL' , P_pbl_schsl_s ,1, 'GET',.True.,err)
call phy_optc ('SCHMURB' , P_pbl_schurb_s,1, 'GET',.True.,err)
call phy_optl ('SNOALB_ANL', P_pbl_snoalb_L,1, 'GET',.True.,err)
call phy_optl ('ICELAC' , P_pbl_icelac_L, 1, 'GET',.True.,err)
call phy_optl ('CHAUF' , P_pbl_ocean_L ,1, 'GET',.True.,err)
*
call low2up (P_pbl_schsl_S,dumc)
P_pbl_schsl_S = dumc
call low2up (P_pbl_schurb_S,dumc)
P_pbl_schurb_S = dumc
*
if (itf_cpl_nml(trim(Path_work_S)//'/model_settings.nml') .ne. 1)
+ stop 'In e_gemnml: After itf_cpl_nml'
*
LAM = Grd_typ_S(1:1).eq.'L'
*
if ( .not. LAM ) then
Pil_bmf_L = .true.
Pil_sfc2d_L = .true.
Pil_3df_L = .true.
Pil_nesdt = 1000
else
if ( Pil_sfc2d_L .or. Pil_3df_L ) then
if ( Mod_runstrt_S.eq.'@#$%' ) then
if (wkoffit(trim(Path_output_S)//'/labfl.bin').gt.-1) then
unf = 0
if (fnom(unf,trim(Path_output_S)//'/labfl.bin','SEQ/UNF+OLD',0).ge.0)
$ then
read(unf,err=999,end=999) Mod_runstrt_S
err = fclos( unf )
endif
endif
endif
if ( Pil_3df_L ) then
if ( Pil_jobstrt_S.eq.'@#$%' .or.
$ Pil_jobend_S .eq.'@#$%' ) then
write (6,1005)
call e_arret('e_gemnml')
endif
if ( (Pil_jobstrt_S.ne.Pil_jobend_S).and.
$ (Pil_nesdt.le.0) ) then
write (6,1006)
call e_arret('e_gemnml')
endif
endif
endif
endif
*
err = grid_nml ('print')
err = ptopo_nml ('print')
err = e_gement_nml ('print')
if (C_coupling_L) err = itf_cpl_nml ('print')
*
if (.not.set_dcst_8 (Dcst_cpd_8,liste_S,cnbre,6,1))
$ call e_arret ('SET_DCST_8')
*
call e_trinit
*
ni = Grd_ni
nila = Grd_nila
*
if (lam) then
niu = ni-1
else
ni=ni+1
if ( ni .eq. nila+1) nila=nila+1
niu=ni
endif
*
nifi = ni
niv = ni
njfi = Grd_nj
nju = Grd_nj
njv = Grd_nj-1
npfi = nifi*njfi
npu = niu *nju
npv = niv *njv
*
if (e_schm_offline_L) then
niu = Grd_ni
njv = Grd_nj
endif
*
if (LAM) then
pni = nifi
pniu = niu
else
pni = nifi-1
pniu = pni
endif
pnj = njfi
pnjv = njv
*
return
*
999 write(6,1004)
call e_arret('e_gemnml')
*
*--------------------------------------------------------------------
1004 format(/' Mod_runstrt_S must be specified in LAM configuration ',
$ /' when Pil_sfc2d_L or Pil_3df_L is .T. - ABORT -'/)
1005 format(/' Pil_jobstrt_S and Pil_jobend_S must both',
$ /' be specified in LAM configuration - ABORT -'/)
1006 format(/' To treat Pil_3df_L data, Pil_nesdt must ',
$ /' be specified in LAM configuration - ABORT -'/)
*
return
end