nilyin
/
wrf-python
forked from 3rdparty/wrf-python
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

Moved work arrays out of fortran. Fixes #47

lon0
Bill Ladwig 7 years ago
parent
6564b3c0e3
commit
71fe678e91
4 changed files with 58 additions and 27 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 28
      fortran/rip_cape.f90
  2. 6
      fortran/wrf_fctt.f90
  3. 6
      fortran/wrf_vinterp.f90
  4. 19
      src/wrf/extension.py

28
fortran/rip_cape.f90
Unescape View File

@ -272,6 +272,7 @@ END SUBROUTINE DPFCALC
! NCLFORTSTART ! NCLFORTSTART
SUBROUTINE DCAPECALC3D(prs,tmk,qvp,ght,ter,sfp,cape,cin,& SUBROUTINE DCAPECALC3D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
prsf, prs_new, tmk_new, qvp_new, ght_new,&
cmsg,mix,mjy,mkzh,ter_follow,& cmsg,mix,mjy,mkzh,ter_follow,&
psafile, errstat, errmsg) psafile, errstat, errmsg)
USE wrf_constants, ONLY : CELKEL, G, EZERO, ESLCON1, ESLCON2, & USE wrf_constants, ONLY : CELKEL, G, EZERO, ESLCON1, ESLCON2, &
@ -293,6 +294,14 @@ SUBROUTINE DCAPECALC3D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
REAL(KIND=8), DIMENSION(mix,mjy), INTENT(IN) ::sfp REAL(KIND=8), DIMENSION(mix,mjy), INTENT(IN) ::sfp
REAL(KIND=8), DIMENSION(mix,mjy,mkzh), INTENT(OUT) :: cape REAL(KIND=8), DIMENSION(mix,mjy,mkzh), INTENT(OUT) :: cape
REAL(KIND=8), DIMENSION(mix,mjy,mkzh), INTENT(OUT) :: cin REAL(KIND=8), DIMENSION(mix,mjy,mkzh), INTENT(OUT) :: cin
REAL(KIND=8), DIMENSION(mkzh,mix,mjy), INTENT(INOUT) :: prsf
REAL(KIND=8), DIMENSION(mkzh,mix,mjy), INTENT(INOUT) :: prs_new
REAL(KIND=8), DIMENSION(mkzh,mix,mjy), INTENT(INOUT) :: tmk_new
REAL(KIND=8), DIMENSION(mkzh,mix,mjy), INTENT(INOUT) :: qvp_new
REAL(KIND=8), DIMENSION(mkzh,mix,mjy), INTENT(INOUT) :: ght_new
REAL(KIND=8), INTENT(IN) :: cmsg REAL(KIND=8), INTENT(IN) :: cmsg
CHARACTER(LEN=*), INTENT(IN) :: psafile CHARACTER(LEN=*), INTENT(IN) :: psafile
INTEGER, INTENT(INOUT) :: errstat INTEGER, INTENT(INOUT) :: errstat
@ -308,15 +317,10 @@ SUBROUTINE DCAPECALC3D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
REAL(KIND=8) :: eslift, tmkenv, qvpenv, tonpsadiabat REAL(KIND=8) :: eslift, tmkenv, qvpenv, tonpsadiabat
REAL(KIND=8) :: benamin, dz REAL(KIND=8) :: benamin, dz
REAL(KIND=8), DIMENSION(150) :: buoy, zrel, benaccum REAL(KIND=8), DIMENSION(150) :: buoy, zrel, benaccum
REAL(KIND=8), DIMENSION(mkzh,mix,mjy) :: prsf
REAL(KIND=8), DIMENSION(150) :: psadithte, psadiprs REAL(KIND=8), DIMENSION(150) :: psadithte, psadiprs
REAL(KIND=8), DIMENSION(150,150) :: psaditmk REAL(KIND=8), DIMENSION(150,150) :: psaditmk
LOGICAL :: elfound LOGICAL :: elfound
REAL(KIND=8), DIMENSION(mkzh,mix,mjy) :: prs_new
REAL(KIND=8), DIMENSION(mkzh,mix,mjy) :: tmk_new
REAL(KIND=8), DIMENSION(mkzh,mix,mjy) :: qvp_new
REAL(KIND=8), DIMENSION(mkzh,mix,mjy) :: ght_new
! To remove compiler warnings ! To remove compiler warnings
tmkpari = 0 tmkpari = 0
@ -597,6 +601,7 @@ END SUBROUTINE DCAPECALC3D
! NCLFORTSTART ! NCLFORTSTART
SUBROUTINE DCAPECALC2D(prs,tmk,qvp,ght,ter,sfp,cape,cin,& SUBROUTINE DCAPECALC2D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
prsf, prs_new, tmk_new, qvp_new, ght_new,&
cmsg,mix,mjy,mkzh,ter_follow,& cmsg,mix,mjy,mkzh,ter_follow,&
psafile, errstat, errmsg) psafile, errstat, errmsg)
USE wrf_constants, ONLY : CELKEL, G, EZERO, ESLCON1, ESLCON2, & USE wrf_constants, ONLY : CELKEL, G, EZERO, ESLCON1, ESLCON2, &
@ -618,6 +623,13 @@ SUBROUTINE DCAPECALC2D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
REAL(KIND=8), DIMENSION(mix,mjy), INTENT(IN) ::sfp REAL(KIND=8), DIMENSION(mix,mjy), INTENT(IN) ::sfp
REAL(KIND=8), DIMENSION(mix,mjy,mkzh), INTENT(OUT) :: cape REAL(KIND=8), DIMENSION(mix,mjy,mkzh), INTENT(OUT) :: cape
REAL(KIND=8), DIMENSION(mix,mjy,mkzh), INTENT(OUT) :: cin REAL(KIND=8), DIMENSION(mix,mjy,mkzh), INTENT(OUT) :: cin
REAL(KIND=8), DIMENSION(mkzh,mix,mjy), INTENT(INOUT) :: prsf
REAL(KIND=8), DIMENSION(mkzh,mix,mjy), INTENT(INOUT) :: prs_new
REAL(KIND=8), DIMENSION(mkzh,mix,mjy), INTENT(INOUT) :: tmk_new
REAL(KIND=8), DIMENSION(mkzh,mix,mjy), INTENT(INOUT) :: qvp_new
REAL(KIND=8), DIMENSION(mkzh,mix,mjy), INTENT(INOUT) :: ght_new
REAL(KIND=8), INTENT(IN) :: cmsg REAL(KIND=8), INTENT(IN) :: cmsg
CHARACTER(LEN=*), INTENT(IN) :: psafile CHARACTER(LEN=*), INTENT(IN) :: psafile
INTEGER, INTENT(INOUT) :: errstat INTEGER, INTENT(INOUT) :: errstat
@ -635,15 +647,11 @@ SUBROUTINE DCAPECALC2D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
REAL(KIND=8) :: eslift, tmkenv, qvpenv, tonpsadiabat REAL(KIND=8) :: eslift, tmkenv, qvpenv, tonpsadiabat
REAL(KIND=8) :: benamin, dz, pup, pdn REAL(KIND=8) :: benamin, dz, pup, pdn
REAL(KIND=8), DIMENSION(150) :: buoy, zrel, benaccum REAL(KIND=8), DIMENSION(150) :: buoy, zrel, benaccum
REAL(KIND=8), DIMENSION(mkzh,mix,mjy) :: prsf
REAL(KIND=8), DIMENSION(150) :: psadithte, psadiprs REAL(KIND=8), DIMENSION(150) :: psadithte, psadiprs
REAL(KIND=8), DIMENSION(150,150) :: psaditmk REAL(KIND=8), DIMENSION(150,150) :: psaditmk
LOGICAL :: elfound LOGICAL :: elfound
REAL(KIND=8), DIMENSION(mkzh) :: eth_temp REAL(KIND=8), DIMENSION(mkzh) :: eth_temp
REAL(KIND=8), DIMENSION(mkzh,mix,mjy) :: prs_new
REAL(KIND=8), DIMENSION(mkzh,mix,mjy) :: tmk_new
REAL(KIND=8), DIMENSION(mkzh,mix,mjy) :: qvp_new
REAL(KIND=8), DIMENSION(mkzh,mix,mjy) :: ght_new
! To remove compiler warnings ! To remove compiler warnings
errstat = 0 errstat = 0

6
fortran/wrf_fctt.f90
Unescape View File

@ -1,5 +1,5 @@
!NCLFORTSTART !NCLFORTSTART
SUBROUTINE wrfcttcalc(prs, tk, qci, qcw, qvp, ght, ter, ctt, haveqci, nz, ns, ew) SUBROUTINE wrfcttcalc(prs, tk, qci, qcw, qvp, ght, ter, ctt, pf, haveqci, nz, ns, ew)
USE wrf_constants, ONLY : EPS, USSALR, RD, G, ABSCOEFI, ABSCOEF, CELKEL USE wrf_constants, ONLY : EPS, USSALR, RD, G, ABSCOEFI, ABSCOEF, CELKEL
IMPLICIT NONE IMPLICIT NONE
@ -12,6 +12,8 @@ SUBROUTINE wrfcttcalc(prs, tk, qci, qcw, qvp, ght, ter, ctt, haveqci, nz, ns, ew
REAL(KIND=8), DIMENSION(ew,ns), INTENT(IN) :: ter REAL(KIND=8), DIMENSION(ew,ns), INTENT(IN) :: ter
REAL(KIND=8), DIMENSION(ew,ns), INTENT(OUT) :: ctt REAL(KIND=8), DIMENSION(ew,ns), INTENT(OUT) :: ctt
REAL(KIND=8), DIMENSION(ew,ns,nz), INTENT(INOUT) :: pf
!NCLEND !NCLEND
! REAL(KIND=8) :: znfac(nz) ! REAL(KIND=8) :: znfac(nz)
@ -20,7 +22,7 @@ SUBROUTINE wrfcttcalc(prs, tk, qci, qcw, qvp, ght, ter, ctt, haveqci, nz, ns, ew
INTEGER i,j,k,ripk INTEGER i,j,k,ripk
REAL(KIND=8) :: opdepthu, opdepthd, dp, arg1, fac, prsctt, ratmix REAL(KIND=8) :: opdepthu, opdepthd, dp, arg1, fac, prsctt, ratmix
REAL(KIND=8) :: arg2, agl_hgt, vt REAL(KIND=8) :: arg2, agl_hgt, vt
REAL(KIND=8), DIMENSION(ew,ns,nz) :: pf
REAL(KIND=8) :: p1, p2 REAL(KIND=8) :: p1, p2
!$OMP PARALLEL !$OMP PARALLEL

6
fortran/wrf_vinterp.f90
Unescape View File

@ -127,7 +127,7 @@ END FUNCTION wrf_intrp_value
!NCLFORTSTART !NCLFORTSTART
SUBROUTINE wrf_vintrp(datain, dataout, pres, tk, qvp, ght, terrain,& SUBROUTINE wrf_vintrp(datain, dataout, pres, tk, qvp, ght, terrain,&
sfp, smsfp, vcarray, interp_levels, numlevels,& sfp, smsfp, vcarray, interp_levels, numlevels,&
icase, ew, ns, nz, extrap, vcor, logp, rmsg,& icase, ew, ns, nz, extrap, vcor, logp, tempout, rmsg,&
errstat, errmsg) errstat, errmsg)
USE wrf_constants, ONLY : ALGERR, SCLHT, EXPON, EXPONI, GAMMA, GAMMAMD, TLCLC1, & USE wrf_constants, ONLY : ALGERR, SCLHT, EXPON, EXPONI, GAMMA, GAMMAMD, TLCLC1, &
TLCLC2, TLCLC3, TLCLC4, THTECON1, THTECON2, THTECON3, & TLCLC2, TLCLC3, TLCLC4, THTECON1, THTECON2, THTECON3, &
@ -146,6 +146,9 @@ SUBROUTINE wrf_vintrp(datain, dataout, pres, tk, qvp, ght, terrain,&
REAL(KIND=8), DIMENSION(ew,ns,numlevels), INTENT(OUT) :: dataout REAL(KIND=8), DIMENSION(ew,ns,numlevels), INTENT(OUT) :: dataout
REAL(KIND=8), DIMENSION(ew,ns,nz), INTENT(IN) :: vcarray REAL(KIND=8), DIMENSION(ew,ns,nz), INTENT(IN) :: vcarray
REAL(KIND=8), DIMENSION(numlevels), INTENT(IN) :: interp_levels REAL(KIND=8), DIMENSION(numlevels), INTENT(IN) :: interp_levels
REAL(KIND=8), DIMENSION(ew,ns), INTENT(INOUT) :: tempout
REAL(KIND=8), INTENT(IN) :: rmsg REAL(KIND=8), INTENT(IN) :: rmsg
INTEGER, INTENT(INOUT) :: errstat INTEGER, INTENT(INOUT) :: errstat
CHARACTER(LEN=*), INTENT(INOUT) :: errmsg CHARACTER(LEN=*), INTENT(INOUT) :: errmsg
@ -156,7 +159,6 @@ SUBROUTINE wrf_vintrp(datain, dataout, pres, tk, qvp, ght, terrain,&
INTEGER :: i, j, k, kupper !itriv INTEGER :: i, j, k, kupper !itriv
INTEGER :: ifound, isign !miy,mjx INTEGER :: ifound, isign !miy,mjx
INTEGER :: log_errcnt, interp_errcnt, interp_errstat INTEGER :: log_errcnt, interp_errcnt, interp_errstat
REAL(KIND=8), DIMENSION(ew,ns) :: tempout
REAL(KIND=8) :: rlevel, vlev, diff REAL(KIND=8) :: rlevel, vlev, diff
REAL(KIND=8) :: tmpvlev REAL(KIND=8) :: tmpvlev
REAL(KIND=8) :: vcp1, vcp0, valp0, valp1 REAL(KIND=8) :: vcp1, vcp0, valp0, valp1

19
src/wrf/extension.py
Unescape View File

@ -618,6 +618,14 @@ def _cape(p_hpa, tk, qv, ht, ter, sfp, missing, i3dflag, ter_follow,
else: else:
cape_routine = dcapecalc2d cape_routine = dcapecalc2d
# Work arrays
k_left_shape = (p_hpa.shape[2], p_hpa.shape[0], p_hpa.shape[1])
prsf = np.empty(k_left_shape, np.float64, order="F")
prs_new = np.empty(k_left_shape, np.float64, order="F")
tmk_new = np.empty(k_left_shape, np.float64, order="F")
qvp_new = np.empty(k_left_shape, np.float64, order="F")
ght_new = np.empty(k_left_shape, np.float64, order="F")
# note that p_hpa, tk, qv, and ht have the vertical flipped # note that p_hpa, tk, qv, and ht have the vertical flipped
result = cape_routine(p_hpa, result = cape_routine(p_hpa,
tk, tk,
@ -627,6 +635,11 @@ def _cape(p_hpa, tk, qv, ht, ter, sfp, missing, i3dflag, ter_follow,
sfp, sfp,
capeview, capeview,
cinview, cinview,
prsf,
prs_new,
tmk_new,
qvp_new,
ght_new,
missing, missing,
ter_follow, ter_follow,
psafile, psafile,
@ -766,6 +779,8 @@ def _ctt(p_hpa, tk, qice, qcld, qv, ght, ter, haveqci, outview=None):
if outview is None: if outview is None:
outview = np.empty_like(ter) outview = np.empty_like(ter)
pf = np.empty(p_hpa.shape[0:3], np.float64, order="F")
result = wrfcttcalc(p_hpa, result = wrfcttcalc(p_hpa,
tk, tk,
qice, qice,
@ -774,6 +789,7 @@ def _ctt(p_hpa, tk, qice, qcld, qv, ght, ter, haveqci, outview=None):
ght, ght,
ter, ter,
outview, outview,
pf,
haveqci) haveqci)
return result return result
@ -859,6 +875,8 @@ def _vintrp(field, pres, tk, qvp, ght, terrain, sfp, smsfp,
outdims = field.shape[0:2] + interp_levels.shape outdims = field.shape[0:2] + interp_levels.shape
outview = np.empty(outdims, field.dtype, order="F") outview = np.empty(outdims, field.dtype, order="F")
tempout = np.zeros(field.shape[0:2], np.float64, order="F")
errstat = np.array(0) errstat = np.array(0)
errmsg = np.zeros(Constants.ERRLEN, "c") errmsg = np.zeros(Constants.ERRLEN, "c")
@ -877,6 +895,7 @@ def _vintrp(field, pres, tk, qvp, ght, terrain, sfp, smsfp,
extrap, extrap,
vcor, vcor,
logp, logp,
tempout,
missing, missing,
errstat, errstat,
errmsg) errmsg)

Write Preview
Loading…
Cancel
Save