!########################################################################
!########################################################################
!######### #########
!######### SUBROUTINE interface_wrf_bmjdrv #########
!######### #########
!######### Developed by #########
!######### Center for Analysis and Prediction of Storms #########
!######### University of Oklahoma #########
!######### #########
!########################################################################
!########################################################################
SUBROUTINE interface_wrf_bmjdrv(nx,ny,nz,pprt,ptprt,qv,pbar,ptbar,zp, &,2
ptcumsrc,qcumsrc,bmjraincv,prcrate, &
cldefi,xland)
!------------------------------------------------------------------------
!
! PURPOSE:
!
! Interfaces with the WRF version of the Betts-Miller-Janjic convective
! adjustment scheme.
!
!------------------------------------------------------------------------
!
! AUTHOR: Eric Kemp, 10 October 2001
!
! MODIFICATION HISTORY:
!
! Eric Kemp, 1 November 2001. Fixed dimension error with array wrf_t.
!
! Eric Kemp, 12 March 2002. Removed lowlyr array from argument list.
! Replaced with new automatic array wrf_lowlyr.
!
!------------------------------------------------------------------------
!
! Use WRF Betts-Miller-Janjic module.
!
!------------------------------------------------------------------------
USE module_cu_bmj
!------------------------------------------------------------------------
!
! Force explicit declarations.
!
!------------------------------------------------------------------------
IMPLICIT NONE
!------------------------------------------------------------------------
!
! List include files.
!
!------------------------------------------------------------------------
INCLUDE 'globcst.inc'
INCLUDE 'grid.inc'
INCLUDE 'phycst.inc'
!------------------------------------------------------------------------
!
! Arguments.
!
!------------------------------------------------------------------------
INTEGER,INTENT(IN) :: nx,ny,nz ! Grid dimensions.
REAL,INTENT(IN) :: pprt(nx,ny,nz) ! Perturbation pressure (Pa).
REAL,INTENT(IN) :: ptprt(nx,ny,nz) ! Perturbation potential
! temperature (K).
REAL,INTENT(IN) :: qv(nx,ny,nz) ! Specific humidity (kg/kg).
REAL,INTENT(IN) :: pbar(nx,ny,nz) ! Base-state pressure (Pa).
REAL,INTENT(IN) :: ptbar(nx,ny,nz) ! Base-state potential
! temperature (K).
REAL,INTENT(IN) :: zp(nx,ny,nz) ! Height at w-points (m).
REAL,INTENT(INOUT) :: ptcumsrc(nx,ny,nz) ! Potential temperature
! tendency.
REAL,INTENT(INOUT) :: qcumsrc(nx,ny,nz,5)! Moisture tendencies.
! qcumsrc(1,1,1,1) for qv
! qcumsrc(1,1,1,2) for qc
! qcumsrc(1,1,1,3) for qr
! qcumsrc(1,1,1,4) for qi
! qcumsrc(1,1,1,5) for qs
REAL,INTENT(INOUT) :: bmjraincv(nx,ny) ! BMJ rainfall (cm).
REAL,INTENT(INOUT) :: prcrate(nx,ny) ! Precipitation rate (mm/s)
REAL,INTENT(INOUT) :: cldefi(nx,ny) ! Cloud efficiency
! (dimensionless).
REAL,INTENT(IN) :: xland(nx,ny) ! Land-sea mask (1.0 for land;
! 2.0 for water)
!------------------------------------------------------------------------
!
! WRF 3-D arrays (dimensioned i,k,j).
!
!------------------------------------------------------------------------
REAL :: wrf_rr(nx,nz,ny) ! Dry air density (kg/m^3)
REAL :: wrf_rthcuten(nx,nz,ny) ! Rho_dTheta_m tendency due to
! cumulus scheme
! precipitation
! (kg/m^3 . K)
REAL :: wrf_rqvcuten(nx,nz,ny) ! Rho_dQv tendency due to
! cumulus scheme
! precipitation
! (kg/m^3 . kg/kg)
REAL :: wrf_th(nx,nz,ny) ! Potential temperature (K)
REAL :: wrf_t(nx,nz,ny) ! Temperature (K)
REAL :: wrf_qvmix(nx,nz,ny) ! Water vapor mixing ratio
! (kg/kg)
REAL :: wrf_pint(nx,nz,ny) ! Pressure at w-points (Pa)
REAL :: wrf_pmid(nx,nz,ny) ! Pressure (Pa)
REAL :: wrf_pi(nx,nz,ny) ! Exner function
! (dimensionless)
REAL :: wrf_rho(nx,nz,ny) ! Density (kg/m^3)
REAL :: wrf_dz8w(nx,nz,ny) ! dz between full levels (m)
!------------------------------------------------------------------------
!
! Other local arrays and variables.
!
!------------------------------------------------------------------------
INTEGER :: wrf_lowlyr(nx,ny) ! Index of lowest model level.
REAL :: wrf_raincv(nx,ny) ! Cumulus scheme
! precipitation (mm)
INTEGER :: ids,ide,jds,jde,kds,kde, &
ims,ime,jms,jme,kms,kme, &
its,ite,jts,jte,kts,kte
INTEGER :: itimestep ! Number of timestep.
INTEGER :: stepcu ! Number of fundamental
! timesteps between
! convection calls.
REAL :: d608 ! rvovrd - 1.
INTEGER :: i,j,k
REAL :: qvcumsrctmp,ptcumsrctmp
!------------------------------------------------------------------------
!
! Local parameters.
!
!------------------------------------------------------------------------
REAL,PARAMETER :: trfz = 273.15 ! Freezing point (273.15 K)
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
wrf_lowlyr(:,:) = 2
wrf_raincv(:,:) = 0
!------------------------------------------------------------------------
!
! Set the WRF "domain," "memory," and "tile" dimensions based on the
! ARPS dimensions.
!
!------------------------------------------------------------------------
CALL interface_wrf_dims(nx,ny,nz, &
ids,ide,jds,jde,kds,kde, &
ims,ime,jms,jme,kms,kme, &
its,ite,jts,jte,kts,kte)
!------------------------------------------------------------------------
!
! Set several scalar arguments.
!
!------------------------------------------------------------------------
d608 = rvdrd - 1.
stepcu = confrq/dtbig ! Number of actual time steps per convection
! time step.
itimestep = (curtim-tstart)/dtbig ! Current actual time step.
!------------------------------------------------------------------------
!
! Fill WRF 3-D arrays. Note that WRF arrays are indexed i,k,j.
!
!------------------------------------------------------------------------
DO k = 1,nz-1
DO j = 1,ny-1
DO i = 1,nx-1
wrf_pmid(i,k,j) = pprt(i,j,k) + pbar(i,j,k)
wrf_pi(i,k,j) = (wrf_pmid(i,k,j)*1.0E-5)**rddcp
wrf_th(i,k,j) = ptprt(i,j,k) + ptbar(i,j,k)
wrf_t(i,k,j) = wrf_th(i,k,j)*wrf_pi(i,k,j)
wrf_rr(i,k,j) = wrf_pmid(i,k,j)/(rd*wrf_t(i,k,j)) ! Dry air
! density.
wrf_qvmix(i,k,j) = MAX(0.,qv(i,j,k)/(1. - qv(i,j,k)))
wrf_rho(i,k,j) = wrf_rr(i,k,j)/(1. + 0.608*wrf_qvmix(i,k,j))
wrf_dz8w(i,k,j) = zp(i,j,k+1) - zp(i,j,k)
END DO ! DO i = 1,nx-1
END DO ! DO j = 1,ny-1
END DO ! DO k = 1,nz-1
wrf_pint(:,:,:) = wrf_pmid(:,:,:) ! Not actually used by WRF code,
! but passed as argument.
!------------------------------------------------------------------------
!
! Call WRF Betts-Miller-Janjic code.
!
!------------------------------------------------------------------------
CALL bmjdrv(dtbig,itimestep,stepcu,wrf_rr,wrf_rthcuten,wrf_rqvcuten, &
wrf_raincv,wrf_th,wrf_t,wrf_qvmix,wrf_pint,wrf_pmid, &
wrf_pi,wrf_rho,wrf_dz8w,cp,rd,rvdrd,lathv, &
g,trfz,d608,cldefi,wrf_lowlyr,xland, &
ids,ide,jds,jde,kds,kde, &
ims,ime,jms,jme,kms,kme, &
its,ite,jts,jte,kts,kte)
!------------------------------------------------------------------------
!
! Save precipitation rate and accumulation.
!
!------------------------------------------------------------------------
prcrate(:,:) = wrf_raincv(:,:)/dtbig ! mm to mm/s
bmjraincv(:,:) = wrf_raincv(:,:)*1.E-1 ! mm to cm
!------------------------------------------------------------------------
!
! Convert rho_dthetam_dt and rho_dqvmix_dt to dtheta_dt and dqv_dt.
!
!------------------------------------------------------------------------
DO k = 2,nz-2
DO j = 1,ny-1
DO i = 1,nx-1
qvcumsrctmp = wrf_rqvcuten(i,k,j)* &
(1. - (wrf_qvmix(i,k,j)*wrf_qvmix(i,k,j)))/ &
(wrf_rr(i,k,j))
qcumsrc(i,j,k,1) = qcumsrc(i,j,k,1) + qvcumsrctmp
ptcumsrctmp = (wrf_rthcuten(i,k,j)/wrf_rr(i,k,j)) - &
(rvdrd*wrf_th(i,k,j)*qvcumsrctmp)
ptcumsrctmp = ptcumsrctmp / &
(1. + (rvdrd*wrf_qvmix(i,k,j)))
ptcumsrc(i,j,k) = ptcumsrc(i,j,k) + ptcumsrctmp
END DO ! DO i = 1,nx-1
END DO ! DO j = 1,ny-1
END DO ! DO k = 2,nz-2
!------------------------------------------------------------------------
!
! The end.
!
!------------------------------------------------------------------------
RETURN
END SUBROUTINE interface_wrf_bmjdrv
!########################################################################
!########################################################################
!######### #########
!######### SUBROUTINE interface_wrf_bmjinit #########
!######### #########
!######### Developed by #########
!######### Center for Analysis and Prediction of Storms #########
!######### University of Oklahoma #########
!######### #########
!########################################################################
!########################################################################
SUBROUTINE interface_wrf_bmjinit(nx,ny,nz,cldefi,restart),2
!------------------------------------------------------------------------
!
! PURPOSE:
!
! Initializes variables and look-up tables used by the WRF version of
! the Betts-Miller-Janjic convective adjustment scheme.
!
!------------------------------------------------------------------------
!
! AUTHOR: Eric Kemp, 12 October 2001
!
! MODIFICATION HISTORY:
!
! Eric Kemp, 12 March 2002. Removed lowlyr array.
!
!------------------------------------------------------------------------
!
! Use WRF Betts-Miller-Janjic module.
!
!------------------------------------------------------------------------
USE module_cu_bmj
!------------------------------------------------------------------------
!
! Force explicit declarations.
!
!------------------------------------------------------------------------
IMPLICIT NONE
!------------------------------------------------------------------------
!
! List include files.
!
!------------------------------------------------------------------------
INCLUDE 'phycst.inc'
!------------------------------------------------------------------------
!
! Declare arguments.
!
!------------------------------------------------------------------------
INTEGER,INTENT(IN) :: nx,ny,nz ! Grid dimensions
LOGICAL,INTENT(IN) :: restart ! Restart flag
REAL,INTENT(INOUT) :: cldefi(nx,ny) ! BMJ cloud efficiency.
!------------------------------------------------------------------------
!
! Local variables. Note that the arrays, while passed as arguments
! to the BMJ code, are not actually used by ARPS. Also, the 3-D
! arrays are dimensioned i,k,j.
!
!------------------------------------------------------------------------
REAL :: wrf_rthcuten(nx,nz,ny)
REAL :: wrf_rqvcuten(nx,nz,ny)
REAL :: wrf_rqccuten(nx,nz,ny)
REAL :: wrf_rqrcuten(nx,nz,ny)
INTEGER :: wrf_lowlyr(nx,ny)
INTEGER :: ids,ide,jds,jde,kds,kde, &
ims,ime,jms,jme,kms,kme, &
its,ite,jts,jte,kts,kte
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!------------------------------------------------------------------------
!
! Set the WRF "domain," "memory," and "tile" dimensions based on the
! ARPS dimensions.
!
!------------------------------------------------------------------------
CALL interface_wrf_dims(nx,ny,nz, &
ids,ide,jds,jde,kds,kde, &
ims,ime,jms,jme,kms,kme, &
its,ite,jts,jte,kts,kte)
!------------------------------------------------------------------------
!
! Call WRF Betts-Miller-Janjic initializer.
!
!------------------------------------------------------------------------
CALL bmjinit(wrf_rthcuten,wrf_rqvcuten,wrf_rqccuten,wrf_rqrcuten, &
cldefi,wrf_lowlyr,cp,rd,restart, &
ids,ide,jds,jde,kds,kde, &
ims,ime,jms,jme,kms,kme, &
its,ite,jts,jte,kts,kte)
!------------------------------------------------------------------------
!
! The end.
!
!------------------------------------------------------------------------
RETURN
END SUBROUTINE interface_wrf_bmjinit
!########################################################################
!########################################################################
!######### #########
!######### SUBROUTINE interface_wrf_dims #########
!######### #########
!######### Developed by #########
!######### Center for Analysis and Prediction of Storms #########
!######### University of Oklahoma #########
!######### #########
!########################################################################
!########################################################################
SUBROUTINE interface_wrf_dims(nx,ny,nz, &
ids,ide,jds,jde,kds,kde, &
ims,ime,jms,jme,kms,kme, &
its,ite,jts,jte,kts,kte)
!------------------------------------------------------------------------
!
! PURPOSE:
!
! Assigns WRF "domain," "memory," and "tile" dimensions based on ARPS
! dimensions.
!
!------------------------------------------------------------------------
!
! AUTHOR: Eric Kemp, 11 October 2001
!
!------------------------------------------------------------------------
!
! Force explicit declarations.
!
!------------------------------------------------------------------------
IMPLICIT NONE
!------------------------------------------------------------------------
!
! Arguments
!
!------------------------------------------------------------------------
INTEGER,INTENT(IN) :: nx,ny,nz ! ARPS grid dimensions
INTEGER,INTENT(OUT) :: ids,ide,jds,jde,kds,kde ! WRF "domain" dims.
INTEGER,INTENT(OUT) :: ims,ime,jms,jme,kms,kme ! WRF "memory" dims.
INTEGER,INTENT(OUT) :: its,ite,jts,jte,kts,kte ! WRF "tile" dims.
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!------------------------------------------------------------------------
!
! The "domain" dimensions, while passed as arguments, are not actually
! used by the WRF BMJ scheme.
!
!------------------------------------------------------------------------
ids = 1
ide = nx
jds = 1
jde = ny
kds = 1
kde = nz-2
!------------------------------------------------------------------------
!
! The "memory" dimensions are used to allocate the 3-D and 2-D argument
! arrays in the WRF BMJ code.
!
!------------------------------------------------------------------------
ims = 1
ime = nx
jms = 1
jme = ny
kms = 1
kme = nz
!------------------------------------------------------------------------
!
! The "tile" dimensions are used to allocate the 1-D arrays and are
! used as constraints for the DO loops in the WRF BMJ code.
! Also, KTE + 1 = KME.
!
!------------------------------------------------------------------------
its = 1
ite = nx-1
jts = 1
jte = ny-1
kts = 1
kte = nz-3
! kts = 2
! kte = nz-1
!------------------------------------------------------------------------
!
! The end.
!
!------------------------------------------------------------------------
RETURN
END SUBROUTINE interface_wrf_dims