From acdc4c096bf3b28cdfd0088c3755ffe70e00c6bd Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Tue, 4 Jul 2023 15:15:54 +0200
Subject: [PATCH] Philippe 04/07/2023: minor modifications (cleaning of code)
---
src/MNH/condensation.f90 | 41 +++++++++++++++++-------------------
src/MNH/fft55.f90 | 1 +
src/MNH/ice4_compute_pdf.f90 | 2 --
src/MNH/ice4_rainfr_vert.f90 | 1 -
src/MNH/mode_prandtl.f90 | 6 +++---
src/MNH/pressurez.f90 | 7 ++++++
src/MNH/shuman.f90 | 6 +-----
src/MNH/slow_terms.f90 | 15 ++++++++-----
8 files changed, 41 insertions(+), 38 deletions(-)
diff --git a/src/MNH/condensation.f90 b/src/MNH/condensation.f90
index 6c8d331cf..15cb3feba 100644
--- a/src/MNH/condensation.f90
+++ b/src/MNH/condensation.f90
@@ -212,16 +212,15 @@ REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZCRIAUTIP
INTEGER, DIMENSION(:,:), POINTER, CONTIGUOUS :: ITPL ! top levels of troposphere
REAL, DIMENSION(:,:), POINTER, CONTIGUOUS :: ZTMIN ! minimum Temp. related to ITPL
!
-REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZLV, ZLS, ZCPD
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZLV, ZLS, ZCPD, ZCONDP
REAL :: ZCOND
-REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZCONDP
REAL :: ZGCOND, ZSBAR, ZSBARC, ZQ1, ZAUTC, ZAUTI, ZGAUV, ZGAUC, ZGAUI, ZGAUTC, ZGAUTI ! Used for integration in Gaussian Probability Density Function
REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZSBARP,ZQ1P,ZGCONDP,ZGAUVP,ZAUTCP,ZGAUTCP,ZGAUCP,ZAUTIP,ZGAUTIP,ZGAUIP
REAL :: ZTEMP, ZPV, ZQSL, ZPIV, ZQSI, ZLVS ! thermodynamics
REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZPVP,ZQSLP,ZPIVP,ZQSIP,ZLVSP
-REAL :: ZLL, DZZ, ZZZ ! used for length scales
-REAL, DIMENSION(:,:) , POINTER, CONTIGUOUS :: ZZZP
-REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: DZZP,ZLLP
+REAL :: ZLL, DZZ
+REAL, DIMENSION(:,:), POINTER, CONTIGUOUS :: ZZZP
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZDZZP,ZLLP ! used for length scales
REAL :: ZAH, ZA, ZB, ZSIGMA, ZDRW, ZDTL, ZSIG_CONV ! related to computation of Sig_s
REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZAHP,ZAP,ZBP,ZSIGMAP,ZDRWP,ZDTLP,ZSIG_CONVP
REAL :: ZRCOLD, ZRIOLD
@@ -318,7 +317,7 @@ allocate( ZAP(kiu, kju, kku ) )
allocate( ZBP(kiu, kju, kku ) )
allocate( ZSBARP(kiu, kju, kku ) )
allocate( ZSIGMAP(kiu, kju, kku ) )
-allocate( DZZP(kiu, kju, kku ) )
+allocate( ZDZZP(kiu, kju, kku ) )
allocate( ZDRWP(kiu, kju, kku ) )
allocate( ZDTLP(kiu, kju, kku ) )
allocate( ZLLP(kiu, kju, kku ) )
@@ -370,7 +369,7 @@ CALL MNH_MEM_GET( ZAP, kiu, kju, kku )
CALL MNH_MEM_GET( ZBP, kiu, kju, kku )
CALL MNH_MEM_GET( ZSBARP, kiu, kju, kku )
CALL MNH_MEM_GET( ZSIGMAP, kiu, kju, kku )
-CALL MNH_MEM_GET( DZZP, kiu, kju, kku )
+CALL MNH_MEM_GET( ZDZZP, kiu, kju, kku )
CALL MNH_MEM_GET( ZDRWP, kiu, kju, kku )
CALL MNH_MEM_GET( ZDTLP, kiu, kju, kku )
CALL MNH_MEM_GET( ZLLP, kiu, kju, kku )
@@ -396,7 +395,7 @@ CALL MNH_MEM_GET( JKMK, kku )
!$acc data present( PPABS, PZZ, PT, PRV, PRC, PRI, PRS, PRG, PSIGS, PMFCONV, PCLDFR, PSIGRC, &
!$acc & ztlk, zrt, zl, zfrac, itpl, ztmin, zlv, zls,zcpd, gwork,&
!$acc & ZZZP,JKPP,ZPVP,ZQSLP,ZPIVP,ZQSIP,ZLVSP,ZAHP,ZAP,ZBP,ZSBARP,ZSIGMAP,&
-!$acc & DZZP,ZDRWP,ZDTLP,ZLLP,ZSIG_CONVP,ZQ1P,ZGCONDP,ZGAUVP,ZCONDP,ZAUTCP,&
+!$acc & ZDZZP,ZDRWP,ZDTLP,ZLLP,ZSIG_CONVP,ZQ1P,ZGCONDP,ZGAUVP,ZCONDP,ZAUTCP,&
!$acc & ZGAUTCP,ZGAUCP,ZCRIAUTIP,ZAUTIP,ZGAUTIP,ZGAUIP,INQ1P,ZINCP,ZRCOLDP,ZRIOLDP,&
!$acc & JKPK,JKMK )
#endif
@@ -560,9 +559,9 @@ DO CONCURRENT(JI=KIB:KIE,JJ=KJB:KJE,JK=IKTB:IKTE)
END IF
ELSE
! parameterize Sigma_s with first_order closure
- DZZP(JI,JJ,JK) = PZZ(JI,JJ,JKPK(JK)) - PZZ(JI,JJ,JKMK(JK))
+ ZDZZP(JI,JJ,JK) = PZZ(JI,JJ,JKPK(JK)) - PZZ(JI,JJ,JKMK(JK))
ZDRWP(JI,JJ,JK) = ZRT(JI,JJ,JKPK(JK)) - ZRT(JI,JJ,JKMK(JK))
- ZDTLP(JI,JJ,JK) = ZTLK(JI,JJ,JKPK(JK)) - ZTLK(JI,JJ,JKMK(JK)) + XG/ZCPD(JI,JJ,JK) * DZZP(JI,JJ,JK)
+ ZDTLP(JI,JJ,JK) = ZTLK(JI,JJ,JKPK(JK)) - ZTLK(JI,JJ,JKMK(JK)) + XG/ZCPD(JI,JJ,JK) * ZDZZP(JI,JJ,JK)
ZLLP(JI,JJ,JK) = ZL(JI,JJ,JK)
! standard deviation due to convection
ZSIG_CONVP(JI,JJ,JK) =0.
@@ -570,11 +569,11 @@ DO CONCURRENT(JI=KIB:KIE,JJ=KJB:KJE,JK=IKTB:IKTE)
ZSIG_CONVP(JI,JJ,JK) = ZCSIG_CONV * PMFCONV(JI,JJ,JK) / ZAP(JI,JJ,JK)
! zsigma should be of order 4.e-4 in lowest 5 km of atmosphere
ZSIGMAP(JI,JJ,JK) = SQRT( MAX( 1.E-25, ZCSIGMA * ZCSIGMA * ZLLP(JI,JJ,JK)*ZLLP(JI,JJ,JK) &
- /(DZZP(JI,JJ,JK)*DZZP(JI,JJ,JK))*(&
- ZAP(JI,JJ,JK)*ZAP(JI,JJ,JK)*ZDRWP(JI,JJ,JK)*ZDRWP(JI,JJ,JK) - 2.*ZAP(JI,JJ,JK)*ZBP(JI,JJ,JK) &
- *ZDRWP(JI,JJ,JK)*ZDTLP(JI,JJ,JK) &
- + ZBP(JI,JJ,JK)*ZBP(JI,JJ,JK)*ZDTLP(JI,JJ,JK)*ZDTLP(JI,JJ,JK)) + &
- ZSIG_CONVP(JI,JJ,JK) * ZSIG_CONVP(JI,JJ,JK) ) )
+ /(ZDZZP(JI,JJ,JK)*ZDZZP(JI,JJ,JK))*(&
+ ZAP(JI,JJ,JK)*ZAP(JI,JJ,JK)*ZDRWP(JI,JJ,JK)*ZDRWP(JI,JJ,JK) - 2.*ZAP(JI,JJ,JK)*ZBP(JI,JJ,JK) &
+ * ZDRWP(JI,JJ,JK)*ZDTLP(JI,JJ,JK) &
+ + ZBP(JI,JJ,JK)*ZBP(JI,JJ,JK)*ZDTLP(JI,JJ,JK)*ZDTLP(JI,JJ,JK)) + &
+ ZSIG_CONVP(JI,JJ,JK) * ZSIG_CONVP(JI,JJ,JK) ) )
END IF
ZSIGMAP(JI,JJ,JK)= MAX( 1.E-10, ZSIGMAP(JI,JJ,JK) )
! ZSIGMAP(JI,JJ,JK)= MAX( 1.E-12, ZSIGMAP(JI,JJ,JK) )
@@ -594,8 +593,7 @@ DO CONCURRENT(JI=KIB:KIE,JJ=KJB:KJE,JK=IKTB:IKTE)
PCLDFR(JI,JJ,JK) = MAX( 0., MIN(1.,0.5*ZGAUVP(JI,JJ,JK)))
!Computation of condensate
- ZCONDP(JI,JJ,JK) = (EXP(-ZGCONDP(JI,JJ,JK)**2)-ZGCONDP(JI,JJ,JK)*SQRT(XPI)*ZGAUVP(JI,JJ,JK)) &
- *ZSIGMAP(JI,JJ,JK)/SQRT(2.*XPI)
+ ZCONDP(JI,JJ,JK) = (EXP(-ZGCONDP(JI,JJ,JK)**2)-ZGCONDP(JI,JJ,JK)*SQRT(XPI)*ZGAUVP(JI,JJ,JK))*ZSIGMAP(JI,JJ,JK)/SQRT(2.*XPI)
ZCONDP(JI,JJ,JK) = MAX(ZCONDP(JI,JJ,JK), 0.)
PSIGRC(JI,JJ,JK) = PCLDFR(JI,JJ,JK)
@@ -603,14 +601,13 @@ DO CONCURRENT(JI=KIB:KIE,JJ=KJB:KJE,JK=IKTB:IKTE)
!Computation warm/cold Cloud Fraction and content in high water content part
IF(GPRESENT_PHLC_HCF .AND. GPRESENT_PHLC_HRC)THEN
IF(1-ZFRAC(JI,JJ,JK) > 1.E-20)THEN
- ZAUTCP(JI,JJ,JK) = (ZSBARP(JI,JJ,JK) - XCRIAUTC/(PRHODREF(JI,JJ,JK)*(1-ZFRAC(JI,JJ,JK)))) &
- /ZSIGMAP(JI,JJ,JK)
+ ZAUTCP(JI,JJ,JK) = (ZSBARP(JI,JJ,JK) - XCRIAUTC/(PRHODREF(JI,JJ,JK)*(1-ZFRAC(JI,JJ,JK))))/ZSIGMAP(JI,JJ,JK)
ZGAUTCP(JI,JJ,JK) = -ZAUTCP(JI,JJ,JK)/SQRT(2.)
!Approximation of erf function for Gaussian distribution
ZGAUCP(JI,JJ,JK) = 1 - SIGN(1., ZGAUTCP(JI,JJ,JK)) * SQRT(1-EXP(-4*ZGAUTCP(JI,JJ,JK)**2/XPI))
PHLC_HCF(JI,JJ,JK) = MAX( 0., MIN(1.,0.5*ZGAUCP(JI,JJ,JK)))
PHLC_HRC(JI,JJ,JK) = (1-ZFRAC(JI,JJ,JK))*(EXP(-ZGAUTCP(JI,JJ,JK)**2)-ZGAUTCP(JI,JJ,JK) &
- *SQRT(XPI)*ZGAUCP(JI,JJ,JK))*ZSIGMAP(JI,JJ,JK)/SQRT(2.*XPI)
+ *SQRT(XPI)*ZGAUCP(JI,JJ,JK))*ZSIGMAP(JI,JJ,JK)/SQRT(2.*XPI)
PHLC_HRC(JI,JJ,JK) = PHLC_HRC(JI,JJ,JK) + XCRIAUTC/PRHODREF(JI,JJ,JK) * PHLC_HCF(JI,JJ,JK)
PHLC_HRC(JI,JJ,JK) = MAX(PHLC_HRC(JI,JJ,JK), 0.)
ELSE
@@ -628,7 +625,7 @@ DO CONCURRENT(JI=KIB:KIE,JJ=KJB:KJE,JK=IKTB:IKTE)
ZGAUIP(JI,JJ,JK) = 1 - SIGN(1., ZGAUTIP(JI,JJ,JK)) * SQRT(1-EXP(-4*ZGAUTIP(JI,JJ,JK)**2/XPI))
PHLI_HCF(JI,JJ,JK) = MAX( 0., MIN(1.,0.5*ZGAUIP(JI,JJ,JK)))
PHLI_HRI(JI,JJ,JK) = ZFRAC(JI,JJ,JK)*(EXP(-ZGAUTIP(JI,JJ,JK)**2)-ZGAUTIP(JI,JJ,JK) &
- * SQRT(XPI)*ZGAUIP(JI,JJ,JK))*ZSIGMAP(JI,JJ,JK)/SQRT(2.*XPI)
+ * SQRT(XPI)*ZGAUIP(JI,JJ,JK))*ZSIGMAP(JI,JJ,JK)/SQRT(2.*XPI)
PHLI_HRI(JI,JJ,JK) = PHLI_HRI(JI,JJ,JK) + ZCRIAUTIP(JI,JJ,JK)*PHLI_HCF(JI,JJ,JK)
PHLI_HRI(JI,JJ,JK) = MAX(PHLI_HRI(JI,JJ,JK), 0.)
ELSE
@@ -720,7 +717,7 @@ ENDDO ! CONCURRENT
#ifndef MNH_OPENACC
deallocate( ztlk, zrt, zl, zfrac, itpl, ztmin, zlv, zls,zcpd, gwork )
deallocate( ZZZP, JKPP, ZPVP, ZQSLP, ZPIVP, ZQSIP, ZLVSP, ZAHP, ZAP, ZBP, ZSBARP, ZSIGMAP )
-deallocate( DZZP, ZDRWP, ZDTLP, ZLLP, ZSIG_CONVP, ZQ1P, ZGCONDP, ZGAUVP, ZCONDP, ZAUTCP )
+deallocate( ZDZZP, ZDRWP, ZDTLP, ZLLP, ZSIG_CONVP, ZQ1P, ZGCONDP, ZGAUVP, ZCONDP, ZAUTCP )
deallocate( ZGAUTCP, ZGAUCP, ZCRIAUTIP, ZAUTIP, ZGAUTIP, ZGAUIP, INQ1P, ZINCP, ZRCOLDP, ZRIOLDP )
deallocate( JKPK,JKMK )
#else
diff --git a/src/MNH/fft55.f90 b/src/MNH/fft55.f90
index 805c05024..4bc2cb5bb 100644
--- a/src/MNH/fft55.f90
+++ b/src/MNH/fft55.f90
@@ -154,6 +154,7 @@ IEVEN=MOD(IN,2)
INH=IN/2
INN=2*IN
INBLOX=1+(ILOT-1)/NVECLEN
+!INVEX = remaining of the division of NVECLEN by KLOT
INVEX=ILOT-(INBLOX-1)*NVECLEN
IF (KISIGN.EQ.1) THEN
!
diff --git a/src/MNH/ice4_compute_pdf.f90 b/src/MNH/ice4_compute_pdf.f90
index 63f868579..c947980f0 100644
--- a/src/MNH/ice4_compute_pdf.f90
+++ b/src/MNH/ice4_compute_pdf.f90
@@ -122,8 +122,6 @@ INTEGER :: IHSUBG_PR_PDF ! temporary variable for OpenCC character limitation (C
!
!-------------------------------------------------------------------------------
-! !$acc data copyin( XRTMIN )
-
!$acc data present(PRHODREF,PRCT,PRIT,PCF,PT,PSIGMA_RC, &
!$acc& PHLC_HCF,PHLC_LCF,PHLC_HRC,PHLC_LRC,PHLI_HCF,PHLI_LCF,PHLI_HRI,PHLI_LRI,PRF)
diff --git a/src/MNH/ice4_rainfr_vert.f90 b/src/MNH/ice4_rainfr_vert.f90
index 629613e5d..24631212f 100644
--- a/src/MNH/ice4_rainfr_vert.f90
+++ b/src/MNH/ice4_rainfr_vert.f90
@@ -55,7 +55,6 @@ REAL, DIMENSION(:,:,:), OPTIONAL,INTENT(IN) :: PRH !Hail field
INTEGER :: JI, JJ, JK
LOGICAL :: MASK
!
-! !$acc data copyin( XRTMIN )
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/mode_prandtl.f90 b/src/MNH/mode_prandtl.f90
index 243d0b8cb..0e0872572 100644
--- a/src/MNH/mode_prandtl.f90
+++ b/src/MNH/mode_prandtl.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2022 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2023 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -899,7 +899,7 @@ SUBROUTINE D_M3_WTH_W2R_O_DDTDZ(PREDTH1,PREDR1,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST,PD
INTEGER :: IKB, IKE
#ifndef MNH_OPENACC
REAL, DIMENSION(:,:,:), allocatable :: ZTMP1_DEVICE
- #else
+#else
REAL, DIMENSION(:,:,:), pointer,contiguous :: ZTMP1_DEVICE
#endif
@@ -973,7 +973,7 @@ SUBROUTINE M3_WTH_WR2(PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTDZ
INTEGER :: IKB, IKE
#ifndef MNH_OPENACC
REAL, DIMENSION(:,:,:), allocatable :: ZTMP1_DEVICE, ZTMP2_DEVICE
- #else
+#else
REAL, DIMENSION(:,:,:), pointer,contiguous :: ZTMP1_DEVICE, ZTMP2_DEVICE
#endif
diff --git a/src/MNH/pressurez.f90 b/src/MNH/pressurez.f90
index d27cce377..6bcc60244 100644
--- a/src/MNH/pressurez.f90
+++ b/src/MNH/pressurez.f90
@@ -702,6 +702,13 @@ IF(CEQNSYS=='LHE'.AND. LFLAT .AND. LCARTESIAN .AND. .NOT. LIBM) THEN
CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'PRESSUREZ', 'OpenACC: CEQNSYS=LHE.AND. LFLAT .AND. LCARTESIAN' // &
' .AND. .NOT. LIBM not yet tested' )
#endif
+
+#ifdef MNH_MGSOLVER
+ IF ( HPRESOPT == "ZSOLV" ) &
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'PRESSUREZ', 'OpenACC: CEQNSYS=LHE.AND. LFLAT .AND. LCARTESIAN' // &
+ ' .AND. .NOT. LIBM with ZSOLV: not (yet) supported' )
+#endif
+
! flat cartesian LHE case -> exact solution
IF ( HPRESOPT /= "ZRESI" ) THEN
CALL FLAT_INV(HLBCX,HLBCY,PDXHATM,PDYHATM,PRHOT,PAF,PBF,PCF, &
diff --git a/src/MNH/shuman.f90 b/src/MNH/shuman.f90
index 12a702243..6835159d2 100644
--- a/src/MNH/shuman.f90
+++ b/src/MNH/shuman.f90
@@ -1,12 +1,8 @@
!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-!-----------------------------------------------------------------
! ##################
MODULE MODI_SHUMAN
! ##################
diff --git a/src/MNH/slow_terms.f90 b/src/MNH/slow_terms.f90
index 2d7e5b7f9..e90986092 100644
--- a/src/MNH/slow_terms.f90
+++ b/src/MNH/slow_terms.f90
@@ -164,11 +164,11 @@ USE MODD_CST, only: XALPW, XBETAW, XGAMW, XCL, XCPD, XCPV, XLVTT, XMD, XM
USE MODD_PARAMETERS, only: JPVEXT
use mode_budget, only: Budget_store_init, Budget_store_end
-use mode_mppdb
-
#ifdef MNH_OPENACC
- USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
+USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
#endif
+use mode_mppdb
+
#if defined(MNH_BITREP) || defined(MNH_BITREP_OMP)
use modi_bitrep
#endif
@@ -220,8 +220,13 @@ INTEGER :: IKE ! the microphysical sources have to be computed
!
REAL :: ZTSPLITR ! Small time step for rain sedimentation
!
-REAL, DIMENSION(:,:,:), POINTER,CONTIGUOUS :: ZT,ZW,ZW1,ZW2,ZW3,ZEXNT,ZDZZ ! Work arrays
-LOGICAL, DIMENSION(:,:,:), POINTER,CONTIGUOUS :: G3D
+#ifndef MNH_OPENACC
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZT,ZW,ZW1,ZW2,ZW3,ZEXNT,ZDZZ ! Work arrays
+LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: G3D
+#else
+REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZT,ZW,ZW1,ZW2,ZW3,ZEXNT,ZDZZ ! Work arrays
+LOGICAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: G3D
+#endif
!
INTEGER :: JI,JJ,IC,JL ! loop control for packed array
INTEGER :: JIU, JJU, JKU
--
GitLab