From f4eeee927bafe46e07d15ffd198382691d8bba16 Mon Sep 17 00:00:00 2001 From: Bill Ladwig Date: Fri, 13 Oct 2017 16:09:51 -0600 Subject: [PATCH] Modified the indexing labels so that they make sense. --- fortran/rip_cape.f90 | 121 +++++++++++++++++++++-------------------- fortran/wrffortran.pyf | 58 ++++++++++---------- 2 files changed, 89 insertions(+), 90 deletions(-) diff --git a/fortran/rip_cape.f90 b/fortran/rip_cape.f90 index 945b98e..84fdb30 100644 --- a/fortran/rip_cape.f90 +++ b/fortran/rip_cape.f90 @@ -37,7 +37,7 @@ END FUNCTION TVIRTUAL REAL(KIND=8) FUNCTION TONPSADIABAT(thte, prs, psadithte, psadiprs, psaditmk, gamma,& errstat, errmsg) USE wrf_constants, ONLY : ALGERR -!$OMP DECLARE SIMD (TONPSADIABAT) +!!$OMP DECLARE SIMD (TONPSADIABAT) !!uniform(thte,prs,psadithte,psadiprs,psaditmk) !f2py threadsafe !f2py intent(in,out) :: cape, cin @@ -218,17 +218,17 @@ END SUBROUTINE DLOOKUP_TABLE ! which case it assumes the lower bounding pressure level is as far ! below the lowest vertical level as the upper bounding pressure ! level is above. -SUBROUTINE DPFCALC(prs, sfp, pf, miy, mjx, mkzh, ter_follow) +SUBROUTINE DPFCALC(prs, sfp, pf, mix, mjy, mkzh, ter_follow) - REAL(KIND=8), DIMENSION(mkzh,miy,mjx), INTENT(IN) :: prs - REAL(KIND=8), DIMENSION(miy,mjx), INTENT(IN) :: sfp - REAL(KIND=8), DIMENSION(mkzh,miy,mjx), INTENT(OUT) :: pf - INTEGER, INTENT(IN) :: ter_follow,miy,mjx,mkzh + REAL(KIND=8), DIMENSION(mkzh,mix,mjy), INTENT(IN) :: prs + REAL(KIND=8), DIMENSION(mix,mjy), INTENT(IN) :: sfp + REAL(KIND=8), DIMENSION(mkzh,mix,mjy), INTENT(OUT) :: pf + INTEGER, INTENT(IN) :: ter_follow,mix,mjy,mkzh INTEGER :: i,j,k - DO j = 1,mjx - DO i = 1,miy + DO j = 1,mjy + DO i = 1,mix DO k = 1,mkzh IF (k .EQ. mkzh) THEN ! terrain-following data @@ -270,7 +270,7 @@ END SUBROUTINE DPFCALC ! NCLFORTSTART SUBROUTINE DCAPECALC3D(prs,tmk,qvp,ght,ter,sfp,cape,cin,& - cmsg,miy,mjx,mkzh,ter_follow,& + cmsg,mix,mjy,mkzh,ter_follow,& psafile, errstat, errmsg) USE wrf_constants, ONLY : ALGERR, CELKEL, G, EZERO, ESLCON1, ESLCON2, & EPS, RD, CP, GAMMA, CPMD, RGASMD, GAMMAMD, TLCLC1, & @@ -282,15 +282,15 @@ SUBROUTINE DCAPECALC3D(prs,tmk,qvp,ght,ter,sfp,cape,cin,& !f2py threadsafe !f2py intent(in,out) :: cape, cin - INTEGER, INTENT(IN) :: miy, mjx, mkzh, ter_follow - REAL(KIND=8), DIMENSION(miy,mjx,mkzh), INTENT(IN) :: prs - REAL(KIND=8), DIMENSION(miy,mjx,mkzh), INTENT(IN) :: tmk - REAL(KIND=8), DIMENSION(miy,mjx,mkzh), INTENT(IN) :: qvp - REAL(KIND=8), DIMENSION(miy,mjx,mkzh), INTENT(IN) :: ght - REAL(KIND=8), DIMENSION(miy,mjx), INTENT(IN) :: ter - REAL(KIND=8), DIMENSION(miy,mjx), INTENT(IN) ::sfp - REAL(KIND=8), DIMENSION(miy,mjx,mkzh), INTENT(OUT) :: cape - REAL(KIND=8), DIMENSION(miy,mjx,mkzh), INTENT(OUT) :: cin + INTEGER, INTENT(IN) :: mix, mjy, mkzh, ter_follow + REAL(KIND=8), DIMENSION(mix,mjy,mkzh), INTENT(IN) :: prs + REAL(KIND=8), DIMENSION(mix,mjy,mkzh), INTENT(IN) :: tmk + REAL(KIND=8), DIMENSION(mix,mjy,mkzh), INTENT(IN) :: qvp + REAL(KIND=8), DIMENSION(mix,mjy,mkzh), INTENT(IN) :: ght + REAL(KIND=8), DIMENSION(mix,mjy), INTENT(IN) :: ter + 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) :: cin REAL(KIND=8), INTENT(IN) :: cmsg CHARACTER(LEN=*), INTENT(IN) :: psafile INTEGER, INTENT(INOUT) :: errstat @@ -306,16 +306,16 @@ SUBROUTINE DCAPECALC3D(prs,tmk,qvp,ght,ter,sfp,cape,cin,& REAL(KIND=8) :: eslift, tmkenv, qvpenv, tonpsadiabat REAL(KIND=8) :: benamin, dz REAL(KIND=8), DIMENSION(150) :: buoy, zrel, benaccum - REAL(KIND=8), DIMENSION(mkzh,miy,mjx) :: prsf + REAL(KIND=8), DIMENSION(mkzh,mix,mjy) :: prsf REAL(KIND=8), DIMENSION(150) :: psadithte, psadiprs REAL(KIND=8), DIMENSION(150,150) :: psaditmk LOGICAL :: elfound REAL :: t1,t2 - REAL(KIND=8), DIMENSION(mkzh,miy,mjx) :: prs_new - REAL(KIND=8), DIMENSION(mkzh,miy,mjx) :: tmk_new - REAL(KIND=8), DIMENSION(mkzh,miy,mjx) :: qvp_new - REAL(KIND=8), DIMENSION(mkzh,miy,mjx) :: ght_new + 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 tmkpari = 0 @@ -354,19 +354,19 @@ SUBROUTINE DCAPECALC3D(prs,tmk,qvp,ght,ter,sfp,cape,cin,& !CALL cpu_time(t1) !CALL OMP_SET_NUM_THREADS(16) !$OMP PARALLEL DO - DO i = 1,mjx - DO j = 1,miy + DO j = 1,mjy + DO i = 1,mix DO k = 1,mkzh - prs_new(k,j,i) = prs(j,i,k) - tmk_new(k,j,i) = tmk(j,i,k) - qvp_new(k,j,i) = qvp(j,i,k) - ght_new(k,j,i) = ght(j,i,k) + prs_new(k,i,j) = prs(i,j,k) + tmk_new(k,i,j) = tmk(i,j,k) + qvp_new(k,i,j) = qvp(i,j,k) + ght_new(k,i,j) = ght(i,j,k) END DO END DO END DO !$OMP END PARALLEL DO - CALL DPFCALC(prs_new, sfp, prsf, miy, mjx, mkzh, ter_follow) + CALL DPFCALC(prs_new, sfp, prsf, mix, mjy, mkzh, ter_follow) ! before looping, set lookup table for getting temperature on ! a pseudoadiabat. @@ -383,12 +383,12 @@ SUBROUTINE DCAPECALC3D(prs,tmk,qvp,ght,ter,sfp,cape,cin,& !$OMP benaccum, zrel, kmax, dz, elfound, & !$OMP kel, klfc, & !$OMP i,j,k,kpar) - DO j = 1,mjx - DO i = 1,miy + DO j = 1,mjy + DO i = 1,mix cape(i,j,1) = 0.d0 cin(i,j,1) = 0.d0 -!$OMP SIMD +!!$OMP SIMD DO kpar = 2, mkzh ! Calculate temperature and moisture properties of parcel @@ -420,7 +420,7 @@ SUBROUTINE DCAPECALC3D(prs,tmk,qvp,ght,ter,sfp,cape,cin,& klcl = 1 END IF -!$OMP SIMD lastprivate(qvplift,tmklift,ghtlift,tvlift,tmkenv,qvpenv,tvenv,eslift,facden) +!!$OMP SIMD lastprivate(qvplift,tmklift,ghtlift,tvlift,tmkenv,qvpenv,tvenv,eslift,facden) DO k = kpar,1,-1 ! For arrays that go bottom to top kk = kk + 1 @@ -601,7 +601,7 @@ END SUBROUTINE DCAPECALC3D ! NCLFORTSTART SUBROUTINE DCAPECALC2D(prs,tmk,qvp,ght,ter,sfp,cape,cin,& - cmsg,miy,mjx,mkzh,ter_follow,& + cmsg,mix,mjy,mkzh,ter_follow,& psafile, errstat, errmsg) USE wrf_constants, ONLY : ALGERR, CELKEL, G, EZERO, ESLCON1, ESLCON2, & EPS, RD, CP, GAMMA, CPMD, RGASMD, GAMMAMD, TLCLC1, & @@ -613,15 +613,15 @@ SUBROUTINE DCAPECALC2D(prs,tmk,qvp,ght,ter,sfp,cape,cin,& !f2py threadsafe !f2py intent(in,out) :: cape, cin - INTEGER, INTENT(IN) :: miy, mjx, mkzh, ter_follow - REAL(KIND=8), DIMENSION(miy,mjx,mkzh), INTENT(IN) :: prs - REAL(KIND=8), DIMENSION(miy,mjx,mkzh), INTENT(IN) :: tmk - REAL(KIND=8), DIMENSION(miy,mjx,mkzh), INTENT(IN) :: qvp - REAL(KIND=8), DIMENSION(miy,mjx,mkzh), INTENT(IN) :: ght - REAL(KIND=8), DIMENSION(miy,mjx), INTENT(IN) :: ter - REAL(KIND=8), DIMENSION(miy,mjx), INTENT(IN) ::sfp - REAL(KIND=8), DIMENSION(miy,mjx,mkzh), INTENT(OUT) :: cape - REAL(KIND=8), DIMENSION(miy,mjx,mkzh), INTENT(OUT) :: cin + INTEGER, INTENT(IN) :: mix, mjy, mkzh, ter_follow + REAL(KIND=8), DIMENSION(mix,mjy,mkzh), INTENT(IN) :: prs + REAL(KIND=8), DIMENSION(mix,mjy,mkzh), INTENT(IN) :: tmk + REAL(KIND=8), DIMENSION(mix,mjy,mkzh), INTENT(IN) :: qvp + REAL(KIND=8), DIMENSION(mix,mjy,mkzh), INTENT(IN) :: ght + REAL(KIND=8), DIMENSION(mix,mjy), INTENT(IN) :: ter + 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) :: cin REAL(KIND=8), INTENT(IN) :: cmsg CHARACTER(LEN=*), INTENT(IN) :: psafile INTEGER, INTENT(INOUT) :: errstat @@ -639,16 +639,16 @@ SUBROUTINE DCAPECALC2D(prs,tmk,qvp,ght,ter,sfp,cape,cin,& REAL(KIND=8) :: eslift, tmkenv, qvpenv, tonpsadiabat REAL(KIND=8) :: benamin, dz, pup, pdn REAL(KIND=8), DIMENSION(150) :: buoy, zrel, benaccum - REAL(KIND=8), DIMENSION(mkzh,miy,mjx) :: prsf + REAL(KIND=8), DIMENSION(mkzh,mix,mjy) :: prsf REAL(KIND=8), DIMENSION(150) :: psadithte, psadiprs REAL(KIND=8), DIMENSION(150,150) :: psaditmk LOGICAL :: elfound INTEGER :: nthreads REAL(KIND=8), DIMENSION(mkzh) :: eth_temp - REAL(KIND=8), DIMENSION(mkzh,miy,mjx) :: prs_new - REAL(KIND=8), DIMENSION(mkzh,miy,mjx) :: tmk_new - REAL(KIND=8), DIMENSION(mkzh,miy,mjx) :: qvp_new - REAL(KIND=8), DIMENSION(mkzh,miy,mjx) :: ght_new + 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 errstat = 0 @@ -684,13 +684,13 @@ SUBROUTINE DCAPECALC2D(prs,tmk,qvp,ght,ter,sfp,cape,cin,& ! !$OMP PARALLEL DO - DO i = 1,mjx - DO j = 1,miy + DO j = 1,mjy + DO i = 1,mix DO k = 1,mkzh - prs_new(k,j,i) = prs(j,i,k) - tmk_new(k,j,i) = tmk(j,i,k) - qvp_new(k,j,i) = qvp(j,i,k) - ght_new(k,j,i) = ght(j,i,k) + prs_new(k,i,j) = prs(i,j,k) + tmk_new(k,i,j) = tmk(i,j,k) + qvp_new(k,i,j) = qvp(i,j,k) + ght_new(k,i,j) = ght(i,j,k) END DO END DO END DO @@ -699,7 +699,7 @@ SUBROUTINE DCAPECALC2D(prs,tmk,qvp,ght,ter,sfp,cape,cin,& ! calculated the pressure at full sigma levels (a set of pressure ! levels that bound the layers represented by the vertical grid points) - CALL DPFCALC(prs_new, sfp, prsf, miy, mjx, mkzh, ter_follow) + CALL DPFCALC(prs_new, sfp, prsf, mix, mjy, mkzh, ter_follow) ! before looping, set lookup table for getting temperature on ! a pseudoadiabat. @@ -713,15 +713,16 @@ SUBROUTINE DCAPECALC2D(prs,tmk,qvp,ght,ter,sfp,cape,cin,& !CALL OMP_SET_NUM_THREADS(16) !nthreads = omp_get_num_threads() + !$OMP PARALLEL DO COLLAPSE(2) PRIVATE(tlcl, ethpari, & !$OMP zlcl, kk, ilcl, klcl, tmklift, tvenv, tvlift, ghtlift, & !$OMP facden, tmkenv, qvpenv, eslift, qvplift, buoy, benamin, & !$OMP benaccum, zrel, kmax, dz, elfound, & !$OMP kel, klfc, pavg, p2, p1, totthe, totqvp, totprs, & -!$OMP i,j,k,kpar, qvppari, tmkpari,p, pup, pdn, q, th, & -!$OMP pp1, pp2) - DO j = 1,mjx - DO i = 1,miy +!$OMP i,j,k,kpar, kpar1, kpar2, qvppari, tmkpari,p, pup, pdn, q, th, & +!$OMP pp1, pp2, ethmax, eth_temp, klev) + DO j = 1,mjy + DO i = 1,mix cape(i,j,1) = 0.d0 cin(i,j,1) = 0.d0 ! find parcel with max theta-e in lowest 3 km agl. diff --git a/fortran/wrffortran.pyf b/fortran/wrffortran.pyf index eed6320..5a01ba5 100644 --- a/fortran/wrffortran.pyf +++ b/fortran/wrffortran.pyf @@ -63,51 +63,49 @@ python module _wrffortran ! in integer intent(inout) :: errstat character*(*) intent(inout) :: errmsg end subroutine dlookup_table - subroutine dpfcalc(prs,sfp,pf,miy,mjx,mkzh,ter_follow) ! in :_wrffortran:rip_cape.f90 - real(kind=8) dimension(mkzh,miy,mjx),intent(in) :: prs - real(kind=8) dimension(miy,mjx),intent(in),depend(miy,mjx) :: sfp - real(kind=8) dimension(mkzh,miy,mjx),intent(out),depend(mkzh,miy,mjx) :: pf - integer, optional,intent(in),check(shape(prs,1)==miy),depend(prs) :: miy=shape(prs,1) - integer, optional,intent(in),check(shape(prs,2)==mjx),depend(prs) :: mjx=shape(prs,2) + subroutine dpfcalc(prs,sfp,pf,mix,mjy,mkzh,ter_follow) ! in :_wrffortran:rip_cape.f90 + real(kind=8) dimension(mkzh,mix,mjy),intent(in) :: prs + real(kind=8) dimension(mix,mjy),intent(in),depend(mix,mjy) :: sfp + real(kind=8) dimension(mkzh,mix,mjy),intent(out),depend(mkzh,mix,mjy) :: pf + integer, optional,intent(in),check(shape(prs,1)==mix),depend(prs) :: mix=shape(prs,1) + integer, optional,intent(in),check(shape(prs,2)==mjy),depend(prs) :: mjy=shape(prs,2) integer, optional,intent(in),check(shape(prs,0)==mkzh),depend(prs) :: mkzh=shape(prs,0) integer intent(in) :: ter_follow end subroutine dpfcalc - subroutine dcapecalc3d(prs,tmk,qvp,ght,ter,sfp,cape,cin,cmsg,miy,mjx,mkzh,ter_follow,psafile,errstat,errmsg) ! in :_wrffortran:rip_cape.f90 + subroutine dcapecalc3d(prs,tmk,qvp,ght,ter,sfp,cape,cin,cmsg,mix,mjy,mkzh,ter_follow,psafile,errstat,errmsg) ! in :_wrffortran:rip_cape.f90 threadsafe - use omp_lib use wrf_constants, only: tlclc2,gamma,tlclc1,rgasmd,tlclc4,g,tlclc3,thtecon3,eps,rd,cpmd,celkel,gammamd,eslcon2,eslcon1,cp,thtecon1,algerr,ezero,thtecon2 - real(kind=8) dimension(miy,mjx,mkzh),intent(in) :: prs - real(kind=8) dimension(miy,mjx,mkzh),intent(in),depend(miy,mjx,mkzh) :: tmk - real(kind=8) dimension(miy,mjx,mkzh),intent(in),depend(miy,mjx,mkzh) :: qvp - real(kind=8) dimension(miy,mjx,mkzh),intent(in),depend(miy,mjx,mkzh) :: ght - real(kind=8) dimension(miy,mjx),intent(in),depend(miy,mjx) :: ter - real(kind=8) dimension(miy,mjx),intent(in),depend(miy,mjx) :: sfp - real(kind=8) dimension(miy,mjx,mkzh),intent(out,in),depend(miy,mjx,mkzh) :: cape - real(kind=8) dimension(miy,mjx,mkzh),intent(out,in),depend(miy,mjx,mkzh) :: cin + real(kind=8) dimension(mix,mjy,mkzh),intent(in) :: prs + real(kind=8) dimension(mix,mjy,mkzh),intent(in),depend(mix,mjy,mkzh) :: tmk + real(kind=8) dimension(mix,mjy,mkzh),intent(in),depend(mix,mjy,mkzh) :: qvp + real(kind=8) dimension(mix,mjy,mkzh),intent(in),depend(mix,mjy,mkzh) :: ght + real(kind=8) dimension(mix,mjy),intent(in),depend(mix,mjy) :: ter + real(kind=8) dimension(mix,mjy),intent(in),depend(mix,mjy) :: sfp + real(kind=8) dimension(mix,mjy,mkzh),intent(out,in),depend(mix,mjy,mkzh) :: cape + real(kind=8) dimension(mix,mjy,mkzh),intent(out,in),depend(mix,mjy,mkzh) :: cin real(kind=8) intent(in) :: cmsg - integer, optional,intent(in),check(shape(prs,0)==miy),depend(prs) :: miy=shape(prs,0) - integer, optional,intent(in),check(shape(prs,1)==mjx),depend(prs) :: mjx=shape(prs,1) + integer, optional,intent(in),check(shape(prs,0)==mix),depend(prs) :: mix=shape(prs,0) + integer, optional,intent(in),check(shape(prs,1)==mjy),depend(prs) :: mjy=shape(prs,1) integer, optional,intent(in),check(shape(prs,2)==mkzh),depend(prs) :: mkzh=shape(prs,2) integer intent(in) :: ter_follow character*(*) intent(in) :: psafile integer intent(inout) :: errstat character*(*) intent(inout) :: errmsg end subroutine dcapecalc3d - subroutine dcapecalc2d(prs,tmk,qvp,ght,ter,sfp,cape,cin,cmsg,miy,mjx,mkzh,ter_follow,psafile,errstat,errmsg) ! in :_wrffortran:rip_cape.f90 + subroutine dcapecalc2d(prs,tmk,qvp,ght,ter,sfp,cape,cin,cmsg,mix,mjy,mkzh,ter_follow,psafile,errstat,errmsg) ! in :_wrffortran:rip_cape.f90 threadsafe - use omp_lib use wrf_constants, only: tlclc2,gamma,tlclc1,rgasmd,tlclc4,g,tlclc3,thtecon3,eps,rd,cpmd,celkel,gammamd,eslcon2,eslcon1,cp,thtecon1,algerr,ezero,thtecon2 - real(kind=8) dimension(miy,mjx,mkzh),intent(in) :: prs - real(kind=8) dimension(miy,mjx,mkzh),intent(in),depend(miy,mjx,mkzh) :: tmk - real(kind=8) dimension(miy,mjx,mkzh),intent(in),depend(miy,mjx,mkzh) :: qvp - real(kind=8) dimension(miy,mjx,mkzh),intent(in),depend(miy,mjx,mkzh) :: ght - real(kind=8) dimension(miy,mjx),intent(in),depend(miy,mjx) :: ter - real(kind=8) dimension(miy,mjx),intent(in),depend(miy,mjx) :: sfp - real(kind=8) dimension(miy,mjx,mkzh),intent(out,in),depend(miy,mjx,mkzh) :: cape - real(kind=8) dimension(miy,mjx,mkzh),intent(out,in),depend(miy,mjx,mkzh) :: cin + real(kind=8) dimension(mix,mjy,mkzh),intent(in) :: prs + real(kind=8) dimension(mix,mjy,mkzh),intent(in),depend(mix,mjy,mkzh) :: tmk + real(kind=8) dimension(mix,mjy,mkzh),intent(in),depend(mix,mjy,mkzh) :: qvp + real(kind=8) dimension(mix,mjy,mkzh),intent(in),depend(mix,mjy,mkzh) :: ght + real(kind=8) dimension(mix,mjy),intent(in),depend(mix,mjy) :: ter + real(kind=8) dimension(mix,mjy),intent(in),depend(mix,mjy) :: sfp + real(kind=8) dimension(mix,mjy,mkzh),intent(out,in),depend(mix,mjy,mkzh) :: cape + real(kind=8) dimension(mix,mjy,mkzh),intent(out,in),depend(mix,mjy,mkzh) :: cin real(kind=8) intent(in) :: cmsg - integer, optional,intent(in),check(shape(prs,0)==miy),depend(prs) :: miy=shape(prs,0) - integer, optional,intent(in),check(shape(prs,1)==mjx),depend(prs) :: mjx=shape(prs,1) + integer, optional,intent(in),check(shape(prs,0)==mix),depend(prs) :: mix=shape(prs,0) + integer, optional,intent(in),check(shape(prs,1)==mjy),depend(prs) :: mjy=shape(prs,1) integer, optional,intent(in),check(shape(prs,2)==mkzh),depend(prs) :: mkzh=shape(prs,2) integer intent(in) :: ter_follow character*(*) intent(in) :: psafile