copyright (C) 2001 MSC-RPN COMM %%%MC2%%%
*
subroutine mtn_cfg (prout,status) 1,3
implicit none
*
logical prout
integer status
*
#include "lcldim.cdk"
#include "rec.cdk"
#include "grd.cdk"
#include "cdate.cdk"
#include "levels.cdk"
#include "nesting.cdk"
#include "yomdyn.cdk"
#include "yomdyn1.cdk"
#include "filename.cdk"
#include "physcom.cdk"
#include "tracers.cdk"
#include "nbcpu.cdk"
#include "nestpnt.cdk"
#include "mtn.cdk"
#include "sor.cdk"
#include "path.cdk"
#include "lun.cdk"
#include "refer.cdk"
*
integer unnml,pnerrdirf,pnflag1,pnflag2,i,j,k,err,longueur
real*8 dayfrac
character*12 nmlname
namelist /mtn_cfgs/ gni,gnj,gnk,nktop,Grd_dx,htop,
$ gnnt,gnnrstrt,grdt,gnnpbl,zt,hord_zspng,
$ hblen_x,hblen_y,grtf,grtstar,vmh_stime,
$ gnpvw,grpilver,gnpilver,vmh_ndt,flipit,
$ grepsi,mtn_hwx,mtn_hwy,mtn_xpos,mtn_ypos,
$ mtn_heigth,mtn_flo,mtn_thrate,iscal,
$ blb_zp,blb_xs,blb_zs,blb_xp,mtn_typ,
$ period_x,period_y,topo_folwing
namelist /mtn_cfgs_p/ gni,gnj,gnk,nktop,Grd_dx,htop,
$ gnnt,gnnrstrt,grdt,gnnpbl,hord_zspng,
$ hblen_x,hblen_y,grtf,grtstar,vmh_stime,
$ gnpvw,grpilver,gnpilver,vmh_ndt,flipit,
$ grepsi,mtn_hwx,mtn_hwy,mtn_xpos,mtn_ypos,
$ mtn_heigth,mtn_flo,mtn_thrate,iscal,
$ blb_zp,blb_xs,blb_zs,blb_xp,mtn_typ,
$ period_x,period_y,topo_folwing
data unnml /11/
*
status = -1
hx = 3
hy = hx
nmlname = 'mtn_cfgs'
*
if (.not.modrstrt) then
*
*
* In what follows are the description of two
*
* ################################################
* # #
* # HYDROSTATIC LINEAR MOUNTAIN WAVE PROBLEMS #
* # (ref.:Pinty et al,1995:MWR,123,3042-3058) #
* # #
* ################################################
*
*
* -the atmosphere is isothermal at T = 273.15 K
* -the mountain has a top elevation of 1. m
* -the model has an horizontal resolution of 3.2 km
* and a vertical resolution of 250. m
* with gni = 162 grid pts
* in the x-direction and gnk = 81 levels
*
* PINTY 1 (Pinty et al. FIG 1,p3046): the wind is 32 m/s
*
* PINTY 2 (Pinty et al. FIG 3,p3047): the wind is 8 m/s
*
* n.b. in these cases the Courant # is kept equal to 0.5
*
*
* Plus one
*
* ##################################################
* # #
* # NON-HYDROSTATIC LINEAR MOUNTAIN WAVE PROBLEM #
* # (ref.:Shaer et al,2002:MWR, ) #
* # #
* ##################################################
*
* -the atmosphere is non-isothermal with tzero1= 288.15 K
* and a temperature gradient given by nstar1= 1.e-2 s-1
* -the mountain has a top elevation of 2.5 m
* -the model has an horizontal resolution of 500.0 m
* and a vertical resolution of 300. m
* with gni = 402 grid pts
* in the x-direction and gnk = 66 levels
*
*
flipit = .true.
vmh_stime = 0
topo_folwing=.true.
*
if (theocase.eq.'MTN_PINTY1'.or.theocase.eq.'MTN_PINTY2') then
*
* pinty cases
grtstar = 273.15
iscal(1) = 1000000
iscal(2) = 1000000
mtn_heigth = 1.0
Grd_dx = 3200.
htop = 20000.
gni = 162
gnj = 2 ! requires slab=.true.
gnk = 81
nk = gnk-1
mtn_hwx = 5
mtn_hwy = -1
mtn_xpos = 81
mtn_ypos = 1
mtn_thrate = 2.
*
hblen_x = 15
*
else if (theocase.eq.'MTN_SHAER') then
*
* shaer case
grtstar = 250.15
iscal(1) = 1000000
iscal(2) = 1000000
c iscal(1) = 5000
c iscal(2) = 2000
mtn_heigth = 2.50
Grd_dx = 500.
htop = 19500.
gni = 402
gnj = 2 ! requires slab=.true.
gnk = 66
nk = gnk-1
mtn_hwx = 10
mtn_hwy = -1
mtn_xpos = 201
mtn_ypos = 1
mtn_thrate = 0.3
*
hblen_x = 30
*
else if (theocase.eq.'NOFLOW') then
*
* is it no flow?
*
grtstar = 250.
iscal(1) = 1000000
iscal(2) = 1000000
mtn_heigth = 0.0
Grd_dx = 10000.
htop = 20000.
gni = 12
gnj = 2 ! requires slab=.true.
gnk = 21
nk = gnk-1
mtn_hwx = 10
mtn_hwy = -1
mtn_xpos = 1
mtn_ypos = 1
mtn_thrate = 0.3
grtf = 0.05 ! pretty important
*
hblen_x = 0
period_x = .true.
*
endif
*
if (theocase.eq.'MTN_PINTY1') then
*
* PINTY 1
*
mtn_flo = 32.
grdt = 50.0
gnnt = 800
gnnrstrt = 400
gnpilver = 40
vmh_ndt = 80
*
else if (theocase.eq.'MTN_PINTY2') then
*
* PINTY 2
*
mtn_flo = 8.
grdt = 200.0
gnnt = 1600
gnnrstrt = 400
gnpilver = 10
vmh_ndt = 160
*
else if (theocase.eq.'MTN_SHAER') then
*
* SHAER
*
mtn_flo = 10.
grdt = 8.0
gnnt = 1600
gnnrstrt = 320
gnpilver = 30
vmh_ndt = 160
*
else if (theocase.eq.'NOFLOW') then
*
* NOFLOW
*
mtn_flo = 0.
grdt = 100.0
gnnt = 1000
gnnrstrt = 10000
gnpilver = 0
*
endif
*
grpilver = 1.
grepsi = 0. ! No decentering of SI scheme
hord_lnr = 0. ! No diffusion
gnmaphy = 0 ! No physical parameterization
slab = .true. ! Slab-symmetry in y-direction.
ctebcs = .true. ! Fixed boundary conditions.
nofcms = .true. ! No rotation; cartesian coordinates.
flextop = .false.
*
nktop = -1
gnnohyd = 1 ! non-hydrostatic
gnnpbl = -1
gnpvw = 0
do k=1,maxdynlv
zt(k)=-1.0
end do
zt(1) = 1.
*
hblen_y = 0
hord_zspng = 0
if(.not.topo_folwing) vmh_ndt=1
*---- Added nml parameters for the Color case
blb_zp = 9000.
blb_xp = 25
blb_xs = 5
blb_zs = 3
mtn_typ = 'w'
*
* *** Updating configuration with namelist mtn_cfgs
*
open (unnml,file=nml,access='SEQUENTIAL',
$ form='FORMATTED',status='OLD',iostat=pnerrdirf)
if (pnerrdirf.ne.0) then
print '(/,2x,a/2x,3a/)', '==> ABORT -- ABORT <==',
$ 'FILE ',nml(1:longueur(nml)),' NOT FOUND'
goto 9991
endif
*
rewind ( unnml )
read (unnml, nml=mtn_cfgs, end=6121)
write (6,601) nmlname
goto 603
6121 write (6,602) nmlname
*
603 close (unnml)
*
else
*
print '(1x,a/1x,3a)', 'WARNING -- RESTART MODE',
$ 'USING CONFIGURATION OF PREVIOUS RUN (',nmlname,')'
stop
*
endif
*
status = 1
goto 9991
9120 write (6, 9150) nmlname,nml
9991 continue
#if defined (NEC) || defined (HPPA)
call flush (6)
#endif
*
if (period_x) then
hblen_x = 0
endif
if (period_y) then
hblen_y = 0
endif
hblen_x = min(max(hblen_x,0),(gni/2-1))
hblen_y = min(max(hblen_y,0),(gnj/2-1))
*
nktop = min(gnk-1,max(0,nktop))
hord_zspng = min(gnk-2,max(0,hord_zspng))
if (hord_zspng.gt.0) hord_zspng=max(4,hord_zspng)
*
gcrunstrt = "19980101.000000"
gcjobstrt = gcrunstrt
dayfrac=(gnnt*grdt)/86400.0
call incdatsd(gcjobend,gcrunstrt,dayfrac)
gcrunend = gcjobend
call datp2f (gnidate,gcrunstrt)
Grd_ni = gni
Grd_nj = gnj
Grd_proj_S = 'P'
call hpalloc (paxp ,gni*2 , err,1)
call hpalloc (payp ,gnj*2 , err,1)
*
xref = 1000000.
yref = 1005000.
Grd_dgrw = 0.
*
gnstepno= 0
*
call gllvls (gnk)
*
Pil_nesdt = 0
c trpil(1) = 'BU'
do i=1,maxntrpil
trpil(i) = '@#@#'
end do
*
if (prout) then
*
* Print control parameters
*
print*
write (6, nml=mtn_cfgs_p)
print*
*
endif
*
601 format (' CONFIGURATION UPDATED again WITH NAMELIST ',a)
602 format (' NAMELIST ',a,' NOT FOUND - USING DEFAULT CONFIGURATION')
9150 format (/,2x,'==> ABORT -- ABORT <=='/2x,'NAMELIST ',a,
$ ' NOT FOUND ON FILE ',a/)
*
return
end