!
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE INITPARA ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE initpara(nx,ny,nz,nstyps) 9,278
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Initialize the model control parameters. Most of them are read in
! from an input file.
!
!-----------------------------------------------------------------------
!
! AUTHOR: Ming Xue
!
! 3/17/1991.
!
! MODIFICATION HISTORY:
!
! 5/02/92 (M. Xue)
! Added full documentation.
!
! 5/25/92 (M. Xue)
! Reworked to provide a friendly user interface for control
! parameter input, and write out a log file.
!
! 6/04/92 (M. Xue)
! Further facelift.
!
! 8/03/92 (M. Xue)
! The grid scale in the formula of divergecne damping coefficient
! is changed from (dx*dy*dz)**(2/3) to min(dx,dy,dz)**2.
! This will affect the results as compared with previous runs.
! Added output control parameter input etc.
!
! 4/16/93 (M. Xue and H. Jin)
! Added parameter inputs that are related to terrain.
!
! 9/20/93 (A. Sathye and M. Xue)
! Changed to the NAMELIST input format.
!
! 9/27/93 (M. Xue)
! For non-stretched case, dzmin is set to dz. For 2-d mode,
! appropriate LBC's are automatially set to periodic B.C.
!
! 12/3/93 (M. Xue)
! Added parameters for automatical grid translation.
!
! 2/12/94 (Yuhe Liu)
! Added parameters for surface energy budget model.
!
! 10/26/94 (Y. Liu)
! Add lbcopt to namelist &boundary_condition_options for the
! lateral boundary condition option.
!
! 12/12/94 (Y. Liu)
! Changed default values of variables in namelists to the same as
! in User's Guide and corrected the log file output.
!
! 12/22/94 (Y. Liu)
! Added more parameters into the namelist blocks, including
! ubar0 and vbar0 in initialization, and strhtune in grid.
!
! 01/28/95 (G. Bassett)
! Added new parameter, buoyopt, to input namelist &initialization.
!
! 08/24/95 (K. Brewster)
! Changed informative opening message to tell user about namelist.
!
! 2/2/96 (Donghai Wang & yuhe Liu)
! Added parameters for map projection factor.
!
! 3/26/96 (Yuhe Liu)
! Added a namelist, &radiation, and parameters for radiation.
!
! 4/2/96 (Donghai Wang, X. Song and M. Xue)
! Added parameters for implicit treatment of vertical mixing.
!
! 5/7/96 (Donghai Wang and M. Xue)
! Added a parameter for Rayleigh damping.
!
! 7/31/96 (Ming Xue and Yuhe Liu)
! Added the isotropic option for divergence damping. Parameter
! divdmpnd changed to divdmpndh for horizontal and divdmpndv for
! vertical.
!
! 3/23/97 (Ming Xue)
! Parameter scmixfctr added to namelist block computational_mixing.
!
! 3/23/97 (Ming Xue)
! Modifications made so that the program will complete reading in
! input parameters and check their validity even when error is
! encountered before it stops at the end of this subroutine.
!
! 7/27/97 (Dan Weber)
! Added fftopt to the list of specified parameters.
!
! 10/21/97 (Donghai Wang)
! Added two parameters,buoy2nd and rhofctopt.
!
! 04/15/98 (Donghai Wang)
! Added a new fraction factor for Kain-Fritsch scheme.
!
! 08/31/98 (K. Brewster)
! Added nudging NAMELIST to version 4.4.
!
! 1999/10/21 (Gene Bassett)
! Separated the reading in from the computation of derived variables
! (since some values were not being set when reading was aborted due
! to namelist read errors).
!
! 2000/04/13 (Gene Bassett)
! Added dumping options for HDF formats.
!
! 2000/04/24 (Gene Bassett)
! Update message passing version and added grid_dims &
! message_passing namelist blocks.
!
!-----------------------------------------------------------------------
!
! INPUT:
!
! nx Number of grid points in the x-direction
! ny Number of grid points in the y-direction
! nz Number of grid points in the z-direction
!
! OUTPUT:
!
! Control parameters defined in include files.
!
!-----------------------------------------------------------------------
!
! Variable Declarations. (Local Variables)
!
!-----------------------------------------------------------------------
!
IMPLICIT NONE
INTEGER :: nx,ny,nz ! The number of grid points in 3 dimensions.
INTEGER :: nstyps ! Maximum number of soil types per grid point.
!
!-----------------------------------------------------------------------
!
! Misc. local variables:
!
!-----------------------------------------------------------------------
!
REAL :: wrmax ! Maximun value of canopy moisture
INTEGER :: i
INTEGER :: lenstr ! Length of a string
LOGICAL :: iexist ! Flag set by inquire statement for file
! existence
REAL :: temr
REAL :: dtsml0,dtsfc0 ! Temporary variable
CHARACTER (LEN=19) :: initime ! Real time in form of 'year-mo-dy:hr:mn:ss'
INTEGER :: unum ! unit number for reading in namelist
PARAMETER (unum=5)
CHARACTER (LEN=80) :: inputfile
INTEGER :: lenfil
!
!-----------------------------------------------------------------------
!
! Include files:
!
!-----------------------------------------------------------------------
!
!
!-----------------------------------------------------------------------
!
! Global constants and parameters, most of them specify the
! model run options.
!
!-----------------------------------------------------------------------
!
INCLUDE 'globcst.inc'
INCLUDE 'soilcst.inc'
INCLUDE 'nudging.inc'
INCLUDE 'radcst.inc'
!
!-----------------------------------------------------------------------
!
! Grid and map parameters.
!
!-----------------------------------------------------------------------
!
INCLUDE 'grid.inc'
!
!-----------------------------------------------------------------------
!
! Control parameters defining the boundary condition types.
!
!-----------------------------------------------------------------------
!
INCLUDE 'bndry.inc'
!
!-----------------------------------------------------------------------
!
! Universal physical constants such as gas constants.
!
!-----------------------------------------------------------------------
!
INCLUDE 'phycst.inc'
!
!-----------------------------------------------------------------------
!
! External boundary parameters and variables.
!
!-----------------------------------------------------------------------
!
INCLUDE 'exbc.inc'
!
!-----------------------------------------------------------------------
!
! Message passing parameters.
!
!-----------------------------------------------------------------------
!
INCLUDE 'mp.inc'
!
!-----------------------------------------------------------------------
!
! namelist Declarations:
!
!-----------------------------------------------------------------------
!
!
!-----------------------------------------------------------------------
!
! Define the namelist, &arpsagr, for ARPS AGR. Not used by other programs
! except for ARPSagr. Included here to avoid problem on e.g., Cray's
! when reading arps.input.
!
!-----------------------------------------------------------------------
!
NAMELIST /grid_dims/ nx,ny,nz
NAMELIST /message_passing/ nproc_x,nproc_y,max_fopen
INCLUDE 'agricst.inc'
INCLUDE 'nodal.inc'
NAMELIST /arpsagr/ runold, rstime, &
levfix, intrat, intratt, &
intrpodr, kcheck, &
verbose1, verbose2, verbose3, &
verbose4, verbose5, verbose6, &
rstart,rstdump,grdsrt, &
nfinelv, ngrdnew, &
ixc,jyc,ixln,jyln,gangle
NAMELIST /comment_lines/ nocmnt, cmnt
NAMELIST /jobname/ runname
NAMELIST /model_configuration/ runmod
NAMELIST /initialization/ initime,initopt,inibasopt,viniopt,ubar0, &
vbar0,pt0opt,ptpert0,pt0radx,pt0rady,pt0radz,pt0ctrx, &
pt0ctry,pt0ctrz,rstinf,inifmt,inifile,inigbf,sndfile, &
soilinitopt,soiltintv,timeopt
NAMELIST /nudging/ nudgopt,ndstart,ndstop,ndintvl,ndgain,incrfnam, &
nudgu,nudgv,nudgw,nudgp,nudgpt,nudgqv, &
nudgqc,nudgqr,nudgqi,nudgqs,nudgqh,incrfmt
NAMELIST /equation_formulation/ buoyopt,buoy2nd,rhofctopt,bsnesq, &
peqopt
NAMELIST /terrain/ ternopt,mntopt,hmount,mntwidx,mntwidy, &
mntctrx,mntctry,terndta,ternfmt
NAMELIST /grid/ dx,dy,dz,strhopt,dzmin,zrefsfc,dlayer1,dlayer2, &
strhtune,zflat,ctrlat,ctrlon
NAMELIST /projection/ mapproj, trulat1,trulat2,trulon, sclfct, &
mpfctopt,mptrmopt,maptest
NAMELIST /timestep/ dtbig,tstart,tstop
NAMELIST /acoustic_wave/csopt,csfactr,csound,dtsml,vimplct, &
ptsmlstp,tacoef
NAMELIST /numerics/ madvopt, sadvopt,fctorderopt,fctadvptprt
NAMELIST /boundary_condition_options/ lbcopt, wbc,ebc,sbc,nbc, &
tbc,fftopt,bbc, rbcopt,c_phase,rlxlbc,pdetrnd
NAMELIST /exbcpara/exbcname,tinitebd,tintvebd, &
ngbrz,brlxhw,cbcdmp,cbcmix,exbcfmt
NAMELIST /coriolis_force/ coriopt,coriotrm
NAMELIST /turbulence/tmixopt,trbisotp,tkeopt,trbvimp,tmixvert, &
alfcoef,tmixcst, prantl, kmlimit
NAMELIST /computational_mixing/ &
cmix2nd,cfcm2h,cfcm2v,cmix4th,cfcm4h,cfcm4v,scmixfctr, &
cmix_opt
NAMELIST /divergence_damping/ divdmp,divdmpndh, divdmpndv
NAMELIST /rayleigh_damping/ raydmp,cfrdmp,zbrdmp
NAMELIST /asselin_time_filter/ flteps
NAMELIST /microphysics/ mphyopt,moist,cnvctopt, &
kffbfct,kfsubsattrig,wcldbs,confrq,qpfgfrq,idownd, &
subsatopt,rhsat,rhsatmin,dx_rhsatmin,dx_rhsat100
NAMELIST /radiation/ radopt, radstgr, rlwopt, dtrad, raddiag
NAMELIST /surface_physics/ sfcphy,landwtr,cdhwtropt, &
cdmlnd,cdmwtr,cdhlnd,cdhwtr,cdqlnd,cdqwtr, &
pbldopt,pbldpth0,lsclpbl0,tqflxdis,dtqflxdis, &
smthflx,numsmth,sfcdiag
NAMELIST /soil_ebm/ sfcdat,soilinit,dtsfc, &
styp,vtyp,lai0,roufns0,veg0,ptslnd0,ptswtr0, &
tsoil0,wetsfc0,wetdp0,wetcanp0,snowdpth0, &
tsprt,t2prt,wgrat,w2rat, &
sfcdtfl,soilinfl,sfcfmt,soilfmt,nstyp, &
tsoil_offset, tsoil_offset_amplitude
NAMELIST /grdtrans/cltkopt,grdtrns,umove,vmove,chkdpth, &
twindow,tceltrk,tcrestr
NAMELIST /history_dump/ hdmpopt,hdmpfmt,grbpkbit,thisdmp, &
tstrtdmp,numhdmp,hdmptim,istager,hdfcompr
NAMELIST /output/ dirname,tfmtprt,exbcdmp,extdadmp, &
grdout,basout,varout,mstout,rainout,prcout, &
iceout,tkeout, trbout,sfcout,landout,totout, &
radout,flxout, &
qcexout,qrexout,qiexout,qsexout,qhexout, &
trstout,tmaxmin,tenergy,imgopt, &
timgdmp,pltopt,tplots,filcmprs,readyfl, &
sfcdmp,soildmp,terndmp
NAMELIST /debug/ lvldbg
REAL :: dh
INTEGER :: err_no
DATA err_no /0/
INTEGER :: ip
INTEGER ebcsv,wbcsv,nbcsv,sbcsv
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!-----------------------------------------------------------------------
!
! Set the ARPS version number, which will be printed in the log
! file in the comment line. The string can be up to 20 character long.
!
!-----------------------------------------------------------------------
arpsversion = 'ARPS 5.0'
!
!-----------------------------------------------------------------------
!
! Now we begin to read in the values of parameters:
!
!-----------------------------------------------------------------------
!
!
!-----------------------------------------------------------------------
!
! Set up the default values for all the variables to be read in
! using the namelist method. In case the user does not specify a
! particular value, this value will be used.
!
!-----------------------------------------------------------------------
!
nx = 67
ny = 67
nz = 35
nproc_x = 1
nproc_y = 1
max_fopen = 1
nocmnt = 10
cmnt(1) = ' '
cmnt(2) = 'A zero perturbation run '
cmnt(3) = ' '
cmnt(4) = ' '
cmnt(5) = ' '
cmnt(6) = ' '
cmnt(7) = ' '
cmnt(8) = ' '
cmnt(9) = ' '
cmnt(10) =' '
runname = 'may20'
runmod = 1
initime = '1977-05-20.21:00:00'
timeopt = 0
initopt = 1
inibasopt = 1
viniopt = 1
pt0opt = 1
ubar0 = 0.0
vbar0 = 0.0
ptpert0 = 4.0
pt0radx = 10000.0
pt0rady = 10000.0
pt0radz = 1500.0
pt0ctrx = 32000.0
pt0ctry = 32000.0
pt0ctrz = 1500.0
rstinf = 'may20.rst003600'
inifmt = 1
inifile = 'may20.bin003600'
inigbf = 'may20.bingrdbas'
sndfile = 'may20.snd'
soilinitopt = 0
soiltintv = 0.0
nudgopt = 0
ndstart = 0.
ndstop = 0.
ndintvl = 600.
ndgain = 1.9
incrfnam = 'nudge.spam'
incrfmt = 0
nudgu = 1
nudgv = 1
nudgw = 1
nudgp = 1
nudgpt = 1
nudgqv = 1
nudgqc = 0
nudgqr = 0
nudgqi = 0
nudgqs = 0
nudgqh = 0
ternopt = 0
mntopt = 1
hmount = 0.0
mntwidx = 1.0E4
mntwidy = 1.0E4
mntctrx = 1.0E4
mntctry = 1.0E4
terndta ='arpstern.data'
ternfmt = 0
dx = 1000.0
dy = 1000.0
dz = 500.0
strhopt = 0
dzmin = 500.0
zrefsfc = 0.0
dlayer1 = 0.0
dlayer2 = 1.0E5
strhtune = 1.0
zflat = 1.0E5
ctrlat = 35.0
ctrlon = -100.0
mapproj = 0
trulat1 = 30.0
trulat2 = 60.0
trulon = -100.0
sclfct = 1.0
mpfctopt = 1
mptrmopt = 1
maptest = 0
dtbig = 6.0
tstart= 0.0
tstop = 3600.0
vimplct = 1
ptsmlstp = 0
csopt = 1
csfactr = 0.5
csound = 150.0
tacoef = 0.6
dtsml = 1.0
buoyopt = 1
buoy2nd = 1
rhofctopt = 1
bsnesq = 0
peqopt = 1
madvopt = 1
sadvopt = 1
fctorderopt=1
fctadvptprt=1
lbcopt = 1
wbc = 4
ebc = 4
sbc = 4
nbc = 4
tbc = 1
fftopt = 2
bbc = 1
rbcopt = 1
c_phase = 30.0
rlxlbc = 0.0
pdetrnd = 0
radopt = 0
radstgr = 1
rlwopt = 1
dtrad = 600.0
raddiag = 1
moist = 0
mphyopt = 0
cnvctopt = 0
subsatopt = 0
kffbfct = 0.0
kfsubsattrig = 0
ice = 0
wcldbs = 0.005
confrq = 600.0
qpfgfrq = 120.0
idownd = 1
rhsat = 0.80
rhsatmin = 0.80
dx_rhsatmin = 50000.
dx_rhsat100 = 5000.
sfcphy = 0
landwtr = 1
cdhwtropt= 0
cdmlnd = 3.0E-3
cdmwtr = 1.0E-3
cdhlnd = 3.0E-3
cdhwtr = 1.0E-3
cdqlnd = 2.1E-3
cdqwtr = 0.7E-3
pbldopt = 0
pbldpth0 = 1400.0
lsclpbl0 = 0.15
sflxdis = 0
tqflxdis = 0
dtqflxdis= 200.0
smthflx = 0
numsmth = 1
sfcdiag = 0
sfcdat = 1
nstyp = 4
styp = 3
vtyp = 10
lai0 = 0.31
roufns0 = 0.1
veg0 = 0.0
sfcdtfl = 'arpssfc.data'
sfcfmt = 0
soilinit = 1
ptslnd0 = 300.16
ptswtr0 = 288.16
tsoil0 = 297.16
wetsfc0 = 0.0
wetdp0 = 0.0
wetcanp0 = 0.0
snowdpth0 = 0
soilinfl = 'may20.soilinit'
soilfmt = 0
dtsfc = 10.0
coriopt = 0
coriotrm= 0
tmixopt = 2
trbisotp = 1
tkeopt = 1
trbvimp = 0
tmixvert = 1
alfcoef = 0.25
prantl = 1.0
tmixcst = 0.0
kmlimit = 0.5
cmix2nd = 1
cfcm2h = 0.0
cfcm2v = 1.0E-3
cmix4th = 1
cfcm4h = 1.0E-3
cfcm4v = 0.0
scmixfctr = 1.0
cmix_opt = 0
divdmp = 1
divdmpndh = 0.05
divdmpndv = 0.05
tmaxmin = 60.0
tenergy = 360000.0
imgopt = 0
timgdmp = 60.0
pltopt = 0
tplots = 1800.0
filcmprs = 1
readyfl = 0
raydmp = 0
cfrdmp = 1./300.
zbrdmp = 10000.0
flteps = 0.10
cltkopt = 0
grdtrns = 0
umove = 0.0
vmove = 0.0
chkdpth = 2500.0
twindow = 33333
tceltrk = 120.0
tcrestr = 1800.0
lvldbg = 0
hdmpopt = 1
hdmpfmt = 10
grbpkbit = 16
hdfcompr = 0
thisdmp = 3600.0
tstrtdmp = 0.0
numhdmp = 1
DO i=1,numhdmp
hdmptim(i) = 0.
END DO
istager = 0
dirname = ' '
tfmtprt = 3600.0
exbcdmp = 0
extdadmp = 0
grdout = 0
basout = 0
varout = 1
mstout = 1
rainout = 0
prcout = 0
iceout = 0
totout = 1
tkeout = 0
trbout = 0
sfcout = 0
snowout = 0
landout = 0
radout = 0
flxout = 0
qcexout = 0
qrexout = 0
qiexout = 0
qsexout = 0
qhexout = 0
sfcdmp = 0
soildmp = 0
terndmp = 0
trstout = 3600.0
exbcname = 'arpsexbc'
tinitebd = '1977-05-20.15:00:00'
tintvebd = 10800
ngbrz = 5
brlxhw = 2.3
cbcdmp = 0.0033333333
cbcmix = 1.0E-3
exbcfmt = 0
mgrid = 1
!
!-----------------------------------------------------------------------
!
! Initialize message passing processors.
!
!-----------------------------------------------------------------------
!
! Non-MPI defaults:
mp_opt = 0
myproc = 0
loc_x = 1
loc_y = 1
!
!-----------------------------------------------------------------------
!
! Initialize the processors for an MPI job.
!
!-----------------------------------------------------------------------
!
CALL mpinit_proc
IF (myproc == 0)THEN
WRITE(6,'(/ 16(/5x,a)//)') &
'###############################################################', &
'###############################################################', &
'##### #####', &
'##### Welcome to #####', &
'##### #####', &
'##### The Advanced Regional Prediction System (ARPS) #####', &
'##### #####', &
'##### Version 5.0 #####', &
'##### #####', &
'##### Developed by #####', &
'##### Center for Analysis and Prediction of Storms #####', &
'##### University of Oklahoma #####', &
'##### #####', &
'###############################################################', &
'###############################################################'
WRITE(6,'(5(/5x,a),/6(/5x,a)/)') &
'The model begins by reading a number of control parameters,', &
'which are specified in namelist format through the standard', &
'input stream (unit 5). See the ARPS Users Guide and the', &
'sample input file, arps.input, for guidance on specifying', &
'these parameters', &
'At the end of all parameter input, a log file is produced', &
'which can be directly used as the input file when you want', &
'to replicate the same job. This file is named runnam.log.nn', &
'where runnam is a standard prefix for all output files that', &
'are produced by this job and nn is a number appended to the', &
'file name when file runnam.log.nn-1 already exists.'
END IF
!
!-----------------------------------------------------------------------
!
! Read in grid dimensions.
!
!-----------------------------------------------------------------------
!
IF (myproc == 0) READ (unum,grid_dims, END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)')'Namelist block grid_dims sucessfully read.'
END IF
CALL mpupdatei(nx,1)
CALL mpupdatei(ny,1)
CALL mpupdatei(nz,1)
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i5)') "nx =",nx
WRITE(6,'(5x,a,i5)') "ny =",ny
WRITE(6,'(5x,a,i5)') "nz =",nz
END IF
!
!-----------------------------------------------------------------------
!
! Read in message passing options.
!
!-----------------------------------------------------------------------
!
IF (myproc == 0) READ (unum,message_passing, END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)')'Namelist block message_passing sucessfully read.'
END IF
CALL mpupdatei(nproc_x,1)
CALL mpupdatei(nproc_y,1)
CALL mpupdatei(max_fopen,1)
nproc_x_in = nproc_x
nproc_y_in = nproc_y
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i4)') &
"Number of processors in the x-direction is:",nproc_x
WRITE(6,'(5x,a,i4)') &
"Number of processors in the y-direction is:",nproc_y
WRITE(6,'(5x,a,i4)') &
"Maximum number of files open:",max_fopen
END IF
! Note that for MP version nx & ny here are global values. They will
! be reassigned to their per-processor value below.
IF (mp_opt > 0) THEN
IF (nx /= nproc_x*int((nx-3)/nproc_x)+3) THEN
nx = nproc_x*int((nx-3)/nproc_x+0.9999999999999) + 3
IF (myproc == 0) THEN
WRITE (6,*) "WARNING: adjusting nx to fit on ",nproc_x," processors:"
WRITE(6,'(5x,a,i5)') " new nx =",nx
ENDIF
ENDIF
IF (ny /= nproc_y*int((ny-3)/nproc_y)+3) THEN
ny = nproc_y*int((ny-3)/nproc_y+0.9999999999999) + 3
IF (myproc == 0) THEN
WRITE (6,*) "WARNING: adjusting ny to fit on ",nproc_y," processors:"
WRITE(6,'(5x,a,i5)') " new ny =",ny
ENDIF
ENDIF
ELSE
nproc_x = 1
nproc_y = 1
nprocs = 1
max_fopen = 1
ENDIF
!
!-----------------------------------------------------------------------
!
! Initialize message passing variables.
!
!-----------------------------------------------------------------------
!
CALL mpinit_var
!-----------------------------------------------------------------------
! Read in agri name list block - not used by single grid arps run
!-----------------------------------------------------------------------
IF (myproc == 0) READ (unum,arpsagr, END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)')'Namelist block arpsagr sucessfully read.'
END IF
!
!-----------------------------------------------------------------------
!
! Read in some comment lines on this job and the name of
! this run designated by a string at least 6 character long.
!
!-----------------------------------------------------------------------
!
IF (myproc == 0) READ (unum,comment_lines, END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)')'Namelist block comment_lines sucessfully read.'
END IF
CALL mpupdatei(nocmnt,1)
CALL mpupdatec(cmnt,80*nocmnt)
IF (myproc == 0) READ (unum,jobname,END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)')'Namelist block jobname sucessfully read.'
END IF
CALL mpupdatec(runname,80)
IF (myproc == 0)THEN
WRITE(6,'(/5x,a,a)') 'The name of this run is: ', runname
END IF
!
!-----------------------------------------------------------------------
!
! Find out the number of characters to be used to construct file
! names.
!
!-----------------------------------------------------------------------
!
CALL gtlfnkey( runname, lfnkey )
!
!-----------------------------------------------------------------------
!
! Read in the parameter that controls the model run mode:
!
!-----------------------------------------------------------------------
!
IF (myproc == 0) READ (unum,model_configuration,END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)') &
'Namelist block model_configuration sucessfully read.'
END IF
CALL mpupdatei(runmod,1)
IF (myproc == 0)THEN
WRITE (6,'(/5x,a,i4)') 'The run mode is: ', runmod
END IF
!
!-----------------------------------------------------------------------
!
! Read in control parameter INITOPT for model initialization
!
! INITOPT = 1, Self initialization (e.g. specify perturbation using
! analytical functions),
! = 2, Restart run, initialize the model using previous
! model output,
! = 3, Initialize the model using external input data file.
!
! For options 2 and 3, the names of input files need to be provided.
!
!-----------------------------------------------------------------------
!
IF (myproc == 0) READ (unum,initialization,END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)')'Namelist block initialization sucessfully read.'
END IF
CALL mpupdatec(initime,19)
CALL mpupdatei(initopt,1)
CALL mpupdatei(inibasopt,1)
CALL mpupdatei(viniopt,1)
CALL mpupdater(ubar0,1)
CALL mpupdater(vbar0,1)
CALL mpupdatei(pt0opt,1)
CALL mpupdater(ptpert0,1)
CALL mpupdater(pt0radx,1)
CALL mpupdater(pt0rady,1)
CALL mpupdater(pt0radz,1)
CALL mpupdater(pt0ctrx,1)
CALL mpupdater(pt0ctry,1)
CALL mpupdater(pt0ctrz,1)
CALL mpupdatec(rstinf,128)
CALL mpupdatei(inifmt,1)
CALL mpupdatec(inifile,128)
CALL mpupdatec(inigbf,128)
CALL mpupdatec(sndfile,128)
CALL mpupdatei(soilinitopt,1)
CALL mpupdater(soiltintv,1)
CALL mpupdatei(timeopt,1)
READ (initime, '(i4.4,1x,i2.2,1x,i2.2,1x,i2.2,1x,i2.2,1x,i2.2)' ) &
year,month,day,hour,minute,second
IF (myproc == 0)THEN
WRITE(6,'(a,a,i4.4,a,i2.2,a,i2.2,a,i2.2,a,i2.2,a,i2.2)') &
' The initial local time for this run is ', &
' year-mo-dy:hr:mn:ss = ', &
year,'-',month,'-',day,'.',hour,':',minute,':',second
WRITE(6,'(5x,a,i4/)') 'Perturbation option was ', pt0opt
WRITE(6,'(5x,a,f10.3,a)') &
'The magnitude of the initial perturbation is ', ptpert0,' K.'
WRITE(6,'(5x,a,3e10.3,a,/5x,a,a,/5x,a,e10.3,a,e10.3,a,e10.3,a)') &
'The input radii of the thermal bubble are ', &
pt0radx, pt0rady, pt0radz,' (m)', &
'in x, y and z direction recpectively, and the center is ', &
'located at','x=',pt0ctrx,' y=',pt0ctry,' z=',pt0ctrz, &
' (m).'
END IF
!
!-----------------------------------------------------------------------
!
! Input data files for initialization:
!
!-----------------------------------------------------------------------
!
lenstr = 80
CALL strlnth( rstinf, lenstr)
IF (myproc == 0)THEN
WRITE(6,'(5x,a,a)') &
'The two time level restart data to be read in is ', &
rstinf(1:lenstr)
WRITE(6,'(5x,a,i4)') &
'The history dump type restart data format was ',inifmt
END IF
lenstr = 80
CALL strlnth( inifile, lenstr)
IF (myproc == 0)THEN
WRITE(6,'(5x,a,a)') &
'The t-depedent history dump format restart data to be read is ', &
inifile(1:lenstr)
END IF
lenstr = 80
CALL strlnth( inigbf, lenstr)
IF (myproc == 0)THEN
WRITE(6,'(5x,a,a,a)') &
'The base state/grid history dump ', &
'format restart data to be read is ', inigbf(1:lenstr)
END IF
!
!-----------------------------------------------------------------------
!
! Input the environmental sounding.
!
!-----------------------------------------------------------------------
!
lenstr = 80
CALL strlnth( sndfile, lenstr )
IF (myproc == 0)THEN
WRITE(6,'(5x,a,a)') &
'Sounding file to be used is ', sndfile(1:lenstr)
END IF
!
!-----------------------------------------------------------------------
!
! Read the nudging options.
!
!-----------------------------------------------------------------------
!
IF (myproc == 0) READ (unum,nudging,END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)')'Namelist block nudging sucessfully read.'
END IF
CALL mpupdatei(nudgopt,1)
CALL mpupdater(ndstart,1)
CALL mpupdater(ndstop,1)
CALL mpupdater(ndintvl,1)
CALL mpupdater(ndgain,1)
CALL mpupdatec(incrfnam,132)
CALL mpupdatei(nudgu,1)
CALL mpupdatei(nudgv,1)
CALL mpupdatei(nudgw,1)
CALL mpupdatei(nudgp,1)
CALL mpupdatei(nudgpt,1)
CALL mpupdatei(nudgqv,1)
CALL mpupdatei(nudgqc,1)
CALL mpupdatei(nudgqr,1)
CALL mpupdatei(nudgqi,1)
CALL mpupdatei(nudgqs,1)
CALL mpupdatei(nudgqh,1)
CALL mpupdatei(incrfmt,1)
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i4)') &
'The nudging assimilation option was ',nudgopt
WRITE(6,'(5x,a,f9.2)') 'Nudging assimilation start: ',ndstart
WRITE(6,'(5x,a,f9.2)') 'Nudging assimilation stop: ',ndstop
WRITE(6,'(5x,a,f9.2)') 'Nudging assimilation interval: ',ndintvl
WRITE(6,'(5x,a,f9.2)') 'Nudging assimilation gain: ',ndgain
END IF
lenstr = 80
CALL strlnth( incrfnam, lenstr)
IF (myproc == 0)THEN
WRITE(6,'(5x,a,a)') &
'The nudging increment file is ',incrfnam(1:lenstr)
END IF
!
!-----------------------------------------------------------------------
!
! Specify the types of terrain option:
!
!-----------------------------------------------------------------------
!
IF (myproc == 0) READ (unum,terrain,END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)')'Namelist block terrain sucessfully read.'
END IF
CALL mpupdatei(ternopt,1)
CALL mpupdatei(mntopt,1)
CALL mpupdater(hmount,1)
CALL mpupdater(mntwidx,1)
CALL mpupdater(mntwidy,1)
CALL mpupdater(mntctrx,1)
CALL mpupdater(mntctry,1)
CALL mpupdatec(terndta,128)
CALL mpupdatei(ternfmt,1)
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i4)') 'The mountain type option was ', mntopt
WRITE(6,'(5x,a,f10.3,a)') &
'The height of mountain is ', hmount,' (m).'
WRITE(6,'(5x,a,2e10.3,a,/5x,a,a,/5x,a,e10.3,a,e10.3,a)') &
'The input half-width of bell-shaped mountain are ', &
mntwidx, mntwidy, ' (m)', &
'in x and y direction recpectively, and the center is ', &
'located at','x=',mntctrx,' y=',mntctry,' (m).'
WRITE(6,'(5x,a,i4)') 'The terrain option was ', ternopt
END IF
lenstr = 80
CALL strlnth( terndta, lenstr)
IF (myproc == 0)THEN
WRITE(6,'(5x,a,a)') &
'The terrain data file is ',terndta(1:lenstr)
WRITE(6,'(5x,a,i4)') 'The terrain data file format is ', ternfmt
END IF
!
!-----------------------------------------------------------------------
!
! Input horizontal grid size
!
!-----------------------------------------------------------------------
!
IF (myproc == 0) READ (unum,grid,END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)')'Namelist block grid sucessfully read.'
END IF
CALL mpupdater(dx,1)
CALL mpupdater(dy,1)
CALL mpupdater(dz,1)
CALL mpupdatei(strhopt,1)
CALL mpupdater(dzmin,1)
CALL mpupdater(zrefsfc,1)
CALL mpupdater(dlayer1,1)
CALL mpupdater(dlayer2,1)
CALL mpupdater(strhtune,1)
CALL mpupdater(zflat,1)
CALL mpupdater(ctrlat,1)
CALL mpupdater(ctrlon,1)
IF( strhopt == 0.AND.dzmin /= dz ) THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a)') &
'For non-stretched case, dzmin was reset to dz.'
END IF
dzmin = dz
END IF
IF (myproc == 0)THEN
WRITE(6,'(5x,a,f10.3,a)') &
'Input dx was',dx,' meters'
WRITE(6,'(5x,a,f10.3,a)') &
'Input dy was ',dy,' meters'
WRITE(6,'(5x,a,i4)') 'The stretch option was ', strhopt
WRITE(6,'(5x,a,f10.3,a)') &
'Input dz was ',dz,' meters'
WRITE(6,'(5x,a,f10.3,a)') &
'Input ctrlat was ',ctrlat,' degree North'
WRITE(6,'(5x,a,f10.3,a)') &
'Input ctrlon was ',ctrlon,' degree East'
WRITE(6,'(5x,a,f10.3,a)') &
'dzmin is ',dzmin,' meters'
WRITE(6,'(5x,a,f10.3,a)') &
'zrefsfc is ',zrefsfc ,' meters'
WRITE(6,'(5x,a,f10.3,a)') &
'dlayer1 is ',dlayer1 ,' meters'
WRITE(6,'(5x,a,f10.3,a)') &
'dlayer2 is ',dlayer2 ,' meters'
WRITE(6,'(5x,a,f10.3,a)') &
'zflat is ',zflat ,' meters'
END IF
!
!-----------------------------------------------------------------------
!
! Input map projection parameters
!
!-----------------------------------------------------------------------
!
IF (myproc == 0) READ (unum,projection,END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)')'Namelist block projection sucessfully read.'
END IF
CALL mpupdatei(mapproj,1)
CALL mpupdater(trulat1,1)
CALL mpupdater(trulat2,1)
CALL mpupdater(trulon,1)
CALL mpupdater(sclfct,1)
CALL mpupdatei(mpfctopt,1)
CALL mpupdatei(mptrmopt,1)
CALL mpupdatei(maptest,1)
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i4)') &
'Input mapproj was ',mapproj
WRITE(6,'(5x,a,f10.3,a)') &
'Input trulat1 was ',trulat1,' degree North'
WRITE(6,'(5x,a,f10.3,a)') &
'Input trulat2 was ',trulat2,' degree North'
WRITE(6,'(5x,a,f10.3)') &
'The latitude of the center of the model domain was ',ctrlat
WRITE(6,'(5x,a,f10.3)') &
'The longitude of the center of the model domain was ',ctrlon
WRITE(6,'(5x,a,f10.3,a)') &
'Input trulon was ',trulon,' degree East'
WRITE(6,'(5x,a,e15.5)') &
'Input sclfct was ',sclfct
WRITE(6,'(5x,a,i5)') &
'The option for map factor was ', mpfctopt
WRITE(6,'(5x,a,i5)') &
'The option for map factor term in u and v advection was ', &
mptrmopt
END IF
IF (myproc == 0) READ (unum,timestep,END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)')'Namelist block timestep sucessfully read.'
END IF
CALL mpupdater(dtbig,1)
CALL mpupdater(tstart,1)
CALL mpupdater(tstop,1)
IF (myproc == 0)THEN
WRITE(6,'(5x,a,f10.3,a)') &
'The big timestep was ',dtbig,' seconds.'
WRITE(6,'(5x,a,f10.3,a)') &
'The model startup time was ',tstart, ' seconds.'
WRITE(6,'(5x,a,f10.3,a)') &
'The termination time was ',tstop, ' seconds.'
END IF
IF (myproc == 0) READ (unum,acoustic_wave,END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)')'Namelist block acoustic_wave sucessfully read.'
END IF
CALL mpupdatei(csopt,1)
CALL mpupdater(csfactr,1)
CALL mpupdater(csound,1)
CALL mpupdater(dtsml,1)
CALL mpupdatei(vimplct,1)
CALL mpupdatei(ptsmlstp,1)
CALL mpupdater(tacoef,1)
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i4)') 'The sound speed option was ',csopt
WRITE(6,'(5x,a,f10.3)') &
'The reduction factr for sound speed was ', csfactr
WRITE(6,'(5x,a,f10.3,a)') &
'The constant sound speed was ', csound,' m/s.'
WRITE(6,'(5x,a,a,i5)') &
'The vertical implicit integration option for ', &
'w and p equations was ', vimplct
WRITE(6,'(5x,a,a,i5)') &
'The option for potential temperature equation integration', &
'was ', ptsmlstp
WRITE(6,'(5x,a,a,f10.3)') &
'The time average coefficient for vertically ', &
'implicit solver was ', tacoef
WRITE(6,'(5x,a,f10.3,a)') &
'The input small timestep was ',dtsml,' seconds.'
WRITE(6,'(5x,a,f10.3,a)') &
'The actual small time step size to be used is ', &
dtsml,' seconds.'
END IF
!
!-----------------------------------------------------------------------
!
! Read in parameters related to equation formaulation
!
!-----------------------------------------------------------------------
!
IF (myproc == 0) READ (unum,equation_formulation,END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)') &
'Namelist block equation_formulation sucessfully read.'
END IF
CALL mpupdatei(buoyopt,1)
CALL mpupdatei(buoy2nd,1)
CALL mpupdatei(rhofctopt,1)
CALL mpupdatei(bsnesq,1)
CALL mpupdatei(peqopt,1)
IF ( buoyopt == 0 ) THEN
IF (myproc == 0)THEN
WRITE(6,*) 'WARNING: buoyancy terms turned off by', &
'selecting buoyopt=0.'
END IF
END IF
IF (myproc == 0)THEN
WRITE(6,'(5x,a,a,i5)') &
'The option for pressure equation formulation', &
'was ',peqopt
END IF
!
!-----------------------------------------------------------------------
!
! Read in parameters related to numerical schemes
!
!-----------------------------------------------------------------------
!
IF (myproc == 0) READ (unum,numerics,END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)')'Namelist block numerics sucessfully read.'
END IF
CALL mpupdatei(madvopt,1)
CALL mpupdatei(sadvopt,1)
CALL mpupdatei(fctorderopt,1)
CALL mpupdatei(fctadvptprt,1)
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i5)') &
'The option for momentum advection was ', madvopt
IF( madvopt < 1 .OR. madvopt > 3 ) THEN
WRITE(6,'(5x,a,i3,a,2(/5x,a))') &
'Input value of madvopt= ', madvopt,' was invalid.', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
err_no = err_no + 1
END IF
WRITE(6,'(5x,a,i5)') &
'The option for scalar advection was ', sadvopt
IF( sadvopt < 1 .OR. sadvopt > 5 ) THEN
WRITE(6,'(5x,a,i3,a,2(/5x,a))') &
'Input value of sadvopt= ', sadvopt,' was invalid.', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
err_no = err_no + 1
END IF
IF( fctorderopt /= 1 .AND. fctorderopt /= 2 ) THEN
WRITE(6,'(5x,a,i3,a,2(/5x,a))') &
'Input value of fctorderopt= ', fctorderopt,' was invalid.', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
err_no = err_no + 1
END IF
IF( fctadvptprt < 0 .OR. fctadvptprt > 2 ) THEN
WRITE(6,'(5x,a,i3,a,2(/5x,a))') &
'Input value of fctadvptprt= ', fctadvptprt,' was invalid.', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
err_no = err_no + 1
END IF
IF(sadvopt == 4.AND.ptsmlstp == 1.AND.fctadvptprt /= 1) THEN
WRITE(6,'(2(/5x,a))') &
'When sadvopt=4, and ptsmlstp=1, fctadvptprt has to be 1', &
'fctadvptprt reset to 1'
fctadvptprt = 1
END IF
END IF
!
!-----------------------------------------------------------------------
!
! Input boundary condition control parameters:
!
!-----------------------------------------------------------------------
!
IF (myproc == 0) READ (unum,boundary_condition_options,END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)') &
'Namelist block boundary_condition_options sucessfully read.'
END IF
CALL mpupdatei(lbcopt,1)
CALL mpupdatei(wbc,1)
CALL mpupdatei(ebc,1)
CALL mpupdatei(sbc,1)
CALL mpupdatei(nbc,1)
CALL mpupdatei(tbc,1)
CALL mpupdatei(fftopt,1)
CALL mpupdatei(bbc,1)
CALL mpupdatei(rbcopt,1)
CALL mpupdater(c_phase,1)
CALL mpupdater(rlxlbc,1)
CALL mpupdatei(pdetrnd,1)
!
!-----------------------------------------------------------------------
!
! For 2-D or 1-D runs, appropriate boundary conditions are
! automatically set to periodic.
!
!-----------------------------------------------------------------------
!
IF( runmod == 2 .OR. runmod == 4 ) THEN
IF( nbc /= 2 ) THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i2)') 'nbc reset to 2 for runmod=',runmod
END IF
nbc = 2
END IF
IF( sbc /= 2 ) THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i2)') 'sbc reset to 2 for runmod=',runmod
END IF
sbc = 2
END IF
END IF
IF( runmod == 3 .OR. runmod == 4 ) THEN
IF( wbc /= 2 ) THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i2)') 'wbc reset to 2 for runmod=',runmod
END IF
wbc = 2
END IF
IF( ebc /= 2 ) THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i2)') 'ebc reset to 2 for runmod=',runmod
END IF
ebc = 2
END IF
END IF
IF ( lbcopt == 1 .AND. &
(wbc == 5 .OR. ebc == 5 .OR. sbc == 5 .OR. nbc == 5) ) THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a/5x,a,4(/5x,a,i2),2(/5x,a))') &
'The lateral boundary conditions was set to internal ', &
'determined, but one of them was set to external forced.', &
'wbc = ',wbc,' ebc = ',ebc,' sbc = ',sbc,' nbc = ',nbc, &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
END IF
err_no = err_no + 1
ELSE IF ( lbcopt == 2 ) THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a/5x,a)') &
'The lateral boundary conditions was set to external forced.', &
'All lateral boundary conditions will be reset to 5 accordingly.'
END IF
wbc = 5
ebc = 5
sbc = 5
nbc = 5
ELSE IF( lbcopt /= 1 ) THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i3,a,2(/5x,a))') &
'Input value of lbcopt = ', lbcopt,' was invalid.', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
END IF
err_no = err_no + 1
END IF
IF ( ebc == 3 .OR. wbc == 3 ) THEN
ebc = 3
wbc = 3
END IF
IF ( nbc == 3 .OR. sbc == 3 ) THEN
nbc = 3
sbc = 3
END IF
IF (myproc == 0)THEN
WRITE(6,'(5x,a, 4(/5x,i3,a))') &
'The boundary options are:', &
wbc,' for west boundary,',ebc,' for east boundary,', &
sbc,' for south boundary,',nbc,' for north boundary.'
IF ( vimplct == 1 .AND. (tbc == 2 .OR. bbc == 2) ) THEN
WRITE(6,'(5x,a/5x,a,2(/5x,a,i2),2(/5x,a))') &
'The small time step integration scheme was set to implicit ', &
'which is not valid to periodic vertical boundary conditions.', &
'tbc = ',tbc,' bbc = ',bbc, &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
err_no = err_no + 1
END IF
WRITE(6,'(5x,a, /2(5x,i3,a))') &
'The boundary options are:', &
tbc,' for top boundary,',bbc,' for bottom boundary.'
WRITE(6,'(5x,a, /2(5x,i3,a))') &
'The upper boundary fft transform option is: ', fftopt
IF( vimplct == 0.AND.tbc == 4)THEN
WRITE(6,'(5x,a,/5x,a,/5x,a,2(/5x,a))') &
'The upper radiation condition boundary option was chosen and', &
'is not compatible with the vertically explicit option', &
'reset tbc or vimplct', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
err_no = err_no + 1
END IF
IF( tbc == 4.AND.inibasopt == 2)THEN
WRITE(6,'(5x,a,/5x,a,4(/5x,a))') &
'The upper radiation boundary condition option was chosen ', &
'with a neutral environment. This upper radiation ', &
'is not compatible with a neutral base state. ', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
err_no = err_no + 1
END IF
!
!-----------------------------------------------------------------------
!
! Input radiation lateral boundary condition options:
!
!-----------------------------------------------------------------------
!
IF( rbcopt < 1.OR.rbcopt > 5 ) THEN
WRITE(6,'(1x,a,/1x,a,i3,a,2(5x,a))') &
'Only option rbcopt=1,2,3,4 is available in current version.', &
'The input was ',rbcopt,', Please reset rbcopt and rerun ARPS.', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
err_no = err_no + 1
END IF
WRITE(6,'(5x,a,i4)') &
'The radiation boundary condition option was',rbcopt
WRITE(6,'(5x,a,/5x,a,f13.6)') &
'The constant gravity phase speed used by radiation ', &
'lateral boundary condition option 2 was ',c_phase
WRITE(6,'(5x,a,f13.6)') &
'The relaxation coefficient used at the inflow boundaries is' &
,rlxlbc
! IF ( initopt.ne.1 .and. lbcopt.ne.1 ) THEN
! pdetrnd = 0
! ENDIF
WRITE(6,'(5x,a,i4)') &
'Option for pressure detrending was', pdetrnd
END IF
!
!-----------------------------------------------------------------------
!
! Input external boundary condition control parameters:
!
!-----------------------------------------------------------------------
!
IF (myproc == 0) READ (unum,exbcpara)
IF (myproc == 0)THEN
WRITE(6,'(a)')'Namelist block exbcpara sucessfully read.'
END IF
CALL mpupdatec(exbcname,80)
CALL mpupdatec(tinitebd,19)
CALL mpupdatei(tintvebd,1)
CALL mpupdatei(ngbrz,1)
CALL mpupdatei(brlxhw,1)
CALL mpupdatei(cbcdmp,1)
CALL mpupdatei(cbcmix,1)
CALL mpupdatei(exbcfmt,1)
IF (myproc == 0)THEN
WRITE(6,'(5x,a,a9)') &
'The initial external boundary time string was ',tinitebd
WRITE(6,'(5x,a,i10)') &
'The time interval to update external boundary conditions was ', &
tintvebd
WRITE(6,'(5x,a,i10)') &
'The number of boundary relaxation zone grids was ', ngbrz
WRITE(6,'(5x,a,e15.8)') &
'The real grid number where BC relaxation is half weighted was ', &
brlxhw
WRITE(6,'(5x,a,e15.8)') &
'The magnitude of the boundary relaxation damping was ',cbcdmp
WRITE(6,'(5x,a,e15.8)') &
'The magnitude of the boundary computational mixing was ',cbcmix
WRITE(6,'(5x,a,i4)') &
'The external boundary file format was ', exbcfmt
END IF
!
!-----------------------------------------------------------------------
!
! Coriolis parameters:
!
!-----------------------------------------------------------------------
!
IF (myproc == 0) READ (unum,coriolis_force,END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)')'Namelist block coriolis_force sucessfully read.'
END IF
CALL mpupdatei(coriopt,1)
CALL mpupdatei(coriotrm,1)
IF (myproc == 0)THEN
WRITE (6,'(5x,a,i4)') 'The Coriolis term option was ', coriopt
WRITE (6,'(5x,a,i4)') 'The flag for Coriolis formulation was', &
coriotrm
END IF
!
!-----------------------------------------------------------------------
!
! Input parameters for turbulent mixing.
!
!-----------------------------------------------------------------------
!
IF (myproc == 0) READ (unum,turbulence,END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)')'Namelist block turbulence sucessfully read.'
END IF
CALL mpupdatei(tmixopt,1)
CALL mpupdatei(trbisotp,1)
CALL mpupdatei(tkeopt,1)
CALL mpupdatei(trbvimp,1)
CALL mpupdatei(tmixvert,1)
CALL mpupdater(alfcoef,1)
CALL mpupdater(tmixcst,1)
CALL mpupdater(prantl,1)
CALL mpupdater(kmlimit,1)
IF (myproc == 0)THEN
WRITE (6,'(5x,a,i4)') 'The turbulence option was ', tmixopt
WRITE (6,'(5x,a,i4)') 'The isotropic turbulence option was ', &
trbisotp
WRITE (6,'(5x,a,i4)') 'The 1.5 order TKE option was ', tkeopt
WRITE (6,'(5x,a,i4)') &
'The implicit treatment of vertical mixing option was', &
trbvimp
WRITE (6,'(5x,a,f10.3)') &
'The parameter coeff was ', alfcoef
WRITE (6,'(5x,a,f10.3)') &
'The nondimensional turbulent prandtl number was ', prantl
WRITE (6,'(5x,a,f10.3)') &
'The constant mixing coeff was ', tmixcst
WRITE (6,'(5x,a,f10.3)') &
'The parameter used to limit km was ', kmlimit
END IF
IF (trbvimp == 0) alfcoef=1.0
IF (tmixopt == 4 .AND. (tkeopt <= 0 .OR. tkeopt >= 4) ) THEN
IF (myproc == 0)THEN
WRITE (6,'(5x,a,i3,2(/5x,a))') &
'tkeopt should be 1, 2, or 3 for tmixopt=4, input was=',tkeopt, &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
END IF
err_no = err_no + 1
END IF
!
!-----------------------------------------------------------------------
!
! Input control parameters for computational mixing
!
!-----------------------------------------------------------------------
!
IF (myproc == 0) READ (unum,computational_mixing,END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)') &
'Namelist block computational_mixing sucessfully read.'
END IF
CALL mpupdatei(cmix2nd,1)
CALL mpupdater(cfcm2h,1)
CALL mpupdater(cfcm2v,1)
CALL mpupdatei(cmix4th,1)
CALL mpupdater(cfcm4h,1)
CALL mpupdater(cfcm4v,1)
CALL mpupdater(scmixfctr,1)
CALL mpupdatei(cmix_opt,1)
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i4)') &
'The second order computational mixing option was ',cmix2nd
WRITE(6,'(5x,a,e15.5)') &
'The coeff for second order horizontal mixing was ',cfcm2h
WRITE(6,'(5x,a,e15.5)') &
'The coeff for second order vertical mixing was ',cfcm2v
WRITE(6,'(5x,a,i4)') &
'The fourth order computational mixing option was ',cmix4th
WRITE(6,'(5x,a,e15.5)') &
'The coeff for fourth order horizontal mixing was ',cfcm4h
WRITE(6,'(5x,a,e15.5)') &
'The coeff for fourth order vertical mixing was ',cfcm4v
WRITE(6,'(5x,a,e15.5)') &
'The c-mixing reduction factor for scalars was ',scmixfctr
WRITE(6,'(5x,a,i4)') &
'The c-mix monotonic option was ',cmix_opt
IF( cmix2nd /= 0 .AND. cfcm2h > 0.125/dtbig ) THEN
WRITE(6,'(5x,a,a,2(/5x,a))') &
'Value of cfcm2h was too large. ', &
'It has to be less than 1/(8*dtbig).', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
err_no = err_no + 1
CALL arpsstop('arpsstop called from INITPARA with cdcm2h selection',1)
END IF
IF( cmix2nd /= 0 .AND. cfcm2v > 0.125/dtbig ) THEN
WRITE(6,'(5x,a,a,2(/5x,a))') &
'Value of cfcm2v was too large. ', &
'It has to be less than 1/(8*dtbig).', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
err_no = err_no + 1
END IF
IF( cmix4th /= 0 .AND. cfcm4h > 0.125/dtbig ) THEN
WRITE(6,'(5x,a,a,2(/5x,a))') &
'Value of cfcm4h was too large. ', &
'It has to be less than 1/(8*dtbig).', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
err_no = err_no + 1
END IF
IF( cmix4th /= 0 .AND. cfcm4v > 0.125/dtbig ) THEN
WRITE(6,'(5x,a,a,2(/5x,a))') &
'Value of cfcm4v was too large. ', &
'It has to be less than 1/(8*dtbig).', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
err_no = err_no + 1
END IF
END IF
!
!-----------------------------------------------------------------------
!
! Input controls for divergence damping on acoustic waves
!
!-----------------------------------------------------------------------
!
IF (myproc == 0) READ (unum,divergence_damping,END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)') &
'Namelist block divergence_damping sucessfully read.'
END IF
CALL mpupdatei(divdmp,1)
CALL mpupdater(divdmpndh,1)
CALL mpupdater(divdmpndv,1)
IF (myproc == 0)THEN
WRITE (6,'(5x,a,i4)') &
'The acoustic wave damping option was ', divdmp
WRITE (6,'(5x,a,f10.3,a,f10.3,a)') &
'The non-dimensional divergence damping coeff was ', &
divdmpndh, ' for horizontal and ', &
divdmpndv, ' for vertical'
END IF
!
!-----------------------------------------------------------------------
!
! Rayleigh damping parameters:
!
!-----------------------------------------------------------------------
!
IF (myproc == 0) READ (unum,rayleigh_damping,END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)')'Namelist block rayleigh_damping sucessfully read.'
END IF
CALL mpupdatei(raydmp,1)
CALL mpupdater(cfrdmp,1)
CALL mpupdater(zbrdmp,1)
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i4)') 'The rayleigh damping option was ',raydmp
WRITE(6,'(5x,a,e15.5)') 'The rayleigh damping coeff was ',cfrdmp
WRITE(6,'(5x,a,e15.5)') &
'The altitude of base of rayleigh damping was ',zbrdmp
IF ( raydmp == 2 .AND. lbcopt /= 2 ) THEN
WRITE (6,'(5x,a,i3,/5x,a,a,2(/5x,a))') &
'You can use raydmp=2 only when lbcopt=2. lbcopt=', lbcopt, &
'had been chosen. Please reset raydmp or lbcopt in the', &
'input file.', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
err_no = err_no + 1
CALL arpsstop('arpsstop called from INITPARA with raydmp/lbcopt &
& selection',1)
END IF
END IF
!
!-----------------------------------------------------------------------
!
! Robert-Asselin time filter coefficient:
!
!-----------------------------------------------------------------------
!
IF (myproc == 0) READ (unum,asselin_time_filter,END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)') &
'Namelist block asselin_time_filter sucessfully read.'
END IF
CALL mpupdater(flteps,1)
IF (myproc == 0)THEN
WRITE(6,'(5x,a,e15.5)') &
'The non-dimensional coeff of asselin time filter was ',flteps
END IF
!
!-----------------------------------------------------------------------
!
! Input the control parameters for microphysics parameterizations
!
!-----------------------------------------------------------------------
!
IF (myproc == 0) READ (unum,microphysics,END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)')'Namelist block microphysics sucessfully read.'
END IF
CALL mpupdatei(mphyopt,1)
CALL mpupdatei(moist,1)
CALL mpupdatei(cnvctopt,1)
CALL mpupdatei(subsatopt,1)
CALL mpupdatei(kfsubsattrig,1)
CALL mpupdater(kffbfct,1)
CALL mpupdater(wcldbs,1)
CALL mpupdater(confrq,1)
CALL mpupdater(qpfgfrq,1)
CALL mpupdatei(idownd,1)
CALL mpupdater(rhsat,1)
CALL mpupdater(rhsatmin,1)
CALL mpupdater(dx_rhsatmin,1)
CALL mpupdater(dx_rhsat100,1)
IF (myproc == 0)THEN
WRITE (6,'(5x,a,i4)') 'The microphysics option was ', mphyopt
WRITE (6,'(5x,a,i4)') 'The moist phyics option was ', moist
WRITE (6,'(5x,a,i4)') &
'The convective cumulus option was ',cnvctopt
WRITE (6,'(5x,a,i4)') &
'The sub-saturation option was ',subsatopt
WRITE (6,'(5x,a,f15.5)') &
'The K-F rainwater feedback option was ',kffbfct
WRITE (6,'(5x,a,i4)') &
'The K-F sub-saturation trigger was kfsubsattrig=', kfsubsattrig
WRITE (6,'(5x,a,f10.5)') 'The vertical motion was ', wcldbs
WRITE (6,'(5x,a,f10.5)') &
'The frequency of conv. para. updated in seconds was',confrq
WRITE (6,'(5x,a,f10.5)') &
'The frequency of grid para. updated in seconds was',qpfgfrq
WRITE (6,'(5x,a,i4)') 'The downdraft flag was ', idownd
WRITE (6,'(5x,a,f10.5)') &
'The threshold of RH for condensation to occur: rhsat = ', &
rhsat
WRITE (6,'(5x,a,f10.5)') &
'The threshold of RH for a grid size of dx_rhsatmin: rhsatmin = ',&
rhsatmin
WRITE (6,'(5x,a,f15.5)') &
'The grid size for condensation to occur (RH=rhsatmin): dx_rhsatmin = ', &
dx_rhsatmin
WRITE (6,'(5x,a,f15.5)') &
'The grid size for condensation to occur (RH=100%): dx_rhsat100 = ', &
dx_rhsat100
IF ( moist == 0 .AND. cnvctopt == 1 ) THEN
WRITE (6,'(5x,a/5x,a,a,2(/5x,a))') &
'Since cnvctopt = 1, ', &
'moist has to be set to 1 in order to use cumulus physics', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
err_no = err_no + 1
CALL arpsstop('arpsstop called from INITPARA with moist/cnvctopt &
& selection',1)
END IF
IF ( cnvctopt == 1 .AND. mphyopt /= 0 ) THEN
WRITE (6,'(5x,a/5x,a,a,2(/5x,a))') &
'Use cnvctopt=2 if you wish to use', &
'both cumulus parameterization and microphysics.', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
err_no = err_no + 1
END IF
END IF
IF ( mphyopt < 0 .OR. mphyopt > 4 ) THEN
IF (myproc == 0)THEN
WRITE (6,'(5x,a/5x,a/5x,a)') &
'No option for mphyopt > 4.', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
END IF
err_no = err_no + 1
ELSE IF ( mphyopt == 2 .OR. mphyopt == 3 ) THEN
ice = 1
ELSE
ice = 0
END IF
IF (kfsubsattrig < 0 .OR. kfsubsattrig > 1) THEN
WRITE (6,'(5x,a/5x,a/5x,a)') &
'ERROR: No option for kfsubsattrig < 0 or > 1. ', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
err_no = err_no + 1
END IF
IF ( subsatopt < 0 .OR. subsatopt > 2 ) THEN
WRITE (6,'(5x,a/5x,a/5x,a)') &
'ERROR: No option for subsatopt < 0 or > 2. ', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
err_no = err_no + 1
ELSE IF (subsatopt == 0) THEN
rhsat = 1.0
ELSE IF (subsatopt == 1) THEN
IF (rhsat < 0.) THEN
WRITE (6,'(5x,a/5x,a/5x,a/5x,a)') &
'ERROR: The threshold of RH can not be less than 0. ', &
'But you have chosen rhsat < 0. ', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
err_no = err_no + 1
ELSE IF (rhsat > 1.) THEN
WRITE (6,'(5x,a/5x,a)') &
'WARNING: The subsatopt is designed for RH less than 1. ', &
'But you have chosen rhsat > 1. It is now set to 1. '
END IF
rhsat = max(0., min(1.0, rhsat))
ELSE IF (subsatopt == 2) THEN
IF (rhsatmin < 0.) THEN
WRITE (6,'(5x,a/5x,a/5x,a)') &
'ERROR: The threshold of RH can not be less than 0. ', &
'But you have chosen rhsatmin < 0. ', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
err_no = err_no + 1
ELSE IF (rhsatmin > 1.) THEN
WRITE (6,'(5x,a/5x,a/5x,a)') &
'WARNING: the subsatopt is designed for RH less than 1. ', &
'But you have chosen rhsatmin greater than 1. ', &
'It is now re-set to 1. '
rhsatmin = 1.
END IF
IF (dx_rhsatmin < 0. .OR. dx_rhsat100 < 0.) THEN
WRITE (6,'(5x,a/5x,a/5x,a)') &
'ERROR: dx_rhsatmin or dx_rhsat100 can not be less than 0. ', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
err_no = err_no + 1
ELSE IF (dx_rhsatmin < dx_rhsat100) THEN
WRITE (6,'(5x,a/5x,a/5x,a)') &
'ERROR: dx_rhsatmin can not be greater than dx_rhsat100. ', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
err_no = err_no + 1
END IF
rhsat = max(rhsatmin, &
min(1.0,1.0+(rhsatmin-1.0)*(dx-dx_rhsat100) &
/max(0.1,dx_rhsatmin-dx_rhsat100)))
ENDIF
WRITE (6,'(5x,a,f10.5)') &
'rhsat for model integration is re-adjusted to ', rhsat
!
!-----------------------------------------------------------------------
!
! Input the control parameters for radiation parameterizations
!
!-----------------------------------------------------------------------
!
IF (myproc == 0) READ (unum,radiation,END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)')'Namelist block radiation sucessfully read.'
END IF
CALL mpupdatei(radopt,1)
CALL mpupdatei(radstgr,1)
CALL mpupdatei(rlwopt,1)
CALL mpupdater(dtrad,1)
CALL mpupdatei(raddiag,1)
IF (myproc == 0)THEN
WRITE (6,'(5x,a,i4)') &
'The radiation phyics option was ', radopt
WRITE (6,'(5x,a,i4)') &
'The radiation staggering option was ', radstgr
WRITE (6,'(5x,a,i4)') &
'The option for longwave schemes was ', rlwopt
WRITE (6,'(5x,a,f10.5)') &
'The Time interval to update the radiation forcing was ', dtrad
WRITE (6,'(5x,a,i4)') &
'The radiation diagnostic output option was ', raddiag
END IF
nradstp = nint( dtrad/dtbig )
IF( nradstp /= 0 ) THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i6,a)') &
'Radiation physics will be calculated every ', nradstp, &
' time steps'
END IF
dtrad = dtbig*nradstp
ELSE
nradstp = -1
radopt = 0
IF (myproc == 0)THEN
WRITE(6,'(5x,a)') &
'Radiation physics is switched off.'
END IF
END IF
!
!-----------------------------------------------------------------------
!
! Input surface physics options
!
!-----------------------------------------------------------------------
!
IF (myproc == 0) READ (unum,surface_physics,END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)') 'Namelist block surface_physics sucessfully read.'
END IF
CALL mpupdatei(sfcphy,1)
CALL mpupdatei(landwtr,1)
CALL mpupdatei(cdhwtropt,1)
CALL mpupdater(cdmlnd,1)
CALL mpupdater(cdmwtr,1)
CALL mpupdater(cdhlnd,1)
CALL mpupdater(cdhwtr,1)
CALL mpupdater(cdqlnd,1)
CALL mpupdater(cdqwtr,1)
CALL mpupdatei(pbldopt,1)
CALL mpupdater(pbldpth0,1)
CALL mpupdater(lsclpbl0,1)
CALL mpupdatei(tqflxdis,1)
CALL mpupdater(dtqflxdis,1)
CALL mpupdatei(smthflx,1)
CALL mpupdatei(numsmth,1)
CALL mpupdatei(sfcdiag,1)
IF (myproc == 0)THEN
WRITE (6,'(5x,a,i4)') 'The surface physics option was ', sfcphy
WRITE (6,'(5x,a,i4)') 'The land/water option was ', landwtr
WRITE (6,'(5x,a,i4)') &
'The constant water cdh option was ', cdhwtropt
WRITE (6,'(5x,a,f10.3)') &
'The user specified drag coeff for momentun over land was ', &
cdmlnd
WRITE (6,'(5x,a,f10.3)') &
'The user specified drag coeff for momentun over water was ', &
cdmwtr
WRITE (6,'(5x,a,f10.3)') &
'The user specified drag coeff for heat over land was ', &
cdhlnd
WRITE (6,'(5x,a,f10.3)') &
'The user specified drag coeff for heat over water was ', &
cdhwtr
WRITE (6,'(5x,a,f10.3)') &
'The user specified drag coeff for moisture over land was ', &
cdqlnd
WRITE (6,'(5x,a,f10.3)') &
'The user specified drag coeff for moisture over water was ', &
cdqwtr
WRITE (6,'(5x,a,i3)') &
'The option for determining PBL depth was ', pbldopt
WRITE (6,'(5x,a,f10.3)') &
'The user specified PBL depth was ', pbldpth0
WRITE (6,'(5x,a,f10.3)') &
'The PBL length scale ', lsclpbl0
WRITE (6,'(5x,a,i4)') 'The flux distribution option was ', &
sflxdis
END IF
IF ( sfcphy == 0 ) THEN
sflxdis = 0
IF (myproc == 0)THEN
WRITE (6,'(5x,a/5x,a)') &
'When sfcphy=0, there is no surface flux to be distributed.', &
' Set sflxdis=0.'
END IF
ELSE IF ( sflxdis < 0 .OR. sflxdis > 3 ) THEN
IF (myproc == 0)THEN
WRITE (6,'(5x,a,/5x,a,/5x,a)') &
'The options for sflxdis must be between 0 and 3.', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
END IF
err_no = err_no + 1
END IF
IF (myproc == 0)THEN
WRITE (6,'(5x,a,i4)') &
'The heat and moisture distribution option was ',tqflxdis
END IF
IF ( sfcphy == 0 ) THEN
tqflxdis = 0
IF (myproc == 0)THEN
WRITE (6,'(5x,a/5x,a)') &
'When sfcphy=0, there is no surface flux to be distributed.', &
' Set tqflxdis=0.'
END IF
ELSE IF ( tqflxdis < 0 .OR. tqflxdis > 2 ) THEN
IF (myproc == 0)THEN
WRITE (6,'(5x,a,/5x,a,/5x,a))') &
'The options for tqflxdis must be 0, 1, or 2.', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
END IF
err_no = err_no + 1
END IF
IF( tqflxdis /= 0 .AND. sflxdis /= 0 ) THEN
IF (myproc == 0)THEN
WRITE (6,'(5x,a,/5x,a,/5x,a,/5x,a)') &
'Options tqflxdis and sflxdis should not be turned on at the', &
'same time. Please turn one of them off', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
END IF
err_no = err_no + 1
END IF
IF ( smthflx >= 0 ) THEN
numsmth = MAX( 1, numsmth )
END IF
IF ( radopt == 0 .AND. (sfcphy == 3 .OR. sfcphy == 4) ) THEN
radopt = 1
IF (myproc == 0)THEN
WRITE (6,'(5x,a/5x,a/5x,a,i2)') &
'Since soil-vegetation process was switched on, we must', &
'compute the surface radiation flux for energy balance.', &
'radopt was reset to 1 in INITPARA.'
END IF
END IF
!
!-----------------------------------------------------------------------
!
! Input soil and vegetation parameters
!
!-----------------------------------------------------------------------
!
IF (myproc == 0) READ (unum,soil_ebm,END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)')'Namelist block soil_ebm sucessfully read.'
END IF
CALL mpupdatei(sfcdat,1)
CALL mpupdatei(soilinit,1)
CALL mpupdater(dtsfc,1)
CALL mpupdatei(styp,1)
CALL mpupdatei(vtyp,1)
CALL mpupdater(lai0,1)
CALL mpupdater(roufns0,1)
CALL mpupdater(veg0,1)
CALL mpupdater(ptslnd0,1)
CALL mpupdater(ptswtr0,1)
CALL mpupdater(tsoil0,1)
CALL mpupdater(wetsfc0,1)
CALL mpupdater(wetdp0,1)
CALL mpupdater(wetcanp0,1)
CALL mpupdater(snowdpth0,1)
CALL mpupdater(tsprt,1)
CALL mpupdater(t2prt,1)
CALL mpupdater(wgrat,1)
CALL mpupdater(w2rat,1)
CALL mpupdatec(sfcdtfl,128)
CALL mpupdatec(soilinfl,128)
CALL mpupdatei(sfcfmt,1)
CALL mpupdatei(soilfmt,1)
CALL mpupdatei(nstyp,1)
CALL mpupdatei(tsoil_offset, 1)
CALL mpupdater(tsoil_offset_amplitude, 1)
nstyp = MAX(1,nstyp)
nstyps = nstyp
IF (myproc == 0)THEN
WRITE (6,'(5x,a,i4)') &
'The surface data input option was ',sfcdat
WRITE (6,'(5x,a,i4)') &
'The surface initial data input option was ',soilinit
END IF
IF ( sfcphy == 0 ) THEN
sfcdat = 1
soilinit = 1
landwtr = 0
sfcdiag = 0
IF (myproc == 0)THEN
WRITE (6,'(5x,a/5x,a/5x,a)') &
'Since sfcphy = 0, sfcdat and soilinit are set to 1 and', &
'landwtr to 0 to avoid reading the surface data.', &
'Diagnostics printing is turned off.'
END IF
END IF
IF (myproc == 0)THEN
WRITE (6,'(5x,a,f10.3)') &
'The time step for surface energy budget model was ',dtsfc
WRITE (6,'(5x,a,i4)') 'The surface soil type is ',styp
WRITE (6,'(5x,a,i4)') 'The surface vegtation type is ',vtyp
WRITE (6,'(5x,a,f10.3)') 'The leaf area index is ', lai0
WRITE (6,'(5x,a,f10.3)') &
'The user specified land surface roughness was ', roufns0
WRITE (6,'(5x,a,f10.3)') &
'The user specified vegetation fraction was ', veg0
WRITE (6,'(5x,a,a,f10.3)') &
'The initial ground level soil potential temperature ', &
'over land is ',ptslnd0
WRITE (6,'(5x,a,a,f10.3)') &
'The initial ground level soil potential temperature ', &
'over water is ',ptswtr0
WRITE (6,'(5x,a,f10.3)') &
'The initial deep ground temperature is ',tsoil0
WRITE (6,'(5x,a,f10.3)') 'The surface soil moisture is ',wetsfc0
WRITE (6,'(5x,a,f10.3)') 'The deep soil moisture is ',wetdp0
WRITE (6,'(5x,a,f10.3)') 'The canopy moisture is ',wetcanp0
WRITE (6,'(5x,a,f10.3)') 'The snow depth is ',snowdpth0
WRITE (6,'(5x,a,f10.3)') &
'The offset of tsfc from surface air temperature is ',tsprt
WRITE (6,'(5x,a,f10.3)') &
'The offset of tsoil from surface air temperature is ',t2prt
WRITE (6,'(5x,a,f10.3)') &
'The saturation ratio of surface soil moisture is ',wgrat
WRITE (6,'(5x,a,f10.3)') &
'The saturation ratio of deep soil moisture is ',w2rat
END IF
lenstr = 80
CALL strlnth( sfcdtfl, lenstr )
IF (myproc == 0)THEN
WRITE(6,'(5x,a,a)') &
'Surface data file to be used is ', sfcdtfl(1:lenstr)
WRITE (6,'(5x,a,i4)') &
'The surface data file format was ',sfcfmt
END IF
lenstr = 80
CALL strlnth( soilinfl, lenstr )
IF (myproc == 0)THEN
WRITE(6,'(5x,a,a)') &
'Soil data file to be used is ', soilinfl(1:lenstr)
WRITE (6,'(5x,a,i4)') &
'The soil data file format was ',soilfmt
END IF
IF ( sfcphy /= 0 ) THEN
dtsfc = MIN( dtsfc, dtbig )
dtsfc0 = dtsfc
nsfcst = nint(dtbig/dtsfc)
dtsfc = dtbig/nsfcst
IF ( dtsfc > dtsfc0 ) THEN
nsfcst = nsfcst + 1
dtsfc = dtbig/nsfcst
IF (myproc == 0)THEN
WRITE(6,'(/a,1x,f10.4,a)') &
' The actual surface model time step to be used is ', &
dtsfc, ' seconds'
END IF
END IF
IF (styp <= 0 .OR. styp >= 14) THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i3,a,2(/5x,a))') &
'The input styp =',styp, 'not acceptable.', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
END IF
err_no = err_no + 1
END IF
IF (vtyp <= 0 .OR. vtyp >= 15) THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i3,a,2(/5x,a))') &
'The input vtyp =',vtyp, 'not acceptable.', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
END IF
err_no = err_no + 1
END IF
IF ( lai0 < 0.0 ) THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a,f6.2,a,2(/5x,a))') &
'The input lai0=',lai0, 'not acceptable.', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
END IF
err_no = err_no + 1
END IF
IF ( roufns0 < 0.0 ) THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a,f6.2,a,2(/5x,a))') &
'The input roufns0=',roufns0, 'not acceptable.', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
END IF
err_no = err_no + 1
END IF
IF ( veg0 < 0.0 .OR. veg0 > 1.0 ) THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a,f6.2,a,2(/5x,a))') &
'The input veg0=',veg0, 'not acceptable.', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
END IF
err_no = err_no + 1
END IF
IF ( ptslnd0 < 173.13 .OR. ptslnd0 > 373.16 ) THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a,f10.5,a,2(/5x,a))') &
'The input ptslnd0=',ptslnd0, 'not acceptable.', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
END IF
err_no = err_no + 1
END IF
IF ( ptswtr0 < 173.13 .OR. ptswtr0 > 373.16 ) THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a,f10.5,a,2(/5x,a))') &
'The input ptswtr0=',ptswtr0, 'not acceptable.', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
END IF
err_no = err_no + 1
END IF
IF ( tsoil0 < 173.13 .OR. tsoil0 > 373.16 ) THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a,f10.5,a,2(/5x,a))') &
'The input tsoil0=',tsoil0, 'not acceptable.', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
END IF
err_no = err_no + 1
END IF
IF ( styp == 12 ) THEN
ptslnd0 = MIN( ptslnd0, 273.16 )
tsoil0 = MIN( tsoil0, 273.16 )
wetsfc0 = 0.
wetdp0 = 0.
wetcanp0 = 0.
IF (myproc == 0)THEN
WRITE(6,'(/a/a/a)') &
' The soil type is ice.', &
' The soil temperatures are set to ice point 273.16 K.', &
' And the moisture variables are set to 0.'
END IF
ELSE IF ( styp == 13 ) THEN
wetsfc0 = 1.
wetdp0 = 1.
wetcanp0 = 1.
IF (myproc == 0)THEN
WRITE(6,'(/a/a)') &
' The soil type is water.', &
' The moisture variables are set to 1.'
END IF
ELSE
IF (wetsfc0 < 0.0 .OR. wetsfc0 > 1.0) THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a,f10.5,a,2(/5x,a))') &
'The input wetsfc0=',wetsfc0, 'not acceptable.', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
END IF
err_no = err_no + 1
ELSE IF ( wetsfc0 > wsat(styp) ) THEN
wetsfc0 = wsat(styp)
IF (myproc == 0)THEN
WRITE(6,'(/a/a,f10.4)') &
' The input wetsfc0 is greater than the saturated value', &
' and actually adjusted to the saturated value: ', &
wetsfc0
END IF
END IF
IF (wetdp0 < 0.0 .OR. wetdp0 > 1.0) THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a,f10.5,a,2(/5x,a))') &
'The input wetdp0=',wetdp0, 'not acceptable.', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
END IF
err_no = err_no + 1
ELSE IF ( wetdp0 > wsat(styp) ) THEN
wetdp0 = wsat(styp)
IF (myproc == 0)THEN
WRITE(6,'(/a/a,f10.4)') &
' The input wetdp0 is greater than the saturated value ', &
' and actually adjusted to the saturated value: ',wetdp0
END IF
END IF
wgrat = MAX( 0.0, MIN(1.0,wgrat) )
w2rat = MAX( 0.0, MIN(1.0,w2rat) )
wrmax = .2*veg0*lai0
IF (wetcanp0 < 0.0 .OR. wetcanp0 > 1.0) THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a,f10.5,a,2(/5x,a))') &
'The input wetcanp0=',wetcanp0, 'not acceptable.', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
END IF
err_no = err_no + 1
ELSE IF ( wetcanp0 > wrmax ) THEN
wetcanp0 = wrmax
IF (myproc == 0)THEN
WRITE(6,'(/a/a,f10.4)') &
' The input wetcanp0 is greater than the maximun value ', &
' and actually adjusted to the maximun value: ',wetcanp0
END IF
END IF
END IF
END IF
nstyps = MAX(1,nstyps)
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i5)') "nstyps =",nstyps
END IF
!
! soil_offset amplitude
!
SELECT CASE (tsoil_offset)
CASE (0:2)
IF (myproc == 0) &
WRITE(6, '(a/, a, I2)') &
' Option for including seasonal deep and skin'// &
' layer temperature offset in the two-layer soil model', &
' Your choice is ', tsoil_offset
CASE DEFAULT
err_no = err_no + 1
IF (myproc == 0) &
WRITE(6, '(a, I2, 3(a/))') &
' The input tsoil_offset =',tsoil_offset, 'not acceptable.', &
' Program will try to complete reading in input parameters,',&
' but will stop at the end of subroutine INITPARA.'
END SELECT
IF (myproc == 0) &
WRITE(6, '(a/, a, F5.3)') &
' The amplitude of the annual cycle of the difference (offset)', &
' in deep and skin layer soil seasonal-mean temperatures is ', &
tsoil_offset_amplitude
!
!-----------------------------------------------------------------------
!
! Read in parameters for automatic grid translation.
!
!-----------------------------------------------------------------------
!
IF (myproc == 0) READ (unum,grdtrans,END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)')'Namelist block grdtrans sucessfully read.'
END IF
CALL mpupdatei(cltkopt,1)
CALL mpupdatei(grdtrns,1)
CALL mpupdater(umove,1)
CALL mpupdater(vmove,1)
CALL mpupdater(chkdpth,1)
CALL mpupdater(twindow,1)
CALL mpupdater(tceltrk,1)
CALL mpupdater(tcrestr,1)
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i10)') 'Cell tracking option was ',cltkopt
WRITE(6,'(5x,a,i10)') 'The grid translation option was ',grdtrns
END IF
IF( grdtrns == 2 .AND. cltkopt == 0 ) THEN
cltkopt = 1
IF (myproc == 0)THEN
WRITE(6,'((5x,a)/)') &
'Since grdtrns =2, cltkopt was reset to 1.'
END IF
END IF
!
!-----------------------------------------------------------------------
!
! Ground-relative domain translation speed:
!
!-----------------------------------------------------------------------
!
IF (myproc == 0)THEN
WRITE(6,'(5x,a,f10.3)') &
'The domain translation speed in x was ', umove
WRITE(6,'(5x,a,f10.3)') &
'The domain translation speed in y was ', vmove
WRITE(6,'(5x,a,f10.3)') &
'The depth of domain to check for grid translation was',chkdpth
WRITE(6,'(5x,a,f10.3)') &
'The time window for updating umove and vmove was ',twindow
WRITE(6,'(5x,a,f10.3)') 'Cell tracking interval was ', tceltrk
END IF
IF( tceltrk > 0.0 .AND. tceltrk < dtbig ) THEN
nceltrk = 1
ELSE
nceltrk = nint(tceltrk/dtbig)
END IF
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i6,a)') &
'Cell-tracking routine will be called every', nceltrk, &
' time steps.'
WRITE(6,'(5x,a,f10.3)') 'Cell restore time was ', tcrestr
END IF
!
!-----------------------------------------------------------------------
!
! Read in namelist &history_dump
!
!-----------------------------------------------------------------------
!
IF (myproc == 0) READ (unum,history_dump,END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)')'Namelist block history_dump sucessfully read.'
END IF
CALL mpupdatei(hdmpopt,1)
CALL mpupdatei(hdmpfmt,1)
CALL mpupdatei(grbpkbit,1)
CALL mpupdater(thisdmp,1)
CALL mpupdater(tstrtdmp,1)
CALL mpupdatei(numhdmp,1)
CALL mpupdater(hdmptim,numhdmp)
CALL mpupdatei(istager,1)
CALL mpupdatei(hdfcompr,1)
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i4)') 'The history dump option was ',hdmpopt
WRITE(6,'(5x,a,i4)') 'The history dump format was ',hdmpfmt
END IF
IF( hdmpfmt < 0 .OR. hdmpfmt > 11) THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i4,a,2(/5x,a))') &
'The option hdmpfmt=', hdmpfmt, ' not valid.', &
'Program will try to complete reading in input parameters, ', &
'but will stop at the end of subroutine INITPARA.'
END IF
err_no = err_no + 1
END IF
! IF( hdmpfmt.eq.10 .and. nz.ge.256 ) THEN
! write(6,'(5x,a/5x,a)')
! : 'The GRIB format can only handle number of vertical levels',
! : 'less than 256 (8-bits). Reset hdmpfmt to 1 (binary format)'
! hdmpfmt = 1
! ENDIF
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i6)') &
'Number of bits in packing GRIB dump data was ',grbpkbit
WRITE(6,'(5x,a,i4)') &
'HDF4 compression option was ',hdfcompr
WRITE(6,'(5x,a,f10.3,a)') &
'The history dump time interval was ',thisdmp,' seconds '
WRITE(6,'(5x,a,f10.3,a)') &
'The history dump starting time was ',tstrtdmp,' seconds '
END IF
IF ( hdmpopt == 2 ) THEN
IF(numhdmp > 0) THEN
DO i=1,numhdmp
hdmpstp(i) = nint(hdmptim(i)/dtbig)
END DO
nhisdmp = 1
IF (myproc == 0)THEN
WRITE(6,'(5x,i3,a,a)') numhdmp, &
' history data dumps will be produced at', &
' the following time steps:'
WRITE(6,'(5x,10i6)') (hdmpstp(i),i=1,numhdmp)
END IF
ELSE
nhisdmp = -1
IF (myproc == 0)THEN
WRITE(6,'(5x,a)') &
'History data dump is switched off.'
END IF
END IF
ELSE
hdmpopt = 1
nhisdmp = nint(thisdmp/dtbig)
nstrtdmp = nint(tstrtdmp/dtbig)
thisdmp = nhisdmp*dtbig
tstrtdmp = nstrtdmp*dtbig
IF(nhisdmp > 0) THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i6,a,i6,a/5x,a,a)') &
'History data dumps will be produced every ', nhisdmp, &
' time steps after the first ',nstrtdmp,' time steps ', &
'where tttttt (if any) stands for the time of the data ', &
'in seconds.'
END IF
ELSE
nhisdmp = -1
IF (myproc == 0)THEN
WRITE(6,'(5x,a)') &
'History data dump is switched off.'
END IF
END IF
END IF
!
!-----------------------------------------------------------------------
!
! Read in namelist &output
!
!-----------------------------------------------------------------------
!
IF (myproc == 0) READ (unum,output,END=100)
IF (myproc == 0)THEN
WRITE(6,'(a)')'Namelist block output sucessfully read.'
END IF
CALL mpupdatec(dirname,128)
CALL mpupdater(tfmtprt,1)
CALL mpupdatei(exbcdmp,1)
CALL mpupdatei(extdadmp,1)
CALL mpupdatei(grdout,1)
CALL mpupdatei(basout,1)
CALL mpupdatei(varout,1)
CALL mpupdatei(mstout,1)
CALL mpupdatei(rainout,1)
CALL mpupdatei(prcout,1)
CALL mpupdatei(iceout,1)
CALL mpupdatei(tkeout,1)
CALL mpupdatei(trbout,1)
CALL mpupdatei(sfcout,1)
CALL mpupdatei(landout,1)
CALL mpupdatei(totout,1)
CALL mpupdatei(radout,1)
CALL mpupdatei(flxout,1)
CALL mpupdatei(qcexout,1)
CALL mpupdatei(qrexout,1)
CALL mpupdatei(qiexout,1)
CALL mpupdatei(qsexout,1)
CALL mpupdatei(qhexout,1)
CALL mpupdatei(trstout,1)
CALL mpupdater(tmaxmin,1)
CALL mpupdater(tenergy,1)
CALL mpupdatei(imgopt,1)
CALL mpupdater(timgdmp,1)
CALL mpupdatei(pltopt,1)
CALL mpupdater(tplots,1)
CALL mpupdatei(filcmprs,1)
CALL mpupdatei(readyfl,1)
CALL mpupdatei(sfcdmp,1)
CALL mpupdatei(soildmp,1)
CALL mpupdatei(terndmp,1)
IF (myproc == 0)THEN
WRITE(6,'(/5x,a,f10.3,a)') &
'Formatted printout time interval was ',tfmtprt,' seconds.'
END IF
nfmtprt = nint(tfmtprt/dtbig)
IF( nfmtprt /= 0) THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i6,a)') &
'Formatted printing is done every ', nfmtprt,' time steps.'
END IF
ELSE
nfmtprt = -1
IF (myproc == 0)THEN
WRITE(6,'(5x,a)') &
'Formatted printing is switched off.'
END IF
END IF
!
!-----------------------------------------------------------------------
!
! Input model output parameters:
!
! First, give the name of the directory into which output files
! will be written:
!
!-----------------------------------------------------------------------
!
ldirnam = 80
CALL strlnth( dirname, ldirnam)
IF( ldirnam == 0 ) THEN
dirname = '.'
ldirnam=1
END IF
IF( dirname(1:ldirnam) /= ' ') THEN
!
!-----------------------------------------------------------------------
!
! Check if the specified output directory exists, if not,
! abort the job.
!
!-----------------------------------------------------------------------
!
INQUIRE(FILE=dirname(1:ldirnam),EXIST=iexist)
IF( .NOT.iexist ) THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a,2(/5x,a))') &
'Specified output directory '//dirname(1:ldirnam)// &
' not found.', &
'It was created by the program.'
END IF
CALL unixcmd( 'mkdir -p '//dirname(1:ldirnam) )
! write(6,'(5x,a,4(/5x,a))')
! : 'Specified output directory '//dirname(1:ldirnam)//
! : ' not found.',
! : 'Please create it before starting the model.',
! : 'Program will try to complete reading in input parameters, ',
! : 'but will stop at the end of subroutine INITPARA.'
! err_no = err_no + 1
END IF
IF (myproc == 0)THEN
WRITE(6,'(5x,a)') &
'Output files will be in directory '//dirname(1:ldirnam)//'.'
END IF
ELSE
IF (myproc == 0)THEN
WRITE(6,'(5x,a)') &
'Output files will be in the current work directory.'
END IF
END IF
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i4)') &
'The flag to dump out ARPS array into EXBC fields was ',exbcdmp
END IF
IF ( lbcopt /= 2 ) THEN
extdadmp = 0
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i4)') &
'The flag to dump out EXBC array into ARPS history file was ', &
extdadmp
END IF
END IF
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i4)') &
'The flag to dump out ARPS surface data files was ',sfcdmp
WRITE(6,'(5x,a,i4)') &
'The flag to dump out ARPS soil data files was ',soildmp
WRITE(6,'(5x,a,i4)') &
'The flag to dump out an ARPS terrain data file was ',terndmp
END IF
!
!-----------------------------------------------------------------------
!
! Set the control parameters for the output of selected fields.
!
!-----------------------------------------------------------------------
!
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i4)') &
'The input grid coordinate dump option was ', grdout
WRITE(6,'(5x,a,i4)') &
'The input base state array dump option was ', basout
WRITE(6,'(5x,a,i4)') &
'The input mass-velocity array dump option was ', varout
WRITE(6,'(5x,a,i4)') &
'The input non-ice water array dump option was ',mstout
WRITE(6,'(5x,a,i4)') &
'The input rain array dump option was ', rainout
END IF
rainout = rainout * mstout
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i4)') &
'The input precipitation rates array dump option was ',prcout
END IF
prcout = prcout * mstout
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i4)') &
'The input ice array dump option was ', iceout
WRITE(6,'(5x,a,i4)') &
'The input TKE dump option was ', tkeout
WRITE(6,'(5x,a,i4)') &
'The input eddy mixing coeff dump option was ', trbout
WRITE(6,'(5x,a,i4)') &
'The soil variable dump option was ', sfcout
WRITE(6,'(5x,a,i4)') &
'The surface property array dump option was ', landout
WRITE(6,'(5x,a,i4)') &
'The radiation arrays dump option was ', radout
WRITE(6,'(5x,a,i4)') &
'The surface fluxes dump option was ', flxout
WRITE(6,'(5x,a,i4)') &
'The qc EXBC dump option was ', qcexout
WRITE(6,'(5x,a,i4)') &
'The qr EXBC dump option was ', qrexout
WRITE(6,'(5x,a,i4)') &
'The qi EXBC dump option was ', qiexout
WRITE(6,'(5x,a,i4)') &
'The qs EXBC dump option was ', qsexout
WRITE(6,'(5x,a,i4)') &
'The qh EXBC dump option was ', qhexout
END IF
!
!-----------------------------------------------------------------------
!
! Input restart data dump time:
!
!-----------------------------------------------------------------------
!
IF (myproc == 0)THEN
WRITE(6,'(5x,a)') &
'Specify the time interval between restart data dumps (s):'
WRITE(6,'(5x,a,f10.3,a)') &
'Time interval between restart dumps was ',trstout,' seconds '
END IF
nrstout = nint(trstout/dtbig)
IF( nrstout > 0) THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a,/5x,a,i6,a,/5x,a)') &
'Restart data files '//runname(1:lfnkey)//'.rsttttttt', &
'will be produced every ', nrstout,' time steps', &
'where tttttt stands for the time of the data in seconds.'
END IF
ELSE
nrstout = -1
IF (myproc == 0)THEN
WRITE(6,'(5x,a)') &
'Restart data dump is switched off.'
END IF
END IF
!
!-----------------------------------------------------------------------
!
! Input parameters for maximum and minimum statistics calculations:
!
!-----------------------------------------------------------------------
!
IF (myproc == 0)THEN
WRITE(6,'(5x,a,f10.3,a)') &
'Interval between max/min calucations was ',tmaxmin,' seconds '
END IF
nmaxmin = nint(tmaxmin/dtbig)
IF( tmaxmin > 0.0 .AND. tmaxmin < dtbig ) THEN
nmaxmin = 1
ELSE
nmaxmin = nint(tmaxmin/dtbig)
END IF
IF(nmaxmin /= 0)THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i6,a,/5x,a/)') &
'Max. min. statistics are calculated every ', nmaxmin, &
' time steps.', &
'and the results are written into file '//runname(1:lfnkey) &
//'.maxmin '
END IF
ELSE
nmaxmin = -1
IF (myproc == 0)THEN
WRITE(6,'(5x,a)') &
'Max. min. statistics calcualtions are switched off.'
END IF
END IF
!
!-----------------------------------------------------------------------
!
! Input parameter for energy/ptprt variance statistics calculations:
!
!-----------------------------------------------------------------------
!
IF (myproc == 0)THEN
WRITE(6,'(5x,a,f10.3)') &
'Interval between energy stats calculations was ',tenergy
END IF
nenergy = nint(tenergy/dtbig)
IF(nenergy /= 0)THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i6,a,/5x,a)') &
'Energy statistics are calculated every',nenergy,' time steps.', &
'and the results are written into file '// &
runname(1:lfnkey)//'.eng '
END IF
ELSE
nenergy = -1
IF (myproc == 0)THEN
WRITE(6,'(5x,a)') &
'Energy statistics calculations are switched off.'
END IF
END IF
!
!-----------------------------------------------------------------------
!
! More output control parameters, for HDF imgage generation, cell-
! tracking calls and graphic plotting.
!
!-----------------------------------------------------------------------
!
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i4)') 'Image dump option was ',imgopt
WRITE(6,'(5x,a,f10.3)') 'Image dump interval was ',timgdmp
END IF
IF( timgdmp == 0.0) THEN
imgopt = 0
nimgdmp = 1
ELSE IF( timgdmp > 0.0 .AND. timgdmp < dtbig ) THEN
nimgdmp = 1
ELSE
nimgdmp = nint(timgdmp/dtbig)
END IF
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i6,a)') &
'HDF images will be produced every ', nimgdmp,' time steps.'
WRITE(6,'(5x,a,i4)') 'Plotting option was ', pltopt
WRITE(6,'(5x,a,f10.3)') 'Plotting interval was ', tplots
END IF
nplots = nint(tplots /dtbig)
IF(nplots > 0)THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i6,a)') &
'Plotting routine will be called every',nplots,' time steps.'
END IF
ELSE
nplots = -1
END IF
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i6)') &
'File compression option was ',filcmprs
END IF
!
!-----------------------------------------------------------------------
!
! Input debug information print controls:
!
!-----------------------------------------------------------------------
!
IF (myproc == 0) READ (unum,debug)
IF (myproc == 0)THEN
WRITE(6,'(a)')'Namelist block debug sucessfully read.'
END IF
CALL mpupdatei(lvldbg,1)
IF (myproc == 0)THEN
WRITE(6,'(5x,a,i4)') 'The debug printing level was ', lvldbg
END IF
GO TO 102
!
!-----------------------------------------------------------------------
!
! Print out the input parameters.
! Write out a log file of model parameters which can be used as
! the input file to re-run the model.
!
!-----------------------------------------------------------------------
!
100 CONTINUE
IF (myproc == 0)THEN
CALL wrtcomment('Error reading NAMELIST file. Default values used',1)
END IF
102 CONTINUE
!
!-----------------------------------------------------------------------
!
! Compute derived variables.
!
!-----------------------------------------------------------------------
!
ebc_global = ebc
wbc_global = wbc
nbc_global = nbc
sbc_global = sbc
IF (mp_opt > 0) THEN ! Convert from global to processor specific values.
nx = (nx - 3)/nproc_x + 3
ny = (ny - 3)/nproc_y + 3
IF (myproc == 0) WRITE(6,'(5x,a,i5)') " Processor nx =",nx
IF (myproc == 0) WRITE(6,'(5x,a,i5)') " Processor ny =",ny
IF (loc_x /= 1) wbc = 0
IF (loc_x /= nproc_x) ebc = 0
IF (loc_y /= 1) sbc = 0
IF (loc_y /= nproc_y) nbc = 0
END IF
IF( initopt == 2 ) THEN
restrt = 1
ELSE
restrt = 0
END IF
CALL julday( year, month, day, jday ) ! Get the Julian day
nudgstp=1
temr = ndintvl/dtbig
nudgstp=MAX(nint(temr),1)
ndintvl=dtbig*nudgstp
temr = (ndstop-ndstart)/ndintvl
ndscale=ndgain/MAX(nint(temr),1)
IF ( mapproj == 0 ) THEN
mpfctopt = 0
END IF
mptrmopt = mptrmopt * mpfctopt
latitud = ctrlat
longitud= ctrlon
IF ( mapproj == 0 ) THEN
trulat1 = ctrlat
trulat2 = ctrlat
trulon = ctrlon
END IF
dtsml0 = dtsml
nsmstp = MAX( 1, nint(2.0*dtbig/dtsml) )
dtsml = 2.0*dtbig/nsmstp
IF (dtsml > dtsml0) THEN
nsmstp = nsmstp + 1
dtsml = 2.0*dtbig/nsmstp
END IF
dxinv = 1.0/dx
dyinv = 1.0/dy
dzinv = 1.0/dz
xl = (nx-3)*dx
yl = (ny-3)*dy
zh = (nz-3)*dz
IF( ternopt /= 0 .OR. strhopt /= 0 ) THEN
crdtrns = 1
ELSE
crdtrns = 0
END IF
cbcmixh = cbcmix * dx*dy
IF( runmod == 2 ) THEN
dh = dx
ELSE IF( runmod == 3 ) THEN
dh = dy
ELSE
dh = SQRT(dx*dy)
END IF
cfcmh2 = cfcm2h * dh*dh
cfcmh4 = cfcm4h * dh**4
cfcmv2 = cfcm2v * dz*dz
cfcmv4 = cfcm4v * dz**4
IF ( divdmp == 1 ) THEN ! isotropic, cdvdmph=cdvdmpv
IF ( runmod == 1 ) THEN
temr = MIN(dx,dy,dzmin)
ELSE IF( runmod == 2 ) THEN
temr = MIN(dx,dzmin)
ELSE IF( runmod == 3 ) THEN
temr = MIN(dy,dzmin)
ELSE IF( runmod == 4 ) THEN
temr = dzmin
END IF
cdvdmph = divdmpndh * temr **2 / dtsml
cdvdmpv = cdvdmph
ELSE IF ( divdmp == 2 ) THEN
IF ( runmod == 1 ) THEN
temr = MIN( SQRT(dx*dy), 5000.0 )
ELSE IF( runmod == 2 ) THEN
temr = MIN( dx, 5000.0 )
ELSE IF( runmod == 3 ) THEN
temr = MIN( dy, 5000.0 )
ELSE IF( runmod == 4 ) THEN
temr = dzmin
END IF
cdvdmph = divdmpndh * temr**2 / dtsml
cdvdmpv = divdmpndv * dzmin **2 / dtsml
END IF
IF( err_no /= 0 ) THEN
IF (myproc == 0)THEN
WRITE(6,'(5x,i4,a,/5x,a,/5x,a,a)') &
err_no, ' fatal errors found with the input parameters.', &
'Please check the ARPS input parameters carefully.', &
'The values of parameters you have used can be found', &
' in the log file.'
END IF
CALL arpsstop('arpsstop called from INITPARA with an option',1)
END IF
RETURN
END SUBROUTINE initpara
!
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE PRTLOG ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE prtlog(nx,ny,nz,nunit) 6,6
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Print a log file compatible in the namelist format
!
!-----------------------------------------------------------------------
!
! AUTHOR: Adwait Sathye
! 9/15/93
!
!-----------------------------------------------------------------------
!
!
!-----------------------------------------------------------------------
!
! Variable Declarations.
!
!-----------------------------------------------------------------------
!
IMPLICIT NONE
INTEGER :: nx,ny,nz ! The number of grid points in 3 directions
INTEGER :: nunit ! The I/O unit to be used for the log file output
!
!-----------------------------------------------------------------------
!
! Misc. local variables:
!
!-----------------------------------------------------------------------
!
CHARACTER (LEN=80) :: logfn
INTEGER :: llogfn
INTEGER :: logfunt
INTEGER :: istat
INTEGER :: lenstr,i,j,ncmnt
!
!
!-----------------------------------------------------------------------
!
! Include files
!
!-----------------------------------------------------------------------
!
INCLUDE 'globcst.inc'
INCLUDE 'grid.inc' ! Grid parameters
INCLUDE 'bndry.inc'
INCLUDE 'phycst.inc'
INCLUDE 'exbc.inc'
INCLUDE 'nudging.inc'
INCLUDE 'mp.inc' ! Message passing parameters.
INCLUDE 'agricst.inc'
INCLUDE 'nodal.inc'
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!-----------------------------------------------------------------------
!
! Write out a log file in namelist format which can be used as
! the input file for replicating this run.
!
! First get a name for the log file:
!
!-----------------------------------------------------------------------
!
IF( nunit == 6 ) THEN
logfunt = 6
WRITE(logfunt,'(///2x,a,i3//)') &
'PRINT OUT OF MODEL PARAMETERS FOR GRID ',mgrid
ELSE
CALL gtlogfn(runname(1:lfnkey), mgrid, nestgrd, logfn, llogfn)
CALL getunit( logfunt )
OPEN (UNIT=logfunt, FILE=trim(logfn(1:llogfn)),STATUS='new', &
IOSTAT=istat)
IF(istat /= 0) THEN
WRITE(6,'(/3x,a)')'Error in opening log file ',logfn(1:llogfn)
WRITE(6,'(3x,a/)')'Job stopped in subroutine INITPARA.'
CALL arpsstop('arpsstop called from PRTLOG with opening log file' &
,1)
END IF
END IF
!
!-----------------------------------------------------------------------
!
! Construct a namelist input file in the namelog file. default
! format used by the write function for namelist is to write all the
! data in a single line, as opposed to a single value per line.
!
!-----------------------------------------------------------------------
!
WRITE (logfunt, '(1x,a)') '&grid_dims'
WRITE (logfunt, '(3x,a,i4,a)') 'nx = ', nx, ','
WRITE (logfunt, '(3x,a,i4,a)') 'ny = ', ny, ','
WRITE (logfunt, '(3x,a,i4,a)') 'nz = ', nz, ','
WRITE (logfunt, '(1x,a)') '/'
WRITE (logfunt, '(1x,a)') '&message_passing'
WRITE (logfunt, '(3x,a,i4,a)') 'nproc_x = ', nproc_x, ','
WRITE (logfunt, '(3x,a,i4,a)') 'nproc_y = ', nproc_y, ','
WRITE (logfunt, '(3x,a,i4,a)') 'max_fopen = ', max_fopen, ','
WRITE (logfunt, '(1x,a)') '/'
nxc = nx ! Base grid dimensions in ARPS AGR
nyc = ny ! Base grid dimensions in ARPS AGR
nzc = nz ! Base grid dimensions in ARPS AGR
WRITE (logfunt, '(1x,a)') '&arpsagr'
WRITE (logfunt, '(3x,a,i4,a)') 'levfix = ', levfix, ','
WRITE (logfunt, '(3x,a,i4,a)') ' intrat = ', intrat, ','
WRITE (logfunt, '(3x,a,i4,a)') ' intratt= ', intratt, ','
WRITE (logfunt, '(3x,a,i4,a)') 'intrpodr= ', intrpodr, ','
WRITE (logfunt, '(3x,a,i10,a)') 'kcheck = ', kcheck, ','
WRITE (logfunt, '(3x,a,l7,a)') 'verbose1= ', verbose1, ','
WRITE (logfunt, '(3x,a,l7,a)') 'verbose2= ', verbose2, ','
WRITE (logfunt, '(3x,a,l7,a)') 'verbose3= ', verbose3, ','
WRITE (logfunt, '(3x,a,l7,a)') 'verbose4= ', verbose4, ','
WRITE (logfunt, '(3x,a,l7,a)') 'verbose5= ', verbose5, ','
WRITE (logfunt, '(3x,a,l7,a)') 'verbose6= ', verbose6, ','
WRITE (logfunt, '(3x,a,l7,a)') 'rstart = ', rstart , ','
WRITE (logfunt,'(3x,a,a,a)') 'runold = ''', trim(runold), ''','
WRITE (logfunt, '(3x,a,f16.4,a)') 'rstime = ',rstime, ','
WRITE (logfunt, '(3x,a,l7,a)') 'rstdump = ', rstdump , ','
WRITE (logfunt, '(3x,a,l7,a)') 'grdsrt = ', grdsrt , ','
WRITE (logfunt, '(3x,a,i4,a)') 'nfinelv = ', nfinelv, ','
DO i=1,nfinelv
WRITE (logfunt, '(5x,a,i3.3,a,i3,a)')'ngrdnew(',i,') =',ngrdnew(nfinelv),','
DO j=1,ngrdnew(nfinelv)
WRITE (logfunt,'(7x,a,i3.3,a,i3.3,a,f10.3,a)')'ixc(',j,',',i,') =',ixc(j,i),','
WRITE (logfunt,'(7x,a,i3.3,a,i3.3,a,f10.3,a)')'jyc(',j,',',i,') =',jyc(j,i),','
WRITE (logfunt,'(7x,a,i3.3,a,i3.3,a,f10.3,a)')'ixln(',j,',',i,') =',ixln(j,i),','
WRITE (logfunt,'(7x,a,i3.3,a,i3.3,a,f10.3,a)')'jyln(',j,',',i,') =',jyln(j,i),','
WRITE (logfunt,'(7x,a,i3.3,a,i3.3,a,f10.3,a)')'gangle(',j,',',i,') =',gangle(j,i),','
ENDDO
ENDDO
WRITE (logfunt, '(1x,a)') '/'
ncmnt = MAX( 1, MIN(9,nocmnt) )
WRITE (logfunt, '(1x,a)') '&comment_lines'
WRITE (logfunt, '(3x,a,i4,a)') 'nocmnt = ', ncmnt , ','
WRITE (cmnt(ncmnt),'(a,i4,a,i4,a,i4,a,a)') &
' nx =',nx,', ny =',ny,', nz =',nz, &
' ',arpsversion
DO i=1,ncmnt
WRITE (logfunt,'(3x,a,i2.2,a,a,a)') &
'cmnt(',i,') = ''', trim(cmnt(i)), ''','
END DO
WRITE (logfunt, '(1x,a)') '/'
!
!-----------------------------------------------------------------------
!
! Write the jobname namelist values into the log file.
!
!-----------------------------------------------------------------------
!
WRITE (logfunt, '(/1x,a)') '&jobname'
WRITE (logfunt,'(3x,a,a,a)') 'runname = ''', trim(runname), ''','
WRITE (logfunt, '(1x,a)') '/'
!
!-----------------------------------------------------------------------
!
! Write the model config namelist values into the log file.
!
!-----------------------------------------------------------------------
!
WRITE (logfunt, '(/1x,a)') '&model_configuration'
WRITE (logfunt, '(3x,a,i4,a)') 'runmod = ', runmod, ','
WRITE (logfunt, '(1x,a)') '/'
!
!-----------------------------------------------------------------------
!
! Write the initialization namelist values into the namelist logfile
!
!-----------------------------------------------------------------------
!
WRITE (logfunt, '(/1x,a)') '&initialization'
WRITE (logfunt, '(3x,a,i4.4,a,i2.2,a,i2.2,a,i2.2,a,i2.2,a,i2.2,a)') &
'initime = ''', year,'-',month,'-',day,'.', &
hour,':',minute,':',second, ''','
WRITE (logfunt, '(3x,a,i4,a)') 'timeopt = ', timeopt, ','
WRITE (logfunt, '(3x,a,i4,a)') 'initopt = ', initopt, ','
WRITE (logfunt, '(3x,a,i4,a)') 'inibasopt = ', inibasopt,','
WRITE (logfunt, '(3x,a,i4,a)') 'viniopt = ', viniopt, ','
WRITE (logfunt, '(3x,a,i4,a)') 'soilinitopt = ',soilinitopt,','
WRITE (logfunt, '(3x,a,f16.4,a)') 'soiltintv = ',soiltintv, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'ubar0 = ', ubar0, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'vbar0 = ', vbar0, ','
WRITE (logfunt, '(3x,a,i4,a)') 'pt0opt = ', pt0opt, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'ptpert0 = ', ptpert0, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'pt0radx = ', pt0radx, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'pt0rady = ', pt0rady, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'pt0radz = ', pt0radz, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'pt0ctrx = ', pt0ctrx, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'pt0ctry = ', pt0ctry, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'pt0ctrz = ', pt0ctrz, ','
WRITE (logfunt, '(3x,a,a,a)') 'sndfile = ''', trim(sndfile), ''','
WRITE (logfunt,'(3x,a,a,a)') 'rstinf = ''', trim(rstinf), ''','
WRITE (logfunt, '(3x,a,i4,a)')'inifmt = ', inifmt, ','
WRITE (logfunt, '(3x,a,a,a)') 'inifile = ''', trim(inifile), ''','
WRITE (logfunt, '(3x,a,a,a)') 'inigbf = ''', trim(inigbf), ''','
WRITE (logfunt, '(1x,a)') '/'
!
!-----------------------------------------------------------------------
!
! Write the nudging namelist values into the namelist logfile
!
!-----------------------------------------------------------------------
!
WRITE (logfunt, '(/1x,a)') '&nudging'
WRITE (logfunt, '(3x,a,i4,a)') 'nudgopt = ', nudgopt, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'ndstart = ', ndstart, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'ndstop = ', ndstop, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'ndintvl = ', ndintvl, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'ndgain = ', ndgain, ','
WRITE (logfunt, '(3x,a,a,a)') 'incrfnam = ''', trim(incrfnam), ''','
WRITE (logfunt, '(3x,a,i4,a)') 'incrfmt = ', incrfmt, ','
WRITE (logfunt, '(3x,a,i4,a)') 'nudgu = ', nudgu, ','
WRITE (logfunt, '(3x,a,i4,a)') 'nudgv = ', nudgv, ','
WRITE (logfunt, '(3x,a,i4,a)') 'nudgw = ', nudgw, ','
WRITE (logfunt, '(3x,a,i4,a)') 'nudgp = ', nudgp, ','
WRITE (logfunt, '(3x,a,i4,a)') 'nudgpt = ', nudgpt, ','
WRITE (logfunt, '(3x,a,i4,a)') 'nudgqv = ', nudgqv, ','
WRITE (logfunt, '(3x,a,i4,a)') 'nudgqc = ', nudgqc, ','
WRITE (logfunt, '(3x,a,i4,a)') 'nudgqr = ', nudgqr, ','
WRITE (logfunt, '(3x,a,i4,a)') 'nudgqi = ', nudgqi, ','
WRITE (logfunt, '(3x,a,i4,a)') 'nudgqs = ', nudgqs, ','
WRITE (logfunt, '(3x,a,i4,a)') 'nudgqh = ', nudgqh, ','
WRITE (logfunt, '(1x,a)') '/'
!
!-----------------------------------------------------------------------
!
! Write the terrain namelist values into the namelist logfile
!
!-----------------------------------------------------------------------
!
WRITE (logfunt, '(/1x,a)') '&terrain'
WRITE (logfunt, '(3x,a,i4,a)') 'ternopt = ', ternopt, ','
WRITE (logfunt, '(3x,a,i4,a)') 'mntopt = ', mntopt, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'hmount = ', hmount, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'mntwidx = ', mntwidx, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'mntwidy = ', mntwidy, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'mntctrx = ', mntctrx, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'mntctry = ', mntctry, ','
WRITE (logfunt, '(3x,a,i4,a)') 'ternfmt = ', ternfmt, ','
WRITE (logfunt, '(3x,a,a,a)') 'terndta = ''', trim(terndta), ''','
WRITE (logfunt, '(1x,a)') '/'
!
!-----------------------------------------------------------------------
!
! Write the grid namelist values into the namelist logfile.
!
!-----------------------------------------------------------------------
!
WRITE (logfunt, '(/1x,a)') '&grid'
WRITE (logfunt, '(3x,a,f16.4,a)') 'dx = ', dx, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'dy = ', dy, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'dz = ', dz, ','
WRITE (logfunt, '(3x,a,i4,a)') 'strhopt = ', strhopt, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'dzmin = ', dzmin, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'zrefsfc = ', zrefsfc, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'dlayer1 = ', dlayer1, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'dlayer2 = ', dlayer2, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'strhtune = ', strhtune, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'zflat = ', zflat, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'ctrlat = ', ctrlat, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'ctrlon = ', ctrlon, ','
WRITE (logfunt, '(1x,a)') '/'
!
!-----------------------------------------------------------------------
!
! Write the map projection namelist values into the namelist logfile.
!
!-----------------------------------------------------------------------
!
WRITE (logfunt, '(/1x,a)') '&projection'
WRITE (logfunt, '(3x,a,i4,a)') 'mapproj = ',mapproj, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'trulat1 = ',trulat1, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'trulat2 = ',trulat2, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'trulon = ',trulon, ','
WRITE (logfunt, '(3x,a,e15.5,a)') 'sclfct = ',sclfct, ','
WRITE (logfunt, '(3x,a,i4,a)') 'mpfctopt = ',mpfctopt,','
WRITE (logfunt, '(3x,a,i4,a)') 'mptrmopt = ',mptrmopt,','
WRITE (logfunt, '(3x,a,i4,a)') 'maptest = ',maptest, ','
WRITE (logfunt, '(1x,a)') '/'
!
!-----------------------------------------------------------------------
!
! Write the timestep namelist values into the namelist logfile.
!
!-----------------------------------------------------------------------
!
WRITE (logfunt, '(/1x,a)') '×tep'
WRITE (logfunt, '(3x,a,f16.4,a)') 'dtbig = ', dtbig, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'tstart = ', tstart,','
WRITE (logfunt, '(3x,a,f16.4,a)') 'tstop = ', tstop, ','
WRITE (logfunt, '(1x,a)') '/'
!
!-----------------------------------------------------------------------
!
! Write the acoustic_wave namelist values into the namelist logfile.
!
!-----------------------------------------------------------------------
!
WRITE (logfunt, '(/1x,a)') '&acoustic_wave'
WRITE (logfunt, '(3x,a,i4,a)') 'vimplct = ', vimplct, ','
WRITE (logfunt, '(3x,a,i4,a)') 'ptsmlstp = ', ptsmlstp,','
WRITE (logfunt, '(3x,a,i4,a)') 'csopt = ', csopt, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'csfactr = ', csfactr, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'csound = ', csound, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'tacoef = ', tacoef, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'dtsml = ', dtsml, ','
WRITE (logfunt, '(1x,a)') '/'
!
!-----------------------------------------------------------------------
!
! Write out equation formulation related parameters
!
!-----------------------------------------------------------------------
!
WRITE (logfunt, '(/1x,a)') '&equation_formulation'
WRITE (logfunt, '(3x,a,i4,a)') 'buoyopt = ', buoyopt, ','
WRITE (logfunt, '(3x,a,i4,a)') 'buoy2nd = ', buoy2nd, ','
WRITE (logfunt, '(3x,a,i4,a)') 'rhofctopt = ', rhofctopt,','
WRITE (logfunt, '(3x,a,i4,a)') 'bsnesq = ', bsnesq, ','
WRITE (logfunt, '(3x,a,i4,a)') 'peqopt = ', peqopt, ','
WRITE (logfunt, '(1x,a)') '/'
!
!-----------------------------------------------------------------------
!
! Write out numerics related parameters
!
!-----------------------------------------------------------------------
!
WRITE (logfunt, '(/1x,a)') '&numerics'
WRITE (logfunt, '(3x,a,i4,a)') 'madvopt = ', madvopt, ','
WRITE (logfunt, '(3x,a,i4,a)') 'sadvopt = ', sadvopt, ','
WRITE (logfunt, '(3x,a,i3,a)') 'fctorderopt= ',fctorderopt, ','
WRITE (logfunt, '(3x,a,i3,a)') 'fctadvptprt= ',fctadvptprt, ','
WRITE (logfunt, '(1x,a)') '/'
!
!-----------------------------------------------------------------------
!
! Write all the boundary conditions in the namelist format into
! the namelist logfile.
!
!-----------------------------------------------------------------------
!
WRITE (logfunt, '(/1x,a)') '&boundary_condition_options'
WRITE (logfunt, '(3x,a,i4,a)') 'lbcopt = ', lbcopt, ','
WRITE (logfunt, '(3x,a,i4,a)') 'wbc = ', wbc_global, ','
WRITE (logfunt, '(3x,a,i4,a)') 'ebc = ', ebc_global, ','
WRITE (logfunt, '(3x,a,i4,a)') 'sbc = ', sbc_global, ','
WRITE (logfunt, '(3x,a,i4,a)') 'nbc = ', nbc_global, ','
WRITE (logfunt, '(3x,a,i4,a)') 'tbc = ', tbc, ','
WRITE (logfunt, '(3x,a,i4,a)') 'fftopt = ', fftopt, ','
WRITE (logfunt, '(3x,a,i4,a)') 'bbc = ', bbc, ','
WRITE (logfunt, '(3x,a,i4,a)') 'rbcopt = ', rbcopt, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'c_phase = ', c_phase,','
WRITE (logfunt, '(3x,a,f16.4,a)') 'rlxlbc = ', rlxlbc ,','
WRITE (logfunt, '(3x,a,i4,a)') 'pdetrnd = ', pdetrnd,','
WRITE (logfunt, '(1x,a)') '/'
!
!-----------------------------------------------------------------------
!
! Write the exbcpara namelist value into the log file.
!
!-----------------------------------------------------------------------
!
lenstr = 80
CALL strlnth( exbcname, lenstr)
WRITE (logfunt, '(/1x,a)') '&exbcpara'
WRITE (logfunt, '(3x,a)') &
'exbcname = '''//exbcname(1:lenstr)//''','
WRITE (logfunt, '(3x,a)') 'tinitebd = '''//tinitebd//''','
WRITE (logfunt, '(3x,a,i10,a)') 'tintvebd = ', tintvebd, ','
WRITE (logfunt, '(3x,a,i10,a)') 'ngbrz = ', ngbrz, ','
WRITE (logfunt, '(3x,a,e15.5,a)') 'brlxhw = ', brlxhw, ','
WRITE (logfunt, '(3x,a,e15.5,a)') 'cbcdmp = ', cbcdmp, ','
WRITE (logfunt, '(3x,a,e15.5,a)') 'cbcmix = ', cbcmix, ','
WRITE (logfunt, '(3x,a,i4,a)') 'exbcfmt = ', exbcfmt, ','
WRITE (logfunt, '(1x,a)') '/'
!
!-----------------------------------------------------------------------
!
! Write the coriolis force namelist values into the logfile.
!
!-----------------------------------------------------------------------
!
WRITE (logfunt, '(/1x,a)') '&coriolis_force'
WRITE (logfunt, '(3x,a,i4,a)') 'coriopt = ', coriopt, ','
WRITE (logfunt, '(3x,a,i4,a)') 'coriotrm = ', coriotrm,','
WRITE (logfunt, '(1x,a)') '/'
!
!-----------------------------------------------------------------------
!
! Write the turbulence namelist values into the namelist logfile.
!
!-----------------------------------------------------------------------
!
WRITE (logfunt, '(/1x,a)') '&turbulence'
WRITE (logfunt, '(3x,a,i4,a)') 'tmixopt = ', tmixopt, ','
WRITE (logfunt, '(3x,a,i4,a)') 'trbisotp = ', trbisotp,','
WRITE (logfunt, '(3x,a,i4,a)') 'tkeopt = ', tkeopt, ','
WRITE (logfunt, '(3x,a,i4,a)') 'trbvimp = ', trbvimp, ','
WRITE (logfunt, '(3x,a,i4,a)') 'tmixvert = ', tmixvert,','
WRITE (logfunt, '(3x,a,f16.4,a)') 'alfcoef = ', alfcoef, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'prantl = ', prantl, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'tmixcst = ', tmixcst, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'kmlimit = ', kmlimit, ','
WRITE (logfunt, '(1x,a)') '/'
!
!-----------------------------------------------------------------------
!
! Write a computational_mixing namelist values into the logfile.
!
!-----------------------------------------------------------------------
!
WRITE (logfunt, '(/1x,a)') '&computational_mixing'
WRITE (logfunt, '(3x,a,i4,a)') 'cmix2nd = ', cmix2nd,','
WRITE (logfunt, '(3x,a,e15.5,a)') 'cfcm2h = ', cfcm2h, ','
WRITE (logfunt, '(3x,a,e15.5,a)') 'cfcm2v = ', cfcm2v, ','
WRITE (logfunt, '(3x,a,i4,a)') 'cmix4th = ', cmix4th,','
WRITE (logfunt, '(3x,a,e15.5,a)') 'cfcm4h = ', cfcm4h, ','
WRITE (logfunt, '(3x,a,e15.5,a)') 'cfcm4v = ', cfcm4v, ','
WRITE (logfunt, '(3x,a,e15.5,a)') 'scmixfctr = ', scmixfctr, ','
WRITE (logfunt, '(3x,a,i4,a)') 'cmix_opt = ', cmix_opt, ','
WRITE (logfunt, '(1x,a)') '/'
!
!-----------------------------------------------------------------------
!
! Calculate divdmpnd and write the divergence namelist data into
! the namelist log file.
!
!-----------------------------------------------------------------------
!
WRITE (logfunt, '(/1x,a)') '&divergence_damping'
WRITE (logfunt, '(3x,a,i4,a)') 'divdmp = ', divdmp, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'divdmpndh = ', divdmpndh,','
WRITE (logfunt, '(3x,a,f16.4,a)') 'divdmpndv = ', divdmpndv,','
WRITE (logfunt, '(1x,a)') '/'
!
!-----------------------------------------------------------------------
!
! Write the rayleigh_damping namelist values into the logfile.
!
!-----------------------------------------------------------------------
!
WRITE (logfunt, '(/1x,a)') '&rayleigh_damping'
WRITE (logfunt, '(3x,a,i4,a)') 'raydmp = ', raydmp, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'cfrdmp = ', cfrdmp, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'zbrdmp = ', zbrdmp, ','
WRITE (logfunt, '(1x,a)') '/'
!
!-----------------------------------------------------------------------
!
! Write the asselin_time_filter namelist data into the logfile.
!
!-----------------------------------------------------------------------
!
WRITE (logfunt, '(/1x,a)') '&asselin_time_filter'
WRITE (logfunt, '(3x,a,f16.4,a)') 'flteps = ', flteps, ','
WRITE (logfunt, '(1x,a)') '/'
!
!-----------------------------------------------------------------------
!
! Write the microphysics namelist values into the log file.
!
!-----------------------------------------------------------------------
!
WRITE (logfunt, '(/1x,a)') 'µphysics'
WRITE (logfunt, '(3x,a,i4,a)') 'moist = ', moist, ','
WRITE (logfunt, '(3x,a,i4,a)') 'mphyopt = ', mphyopt, ','
WRITE (logfunt, '(3x,a,i4,a)') 'cnvctopt = ', cnvctopt,','
WRITE (logfunt, '(3x,a,e15.5,a)') 'kffbfct = ', kffbfct, ','
WRITE (logfunt, '(3x,a,i4,a)') 'kfsubsattrig = ', kfsubsattrig, ','
WRITE (logfunt, '(3x,a,e15.5,a)') 'wcldbs = ', wcldbs, ','
WRITE (logfunt, '(3x,a,e15.4,a)') 'confrq = ', confrq, ','
WRITE (logfunt, '(3x,a,e15.4,a)') 'qpfgfrq = ', qpfgfrq, ','
WRITE (logfunt, '(3x,a,i4,a)') 'idownd = ', idownd, ','
WRITE (logfunt, '(3x,a,i4,a)') 'subsatopt = ', subsatopt, ','
WRITE (logfunt, '(3x,a,e15.5,a)') 'rhsat = ', rhsat, ','
WRITE (logfunt, '(3x,a,e15.5,a)') 'rhsatmin = ', rhsatmin, ','
WRITE (logfunt, '(3x,a,e15.5,a)') 'dx_rhsatmin = ', dx_rhsatmin, ','
WRITE (logfunt, '(3x,a,e15.5,a)') 'dx_rhsat100 = ', dx_rhsat100, ','
WRITE (logfunt, '(1x,a)') '/'
!
!-----------------------------------------------------------------------
!
! Write the radiation namelist values into the log file.
!
!-----------------------------------------------------------------------
!
WRITE (logfunt, '(/1x,a)') '&radiation'
WRITE (logfunt, '(3x,a,i4,a)') 'radopt = ', radopt, ','
WRITE (logfunt, '(3x,a,i4,a)') 'radstgr = ', radstgr, ','
WRITE (logfunt, '(3x,a,i4,a)') 'rlwopt = ', rlwopt, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'dtrad = ', dtrad, ','
WRITE (logfunt, '(3x,a,i4,a)') 'raddiag = ', raddiag, ','
WRITE (logfunt, '(1x,a)') '/'
!
!-----------------------------------------------------------------------
!
! Write the surface physics namelist values into the namelist
! log file.
!
!-----------------------------------------------------------------------
!
WRITE (logfunt, '(/1x,a)') '&surface_physics'
WRITE (logfunt, '(3x,a,i4,a)') 'sfcphy = ', sfcphy, ','
WRITE (logfunt, '(3x,a,i4,a)') 'landwtr = ', landwtr,','
WRITE (logfunt, '(3x,a,i4,a)') 'cdhwtropt = ', cdhwtropt,','
WRITE (logfunt, '(3x,a,e15.5,a)') 'cdmlnd = ', cdmlnd, ','
WRITE (logfunt, '(3x,a,e15.5,a)') 'cdmwtr = ', cdmwtr, ','
WRITE (logfunt, '(3x,a,e15.5,a)') 'cdhlnd = ', cdhlnd, ','
WRITE (logfunt, '(3x,a,e15.5,a)') 'cdhwtr = ', cdhwtr, ','
WRITE (logfunt, '(3x,a,e15.5,a)') 'cdqlnd = ', cdqlnd, ','
WRITE (logfunt, '(3x,a,e15.5,a)') 'cdqwtr = ', cdqwtr, ','
WRITE (logfunt, '(3x,a,i4,a)') 'pbldopt = ', pbldopt,','
WRITE (logfunt, '(3x,a,f16.4,a)') 'pbldpth0 = ', pbldpth0,','
WRITE (logfunt, '(3x,a,f16.4,a)') 'lsclpbl0 = ', lsclpbl0,','
! write (logfunt, '(3x,a,i4,a)') 'sflxdis = ', sflxdis,','
WRITE (logfunt, '(3x,a,i4,a)') 'tqflxdis = ', tqflxdis,','
WRITE (logfunt, '(3x,a,f16.4,a)') 'dtqflxdis = ', dtqflxdis,','
WRITE (logfunt, '(3x,a,i4,a)') 'sfcdiag = ', sfcdiag,','
WRITE (logfunt, '(1x,a)') '/'
!
!-----------------------------------------------------------------------
!
! Write the surface energy budget model (EBM) namelist values into
! the namelist log file.
!
!-----------------------------------------------------------------------
!
WRITE (logfunt, '(/1x,a)') '&soil_ebm'
WRITE (logfunt, '(3x,a,i4,a)') 'sfcdat = ', sfcdat, ','
WRITE (logfunt, '(3x,a,i4,a)') 'styp = ', styp, ','
WRITE (logfunt, '(3x,a,i4,a)') 'vtyp = ', vtyp, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'lai0 = ', lai0, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'roufns0 = ', roufns0, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'veg0 = ', veg0, ','
lenstr = 80
CALL strlnth( sfcdtfl,lenstr )
WRITE (logfunt, '(3x,a,a,a)') &
'sfcdtfl = ''', sfcdtfl(1:lenstr), ''','
WRITE (logfunt, '(3x,a,i4,a)') 'sfcfmt = ', sfcfmt, ','
WRITE (logfunt, '(3x,a,i4,a)') 'soilinit = ', soilinit, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'ptslnd0 = ', ptslnd0, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'ptswtr0 = ', ptswtr0, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'tsoil0 = ', tsoil0, ','
WRITE (logfunt, '(3x,a,e15.5,a)') 'wetsfc0 = ', wetsfc0, ','
WRITE (logfunt, '(3x,a,e15.5,a)') 'wetdp0 = ', wetdp0, ','
WRITE (logfunt, '(3x,a,e15.5,a)') 'wetcanp0 = ', wetcanp0, ','
WRITE (logfunt, '(3x,a,e15.5,a)') 'snowdpth0 = ', snowdpth0,','
WRITE (logfunt, '(3x,a,e15.5,a)') 'tsprt = ', tsprt, ','
WRITE (logfunt, '(3x,a,e15.5,a)') 't2prt = ', t2prt, ','
WRITE (logfunt, '(3x,a,e15.5,a)') 'wgrat = ', wgrat, ','
WRITE (logfunt, '(3x,a,e15.5,a)') 'w2rat = ', w2rat, ','
lenstr = 80
CALL strlnth( soilinfl,lenstr )
WRITE (logfunt, '(3x,a,a,a)') &
'soilinfl = ''', soilinfl(1:lenstr), ''','
WRITE (logfunt, '(3x,a,i4,a)') 'soilfmt = ',soilfmt, ','
WRITE (logfunt, '(3x,a,i4,a)') 'tsoil_offset = ',tsoil_offset, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'tsoil_offset_amplitude = ',tsoil_offset_amplitude, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'dtsfc = ', dtsfc, ','
WRITE (logfunt, '(1x,a)') '/'
!
!-----------------------------------------------------------------------
!
! Parameters for automatic grid translation.
!
!-----------------------------------------------------------------------
!
WRITE (logfunt, '(/1x,a)') '&grdtrans'
WRITE (logfunt, '(3x,a,i4,a)') 'cltkopt =',cltkopt,','
WRITE (logfunt, '(3x,a,f16.4,a)') 'tceltrk =',tceltrk,','
WRITE (logfunt, '(3x,a,f16.4,a)') 'tcrestr =',tcrestr,','
WRITE (logfunt, '(3x,a,i4,a)') 'grdtrns =',grdtrns,','
WRITE (logfunt, '(3x,a,f16.4,a)') 'umove =',umove, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'vmove =',vmove, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'twindow =',twindow,','
WRITE (logfunt, '(3x,a,f16.4,a)') 'chkdpth =',chkdpth,','
WRITE (logfunt, '(1x,a)') '/'
!
!-----------------------------------------------------------------------
!
! Write the history_dump namelist data into the log file.
!
!-----------------------------------------------------------------------
!
WRITE (logfunt, '(/1x,a)') '&history_dump'
WRITE (logfunt, '(3x,a,i4,a)') 'hdmpopt = ', hdmpopt, ','
WRITE (logfunt, '(3x,a,i4,a)') 'hdmpfmt = ', hdmpfmt, ','
WRITE (logfunt, '(3x,a,i4,a)') 'grbpkbit = ', grbpkbit,','
WRITE (logfunt, '(3x,a,i4,a)') 'hdfcompr = ', hdfcompr,','
WRITE (logfunt, '(3x,a,f16.4,a)') 'thisdmp = ', thisdmp, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'tstrtdmp = ', tstrtdmp,','
WRITE (logfunt, '(3x,a,i4,a)') 'numhdmp = ', numhdmp, ','
IF ( numhdmp > 0 ) THEN
DO i=1,numhdmp
WRITE (logfunt, '(3x,a,i3.3,a,f16.4,a)') &
'hdmptim(',i,') = ', hdmptim(i),','
END DO
END IF
WRITE (logfunt, '(1x,a)') '/'
!
!-----------------------------------------------------------------------
!
! Write the output namelist data into the log file.
!
!-----------------------------------------------------------------------
!
WRITE (logfunt, '(/1x,a)') '&output'
WRITE (logfunt, '(3x,a)') &
'dirname = '''//dirname(1:ldirnam)//''','
WRITE (logfunt, '(3x,a,i4,a)') 'exbcdmp = ', exbcdmp, ','
WRITE (logfunt, '(3x,a,i4,a)') 'extdadmp = ', extdadmp,','
WRITE (logfunt, '(3x,a,i4,a)') 'filcmprs = ', filcmprs,','
WRITE (logfunt, '(3x,a,i4,a)') 'basout = ', basout, ','
WRITE (logfunt, '(3x,a,i4,a)') 'grdout = ', grdout, ','
WRITE (logfunt, '(3x,a,i4,a)') 'varout = ', varout, ','
WRITE (logfunt, '(3x,a,i4,a)') 'mstout = ', mstout, ','
WRITE (logfunt, '(3x,a,i4,a)') 'iceout = ', iceout, ','
WRITE (logfunt, '(3x,a,i4,a)') 'tkeout = ', tkeout, ','
WRITE (logfunt, '(3x,a,i4,a)') 'trbout = ', trbout, ','
WRITE (logfunt, '(3x,a,i4,a)') 'sfcout = ', sfcout, ','
WRITE (logfunt, '(3x,a,i4,a)') 'rainout = ', rainout, ','
WRITE (logfunt, '(3x,a,i4,a)') 'prcout = ', prcout, ','
WRITE (logfunt, '(3x,a,i4,a)') 'landout = ', landout, ','
WRITE (logfunt, '(3x,a,i4,a)') 'radout = ', radout, ','
WRITE (logfunt, '(3x,a,i4,a)') 'flxout = ', flxout, ','
WRITE (logfunt, '(3x,a,i4,a)') 'qcexout = ', qcexout, ','
WRITE (logfunt, '(3x,a,i4,a)') 'qrexout = ', qrexout, ','
WRITE (logfunt, '(3x,a,i4,a)') 'qiexout = ', qiexout, ','
WRITE (logfunt, '(3x,a,i4,a)') 'qsexout = ', qsexout, ','
WRITE (logfunt, '(3x,a,i4,a)') 'qhexout = ', qhexout, ','
WRITE (logfunt, '(3x,a,i4,a)') 'sfcdmp = ', sfcdmp, ','
WRITE (logfunt, '(3x,a,i4,a)') 'soildmp = ', soildmp, ','
WRITE (logfunt, '(3x,a,i4,a)') 'terndmp = ', terndmp, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'tfmtprt = ', tfmtprt, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'trstout = ', trstout, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'tmaxmin = ', tmaxmin, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'tenergy = ', tenergy, ','
WRITE (logfunt, '(3x,a,i4,a)') 'imgopt = ', imgopt, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'timgdmp = ', timgdmp, ','
WRITE (logfunt, '(3x,a,i4,a)') 'pltopt = ', pltopt, ','
WRITE (logfunt, '(3x,a,f16.4,a)') 'tplots = ', tplots, ','
WRITE (logfunt, '(1x,a)') '/'
!
!-----------------------------------------------------------------------
!
! Write the debug namelist value into the log file.
!
!-----------------------------------------------------------------------
!
WRITE (logfunt, '(/1x,a)') '&debug'
WRITE (logfunt, '(3x,a,i4,a)') 'lvldbg = ', lvldbg, ','
WRITE (logfunt, '(1x,a)') '/'
IF( logfunt /= 6 ) THEN
CLOSE(UNIT=logfunt)
CALL retunit( logfunt )
WRITE(6,'(/3x,a,a,a/)') &
'Log file ',logfn(1:llogfn),' was produced for this job.'
END IF
RETURN
END SUBROUTINE prtlog
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE SETGRD ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE setgrd( nx,ny, x, y ) 2,4
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Set up the ARPS model grid.
!
! The structure of this program is as follows:
!
! 1. Get the map projection information.
! (call subroutine setmapr)
!
! 2. Get the absolute coordinates of the model grid origin on map
! grid with the origin at north pole.
! (call subroutine lltoxy)
!
! 3. Set up the model origin.
! (call subroutine setorig)
!
!-----------------------------------------------------------------------
!
! AUTHOR: Yuhe Liu
! 1/26/94
!
! MODIFICATIONS:
!
! 7/15/94
! Change the model grid reference point from the southwest corner to
! the center of model domain.
!
! 9/10/94 (Weygandt & Y. Lu)
! Cleaned up documentation.
!
!-----------------------------------------------------------------------
!
! INPUT:
!
! nx Number of grid points for the model
! grid in the east-west direction.
! ny Number of grid points for the model
! grid in the north-south direction.
!
! OUTPUT:
!
! x Analysis grid points in the e-w direction
! (in grid units)
! y Analysis grid points in the n-s direction
! (in grid units)
!
!-----------------------------------------------------------------------
!
!
!-----------------------------------------------------------------------
!
! Variable Declarations.
!
!-----------------------------------------------------------------------
!
IMPLICIT NONE
INTEGER :: nx ! Number of model grid points
! in the east-west direction.
INTEGER :: ny ! Number of model grid points
! in the north-south direction
REAL :: x (nx) ! 2-D model grid points east-west
! direction (model grid units)
REAL :: y (ny) ! 2-D model grid points north-south
! direction (model grid units)
!
!-----------------------------------------------------------------------
!
! Include files: globcst.inc phycst.inc
!
! dx Model grid spacing in the x-direction east-west
! (meters)
! dy Analysis grid spacing in the y-direction north-south
! (meters)
!
! ctrlat Latitude of the center of the model grid (deg. N)
! ctrlon Longitude of the center of the model grid (deg. E)
!
!wdt update
! mapproj type of map projection used to setup the model grid.
! mapproj = 1 Polar Stereographic projection
! = 2 Lambert Contformal
! = 3 Mercator projection
! = 4 Lat, Lon Projection
! = 5 User defined
! trulat1 The 1st real true latitude of map projection.
! trulat2 The 2nd real true latitude of map projection.
! trulon Real true longitude of map projection.
! sclfct Map scale factor (eg. sclfct=1/1000000)
!
!-----------------------------------------------------------------------
!
INCLUDE 'globcst.inc'
INCLUDE 'grid.inc' ! Grid parameters
INCLUDE 'phycst.inc'
INCLUDE 'mp.inc' ! Message passing parameters.
!
!-----------------------------------------------------------------------
!
! Misc. local variables:
!
!-----------------------------------------------------------------------
!
INTEGER :: i,j
REAL :: alatpro(2)
REAL :: sclf
REAL :: dxscl ! Model x-direction grid spacing
! normalized by the map scale
! dxscl=dx/sclf
REAL :: dyscl ! Model y-direction grid spacing
! normalized by the map scale
! dyscl=dy/sclf
REAL :: ctrx, ctry, swx, swy
REAL :: xsub0, ysub0
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
alatpro(1) = trulat1
alatpro(2) = trulat2
IF( sclfct /= 1.0) THEN
sclf = 1.0/sclfct
dxscl = dx*sclf
dyscl = dy*sclf
ELSE
sclf = 1.0
dxscl = dx
dyscl = dy
END IF
xsub0 = dx * (nx-3) * (loc_x-1)
ysub0 = dy * (ny-3) * (loc_y-1)
!
!-----------------------------------------------------------------------
!
! Note IMPORTANT!!!!: dx and dy are in meters...and the grid is
! oriented so that the y-axis line through the true longitude of
! a map projection runs along a longitude line towards
! the northpole and the x-axis is perpendicular to the y-axis.
! Create the x,y grid in grid meters (multiplied by sclf), the
! origin is the southwest corner of the model physical domain as
! translated from the center point specified by user
! (ctrlat/ctrlon).
!
!-----------------------------------------------------------------------
!
CALL setmapr( mapproj,sclf,alatpro,trulon )
! set up parameters for map projection
!
!-----------------------------------------------------------------------
!
! Find the absolute coordinate (ctrx,ctry) of point (ctrlat,ctrlon)
! in the latitude-longitude space.
!
!-----------------------------------------------------------------------
!
CALL lltoxy( 1,1, ctrlat,ctrlon, ctrx, ctry )
!
!-----------------------------------------------------------------------
!
! Translate the center point to the first physical point, i.e.,
! the origin of the model grid.
!
!-----------------------------------------------------------------------
!
! swx = ctrx - (float(nx-3)/2.) * dxscl
! swy = ctry - (float(ny-3)/2.) * dyscl
swx = ctrx - (FLOAT(nproc_x*(nx-3))/2.) * dxscl
swy = ctry - (FLOAT(nproc_y*(ny-3))/2.) * dyscl
CALL setorig( 1, swx, swy)
! set up the model origin to the coord.
xgrdorg = 0.0
ygrdorg = 0.0
!
!-----------------------------------------------------------------------
!
! Calculate the rest of the model grid points in earth meters*sclf
!
!-----------------------------------------------------------------------
!
DO i=1,nx
! x(i) = dxscl * (i-2)
x(i) = sclf*xsub0 + dxscl * (i-2)
END DO
DO j=1,ny
! y(j) = dyscl * (j-2)
y(j) = sclf*ysub0 + dyscl * (j-2)
END DO
CALL setcornerll(nx,ny,x,y)
RETURN
END SUBROUTINE setgrd