!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE INITIAL ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE initial(mptr,nx,ny,nz,nzsoil,nxndg,nyndg,nzndg,nstyps, & 3,9
exbcbufsz, &
u,v,w,wcont,ptprt,pprt,qv,qc,qr,qi,qs,qh,tke, &
udteb,udtwb,udtnb,udtsb,vdteb,vdtwb,vdtnb,vdtsb, &
wdteb,wdtwb,wdtnb,wdtsb,pdteb,pdtwb,pdtnb,pdtsb, &
sdteb,sdtwb,sdtnb,sdtsb, &
ubar,vbar,ptbar,pbar,ptbari,pbari, &
rhostr,rhostri,qvbar,ppi,csndsq, &
x,y,z,zp,zpsoil,hterain,mapfct, &
j1,j2,j3,j3soil,aj3x,aj3y,aj3z,j3inv,j3soilinv, &
trigs1,trigs2,ifax1,ifax2, &
wsave1,wsave2,vwork1,vwork2, &
sinlat, kmh,kmv,rprntl, &
soiltyp,stypfrct,vegtyp,lai,roufns,veg, &
tsoil,qsoil,wetcanp,snowdpth,ptsfc,qvsfc, &
ptcumsrc,qcumsrc,w0avg,nca,kfraincv, &
cldefi,xland,bmjraincv, &
raing,rainc,prcrate,exbcbuf,bcrlx,radfrc,radsw, &
rnflx,radswnet,radlwin,usflx,vsflx,ptsflx,qvsflx, &
uincr,vincr,wincr,pincr,ptincr,qvincr, &
qcincr,qrincr,qiincr,qsincr,qhincr, &
tem1soil,tem2soil,tem3soil,tem4soil,tem5soil, &
temxy1,tem1,tem2,tem3,tem4,tem5,tem6,tem7, &
tem8,tem9,tem10,tem11,tem12,tem13, &
tem14,tem15,tem16,tem17,tem18,tem19, &
tem20,tem21,tem22,tem23,tem24,tem25,tem26, &
tem1_0,tem2_0,tem3_0)
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Initialize the model parameters and variables, including base state
! variables, dependent variables and grid structure.
!
! This is the main driver for model initializations.
!
!-----------------------------------------------------------------------
!
! AUTHOR: Ming Xue
! 11/5/92.
!
! MODIFICATION HISTORY:
!
! 5/02/92 (M. Xue)
! Added full documentation.
!
! 5/03/92 (M. Xue)
! Further documentation.
!
! 9/14/1992 (M. Xue)
! Different surface drag coefficients defined for momentum, heat and
! moisture.
! Three options included for the Coriolis force calculations.
!
! 2/12/94 (Yuhe Liu)
! Surface data and variables added for surface energy budget model.
!
! 6/10/94 (M. Xue &AS)
! Added call to initpwr.
!
! 02/07/1995 (Yuhe Liu)
! Added a new 2-D permanent array, veg(nx,ny), to the argument list
!
! 08/30/1995 (Yuhe Liu)
! Moved the initialization of external boundary arrays from the
! main program to this subroutine.
!
! 10/31/95 (D. Weber)
! Added trigs1,trigs2,ifax1,ifax2 for use in the upper w-p
! radiation condition.
!
! 1/22/96 (Donghai Wang & Yuhe Liu)
! Added the map projection factor to ARPS governing equations.
!
! 07/22/97 (D. Weber)
! Added wsave1,wsave2,vwork1,vwork2 for use in the even fft version
! of the upper w-p radiation condition (fftopt=2).
!
! 08/01/97 (Zonghui Huo)
! Added Kain-fritsch cumulus parameterization scheme.
!
! 11/05/97 (D. Weber)
! Added temxy5 array for use in the bottom boundary condition for
! pertrubation pressure (hydrostatic).
!
! 11/06/97 (D. Weber)
! Added three additional levels to the mapfct array. The three
! levels (4,5,6) represent the inverse of the first three in order.
! The inverse map factors are computed to improve efficiency.
!
! 4/15/1998 (Donghai Wang)
! Added the source terms to the right hand terms of the qc,qr,qi,qs
! equations due to the K-F cumulus parameterization.
!
! 4/15/1998 (Donghai Wang)
! Added the running average vertical velocity (array w0avg)
! for the K-F cumulus parameterization scheme.
!
! 9/15/1998 (D. Weber)
! Added ptbari, pbari (inverse) for use in optimizing the code.
!
! 8/31/1998 (K. Brewster)
! Added call to ININUDGE to initialize nudging terms.
!
! 11/18/1998 (K. Brewster)
! Changed pibar to ppi (full pi) and moved initialization.
!
! 12/09/1998 (Donghai Wang)
! Added the snow cover.
!
! 07/10/2001 (K. Brewster)
! Added increment arrays to argument list and to call to ininudge.
!
! 03/13/2002 (Eric Kemp)
! Added arrays for WRF BMJ cumulus scheme.
!
! April 2002 (Fanyou Kong)
! Added WRF new Kain-Fritsch (April 2002 version: KF_ETA) scheme
! initialization (lookup table)
! 05/02/2002 (Dan Weber and Jerry Brotzge)
! Added arrays for the new soil model.
!
!-----------------------------------------------------------------------
!
! INPUT:
!
! mptr Grid identifier.
! nx Number of grid points in the x-direction (east/west)
! ny Number of grid points in the y-direction (north/south)
! nz Number of grid points in the vertical
! nzsoil Number of grid points in the soil model in the -z-direction
!
! nxndg Number of x grid points for nudging (1 or nx)
! nyndg Number of y grid points for nudging (1 or ny)
! nzndg Number of z grid points for nudging (1 or nz)
!
! OUTPUT:
!
! u x-component of velocity at all time levels (m/s).
! v y-component of velocity at all time levels (m/s).
! w z-component of velocity at all time levels (m/s).
! wcont Contravariant vertical velocity (m/s)
! ptprt Perturbation potential temperature at all time levels (K)
! pprt Perturbation pressure at all time levels (Pascal)
! qv Water vapor specific humidity at all time levels (kg/kg)
! qc Cloud water mixing ratio at all time levels (kg/kg)
! qr Rainwater mixing ratio at all time levels (kg/kg)
! qi Cloud ice mixing ratio at all time levels (kg/kg)
! qs Snow mixing ratio at all time levels (kg/kg)
! qh Hail mixing ratio at all time levels (kg/kg)
! tke Turbulent Kinetic Energy ((m/s)**2)
!
! udteb Time tendency of u field at east boundary (m/s**2)
! udtwb Time tendency of u field at west boundary (m/s**2)
! udtnb Time tendency of u field at north boundary (m/s**2)
! udtsb Time tendency of u field at south boundary (m/s**2)
!
! vdteb Time tendency of v field at east boundary (m/s**2)
! vdtwb Time tendency of v field at west boundary (m/s**2)
! vdtnb Time tendency of v field at north boundary (m/s**2)
! vdtsb Time tendency of v field at south boundary (m/s**2)
!
! wdteb Time tendency of w field at east boundary (m/s**2)
! wdtwb Time tendency of w field at west boundary (m/s**2)
! wdtnb Time tendency of w field at north boundary (m/s**2)
! wdtsb Time tendency of w field at south boundary (m/s**2)
!
! pdteb Time tendency of pprt field at east boundary (PASCAL/s)
! pdtwb Time tendency of pprt field at west boundary (PASCAL/s)
! pdtnb Time tendency of pprt field at north boundary (PASCAL/s)
! pdtsb Time tendency of pprt field at south boundary (PASCAL/s)
!
! sdteb Time tendency of a scalar field at east boundary (m/s**2)
! sdtwb Time tendency of a scalar field at west boundary (m/s**2)
! sdtnb Time tendency of a scalar field at north boundary (m/s**2)
! sdtsb Time tendency of a scalar field at south boundary (m/s**2)
!
! ubar Base state x-velocity component (m/s)
! vbar Base state y-velocity component (m/s)
! ptbar Base state potential temperature (K)
! pbar Base state pressure (Pascal)
! ptbari Inverse Base state potential temperature (K)
! pbari Inverse Base state pressure (Pascal)
! rhostr Base state density rhobar times j3 (kg/m**3)
! rhostri Inverse base state density rhobar times j3 (kg/m**3)
! qvbar Base state water vapor specific humidity (kg/kg).
! ppi Exner function
! csndsq Sound wave speed squared.
!
! x x-coordinate of grid points in computational space (m)
! y y-coordinate of grid points in computational space (m)
! z z-coordinate of grid points in computational space (m)
! zp Vertical coordinate of grid points in physical space (m)
! zpsoil Vertical coordinate of grid points in the soil model
! in physical space (m).
! hterain Terrain height (m)
! mapfct Map factors at scalar, u and v points
!
! j1 Coordinate transformation Jacobian -d(zp)/dx
! j2 Coordinate transformation Jacobian -d(zp)/dy
! j3 Coordinate transformation Jacobian d(zp)/dz
! j3soil Soil coordinate transformation Jacobian d(zpsoil)/dz
! aj3x Avgx of the coordinate transformation Jacobian d(zp)/dz
! aj3y Avgy of the coordinate transformation Jacobian d(zp)/dz
! aj3z Avgz of the coordinate transformation Jacobian d(zp)/dz
! j3inv Inverse of the coordinate transformation j3
! j3soilinv Inverse of the soil coordinate transformation j3soil
!
! trigs1 Array containing pre-computed trig function for fftopt=1.
! trigs2 Array containing pre-computed trig function for fftopt=1.
! ifax1 Array containing the factors of nx for fftopt=1.
! ifax2 Array containing the factors of ny for fftopt=1.
!
! vwork1 2-D work array for fftopt=2 option.
! vwork2 2-D work array for fftopt=2 option.
! wsave1 Work array for fftopt=2 option.
! wsave2 Work array for fftopt=2 option.
!
! sinlat Sin of latitude at each grid point
!
! kmh Horizontal turb. mixing coef. for momentum ( m**2/s )
! kmv Vertical turb. mixing coef. for momentum ( m**2/s )
! rprntl Reciprocal of Prandtl number
!
! soiltyp Soil type
! stypfrct Soil type fraction
! vegtyp Vegetation type
! lai Leaf Area Index
! roufns Surface roughness
! veg Vegetation fraction
!
! tsoil Soil temperature (K)
! qsoil Soil moisture (m**3/m**3)
! wetcanp Canopy water amount
! ptsfc Ground surface potential temperature (K)
! qvsfc Effective S.H. at sfc.
!
! ptcumsrc Source term in pt-equation due to cumulus parameterization
! qcumsrc Source term in water equations due to cumulus parameterization
!
! nca Counter for CAPE release in the Kain-Fritsch scheme
! kfraincv K-F convective precipitation rate
! cldefi BMJ cloud efficiency
! xland BMJ land/sea mask
! bmjraincv BMJ convective precipitation amount
!
! radfrc Radiation forcing (K/s)
! radsw Solar radiation reaching the surface
! rnflx Net absorbed radiation by the surface
! radswnet Net shortwave radiation
! radlwin Incoming longwave radiation
!
! raing Grid supersaturation rain
! rainc Cumulus convective rain
!
! usflx Surface flux of u-momentum (kg/(m*s**2))
! vsflx Surface flux of v-momentum (kg/(m*s**2))
! ptsflx Surface heat flux (K*kg/(m**2 * s ))
! qvsflx Surface moisture flux of (kg/(m**2 * s))
!
! temxy1 Temporary work array
!
! tem1soil Soil model temporary work array.
! tem2soil Soil model temporary work array.
! tem3soil Soil model temporary work array.
! tem4soil Soil model temporary work array.
! tem5soil Soil model temporary work array.
!
! tem1 Temporary work array.
! tem2 Temporary work array.
! tem3 Temporary work array.
! tem4 Temporary work array.
! tem5 Temporary work array.
! tem6 Temporary work array.
! tem7 Temporary work array.
! tem8 Temporary work array.
! tem9 Temporary work array.
! tem10 Temporary work array.
! tem11 Temporary work array.
! tem12 Temporary work array.
! tem13 Temporary work array.
! tem14 Temporary work array.
! tem15 Temporary work array.
! tem16 Temporary work array.
! tem17 Temporary work array.
! tem18 Temporary work array.
! tem19 Temporary work array.
! tem20 Temporary work array.
! tem21 Temporary work array.
! tem22 Temporary work array.
! tem23 Temporary work array.
! tem24 Temporary work array.
! tem25 Temporary work array.
! tem26 Temporary work array.
!
! tem1_0 Temporary work array.
! tem2_0 Temporary work array.
! tem3_0 Temporary work array.
!
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!
! Variable Declarations.
!
!-----------------------------------------------------------------------
!
IMPLICIT NONE
INTEGER :: mptr ! Grid identifier
INCLUDE 'timelvls.inc'
INTEGER :: nx,ny,nz ! The number of grid points in 3 directions
INTEGER :: nzsoil ! Number of grid points in the -z-direction
INTEGER :: nxndg,nyndg,nzndg ! The number of grid points in 3 directions
REAL :: u (nx,ny,nz,nt) ! Total u-velocity (m/s).
REAL :: v (nx,ny,nz,nt) ! Total v-velocity (m/s).
REAL :: w (nx,ny,nz,nt) ! Total w-velocity (m/s).
REAL :: wcont (nx,ny,nz) ! Contravariant vertical velocity (m/s)
REAL :: ptprt (nx,ny,nz,nt) ! Perturbation potential temperature
! from that of base state atmosphere (Kelvin).
REAL :: pprt (nx,ny,nz,nt) ! Perturbation pressure from that
! of base state atmosphere (Pascal).
REAL :: qv (nx,ny,nz,nt) ! Water vapor specific humidity (kg/kg).
REAL :: qc (nx,ny,nz,nt) ! Cloud water mixing ratio (kg/kg).
REAL :: qr (nx,ny,nz,nt) ! Rain water mixing ratio (kg/kg).
REAL :: qi (nx,ny,nz,nt) ! Cloud ice mixing ratio (kg/kg).
REAL :: qs (nx,ny,nz,nt) ! Snow mixing ratio (kg/kg).
REAL :: qh (nx,ny,nz,nt) ! Hail mixing ratio (kg/kg).
REAL :: tke (nx,ny,nz,nt) ! Turbulent Kinetic Energy ((m/s)**2)
REAL :: udteb (ny,nz) ! T-tendency of u at e-boundary (m/s**2)
REAL :: udtwb (ny,nz) ! T-tendency of u at w-boundary (m/s**2)
REAL :: udtnb (nx,nz) ! T-tendency of u at n-boundary (m/s**2)
REAL :: udtsb (nx,nz) ! T-tendency of u at s-boundary (m/s**2)
REAL :: vdteb (ny,nz) ! T-tendency of v at e-boundary (m/s**2)
REAL :: vdtwb (ny,nz) ! T-tendency of v at w-boundary (m/s**2)
REAL :: vdtnb (nx,nz) ! T-tendency of v at n-boundary (m/s**2)
REAL :: vdtsb (nx,nz) ! T-tendency of v at s-boundary (m/s**2)
REAL :: wdteb (ny,nz) ! T-tendency of w at e-boundary (m/s**2)
REAL :: wdtwb (ny,nz) ! T-tendency of w at w-boundary (m/s**2)
REAL :: wdtnb (nx,nz) ! T-tendency of w at n-boundary (m/s**2)
REAL :: wdtsb (nx,nz) ! T-tendency of w at s-boundary (m/s**2)
REAL :: pdteb (ny,nz) ! T-tendency of pprt at e-boundary (PASCAL/s)
REAL :: pdtwb (ny,nz) ! T-tendency of pprt at w-boundary (PASCAL/s)
REAL :: pdtnb (nx,nz) ! T-tendency of pprt at n-boundary (PASCAL/s)
REAL :: pdtsb (nx,nz) ! T-tendency of pprt at s-boundary (PASCAL/s)
REAL :: sdteb (ny,nz) ! T-tendency of w at e-boundary (m/s**2)
REAL :: sdtwb (ny,nz) ! T-tendency of w at w-boundary (m/s**2)
REAL :: sdtnb (nx,nz) ! T-tendency of w at n-boundary (m/s**2)
REAL :: sdtsb (nx,nz) ! T-tendency of w at s-boundary (m/s**2)
REAL :: ubar (nx,ny,nz) ! Base state u-velocity (m/s).
REAL :: vbar (nx,ny,nz) ! Base state v-velocity (m/s).
REAL :: ptbar (nx,ny,nz) ! Base state potential temperature (K)
REAL :: pbar (nx,ny,nz) ! Base state pressure (Pascal).
REAL :: ptbari(nx,ny,nz) ! Inverse Base state pot. temperature (K)
REAL :: pbari (nx,ny,nz) ! Inverse Base state pressure (Pascal).
REAL :: rhostr(nx,ny,nz) ! Base state density rhobar times j3.
REAL :: rhostri(nx,ny,nz) ! Inverse base state density rhobar times j3.
REAL :: qvbar (nx,ny,nz) ! Base state water vapor specific humidity
! (kg/kg).
REAL :: ppi (nx,ny,nz) ! Exner function.
REAL :: csndsq(nx,ny,nz) ! Sound wave speed squared.
REAL :: x (nx) ! The x-coord. of the physical and
! computational grid. Defined at u-point.
REAL :: y (ny) ! The y-coord. of the physical and
! computational grid. Defined at v-point.
REAL :: z (nz) ! The z-coord. of the computational grid.
! Defined at w-point on the staggered grid.
REAL :: zp (nx,ny,nz) ! The physical height coordinate defined at
! w-point on the staggered grid.
REAL :: zpsoil(nx,ny,nzsoil) ! The physical height coordinate defined
! at the center of a soil layer(m).
REAL :: hterain(nx,ny) ! Terrain height (m).
REAL :: mapfct(nx,ny,8) ! Map factors at scalar, u and v points
REAL :: j1 (nx,ny,nz) ! Coordinate transformation Jacobian -d(zp)/dx.
REAL :: j2 (nx,ny,nz) ! Coordinate transformation Jacobian -d(zp)/dy.
REAL :: j3 (nx,ny,nz) ! Coordinate transformation Jacobian d(zp)/dz.
REAL :: j3soil(nx,ny,nzsoil) ! Coordinate transformation Jacobian
! defined as d( zpsoil )/d( zsoil ).
REAL :: aj3x (nx,ny,nz) ! Coordinate transformation Jacobian defined
! as d( zp )/d( z ) AVERAGED IN THE X-DIR.
REAL :: aj3y (nx,ny,nz) ! Coordinate transformation Jacobian defined
! as d( zp )/d( z ) AVERAGED IN THE Y-DIR.
REAL :: aj3z (nx,ny,nz) ! Coordinate transformation Jacobian defined
! as d( zp )/d( z ) AVERAGED IN THE Z-DIR.
REAL :: j3inv (nx,ny,nz) ! Inverse of J3
REAL :: j3soilinv(nx,ny,nzsoil) ! Inverse of J3soil.
REAL :: trigs1(3*(nx-1)/2+1) ! Array containing pre-computed trig
! function for fftopt=1.
REAL :: trigs2(3*(ny-1)/2+1) ! Array containing pre-computed trig
! function for fftopt=1.
INTEGER :: ifax1(13) ! Array containing the factors of nx for
! fftopt=1.
INTEGER :: ifax2(13) ! Array containing the factors of ny for
! fftopt=1.
REAL :: vwork1 (nx+1,ny+1) ! 2-D work array for fftopt=2.
REAL :: vwork2 (ny,nx+1) ! 2-D work array for fftopt=2.
REAL :: wsave1 (3*(ny-1)+15) ! Work array for fftopt=2.
REAL :: wsave2 (3*(nx-1)+15) ! Work array for fftopt=2.
REAL :: sinlat(nx,ny) ! Sin of latitude at each grid point
REAL :: kmh (nx,ny,nz) ! Horizontal turb. mixing coef. for
! momentum. ( m**2/s )
REAL :: kmv (nx,ny,nz) ! Vertical turb. mixing coef. for
! momentum. ( m**2/s )
REAL :: rprntl(nx,ny,nz) ! Reciprocal of Prandtl number
INTEGER :: nstyps ! Number of soil type
INTEGER :: soiltyp(nx,ny,nstyps) ! Soil types at grids
REAL :: stypfrct(nx,ny,nstyps) ! Fraction of soil types
INTEGER :: vegtyp (nx,ny) ! Vegetation type
REAL :: lai (nx,ny) ! Leaf Area Index
REAL :: roufns (nx,ny) ! Surface roughness
REAL :: veg (nx,ny) ! Vegetation fraction
REAL :: tsoil (nx,ny,nzsoil,0:nstyps) ! Soil layer temperature (K)
REAL :: qsoil (nx,ny,nzsoil,0:nstyps) ! Soil layer moisture (m**3/m**3)
REAL :: wetcanp(nx,ny,0:nstyps) ! Canopy water amount
REAL :: snowdpth(nx,ny) ! Snow depth (m)
REAL :: qvsfc (nx,ny,0:nstyps) ! Effective qv at sfc.
REAL :: ptsfc (nx,ny) ! Ground surface potential
! temperature (K)
REAL :: ptcumsrc(nx,ny,nz) ! Source term in pt-equation due
! to cumulus parameterization
REAL :: qcumsrc(nx,ny,nz,5) ! Source term in water equations due
! to cumulus parameterization:
! qcumsrc(1,1,1,1) for qv equation
! qcumsrc(1,1,1,2) for qc equation
! qcumsrc(1,1,1,3) for qr equation
! qcumsrc(1,1,1,4) for qi equation
! qcumsrc(1,1,1,5) for qs equation
REAL :: w0avg(nx,ny,nz) ! a closing running average vertical
! velocity in 10min for K-F scheme
REAL :: kfraincv(nx,ny) ! K-F convective rainfall (cm)
INTEGER :: nca(nx,ny) ! K-F counter for CAPE release
!EMK BMJ
REAL,INTENT(INOUT) :: cldefi(nx,ny) ! BMJ cloud efficiency
REAL,INTENT(INOUT) :: xland(nx,ny) ! BMJ land mask
! (1.0 = land, 2.0 = sea)
REAL,INTENT(INOUT) :: bmjraincv(nx,ny) ! BMJ convective rainfall (cm)
!EMK END
REAL :: radfrc(nx,ny,nz) ! Radiation forcing (K/s)
REAL :: radsw(nx,ny) ! Solar radiation reacing the surface
REAL :: rnflx(nx,ny) ! Net absorbed radiation by the surface
REAL :: radswnet(nx,ny) ! Net shortwave radiation
REAL :: radlwin(nx,ny) ! Incoming longwave radiation
REAL :: raing(nx,ny) ! Grid supersaturation rain
REAL :: rainc(nx,ny) ! Cumulus convective rain
REAL :: prcrate(nx,ny,4) ! precipitation rates (kg/(m**2*s))
! prcrate(1,1,1) = total precipitation rate
! prcrate(1,1,2) = grid scale precip. rate
! prcrate(1,1,3) = cumulus precip. rate
! prcrate(1,1,4) = microphysics precip. rate
REAL :: usflx (nx,ny) ! Surface flux of u-momentum (kg/(m*s**2))
REAL :: vsflx (nx,ny) ! Surface flux of v-momentum (kg/(m*s**2))
REAL :: ptsflx(nx,ny) ! Surface heat flux (K*kg/(m*s**2))
REAL :: qvsflx(nx,ny) ! Surface moisture flux (kg/(m**2*s))
INTEGER :: exbcbufsz ! EXBC buffer size
REAL :: exbcbuf( exbcbufsz ) ! EXBC buffer array
REAL :: bcrlx(nx,ny) ! EXBC relaxation coefficients
REAL :: uincr(nxndg,nyndg,nzndg) ! Analysis increment for u
REAL :: vincr(nxndg,nyndg,nzndg) ! Analysis increment for v
REAL :: wincr(nxndg,nyndg,nzndg) ! Analysis increment for w
REAL :: pincr(nxndg,nyndg,nzndg) ! Analysis increment for p
REAL :: ptincr(nxndg,nyndg,nzndg) ! Analysis increment for pt
REAL :: qvincr(nxndg,nyndg,nzndg) ! Analysis increment for qv
REAL :: qcincr(nxndg,nyndg,nzndg) ! Analysis increment for qc
REAL :: qrincr(nxndg,nyndg,nzndg) ! Analysis increment for qr
REAL :: qiincr(nxndg,nyndg,nzndg) ! Analysis increment for qi
REAL :: qsincr(nxndg,nyndg,nzndg) ! Analysis increment for qs
REAL :: qhincr(nxndg,nyndg,nzndg) ! Analysis increment for qh
REAL :: temxy1(nx,ny) ! Temporary work array
REAL :: tem1soil(nx,ny,nzsoil) ! Temporary soil model work array.
REAL :: tem2soil(nx,ny,nzsoil) ! Temporary soil model work array.
REAL :: tem3soil(nx,ny,nzsoil) ! Temporary soil model work array.
REAL :: tem4soil(nx,ny,nzsoil) ! Temporary soil model work array.
REAL :: tem5soil(nx,ny,nzsoil) ! Temporary soil model work array.
REAL :: tem1 (nx,ny,nz) ! Temporary work array.
REAL :: tem2 (nx,ny,nz) ! Temporary work array.
REAL :: tem3 (nx,ny,nz) ! Temporary work array.
REAL :: tem4 (nx,ny,nz) ! Temporary work array.
REAL :: tem5 (nx,ny,nz) ! Temporary work array.
REAL :: tem6 (nx,ny,nz) ! Temporary work array.
REAL :: tem7 (nx,ny,nz) ! Temporary work array.
REAL :: tem8 (nx,ny,nz) ! Temporary work array.
REAL :: tem9 (nx,ny,nz) ! Temporary work array.
REAL :: tem10 (nx,ny,nz) ! Temporary work array.
REAL :: tem11 (nx,ny,nz) ! Temporary work array.
REAL :: tem12 (nx,ny,nz) ! Temporary work array.
REAL :: tem13 (nx,ny,nz) ! Temporary work array.
REAL :: tem14 (nx,ny,nz) ! Temporary work array.
REAL :: tem15 (nx,ny,nz) ! Temporary work array.
REAL :: tem16 (nx,ny,nz) ! Temporary work array.
REAL :: tem17 (nx,ny,nz) ! Temporary work array.
REAL :: tem18 (nx,ny,nz) ! Temporary work array.
REAL :: tem19 (nx,ny,nz) ! Temporary work array.
REAL :: tem20 (nx,ny,nz) ! Temporary work array.
REAL :: tem21 (nx,ny,nz) ! Temporary work array.
REAL :: tem22 (nx,ny,nz) ! Temporary work array.
REAL :: tem23 (nx,ny,nz) ! Temporary work array.
REAL :: tem24 (nx,ny,nz) ! Temporary work array.
REAL :: tem25 (nx,ny,nz) ! Temporary work array.
REAL :: tem26 (nx,ny,nz) ! Temporary work array.
REAL :: tem1_0(0:nx,0:ny,0:nz) ! Temporary work array.
REAL :: tem2_0(0:nx,0:ny,0:nz) ! Temporary work array.
REAL :: tem3_0(0:nx,0:ny,0:nz) ! Temporary work array.
!
!-----------------------------------------------------------------------
!
! Include files:
!
!-----------------------------------------------------------------------
!
INCLUDE 'globcst.inc'
INCLUDE 'bndry.inc'
INCLUDE 'indtflg.inc'
INCLUDE 'phycst.inc'
INCLUDE 'exbc.inc'
INCLUDE 'nudging.inc'
!
!-----------------------------------------------------------------------
!
! Misc. local variables:
!
!-----------------------------------------------------------------------
!
INTEGER :: i,j
INTEGER :: ireturn
REAL :: tem
!EMK BMJ
LOGICAL :: restart
INTEGER,PARAMETER :: vegwaterflag = 14
INTEGER,PARAMETER :: xland_waterflag = 2
INTEGER,PARAMETER :: xland_landflag = 1
!EMK END
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
mgrid = mptr
grdin = 0
basin = 0
varin = 0
mstin = 0
rainin= 0
prcin = 0
icein = 0
trbin = 0
sfcin = 0
landin= 0
radin = 0
flxin = 0
!wdt update - init0 no longer necessary (arrays set to 0 after allocation)
!
!-----------------------------------------------------------------------
!
! INITialize model array VARiables.
!
!-----------------------------------------------------------------------
!
!EMK BMJ
CALL initgrdvar
(nx,ny,nz,nzsoil,nt,nstyps,exbcbufsz, &
x,y,z,zp,zpsoil,hterain,mapfct, &
j1,j2,j3,j3soil,aj3x,aj3y,aj3z,j3inv,j3soilinv, &
u,v,w,wcont,ptprt,pprt,qv,qc,qr,qi,qs,qh,tke, &
udteb, udtwb, vdtnb, vdtsb, &
pdteb,pdtwb ,pdtnb ,pdtsb, &
trigs1,trigs2,ifax1,ifax2, &
wsave1,wsave2,vwork1,vwork2, &
ubar,vbar,ptbar,pbar,ptbari,pbari, &
rhostr,rhostri,qvbar,ppi,csndsq, &
soiltyp,stypfrct,vegtyp,lai,roufns,veg, &
tsoil,qsoil,wetcanp,snowdpth,qvsfc, &
ptcumsrc,qcumsrc,w0avg,nca,kfraincv, &
cldefi,xland,bmjraincv, &
raing,rainc,prcrate,exbcbuf, &
radfrc,radsw,rnflx,radswnet,radlwin, &
usflx,vsflx,ptsflx,qvsflx, &
tem1soil,tem2soil,tem3soil,tem4soil,tem5soil, &
tem1,tem2,tem3,tem4,tem5, &
tem6,tem7,tem8,tem9)
DO j=1,ny-1
DO i=1,nx-1
tem = 0.5 * ( pprt(i,j,1,2)+pbar(i,j,1) &
+ pprt(i,j,2,2)+pbar(i,j,2) )
ptsfc(i,j)=tsoil(i,j,1,0)*(p0/tem)**rddcp
END DO
END DO
!
!-----------------------------------------------------------------------
!
! Calculate the sin of the lattitude of each grid point, to be used
! in the calculation of latitude-dependent Coriolis parameters.
!
!-----------------------------------------------------------------------
!
CALL gtsinlat(nx,ny,x,y, sinlat, tem1,tem2, tem3)
!
!-----------------------------------------------------------------------
!
! Initialize arrays that store the lookup table data.
!
!-----------------------------------------------------------------------
!
CALL initlktb
!
!-----------------------------------------------------------------------
!
! Initialize the external boundary data array.
!
!-----------------------------------------------------------------------
!
IF( lbcopt == 2 .AND. mptr == 1 ) THEN
ireturn = 0
! DBW question why not soil model variables as well????
CALL extbdtini(nx,ny,nz, &
u,v,w,ptprt,pprt, &
qv,qc,qr,qi,qs,qh,ptbar,pbar, &
exbcbuf(nu0exb), exbcbuf(nv0exb), &
exbcbuf(nw0exb), exbcbuf(npt0exb), &
exbcbuf(npr0exb), exbcbuf(nqv0exb), &
exbcbuf(nqc0exb), exbcbuf(nqr0exb), &
exbcbuf(nqi0exb), exbcbuf(nqs0exb), &
exbcbuf(nqh0exb), exbcbuf(nudtexb), &
exbcbuf(nvdtexb), exbcbuf(nwdtexb), &
exbcbuf(nptdtexb),exbcbuf(nprdtexb), &
exbcbuf(nqvdtexb),exbcbuf(nqcdtexb), &
exbcbuf(nqrdtexb),exbcbuf(nqidtexb), &
exbcbuf(nqsdtexb),exbcbuf(nqhdtexb), &
bcrlx, &
tem1,tem2,tem3,tem4,tem5,tem6, &
tem7,tem8,tem9,tem10,tem11,ireturn)
IF( ireturn == 1 ) THEN
WRITE (6,'(a/a)') &
'Can not find the external boundary data. Dump the', &
'history file and restart file and then STOP the model.'
CALL arpsstop('arpsstop called from initial with ext boundary file',1)
ELSE IF( ireturn == 2 ) THEN
WRITE (6,'(a/a)') &
'Can not open the external boundary data. Dump the history', &
'file and restart file and then STOP the model.'
CALL arpsstop('arpsstop called from initial with opening ext &
& boundary file ',1)
ELSE IF( ireturn == 3 ) THEN
WRITE (6,'(a/a)') &
'Read errors in the external boundary data file. Dump the', &
'history file and restart file and then STOP the model.'
CALL arpsstop('arpsstop called from initial with reading ext &
& boundary file ',1)
ELSE IF( ireturn /= 0 ) THEN
WRITE (6,'(a/a)') &
'Other errors in getting the external boundary data. Dump the', &
'history file and restart file and then STOP the model.'
CALL arpsstop('arpsstop called from initial with the ext &
& boundary file ',1)
END IF
END IF
!
!-----------------------------------------------------------------------
!
! Initialize nudging assimilation variables
!
!-----------------------------------------------------------------------
!
IF( nudgopt > 0 ) &
CALL ininudge(nxndg,nyndg,nzndg, &
uincr,vincr,wincr,pincr,ptincr,qvincr, &
qcincr,qrincr,qiincr,qsincr,qhincr,ireturn)
!-----------------------------------------------------------------------
!
! Initialize KF_ETA arrays and look-up tables.
!
!-----------------------------------------------------------------------
!KFY KF_ETA
IF (cnvctopt == 5) THEN
!...Now initialize KF_ETA look-up tables
IF (initopt == 2 .or. initopt == 4) THEN
restart = .TRUE.
ELSE
restart = .FALSE.
END IF
CALL interface_wrf_kfinit(nx,ny,nz,nca,restart)
END IF ! IF (cnvctopt == 5) THEN
!KFY KF_ETA END
!-----------------------------------------------------------------------
!
! Initialize BMJ arrays and look-up tables.
!
!-----------------------------------------------------------------------
!EMK BMJ
IF (cnvctopt == 4) THEN
DO j = 1,ny-1
DO i = 1,nx-1
IF (vegtyp(i,j) == vegwaterflag) THEN
xland(i,j) = xland_waterflag
ELSE
xland(i,j) = xland_landflag
END IF
END DO ! DO i = 1,nx
END DO ! DO j = 1,ny
!...Now initialize BMJ look-up tables
IF (initopt == 2 .or. initopt == 4) THEN
restart = .TRUE.
ELSE
restart = .FALSE.
END IF
CALL interface_wrf_bmjinit(nx,ny,nz,cldefi,restart)
END IF ! IF (cnvctopt == 4) THEN
!EMK END
!
!-----------------------------------------------------------------------
!
! End of model initialization.
!
!-----------------------------------------------------------------------
!
RETURN
END SUBROUTINE initial