!-------------------------------------- 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 theo_cfg - reads parameters from namelist theo_cfgs
*
#include "model_macros_f.h"
*
subroutine theo_cfg 1,5
implicit none
*
*author
* sylvie gravel - Apr 2003
*
*revision
* v3_11 - gravel s - initial version
*
*object
* See above id
*
*arguments - none
*
#include "ptopo.cdk"
#include "theonml.cdk"
*
integer fnom,gem_nml,var4d_nml,bubble_cfg,mtn_cfg
external fnom,gem_nml,var4d_nml,bubble_cfg,mtn_cfg
*
integer k, unf, status, err, nrec
character*16 dumc_S
**
* ---------------------------------------------------------------
*
status = -1
*
if ( Ptopo_npey .gt.1) then
if (Lun_out.gt.0) write (Lun_out, 9240)
goto 9999
endif
*
err = gem_nml ('')
err = var4d_nml ('')
Theo_nivdist_S='UNI'
Theo_case_S='xxx'
Lam_runstrt_S="19980101.000000"
Out3_etik_S='THEOC'
Out3_ip3 = -1
Lctl_debug_L=.false.
*
call hpalloc (Geomg_hyb_ , maxhlev, err,1)
*
unf = 0
if (fnom (unf, 'model_settings', 'SEQ+OLD' , nrec) .ne. 0) goto 9110
rewind(unf)
read (unf, nml=theo_cfgs, end = 9000, err=9000)
*
*
if ( Theo_case_S .eq. 'BUBBLE'
% .or. Theo_case_S .eq. 'BUBBLE_G'
% .or. Theo_case_S .eq. '2_BUBBLES') then
err = bubble_cfg (unf)
elseif ( Theo_case_S .eq. 'MTN_SCHAR'
% .or. Theo_case_S .eq. 'MTN_SCHAR2'
% .or. Theo_case_S .eq. 'MTN_PINTY'
% .or. Theo_case_S .eq. 'MTN_PINTY2'
% .or. Theo_case_S .eq. 'MTN_PINTYNL') then
print *,'Theo_case_S=',Theo_case_S
err = mtn_cfg (unf)
print *,'after mtn_cfg err=',err
else
if (Lun_out.gt.0) then
write (Lun_out, 9200) Theo_case_S
write (Lun_out, 8000)
endif
err = -1
endif
call fclos (unf)
if (err.lt.0) goto 9999
*
call low2up (Adw_interp_type_S,dumc_S)
Adw_interp_type_S = dumc_S
call low2up (Hzd_type_S,dumc_S)
Hzd_type_S = dumc_S
do k=1,maxhlev
hyb(k)=Geomg_hyb(k)
enddo
call hpdeallc (Geomg_hyb_ , err,1)
if (Lun_out.gt.0) write (Lun_out, 7050) Theo_case_S
status=1
return
*
9110 if (Lun_out.gt.0) then
write (Lun_out, 9050)
write (Lun_out, 8000)
endif
goto 9999
9000 if (Lun_out.gt.0) then
call fclos (unf)
write (Lun_out, 9100)
write (Lun_out, 8000)
endif
*
9999 call gem_stop ('THEO_CFG',status)
*
* ---------------------------------------------------------------
7050 format (/' THEORETICAL CASE IS: ',a/)
8000 format (/,'========= ABORT IN S/R theo_cfg.f ============='/)
9050 format (/,' FILE: model_settings NOT AVAILABLE'/)
9100 format (/,' NAMELIST theo_cfgs ABSENT or INVALID FROM FILE: model_settings'/)
9200 format (/,' Unsupported theoretical case: ',a/)
9240 format (/,' For theoretical cases, number of PEs in y must be 1 '/)
*
return
end