@ -227,6 +227,7 @@ SUBROUTINE DPFCALC(prs, sfp, pf, mix, mjy, mkzh, ter_follow)
@@ -227,6 +227,7 @@ SUBROUTINE DPFCALC(prs, sfp, pf, mix, mjy, mkzh, ter_follow)
INTEGER :: i , j , k
! $ OMP PARALLEL DO COLLAPSE ( 3 )
DO j = 1 , mjy
DO i = 1 , mix
DO k = 1 , mkzh
@ -245,6 +246,8 @@ SUBROUTINE DPFCALC(prs, sfp, pf, mix, mjy, mkzh, ter_follow)
@@ -245,6 +246,8 @@ SUBROUTINE DPFCALC(prs, sfp, pf, mix, mjy, mkzh, ter_follow)
END DO
END DO
! $ OMP END PARALLEL DO
RETURN
END SUBROUTINE DPFCALC
@ -351,10 +354,7 @@ SUBROUTINE DCAPECALC3D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
@@ -351,10 +354,7 @@ SUBROUTINE DCAPECALC3D(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 cpu_time ( t1 )
! CALL OMP_SET_NUM_THREADS ( 16 )
! $ OMP PARALLEL DO
! $ OMP PARALLEL DO COLLAPSE ( 3 )
DO j = 1 , mjy
DO i = 1 , mix
DO k = 1 , mkzh
@ -403,10 +403,6 @@ SUBROUTINE DCAPECALC3D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
@@ -403,10 +403,6 @@ SUBROUTINE DCAPECALC3D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
zlcl = ght_new ( kpar , i , j ) + ( tmk_new ( kpar , i , j ) - tlcl ) / ( G / CP * ( 1.D0 + CPMD * qvp_new ( kpar , i , j ) ) )
! DO k = kpar , 1 , - 1
! tmklift_new ( k ) = TONPSADIABAT ( ethpari , prs_new ( k , i , j ) , psadithte , psadiprs , &
! psaditmk , GAMMA , errstat , errmsg )
! END DO
! Calculate buoyancy and relative height of lifted parcel at
! all levels , and store in bottom up arrays . add a level at the lcl ,
! and at all points where buoyancy is zero .
@ -428,7 +424,8 @@ SUBROUTINE DCAPECALC3D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
@@ -428,7 +424,8 @@ SUBROUTINE DCAPECALC3D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
! Model level is below lcl
IF ( ght_new ( k , i , j ) . LT . zlcl ) THEN
tmklift = tmk_new ( kpar , i , j ) - G / ( CP * ( 1.D0 + CPMD * qvp_new ( kpar , i , j ) ) ) * ( ght_new ( k , i , j ) - ght_new ( kpar , i , j ) )
tmklift = tmk_new ( kpar , i , j ) - G / ( CP * ( 1.D0 + CPMD * qvp_new ( kpar , i , j ) ) ) * &
( ght_new ( k , i , j ) - ght_new ( kpar , i , j ) )
tvenv = tmk_new ( k , i , j ) * ( EPS + qvp_new ( k , i , j ) ) / ( EPS * ( 1.D0 + qvp_new ( k , i , j ) ) )
tvlift = tmklift * ( EPS + qvp_new ( kpar , i , j ) ) / ( EPS * ( 1.D0 + qvp_new ( kpar , i , j ) ) )
ghtlift = ght_new ( k , i , j )
@ -436,8 +433,10 @@ SUBROUTINE DCAPECALC3D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
@@ -436,8 +433,10 @@ SUBROUTINE DCAPECALC3D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
! This model level and previous model level straddle the lcl ,
! so first create a new level in the bottom - up array , at the lcl .
facden = 1.0 / ( ght_new ( k , i , j ) - ght_new ( k + 1 , i , j ) )
tmkenv = tmk_new ( k + 1 , i , j ) * ( ( ght_new ( k , i , j ) - zlcl ) * facden ) + tmk_new ( k , i , j ) * ( ( zlcl - ght_new ( k + 1 , i , j ) ) * facden )
qvpenv = qvp_new ( k + 1 , i , j ) * ( ( ght_new ( k , i , j ) - zlcl ) * facden ) + qvp_new ( k , i , j ) * ( ( zlcl - ght_new ( k + 1 , i , j ) ) * facden )
tmkenv = tmk_new ( k + 1 , i , j ) * ( ( ght_new ( k , i , j ) - zlcl ) * facden ) + tmk_new ( k , i , j ) * &
( ( zlcl - ght_new ( k + 1 , i , j ) ) * facden )
qvpenv = qvp_new ( k + 1 , i , j ) * ( ( ght_new ( k , i , j ) - zlcl ) * facden ) + qvp_new ( k , i , j ) * &
( ( zlcl - ght_new ( k + 1 , i , j ) ) * facden )
tvenv = tmkenv * ( EPS + qvpenv ) / ( EPS * ( 1.D0 + qvpenv ) )
tvlift = tlcl * ( EPS + qvp_new ( kpar , i , j ) ) / ( EPS * ( 1.D0 + qvp_new ( kpar , i , j ) ) )
ghtlift = zlcl
@ -570,8 +569,7 @@ SUBROUTINE DCAPECALC3D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
@@ -570,8 +569,7 @@ SUBROUTINE DCAPECALC3D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
END DO
END DO
! $ OMP END PARALLEL DO
! CALL cpu_time ( t2 )
! print * , 'Time taken in seconds ' , ( t2 - t1 )
RETURN
END SUBROUTINE DCAPECALC3D
@ -590,8 +588,6 @@ END SUBROUTINE DCAPECALC3D
@@ -590,8 +588,6 @@ END SUBROUTINE DCAPECALC3D
! the cape and cin arrays . Also , LCL and LFC heights
! are put in the k = mkzh - 1 and k = mkzh - 2 slabs of the cin array .
!
! Important ! The z - indexes must be arranged so that mkzh ( max z - index ) is the
! surface pressure . So , pressure must be ordered in ascending order before
! calling this routine . Other variables must be ordered the same ( p , tk , q , z ) .
@ -711,10 +707,6 @@ SUBROUTINE DCAPECALC2D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
@@ -711,10 +707,6 @@ SUBROUTINE DCAPECALC2D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
RETURN
END IF
! 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 , &
@ -784,7 +776,6 @@ SUBROUTINE DCAPECALC2D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
@@ -784,7 +776,6 @@ SUBROUTINE DCAPECALC2D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
tmkpari = ( totthe / totprs ) * &
( prs_new ( kpar1 , i , j ) / 100 0.D0 ) ** ( GAMMA * ( 1.D0 + GAMMAMD * qvp_new ( kpar1 , i , j ) ) )
! CALL CPU_TIME ( t3 )
DO kpar = kpar1 , kpar2
! Calculate temperature and moisture properties of parcel
@ -825,7 +816,8 @@ SUBROUTINE DCAPECALC2D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
@@ -825,7 +816,8 @@ SUBROUTINE DCAPECALC2D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
! Model level is below lcl
IF ( ght_new ( k , i , j ) . LT . zlcl ) THEN
tmklift = tmk_new ( kpar , i , j ) - G / ( CP * ( 1.D0 + CPMD * qvp_new ( kpar , i , j ) ) ) * ( ght_new ( k , i , j ) - ght_new ( kpar , i , j ) )
tmklift = tmk_new ( kpar , i , j ) - G / ( CP * ( 1.D0 + CPMD * qvp_new ( kpar , i , j ) ) ) * &
( ght_new ( k , i , j ) - ght_new ( kpar , i , j ) )
tvenv = tmk_new ( k , i , j ) * ( EPS + qvp_new ( k , i , j ) ) / ( EPS * ( 1.D0 + qvp_new ( k , i , j ) ) )
tvlift = tmklift * ( EPS + qvp_new ( kpar , i , j ) ) / ( EPS * ( 1.D0 + qvp_new ( kpar , i , j ) ) )
ghtlift = ght_new ( k , i , j )
@ -833,8 +825,10 @@ SUBROUTINE DCAPECALC2D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
@@ -833,8 +825,10 @@ SUBROUTINE DCAPECALC2D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
! This model level and previous model level straddle the lcl ,
! so first create a new level in the bottom - up array , at the lcl .
facden = 1 / ( ght_new ( k , i , j ) - ght_new ( k + 1 , i , j ) )
tmkenv = tmk_new ( k + 1 , i , j ) * ( ( ght_new ( k , i , j ) - zlcl ) * facden ) + tmk_new ( k , i , j ) * ( ( zlcl - ght_new ( k + 1 , i , j ) ) * facden )
qvpenv = qvp_new ( k + 1 , i , j ) * ( ( ght_new ( k , i , j ) - zlcl ) * facden ) + qvp_new ( k , i , j ) * ( ( zlcl - ght_new ( k + 1 , i , j ) ) * facden )
tmkenv = tmk_new ( k + 1 , i , j ) * ( ( ght_new ( k , i , j ) - zlcl ) * facden ) + tmk_new ( k , i , j ) * &
( ( zlcl - ght_new ( k + 1 , i , j ) ) * facden )
qvpenv = qvp_new ( k + 1 , i , j ) * ( ( ght_new ( k , i , j ) - zlcl ) * facden ) + qvp_new ( k , i , j ) * &
( ( zlcl - ght_new ( k + 1 , i , j ) ) * facden )
tvenv = tmkenv * ( EPS + qvpenv ) / ( EPS * ( 1.D0 + qvpenv ) )
tvlift = tlcl * ( EPS + qvp_new ( kpar , i , j ) ) / ( EPS * ( 1.D0 + qvp_new ( kpar , i , j ) ) )
ghtlift = zlcl
@ -866,7 +860,6 @@ SUBROUTINE DCAPECALC2D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
@@ -866,7 +860,6 @@ SUBROUTINE DCAPECALC2D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
ilcl = 2
CYCLE
END IF
END DO
kmax = kk
@ -980,5 +973,6 @@ SUBROUTINE DCAPECALC2D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
@@ -980,5 +973,6 @@ SUBROUTINE DCAPECALC2D(prs,tmk,qvp,ght,ter,sfp,cape,cin,&
END DO
END DO
! $ OMP END PARALLEL DO
RETURN
END SUBROUTINE DCAPECALC2D