diff --git a/src/MNH/aer_wet_dep_kmt_warm.f90 b/src/MNH/aer_wet_dep_kmt_warm.f90
index 450f34b47cf6f4e8b53db7187701f291bebf420c..8d80ec2e9a45d3a76181f64370de4ad81d462bb8 100644
--- a/src/MNH/aer_wet_dep_kmt_warm.f90
+++ b/src/MNH/aer_wet_dep_kmt_warm.f90
@@ -116,6 +116,7 @@ END MODULE MODI_AER_WET_DEP_KMT_WARM
!! -------------
!! Original 09/05/07
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -307,6 +308,8 @@ SUBROUTINE AER_WET_MASS_TRANSFER
!* 0. DECLARATIONS
! ------------
!
+use mode_tools, only: Countjv
+
IMPLICIT NONE
!
!* 0.2 declaration of local variables
@@ -767,46 +770,6 @@ IMPLICIT NONE
ZDENSITY_AER(:,:)) ! aerosol density
!
END SUBROUTINE AER_WET_DEP_KMT_EFFIC
-
-!
-!-------------------------------------------------------------------------------
-!
-!
- FUNCTION COUNTJV(LTAB,I1,I2,I3) RESULT(IC)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* declaration of local variables
-!
-!
-LOGICAL, DIMENSION(:,:,:) :: LTAB ! Mask
-INTEGER, DIMENSION(:) :: I1,I2,I3 ! Used to replace the COUNT and PACK
-INTEGER :: JI,JJ,JK,IC
-!
-!-------------------------------------------------------------------------------
-!
-I1(:)=0
-I2(:)=0
-I3(:)=0
-!ktk
-IC = 0
-DO JK = 1,SIZE(LTAB,3)
- DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ,JK) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- I3(IC) = JK
- END IF
- END DO
- END DO
-END DO
-!
-END FUNCTION COUNTJV
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/ch_aqueous_check.f90 b/src/MNH/ch_aqueous_check.f90
index 9a59b93853f0d6dcf44f25dd47d72fc3060f65db..d99d0caa9956f1c29ce0495ad19954b3f7feade2 100644
--- a/src/MNH/ch_aqueous_check.f90
+++ b/src/MNH/ch_aqueous_check.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2007-2019 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.
+!-----------------------------------------------------------------
! ############################
MODULE MODI_CH_AQUEOUS_CHECK
! ############################
@@ -70,16 +71,18 @@ END MODULE MODI_CH_AQUEOUS_CHECK
!! 21/11/07 (M. Leriche) correct threshold for aqueous phase chemistry
!! 20/09/10 (M. Leriche) add ice phase chemical species
!! 04/11/13 (M. Leriche) add transfer back to the gas phase if evaporation
-!!
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS,ONLY: JPHEXT, &! number of horizontal External points
- JPVEXT ! number of vertical External points
-USE MODD_NSV, ONLY : NSV_CHACBEG, NSV_CHACEND, NSV_CHICBEG, NSV_CHICEND, &
+USE MODD_NSV, ONLY: NSV_CHACBEG, NSV_CHACEND, NSV_CHICBEG, NSV_CHICEND, &
NSV_CHGSBEG
+USE MODD_PARAMETERS, ONLY: JPHEXT, & ! number of horizontal External points
+ JPVEXT ! number of vertical External points
+
+use mode_tools, only: Countjv
!
IMPLICIT NONE
!
@@ -287,42 +290,6 @@ IF (OUSECHIC) THEN
ENDIF
ENDIF
!
-CONTAINS
-!
-!-------------------------------------------------------------------------------
-!
- FUNCTION COUNTJV(GTAB,I1,I2,I3) RESULT(IC)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* 0.2 declaration of local variables
-!
-!
-LOGICAL, DIMENSION(:,:,:) :: GTAB ! Mask
-INTEGER, DIMENSION(:) :: I1,I2,I3 ! Used to replace the COUNT and PACK
-INTEGER :: JI,JJ,JK,IC
-!
-!-------------------------------------------------------------------------------
-!
-IC = 0
-DO JK = 1,SIZE(GTAB,3)
- DO JJ = 1,SIZE(GTAB,2)
- DO JI = 1,SIZE(GTAB,1)
- IF( GTAB(JI,JJ,JK) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- I3(IC) = JK
- END IF
- END DO
- END DO
-END DO
-!
-END FUNCTION COUNTJV
-!
!-------------------------------------------------------------------------------
!
END SUBROUTINE CH_AQUEOUS_CHECK
diff --git a/src/MNH/ch_aqueous_sedim1mom.f90 b/src/MNH/ch_aqueous_sedim1mom.f90
index 86e4772967af19b30268c9d24dd277ddf9c4cf4c..bddef28fabab5eda5381b4c4acad12a3c03792e9 100644
--- a/src/MNH/ch_aqueous_sedim1mom.f90
+++ b/src/MNH/ch_aqueous_sedim1mom.f90
@@ -82,6 +82,7 @@ END MODULE MODI_CH_AQUEOUS_SEDIM1MOM
!! 16/12/15 (M Leriche) compute instantaneous rain at the surface
! P. Wautelet 12/02/2019: bugfix: ZRR_SEDIM was not initialized everywhere
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
!
!-------------------------------------------------------------------------------
!
@@ -96,6 +97,8 @@ USE MODD_RAIN_ICE_DESCR, ONLY : WCEXVT=>XCEXVT, WRTMIN=>XRTMIN
USE MODD_RAIN_ICE_PARAM, ONLY : XFSEDR, XEXSEDR, &
XFSEDS, XEXSEDS, &
XFSEDG, XEXSEDG
+
+use mode_tools, only: Countjv
!
IMPLICIT NONE
!
@@ -373,43 +376,6 @@ IF (OUSECHIC) THEN
ENDDO
ENDIF
!
-CONTAINS
-!
-!-------------------------------------------------------------------------------
-!
- FUNCTION COUNTJV(LTAB,I1,I2,I3) RESULT(IC)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* 0.2 declaration of local variables
-!
-!
-LOGICAL, DIMENSION(:,:,:) :: LTAB ! Mask
-INTEGER, DIMENSION(:) :: I1,I2,I3 ! Used to replace the COUNT and PACK
-INTEGER :: IC
-INTEGER :: JI,JJ,JK
-!
-!-------------------------------------------------------------------------------
-!
-IC = 0
-DO JK = 1,SIZE(LTAB,3)
- DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ,JK) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- I3(IC) = JK
- END IF
- END DO
- END DO
-END DO
-!
-END FUNCTION COUNTJV
-!
!-------------------------------------------------------------------------------
!
END SUBROUTINE CH_AQUEOUS_SEDIM1MOM
diff --git a/src/MNH/ch_aqueous_sedim2mom.f90 b/src/MNH/ch_aqueous_sedim2mom.f90
index 926a552b3e28b8ea9f1f66f40a891319e7591f40..55b2d3090a8c75b977136d0b3a2dc601335f2bea 100644
--- a/src/MNH/ch_aqueous_sedim2mom.f90
+++ b/src/MNH/ch_aqueous_sedim2mom.f90
@@ -81,7 +81,8 @@ END MODULE MODI_CH_AQUEOUS_SEDIM2MOM
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! 01/16 M. Leriche : Fusion C2R2 and KHKO
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-!!
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -93,6 +94,7 @@ USE MODD_CST, ONLY : XRHOLW, XPI
USE MODD_RAIN_C2R2_DESCR, ONLY : XRTMIN, XCTMIN
!
USE MODE_ll
+use mode_tools, only: Countjv
!
IMPLICIT NONE
!
@@ -264,43 +266,6 @@ DO JL= 1, SIZE(PRSVS,4)
PRSVS(:,:,:,JL) = MAX( 0.0,ZSV_SEDIM_FACT(:,:,:)*PRSVS(:,:,:,JL) )
END DO
!
-CONTAINS
-!
-!-------------------------------------------------------------------------------
-!
- FUNCTION COUNTJV(LTAB,I1,I2,I3) RESULT(IC)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* 0.2 declaration of local variables
-!
-!
-LOGICAL, DIMENSION(:,:,:) :: LTAB ! Mask
-INTEGER, DIMENSION(:) :: I1,I2,I3 ! Used to replace the COUNT and PACK
-INTEGER :: IC
-INTEGER :: JI,JJ,JK
-!
-!-------------------------------------------------------------------------------
-!
-IC = 0
-DO JK = 1,SIZE(LTAB,3)
- DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ,JK) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- I3(IC) = JK
- END IF
- END DO
- END DO
-END DO
-!
-END FUNCTION COUNTJV
-!
!-------------------------------------------------------------------------------
!
END SUBROUTINE CH_AQUEOUS_SEDIM2MOM
diff --git a/src/MNH/ch_aqueous_sedimc2r2.f90JPP b/src/MNH/ch_aqueous_sedimc2r2.f90JPP
index b34aae9d1b891feac3466e10dfc00a99fca3e224..2627365be22072d9707bfb55193fbbd6078b49ec 100644
--- a/src/MNH/ch_aqueous_sedimc2r2.f90JPP
+++ b/src/MNH/ch_aqueous_sedimc2r2.f90JPP
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2008-2019 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.
+!-----------------------------------------------------------------
! ################################
MODULE MODI_CH_AQUEOUS_SEDIMC2R2
! ################################
@@ -71,6 +72,7 @@ END MODULE MODI_CH_AQUEOUS_SEDIMC2R2
!! -------------
!! Original 30/10/08
!!
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -85,6 +87,8 @@ USE MODD_RAIN_C2R2_DESCR, ONLY : XCEXVT, XRTMIN, XCTMIN, &
USE MODD_RAIN_C2R2_PARAM, ONLY : XFSEDRR, XFSEDCR
USE MODD_CH_MNHC_n, ONLY: XRTMIN_AQ
!
+use mode_tools, only: Countjv
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -300,43 +304,6 @@ DO JL= 1, SIZE(PRSVS,4)
PRSVS(:,:,:,JL) = MAX( 0.0,ZSV_SEDIM_FACT(:,:,:)*PRSVS(:,:,:,JL) )
END DO
!
-CONTAINS
-!
-!-------------------------------------------------------------------------------
-!
- FUNCTION COUNTJV(LTAB,I1,I2,I3) RESULT(IC)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* 0.2 declaration of local variables
-!
-!
-LOGICAL, DIMENSION(:,:,:) :: LTAB ! Mask
-INTEGER, DIMENSION(:) :: I1,I2,I3 ! Used to replace the COUNT and PACK
-INTEGER :: IC
-INTEGER :: JI,JJ,JK
-!
-!-------------------------------------------------------------------------------
-!
-IC = 0
-DO JK = 1,SIZE(LTAB,3)
- DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ,JK) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- I3(IC) = JK
- END IF
- END DO
- END DO
-END DO
-!
-END FUNCTION COUNTJV
-!
!-------------------------------------------------------------------------------
!
END SUBROUTINE CH_AQUEOUS_SEDIMC2R2
diff --git a/src/MNH/ch_aqueous_tmicc2r2.f90 b/src/MNH/ch_aqueous_tmicc2r2.f90
index b034de2e065304641e7d5cf685997adad080205e..463ce4238652ab665025bcec96199e685441306c 100644
--- a/src/MNH/ch_aqueous_tmicc2r2.f90
+++ b/src/MNH/ch_aqueous_tmicc2r2.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2008-2019 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.
+!-----------------------------------------------------------------
! ####################################
MODULE MODI_CH_AQUEOUS_TMICC2R2
! ####################################
@@ -72,7 +73,8 @@ END MODULE MODI_CH_AQUEOUS_TMICC2R2
!! Original 06/05/08
!! 2014 G.Delautier : remplace MODD_RAIN_C2R2_PARAM par MODD_RAIN_C2R2_KHKO_PARAM
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!!
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -90,7 +92,9 @@ USE MODD_RAIN_C2R2_KHKO_PARAM, ONLY : XAUTO1, XAUTO2, &
XACCR4, XACCR5, &
XACCR_RLARGE1, XACCR_RLARGE2, &
XACCR_RSMALL1, XACCR_RSMALL2
-!
+
+use mode_tools, only: Countjv
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -392,40 +396,4 @@ END IF
!
!-------------------------------------------------------------------------------
!
-!
-CONTAINS
-!
-!
- FUNCTION COUNTJV(LTAB,I1,I2,I3) RESULT(IC)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* 0.2 declaration of local variables
-!
-!
-LOGICAL, DIMENSION(:,:,:) :: LTAB ! Mask
-INTEGER, DIMENSION(:) :: I1,I2,I3 ! Used to replace the COUNT and PACK
-INTEGER :: JI,JJ,JK,IC
-!
-!-------------------------------------------------------------------------------
-!
-IC = 0
-DO JK = 1,SIZE(LTAB,3)
- DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ,JK) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- I3(IC) = JK
- END IF
- END DO
- END DO
-END DO
-!
-END FUNCTION COUNTJV
-!
END SUBROUTINE CH_AQUEOUS_TMICC2R2
diff --git a/src/MNH/ch_aqueous_tmicice.f90 b/src/MNH/ch_aqueous_tmicice.f90
index 213f6cdf58d5d8ca744a26d6423154b7a259d3f9..c0fc812219caa96684384ec073a03b668b8f0fbf 100644
--- a/src/MNH/ch_aqueous_tmicice.f90
+++ b/src/MNH/ch_aqueous_tmicice.f90
@@ -103,7 +103,8 @@ END MODULE MODI_CH_AQUEOUS_TMICICE
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! M.Leriche 2015 correction bug
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-!!
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -135,6 +136,7 @@ USE MODD_CH_ICE_n ! index for ice phase chemistry wit
#ifdef MNH_PGI
USE MODE_PACK_PGI
#endif
+use mode_tools, only: Countjv
!
IMPLICIT NONE
!
@@ -1296,43 +1298,6 @@ IF( IMICRO >= 1 ) THEN
!
END IF
!
-!
-!-------------------------------------------------------------------------------
-!
-!
-CONTAINS
-!
-!
- FUNCTION COUNTJV(LTAB,I1,I2,I3) RESULT(IC)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* 0.2 declaration of local variables
-!
-!
-LOGICAL, DIMENSION(:,:,:) :: LTAB ! Mask
-INTEGER, DIMENSION(:) :: I1,I2,I3 ! Used to replace the COUNT and PACK
-INTEGER :: JI,JJ,JK,IC
-!
!-------------------------------------------------------------------------------
!
-IC = 0
-DO JK = 1,SIZE(LTAB,3)
- DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ,JK) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- I3(IC) = JK
- END IF
- END DO
- END DO
-END DO
-!
-END FUNCTION COUNTJV
-!
END SUBROUTINE CH_AQUEOUS_TMICICE
diff --git a/src/MNH/ch_aqueous_tmickess.f90 b/src/MNH/ch_aqueous_tmickess.f90
index a428772a730ff22164d162686b4d4822db46243b..ff4a0bf33b81dee3b215e2632813b506884c16a6 100644
--- a/src/MNH/ch_aqueous_tmickess.f90
+++ b/src/MNH/ch_aqueous_tmickess.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2008-2019 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.
+!-----------------------------------------------------------------
! ####################################
MODULE MODI_CH_AQUEOUS_TMICKESS
! ####################################
@@ -69,7 +70,8 @@ END MODULE MODI_CH_AQUEOUS_TMICKESS
!! -------------
!! Original 26/03/08
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!!
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -80,7 +82,9 @@ USE MODD_PARAMETERS, ONLY : JPHEXT, &! number of horizontal External poi
USE MODD_CLOUDPAR, ONLY : XC1RC, XC2RC, &! autoconversion param.
XCEXRA, XCRA, &! accrection param.
XCEXVT ! constant in the rain drop fall velocity
-!
+
+use mode_tools, only: Countjv
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -281,43 +285,6 @@ IF( IMICRO >= 1 ) THEN
!
END IF
!
-!
!-------------------------------------------------------------------------------
!
-!
-CONTAINS
-!
-!
- FUNCTION COUNTJV(LTAB,I1,I2,I3) RESULT(IC)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* 0.2 declaration of local variables
-!
-!
-LOGICAL, DIMENSION(:,:,:) :: LTAB ! Mask
-INTEGER, DIMENSION(:) :: I1,I2,I3 ! Used to replace the COUNT and PACK
-INTEGER :: JI,JJ,JK,IC
-!
-!-------------------------------------------------------------------------------
-!
-IC = 0
-DO JK = 1,SIZE(LTAB,3)
- DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ,JK) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- I3(IC) = JK
- END IF
- END DO
- END DO
-END DO
-!
-END FUNCTION COUNTJV
-!
END SUBROUTINE CH_AQUEOUS_TMICKESS
diff --git a/src/MNH/ch_aqueous_tmickhko.f90 b/src/MNH/ch_aqueous_tmickhko.f90
index c93eb3a9da06a936ca8bfa9387766b258496eb4a..7369be14eb357a3112c9f118dc42228bd90f8605 100644
--- a/src/MNH/ch_aqueous_tmickhko.f90
+++ b/src/MNH/ch_aqueous_tmickhko.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2008-2019 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.
+!-----------------------------------------------------------------
! ####################################
MODULE MODI_CH_AQUEOUS_TMICKHKO
! ####################################
@@ -72,7 +73,8 @@ END MODULE MODI_CH_AQUEOUS_TMICKHKO
!! -------------
!! Original 03/11/08
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!!
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -81,7 +83,9 @@ END MODULE MODI_CH_AQUEOUS_TMICKHKO
USE MODD_PARAMETERS,ONLY: JPHEXT, &! number of horizontal External points
JPVEXT ! number of vertical External points
USE MODD_RAIN_C2R2_DESCR, ONLY : XRTMIN, XCTMIN
-!
+
+use mode_tools, only: Countjv
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -319,40 +323,4 @@ END IF
!
!-------------------------------------------------------------------------------
!
-!
-CONTAINS
-!
-!
- FUNCTION COUNTJV(LTAB,I1,I2,I3) RESULT(IC)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* 0.2 declaration of local variables
-!
-!
-LOGICAL, DIMENSION(:,:,:) :: LTAB ! Mask
-INTEGER, DIMENSION(:) :: I1,I2,I3 ! Used to replace the COUNT and PACK
-INTEGER :: JI,JJ,JK,IC
-!
-!-------------------------------------------------------------------------------
-!
-IC = 0
-DO JK = 1,SIZE(LTAB,3)
- DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ,JK) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- I3(IC) = JK
- END IF
- END DO
- END DO
-END DO
-!
-END FUNCTION COUNTJV
-!
END SUBROUTINE CH_AQUEOUS_TMICKHKO
diff --git a/src/MNH/ice4_fast_rg.f90 b/src/MNH/ice4_fast_rg.f90
index 28b9911e46bae0e1a32e0398d9c0a4eb12eab952..90f968144039a8d75f53503389af1e92f3b7511e 100644
--- a/src/MNH/ice4_fast_rg.f90
+++ b/src/MNH/ice4_fast_rg.f90
@@ -93,6 +93,7 @@ SUBROUTINE ICE4_FAST_RG(KSIZE, LDSOFT, LDCOMPUTE, KRR, &
!! -------------
!!
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
!
!
!* 0. DECLARATIONS
@@ -345,7 +346,6 @@ ENDIF
! Wet and dry collection of rs on graupel (6.2.1)
IGDRY = 0
-GDRY(:) = .FALSE.
!$acc loop private(IDX) independent
DO JJ = 1, SIZE(GDRY)
IF (PRST(JJ)>XRTMIN(5) .AND. PRGT(JJ)>XRTMIN(6) .AND. LDCOMPUTE(JJ)) THEN
@@ -355,6 +355,8 @@ DO JJ = 1, SIZE(GDRY)
!$acc end atomic
I1(IDX) = JJ
GDRY(JJ) = .TRUE.
+ ELSE
+ GDRY(JJ) = .FALSE.
END IF
END DO
!$acc end kernels
@@ -380,15 +382,10 @@ ELSE
!
!* 6.2.3 select the (PLBDAG,PLBDAS) couplet
!
-#ifndef _OPENACC
- ZVEC1(1:IGDRY)=PACK(PLBDAG(:), MASK=GDRY(:))
- ZVEC2(1:IGDRY)=PACK(PLBDAS(:), MASK=GDRY(:))
-#else
DO JJ = 1, IGDRY
ZVEC1(JJ) = PLBDAG(I1(JJ))
ZVEC2(JJ) = PLBDAS(I1(JJ))
END DO
-#endif
!
!* 6.2.4 find the next lower indice for the PLBDAG and for the PLBDAS
! in the geometrical set of (Lbda_g,Lbda_s) couplet use to
@@ -423,14 +420,10 @@ ELSE
- XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
*(ZVEC1(JJ) - 1.0)
END DO
-#ifndef _OPENACC
- ZZW(:)=UNPACK(VECTOR=ZVEC3(1:IGDRY), MASK=GDRY(:), FIELD=0.0)
-#else
ZZW(:) = 0.
DO JJ = 1, IGDRY
ZZW(I1(JJ)) = ZVEC3(JJ)
END DO
-#endif
!
WHERE(GDRY(:))
#ifndef MNH_BITREP
@@ -461,7 +454,6 @@ ENDIF
!* 6.2.6 accretion of raindrops on the graupeln
!
IGDRY = 0
-GDRY(:) = .FALSE.
!$acc loop private(IDX) independent
DO JJ = 1, SIZE(GDRY)
IF (PRRT(JJ)>XRTMIN(3) .AND. PRGT(JJ)>XRTMIN(6) .AND. LDCOMPUTE(JJ)) THEN
@@ -471,6 +463,8 @@ DO JJ = 1, SIZE(GDRY)
!$acc end atomic
I1(IDX) = JJ
GDRY(JJ) = .TRUE.
+ ELSE
+ GDRY(JJ) = .FALSE.
END IF
END DO
!$acc end kernels
@@ -495,15 +489,10 @@ ELSE
!
!* 6.2.8 select the (PLBDAG,PLBDAR) couplet
!
-#ifndef _OPENACC
- ZVEC1(1:IGDRY)=PACK(PLBDAG(:), MASK=GDRY(:))
- ZVEC2(1:IGDRY)=PACK(PLBDAR(:), MASK=GDRY(:))
-#else
DO JJ = 1, IGDRY
ZVEC1(JJ) = PLBDAG(I1(JJ))
ZVEC2(JJ) = PLBDAR(I1(JJ))
END DO
-#endif
!
!* 6.2.9 find the next lower indice for the PLBDAG and for the PLBDAR
! in the geometrical set of (Lbda_g,Lbda_r) couplet use to
@@ -538,14 +527,10 @@ ELSE
- XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
*(ZVEC1(JJ) - 1.0)
END DO
-#ifndef _OPENACC
- ZZW(:)=UNPACK(VECTOR=ZVEC3(1:IGDRY), MASK=GDRY, FIELD=0.)
-#else
ZZW(:) = 0.
DO JJ = 1, IGDRY
ZZW(I1(JJ)) = ZVEC3(JJ)
END DO
-#endif
!
WHERE(GDRY(:))
#ifndef MNH_BITREP
diff --git a/src/MNH/ice4_fast_rh.f90 b/src/MNH/ice4_fast_rh.f90
index 07f6275e9ad070aa50e6442a9216417f66bf3a57..35122273ec8b9aeb9f287b82f8c1e5d38c159938 100644
--- a/src/MNH/ice4_fast_rh.f90
+++ b/src/MNH/ice4_fast_rh.f90
@@ -83,6 +83,7 @@ SUBROUTINE ICE4_FAST_RH(KSIZE, LDSOFT, LDCOMPUTE, LDWETG, &
!! -------------
!!
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
!
!
!* 0. DECLARATIONS
@@ -275,7 +276,6 @@ ENDIF
!* 7.2.1 accretion of aggregates on the hailstones
!
IGWET = 0
-GWET(:) = .FALSE.
!$acc loop private(IDX) independent
DO JJ = 1, SIZE(GWET)
IF (PRHT(JJ)>XRTMIN(7) .AND. PRST(JJ)>XRTMIN(5) .AND. LDCOMPUTE(JJ)) THEN
@@ -285,6 +285,8 @@ DO JJ = 1, SIZE(GWET)
!$acc end atomic
I1(IDX) = JJ
GWET(JJ) = .TRUE.
+ ELSE
+ GWET(JJ) = .FALSE.
END IF
END DO
!$acc end kernels
@@ -310,15 +312,10 @@ ELSE
!
!* 7.2.3 select the (PLBDAH,PLBDAS) couplet
!
-#ifndef _OPENACC
- ZVEC1(1:IGWET) = PACK( PLBDAH(:),MASK=GWET(:) )
- ZVEC2(1:IGWET) = PACK( PLBDAS(:),MASK=GWET(:) )
-#else
DO JJ = 1, IGWET
ZVEC1(JJ) = PLBDAH(I1(JJ))
ZVEC2(JJ) = PLBDAS(I1(JJ))
END DO
-#endif
!
!* 7.2.4 find the next lower indice for the PLBDAG and for the PLBDAS
! in the geometrical set of (Lbda_h,Lbda_s) couplet use to
@@ -353,14 +350,10 @@ ELSE
- XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* (ZVEC1(JJ) - 1.0)
END DO
-#ifndef _OPENACC
- ZZW(:) = UNPACK( VECTOR=ZVEC3(1:IGWET),MASK=GWET,FIELD=0.0 )
-#else
ZZW(:) = 0.
DO JJ = 1, IGWET
ZZW(I1(JJ)) = ZVEC3(JJ)
END DO
-#endif
!
WHERE(GWET(:))
#ifndef MNH_BITREP
@@ -389,7 +382,6 @@ ENDIF
!
!$acc kernels
IGWET = 0
-GWET(:) = .FALSE.
!$acc loop private(IDX) independent
DO JJ = 1, SIZE(GWET)
IF (PRHT(JJ)>XRTMIN(7) .AND. PRGT(JJ)>XRTMIN(6) .AND. LDCOMPUTE(JJ)) THEN
@@ -399,6 +391,8 @@ DO JJ = 1, SIZE(GWET)
!$acc end atomic
I1(IDX) = JJ
GWET(JJ) = .TRUE.
+ ELSE
+ GWET(JJ) = .FALSE.
END IF
END DO
!$acc end kernels
@@ -424,15 +418,10 @@ ELSE
!
!* 7.2.8 select the (PLBDAH,PLBDAG) couplet
!
-#ifndef _OPENACC
- ZVEC1(1:IGWET) = PACK( PLBDAH(:),MASK=GWET(:) )
- ZVEC2(1:IGWET) = PACK( PLBDAG(:),MASK=GWET(:) )
-#else
DO JJ = 1, IGWET
ZVEC1(JJ) = PLBDAH(I1(JJ))
ZVEC2(JJ) = PLBDAG(I1(JJ))
END DO
-#endif
!
!* 7.2.9 find the next lower indice for the PLBDAH and for the PLBDAG
! in the geometrical set of (Lbda_h,Lbda_g) couplet use to
@@ -467,14 +456,10 @@ ELSE
- XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* (ZVEC1(JJ) - 1.0)
END DO
-#ifndef _OPENACC
- ZZW(:) = UNPACK( VECTOR=ZVEC3(1:IGWET),MASK=GWET,FIELD=0.0 )
-#else
ZZW(:) = 0.
DO JJ = 1, IGWET
ZZW(I1(JJ)) = ZVEC3(JJ)
END DO
-#endif
!
WHERE(GWET(:))
#ifndef MNH_BITREP
@@ -510,7 +495,6 @@ ENDIF
!* 7.2.11 accretion of raindrops on the hailstones
!
IGWET = 0
-GWET(:) = .FALSE.
!$acc loop private(IDX) independent
DO JJ = 1, SIZE(GWET)
IF (PRHT(JJ)>XRTMIN(7) .AND. PRRT(JJ)>XRTMIN(3) .AND. LDCOMPUTE(JJ)) THEN
@@ -520,6 +504,8 @@ DO JJ = 1, SIZE(GWET)
!$acc end atomic
I1(IDX) = JJ
GWET(JJ) = .TRUE.
+ ELSE
+ GWET(JJ) = .FALSE.
END IF
END DO
!$acc end kernels
@@ -543,15 +529,10 @@ ELSE
!
!* 7.2.12 select the (PLBDAH,PLBDAR) couplet
!
-#ifndef _OPENACC
- ZVEC1(1:IGWET)=PACK(PLBDAH(:), MASK=GWET(:))
- ZVEC2(1:IGWET)=PACK(PLBDAR(:), MASK=GWET(:))
-#else
DO JJ = 1, IGWET
ZVEC1(JJ) = PLBDAH(I1(JJ))
ZVEC2(JJ) = PLBDAR(I1(JJ))
END DO
-#endif
!
!* 7.2.13 find the next lower indice for the PLBDAH and for the PLBDAR
! in the geometrical set of (Lbda_h,Lbda_r) couplet use to
@@ -586,14 +567,10 @@ ELSE
- XKER_RWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
*(ZVEC1(JJ) - 1.0)
END DO
-#ifndef _OPENACC
- ZZW(:)=UNPACK(VECTOR=ZVEC3(1:IGWET), MASK=GWET, FIELD=0.)
-#else
ZZW(:) = 0.
DO JJ = 1, IGWET
ZZW(I1(JJ)) = ZVEC3(JJ)
END DO
-#endif
!
WHERE(GWET(:))
#ifndef MNH_BITREP
diff --git a/src/MNH/ice4_fast_rs.f90 b/src/MNH/ice4_fast_rs.f90
index 93a2d4384ae9dd4c59374a2473e0ede0ae0fbee0..a1689ce7dd5e39766097f12deedc02d39fa49031 100644
--- a/src/MNH/ice4_fast_rs.f90
+++ b/src/MNH/ice4_fast_rs.f90
@@ -76,6 +76,7 @@ SUBROUTINE ICE4_FAST_RS(KSIZE, LDSOFT, LDCOMPUTE, &
!! -------------
!!
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
!
!
!* 0. DECLARATIONS
@@ -242,7 +243,6 @@ END WHERE
!* 5.1 cloud droplet riming of the aggregates
!
IGRIM = 0
-GRIM(:) = .FALSE.
!$acc loop private(IDX) independent
DO JJ = 1, SIZE(GRIM)
IF (PRCT(JJ)>XRTMIN(2) .AND. PRST(JJ)>XRTMIN(5) .AND. LDCOMPUTE(JJ)) THEN
@@ -252,6 +252,8 @@ DO JJ = 1, SIZE(GRIM)
!$acc end atomic
I1(IDX) = JJ
GRIM(JJ) = .TRUE.
+ ELSE
+ GRIM(JJ) = .FALSE.
END IF
END DO
!$acc end kernels
@@ -282,13 +284,9 @@ ELSE
! 5.1.1 select the PLBDAS
!
!$acc kernels
-#ifndef _OPENACC
- ZVEC1(1:IGRIM) = PACK( PLBDAS(:),MASK=GRIM(:) )
-#else
DO JJ = 1, IGRIM
ZVEC1(JJ) = PLBDAS(I1(JJ))
END DO
-#endif
!
! 5.1.2 find the next lower indice for the PLBDAS in the geometrical
! set of Lbda_s used to tabulate some moments of the incomplete
@@ -308,14 +306,10 @@ ELSE
!
ZVEC1(1:IGRIM) = XGAMINC_RIM1( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
- XGAMINC_RIM1( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
-#ifndef _OPENACC
- ZZW(:) = UNPACK( VECTOR=ZVEC1(1:IGRIM),MASK=GRIM,FIELD=0.0 )
-#else
ZZW(:) = 0.
DO JJ = 1, IGRIM
ZZW(I1(JJ)) = ZVEC1(JJ)
END DO
-#endif
!
! 5.1.4 riming of the small sized aggregates
!
@@ -336,25 +330,17 @@ ELSE
!
ZVEC1(1:IGRIM) = XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
- XGAMINC_RIM2( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
-#ifndef _OPENACC
- ZZW(:) = UNPACK( VECTOR=ZVEC1(1:IGRIM),MASK=GRIM,FIELD=0.0 )
-#else
ZZW(:) = 0.
DO JJ = 1, IGRIM
ZZW(I1(JJ)) = ZVEC1(JJ)
END DO
-#endif
ZVEC1(1:IGRIM) = XGAMINC_RIM4( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
- XGAMINC_RIM4( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
-#ifndef _OPENACC
- ZZW2(:) = UNPACK( VECTOR=ZVEC1(1:IGRIM),MASK=GRIM,FIELD=0.0)
-#else
ZZW2(:) = 0.
DO JJ = 1, IGRIM
ZZW2(I1(JJ)) = ZVEC1(JJ)
END DO
-#endif
!
! 5.1.6 riming-conversion of the large sized aggregates into graupeln
!
@@ -424,7 +410,6 @@ PA_TH(:) = PA_TH(:) + PRCRIMSG(:)*(PLSFACT(:)-PLVFACT(:))
!* 5.2 rain accretion onto the aggregates
!
IGACC = 0
-GACC(:) = .FALSE.
!$acc loop private(IDX) independent
DO JJ = 1, SIZE(GACC)
IF (PRRT(JJ)>XRTMIN(3) .AND. PRST(JJ)>XRTMIN(5) .AND. LDCOMPUTE(JJ)) THEN
@@ -434,6 +419,8 @@ DO JJ = 1, SIZE(GACC)
!$acc end atomic
I1(IDX) = JJ
GACC(JJ) = .TRUE.
+ ELSE
+ GACC(JJ) = .FALSE.
END IF
END DO
!$acc end kernels
@@ -463,15 +450,10 @@ ELSE
!
! 5.2.1 select the (PLBDAS,PLBDAR) couplet
!
-#ifndef _OPENACC
- ZVEC1(1:IGACC) = PACK( PLBDAS(:),MASK=GACC(:) )
- ZVEC2(1:IGACC) = PACK( PLBDAR(:),MASK=GACC(:) )
-#else
DO JJ = 1, IGACC
ZVEC1(JJ) = PLBDAS(I1(JJ))
ZVEC2(JJ) = PLBDAR(I1(JJ))
END DO
-#endif
!
! 5.2.2 find the next lower indice for the PLBDAS and for the PLBDAR
! in the geometrical set of (Lbda_s,Lbda_r) couplet use to
@@ -506,14 +488,10 @@ ELSE
- XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* (ZVEC1(JJ) - 1.0)
END DO
-#ifndef _OPENACC
- ZZW(:) = UNPACK( VECTOR=ZVEC3(1:IGACC),MASK=GACC,FIELD=0.0 )
-#else
ZZW(:) = 0.
DO JJ = 1, IGACC
ZZW(I1(JJ)) = ZVEC3(JJ)
END DO
-#endif
!
! 5.2.4 raindrop accretion on the small sized aggregates
!
@@ -545,14 +523,10 @@ ELSE
- XKER_RACCS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* (ZVEC1(JJ) - 1.0)
END DO
-#ifndef _OPENACC
- ZZW(:) = UNPACK( VECTOR=ZVEC3(1:IGACC),MASK=GACC(:),FIELD=0.0 )
-#else
ZZW(:) = 0.
DO JJ = 1, IGACC
ZZW(I1(JJ)) = ZVEC3(JJ)
END DO
-#endif
WHERE(GACC(:))
PRS_TEND(:, IRRACCS) = ZZW(:)*ZZW6(:)
END WHERE
@@ -567,14 +541,10 @@ ELSE
- XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
* (ZVEC2(JJ) - 1.0)
END DO
-#ifndef _OPENACC
- ZZW(:) = UNPACK( VECTOR=ZVEC3(1:IGACC),MASK=GACC,FIELD=0.0 )
-#else
ZZW(:) = 0.
DO JJ = 1, IGACC
ZZW(I1(JJ)) = ZVEC3(JJ)
END DO
-#endif
!
! 5.2.6 raindrop accretion-conversion of the large sized aggregates
! into graupeln
diff --git a/src/MNH/ice4_nucleation_wrapper.f90 b/src/MNH/ice4_nucleation_wrapper.f90
index da1d6e311ec50f48d93233f718ee84fa7917bfe0..328fd5f3c2f38f482f78796a9237ffbbef9ed28e 100644
--- a/src/MNH/ice4_nucleation_wrapper.f90
+++ b/src/MNH/ice4_nucleation_wrapper.f90
@@ -2,6 +2,7 @@
!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.
+!-----------------------------------------------------------------
MODULE MODI_ICE4_NUCLEATION_WRAPPER
INTERFACE
SUBROUTINE ICE4_NUCLEATION_WRAPPER(KIT, KJT,KKT, LDMASK, &
@@ -38,16 +39,22 @@ SUBROUTINE ICE4_NUCLEATION_WRAPPER(KIT, KJT, KKT, LDMASK, &
!!
!! MODIFICATIONS
!! -------------
-!!
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
+!
!
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY : XTT
-!
+USE MODD_CST, ONLY: XTT
+
USE MODE_MPPDB
-!
+use mode_tools, only: Countjv
+#ifdef _OPENACC
+use mode_tools, only: Countjv_device
+#endif
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -137,9 +144,9 @@ ZB_RI(:) = 0.
!$acc end kernels
!
#ifndef _OPENACC
-IF(INEGT>0) INEGT_TMP=ICE4_NUCLEATION_COUNTJV(GNEGT(:,:,:), KIT, KJT, KKT, SIZE(I1), I1(:), I2(:), I3(:))
+IF(INEGT>0) INEGT_TMP=COUNTJV(GNEGT(:,:,:), I1(:), I2(:), I3(:))
#else
-IF(INEGT>0) CALL ICE4_NUCLEATION_COUNTJVD_DEVICE(GNEGT(:,:,:),I1(:),I2(:),I3(:),INEGT_TMP)
+IF(INEGT>0) CALL COUNTJV_DEVICE(GNEGT(:,:,:),I1(:),I2(:),I3(:),INEGT_TMP)
#endif
!
!$acc kernels
@@ -165,10 +172,6 @@ IF(INEGT>0) THEN
ZTHT, ZPRES, ZRHODREF, ZEXN, ZLSFACT, ZZT, &
ZRVT, &
ZCIT, ZRVHENI_MR, ZB_TH, ZB_RV, ZB_RI)
-#ifndef _OPENACC
- PRVHENI_MR(:,:,:)=UNPACK(ZRVHENI_MR(:), MASK=GNEGT(:,:,:), FIELD=0.0)
- PCIT(:,:,:) =UNPACK(ZCIT(:), MASK=GNEGT(:,:,:), FIELD=PCIT(:,:,:))
-#else
!$acc kernels
PRVHENI_MR(:,:,:)= 0.0
!$acc loop independent
@@ -177,7 +180,6 @@ IF(INEGT>0) THEN
PCIT (I1(JL), I2(JL), I3(JL)) = ZCIT (JL)
END DO
!$acc end kernels
-#endif
END IF
!
DEALLOCATE(GLDCOMPUTE)
@@ -191,76 +193,4 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PRVHENI_MR,"ICE4_NUCLEATION_WRAPPER end:PRVHENI_MR")
END IF
!
-CONTAINS
- FUNCTION ICE4_NUCLEATION_COUNTJV(LTAB,KIT,KJT,KKT,KSIZE,I1,I2,I3) RESULT(IC)
- IMPLICIT NONE
- INTEGER, INTENT(IN) :: KIT, KJT, KKT, KSIZE
- LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: LTAB ! Mask
- INTEGER, DIMENSION(KSIZE), INTENT(OUT) :: I1, I2, I3 ! Used to replace the COUNT and PACK
- INTEGER :: IC
- INTEGER :: JI, JJ, JK
- IC=0
- DO JK=1, SIZE(LTAB,3)
- DO JJ=1, SIZE(LTAB,2)
- DO JI=1, SIZE(LTAB,1)
- IF(LTAB(JI,JJ,JK)) THEN
- IC=IC+1
- I1(IC)=JI
- I2(IC)=JJ
- I3(IC)=JK
- END IF
- END DO
- END DO
- END DO
- END FUNCTION ICE4_NUCLEATION_COUNTJV
- !
-#ifdef _OPENACC
- SUBROUTINE ICE4_NUCLEATION_COUNTJVD_DEVICE(LTAB,I1,I2,I3,IC)
- !
- IMPLICIT NONE
- !
- LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: LTAB ! Mask
- INTEGER, DIMENSION(:), INTENT(OUT) :: I1,I2,I3 ! Used to replace the COUNT and PACK
- INTEGER, INTENT(OUT) :: IC ! Count
-!$acc declare present(LTAB,I1,I2,I3,IC)
- !
- INTEGER :: JI,JJ,JK,IDX
- !
- !-------------------------------------------------------------------------------
- !
-!$acc kernels present(LTAB,I1,I2,I3)
-
- !To allow comparisons... (I1/I2/I3 are not fully used)
- !Can be removed in production
- ! I1(:) = -999
- ! I2(:) = -999
- ! I3(:) = -999
-
-
- IC = 0
- !Warning: if "independent" is set, content of I1, I2 and I3 can vary between 2
- ! different runs of this subroutine BUT final result should be the same
- !Comment the following line + atomic directives to have consistent values for debugging
- !Warning: huge impact on performance
-!$acc loop collapse(3) private(IDX) independent
- DO JK = 1,SIZE(LTAB,3)
- DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ,JK) ) THEN
-!$acc atomic capture
- IC = IC +1
- IDX = IC
-!$acc end atomic
- I1(IDX) = JI
- I2(IDX) = JJ
- I3(IDX) = JK
- END IF
- END DO
- END DO
- END DO
-!$acc end kernels
-!
- END SUBROUTINE ICE4_NUCLEATION_COUNTJVD_DEVICE
-#endif
- !
END SUBROUTINE ICE4_NUCLEATION_WRAPPER
diff --git a/src/MNH/ice4_rsrimcg_old.f90 b/src/MNH/ice4_rsrimcg_old.f90
index e015f206491f27d7a1da3ad3a49a13d59a39476c..19022b11d3a83a9af3eabca5d3a3a14439c83837 100644
--- a/src/MNH/ice4_rsrimcg_old.f90
+++ b/src/MNH/ice4_rsrimcg_old.f90
@@ -43,6 +43,7 @@ SUBROUTINE ICE4_RSRIMCG_OLD(KSIZE, ODSOFT, ODCOMPUTE, &
!! -------------
!!
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
!
!
!* 0. DECLARATIONS
@@ -137,13 +138,9 @@ IF(.NOT. GDSOFT) THEN
!
! 5.1.1 select the PLBDAS
!
-#ifndef _OPENACC
- ZVEC1(1:IGRIM) = PACK( PLBDAS(:),MASK=GRIM(:) )
-#else
DO JL = 1, IGRIM
ZVEC1(JL) = PLBDAS(IVEC1(JL))
END DO
-#endif
!
! 5.1.2 find the next lower indice for the PLBDAS in the geometrical
! set of Lbda_s used to tabulate some moments of the incomplete
@@ -164,14 +161,10 @@ IF(.NOT. GDSOFT) THEN
!
ZVEC1(1:IGRIM) = XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
- XGAMINC_RIM2( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
-#ifndef _OPENACC
- ZZW(:) = UNPACK( VECTOR=ZVEC1(1:IGRIM),MASK=GRIM,FIELD=0.0 )
-#else
ZZW(:) = 0.
DO JL = 1, IGRIM
ZZW(IVEC1(JL)) = ZVEC1(JL)
END DO
-#endif
!
! 5.1.6 riming-conversion of the large sized aggregates into graupeln
!
diff --git a/src/MNH/ice4_sedimentation_split_momentum.f90 b/src/MNH/ice4_sedimentation_split_momentum.f90
index 866948ea31112e8b1e84f359813f9397572aef8b..927eb8ba536c7a0c0d726272ee4acafd8594892a 100644
--- a/src/MNH/ice4_sedimentation_split_momentum.f90
+++ b/src/MNH/ice4_sedimentation_split_momentum.f90
@@ -69,17 +69,21 @@ SUBROUTINE ICE4_SEDIMENTATION_SPLIT_MOMENTUM(KIB, KIE, KIT, KJB, KJE, KJT, KKB,
!! -------------
!!
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
!
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CST
+USE MODD_PARAM_ICE
USE MODD_RAIN_ICE_DESCR
USE MODD_RAIN_ICE_PARAM
-USE MODD_PARAM_ICE
-USE MODI_GAMMA
+
USE MODE_MSG
+use mode_tools, only: Countjv
+
+USE MODI_GAMMA
!
IMPLICIT NONE
!
@@ -223,8 +227,7 @@ IF (OSEDIC) THEN
ZPRCS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(2)) .AND. &
ZREMAINT(KIB:KIE,KJB:KJE)>0.
ENDDO
- ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,&
- &SIZE(I1),I1(:),I2(:),I3(:))
+ ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
&OMOMENTUM, FIRST .AND. OMOMENTUM, &
&ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
@@ -248,8 +251,7 @@ DO WHILE (ANY(ZREMAINT>0.))
ZPRRS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(3)) .AND. &
ZREMAINT(KIB:KIE,KJB:KJE)>0.
ENDDO
- ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,&
- &SIZE(I1),I1(:),I2(:),I3(:))
+ ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
&OMOMENTUM, FIRST .AND. OMOMENTUM, &
&ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
@@ -272,8 +274,7 @@ DO WHILE (ANY(ZREMAINT>0.))
ZPRIS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(4)) .AND. &
ZREMAINT(KIB:KIE,KJB:KJE)>0.
ENDDO
- ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,&
- &SIZE(I1),I1(:),I2(:),I3(:))
+ ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
&OMOMENTUM, FIRST .AND. OMOMENTUM, &
&ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
@@ -295,8 +296,7 @@ DO WHILE (ANY(ZREMAINT>0.))
ZPRSS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(5)) .AND. &
ZREMAINT(KIB:KIE,KJB:KJE)>0.
ENDDO
- ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,&
- &SIZE(I1),I1(:),I2(:),I3(:))
+ ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
&OMOMENTUM, FIRST .AND. OMOMENTUM, &
&ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
@@ -318,8 +318,7 @@ DO WHILE (ANY(ZREMAINT>0.))
ZPRGS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(6)) .AND. &
ZREMAINT(KIB:KIE,KJB:KJE)>0.
ENDDO
- ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,&
- &SIZE(I1),I1(:),I2(:),I3(:))
+ ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
&OMOMENTUM, FIRST .AND. OMOMENTUM, &
&ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
@@ -342,8 +341,7 @@ IF (KRR==7) THEN
ZPRHS(KIB:KIE,KJB:KJE,JK)>ZRSMIN(7)) .AND. &
ZREMAINT(KIB:KIE,KJB:KJE)>0.
ENDDO
- ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,&
- &SIZE(I1),I1(:),I2(:),I3(:))
+ ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKB, KKTB, KKTE, KKT, KKL, KRR, &
&OMOMENTUM, FIRST .AND. OMOMENTUM, &
&ISEDIM, GSEDIM, I1, I2, I3, XSPLIT_MAXCFL, ZREMAINT, &
@@ -576,36 +574,4 @@ CONTAINS
!
END SUBROUTINE INTERNAL_SEDIM_SPLI
!
- FUNCTION ICE4_SEDIMENTATION_SPLIT_COUNTJV(LTAB,KIT,KJT,KKT,KSIZE,I1,I2,I3) RESULT(IC)
- !
- !* 0. DECLARATIONS
- ! ------------
- !
- IMPLICIT NONE
- !
- !* 0.2 declaration of local variables
- !
- INTEGER, INTENT(IN) :: KIT,KJT,KKT,KSIZE
- LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: LTAB ! Mask
- INTEGER, DIMENSION(KSIZE), INTENT(OUT) :: I1,I2,I3 ! Used to replace the COUNT and PACK
- INTEGER :: JI,JJ,JK,IC
- !
- !-------------------------------------------------------------------------------
- !
- IC = 0
- DO JK = 1,SIZE(LTAB,3)
- DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ,JK) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- I3(IC) = JK
- END IF
- END DO
- END DO
- END DO
- !
- END FUNCTION ICE4_SEDIMENTATION_SPLIT_COUNTJV
- !
END SUBROUTINE ICE4_SEDIMENTATION_SPLIT_MOMENTUM
diff --git a/src/MNH/ice4_sedimentation_split_old.f90 b/src/MNH/ice4_sedimentation_split_old.f90
index 777b82a304f3bbd18c04c4d8098bd651245a6b97..47095b89e40dd5e36d700b22d0c611e22130bade 100644
--- a/src/MNH/ice4_sedimentation_split_old.f90
+++ b/src/MNH/ice4_sedimentation_split_old.f90
@@ -69,18 +69,22 @@ SUBROUTINE ICE4_SEDIMENTATION_SPLIT_OLD(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE,
!!
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
!
!
!* 0. DECLARATIONS
! ------------
!
+USE MODD_BUDGET
USE MODD_CST
USE MODD_RAIN_ICE_DESCR
USE MODD_RAIN_ICE_PARAM
+
+USE MODE_MSG
+use mode_tools, only: Countjv
+
USE MODI_BUDGET
-USE MODD_BUDGET
USE MODI_GAMMA
-USE MODE_MSG
!
IMPLICIT NONE
!
@@ -220,8 +224,7 @@ DO JN = 1 , KSPLITR
GSEDIM(:,:,:)=.FALSE.
GSEDIM(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
ZRCT(KIB:KIE,KJB:KJE,KKTB:KKTE)>XRTMIN(2)
- ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,&
- &SIZE(I1),I1(:),I2(:),I3(:))
+ ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKT, KKL, &
&ISEDIM, GSEDIM, I1, I2, I3, &
&PRHODREF, ZW, PPABST, PTHT, PSEA, PTOWN, ZTSPLITR, PTSTEP, &
@@ -241,8 +244,7 @@ DO JN = 1 , KSPLITR
GSEDIM(:,:,:)=.FALSE.
GSEDIM(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
ZRRT(KIB:KIE,KJB:KJE,KKTB:KKTE)>XRTMIN(3)
- ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,&
- &SIZE(I1),I1(:),I2(:),I3(:))
+ ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKT, KKL, &
&ISEDIM, GSEDIM, I1, I2, I3, &
&PRHODREF, ZW, PPABST, PTHT, PSEA, PTOWN, ZTSPLITR, PTSTEP, &
@@ -260,8 +262,7 @@ DO JN = 1 , KSPLITR
GSEDIM(:,:,:)=.FALSE.
GSEDIM(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
ZRIT(KIB:KIE,KJB:KJE,KKTB:KKTE)>XRTMIN(4)
- ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,&
- &SIZE(I1),I1(:),I2(:),I3(:))
+ ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKT, KKL, &
&ISEDIM, GSEDIM, I1, I2, I3, &
&PRHODREF, ZW, PPABST, PTHT, PSEA, PTOWN, ZTSPLITR, PTSTEP, &
@@ -279,8 +280,7 @@ DO JN = 1 , KSPLITR
GSEDIM(:,:,:)=.FALSE.
GSEDIM(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
ZRST(KIB:KIE,KJB:KJE,KKTB:KKTE)>XRTMIN(5)
- ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,&
- &SIZE(I1),I1(:),I2(:),I3(:))
+ ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKT, KKL, &
&ISEDIM, GSEDIM, I1, I2, I3, &
&PRHODREF, ZW, PPABST, PTHT, PSEA, PTOWN, ZTSPLITR, PTSTEP, &
@@ -298,8 +298,7 @@ DO JN = 1 , KSPLITR
GSEDIM(:,:,:)=.FALSE.
GSEDIM(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
ZRGT(KIB:KIE,KJB:KJE,KKTB:KKTE)>XRTMIN(6)
- ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,&
- &SIZE(I1),I1(:),I2(:),I3(:))
+ ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKT, KKL, &
&ISEDIM, GSEDIM, I1, I2, I3, &
&PRHODREF, ZW, PPABST, PTHT, PSEA, PTOWN, ZTSPLITR, PTSTEP, &
@@ -318,8 +317,7 @@ DO JN = 1 , KSPLITR
GSEDIM(:,:,:)=.FALSE.
GSEDIM(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
ZRHT(KIB:KIE,KJB:KJE,KKTB:KKTE)>XRTMIN(7)
- ISEDIM = ICE4_SEDIMENTATION_SPLIT_COUNTJV(GSEDIM(:,:,:),KIT,KJT,KKT,&
- &SIZE(I1),I1(:),I2(:),I3(:))
+ ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKT, KKL, &
&ISEDIM, GSEDIM, I1, I2, I3, &
&PRHODREF, ZW, PPABST, PTHT, PSEA, PTOWN, ZTSPLITR, PTSTEP, &
@@ -462,36 +460,4 @@ CONTAINS
ENDDO
END SUBROUTINE INTERNAL_SEDIM_SPLI
!
- FUNCTION ICE4_SEDIMENTATION_SPLIT_COUNTJV(LTAB,KIT,KJT,KKT,KSIZE,I1,I2,I3) RESULT(IC)
- !
- !* 0. DECLARATIONS
- ! ------------
- !
- IMPLICIT NONE
- !
- !* 0.2 declaration of local variables
- !
- INTEGER, INTENT(IN) :: KIT,KJT,KKT,KSIZE
- LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: LTAB ! Mask
- INTEGER, DIMENSION(KSIZE), INTENT(OUT) :: I1,I2,I3 ! Used to replace the COUNT and PACK
- INTEGER :: JI,JJ,JK,IC
- !
- !-------------------------------------------------------------------------------
- !
- IC = 0
- DO JK = 1,SIZE(LTAB,3)
- DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ,JK) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- I3(IC) = JK
- END IF
- END DO
- END DO
- END DO
- !
- END FUNCTION ICE4_SEDIMENTATION_SPLIT_COUNTJV
- !
END SUBROUTINE ICE4_SEDIMENTATION_SPLIT_OLD
diff --git a/src/MNH/ice4_sedimentation_stat.f90 b/src/MNH/ice4_sedimentation_stat.f90
index 4bb2957ccb42462063e1b0dc555cc5bb410b0dcd..4194c36771a7ffb1141be74f0eb81b2f7a684921 100644
--- a/src/MNH/ice4_sedimentation_stat.f90
+++ b/src/MNH/ice4_sedimentation_stat.f90
@@ -73,16 +73,19 @@ SUBROUTINE ICE4_SEDIMENTATION_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB,
!! -------------
!!
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
!
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
-USE MODI_BUDGET
USE MODD_BUDGET
+USE MODD_CST
+
USE MODE_MSG
-!
+
+USE MODI_BUDGET
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -252,10 +255,13 @@ CONTAINS
!* 0. DECLARATIONS
! ------------
!
- USE MODI_GAMMA
+ use mode_tools, only: Countjv
+
USE MODD_RAIN_ICE_DESCR
USE MODD_RAIN_ICE_PARAM
- !
+
+ USE MODI_GAMMA
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -333,8 +339,7 @@ CONTAINS
DO JK = KKE , KKB, -1*KKL
!estimation of q' taking into account incomming PWSED
ZQP(:,:)=PWSED(:,:,JK+KKL)*PTSORHODZ(:,:,JK)
- JCOUNT=COUNTJV2((PRXT(:,:,JK) > XRTMIN(KSPE)) .OR. &
- (ZQP(:,:) > XRTMIN(KSPE)),KIT,KJT,SIZE(I1),I1(:),I2(:))
+ JCOUNT=COUNTJV( (PRXT(:,:,JK) > XRTMIN(KSPE)) .OR. (ZQP(:,:) > XRTMIN(KSPE)) ,I1(:),I2(:))
IF(KSPE==2) THEN
!******* for cloud
DO JL=1, JCOUNT
@@ -432,36 +437,4 @@ CONTAINS
ENDDO
END SUBROUTINE INTERNAL_SEDIM_STAT
!
- FUNCTION COUNTJV2(LTAB,KIT,KJT,KSIZE,I1,I2) RESULT(IC)
- !
- !* 0. DECLARATIONS
- ! ------------
- !
- IMPLICIT NONE
- !
- !* 0.1 Declarations of dummy arguments :
- !
- INTEGER, INTENT(IN) :: KIT, KJT, KSIZE
- LOGICAL, DIMENSION(KIT,KJT), INTENT(IN) :: LTAB ! Mask
- INTEGER, DIMENSION(KSIZE), INTENT(OUT) :: I1,I2 ! Used to replace the COUNT and PACK
- !
- !* 0.2 declaration of local variables
- !
- !
- INTEGER :: JI,JJ,IC
- !
- !-------------------------------------------------------------------------------
- !
- IC = 0
- DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- END IF
- END DO
- END DO
- !
- END FUNCTION COUNTJV2
END SUBROUTINE ICE4_SEDIMENTATION_STAT
diff --git a/src/MNH/ice4_tendencies.f90 b/src/MNH/ice4_tendencies.f90
index 3fafb4588fb7542f2197bf01ccfd1c2f55e936b5..e819001b0b1e0b69ecd32e66c676777b6297927e 100644
--- a/src/MNH/ice4_tendencies.f90
+++ b/src/MNH/ice4_tendencies.f90
@@ -8,7 +8,7 @@ INTERFACE
SUBROUTINE ICE4_TENDENCIES(KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, &
&KRR, ODSOFT, ODCOMPUTE, &
&OWARM, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, HSUBG_AUCV_RC, HSUBG_PR_PDF, &
- &PEXN, PRHODREF, PLVFACT, PLSFACT, LDMICRO, K1, K2, K3, &
+ &PEXN, PRHODREF, PLVFACT, PLSFACT, K1, K2, K3, &
&PPRES, PCF, PSIGMA_RC, &
&PCIT, &
&PT, PTHT, &
@@ -40,7 +40,6 @@ REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: LDMICRO
INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K1
INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K2
INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K3
@@ -135,7 +134,7 @@ END MODULE MODI_ICE4_TENDENCIES
SUBROUTINE ICE4_TENDENCIES(KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, &
&KRR, ODSOFT, ODCOMPUTE, &
&OWARM, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, HSUBG_AUCV_RC, HSUBG_PR_PDF, &
- &PEXN, PRHODREF, PLVFACT, PLSFACT, LDMICRO, K1, K2, K3, &
+ &PEXN, PRHODREF, PLVFACT, PLSFACT, K1, K2, K3, &
&PPRES, PCF, PSIGMA_RC, &
&PCIT, &
&PT, PTHT, &
@@ -164,7 +163,8 @@ SUBROUTINE ICE4_TENDENCIES(KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, K
!!
!! MODIFICATIONS
!! -------------
-!!
+!
+! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
!
!
!* 0. DECLARATIONS
@@ -210,7 +210,6 @@ REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: LDMICRO
INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K1
INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K2
INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K3
@@ -302,7 +301,7 @@ REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR ! Rain fraction
!
!$acc declare present(KSIZE,KIB,KIE,KIT,KJB,KJE,KJT,KKB,KKE,KKT,KKL,KRR,ODSOFT, &
!$acc& OWARM,HSUBG_RC_RR_ACCR,HSUBG_RR_EVAP,HSUBG_AUCV_RC,HSUBG_PR_PDF)
-!$acc declare present(ODCOMPUTE,PEXN,PRHODREF,PLVFACT,PLSFACT,LDMICRO,K1,K2,K3,PPRES,PCF,PCIT,PT,PTHT, &
+!$acc declare present(ODCOMPUTE,PEXN,PRHODREF,PLVFACT,PLSFACT,K1,K2,K3,PPRES,PCF,PCIT,PT,PTHT, &
!$acc& PRVT,PRCT,PRRT,PRIT,PRST,PRGT,PRHT,PRRT3D,PSIGMA_RC,PRVHENI_MR,PRRHONG_MR,PRIMLTC_MR, &
!$acc& PRSRIMCG_MR,PRCHONI,PRVDEPS,PRIAGGS,PRIAUTS,PRVDEPG,PRCAUTR,PRCACCR,PRREVAV, &
!$acc& PRCRIMSS,PRCRIMSG,PRSRIMCG,PRRACCSS,PRRACCSG,PRSACCRG,PRSMLTG,PRCMLTSR,PRICFRRG,PRRCFRIG, &
@@ -340,7 +339,6 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PRHODREF,"ICE4_TENDENCIES beg: PRHODREF:")
CALL MPPDB_CHECK(PLVFACT,"ICE4_TENDENCIES beg:PLVFACT")
CALL MPPDB_CHECK(PLSFACT,"ICE4_TENDENCIES beg:PLSFACT")
- CALL MPPDB_CHECK(LDMICRO,"ICE4_TENDENCIES beg:LDMICRO")
CALL MPPDB_CHECK(K1,"ICE4_TENDENCIES beg:K1")
CALL MPPDB_CHECK(K2,"ICE4_TENDENCIES beg:K2")
CALL MPPDB_CHECK(K3,"ICE4_TENDENCIES beg:K3")
@@ -524,10 +522,6 @@ IF(KSIZE>0) THEN
PRHODREF, ZRCT, PCF, PSIGMA_RC,&
PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, ZRF)
!Diagnostic of precipitation fraction
-#ifndef _OPENACC
- PRAINFR(:,:,:)=UNPACK(ZRF(:), MASK=LDMICRO(:,:,:), FIELD=0.)
- ZRRT3D(:,:,:)=PRRT3D(:,:,:)-UNPACK(PRRHONG_MR(:), MASK=LDMICRO(:,:,:), FIELD=0.)
-#else
!$acc kernels
PRAINFR(:,:,:) = 0.
ZRRT3D (:,:,:) = PRRT3D(:,:,:)
@@ -537,7 +531,6 @@ IF(KSIZE>0) THEN
ZRRT3D (K1(JL), K2(JL), K3(JL)) = ZRRT3D(K1(JL), K2(JL), K3(JL)) - PRRHONG_MR(JL)
END DO
!$acc end kernels
-#endif
CALL ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PRAINFR(:,:,:), ZRRT3D(:,:,:))
!$acc kernels
!$acc loop independent
diff --git a/src/MNH/khko_notadjust.f90 b/src/MNH/khko_notadjust.f90
index 58d8e8a59afe41995396c3c16c2faea6b762bcdf..adf6eee1c10df71a80cf600d765cbdd291e023a9 100644
--- a/src/MNH/khko_notadjust.f90
+++ b/src/MNH/khko_notadjust.f90
@@ -92,6 +92,7 @@ END MODULE MODI_KHKO_NOTADJUST
!! M.Mazoyer : 04/16 : New dummy arguments
!! M.Mazoyer : 10/2016 New KHKO output fields
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -109,6 +110,7 @@ USE MODD_RAIN_C2R2_DESCR, ONLY: XRTMIN
USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_MSG
+use mode_tools, only: Countjv
!
USE MODI_BUDGET
USE MODI_PROGNOS
@@ -417,37 +419,4 @@ IF (LBUDGET_SV) THEN
CALL BUDGET (PCCS(:,:,:) * PRHODJ(:,:,:),14+(NSV_C2R2BEG-1),'CEVA_BU_RSV') ! RCC
END IF
!
- CONTAINS
-!!
- FUNCTION COUNTJV(LTAB,I1,I2,I3) RESULT(IC)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* 0.2 declaration of local variables
-!
-!
-LOGICAL, DIMENSION(:,:,:) :: LTAB ! Mask
-INTEGER, DIMENSION(:) :: I1,I2,I3 ! Used to replace the COUNT and PACK
-INTEGER :: JI,JJ,JK,IC
-!
-!-------------------------------------------------------------------------------
-!
-IC = 0
-DO JK = 1,SIZE(LTAB,3)
- DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ,JK) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- I3(IC) = JK
- END IF
- END DO
- END DO
-END DO
-!
-END FUNCTION COUNTJV
END SUBROUTINE KHKO_NOTADJUST
diff --git a/src/MNH/lima.f90 b/src/MNH/lima.f90
index 7da0841e1b8fde7218257de8d6d111012caebb24..851660cf9fc9c96c62d3af27de1c3667d02115fe 100644
--- a/src/MNH/lima.f90
+++ b/src/MNH/lima.f90
@@ -2,6 +2,7 @@
!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.
+!-----------------------------------------------------------------
! ######spl
MODULE MODI_LIMA
! ####################
@@ -100,30 +101,31 @@ END MODULE MODI_LIMA
!!
!* 0. DECLARATIONS
! ------------
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_CLOUDPAR_n, ONLY : NSPLITR, NSPLITG
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODD_PARAM_LIMA, ONLY : LCOLD, LRAIN, LWARM, NMOD_CCN, NMOD_IFN, NMOD_IMM, LHHONI, &
- LACTIT, LFEEDBACKT, NMAXITER, XMRSTEP, XTSTEP_TS, &
- LSEDC, LSEDI, XRTMIN, XCTMIN, LDEPOC, XVDEPOC, &
- LHAIL, LSNOW
-USE MODD_PARAM_LIMA_WARM,ONLY : XLBC, XLBEXC, XAC, XBC, XAR, XBR
-USE MODD_PARAM_LIMA_COLD,ONLY : XAI, XBI
-USE MODD_BUDGET, ONLY : LBU_ENABLE, LBUDGET_TH, LBUDGET_RV, LBUDGET_RC, LBUDGET_RR, &
+USE MODD_BUDGET, ONLY: LBU_ENABLE, LBUDGET_TH, LBUDGET_RV, LBUDGET_RC, LBUDGET_RR, &
LBUDGET_RI, LBUDGET_RS, LBUDGET_RG, LBUDGET_RH, LBUDGET_SV
-USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI, &
+USE MODD_CLOUDPAR_n, ONLY: NSPLITR, NSPLITG
+USE MODD_CST, ONLY: XCI, XCL, XCPD, XCPV, XLSTT, XLVTT, XTT, XRHOLW, XP00, XRD
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI, &
NSV_LIMA_SCAVMASS, NSV_LIMA_NI, NSV_LIMA_IFN_FREE, &
NSV_LIMA_IFN_NUCL, NSV_LIMA_IMM_NUCL, NSV_LIMA_HOM_HAZE
-USE MODD_CST, ONLY : XCI, XCL, XCPD, XCPV, XLSTT, XLVTT, XTT, XRHOLW, XP00, XRD
-!
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
+USE MODD_PARAM_LIMA, ONLY: LCOLD, LRAIN, LWARM, NMOD_CCN, NMOD_IFN, NMOD_IMM, LHHONI, &
+ LACTIT, LFEEDBACKT, NMAXITER, XMRSTEP, XTSTEP_TS, &
+ LSEDC, LSEDI, XRTMIN, XCTMIN, LDEPOC, XVDEPOC, &
+ LHAIL, LSNOW
+USE MODD_PARAM_LIMA_COLD, ONLY: XAI, XBI
+USE MODD_PARAM_LIMA_WARM, ONLY: XLBC, XLBEXC, XAC, XBC, XAR, XBR
+
+use mode_tools, only: Countjv
+
USE MODI_BUDGET
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
-USE MODI_LIMA_SEDIMENTATION
-USE MODI_LIMA_NUCLEATION_PROCS
+USE MODI_LIMA_DROPS_TO_DROPLETS_CONV
USE MODI_LIMA_INST_PROCS
+USE MODI_LIMA_NUCLEATION_PROCS
+USE MODI_LIMA_SEDIMENTATION
USE MODI_LIMA_TENDENCIES
-USE MODI_LIMA_DROPS_TO_DROPLETS_CONV
!
IMPLICIT NONE
!
diff --git a/src/MNH/lima_adjust.f90 b/src/MNH/lima_adjust.f90
index 5cad38d69f8fccdc3f1c1a037f3fa01a1e5a5632..752c861b9d9792eed74add2178143552c425b9c1 100644
--- a/src/MNH/lima_adjust.f90
+++ b/src/MNH/lima_adjust.f90
@@ -136,7 +136,8 @@ END MODULE MODI_LIMA_ADJUST
!! JP Chaboureau *LA* March 2014 fix the calculation of icy cloud fraction
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-!!
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -157,6 +158,7 @@ USE MODD_PARAM_LIMA_WARM
USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
use mode_msg
+use mode_tools, only: Countjv
!
USE MODI_BUDGET
USE MODI_CONDENS
diff --git a/src/MNH/lima_ccn_activation.f90 b/src/MNH/lima_ccn_activation.f90
index 97b12f95ce27a8e739e7acaf0f03cbe099fbd8cf..211fbd35f53472766670fcec4fd26ae627f67a26 100644
--- a/src/MNH/lima_ccn_activation.f90
+++ b/src/MNH/lima_ccn_activation.f90
@@ -89,26 +89,27 @@ END MODULE MODI_LIMA_CCN_ACTIVATION
!! Original ??/??/13
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
USE MODD_CST, ONLY: XALPW, XBETAW, XCL, XCPD, XCPV, XGAMW, XLVTT, XMD, XMV, XRV, XTT
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
USE MODD_PARAM_LIMA, ONLY: LACTIT, NMOD_CCN, XKHEN_MULTI, XCTMIN, XLIMIT_FACTOR
USE MODD_PARAM_LIMA_WARM, ONLY: XWMIN, NAHEN, NHYP, XAHENINTP1, XAHENINTP2, XCSTDCRIT, XHYPF12, &
XHYPINTP1, XHYPINTP2, XTMIN, XHYPF32, XPSI3, XAHENG, XPSI1
-!
-USE MODI_GAMMA
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
-!
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
+
USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
-!
+use mode_tools, only: Countjv
+
+USE MODI_GAMMA
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
diff --git a/src/MNH/lima_ccn_hom_freezing.f90 b/src/MNH/lima_ccn_hom_freezing.f90
index 1e5f382ebd61fa095ed809e769fbf87f4088c63e..26948c4f4cfd7c5e4903a040993cc3a33e7c236c 100644
--- a/src/MNH/lima_ccn_hom_freezing.f90
+++ b/src/MNH/lima_ccn_hom_freezing.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2019 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.
! #################################
MODULE MODI_LIMA_CCN_HOM_FREEZING
@@ -57,28 +57,30 @@ END MODULE MODI_LIMA_CCN_HOM_FREEZING
!! MODIFICATIONS
!! -------------
!! Original 15/03/2018
-!!
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODD_CST, ONLY : XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, XCL, XCI, &
- XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
- XG
-USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, NMOD_IMM, XRTMIN, XCTMIN, XNUC
-USE MODD_PARAM_LIMA_COLD, ONLY : XRCOEF_HONH, XCEXP_DIFVAP_HONH, XCOEF_DIFVAP_HONH,&
- XCRITSAT1_HONH, XCRITSAT2_HONH, XTMAX_HONH, &
- XTMIN_HONH, XC1_HONH, XC2_HONH, XC3_HONH, &
- XDLNJODT1_HONH, XDLNJODT2_HONH, XRHOI_HONH, &
- XC_HONC, XTEXP1_HONC, XTEXP2_HONC, XTEXP3_HONC, &
- XTEXP4_HONC, XTEXP5_HONC
-USE MODD_PARAM_LIMA_WARM, ONLY : XLBC
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
-!
-USE MODD_NSV
USE MODD_BUDGET
+USE MODD_CST, ONLY: XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, XCL, XCI, &
+ XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
+ XG
+USE MODD_NSV
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
+USE MODD_PARAM_LIMA, ONLY: NMOD_CCN, NMOD_IMM, XRTMIN, XCTMIN, XNUC
+USE MODD_PARAM_LIMA_COLD, ONLY: XRCOEF_HONH, XCEXP_DIFVAP_HONH, XCOEF_DIFVAP_HONH,&
+ XCRITSAT1_HONH, XCRITSAT2_HONH, XTMAX_HONH, &
+ XTMIN_HONH, XC1_HONH, XC2_HONH, XC3_HONH, &
+ XDLNJODT1_HONH, XDLNJODT2_HONH, XRHOI_HONH, &
+ XC_HONC, XTEXP1_HONC, XTEXP2_HONC, XTEXP3_HONC, &
+ XTEXP4_HONC, XTEXP5_HONC
+USE MODD_PARAM_LIMA_WARM, ONLY: XLBC
+!
+use mode_tools, only: Countjv
+!
USE MODI_BUDGET
!
IMPLICIT NONE
diff --git a/src/MNH/lima_cold_hom_nucl.f90 b/src/MNH/lima_cold_hom_nucl.f90
index 4007c1355ca200c23083f654577d539ab5c6d554..f6c3f42114c5cbff0cece4bbef71e1eaf538c2cb 100644
--- a/src/MNH/lima_cold_hom_nucl.f90
+++ b/src/MNH/lima_cold_hom_nucl.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2019 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.
!-----------------------------------------------------------------
! ######################
@@ -91,28 +91,30 @@ END MODULE MODI_LIMA_COLD_HOM_NUCL
!! C. Barthe * LACy* jan. 2014 add budgets
!! B.Vie 10/2016 Bug zero division
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODD_CST, ONLY : XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, XCL, XCI, &
- XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
- XG
-USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, NMOD_IMM, XRTMIN, XCTMIN, XNUC, LWARM, LRAIN
-USE MODD_PARAM_LIMA_COLD, ONLY : XRCOEF_HONH, XCEXP_DIFVAP_HONH, XCOEF_DIFVAP_HONH,&
- XCRITSAT1_HONH, XCRITSAT2_HONH, XTMAX_HONH, &
- XTMIN_HONH, XC1_HONH, XC2_HONH, XC3_HONH, &
- XDLNJODT1_HONH, XDLNJODT2_HONH, XRHOI_HONH, &
- XC_HONC, XTEXP1_HONC, XTEXP2_HONC, XTEXP3_HONC, &
- XTEXP4_HONC, XTEXP5_HONC
-USE MODD_PARAM_LIMA_WARM, ONLY : XLBC
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
-!
-USE MODD_NSV
USE MODD_BUDGET
+USE MODD_CST, ONLY: XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, XCL, XCI, &
+ XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
+ XG
+USE MODD_NSV
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
+USE MODD_PARAM_LIMA, ONLY: NMOD_CCN, NMOD_IMM, XRTMIN, XCTMIN, XNUC, LWARM, LRAIN
+USE MODD_PARAM_LIMA_COLD, ONLY: XRCOEF_HONH, XCEXP_DIFVAP_HONH, XCOEF_DIFVAP_HONH,&
+ XCRITSAT1_HONH, XCRITSAT2_HONH, XTMAX_HONH, &
+ XTMIN_HONH, XC1_HONH, XC2_HONH, XC3_HONH, &
+ XDLNJODT1_HONH, XDLNJODT2_HONH, XRHOI_HONH, &
+ XC_HONC, XTEXP1_HONC, XTEXP2_HONC, XTEXP3_HONC, &
+ XTEXP4_HONC, XTEXP5_HONC
+USE MODD_PARAM_LIMA_WARM, ONLY: XLBC
+!
+use mode_tools, only: Countjv
+!
USE MODI_BUDGET
!
IMPLICIT NONE
diff --git a/src/MNH/lima_cold_sedimentation.f90 b/src/MNH/lima_cold_sedimentation.f90
index d4e99f68c4b862e4044fba57f5ce79bccb84a98e..6a62652b7dc00b57ff9f5d401f496f61af249b9c 100644
--- a/src/MNH/lima_cold_sedimentation.f90
+++ b/src/MNH/lima_cold_sedimentation.f90
@@ -76,24 +76,25 @@ END MODULE MODI_LIMA_COLD_SEDIMENTATION
!! C. Barthe * LACy * jan. 2014 add budgets
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE MODD_CST, ONLY : XRHOLW
+USE MODD_NSV
+USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
+USE MODD_PARAM_LIMA, ONLY : XCEXVT, XRTMIN, XCTMIN
USE MODD_PARAM_LIMA_COLD, ONLY : XLBEXI, XLBI, XDI, &
XFSEDRI, XFSEDCI, XFSEDS, XEXSEDS
USE MODD_PARAM_LIMA_MIXED, ONLY : XFSEDG, XEXSEDG, XFSEDH, XEXSEDH
-USE MODD_PARAM_LIMA, ONLY : XCEXVT, XRTMIN, XCTMIN
-USE MODD_CST, ONLY : XRHOLW
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
!
-USE MODD_NSV
-!++cb++
+use mode_tools, only: Countjv
+!
IMPLICIT NONE
-!--cb--
+!
!
!* 0.1 Declarations of dummy arguments :
diff --git a/src/MNH/lima_cold_slow_processes.f90 b/src/MNH/lima_cold_slow_processes.f90
index 0aeb16cfc4c97576272de1ebcc5d2262155663be..1973c65f3d23fa1a538243e90ac5371ad626d50c 100644
--- a/src/MNH/lima_cold_slow_processes.f90
+++ b/src/MNH/lima_cold_slow_processes.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2019 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.
!-----------------------------------------------------------------
! #####################
@@ -78,30 +78,32 @@ END MODULE MODI_LIMA_COLD_SLOW_PROCESSES
!! Original ??/??/13
!! C. Barthe * LACy * jan. 2014 add budgets
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODD_CST, ONLY : XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, &
- XCL, XCI, XTT, XLSTT, XALPI, XBETAI, XGAMI
-USE MODD_PARAM_LIMA, ONLY : LSNOW, XRTMIN, XCTMIN, XALPHAI, XALPHAS, &
- XNUI
-USE MODD_PARAM_LIMA_COLD, ONLY : XLBI, XLBEXI, XLBS, XLBEXS, XBI, XCXS, XCCS, &
- XLBDAS_MAX, XDSCNVI_LIM, XLBDASCNVI_MAX, &
- XC0DEPSI, XC1DEPSI, XR0DEPSI, XR1DEPSI, &
- XSCFAC, X1DEPS, X0DEPS, XEX1DEPS, XEX0DEPS, &
- XDICNVS_LIM, XLBDAICNVS_LIM, &
- XC0DEPIS, XC1DEPIS, XR0DEPIS, XR1DEPIS, &
- XCOLEXIS, XAGGS_CLARGE1, XAGGS_CLARGE2, &
- XAGGS_RLARGE1, XAGGS_RLARGE2
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
USE MODD_BUDGET
-USE MODD_NSV, ONLY : NSV_LIMA_NI
-USE MODI_BUDGET
+USE MODD_CST, ONLY: XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, &
+ XCL, XCI, XTT, XLSTT, XALPI, XBETAI, XGAMI
+USE MODD_NSV, ONLY: NSV_LIMA_NI
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
+USE MODD_PARAM_LIMA, ONLY: LSNOW, XRTMIN, XCTMIN, XALPHAI, XALPHAS, &
+ XNUI
+USE MODD_PARAM_LIMA_COLD, ONLY: XLBI, XLBEXI, XLBS, XLBEXS, XBI, XCXS, XCCS, &
+ XLBDAS_MAX, XDSCNVI_LIM, XLBDASCNVI_MAX, &
+ XC0DEPSI, XC1DEPSI, XR0DEPSI, XR1DEPSI, &
+ XSCFAC, X1DEPS, X0DEPS, XEX1DEPS, XEX0DEPS, &
+ XDICNVS_LIM, XLBDAICNVS_LIM, &
+ XC0DEPIS, XC1DEPIS, XR0DEPIS, XR1DEPIS, &
+ XCOLEXIS, XAGGS_CLARGE1, XAGGS_CLARGE2, &
+ XAGGS_RLARGE1, XAGGS_RLARGE2
+use mode_tools, only: Countjv
+
+USE MODI_BUDGET
!
IMPLICIT NONE
!
diff --git a/src/MNH/lima_functions.f90 b/src/MNH/lima_functions.f90
index a40d500c0ba5a7b56ee6faa8f50d9340993c8396..b5a8f17d782405a0467ae9e39bc3d7cf8faf4b6a 100644
--- a/src/MNH/lima_functions.f90
+++ b/src/MNH/lima_functions.f90
@@ -7,6 +7,7 @@
! P. Wautelet 22/01/2019: replace double precision declarations by real(kind(0.0d0)) (to allow compilation by NAG compiler)
! P. Wautelet 19/04/2019: use modd_precision kinds
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
!-----------------------------------------------------------------
!#################################
MODULE MODI_LIMA_FUNCTIONS
@@ -14,12 +15,6 @@
!
INTERFACE
!
-FUNCTION COUNTJV(LTAB,I1,I2,I3) RESULT(IC)
- LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: LTAB
- INTEGER, DIMENSION(:), INTENT(INOUT) :: I1,I2,I3
- INTEGER :: IC
-END FUNCTION COUNTJV
-!
FUNCTION MOMG (PALPHA,PNU,PP) RESULT (PMOMG)
REAL, INTENT(IN) :: PALPHA
REAL, INTENT(IN) :: PNU
@@ -71,34 +66,6 @@ END MODULE MODI_LIMA_FUNCTIONS
!
!------------------------------------------------------------------------------
!
-!#########################################
-FUNCTION COUNTJV(LTAB,I1,I2,I3) RESULT(IC)
-!#########################################
-!
- IMPLICIT NONE
-!
- LOGICAL, DIMENSION(:,:,:) :: LTAB ! Mask
- INTEGER, DIMENSION(:) :: I1,I2,I3 ! Used to replace the COUNT and PACK
- INTEGER :: JI,JJ,JK,IC
-!
- IC = 0
- DO JK = 1,SIZE(LTAB,3)
- DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ,JK) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- I3(IC) = JK
- END IF
- END DO
- END DO
- END DO
-!
-END FUNCTION COUNTJV
-!
-!------------------------------------------------------------------------------
-!
!###########################################
FUNCTION MOMG (PALPHA,PNU,PP) RESULT (PMOMG)
!###########################################
diff --git a/src/MNH/lima_meyers.f90 b/src/MNH/lima_meyers.f90
index 5d560781521993fc88a4979fba75c117c7963e87..775a104ec5eb74d5d885a93f146f53c2deac0d91 100644
--- a/src/MNH/lima_meyers.f90
+++ b/src/MNH/lima_meyers.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2019 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.
!-----------------------------------------------------------------
! #######################
@@ -107,25 +107,25 @@ END MODULE MODI_LIMA_MEYERS
!! Original ??/??/13
!! C. Barthe * LACy * jan. 2014 add budgets
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS
+USE MODD_BUDGET
USE MODD_CST
+USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NI
+USE MODD_PARAMETERS
USE MODD_PARAM_LIMA
USE MODD_PARAM_LIMA_COLD
-USE MODD_BUDGET
+
+use mode_tools, only: Countjv
+
USE MODI_BUDGET
-USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NI
-!
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
!
-!++cb++
IMPLICIT NONE
-!--cb--
!
!* 0.1 Declarations of dummy arguments :
!
diff --git a/src/MNH/lima_meyers_nucleation.f90 b/src/MNH/lima_meyers_nucleation.f90
index 8f20189526e24357bd33718f151bd5b604d3052a..0aa09ccbabce9769552385398f63cbc8e8283e81 100644
--- a/src/MNH/lima_meyers_nucleation.f90
+++ b/src/MNH/lima_meyers_nucleation.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2018-2019 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.
+!-----------------------------------------------------------------
! ##################################
MODULE MODI_LIMA_MEYERS_NUCLEATION
! ##################################
@@ -67,21 +68,23 @@ END MODULE MODI_LIMA_MEYERS_NUCLEATION
!! MODIFICATIONS
!! -------------
!! Original 15/03/2018
-!!
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS
+USE MODD_BUDGET
USE MODD_CST
+USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NI
+USE MODD_PARAMETERS
USE MODD_PARAM_LIMA
USE MODD_PARAM_LIMA_COLD
-USE MODD_BUDGET
+
+use mode_tools, only: Countjv
+
USE MODI_BUDGET
-USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NI
-!
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
!
IMPLICIT NONE
!
diff --git a/src/MNH/lima_mixed.f90 b/src/MNH/lima_mixed.f90
index 63a64e3c495f024b48fcb5e77e27b4f99d3422d8..7525be5b3a195b44b6020d8f7d0320b66a0b089b 100644
--- a/src/MNH/lima_mixed.f90
+++ b/src/MNH/lima_mixed.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2019 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.
!-----------------------------------------------------------------
! ######################
@@ -98,25 +98,23 @@ END MODULE MODI_LIMA_MIXED
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODD_CST, ONLY : XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, &
- XCL, XCI, XTT, XLSTT, XLVTT, &
- XALPI, XBETAI, XGAMI
-USE MODD_PARAM_LIMA, ONLY : NMOD_IFN, XRTMIN, XCTMIN, LWARM, LCOLD, &
- NMOD_CCN, NMOD_IMM, LRAIN, LSNOW, LHAIL
-USE MODD_PARAM_LIMA_WARM, ONLY : XLBC, XLBEXC, XLBR, XLBEXR
-USE MODD_PARAM_LIMA_COLD, ONLY : XLBI, XLBEXI, XLBS, XLBEXS, XSCFAC
-USE MODD_PARAM_LIMA_MIXED, ONLY : XLBG, XLBEXG, XLBH, XLBEXH
-!USE MODD_BUDGET, ONLY : LBU_ENABLE, NBUMOD
-!
-USE MODD_NSV
-!
USE MODD_BUDGET
+USE MODD_CST, ONLY: XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, &
+ XCL, XCI, XTT, XLSTT, XLVTT, &
+ XALPI, XBETAI, XGAMI
+USE MODD_NSV
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
+USE MODD_PARAM_LIMA, ONLY: NMOD_IFN, XRTMIN, XCTMIN, LWARM, LCOLD, &
+ NMOD_CCN, NMOD_IMM, LRAIN, LSNOW, LHAIL
+USE MODD_PARAM_LIMA_WARM, ONLY: XLBC, XLBEXC, XLBR, XLBEXR
+USE MODD_PARAM_LIMA_COLD, ONLY: XLBI, XLBEXI, XLBS, XLBEXS, XSCFAC
+USE MODD_PARAM_LIMA_MIXED, ONLY: XLBG, XLBEXG, XLBH, XLBEXH
+
+use mode_tools, only: Countjv
+
USE MODI_BUDGET
-!
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
-USE MODI_LIMA_MIXED_SLOW_PROCESSES
USE MODI_LIMA_MIXED_FAST_PROCESSES
+USE MODI_LIMA_MIXED_SLOW_PROCESSES
!
IMPLICIT NONE
!
diff --git a/src/MNH/lima_phillips.f90 b/src/MNH/lima_phillips.f90
index e91caa983c5ad0277ef23783b23c5f4953b6ad00..03af388b71ef40b0ad5e71b8ddea351a304c1483 100644
--- a/src/MNH/lima_phillips.f90
+++ b/src/MNH/lima_phillips.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2019 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.
!-----------------------------------------------------------------
! #########################
@@ -116,30 +116,30 @@ END MODULE MODI_LIMA_PHILLIPS
!! Original ??/??/13
!! C. Barthe * LACy * jan. 2014 add budgets
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
+USE MODD_BUDGET
USE MODD_CST, ONLY : XP00, XRD, XMV, XMD, XCPD, XCPV, XCL, XCI, &
XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
XALPW, XBETAW, XGAMW, XPI
+USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_IFN_FREE
+USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
USE MODD_PARAM_LIMA, ONLY : NMOD_IFN, NSPECIE, XFRAC, &
- NMOD_CCN, NMOD_IMM, NIND_SPECIE, NINDICE_CCN_IMM, &
+ NMOD_CCN, NMOD_IMM, NIND_SPECIE, NINDICE_CCN_IMM, &
XDSI0, XRTMIN, XCTMIN, NPHILLIPS
USE MODD_PARAM_LIMA_COLD, ONLY : XMNU0
-!
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
-USE MODI_LIMA_PHILLIPS_REF_SPECTRUM
-USE MODI_LIMA_PHILLIPS_INTEG
-!
-USE MODD_BUDGET
+
+use mode_tools, only: Countjv
+
USE MODI_BUDGET
-USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_IFN_FREE
-!
-!
+USE MODI_LIMA_PHILLIPS_INTEG
+USE MODI_LIMA_PHILLIPS_REF_SPECTRUM
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
diff --git a/src/MNH/lima_phillips_ifn_nucleation.f90 b/src/MNH/lima_phillips_ifn_nucleation.f90
index 053422c951156e2cdb883407ab4ca29c86b1930c..a6cd6aa804cfb86b819599cee52b962fc3f489d7 100644
--- a/src/MNH/lima_phillips_ifn_nucleation.f90
+++ b/src/MNH/lima_phillips_ifn_nucleation.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2018-2019 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.
+!-----------------------------------------------------------------
! ########################################
MODULE MODI_LIMA_PHILLIPS_IFN_NUCLEATION
! ########################################
@@ -101,30 +102,30 @@ END MODULE MODI_LIMA_PHILLIPS_IFN_NUCLEATION
!! MODIFICATIONS
!! -------------
!! Original 15/03/2018
-!!
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
+USE MODD_BUDGET
USE MODD_CST, ONLY : XP00, XRD, XMV, XMD, XCPD, XCPV, XCL, XCI, &
XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
XALPW, XBETAW, XGAMW, XPI
+USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_IFN_FREE
+USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
USE MODD_PARAM_LIMA, ONLY : NMOD_IFN, NSPECIE, XFRAC, &
- NMOD_CCN, NMOD_IMM, NIND_SPECIE, NINDICE_CCN_IMM, &
+ NMOD_CCN, NMOD_IMM, NIND_SPECIE, NINDICE_CCN_IMM, &
XDSI0, XRTMIN, XCTMIN, NPHILLIPS
USE MODD_PARAM_LIMA_COLD, ONLY : XMNU0
-!
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
-USE MODI_LIMA_PHILLIPS_REF_SPECTRUM
-USE MODI_LIMA_PHILLIPS_INTEG
-!
-USE MODD_BUDGET
+
+use mode_tools, only: Countjv
+
USE MODI_BUDGET
-USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_IFN_FREE
-!
-!
+USE MODI_LIMA_PHILLIPS_INTEG
+USE MODI_LIMA_PHILLIPS_REF_SPECTRUM
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
diff --git a/src/MNH/lima_precip_scavenging.f90 b/src/MNH/lima_precip_scavenging.f90
index cbbf3f3ddaad69dfc3dd83d7196befe77eb6b6a6..351ee92f0222640114445e455096dcd65234ae2b 100644
--- a/src/MNH/lima_precip_scavenging.f90
+++ b/src/MNH/lima_precip_scavenging.f90
@@ -97,32 +97,32 @@ END MODULE MODI_LIMA_PRECIP_SCAVENGING
!!
!! Philippe Wautelet 28/05/2018: corrected truncated integer division (3/2 -> 1.5)
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
!-------------------------------------------------------------------------------
!
!* 0.DECLARATIONS
! --------------
!
-USE MODD_NSV
+USE MODD_BUDGET
USE MODD_CST
+USE MODD_NSV
USE MODD_PARAMETERS
-USE MODI_INI_NSV
+USE MODD_PARAM_LIMA, ONLY: NMOD_IFN, NSPECIE, XFRAC, &
+ XMDIAM_IFN, XSIGMA_IFN, XRHO_IFN, &
+ NMOD_CCN, XR_MEAN_CCN, XLOGSIG_CCN, XRHO_CCN, &
+ XALPHAR, XNUR, &
+ LAERO_MASS, NDIAMR, NDIAMP, XT0SCAV, XTREF, XNDO, &
+ XMUA0, XT_SUTH_A, XMFPA0, XVISCW, XRHO00, &
+ XRTMIN, XCTMIN
+USE MODD_PARAM_LIMA_WARM, ONLY: XCR, XDR
+
+use mode_tools, only: Countjv
+
+USE MODI_BUDGET
USE MODI_GAMMA
+USE MODI_INI_NSV
USE MODI_LIMA_FUNCTIONS
-!
-! Previous versions by S. Berthet were compatible with all schemes
-! Here : Compatibility with LIMA only
-USE MODD_PARAM_LIMA, ONLY : NMOD_IFN, NSPECIE, XFRAC, &
- XMDIAM_IFN, XSIGMA_IFN, XRHO_IFN, &
- NMOD_CCN, XR_MEAN_CCN, XLOGSIG_CCN, XRHO_CCN, &
- XALPHAR, XNUR, &
- LAERO_MASS, NDIAMR, NDIAMP, XT0SCAV, XTREF, XNDO, &
- XMUA0, XT_SUTH_A, XMFPA0, XVISCW, XRHO00, &
- XRTMIN, XCTMIN
-USE MODD_PARAM_LIMA_WARM, ONLY : XCR, XDR
-!
-USE MODD_BUDGET
-USE MODI_BUDGET
-!
+
IMPLICIT NONE
!
!* 0.1 declarations of dummy arguments :
diff --git a/src/MNH/lima_sedimentation.f90 b/src/MNH/lima_sedimentation.f90
index a4e82471390a836e5b0d8cf0084fd16e68582c36..88a0a544ba43209e515ae2bf972eff8a57b79714 100644
--- a/src/MNH/lima_sedimentation.f90
+++ b/src/MNH/lima_sedimentation.f90
@@ -64,19 +64,22 @@ END MODULE MODI_LIMA_SEDIMENTATION
!!
!! B.Vie 02/2019 Desactivate (comment) the heat transport by droplets
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAM_LIMA_COLD, ONLY : XLBEXI, XLBI, XDI
-USE MODD_PARAM_LIMA, ONLY : XCEXVT, XRTMIN, XCTMIN, NSPLITSED, &
- XLB, XLBEX, XD, XFSEDR, XFSEDC, &
- XALPHAC, XNUC
-USE MODD_CST, ONLY : XRHOLW, XCL, XCI
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
-USE MODI_GAMMA, ONLY : GAMMA_X0D
+USE MODD_CST, ONLY: XRHOLW, XCL, XCI
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
+USE MODD_PARAM_LIMA, ONLY: XCEXVT, XRTMIN, XCTMIN, NSPLITSED, &
+ XLB, XLBEX, XD, XFSEDR, XFSEDC, &
+ XALPHAC, XNUC
+USE MODD_PARAM_LIMA_COLD, ONLY: XLBEXI, XLBI, XDI
+
+use mode_tools, only: Countjv
+
+USE MODI_GAMMA, ONLY: GAMMA_X0D
!
IMPLICIT NONE
!
diff --git a/src/MNH/lima_warm_coal.f90 b/src/MNH/lima_warm_coal.f90
index 4623cd61eb057f55a9f0c64c765a358a234f554f..aaae2a04be021958b9d559584d07004c012c40ea 100644
--- a/src/MNH/lima_warm_coal.f90
+++ b/src/MNH/lima_warm_coal.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2019 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.
!-----------------------------------------------------------------
! ##########################
@@ -96,22 +96,23 @@ END MODULE MODI_LIMA_WARM_COAL
!! Original ??/??/13
!! C. Barthe * LACy * jan. 2014 add budgets
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
+USE MODD_BUDGET
+USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NR
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
USE MODD_PARAM_LIMA
USE MODD_PARAM_LIMA_WARM
-!
-USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NR
-USE MODD_BUDGET
+
+use mode_tools, only: Countjv
+
USE MODI_BUDGET
-!
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
diff --git a/src/MNH/lima_warm_evap.f90 b/src/MNH/lima_warm_evap.f90
index aa8b7a9840e7d7352ce25714d4bf4e1f927a5847..9a67a4b824bf150485226d9ad53037131418c1a9 100644
--- a/src/MNH/lima_warm_evap.f90
+++ b/src/MNH/lima_warm_evap.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2019 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.
!-----------------------------------------------------------------
! ##########################
@@ -74,18 +74,19 @@ END MODULE MODI_LIMA_WARM_EVAP
!! -------------
!! Original ??/??/13
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
USE MODD_CST
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
USE MODD_PARAM_LIMA
USE MODD_PARAM_LIMA_WARM
!
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
+use mode_tools, only: Countjv
!
IMPLICIT NONE
!
diff --git a/src/MNH/lima_warm_nucl.f90 b/src/MNH/lima_warm_nucl.f90
index 6887edea9ec7505f0dc072ebbaef71b4225c2763..3cd2f705228d3a81608c24308e85cfefe259cd9e 100644
--- a/src/MNH/lima_warm_nucl.f90
+++ b/src/MNH/lima_warm_nucl.f90
@@ -104,25 +104,26 @@ END MODULE MODI_LIMA_WARM_NUCL
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
USE MODD_CST
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
USE MODD_PARAM_LIMA
USE MODD_PARAM_LIMA_WARM
-!
-USE MODI_GAMMA
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
-!
+
+USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODE_FIELD, ONLY : TFIELDDATA, TYPEREAL
-!
+use mode_tools, only: Countjv
+
+USE MODI_GAMMA
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
diff --git a/src/MNH/lima_warm_sedimentation.f90 b/src/MNH/lima_warm_sedimentation.f90
index 4aa56b4b440a605a24bed1b58c1bfe1bceea2d54..f74899b381c08493f242eef9f5685cc514a95667 100644
--- a/src/MNH/lima_warm_sedimentation.f90
+++ b/src/MNH/lima_warm_sedimentation.f90
@@ -91,21 +91,24 @@ END MODULE MODI_LIMA_WARM_SEDIMENTATION
!! -------------
!! Original ??/??/13
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODD_CST, ONLY : XRHOLW
-USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XALPHAC, XNUC, XCEXVT
-USE MODD_PARAM_LIMA_WARM, ONLY : XLBC, XLBEXC, XLBR, XLBEXR, &
+USE MODD_CST, ONLY: XRHOLW
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
+USE MODD_PARAM_LIMA, ONLY: XRTMIN, XCTMIN, XALPHAC, XNUC, XCEXVT
+USE MODD_PARAM_LIMA_WARM, ONLY: XLBC, XLBEXC, XLBR, XLBEXR, &
XFSEDRC, XFSEDCC, XFSEDRR, XFSEDCR,&
XDC, XDR
-USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
-USE MODI_GAMMA, ONLY : GAMMA_X0D
-!
+
+use mode_tools, only: Countjv
+
+USE MODI_GAMMA, ONLY: GAMMA_X0D
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
diff --git a/src/MNH/ppm_rhodj.f90 b/src/MNH/ppm_rhodj.f90
index 94c74171951e6c215f32a919f0825f88c8f80e39..d99ef1db98e41fa1298d46ef78f03a86040fe18d 100644
--- a/src/MNH/ppm_rhodj.f90
+++ b/src/MNH/ppm_rhodj.f90
@@ -82,10 +82,10 @@ USE MODI_PPM
USE OPENACC
USE MODE_DEVICE
-use mode_mppdb
!
USE MODE_MNH_ZWORK, ONLY : ZUNIT => ZUNIT3D
#endif
+use mode_mppdb
!
!
!
diff --git a/src/MNH/rain_c2r2_khko.f90 b/src/MNH/rain_c2r2_khko.f90
index 75a99204c9dbc033eaeaaaad7fcff9da866c9705..07060753098a0018b03b7cd6d72bfe9f2a1e8705 100644
--- a/src/MNH/rain_c2r2_khko.f90
+++ b/src/MNH/rain_c2r2_khko.f90
@@ -214,29 +214,31 @@ END MODULE MODI_RAIN_C2R2_KHKO
!! C.Lac : 01/2017 : Correction on droplet deposition
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS
-USE MODD_CST
+USE MODD_BUDGET
+USE MODD_CH_AEROSOL
USE MODD_CONF
-USE MODD_IO, ONLY: TFILEDATA
+USE MODD_CST
+USE MODD_DUST
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_NSV, ONLY : NSV_C2R2BEG
USE MODD_PARAM_C2R2
+USE MODD_PARAMETERS
USE MODD_RAIN_C2R2_DESCR
USE MODD_RAIN_C2R2_KHKO_PARAM
-USE MODD_BUDGET
-USE MODD_NSV, ONLY : NSV_C2R2BEG
-USE MODD_CH_AEROSOL
-USE MODD_DUST
USE MODD_SALT
-!
-USE MODI_BUDGET
-!
+
USE MODE_FIELD
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_ll
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+use mode_tools, only: Countjv
+
+USE MODI_BUDGET
USE MODI_GAMMA
!
IMPLICIT NONE
@@ -1960,39 +1962,4 @@ IF ( LBUDGET_SV .AND. LDEPOC ) &
END SUBROUTINE C2R2_KHKO_SEDIMENTATION
!-------------------------------------------------------------------------------
!
-!
- FUNCTION COUNTJV(LTAB,I1,I2,I3) RESULT(IC)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* 0.2 declaration of local variables
-!
-!
-LOGICAL, DIMENSION(:,:,:) :: LTAB ! Mask
-INTEGER, DIMENSION(:) :: I1,I2,I3 ! Used to replace the COUNT and PACK
-INTEGER :: JI,JJ,JK,IC
-!
-!-------------------------------------------------------------------------------
-!
-IC = 0
-DO JK = 1,SIZE(LTAB,3)
- DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ,JK) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- I3(IC) = JK
- END IF
- END DO
- END DO
-END DO
-!
-END FUNCTION COUNTJV
-!
-!------------------------------------------------------------------------------
-!
END SUBROUTINE RAIN_C2R2_KHKO
diff --git a/src/MNH/rain_ice.f90 b/src/MNH/rain_ice.f90
index d6c9fc55bc721736a375a5cb7fe6651e2a768a80..42a602f88f894aceeae0456b575684179687621b 100644
--- a/src/MNH/rain_ice.f90
+++ b/src/MNH/rain_ice.f90
@@ -227,7 +227,6 @@ END MODULE MODI_RAIN_ICE
!! land, sea and urban areas in the cloud sedimentation.
!! (D. Degrauwe), 2013-11: Export upper-air precipitation fluxes PFPR.
!! (S. Riette) Nov 2013 Protection against null sigma
-!! Juan 24/09/2012: for BUG Pgi rewrite PACK function on mode_pack_pgi
!! (C. Lac) FIT temporal scheme : instant M removed
!! (JP Pinty), 01-2014 : ICE4 : partial reconversion of hail to graupel
!! July, 2015 (O.Nuissier/F.Duffourg) Add microphysics diagnostic for
@@ -242,20 +241,23 @@ END MODULE MODI_RAIN_ICE
!! 02/2019 C.Lac add rain fraction as an output field
! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
!
!* 0. DECLARATIONS
! ------------
!
use MODD_BUDGET, only: LBU_ENABLE, LBUDGET_RC, LBUDGET_RG, LBUDGET_RH, LBUDGET_RI, &
LBUDGET_RR, LBUDGET_RS, LBUDGET_RV, LBUDGET_TH
-use MODD_CST, only: XCI, XCL, XCPD, XCPV, XLSTT, XLVTT, XTT
-use MODD_CST, only: XALPI, XBETAI, XGAMI, XMD, XMV, XTT
+use MODD_CST, only: XCI, XCL, XCPD, XCPV, XLSTT, XLVTT, XTT, &
+ XALPI, XBETAI, XGAMI, XMD, XMV, XTT
use MODD_LES, only: LLES_CALL
use MODD_PARAMETERS, only: JPVEXT
use MODD_PARAM_ICE, only: CSUBG_PR_PDF, LDEPOSC
use MODD_RAIN_ICE_DESCR, only: XLBEXR, XLBR, XRTMIN
use MODD_RAIN_ICE_PARAM, only: XCRIAUTC
-!
+
+use mode_mppdb
use MODE_MSG
use MODE_RAIN_ICE_FAST_RG, only: RAIN_ICE_FAST_RG
use MODE_RAIN_ICE_FAST_RH, only: RAIN_ICE_FAST_RH
@@ -266,15 +268,11 @@ use MODE_RAIN_ICE_SEDIMENTATION_SPLIT, only: RAIN_ICE_SEDIMENTATION_SPLIT
use MODE_RAIN_ICE_SEDIMENTATION_STAT, only: RAIN_ICE_SEDIMENTATION_STAT
use MODE_RAIN_ICE_SLOW, only: RAIN_ICE_SLOW
use MODE_RAIN_ICE_WARM, only: RAIN_ICE_WARM
-!
-use mode_mppdb
-#ifdef MNH_PGI
-USE MODE_PACK_PGI
-#endif
-!
+use mode_tools, only: Countjv
+
use MODI_BUDGET
USE MODI_ICE4_RAINFR_VERT
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -623,7 +621,9 @@ IF( IMICRO >= 0 ) THEN
!
IF (LBU_ENABLE .OR. LLES_CALL) THEN
ALLOCATE(ZRHODJ(IMICRO))
- ZRHODJ(:) = PACK( PRHODJ(:,:,:),MASK=GMICRO(:,:,:) )
+ DO JL=1,IMICRO
+ ZRHODJ(JL) = PRHODJ(I1(JL),I2(JL),I3(JL))
+ END DO
ELSE
ALLOCATE(ZRHODJ(0))
END IF
@@ -816,8 +816,10 @@ IF( IMICRO >= 0 ) THEN
ENDIF
!Diagnostic of precipitation fraction
- ZW(:,:,:) = 0.
- PRAINFR(:,:,:) = UNPACK( ZRF(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ PRAINFR(:,:,:) = 0.
+ DO JL=1,IMICRO
+ PRAINFR(I1(JL),I2(JL),I3(JL)) = ZRF(JL)
+ END DO
CALL ICE4_RAINFR_VERT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, PRRT(:,:,:))
DO JL=1,IMICRO
ZRF(JL)=PRAINFR(I1(JL),I2(JL),I3(JL))
@@ -852,7 +854,8 @@ IF( IMICRO >= 0 ) THEN
IF( OWARM ) THEN ! Check if the formation of the raindrops by the slow
! warm processes is allowed
PEVAP3D(:,:,:)= 0.
- CALL RAIN_ICE_WARM(GMICRO, ZRHODREF, ZRVT, ZRCT, ZRRT, ZHLC_HCF, ZHLC_LCF, ZHLC_HRC, ZHLC_LRC, &
+ CALL RAIN_ICE_WARM(GMICRO, IMICRO, I1, I2, I3, &
+ ZRHODREF, ZRVT, ZRCT, ZRRT, ZHLC_HCF, ZHLC_LCF, ZHLC_HRC, ZHLC_LRC, &
ZRHODJ, ZPRES, ZZT, ZLBDAR, ZLBDAR_RF, ZLVFACT, ZCJ, ZKA, ZDV, ZRF, ZCF, ZTHT, ZTHLT, &
PRHODJ, PTHS, PRVS, ZRVS, ZRCS, ZRRS, ZTHS, ZUSW, PEVAP3D)
END IF
@@ -904,29 +907,23 @@ IF( IMICRO >= 0 ) THEN
!
!
!
- ZW(:,:,:) = PRVS(:,:,:)
- PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRCS(:,:,:)
- PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRRS(:,:,:)
- PRRS(:,:,:) = UNPACK( ZRRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRIS(:,:,:)
- PRIS(:,:,:) = UNPACK( ZRIS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRSS(:,:,:)
- PRSS(:,:,:) = UNPACK( ZRSS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRGS(:,:,:)
- PRGS(:,:,:) = UNPACK( ZRGS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ DO JL=1,IMICRO
+ PRVS(I1(JL),I2(JL),I3(JL)) = ZRVS(JL)
+ PRCS(I1(JL),I2(JL),I3(JL)) = ZRCS(JL)
+ PRRS(I1(JL),I2(JL),I3(JL)) = ZRRS(JL)
+ PRIS(I1(JL),I2(JL),I3(JL)) = ZRIS(JL)
+ PRSS(I1(JL),I2(JL),I3(JL)) = ZRSS(JL)
+ PRGS(I1(JL),I2(JL),I3(JL)) = ZRGS(JL)
+ PTHS(I1(JL),I2(JL),I3(JL)) = ZTHS(JL)
+ PCIT(I1(JL),I2(JL),I3(JL)) = ZCIT(JL)
+ !
+ PRAINFR(I1(JL),I2(JL),I3(JL)) = ZRF(JL)
+ END DO
IF ( KRR == 7 ) THEN
- ZW(:,:,:) = PRHS(:,:,:)
- PRHS(:,:,:) = UNPACK( ZRHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ DO JL=1,IMICRO
+ PRHS(I1(JL),I2(JL),I3(JL)) = ZRHS(JL)
+ END DO
END IF
- ZW(:,:,:) = PTHS(:,:,:)
- PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PCIT(:,:,:)
- PCIT(:,:,:) = UNPACK( ZCIT(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
-!
- ZW(:,:,:) = PRAINFR(:,:,:)
- PRAINFR(:,:,:) = UNPACK( ZRF(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
!
!
!
@@ -1099,7 +1096,6 @@ END IF
!sedimentation of rain fraction
CALL ICE4_RAINFR_VERT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, PRRS(:,:,:)*PTSTEP)
!
-!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PCIT,"RAIN_ICE end:PCIT")
@@ -1127,43 +1123,6 @@ IF (MPPDB_INITIALIZED) THEN
END DO
END IF
END IF
-!-------------------------------------------------------------------------------
-!
-CONTAINS
-!
-!-------------------------------------------------------------------------------
-!
- FUNCTION COUNTJV(LTAB,I1,I2,I3) RESULT(IC)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* 0.2 declaration of local variables
-!
-!
-LOGICAL, DIMENSION(:,:,:) :: LTAB ! Mask
-INTEGER, DIMENSION(:) :: I1,I2,I3 ! Used to replace the COUNT and PACK
-INTEGER :: JI,JJ,JK,IC
-!
-!-------------------------------------------------------------------------------
-!
-IC = 0
-DO JK = 1,SIZE(LTAB,3)
- DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ,JK) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- I3(IC) = JK
- END IF
- END DO
- END DO
-END DO
-!
-END FUNCTION COUNTJV
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/rain_ice_elec.f90 b/src/MNH/rain_ice_elec.f90
index 94b30788ff570b25117a6e7bb67f51d929b3d364..37e0c3d04d21f1f9b59f0f52c58eb84633ad6d6f 100644
--- a/src/MNH/rain_ice_elec.f90
+++ b/src/MNH/rain_ice_elec.f90
@@ -226,35 +226,36 @@ END MODULE MODI_RAIN_ICE_ELEC
!! J.Escobar : 10/2017 : for real*4 , limit exp() in RAIN_ICE_ELEC_SLOW with XMNH_HUGE_12_LOG
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_REF, ONLY : XTHVREFZ
-USE MODD_PARAMETERS
-USE MODD_CST
-USE MODD_CONF
-USE MODD_RAIN_ICE_DESCR
-USE MODD_RAIN_ICE_PARAM
-USE MODD_PARAM_ICE
USE MODD_BUDGET
-USE MODD_LES
-USE MODE_ll
-!
-USE MODD_ELEC_PARAM
+USE MODD_CONF
+USE MODD_CST
USE MODD_ELEC_DESCR
USE MODD_ELEC_n
-USE MODD_NSV, ONLY : NSV_ELECBEG, NSV_ELECEND ! variables scalaires pour bilans
-!
-USE MODI_BUDGET
-USE MODI_MOMG
-!
+USE MODD_ELEC_PARAM
+USE MODD_LES
+USE MODE_ll
+USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELECEND ! Scalar variables for budgets
+USE MODD_PARAMETERS
+USE MODD_PARAM_ICE
+USE MODD_RAIN_ICE_DESCR
+USE MODD_RAIN_ICE_PARAM
+USE MODD_REF, ONLY: XTHVREFZ
+
#ifdef MNH_PGI
USE MODE_PACK_PGI
#endif
-!
+use mode_tools, only: Countjv
+
+USE MODI_BUDGET
+USE MODI_MOMG
+
IMPLICIT NONE
!
!
@@ -5782,41 +5783,6 @@ END SUBROUTINE INDUCTIVE_PROCESS
!
!------------------------------------------------------------------------------
!
-!
- FUNCTION COUNTJV(LTAB,I1,I2,I3) RESULT(IC)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* 0.2 declaration of local variables
-!
-!
-LOGICAL, DIMENSION(:,:,:) :: LTAB ! Mask
-INTEGER, DIMENSION(:) :: I1,I2,I3 ! Used to replace the COUNT and PACK
-INTEGER :: JI,JJ,JK,IC
-!
-!-------------------------------------------------------------------------------
-!
-IC = 0
-DO JK = 1,SIZE(LTAB,3)
- DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ,JK) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- I3(IC) = JK
- END IF
- END DO
- END DO
-END DO
-!
-END FUNCTION COUNTJV
-!
-!-------------------------------------------------------------------------------
-!
!
FUNCTION BI_LIN_INTP_V(ZT, KI, KJ, PDX, PDY, KN) RESULT(Y)
!
diff --git a/src/MNH/rain_ice_fast_rg.f90 b/src/MNH/rain_ice_fast_rg.f90
index c6bcad458060b288b5c6807a3fd8fa7c067d4808..181b055d3cf88b3cc997d26b402687bd0c2fe69a 100644
--- a/src/MNH/rain_ice_fast_rg.f90
+++ b/src/MNH/rain_ice_fast_rg.f90
@@ -6,6 +6,8 @@
! Modifications:
! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 03/06/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
+! P. Wautelet 05/06/2019: optimisations
!-----------------------------------------------------------------
MODULE MODE_RAIN_ICE_FAST_RG
@@ -79,11 +81,12 @@ REAL, DIMENSION(:), intent(out) :: PRWETG ! Wet growth rate of the g
!* 0.2 declaration of local variables
!
INTEGER :: IGDRY
-INTEGER :: JJ
+INTEGER :: JJ, JL
+INTEGER, DIMENSION(size(PRHODREF)) :: I1
INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1, IVEC2 ! Vectors of indices for interpolations
-LOGICAL, DIMENSION(size(PRHODREF)) :: GDRY ! Test where to compute dry growth
REAL, DIMENSION(size(PRHODREF)) :: ZZW ! Work array
REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors for interpolations
+REAL, DIMENSION(:), ALLOCATABLE :: ZVECLBDAG, ZVECLBDAR, ZVECLBDAS
REAL, DIMENSION(size(PRHODREF),7) :: ZZW1 ! Work arrays
!
!-------------------------------------------------------------------------------
@@ -125,7 +128,6 @@ END IF
!
!* 6.1 rain contact freezing
!
- ZZW1(:,3:4) = 0.0
WHERE( (PRIT(:)>XRTMIN(4)) .AND. (PRRT(:)>XRTMIN(3)) .AND. &
(PRIS(:)>0.0) .AND. (PRRS(:)>0.0) )
ZZW1(:,3) = MIN( PRIS(:),XICFRR * PRIT(:) & ! RICFRRG
@@ -155,11 +157,11 @@ END IF
!* 6.2 compute the Dry growth case
!
ZZW1(:,:) = 0.0
- WHERE( (PRGT(:)>XRTMIN(6)) .AND. ((PRCT(:)>XRTMIN(2) .AND. PRCS(:)>0.0)) )
+ WHERE( PRGT(:)>XRTMIN(6) .AND. PRCT(:)>XRTMIN(2) .AND. PRCS(:)>0.0 )
ZZW(:) = PLBDAG(:)**(XCXG-XDG-2.0) * PRHODREF(:)**(-XCEXVT)
ZZW1(:,1) = MIN( PRCS(:),XFCDRYG * PRCT(:) * ZZW(:) ) ! RCDRYG
END WHERE
- WHERE( (PRGT(:)>XRTMIN(6)) .AND. ((PRIT(:)>XRTMIN(4) .AND. PRIS(:)>0.0)) )
+ WHERE( (PRGT(:)>XRTMIN(6)) .AND. PRIT(:)>XRTMIN(4) .AND. PRIS(:)>0.0 )
ZZW(:) = PLBDAG(:)**(XCXG-XDG-2.0) * PRHODREF(:)**(-XCEXVT)
ZZW1(:,2) = MIN( PRIS(:),XFIDRYG * EXP( XCOLEXIG*(PZT(:)-XTT) ) &
* PRIT(:) * ZZW(:) ) ! RIDRYG
@@ -167,13 +169,20 @@ END IF
!
!* 6.2.1 accretion of aggregates on the graupeln
!
- GDRY(:) = (PRST(:)>XRTMIN(5)) .AND. (PRGT(:)>XRTMIN(6)) .AND. (PRSS(:)>0.0)
- IGDRY = COUNT( GDRY(:) )
-!
+ IGDRY = 0
+ DO JJ = 1, SIZE(PRST)
+ IF ( PRST(JJ)>XRTMIN(5) .AND. PRGT(JJ)>XRTMIN(6) .AND. PRSS(JJ)>0.0 ) THEN
+ IGDRY = IGDRY + 1
+ I1(IGDRY) = JJ
+ END IF
+ END DO
+
IF( IGDRY>0 ) THEN
!
!* 6.2.2 allocations
!
+ ALLOCATE(ZVECLBDAG(IGDRY))
+ ALLOCATE(ZVECLBDAS(IGDRY))
ALLOCATE(ZVEC1(IGDRY))
ALLOCATE(ZVEC2(IGDRY))
ALLOCATE(ZVEC3(IGDRY))
@@ -182,20 +191,20 @@ END IF
!
!* 6.2.3 select the (PLBDAG,PLBDAS) couplet
!
- ZVEC1(:) = PACK( PLBDAG(:),MASK=GDRY(:) )
- ZVEC2(:) = PACK( PLBDAS(:),MASK=GDRY(:) )
+ ZVECLBDAG(1:IGDRY) = PLBDAG(I1(1:IGDRY))
+ ZVECLBDAS(1:IGDRY) = PLBDAS(I1(1:IGDRY))
!
!* 6.2.4 find the next lower indice for the PLBDAG and for the PLBDAS
! in the geometrical set of (Lbda_g,Lbda_s) couplet use to
! tabulate the SDRYG-kernel
!
ZVEC1(1:IGDRY) = MAX( 1.00001, MIN( REAL(NDRYLBDAG)-0.00001, &
- XDRYINTP1G * LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) )
+ XDRYINTP1G * LOG( ZVECLBDAG(1:IGDRY) ) + XDRYINTP2G ) )
IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) )
ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - REAL( IVEC1(1:IGDRY) )
!
ZVEC2(1:IGDRY) = MAX( 1.00001, MIN( REAL(NDRYLBDAS)-0.00001, &
- XDRYINTP1S * LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2S ) )
+ XDRYINTP1S * LOG( ZVECLBDAS(1:IGDRY) ) + XDRYINTP2S ) )
IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) )
!
@@ -210,17 +219,19 @@ END IF
- XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* (ZVEC1(JJ) - 1.0)
END DO
- ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 )
-!
- WHERE( GDRY(:) )
- ZZW1(:,3) = MIN( PRSS(:),XFSDRYG*ZZW(:) & ! RSDRYG
- * EXP( XCOLEXSG*(PZT(:)-XTT) ) &
- *( PLBDAS(:)**(XCXS-XBS) )*( PLBDAG(:)**XCXG ) &
- *( PRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBSDRYG1/( PLBDAG(:)**2 ) + &
- XLBSDRYG2/( PLBDAG(:) * PLBDAS(:) ) + &
- XLBSDRYG3/( PLBDAS(:)**2) ) )
- END WHERE
+!
+ DO JJ = 1, IGDRY
+ JL = I1(JJ)
+ ZZW1(JL,3) = MIN( PRSS(JL),XFSDRYG*ZVEC3(JJ) & ! RSDRYG
+ * EXP( XCOLEXSG*(PZT(JL)-XTT) ) &
+ *( ZVECLBDAS(JJ)**(XCXS-XBS) )*( ZVECLBDAG(JJ)**XCXG ) &
+ *( PRHODREF(JL)**(-XCEXVT-1.) ) &
+ *( XLBSDRYG1/( ZVECLBDAG(JJ)**2 ) + &
+ XLBSDRYG2/( ZVECLBDAG(JJ) * ZVECLBDAS(JJ) ) + &
+ XLBSDRYG3/( ZVECLBDAS(JJ)**2) ) )
+ END DO
+ DEALLOCATE(ZVECLBDAS)
+ DEALLOCATE(ZVECLBDAG)
DEALLOCATE(IVEC2)
DEALLOCATE(IVEC1)
DEALLOCATE(ZVEC3)
@@ -230,13 +241,20 @@ END IF
!
!* 6.2.6 accretion of raindrops on the graupeln
!
- GDRY(:) = (PRRT(:)>XRTMIN(3)) .AND. (PRGT(:)>XRTMIN(6)) .AND. (PRRS(:)>0.0)
- IGDRY = COUNT( GDRY(:) )
+ IGDRY = 0
+ DO JJ = 1, SIZE(PRRT)
+ IF ( PRRT(JJ)>XRTMIN(3) .AND. PRGT(JJ)>XRTMIN(6) .AND. PRRS(JJ)>0.0 ) THEN
+ IGDRY = IGDRY + 1
+ I1(IGDRY) = JJ
+ END IF
+ END DO
!
IF( IGDRY>0 ) THEN
!
!* 6.2.7 allocations
!
+ ALLOCATE(ZVECLBDAG(IGDRY))
+ ALLOCATE(ZVECLBDAR(IGDRY))
ALLOCATE(ZVEC1(IGDRY))
ALLOCATE(ZVEC2(IGDRY))
ALLOCATE(ZVEC3(IGDRY))
@@ -245,20 +263,20 @@ END IF
!
!* 6.2.8 select the (PLBDAG,PLBDAR) couplet
!
- ZVEC1(:) = PACK( PLBDAG(:),MASK=GDRY(:) )
- ZVEC2(:) = PACK( PLBDAR(:),MASK=GDRY(:) )
+ ZVECLBDAG(1:IGDRY) = PLBDAG(I1(1:IGDRY))
+ ZVECLBDAR(1:IGDRY) = PLBDAR(I1(1:IGDRY))
!
!* 6.2.9 find the next lower indice for the PLBDAG and for the PLBDAR
! in the geometrical set of (Lbda_g,Lbda_r) couplet use to
! tabulate the RDRYG-kernel
!
ZVEC1(1:IGDRY) = MAX( 1.00001, MIN( REAL(NDRYLBDAG)-0.00001, &
- XDRYINTP1G * LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) )
+ XDRYINTP1G * LOG( ZVECLBDAG(1:IGDRY) ) + XDRYINTP2G ) )
IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) )
ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - REAL( IVEC1(1:IGDRY) )
!
ZVEC2(1:IGDRY) = MAX( 1.00001, MIN( REAL(NDRYLBDAR)-0.00001, &
- XDRYINTP1R * LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2R ) )
+ XDRYINTP1R * LOG( ZVECLBDAR(1:IGDRY) ) + XDRYINTP2R ) )
IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) )
!
@@ -273,16 +291,18 @@ END IF
- XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* (ZVEC1(JJ) - 1.0)
END DO
- ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 )
-!
- WHERE( GDRY(:) )
- ZZW1(:,4) = MIN( PRRS(:),XFRDRYG*ZZW(:) & ! RRDRYG
- *( PLBDAR(:)**(-4) )*( PLBDAG(:)**XCXG ) &
- *( PRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBRDRYG1/( PLBDAG(:)**2 ) + &
- XLBRDRYG2/( PLBDAG(:) * PLBDAR(:) ) + &
- XLBRDRYG3/( PLBDAR(:)**2) ) )
- END WHERE
+!
+ DO JJ = 1, IGDRY
+ JL = I1(JJ)
+ ZZW1(JL,4) = MIN( PRRS(JL),XFRDRYG*ZVEC3(JJ) & ! RRDRYG
+ *( ZVECLBDAR(JJ)**(-4) )*( ZVECLBDAG(JJ)**XCXG ) &
+ *( PRHODREF(JL)**(-XCEXVT-1.) ) &
+ *( XLBRDRYG1/( ZVECLBDAG(JJ)**2 ) + &
+ XLBRDRYG2/( ZVECLBDAG(JJ) * ZVECLBDAR(JJ) ) + &
+ XLBRDRYG3/( ZVECLBDAR(JJ)**2) ) )
+ END DO
+ DEALLOCATE(ZVECLBDAR)
+ DEALLOCATE(ZVECLBDAG)
DEALLOCATE(IVEC2)
DEALLOCATE(IVEC1)
DEALLOCATE(ZVEC3)
@@ -294,7 +314,6 @@ END IF
!
!* 6.3 compute the Wet growth case
!
- ZZW(:) = 0.0
PRWETG(:) = 0.0
WHERE( PRGT(:)>XRTMIN(6) )
ZZW1(:,5) = MIN( PRIS(:), &
@@ -319,7 +338,6 @@ END IF
!
!* 6.4 Select Wet or Dry case
!
- ZZW(:) = 0.0
IF ( KRR == 7 ) THEN
WHERE( PRGT(:)>XRTMIN(6) .AND. PZT(:)<XTT &
.AND. & ! Wet
@@ -353,14 +371,13 @@ END IF
WHERE( PRGT(:)>XRTMIN(6) .AND. PZT(:)<XTT &
.AND. & ! Wet
PRDRYG(:)>=PRWETG(:) .AND. PRWETG(:)>0.0 ) ! case
- ZZW(:) = PRWETG(:)
PRCS(:) = PRCS(:) - ZZW1(:,1)
PRIS(:) = PRIS(:) - ZZW1(:,5)
PRSS(:) = PRSS(:) - ZZW1(:,6)
- PRGS(:) = PRGS(:) + ZZW(:)
+ PRGS(:) = PRGS(:) + PRWETG(:)
!
- PRRS(:) = PRRS(:) - ZZW(:) + ZZW1(:,5) + ZZW1(:,6) + ZZW1(:,1)
- PTHS(:) = PTHS(:) + (ZZW(:)-ZZW1(:,5)-ZZW1(:,6))*(PLSFACT(:)-PLVFACT(:))
+ PRRS(:) = PRRS(:) - PRWETG(:) + ZZW1(:,5) + ZZW1(:,6) + ZZW1(:,1)
+ PTHS(:) = PTHS(:) + (PRWETG(:)-ZZW1(:,5)-ZZW1(:,6))*(PLSFACT(:)-PLVFACT(:))
! f(L_f*(RCWETG+RRWETG))
END WHERE
END IF
@@ -426,8 +443,7 @@ END IF
!
!* 6.5 Melting of the graupeln
!
- ZZW(:) = 0.0
- WHERE( (PRGT(:)>XRTMIN(6)) .AND. (PRGS(:)>0.0) .AND. (PZT(:)>XTT) )
+ WHERE( PRGT(:)>XRTMIN(6) .AND. PRGS(:)>0.0 .AND. PZT(:)>XTT )
ZZW(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
ZZW(:) = PKA(:)*(XTT-PZT(:)) + &
( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) &
diff --git a/src/MNH/rain_ice_fast_rh.f90 b/src/MNH/rain_ice_fast_rh.f90
index 178dcc779457fdb1b7bcdf289c00bc87caed6334..76f87fc07633dce60a3fb6a6649f8fa9985efd34 100644
--- a/src/MNH/rain_ice_fast_rh.f90
+++ b/src/MNH/rain_ice_fast_rh.f90
@@ -6,6 +6,8 @@
! Modifications:
! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 03/06/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
+! P. Wautelet 05/06/2019: optimisations
!-----------------------------------------------------------------
MODULE MODE_RAIN_ICE_FAST_RH
@@ -73,11 +75,11 @@ REAL, DIMENSION(:), intent(inout) :: PUSW ! Undersaturation over wat
!* 0.2 declaration of local variables
!
INTEGER :: IHAIL, IGWET
-INTEGER :: JJ
+INTEGER :: JJ, JL
+INTEGER, DIMENSION(size(PRHODREF)) :: I1H, I1W
INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1, IVEC2 ! Vectors of indices for interpolations
-LOGICAL, DIMENSION(size(PRHODREF)) :: GWET ! Test where to compute wet growth
-LOGICAL, DIMENSION(size(PRHODREF)) :: GHAIL ! Test where to compute hail growth
REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors for interpolations
+REAL, DIMENSION(:), ALLOCATABLE :: ZVECLBDAG, ZVECLBDAH, ZVECLBDAS
REAL, DIMENSION(size(PRHODREF)) :: ZZW ! Work array
REAL, DIMENSION(size(PRHODREF),6) :: ZZW1 ! Work arrays
!
@@ -117,36 +119,52 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PUSW,"RAIN_ICE_FAST_RH beg:PUSW")
END IF
!
- GHAIL(:) = PRHT(:)>XRTMIN(7)
- IHAIL = COUNT(GHAIL(:))
+ IHAIL = 0
+ DO JJ = 1, SIZE(PRHT)
+ IF ( PRHT(JJ)>XRTMIN(7) ) THEN
+ IHAIL = IHAIL + 1
+ I1H(IHAIL) = JJ
+ END IF
+ END DO
!
IF( IHAIL>0 ) THEN
!
!* 7.2 compute the Wet growth of hail
-!
- WHERE ( GHAIL(:) )
- PLBDAH(:) = XLBH*( PRHODREF(:)*MAX( PRHT(:),XRTMIN(7) ) )**XLBEXH
- END WHERE
!
ZZW1(:,:) = 0.0
- WHERE( GHAIL(:) .AND. ((PRCT(:)>XRTMIN(2) .AND. PRCS(:)>0.0)) )
- ZZW(:) = PLBDAH(:)**(XCXH-XDH-2.0) * PRHODREF(:)**(-XCEXVT)
- ZZW1(:,1) = MIN( PRCS(:),XFWETH * PRCT(:) * ZZW(:) ) ! RCWETH
- END WHERE
- WHERE( GHAIL(:) .AND. ((PRIT(:)>XRTMIN(4) .AND. PRIS(:)>0.0)) )
- ZZW(:) = PLBDAH(:)**(XCXH-XDH-2.0) * PRHODREF(:)**(-XCEXVT)
- ZZW1(:,2) = MIN( PRIS(:),XFWETH * PRIT(:) * ZZW(:) ) ! RIWETH
- END WHERE
+!
+ DO JJ = 1, IHAIL
+ JL = I1H(JJ)
+ PLBDAH(JL) = XLBH * ( PRHODREF(JL) * MAX( PRHT(JL), XRTMIN(7) ) )**XLBEXH
+
+ IF ( PRCT(JL)>XRTMIN(2) .AND. PRCS(JL)>0.0 ) THEN
+ ZZW(JL) = PLBDAH(JL)**(XCXH-XDH-2.0) * PRHODREF(JL)**(-XCEXVT)
+ ZZW1(JL,1) = MIN( PRCS(JL),XFWETH * PRCT(JL) * ZZW(JL) ) ! RCWETH
+ END IF
+
+ IF ( PRIT(JL)>XRTMIN(4) .AND. PRIS(JL)>0.0 ) THEN
+ ZZW(JL) = PLBDAH(JL)**(XCXH-XDH-2.0) * PRHODREF(JL)**(-XCEXVT)
+ ZZW1(JL,2) = MIN( PRIS(JL),XFWETH * PRIT(JL) * ZZW(JL) ) ! RIWETH
+ END IF
+ END DO
!
!* 7.2.1 accretion of aggregates on the hailstones
!
- GWET(:) = GHAIL(:) .AND. (PRST(:)>XRTMIN(5) .AND. PRSS(:)>0.0)
- IGWET = COUNT( GWET(:) )
+ IGWET = 0
+ DO JJ = 1, IHAIL
+ JL = I1H(JJ)
+ IF ( PRST(JL)>XRTMIN(5) .AND. PRSS(JL)>0.0 ) THEN
+ IGWET = IGWET + 1
+ I1W(IGWET) = JL
+ END IF
+ END DO
!
IF( IGWET>0 ) THEN
!
!* 7.2.2 allocations
!
+ ALLOCATE(ZVECLBDAH(IGWET))
+ ALLOCATE(ZVECLBDAS(IGWET))
ALLOCATE(ZVEC1(IGWET))
ALLOCATE(ZVEC2(IGWET))
ALLOCATE(ZVEC3(IGWET))
@@ -155,20 +173,20 @@ END IF
!
!* 7.2.3 select the (PLBDAH,PLBDAS) couplet
!
- ZVEC1(:) = PACK( PLBDAH(:),MASK=GWET(:) )
- ZVEC2(:) = PACK( PLBDAS(:),MASK=GWET(:) )
+ ZVECLBDAH(1:IGWET) = PLBDAH(I1W(1:IGWET))
+ ZVECLBDAS(1:IGWET) = PLBDAS(I1W(1:IGWET))
!
!* 7.2.4 find the next lower indice for the PLBDAG and for the PLBDAS
! in the geometrical set of (Lbda_h,Lbda_s) couplet use to
! tabulate the SWETH-kernel
!
ZVEC1(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAH)-0.00001, &
- XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
+ XWETINTP1H * LOG( ZVECLBDAH(1:IGWET) ) + XWETINTP2H ) )
IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) )
!
ZVEC2(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAS)-0.00001, &
- XWETINTP1S * LOG( ZVEC2(1:IGWET) ) + XWETINTP2S ) )
+ XWETINTP1S * LOG( ZVECLBDAS(1:IGWET) ) + XWETINTP2S ) )
IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) )
!
@@ -183,16 +201,18 @@ END IF
- XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* (ZVEC1(JJ) - 1.0)
END DO
- ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GWET,FIELD=0.0 )
-!
- WHERE( GWET(:) )
- ZZW1(:,3) = MIN( PRSS(:),XFSWETH*ZZW(:) & ! RSWETH
- *( PLBDAS(:)**(XCXS-XBS) )*( PLBDAH(:)**XCXH ) &
- *( PRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBSWETH1/( PLBDAH(:)**2 ) + &
- XLBSWETH2/( PLBDAH(:) * PLBDAS(:) ) + &
- XLBSWETH3/( PLBDAS(:)**2) ) )
- END WHERE
+!
+ DO JJ = 1, IGWET
+ JL = I1W(JJ)
+ ZZW1(JL,3) = MIN( PRSS(JL),XFSWETH*ZVEC3(JJ) & ! RSWETH
+ *( ZVECLBDAS(JJ)**(XCXS-XBS) )*( ZVECLBDAH(JJ)**XCXH ) &
+ *( PRHODREF(JL)**(-XCEXVT-1.) ) &
+ *( XLBSWETH1/( ZVECLBDAH(JJ)**2 ) + &
+ XLBSWETH2/( ZVECLBDAH(JJ) * ZVECLBDAS(JJ) ) + &
+ XLBSWETH3/( ZVECLBDAS(JJ)**2) ) )
+ END DO
+ DEALLOCATE(ZVECLBDAS)
+ DEALLOCATE(ZVECLBDAH)
DEALLOCATE(IVEC2)
DEALLOCATE(IVEC1)
DEALLOCATE(ZVEC3)
@@ -202,13 +222,21 @@ END IF
!
!* 7.2.6 accretion of graupeln on the hailstones
!
- GWET(:) = GHAIL(:) .AND. (PRGT(:)>XRTMIN(6) .AND. PRGS(:)>0.0)
- IGWET = COUNT( GWET(:) )
+ IGWET = 0
+ DO JJ = 1, IHAIL
+ JL = I1H(JJ)
+ IF ( PRGT(JL)>XRTMIN(6) .AND. PRGS(JL)>0.0 ) THEN
+ IGWET = IGWET + 1
+ I1W(IGWET) = JL
+ END IF
+ END DO
!
IF( IGWET>0 ) THEN
!
!* 7.2.7 allocations
!
+ ALLOCATE(ZVECLBDAG(IGWET))
+ ALLOCATE(ZVECLBDAH(IGWET))
ALLOCATE(ZVEC1(IGWET))
ALLOCATE(ZVEC2(IGWET))
ALLOCATE(ZVEC3(IGWET))
@@ -217,20 +245,20 @@ END IF
!
!* 7.2.8 select the (PLBDAH,PLBDAG) couplet
!
- ZVEC1(:) = PACK( PLBDAH(:),MASK=GWET(:) )
- ZVEC2(:) = PACK( PLBDAG(:),MASK=GWET(:) )
+ ZVECLBDAG(1:IGWET) = PLBDAG(I1W(1:IGWET))
+ ZVECLBDAH(1:IGWET) = PLBDAH(I1W(1:IGWET))
!
!* 7.2.9 find the next lower indice for the PLBDAH and for the PLBDAG
! in the geometrical set of (Lbda_h,Lbda_g) couplet use to
! tabulate the GWETH-kernel
!
ZVEC1(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAG)-0.00001, &
- XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
+ XWETINTP1H * LOG( ZVECLBDAH(1:IGWET) ) + XWETINTP2H ) )
IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) )
!
ZVEC2(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAG)-0.00001, &
- XWETINTP1G * LOG( ZVEC2(1:IGWET) ) + XWETINTP2G ) )
+ XWETINTP1G * LOG( ZVECLBDAG(1:IGWET) ) + XWETINTP2G ) )
IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) )
!
@@ -245,16 +273,18 @@ END IF
- XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* (ZVEC1(JJ) - 1.0)
END DO
- ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GWET,FIELD=0.0 )
-!
- WHERE( GWET(:) )
- ZZW1(:,5) = MAX(MIN( PRGS(:),XFGWETH*ZZW(:) & ! RGWETH
- *( PLBDAG(:)**(XCXG-XBG) )*( PLBDAH(:)**XCXH ) &
- *( PRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBGWETH1/( PLBDAH(:)**2 ) + &
- XLBGWETH2/( PLBDAH(:) * PLBDAG(:) ) + &
- XLBGWETH3/( PLBDAG(:)**2) ) ),0. )
- END WHERE
+!
+ DO JJ = 1, IGWET
+ JL = I1W(JJ)
+ ZZW1(JL,5) = MAX(MIN( PRGS(JL),XFGWETH*ZVEC3(JJ) & ! RGWETH
+ *( ZVECLBDAG(JJ)**(XCXG-XBG) )*( ZVECLBDAH(JJ)**XCXH ) &
+ *( PRHODREF(JL)**(-XCEXVT-1.) ) &
+ *( XLBGWETH1/( ZVECLBDAH(JJ)**2 ) + &
+ XLBGWETH2/( ZVECLBDAH(JJ) * ZVECLBDAG(JJ) ) + &
+ XLBGWETH3/( ZVECLBDAG(JJ)**2) ) ),0. )
+ END DO
+ DEALLOCATE(ZVECLBDAH)
+ DEALLOCATE(ZVECLBDAG)
DEALLOCATE(IVEC2)
DEALLOCATE(IVEC1)
DEALLOCATE(ZVEC3)
@@ -264,45 +294,47 @@ END IF
!
!* 7.3 compute the Wet growth of hail
!
- ZZW(:) = 0.0
- WHERE( GHAIL(:) .AND. PZT(:)<XTT )
- ZZW(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
- ZZW(:) = PKA(:)*(XTT-PZT(:)) + &
- ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) &
- *(XESTT-ZZW(:))/(XRV*PZT(:)) )
+ DO JJ = 1, IHAIL
+ JL = I1H(JJ)
+ IF ( PZT(JL)<XTT ) THEN
+ ZZW(JL) = PRVT(JL)*PPRES(JL)/((XMV/XMD)+PRVT(JL)) ! Vapor pressure
+ ZZW(JL) = PKA(JL)*(XTT-PZT(JL)) + &
+ ( PDV(JL)*(XLVTT + ( XCPV - XCL ) * ( PZT(JL) - XTT )) &
+ *(XESTT-ZZW(JL))/(XRV*PZT(JL)) )
!
! compute RWETH
!
- ZZW(:) = MAX(0., ( ZZW(:) * ( X0DEPH* PLBDAH(:)**XEX0DEPH + &
- X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH ) + &
- ( ZZW1(:,2)+ZZW1(:,3)+ZZW1(:,5) ) * &
- ( PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PZT(:))) ) ) / &
- ( PRHODREF(:)*(XLMTT-XCL*(XTT-PZT(:))) ) )
+ ZZW(JL) = MAX(0., ( ZZW(JL) * ( X0DEPH* PLBDAH(JL)**XEX0DEPH + &
+ X1DEPH*PCJ(JL)*PLBDAH(JL)**XEX1DEPH ) + &
+ ( ZZW1(JL,2)+ZZW1(JL,3)+ZZW1(JL,5) ) * &
+ ( PRHODREF(JL)*(XLMTT+(XCI-XCL)*(XTT-PZT(JL))) ) ) / &
+ ( PRHODREF(JL)*(XLMTT-XCL*(XTT-PZT(JL))) ) )
!
- ZZW1(:,6) = MAX( ZZW(:) - ZZW1(:,2) - ZZW1(:,3) - ZZW1(:,5),0.) ! RCWETH+RRWETH
- END WHERE
- WHERE ( GHAIL(:) .AND. PZT(:)<XTT .AND. ZZW1(:,6)/=0.)
+ ZZW1(JL,6) = MAX( ZZW(JL) - ZZW1(JL,2) - ZZW1(JL,3) - ZZW1(JL,5),0.) ! RCWETH+RRWETH
+ IF ( ZZW1(JL,6)/=0.) THEN
!
! limitation of the available rainwater mixing ratio (RRWETH < RRS !)
!
- ZZW1(:,4) = MAX( 0.0,MIN( ZZW1(:,6),PRRS(:)+ZZW1(:,1) ) )
- PUSW(:) = ZZW1(:,4) / ZZW1(:,6)
- ZZW1(:,2) = ZZW1(:,2)*PUSW(:)
- ZZW1(:,3) = ZZW1(:,3)*PUSW(:)
- ZZW1(:,5) = ZZW1(:,5)*PUSW(:)
- ZZW(:) = ZZW1(:,4) + ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,5)
+ ZZW1(JL,4) = MAX( 0.0,MIN( ZZW1(JL,6),PRRS(JL)+ZZW1(JL,1) ) )
+ PUSW(JL) = ZZW1(JL,4) / ZZW1(JL,6)
+ ZZW1(JL,2) = ZZW1(JL,2)*PUSW(JL)
+ ZZW1(JL,3) = ZZW1(JL,3)*PUSW(JL)
+ ZZW1(JL,5) = ZZW1(JL,5)*PUSW(JL)
+ ZZW(JL) = ZZW1(JL,4) + ZZW1(JL,2) + ZZW1(JL,3) + ZZW1(JL,5)
!
!* 7.1.6 integrate the Wet growth of hail
!
- PRCS(:) = PRCS(:) - ZZW1(:,1)
- PRIS(:) = PRIS(:) - ZZW1(:,2)
- PRSS(:) = PRSS(:) - ZZW1(:,3)
- PRGS(:) = PRGS(:) - ZZW1(:,5)
- PRHS(:) = PRHS(:) + ZZW(:)
- PRRS(:) = MAX( 0.0,PRRS(:) - ZZW1(:,4) + ZZW1(:,1) )
- PTHS(:) = PTHS(:) + ZZW1(:,4)*(PLSFACT(:)-PLVFACT(:))
+ PRCS(JL) = PRCS(JL) - ZZW1(JL,1)
+ PRIS(JL) = PRIS(JL) - ZZW1(JL,2)
+ PRSS(JL) = PRSS(JL) - ZZW1(JL,3)
+ PRGS(JL) = PRGS(JL) - ZZW1(JL,5)
+ PRHS(JL) = PRHS(JL) + ZZW(JL)
+ PRRS(JL) = MAX( 0.0,PRRS(JL) - ZZW1(JL,4) + ZZW1(JL,1) )
+ PTHS(JL) = PTHS(JL) + ZZW1(JL,4)*(PLSFACT(JL)-PLVFACT(JL))
! f(L_f*(RCWETH+RRWETH))
- END WHERE
+ END IF
+ END IF
+ END DO
END IF
IF (LBUDGET_TH) CALL BUDGET ( &
UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),&
@@ -358,24 +390,25 @@ END IF
!
!* 7.5 Melting of the hailstones
!
- ZZW(:) = 0.0
- WHERE( GHAIL(:) .AND. (PRHS(:)>0.0) .AND. (PZT(:)>XTT) )
- ZZW(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
- ZZW(:) = PKA(:)*(XTT-PZT(:)) + &
- ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) &
- *(XESTT-ZZW(:))/(XRV*PZT(:)) )
+ DO JJ = 1, IHAIL
+ JL = I1H(JJ)
+ IF( PRHS(JL)>0.0 .AND. PZT(JL)>XTT ) THEN
+ ZZW(JL) = PRVT(JL)*PPRES(JL)/((XMV/XMD)+PRVT(JL)) ! Vapor pressure
+ ZZW(JL) = PKA(JL)*(XTT-PZT(JL)) + &
+ ( PDV(JL)*(XLVTT + ( XCPV - XCL ) * ( PZT(JL) - XTT )) &
+ *(XESTT-ZZW(JL))/(XRV*PZT(JL)) )
!
! compute RHMLTR
!
- ZZW(:) = MIN( PRHS(:), MAX( 0.0,( -ZZW(:) * &
- ( X0DEPH* PLBDAH(:)**XEX0DEPH + &
- X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH ) - &
- ZZW1(:,6)*( PRHODREF(:)*XCL*(XTT-PZT(:))) ) / &
- ( PRHODREF(:)*XLMTT ) ) )
- PRRS(:) = PRRS(:) + ZZW(:)
- PRHS(:) = PRHS(:) - ZZW(:)
- PTHS(:) = PTHS(:) - ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(-RHMLTR))
- END WHERE
+ ZZW(JL) = MIN( PRHS(JL), MAX( 0.0,( -ZZW(JL) * &
+ ( X0DEPH* PLBDAH(JL)**XEX0DEPH + &
+ X1DEPH*PCJ(JL)*PLBDAH(JL)**XEX1DEPH ) ) / &
+ ( PRHODREF(JL)*XLMTT ) ) )
+ PRRS(JL) = PRRS(JL) + ZZW(JL)
+ PRHS(JL) = PRHS(JL) - ZZW(JL)
+ PTHS(JL) = PTHS(JL) - ZZW(JL)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(-RHMLTR))
+ END IF
+ END DO
END IF
IF (LBUDGET_TH) CALL BUDGET ( &
diff --git a/src/MNH/rain_ice_fast_ri.f90 b/src/MNH/rain_ice_fast_ri.f90
index a0c02d6ce8b427c5022609de12cf37e2289209e3..73a49cf4357ab0901f35722de970beb48dbe050e 100644
--- a/src/MNH/rain_ice_fast_ri.f90
+++ b/src/MNH/rain_ice_fast_ri.f90
@@ -5,6 +5,7 @@
!-----------------------------------------------------------------
! Modifications:
! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
+! P. Wautelet 05/06/2019: optimisations
!-----------------------------------------------------------------
MODULE MODE_RAIN_ICE_FAST_RI
@@ -80,9 +81,7 @@ END IF
!
!* 7.1 cloud ice melting
!
- ZZW(:) = 0.0
- WHERE( (PRIS(:)>0.0) .AND. (PZT(:)>XTT) )
- ZZW(:) = PRIS(:)
+ WHERE( PRIS(:)>0.0 .AND. PZT(:)>XTT )
PRCS(:) = PRCS(:) + PRIS(:)
PTHS(:) = PTHS(:) - PRIS(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(-RIMLTC))
PRIS(:) = 0.0
@@ -100,9 +99,7 @@ END IF
!
!* 7.2 Bergeron-Findeisen effect: RCBERI
!
- ZZW(:) = 0.0
- WHERE( (PRCS(:)>0.0) .AND. (PSSI(:)>0.0) .AND. &
- (PRIT(:)>XRTMIN(4)) .AND. (PCIT(:)>0.0) )
+ WHERE( PRCS(:)>0.0 .AND. PSSI(:)>0.0 .AND. PRIT(:)>XRTMIN(4) .AND. PCIT(:)>0.0 )
ZZW(:) = MIN(1.E8,XLBI*( PRHODREF(:)*PRIT(:)/PCIT(:) )**XLBEXI) ! Lbda_i
ZZW(:) = MIN( PRCS(:),( PSSI(:) / (PRHODREF(:)*PAI(:)) ) * PCIT(:) * &
( X0DEPI/ZZW(:) + X2DEPI*PCJ(:)*PCJ(:)/ZZW(:)**(XDI+2.0) ) )
diff --git a/src/MNH/rain_ice_fast_rs.f90 b/src/MNH/rain_ice_fast_rs.f90
index 335c322b01efb51df04e9e0c4c883c8735df0c3a..6c93ba93b32a440f58382615a5556fcc53335bb6 100644
--- a/src/MNH/rain_ice_fast_rs.f90
+++ b/src/MNH/rain_ice_fast_rs.f90
@@ -6,6 +6,8 @@
! Modifications:
! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 03/06/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
+! P. Wautelet 05/06/2019: optimisations
!-----------------------------------------------------------------
MODULE MODE_RAIN_ICE_FAST_RS
@@ -70,13 +72,13 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PTHS ! Theta source
!* 0.2 declaration of local variables
!
INTEGER :: IGRIM, IGACC
-INTEGER :: JJ
+INTEGER :: JJ, JL
+INTEGER, DIMENSION(size(PRHODREF)) :: I1
INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1, IVEC2 ! Vectors of indices for interpolations
-LOGICAL, DIMENSION(size(PRHODREF)) :: GRIM ! Test where to compute riming
-LOGICAL, DIMENSION(size(PRHODREF)) :: GACC ! Test where to compute accretion
REAL, DIMENSION(size(PRHODREF)) :: ZZW ! Work array
REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors for interpolations
-REAL, DIMENSION(size(PRHODREF),4) :: ZZW1 ! Work arrays
+REAL, DIMENSION(:), ALLOCATABLE :: ZVECLBDAR, ZVECLBDAS
+REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4 ! Work arrays
!-------------------------------------------------------------------------------
!
IF (MPPDB_INITIALIZED) THEN
@@ -109,31 +111,36 @@ END IF
!
!* 5.1 cloud droplet riming of the aggregates
!
- ZZW1(:,:) = 0.0
-!
-! GRIM(:) = (PRCT(:)>0.0) .AND. (PRST(:)>0.0) .AND. &
- GRIM(:) = (PRCT(:)>XRTMIN(2)) .AND. (PRST(:)>XRTMIN(5)) .AND. &
- (PRCS(:)>0.0) .AND. (PZT(:)<XTT)
- IGRIM = COUNT( GRIM(:) )
-!
+ IGRIM = 0
+ DO JJ = 1, SIZE(PRCT)
+ IF ( PRCT(JJ)>XRTMIN(2) .AND. PRST(JJ)>XRTMIN(5) .AND. PRCS(JJ)>0.0 .AND. PZT(JJ)<XTT ) THEN
+ IGRIM = IGRIM + 1
+ I1(IGRIM) = JJ
+ END IF
+ END DO
+ !
IF( IGRIM>0 ) THEN
!
! 5.1.0 allocations
!
+ ALLOCATE(ZVECLBDAS(IGRIM))
ALLOCATE(ZVEC1(IGRIM))
ALLOCATE(ZVEC2(IGRIM))
ALLOCATE(IVEC2(IGRIM))
+ ALLOCATE(ZZW1(IGRIM))
+ ALLOCATE(ZZW2(IGRIM))
+ ALLOCATE(ZZW3(IGRIM))
!
! 5.1.1 select the PLBDAS
!
- ZVEC1(:) = PACK( PLBDAS(:),MASK=GRIM(:) )
+ ZVECLBDAS(1:IGRIM) = PLBDAS(I1(1:IGRIM))
!
! 5.1.2 find the next lower indice for the PLBDAS in the geometrical
! set of Lbda_s used to tabulate some moments of the incomplete
! gamma function
!
ZVEC2(1:IGRIM) = MAX( 1.00001, MIN( REAL(NGAMINC)-0.00001, &
- XRIMINTP1 * LOG( ZVEC1(1:IGRIM) ) + XRIMINTP2 ) )
+ XRIMINTP1 * LOG( ZVECLBDAS(1:IGRIM) ) + XRIMINTP2 ) )
IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) )
ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - REAL( IVEC2(1:IGRIM) )
!
@@ -142,47 +149,53 @@ END IF
!
ZVEC1(1:IGRIM) = XGAMINC_RIM1( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
- XGAMINC_RIM1( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
- ZZW(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GRIM,FIELD=0.0 )
!
! 5.1.4 riming of the small sized aggregates
!
- WHERE ( GRIM(:) )
- ZZW1(:,1) = MIN( PRCS(:), &
- XCRIMSS * ZZW(:) * PRCT(:) & ! RCRIMSS
- * PLBDAS(:)**XEXCRIMSS &
- * PRHODREF(:)**(-XCEXVT) )
- PRCS(:) = PRCS(:) - ZZW1(:,1)
- PRSS(:) = PRSS(:) + ZZW1(:,1)
- PTHS(:) = PTHS(:) + ZZW1(:,1)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RCRIMSS))
- END WHERE
+ DO JJ = 1, IGRIM
+ JL = I1(JJ)
+ ZZW1(JJ) = MIN( PRCS(JL), &
+ XCRIMSS * ZVEC1(JJ) * PRCT(JL) & ! RCRIMSS
+ * ZVECLBDAS(JJ)**XEXCRIMSS &
+ * PRHODREF(JL)**(-XCEXVT) )
+ PRCS(JL) = PRCS(JL) - ZZW1(JJ)
+ PRSS(JL) = PRSS(JL) + ZZW1(JJ)
+ PTHS(JL) = PTHS(JL) + ZZW1(JJ)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(RCRIMSS))
+ END DO
!
! 5.1.5 perform the linear interpolation of the normalized
! "XBS"-moment of the incomplete gamma function
!
ZVEC1(1:IGRIM) = XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
- XGAMINC_RIM2( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
- ZZW(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GRIM,FIELD=0.0 )
!
! 5.1.6 riming-conversion of the large sized aggregates into graupeln
!
!
- WHERE ( GRIM(:) .AND. (PRSS(:)>0.0) )
- ZZW1(:,2) = MIN( PRCS(:), &
- XCRIMSG * PRCT(:) & ! RCRIMSG
- * PLBDAS(:)**XEXCRIMSG &
- * PRHODREF(:)**(-XCEXVT) &
- - ZZW1(:,1) )
- ZZW1(:,3) = MIN( PRSS(:), &
- XSRIMCG * PLBDAS(:)**XEXSRIMCG & ! RSRIMCG
- * (1.0 - ZZW(:) )/(PTSTEP*PRHODREF(:)) )
- PRCS(:) = PRCS(:) - ZZW1(:,2)
- PRSS(:) = PRSS(:) - ZZW1(:,3)
- PRGS(:) = PRGS(:) + ZZW1(:,2)+ZZW1(:,3)
- PTHS(:) = PTHS(:) + ZZW1(:,2)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RCRIMSG))
- END WHERE
+ DO JJ = 1, IGRIM
+ JL = I1(JJ)
+ IF ( PRSS(JL) > 0.0 ) THEN
+ ZZW2(JJ) = MIN( PRCS(JL), &
+ XCRIMSG * PRCT(JL) & ! RCRIMSG
+ * ZVECLBDAS(JJ)**XEXCRIMSG &
+ * PRHODREF(JL)**(-XCEXVT) &
+ - ZZW1(JJ) )
+ ZZW3(JJ) = MIN( PRSS(JL), &
+ XSRIMCG * ZVECLBDAS(JJ)**XEXSRIMCG & ! RSRIMCG
+ * (1.0 - ZVEC1(JJ) )/(PTSTEP*PRHODREF(JL)) )
+ PRCS(JL) = PRCS(JL) - ZZW2(JJ)
+ PRSS(JL) = PRSS(JL) - ZZW3(JJ)
+ PRGS(JL) = PRGS(JL) + ZZW2(JJ)+ZZW3(JJ)
+ PTHS(JL) = PTHS(JL) + ZZW2(JJ)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(RCRIMSG))
+ END IF
+ END DO
+ DEALLOCATE(ZZW3)
+ DEALLOCATE(ZZW2)
+ DEALLOCATE(ZZW1)
DEALLOCATE(IVEC2)
DEALLOCATE(ZVEC2)
DEALLOCATE(ZVEC1)
+ DEALLOCATE(ZVECLBDAS)
END IF
IF (LBUDGET_TH) CALL BUDGET ( &
UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
@@ -199,37 +212,45 @@ END IF
!
!* 5.2 rain accretion onto the aggregates
!
- ZZW1(:,2:3) = 0.0
- GACC(:) = (PRRT(:)>XRTMIN(3)) .AND. (PRST(:)>XRTMIN(5)) .AND. &
- (PRRS(:)>0.0) .AND. (PZT(:)<XTT)
- IGACC = COUNT( GACC(:) )
-!
+ IGACC = 0
+ DO JJ = 1, SIZE(PRRT)
+ IF ( PRRT(JJ)>XRTMIN(3) .AND. PRST(JJ)>XRTMIN(5) .AND. PRRS(JJ)>0.0 .AND. PZT(JJ)<XTT ) THEN
+ IGACC = IGACC + 1
+ I1(IGACC) = JJ
+ END IF
+ END DO
+ !
IF( IGACC>0 ) THEN
!
! 5.2.0 allocations
!
+ ALLOCATE(ZVECLBDAR(IGACC))
+ ALLOCATE(ZVECLBDAS(IGACC))
ALLOCATE(ZVEC1(IGACC))
ALLOCATE(ZVEC2(IGACC))
ALLOCATE(ZVEC3(IGACC))
ALLOCATE(IVEC1(IGACC))
ALLOCATE(IVEC2(IGACC))
+ ALLOCATE(ZZW2(IGACC))
+ ALLOCATE(ZZW3(IGACC))
+ ALLOCATE(ZZW4(IGACC))
!
! 5.2.1 select the (PLBDAS,PLBDAR) couplet
!
- ZVEC1(:) = PACK( PLBDAS(:),MASK=GACC(:) )
- ZVEC2(:) = PACK( PLBDAR(:),MASK=GACC(:) )
+ ZVECLBDAS(1:IGACC) = PLBDAS(I1(1:IGACC))
+ ZVECLBDAR(1:IGACC) = PLBDAR(I1(1:IGACC))
!
! 5.2.2 find the next lower indice for the PLBDAS and for the PLBDAR
! in the geometrical set of (Lbda_s,Lbda_r) couplet use to
! tabulate the RACCSS-kernel
!
ZVEC1(1:IGACC) = MAX( 1.00001, MIN( REAL(NACCLBDAS)-0.00001, &
- XACCINTP1S * LOG( ZVEC1(1:IGACC) ) + XACCINTP2S ) )
+ XACCINTP1S * LOG( ZVECLBDAS(1:IGACC) ) + XACCINTP2S ) )
IVEC1(1:IGACC) = INT( ZVEC1(1:IGACC) )
ZVEC1(1:IGACC) = ZVEC1(1:IGACC) - REAL( IVEC1(1:IGACC) )
!
ZVEC2(1:IGACC) = MAX( 1.00001, MIN( REAL(NACCLBDAR)-0.00001, &
- XACCINTP1R * LOG( ZVEC2(1:IGACC) ) + XACCINTP2R ) )
+ XACCINTP1R * LOG( ZVECLBDAR(1:IGACC) ) + XACCINTP2R ) )
IVEC2(1:IGACC) = INT( ZVEC2(1:IGACC) )
ZVEC2(1:IGACC) = ZVEC2(1:IGACC) - REAL( IVEC2(1:IGACC) )
!
@@ -244,21 +265,21 @@ END IF
- XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
* (ZVEC1(JJ) - 1.0)
END DO
- ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GACC,FIELD=0.0 )
!
! 5.2.4 raindrop accretion on the small sized aggregates
!
- WHERE ( GACC(:) )
- ZZW1(:,2) = & !! coef of RRACCS
- XFRACCSS*( PLBDAS(:)**XCXS )*( PRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBRACCS1/((PLBDAS(:)**2) ) + &
- XLBRACCS2/( PLBDAS(:) * PLBDAR(:) ) + &
- XLBRACCS3/( (PLBDAR(:)**2)) )/PLBDAR(:)**4
- ZZW1(:,4) = MIN( PRRS(:),ZZW1(:,2)*ZZW(:) ) ! RRACCSS
- PRRS(:) = PRRS(:) - ZZW1(:,4)
- PRSS(:) = PRSS(:) + ZZW1(:,4)
- PTHS(:) = PTHS(:) + ZZW1(:,4)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RRACCSS))
- END WHERE
+ DO JJ = 1, IGACC
+ JL = I1(JJ)
+ ZZW2(JJ) = & !! coef of RRACCS
+ XFRACCSS*( ZVECLBDAS(JJ)**XCXS )*( PRHODREF(JL)**(-XCEXVT-1.) ) &
+ *( XLBRACCS1/((ZVECLBDAS(JJ)**2) ) + &
+ XLBRACCS2/( ZVECLBDAS(JJ) * ZVECLBDAR(JJ) ) + &
+ XLBRACCS3/( (ZVECLBDAR(JJ)**2)) )/ZVECLBDAR(JJ)**4
+ ZZW4(JJ) = MIN( PRRS(JL),ZZW2(JJ)*ZVEC3(JJ) ) ! RRACCSS
+ PRRS(JL) = PRRS(JL) - ZZW4(JJ)
+ PRSS(JL) = PRSS(JL) + ZZW4(JJ)
+ PTHS(JL) = PTHS(JL) + ZZW4(JJ)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(RRACCSS))
+ END DO
!
! 5.2.4b perform the bilinear interpolation of the normalized
! RACCS-kernel
@@ -271,7 +292,9 @@ END IF
- XKER_RACCS(IVEC2(JJ) ,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
* (ZVEC2(JJ) - 1.0)
END DO
- ZZW1(:,2) = ZZW1(:,2)*UNPACK( VECTOR=ZVEC3(:),MASK=GACC(:),FIELD=0.0 )
+ DO JJ = 1, IGACC
+ ZZW2(JJ) = ZZW2(JJ) * ZVEC3(JJ)
+ END DO
!! RRACCS!
! 5.2.5 perform the bilinear interpolation of the normalized
! SACCRG-kernel
@@ -284,31 +307,38 @@ END IF
- XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
* (ZVEC2(JJ) - 1.0)
END DO
- ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GACC,FIELD=0.0 )
!
! 5.2.6 raindrop accretion-conversion of the large sized aggregates
! into graupeln
!
- WHERE ( GACC(:) .AND. (PRSS(:)>0.0) )
- ZZW1(:,2) = MAX( MIN( PRRS(:),ZZW1(:,2)-ZZW1(:,4) ),0.0 ) ! RRACCSG
- END WHERE
- WHERE ( GACC(:) .AND. (PRSS(:)>0.0) .AND. ZZW1(:,2)>0.0 )
- ZZW1(:,3) = MIN( PRSS(:),XFSACCRG*ZZW(:)* & ! RSACCRG
- ( PLBDAS(:)**(XCXS-XBS) )*( PRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBSACCR1/((PLBDAR(:)**2) ) + &
- XLBSACCR2/( PLBDAR(:) * PLBDAS(:) ) + &
- XLBSACCR3/( (PLBDAS(:)**2)) )/PLBDAR(:) )
- PRRS(:) = PRRS(:) - ZZW1(:,2)
- PRSS(:) = PRSS(:) - ZZW1(:,3)
- PRGS(:) = PRGS(:) + ZZW1(:,2)+ZZW1(:,3)
- PTHS(:) = PTHS(:) + ZZW1(:,2)*(PLSFACT(:)-PLVFACT(:)) !
- ! f(L_f*(RRACCSG))
- END WHERE
+ DO JJ = 1, IGACC
+ JL = I1(JJ)
+ IF ( PRSS(JL) > 0.0 ) THEN
+ ZZW2(JJ) = MAX( MIN( PRRS(JL),ZZW2(JJ)-ZZW4(JJ) ),0.0 ) ! RRACCSG
+ IF ( ZZW2(JJ) > 0.0 ) THEN
+ ZZW3(JJ) = MIN( PRSS(JL),XFSACCRG*ZVEC3(JJ)* & ! RSACCRG
+ ( ZVECLBDAS(JJ)**(XCXS-XBS) )*( PRHODREF(JL)**(-XCEXVT-1.) ) &
+ *( XLBSACCR1/((ZVECLBDAR(JJ)**2) ) + &
+ XLBSACCR2/( ZVECLBDAR(JJ) * ZVECLBDAS(JJ) ) + &
+ XLBSACCR3/( (ZVECLBDAS(JJ)**2)) )/ZVECLBDAR(JJ) )
+ PRRS(JL) = PRRS(JL) - ZZW2(JJ)
+ PRSS(JL) = PRSS(JL) - ZZW3(JJ)
+ PRGS(JL) = PRGS(JL) + ZZW2(JJ)+ZZW3(JJ)
+ PTHS(JL) = PTHS(JL) + ZZW2(JJ)*(PLSFACT(JL)-PLVFACT(JL)) !
+ ! f(L_f*(RRACCSG))
+ END IF
+ END IF
+ END DO
+ DEALLOCATE(ZZW4)
+ DEALLOCATE(ZZW3)
+ DEALLOCATE(ZZW2)
DEALLOCATE(IVEC2)
DEALLOCATE(IVEC1)
DEALLOCATE(ZVEC3)
DEALLOCATE(ZVEC2)
DEALLOCATE(ZVEC1)
+ DEALLOCATE(ZVECLBDAS)
+ DEALLOCATE(ZVECLBDAR)
END IF
IF (LBUDGET_TH) CALL BUDGET ( &
UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), &
@@ -325,8 +355,7 @@ END IF
!
!* 5.3 Conversion-Melting of the aggregates
!
- ZZW(:) = 0.0
- WHERE( (PRST(:)>XRTMIN(5)) .AND. (PRSS(:)>0.0) .AND. (PZT(:)>XTT) )
+ WHERE( PRST(:)>XRTMIN(5) .AND. PRSS(:)>0.0 .AND. PZT(:)>XTT )
ZZW(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
ZZW(:) = PKA(:)*(XTT-PZT(:)) + &
( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) &
@@ -336,9 +365,7 @@ END IF
!
ZZW(:) = MIN( PRSS(:), XFSCVMG*MAX( 0.0,( -ZZW(:) * &
( X0DEPS* PLBDAS(:)**XEX0DEPS + &
- X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS ) - &
- ( ZZW1(:,1)+ZZW1(:,4) ) * &
- ( PRHODREF(:)*XCL*(XTT-PZT(:))) ) / &
+ X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS ) ) / &
( PRHODREF(:)*XLMTT ) ) )
!
! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT)
diff --git a/src/MNH/rain_ice_nucleation.f90 b/src/MNH/rain_ice_nucleation.f90
index 6c03e2a823771dbe7048db7c9e15de3e1fc6c16f..9c2035bd16f2f9b5f693a675ea3f03421e96dd35 100644
--- a/src/MNH/rain_ice_nucleation.f90
+++ b/src/MNH/rain_ice_nucleation.f90
@@ -5,6 +5,8 @@
!-----------------------------------------------------------------
! Modifications:
! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
!-----------------------------------------------------------------
MODULE MODE_RAIN_ICE_NUCLEATION
@@ -23,15 +25,16 @@ SUBROUTINE RAIN_ICE_NUCLEATION(KIB, KIE, KJB, KJE, KKTB, KKTE,KRR,PTSTEP,&
!* 0. DECLARATIONS
! ------------
!
-use MODD_BUDGET, only: LBUDGET_RI, LBUDGET_RV, LBUDGET_TH
-use MODD_CST, only: XALPI, XALPW, XBETAI, XBETAW, XCI, XCL, XCPD, XCPV, XGAMI, XGAMW, &
- XLSTT, XMD, XMV, XP00, XRD, XTT
-use MODD_RAIN_ICE_PARAM, only: XALPHA1, XALPHA2, XBETA1, XBETA2, XMNU0, XNU10, XNU20
-!
+use MODD_BUDGET, only: LBUDGET_RI, LBUDGET_RV, LBUDGET_TH
+use MODD_CST, only: XALPI, XALPW, XBETAI, XBETAW, XCI, XCL, XCPD, XCPV, XGAMI, XGAMW, &
+ XLSTT, XMD, XMV, XP00, XRD, XTT
+use MODD_RAIN_ICE_PARAM, only: XALPHA1, XALPHA2, XBETA1, XBETA2, XMNU0, XNU10, XNU20
+
use mode_mppdb
-!
+use mode_tools, only: Countjv
+
use MODI_BUDGET
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -151,7 +154,10 @@ IF( INEGT >= 1 ) THEN
!* 3.1.2 update the r_i and r_v mixing ratios
!
ZZW(:) = MIN( ZZW(:),50.E3 ) ! limitation provisoire a 50 l^-1
- ZW(:,:,:) = UNPACK( ZZW(:),MASK=GNEGT(:,:,:),FIELD=0.0 )
+ ZW(:,:,:) = 0.0
+ DO JL=1, INEGT
+ ZW(I1(JL), I2(JL), I3(JL)) = ZZW( JL )
+ END DO
ZW(:,:,:) = MAX( ZW(:,:,:) ,0.0 ) *XMNU0/(PRHODREF(:,:,:)*PTSTEP)
PRIS(:,:,:) = PRIS(:,:,:) + ZW(:,:,:)
PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
@@ -166,8 +172,10 @@ IF( INEGT >= 1 ) THEN
END IF
! f(L_s*(RVHENI))
ZZW(:) = MAX( ZZW(:)+ZCIT(:),ZCIT(:) )
- PCIT(:,:,:) = MAX( UNPACK( ZZW(:),MASK=GNEGT(:,:,:),FIELD=0.0 ) , &
- PCIT(:,:,:) )
+ PCIT(:,:,:) = MAX( PCIT(:,:,:), 0.0 )
+ DO JL=1, INEGT
+ PCIT(I1(JL), I2(JL), I3(JL)) = MAX( ZZW( JL ), PCIT(I1(JL), I2(JL), I3(JL)), 0.0 )
+ END DO
END IF
DEALLOCATE(ZSSI)
DEALLOCATE(ZUSW)
@@ -196,36 +204,4 @@ END IF
END SUBROUTINE RAIN_ICE_NUCLEATION
-FUNCTION COUNTJV(LTAB,I1,I2,I3) RESULT(IC)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* 0.2 declaration of local variables
-!
-!
-LOGICAL, DIMENSION(:,:,:) :: LTAB ! Mask
-INTEGER, DIMENSION(:) :: I1,I2,I3 ! Used to replace the COUNT and PACK
-INTEGER :: JI,JJ,JK,IC
-!
-!-------------------------------------------------------------------------------
-!
-IC = 0
-DO JK = 1,SIZE(LTAB,3)
- DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ,JK) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- I3(IC) = JK
- END IF
- END DO
- END DO
-END DO
-!
-END FUNCTION COUNTJV
-
END MODULE MODE_RAIN_ICE_NUCLEATION
diff --git a/src/MNH/rain_ice_red.f90 b/src/MNH/rain_ice_red.f90
index 87e9f33768962e7b866b422c3748f25280d90d73..9d3b49d4cde2df5d5af7b859d622d71add11c615 100644
--- a/src/MNH/rain_ice_red.f90
+++ b/src/MNH/rain_ice_red.f90
@@ -2,6 +2,7 @@
!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.
+!-----------------------------------------------------------------
! ######spl
MODULE MODI_RAIN_ICE_RED
! ########################
@@ -226,7 +227,6 @@ END MODULE MODI_RAIN_ICE_RED
!! land, sea and urban areas in the cloud sedimentation.
!! (D. Degrauwe), 2013-11: Export upper-air precipitation fluxes PFPR.
!! (S. Riette) Nov 2013 Protection against null sigma
-!! Juan 24/09/2012: for BUG Pgi rewrite PACK function on mode_pack_pgi
!! (C. Lac) FIT temporal scheme : instant M removed
!! (JP Pinty), 01-2014 : ICE4 : partial reconversion of hail to graupel
!! July, 2015 (O.Nuissier/F.Duffourg) Add microphysics diagnostic for
@@ -239,6 +239,8 @@ END MODULE MODI_RAIN_ICE_RED
!! (S. Riette) Source code split into several files
!! 02/2019 C.Lac add rain fraction as an output field
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
!
!* 0. DECLARATIONS
! ------------
@@ -250,21 +252,22 @@ USE MODD_PARAM_ICE, ONLY: CSUBG_PR_PDF,CSUBG_RC_RR_ACCR,CSUBG_RR_EVAP,LDEPO
NMAXITER,XMRSTEP,XTSTEP_TS,XVDEPOSC
USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
USE MODD_VAR_ll, ONLY: IP
-!
+
+USE MODE_ll
+USE MODE_MPPDB
+USE MODE_MSG
+use mode_tools, only: Countjv
+#ifdef _OPENACC
+use mode_tools, only: Countjv_device
+#endif
+
USE MODI_BUDGET
USE MODI_ICE4_NUCLEATION_WRAPPER
USE MODI_ICE4_RAINFR_VERT
USE MODI_ICE4_SEDIMENTATION_STAT
USE MODI_ICE4_SEDIMENTATION_SPLIT
USE MODI_ICE4_TENDENCIES
-!
-USE MODE_ll
-USE MODE_MPPDB
-USE MODE_MSG
-#ifdef MNH_PGI
-USE MODE_PACK_PGI
-#endif
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -738,11 +741,10 @@ ENDIF
! the microphysical fields are larger than a minimal value only !!!
!
#ifndef _OPENACC
-IMICRO=0
-IF(COUNT(ODMICRO)/=0) IMICRO=RAIN_ICE_COUNTJV(ODMICRO(:,:,:), IIT, IJT, IKT, SIZE(I1), I1(:), I2(:), I3(:))
+IMICRO=COUNTJV(ODMICRO(:,:,:), I1(:), I2(:), I3(:))
#else
!$acc data copyout(IMICRO)
-CALL RAIN_ICE_COUNTJV3D_DEVICE(ODMICRO(:,:,:),I1(:),I2(:),I3(:),IMICRO)
+CALL COUNTJV_DEVICE(ODMICRO(:,:,:),I1(:),I2(:),I3(:),IMICRO)
!$acc end data
#endif
!Packing
@@ -920,7 +922,7 @@ DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
CALL ICE4_TENDENCIES(IMICRO, IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, IKL, &
&KRR, GSOFT, LLCOMPUTE, &
&OWARM, CSUBG_RC_RR_ACCR, CSUBG_RR_EVAP, HSUBG_AUCV_RC, CSUBG_PR_PDF, &
- &ZEXN, ZRHODREF, ZLVFACT, ZLSFACT, ODMICRO, I1, I2, I3, &
+ &ZEXN, ZRHODREF, ZLVFACT, ZLSFACT, I1, I2, I3, &
&ZPRES, ZCF, ZSIGMA_RC, &
&ZCIT, &
&ZZT, ZTHT, &
@@ -1205,16 +1207,12 @@ ENDDO
!
! !$acc kernels
IF(IMICRO>0) THEN
-#ifndef _OPENACC
- PCIT(:,:,:) = UNPACK(ZCIT(:), MASK=ODMICRO(:,:,:), FIELD=PCIT(:,:,:))
-#else
!$acc kernels
!$acc loop independent
DO JL=1,IMICRO
PCIT(I1(JL), I2(JL), I3(JL)) = ZCIT(JL)
END DO
!$acc end kernels
-#endif
ELSE
!$acc kernels
PRAINFR(:,:,:)=0.
@@ -1223,15 +1221,11 @@ ELSE
ENDIF
!$acc kernels
IF(GWARM) THEN
-#ifndef _OPENACC
- PEVAP3D(:,:,:)=UNPACK(ZRREVAV(:), MASK=ODMICRO(:,:,:), FIELD=0.)
-#else
PEVAP3D(:,:,:) = 0.
!$acc loop independent
DO JL=1,IMICRO
PEVAP3D(I1(JL), I2(JL), I3(JL)) = ZRREVAV(JL)
END DO
-#endif
ENDIF
!
!
@@ -1282,17 +1276,26 @@ ENDIF
!$acc update self(ZRVT)
!Tendencies computed from difference between old state and new state (can be negative)
#ifndef _OPENACC
-ZW_RVS(:,:,:) = (UNPACK(ZRVT(:), MASK=ODMICRO(:,:,:), FIELD=PRVT(:,:,:)) - PRVT(:,:,:))*ZINV_TSTEP
-ZW_RCS(:,:,:) = (UNPACK(ZRCT(:), MASK=ODMICRO(:,:,:), FIELD=PRCT(:,:,:)) - PRCT(:,:,:))*ZINV_TSTEP
-ZW_RRS(:,:,:) = (UNPACK(ZRRT(:), MASK=ODMICRO(:,:,:), FIELD=PRRT(:,:,:)) - PRRT(:,:,:))*ZINV_TSTEP
-ZW_RIS(:,:,:) = (UNPACK(ZRIT(:), MASK=ODMICRO(:,:,:), FIELD=PRIT(:,:,:)) - PRIT(:,:,:))*ZINV_TSTEP
-ZW_RSS(:,:,:) = (UNPACK(ZRST(:), MASK=ODMICRO(:,:,:), FIELD=PRST(:,:,:)) - PRST(:,:,:))*ZINV_TSTEP
-ZW_RGS(:,:,:) = (UNPACK(ZRGT(:), MASK=ODMICRO(:,:,:), FIELD=PRGT(:,:,:)) - PRGT(:,:,:))*ZINV_TSTEP
-IF(IRR==7) THEN
- ZW_RHS(:,:,:) = (UNPACK(ZRHT(:), MASK=ODMICRO(:,:,:), FIELD=PRHT(:,:,:)) - PRHT(:,:,:))*ZINV_TSTEP
-ELSE
+ ZW_RVS(:,:,:) = 0.
+ ZW_RCS(:,:,:) = 0.
+ ZW_RRS(:,:,:) = 0.
+ ZW_RIS(:,:,:) = 0.
+ ZW_RSS(:,:,:) = 0.
+ ZW_RGS(:,:,:) = 0.
ZW_RHS(:,:,:) = 0.
-ENDIF
+ DO JL=1,IMICRO
+ ZW_RVS(I1(JL), I2(JL), I3(JL)) = ( ZRVT(JL) - PRVT(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
+ ZW_RCS(I1(JL), I2(JL), I3(JL)) = ( ZRCT(JL) - PRCT(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
+ ZW_RRS(I1(JL), I2(JL), I3(JL)) = ( ZRRT(JL) - PRRT(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
+ ZW_RIS(I1(JL), I2(JL), I3(JL)) = ( ZRIT(JL) - PRIT(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
+ ZW_RSS(I1(JL), I2(JL), I3(JL)) = ( ZRST(JL) - PRST(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
+ ZW_RGS(I1(JL), I2(JL), I3(JL)) = ( ZRGT(JL) - PRGT(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
+ END DO
+ IF(KRR==7) THEN
+ DO JL=1,IMICRO
+ ZW_RHS(I1(JL), I2(JL), I3(JL)) = ( ZRHT(JL) - PRHT(I1(JL), I2(JL), I3(JL)) ) * ZINV_TSTEP
+ END DO
+END IF
#else
IF (IRR==7) THEN
!PW: probably not working (see ELSE branch)
@@ -1451,7 +1454,9 @@ IF(GBU_ENABLE) THEN
#endif
!$acc update self(ZINV_TSTEP)
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RVHENI(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RVHENI(JL) * ZINV_TSTEP
+ END DO
PRIS(:,:,:) = PRIS(:,:,:) + ZW(:,:,:)
PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*ZZ_LSFACT(:,:,:)
@@ -1460,7 +1465,9 @@ IF(GBU_ENABLE) THEN
IF (GBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'HENU_BU_RRI')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RCHONI(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCHONI(JL) * ZINV_TSTEP
+ END DO
PRIS(:,:,:) = PRIS(:,:,:) + ZW(:,:,:)
PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
@@ -1469,7 +1476,9 @@ IF(GBU_ENABLE) THEN
IF (GBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'HON_BU_RRI')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RRHONG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RRHONG(JL) * ZINV_TSTEP
+ END DO
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
@@ -1478,7 +1487,9 @@ IF(GBU_ENABLE) THEN
IF (GBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'SFR_BU_RRG')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RVDEPS(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RVDEPS(JL) * ZINV_TSTEP
+ END DO
PRSS(:,:,:) = PRSS(:,:,:) + ZW(:,:,:)
PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*ZZ_LSFACT(:,:,:)
@@ -1487,21 +1498,27 @@ IF(GBU_ENABLE) THEN
IF (GBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'DEPS_BU_RRS')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RIAGGS(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIAGGS(JL) * ZINV_TSTEP
+ END DO
PRSS(:,:,:) = PRSS(:,:,:) + ZW(:,:,:)
PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
IF (GBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'AGGS_BU_RRI')
IF (GBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'AGGS_BU_RRS')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RIAUTS(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIAUTS(JL) * ZINV_TSTEP
+ END DO
PRSS(:,:,:) = PRSS(:,:,:) + ZW(:,:,:)
PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
IF (GBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'AUTS_BU_RRI')
IF (GBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'AUTS_BU_RRS')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RVDEPG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RVDEPG(JL) * ZINV_TSTEP
+ END DO
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*ZZ_LSFACT(:,:,:)
@@ -1511,21 +1528,27 @@ IF(GBU_ENABLE) THEN
IF(GWARM) THEN
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RCAUTR(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCAUTR(JL) * ZINV_TSTEP
+ END DO
PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
IF (GBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'AUTO_BU_RRC')
IF (GBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'AUTO_BU_RRR')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RCACCR(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCACCR(JL) * ZINV_TSTEP
+ END DO
PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
IF (GBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'ACCR_BU_RRC')
IF (GBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'ACCR_BU_RRR')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RREVAV(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RREVAV(JL) * ZINV_TSTEP
+ END DO
PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
PRVS(:,:,:) = PRVS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) - ZW(:,:,:)*ZZ_LVFACT(:,:,:)
@@ -1535,17 +1558,23 @@ IF(GBU_ENABLE) THEN
ENDIF
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RCRIMSS(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCRIMSS(JL) * ZINV_TSTEP
+ END DO
PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
PRSS(:,:,:) = PRSS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RCRIMSG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCRIMSG(JL) * ZINV_TSTEP
+ END DO
PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RSRIMCG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RSRIMCG(JL) * ZINV_TSTEP
+ END DO
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
IF (GBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'RIM_BU_RTH')
@@ -1554,17 +1583,23 @@ IF(GBU_ENABLE) THEN
IF (GBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'RIM_BU_RRG')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RRACCSS(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RRACCSS(JL) * ZINV_TSTEP
+ END DO
PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
PRSS(:,:,:) = PRSS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RRACCSG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RRACCSG(JL) * ZINV_TSTEP
+ END DO
PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RSACCRG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RSACCRG(JL) * ZINV_TSTEP
+ END DO
PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
IF (GBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'ACC_BU_RTH')
@@ -1573,11 +1608,15 @@ IF(GBU_ENABLE) THEN
IF (GBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'ACC_BU_RRG')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RSMLTG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RSMLTG(JL) * ZINV_TSTEP
+ END DO
PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RCMLTSR, MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCMLTSR(JL) * ZINV_TSTEP
+ END DO
PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
IF (GBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'CMEL_BU_RRS')
@@ -1586,16 +1625,22 @@ IF(GBU_ENABLE) THEN
IF (GBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'CMEL_BU_RRR')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RICFRRG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RICFRRG(JL) * ZINV_TSTEP
+ END DO
PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RRCFRIG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RRCFRIG(JL) * ZINV_TSTEP
+ END DO
PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RICFRR(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RICFRR(JL) * ZINV_TSTEP
+ END DO
PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
IF (GBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'CFRZ_BU_RTH')
@@ -1604,21 +1649,29 @@ IF(GBU_ENABLE) THEN
IF (GBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'CFRZ_BU_RRG')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RCWETG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCWETG(JL) * ZINV_TSTEP
+ END DO
PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RRWETG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RRWETG(JL) * ZINV_TSTEP
+ END DO
PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RIWETG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIWETG(JL) * ZINV_TSTEP
+ END DO
PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RSWETG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RSWETG(JL) * ZINV_TSTEP
+ END DO
PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
IF (GBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'WETG_BU_RTH')
@@ -1630,7 +1683,9 @@ IF(GBU_ENABLE) THEN
IF(IRR==7) THEN
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RWETGH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RWETGH(JL) * ZINV_TSTEP
+ END DO
PRGS(:,:,:) = PRGS(:,:,:) - ZW(:,:,:)
PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
IF (GBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'GHCV_BU_RRG')
@@ -1638,21 +1693,29 @@ IF(GBU_ENABLE) THEN
END IF
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RCDRYG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCDRYG(JL) * ZINV_TSTEP
+ END DO
PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RRDRYG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RRDRYG(JL) * ZINV_TSTEP
+ END DO
PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RIDRYG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIDRYG(JL) * ZINV_TSTEP
+ END DO
PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RSDRYG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RSDRYG(JL) * ZINV_TSTEP
+ END DO
PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
IF (GBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'DRYG_BU_RTH')
@@ -1663,7 +1726,9 @@ IF(GBU_ENABLE) THEN
IF (GBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'DRYG_BU_RRG')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RGMLTR(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RGMLTR(JL) * ZINV_TSTEP
+ END DO
PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) - ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) - ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
@@ -1673,25 +1738,35 @@ IF(GBU_ENABLE) THEN
IF(IRR==7) THEN
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RCWETH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCWETH(JL) * ZINV_TSTEP
+ END DO
PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RRWETH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RRWETH(JL) * ZINV_TSTEP
+ END DO
PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RIWETH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIWETH(JL) * ZINV_TSTEP
+ END DO
PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RSWETH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RSWETH(JL) * ZINV_TSTEP
+ END DO
PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RGWETH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RGWETH(JL) * ZINV_TSTEP
+ END DO
PRGS(:,:,:) = PRGS(:,:,:) - ZW(:,:,:)
PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
IF (GBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'WETH_BU_RTH')
@@ -1702,36 +1777,50 @@ IF(GBU_ENABLE) THEN
IF (GBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'WETH_BU_RRH')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RGWETH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RGWETH(JL) * ZINV_TSTEP
+ END DO
PRGS(:,:,:) = PRGS(:,:,:) - ZW(:,:,:)
PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
IF (GBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'HGCV_BU_RRG')
IF (GBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'HGCV_BU_RRH')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RCDRYH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCDRYH(JL) * ZINV_TSTEP
+ END DO
PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RRDRYH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RRDRYH(JL) * ZINV_TSTEP
+ END DO
PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RIDRYH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIDRYH(JL) * ZINV_TSTEP
+ END DO
PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RSDRYH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RSDRYH(JL) * ZINV_TSTEP
+ END DO
PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RGDRYH(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RGDRYH(JL) * ZINV_TSTEP
+ END DO
PRGS(:,:,:) = PRGS(:,:,:) - ZW(:,:,:)
PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RDRYHG(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RDRYHG(JL) * ZINV_TSTEP
+ END DO
PRHS(:,:,:) = PRHS(:,:,:) - ZW(:,:,:)
PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
IF (GBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'DRYH_BU_RTH')
@@ -1743,7 +1832,9 @@ IF(GBU_ENABLE) THEN
IF (GBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'DRYH_BU_RRH')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RHMLTR(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RHMLTR(JL) * ZINV_TSTEP
+ END DO
PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
PRHS(:,:,:) = PRHS(:,:,:) - ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) - ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
@@ -1753,7 +1844,9 @@ IF(GBU_ENABLE) THEN
ENDIF
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RIMLTC(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIMLTC(JL) * ZINV_TSTEP
+ END DO
PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
PRCS(:,:,:) = PRCS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) - ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
@@ -1762,7 +1855,9 @@ IF(GBU_ENABLE) THEN
IF (GBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'IMLT_BU_RRI')
ZW(:,:,:) = 0.
- ZW(:,:,:)=UNPACK(ZTOT_RCBERI(:), MASK=ODMICRO(:,:,:), FIELD=ZW(:,:,:))*ZINV_TSTEP
+ DO JL=1,IMICRO
+ ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCBERI(JL) * ZINV_TSTEP
+ END DO
PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
PRIS(:,:,:) = PRIS(:,:,:) + ZW(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
@@ -1916,94 +2011,6 @@ IF (MPPDB_INITIALIZED) THEN
END IF
!
CONTAINS
- FUNCTION RAIN_ICE_COUNTJV(LTAB, KIT, KJT, KKT, KSIZE, I1,I2,I3) RESULT(IC)
- !
- !* 0. DECLARATIONS
- ! ------------
- !
- IMPLICIT NONE
- !
- !* 0.2 declaration of local variables
- !
- !
- INTEGER, INTENT(IN) :: KIT, KJT, KKT, KSIZE
- LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: LTAB ! Mask
- INTEGER, DIMENSION(KSIZE), INTENT(OUT) :: I1,I2,I3 ! Used to replace the COUNT and PACK
- INTEGER :: JI,JJ,JK,IC
- !
- !-------------------------------------------------------------------------------
- !
- IC = 0
- DO JK = 1, SIZE(LTAB,3)
- DO JJ = 1, SIZE(LTAB,2)
- DO JI = 1, SIZE(LTAB,1)
- IF(LTAB(JI,JJ,JK)) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- I3(IC) = JK
- END IF
- END DO
- END DO
- END DO
- !
- !
- END FUNCTION RAIN_ICE_COUNTJV
- !
-#ifdef _OPENACC
- SUBROUTINE RAIN_ICE_COUNTJV3D_DEVICE(LTAB,I1,I2,I3,IC)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: LTAB ! Mask
-INTEGER, DIMENSION(:), INTENT(OUT) :: I1,I2,I3 ! Used to replace the COUNT and PACK
-INTEGER, INTENT(OUT) :: IC ! Count
-!$acc declare present(LTAB,I1,I2,I3,IC)
-!
-!* 0.2 declaration of local variables
-!
-INTEGER :: JI,JJ,JK,IDX
-!
-!-------------------------------------------------------------------------------
-!
-!$acc kernels present(LTAB,I1,I2,I3)
-
-!To allow comparisons... (I1/I2/I3 are not fully used)
-!Can be removed in production
-! I1(:) = -999
-! I2(:) = -999
-! I3(:) = -999
-
-
-IC = 0
-!Warning: if "independent" is set, content of I1, I2 and I3 can vary between 2
-! different runs of this subroutine BUT final result should be the same
-!Comment the following line + atomic directives to have consistent values for debugging
-!Warning: huge impact on performance
-!$acc loop collapse(3) private(IDX) independent
-DO JK = 1,SIZE(LTAB,3)
- DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ,JK) ) THEN
-!$acc atomic capture
- IC = IC +1
- IDX = IC
-!$acc end atomic
- I1(IDX) = JI
- I2(IDX) = JJ
- I3(IDX) = JK
- END IF
- END DO
- END DO
-END DO
-!$acc end kernels
-!
-END SUBROUTINE RAIN_ICE_COUNTJV3D_DEVICE
-#endif
- !
!
SUBROUTINE CORRECT_NEGATIVITIES(KRR, PRV, PRC, PRR, &
&PRI, PRS, PRG, &
diff --git a/src/MNH/rain_ice_sedimentation_split.f90 b/src/MNH/rain_ice_sedimentation_split.f90
index a2179af6106a9b0c82f57bb2a29ef6b6e835506b..6dba09363500748d89fd065bb64f6f6e55bb226b 100644
--- a/src/MNH/rain_ice_sedimentation_split.f90
+++ b/src/MNH/rain_ice_sedimentation_split.f90
@@ -6,6 +6,7 @@
! Modifications:
! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
!-----------------------------------------------------------------
MODULE MODE_RAIN_ICE_SEDIMENTATION_SPLIT
@@ -32,11 +33,12 @@ use MODD_RAIN_ICE_DESCR, only: XCC, XCONC_LAND, xconc_sea, xconc_urban, XDC, XCE
XALPHAC, XNUC, XALPHAC2, XNUC2, XLBEXC, XRTMIN, XLBEXC, XLBC
use MODD_RAIN_ICE_PARAM, only: XEXSEDG, XEXSEDH, XEXCSEDI, XEXSEDR, XEXSEDS, &
XFSEDG, XFSEDH, XFSEDI, XFSEDR, XFSEDS, XFSEDC
-!
+
use mode_mppdb
-!
+use mode_tools, only: Countjv
+
use MODI_BUDGET
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -659,36 +661,4 @@ END IF
END SUBROUTINE RAIN_ICE_SEDIMENTATION_SPLIT
- FUNCTION COUNTJV(LTAB,I1,I2,I3) RESULT(IC)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* 0.2 declaration of local variables
-!
-!
-LOGICAL, DIMENSION(:,:,:) :: LTAB ! Mask
-INTEGER, DIMENSION(:) :: I1,I2,I3 ! Used to replace the COUNT and PACK
-INTEGER :: JI,JJ,JK,IC
-!
-!-------------------------------------------------------------------------------
-!
-IC = 0
-DO JK = 1,SIZE(LTAB,3)
- DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ,JK) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- I3(IC) = JK
- END IF
- END DO
- END DO
-END DO
-!
-END FUNCTION COUNTJV
-
END MODULE MODE_RAIN_ICE_SEDIMENTATION_SPLIT
diff --git a/src/MNH/rain_ice_sedimentation_stat.f90 b/src/MNH/rain_ice_sedimentation_stat.f90
index e8d07221c69c3258d6849abc51262df27bbd12bb..3156ab84cf81a4df23261990ae54482257b8b646 100644
--- a/src/MNH/rain_ice_sedimentation_stat.f90
+++ b/src/MNH/rain_ice_sedimentation_stat.f90
@@ -5,6 +5,7 @@
!-----------------------------------------------------------------
! Modifications:
! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
!-----------------------------------------------------------------
MODULE MODE_RAIN_ICE_SEDIMENTATION_STAT
@@ -32,9 +33,11 @@ use MODD_RAIN_ICE_PARAM, only: XEXSEDG, XEXSEDH, XEXCSEDI, XEXSEDR, XEXSEDS, &
XFSEDC, XFSEDG, XFSEDH, XFSEDI, XFSEDR, XFSEDS
use MODD_RAIN_ICE_DESCR, only: XALPHAC, XALPHAC2, XCC, XCEXVT, XCONC_LAND, XCONC_SEA, XCONC_URBAN, &
XDC, XLBC, XLBEXC, XNUC, XNUC2, XRTMIN
-!
+
+use mode_tools, only: Countjv
+
use MODI_BUDGET
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -184,8 +187,8 @@ PINPRR3D (:,:,:) = 0.
!estimation of q' taking into account incomming ZWSED
ZQP(:,:)=ZWSED(:,:,JK+KKL)*ZW(:,:,JK)
- JCOUNT=COUNTJV2((PRCS(:,:,JK) > ZRTMIN(2) .AND. PRCT(:,:,JK) > ZRTMIN(2)) .OR. &
- (ZQP(:,:) > ZRTMIN(2)),I1(:),I2(:))
+ JCOUNT=COUNTJV((PRCS(:,:,JK) > ZRTMIN(2) .AND. PRCT(:,:,JK) > ZRTMIN(2)) .OR. &
+ (ZQP(:,:) > ZRTMIN(2)),I1(:),I2(:))
DO JL=1, JCOUNT
JI=I1(JL)
JJ=I2(JL)
@@ -256,8 +259,8 @@ PINPRR3D (:,:,:) = 0.
!estimation of q' taking into account incomming ZWSED
ZQP(:,:)=ZWSED(:,:,JK+KKL)*ZW(:,:,JK)
- JCOUNT=COUNTJV2((PRRS(:,:,JK) > ZRTMIN(3)) .OR. &
- (ZQP(:,:) > ZRTMIN(3)),I1(:),I2(:))
+ JCOUNT=COUNTJV((PRRS(:,:,JK) > ZRTMIN(3)) .OR. &
+ (ZQP(:,:) > ZRTMIN(3)),I1(:),I2(:))
DO JL=1, JCOUNT
JI=I1(JL)
JJ=I2(JL)
@@ -313,8 +316,8 @@ PINPRR3D (:,:,:) = 0.
!estimation of q' taking into account incomming ZWSED
ZQP(:,:)=ZWSED(:,:,JK+KKL)*ZW(:,:,JK)
- JCOUNT=COUNTJV2((PRIS(:,:,JK) > MAX(ZRTMIN(4),1.0E-7 )) .OR. &
- (ZQP(:,:) > MAX(ZRTMIN(4),1.0E-7 )),I1(:),I2(:))
+ JCOUNT=COUNTJV((PRIS(:,:,JK) > MAX(ZRTMIN(4),1.0E-7 )) .OR. &
+ (ZQP(:,:) > MAX(ZRTMIN(4),1.0E-7 )),I1(:),I2(:))
DO JL=1, JCOUNT
JI=I1(JL)
JJ=I2(JL)
@@ -375,8 +378,8 @@ PINPRR3D (:,:,:) = 0.
!estimation of q' taking into account incomming ZWSED
ZQP(:,:)=ZWSED(:,:,JK+KKL)*ZW(:,:,JK)
- JCOUNT=COUNTJV2((PRSS(:,:,JK) > ZRTMIN(5)) .OR. &
- (ZQP(:,:) > ZRTMIN(5)),I1(:),I2(:))
+ JCOUNT=COUNTJV((PRSS(:,:,JK) > ZRTMIN(5)) .OR. &
+ (ZQP(:,:) > ZRTMIN(5)),I1(:),I2(:))
DO JL=1, JCOUNT
JI=I1(JL)
JJ=I2(JL)
@@ -435,8 +438,8 @@ PINPRR3D (:,:,:) = 0.
!estimation of q' taking into account incomming ZWSED
ZQP(:,:)=ZWSED(:,:,JK+KKL)*ZW(:,:,JK)
- JCOUNT=COUNTJV2((PRGS(:,:,JK) > ZRTMIN(6)) .OR. &
- (ZQP(:,:) > ZRTMIN(6)),I1(:),I2(:))
+ JCOUNT=COUNTJV((PRGS(:,:,JK) > ZRTMIN(6)) .OR. &
+ (ZQP(:,:) > ZRTMIN(6)),I1(:),I2(:))
DO JL=1, JCOUNT
JI=I1(JL)
JJ=I2(JL)
@@ -493,8 +496,8 @@ PINPRR3D (:,:,:) = 0.
!estimation of q' taking into account incomming ZWSED
ZQP(:,:)=ZWSED(:,:,JK+KKL)*ZW(:,:,JK)
- JCOUNT=COUNTJV2((PRHS(:,:,JK)+ZQP(JI,JJ) > ZRTMIN(7)) .OR. &
- (ZQP(:,:) > ZRTMIN(7)),I1(:),I2(:))
+ JCOUNT=COUNTJV((PRHS(:,:,JK)+ZQP(JI,JJ) > ZRTMIN(7)) .OR. &
+ (ZQP(:,:) > ZRTMIN(7)),I1(:),I2(:))
DO JL=1, JCOUNT
JI=I1(JL)
JJ=I2(JL)
@@ -573,34 +576,4 @@ IF ( LBUDGET_RC .AND. LDEPOSC ) &
!
END SUBROUTINE RAIN_ICE_SEDIMENTATION_STAT
-
-FUNCTION COUNTJV2(LTAB,I1,I2) RESULT(IC)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* 0.2 declaration of local variables
-!
-!
-LOGICAL, DIMENSION(:,:) :: LTAB ! Mask
-INTEGER, DIMENSION(:) :: I1,I2 ! Used to replace the COUNT and PACK
-INTEGER :: JI,JJ,IC
-!
-!-------------------------------------------------------------------------------
-!
-IC = 0
-DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- END IF
- END DO
-END DO
-!
-END FUNCTION COUNTJV2
-
END MODULE MODE_RAIN_ICE_SEDIMENTATION_STAT
diff --git a/src/MNH/rain_ice_warm.f90 b/src/MNH/rain_ice_warm.f90
index e9362b0d20e3293c0643adf7ba4a51da18158f5d..7c958b685f25f8ec7ce8176ed35adfc1fb31e889 100644
--- a/src/MNH/rain_ice_warm.f90
+++ b/src/MNH/rain_ice_warm.f90
@@ -5,6 +5,7 @@
!-----------------------------------------------------------------
! Modifications:
! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
+! P. Wautelet 03/06/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
!-----------------------------------------------------------------
MODULE MODE_RAIN_ICE_WARM
@@ -16,7 +17,8 @@ MODULE MODE_RAIN_ICE_WARM
CONTAINS
-SUBROUTINE RAIN_ICE_WARM(OMICRO, PRHODREF, PRVT, PRCT, PRRT, PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
+SUBROUTINE RAIN_ICE_WARM(OMICRO, KMICRO, K1, K2, K3, &
+ PRHODREF, PRVT, PRCT, PRRT, PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
PRHODJ, PPRES, PZT, PLBDAR, PLBDAR_RF, PLVFACT, PCJ, PKA, PDV, PRF, PCF, PTHT, PTHLT, &
PRHODJ3D, PTHS3D, PRVS3D, PRVS, PRCS, PRRS, PTHS, PUSW, PEVAP3D)
!
@@ -39,6 +41,10 @@ IMPLICIT NONE
!* 0.1 Declarations of dummy arguments :
!
LOGICAL, DIMENSION(:,:,:), intent(in) :: OMICRO ! Test where to compute all processes
+INTEGER, intent(in) :: KMICRO
+INTEGER, DIMENSION(:), intent(in) :: K1
+INTEGER, DIMENSION(:), intent(in) :: K2
+INTEGER, DIMENSION(:), intent(in) :: K3
REAL, DIMENSION(:), intent(in) :: PRHODREF ! RHO Dry REFerence
REAL, DIMENSION(:), intent(in) :: PRVT ! Water vapor m.r. at t
REAL, DIMENSION(:), intent(in) :: PRCT ! Cloud water m.r. at t
@@ -74,6 +80,7 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
!
!* 0.2 declaration of local variables
!
+INTEGER :: JL
REAL, DIMENSION(size(PRHODREF)) :: ZZW ! Work array
REAL, DIMENSION(size(PRHODREF)) :: ZZW2 ! Work array
REAL, DIMENSION(size(PRHODREF)) :: ZZW3 ! Work array
@@ -267,7 +274,10 @@ END IF
IF (LBUDGET_RR) CALL BUDGET ( &
UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), &
8,'REVA_BU_RRR')
- PEVAP3D(:,:,:)=UNPACK(ZZW(:),MASK=OMICRO(:,:,:),FIELD=PEVAP3D(:,:,:))
+
+ DO JL = 1, KMICRO
+ PEVAP3D(K1(JL), K2(JL), K3(JL)) = ZZW( JL )
+ END DO
!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
diff --git a/src/MNH/series_cloud_elec.f90 b/src/MNH/series_cloud_elec.f90
index 48f463e9955a65a5758880341fc0f8cc06977d14..2346925601a90e9535358ee188f9f3928e82a027 100644
--- a/src/MNH/series_cloud_elec.f90
+++ b/src/MNH/series_cloud_elec.f90
@@ -82,33 +82,33 @@ END MODULE MODI_SERIES_CLOUD_ELEC
!! Philippe Wautelet: 10/01/2019: use NEWUNIT argument of OPEN
!! Philippe Wautelet: 22/01/2019: use standard FLUSH statement instead of non standard intrinsics
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
!
!-------------------------------------------------------------------------------
!
-!* 0. DECLARATIONS
-! ------------
+! 0. DECLARATIONS
+! ------------
!
-USE MODD_CONF, ONLY : CEXP
+USE MODD_CONF, ONLY: CEXP
USE MODD_CST
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_REF
-USE MODD_PARAMETERS
+USE MODD_DYN_n, ONLY: XDXHATM, XDYHATM
USE MODD_ELEC_DESCR
USE MODD_ELEC_PARAM
-!
-USE MODD_GRID_n, ONLY : XXHAT, XYHAT, XZHAT
-USE MODD_DYN_n, ONLY : XDXHATM, XDYHATM
-!
+USE MODD_GRID_n, ONLY: XXHAT, XYHAT, XZHAT
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELECEND
+USE MODD_PARAMETERS
USE MODD_RAIN_ICE_DESCR
USE MODD_RAIN_ICE_PARAM
-USE MODD_NSV, ONLY : NSV_ELECBEG, NSV_ELECEND
-!
+USE MODD_REF
+
USE MODI_MOMG
USE MODI_RADAR_RAIN_ICE
-!
-USE MODE_ll
+
USE MODE_ELEC_ll
-!
+USE MODE_ll
+use mode_tools, only: Countjv
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -596,40 +596,6 @@ END IF
CONTAINS
!
!-------------------------------------------------------------------------------
-!
- FUNCTION COUNTJV(LTAB,I1,I2,I3) RESULT(IC)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* 0.2 declaration of local variables
-!
-!
-LOGICAL, DIMENSION(:,:,:) :: LTAB ! Mask
-INTEGER, DIMENSION(:) :: I1,I2,I3 ! Used to replace the COUNT and PACK
-INTEGER :: JI,JJ,JK,IC
-!
-!-------------------------------------------------------------------------------
-!
-IC = 0
-DO JK = 1, SIZE(LTAB,3)
- DO JJ = 1, SIZE(LTAB,2)
- DO JI = 1, SIZE(LTAB,1)
- IF( LTAB(JI,JJ,JK) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- I3(IC) = JK
- END IF
- END DO
- END DO
-END DO
-!
-END FUNCTION COUNTJV
-!
-!-------------------------------------------------------------------------------
! ##############################################
FUNCTION MOMG0D(PALPHA, PNU, PP) RESULT(PMOMG)
! ##############################################
diff --git a/src/MNH/shallow_convection.f90 b/src/MNH/shallow_convection.f90
index e9ea4751ebb67d364c00232f1303aa345b8ab2a6..548e8bda5982cc59c3920f2241d94443a820de74 100644
--- a/src/MNH/shallow_convection.f90
+++ b/src/MNH/shallow_convection.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-2019 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$
-! MASDEV4_7 conv 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ######################
MODULE MODI_SHALLOW_CONVECTION
! ######################
@@ -158,7 +153,7 @@ END MODULE MODI_SHALLOW_CONVECTION
!! " 01/01/02 Apply conservation correction
!! F Bouyssel 05/11/08 Modifications for reproductibility
!! E. Bazile 20/07/09 Input of TKECLS.
-!! Juan 24/09/2012: for BUG Pgi rewrite PACK function on mode_pack_pgi
+! P. Wautelet 03/06/2019: simplify code (remove always true masks) + replace PACK intrinsics
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -174,10 +169,6 @@ USE MODI_CONVECT_UPDRAFT_SHAL
USE MODI_CONVECT_CLOSURE_SHAL
USE MODI_CONVECT_CHEM_TRANSPORT
!
-#ifdef MNH_PGI
-USE MODE_PACK_PGI
-#endif
-!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -229,7 +220,7 @@ REAL, DIMENSION(KLON,KLEV,KCH1), INTENT(INOUT):: PCH1TEN! species conv. tendency
!
!* 0.2 Declarations of local fixed memory variables :
!
-INTEGER :: ITEST, ICONV ! number of convective columns
+INTEGER :: ICONV ! number of convective columns
INTEGER :: IIB, IIE ! horizontal loop bounds
INTEGER :: IKB, IKE ! vertical loop bounds
INTEGER :: IKS ! vertical dimension
@@ -240,8 +231,6 @@ INTEGER :: IFTSTEPS ! only used for chemical tracers
REAL :: ZEPS, ZEPSA ! R_d / R_v, R_v / R_d
REAL :: ZRDOCP ! R_d/C_p
!
-LOGICAL, DIMENSION(KLON, KLEV) :: GTRIG3 ! 3D logical mask for convection
-LOGICAL, DIMENSION(KLON) :: GTRIG ! 2D logical mask for trigger test
REAL, DIMENSION(KLON,KLEV) :: ZTHT, ZSTHV, ZSTHES ! grid scale theta, theta_v
REAL, DIMENSION(KLON) :: ZWORK2, ZWORK2B ! work array
REAL :: ZW1 ! work variable
@@ -317,9 +306,8 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZRCC ! conv. adj. grid scale r_c
REAL, DIMENSION(:,:), ALLOCATABLE :: ZRIC ! conv. adj. grid scale r_i
REAL, DIMENSION(:,:), ALLOCATABLE :: ZWSUB ! envir. compensating subsidence (Pa/s)
!
-LOGICAL, DIMENSION(:),ALLOCATABLE :: GTRIG1 ! logical mask for convection
-LOGICAL, DIMENSION(:),ALLOCATABLE :: GWORK ! logical work array
-INTEGER, DIMENSION(:),ALLOCATABLE :: IINDEX, IJINDEX, IJSINDEX, IJPINDEX!hor.index
+LOGICAL, DIMENSION(:),ALLOCATABLE :: GTRIG1 ! logical mask for convection
+INTEGER, DIMENSION(:),ALLOCATABLE :: IJINDEX ! hor.index
REAL, DIMENSION(:), ALLOCATABLE :: ZCPH ! specific heat C_ph
REAL, DIMENSION(:), ALLOCATABLE :: ZLV, ZLS! latent heat of vaporis., sublim.
REAL :: ZES ! saturation vapor mixng ratio
@@ -328,7 +316,6 @@ REAL :: ZES ! saturation vapor mixng ratio
REAL, DIMENSION(:,:,:), ALLOCATABLE:: ZCH1 ! grid scale chemical specy (kg/kg)
REAL, DIMENSION(:,:,:), ALLOCATABLE:: ZCH1C ! conv. adjust. chemical specy 1
REAL, DIMENSION(:,:), ALLOCATABLE:: ZWORK3 ! conv. adjust. chemical specy 1
-LOGICAL, DIMENSION(:,:,:),ALLOCATABLE::GTRIG4 ! logical mask
!
!-------------------------------------------------------------------------------
!
@@ -343,44 +330,23 @@ IKB = 1 + JCVEXB
IKS = KLEV
JCVEXT = MAX( 0, KTDIA - 1)
IKE = IKS - JCVEXT
-!
-!
-!* 0.5 Update convective counter ( where KCOUNT > 0
-! convection is still active ).
-! ---------------------------------------------
-!
-GTRIG(:) = .FALSE.
-GTRIG(IIB:IIE) = .TRUE.
-ITEST = COUNT( GTRIG(:) )
-IF ( ITEST == 0 ) THEN
- RETURN
-ENDIF
-
!
!
!* 0.7 Reset convective tendencies to zero if convective
! counter becomes negative
! -------------------------------------------------
!
-GTRIG3(:,:) = SPREAD( GTRIG(:), DIM=2, NCOPIES=IKS )
-WHERE ( GTRIG3(:,:) )
- PTTEN(:,:) = 0.
- PRVTEN(:,:) = 0.
- PRCTEN(:,:) = 0.
- PRITEN(:,:) = 0.
+PTTEN(:,:) = 0.
+PRVTEN(:,:) = 0.
+PRCTEN(:,:) = 0.
+PRITEN(:,:) = 0.
! PUTEN(:,:) = 0.
! PVTEN(:,:) = 0.
- PUMF(:,:) = 0.
-END WHERE
-WHERE ( GTRIG(:) )
- KCLTOP(:) = 0
- KCLBAS(:) = 0
-END WHERE
+PUMF(:,:) = 0.
+KCLTOP(:) = 0
+KCLBAS(:) = 0
IF ( OCH1CONV ) THEN
- ALLOCATE( GTRIG4(KLON,KLEV,KCH1) )
- GTRIG4(:,:,:) = SPREAD( GTRIG3(:,:), DIM=3, NCOPIES=KCH1 )
- WHERE( GTRIG4(:,:,:) ) PCH1TEN(:,:,:) = 0.
- DEALLOCATE( GTRIG4 )
+ PCH1TEN(:,:,:) = 0.
END IF
!
!
@@ -429,47 +395,38 @@ END DO
! at the moment.
! --------------------------------------------------------------
!
-ALLOCATE( ZPRES(ITEST,IKS) )
-ALLOCATE( ZZ(ITEST,IKS) )
-ALLOCATE( ZW(ITEST,IKS) )
-ALLOCATE( ZTH(ITEST,IKS) )
-ALLOCATE( ZTHV(ITEST,IKS) )
-ALLOCATE( ZTHEST(ITEST,IKS) )
-ALLOCATE( ZRV(ITEST,IKS) )
-ALLOCATE( ZSTHLCL(ITEST) )
-ALLOCATE( ZSTLCL(ITEST) )
-ALLOCATE( ZSRVLCL(ITEST) )
-ALLOCATE( ZSWLCL(ITEST) )
-ALLOCATE( ZSZLCL(ITEST) )
-ALLOCATE( ZSTHVELCL(ITEST) )
-ALLOCATE( ISDPL(ITEST) )
-ALLOCATE( ISPBL(ITEST) )
-ALLOCATE( ISLCL(ITEST) )
-ALLOCATE( ZSDXDY(ITEST) )
-ALLOCATE( GTRIG1(ITEST) )
-ALLOCATE( IINDEX(KLON) )
-ALLOCATE( IJSINDEX(ITEST) )
-DO JI = 1, KLON
- IINDEX(JI) = JI
-END DO
-IJSINDEX(:) = PACK( IINDEX(:), MASK=GTRIG(:) )
+ALLOCATE( ZPRES(KLON,IKS) )
+ALLOCATE( ZZ(KLON,IKS) )
+ALLOCATE( ZW(KLON,IKS) )
+ALLOCATE( ZTH(KLON,IKS) )
+ALLOCATE( ZTHV(KLON,IKS) )
+ALLOCATE( ZTHEST(KLON,IKS) )
+ALLOCATE( ZRV(KLON,IKS) )
+ALLOCATE( ZSTHLCL(KLON) )
+ALLOCATE( ZSTLCL(KLON) )
+ALLOCATE( ZSRVLCL(KLON) )
+ALLOCATE( ZSWLCL(KLON) )
+ALLOCATE( ZSZLCL(KLON) )
+ALLOCATE( ZSTHVELCL(KLON) )
+ALLOCATE( ISDPL(KLON) )
+ALLOCATE( ISPBL(KLON) )
+ALLOCATE( ISLCL(KLON) )
+ALLOCATE( ZSDXDY(KLON) )
+ALLOCATE( GTRIG1(KLON) )
!
DO JK = IKB, IKE
-DO JI = 1, ITEST
- JL = IJSINDEX(JI)
- ZPRES(JI,JK) = PPABST(JL,JK)
- ZZ(JI,JK) = PZZ(JL,JK)
- ZTH(JI,JK) = ZTHT(JL,JK)
- ZTHV(JI,JK) = ZSTHV(JL,JK)
- ZTHEST(JI,JK) = ZSTHES(JL,JK)
- ZRV(JI,JK) = MAX( 0., PRVT(JL,JK) )
- ZW(JI,JK) = PWT(JL,JK)
-END DO
+DO JI = 1, KLON
+ JL = JI
+ ZPRES(JI,JK) = PPABST(JI,JK)
+ ZZ(JI,JK) = PZZ(JI,JK)
+ ZTH(JI,JK) = ZTHT(JI,JK)
+ ZTHV(JI,JK) = ZSTHV(JI,JK)
+ ZTHEST(JI,JK) = ZSTHES(JI,JK)
+ ZRV(JI,JK) = MAX( 0., PRVT(JI,JK) )
+ ZW(JI,JK) = PWT(JI,JK)
END DO
-DO JI = 1, ITEST
- JL = IJSINDEX(JI)
- ZSDXDY(JI) = XA25
END DO
+ZSDXDY(:) = XA25
!
!* 2.2 Compute environm. enthalpy and total water = r_v + r_i + r_c
! and envir. saturation theta_e
@@ -483,7 +440,7 @@ ISLCL(:) = MAX( IKB, 2 ) ! initialize DPL PBL and LCL
ISDPL(:) = IKB
ISPBL(:) = IKB
!
-CALL CONVECT_TRIGGER_SHAL( ITEST, KLEV, &
+CALL CONVECT_TRIGGER_SHAL( KLON, KLEV, &
ZPRES, ZTH, ZTHV, ZTHEST, &
ZRV, ZW, ZZ, ZSDXDY, PTKECLS, &
ZSTHLCL, ZSTLCL, ZSRVLCL, ZSWLCL, ZSZLCL, &
@@ -518,8 +475,6 @@ IF ( ICONV == 0 ) THEN
DEALLOCATE( ISDPL )
DEALLOCATE( ISPBL )
DEALLOCATE( GTRIG1 )
- DEALLOCATE( IINDEX )
- DEALLOCATE( IJSINDEX )
RETURN ! no convective column has been found, exit DEEP_CONVECTION
ENDIF
!
@@ -569,7 +524,6 @@ ALLOCATE( ZCAPE(ICONV) )
! work variables
!
ALLOCATE( IJINDEX(ICONV) )
-ALLOCATE( IJPINDEX(ICONV) )
ALLOCATE( ZCPH(ICONV) )
ALLOCATE( ZLV(ICONV) )
ALLOCATE( ZLS(ICONV) )
@@ -579,8 +533,13 @@ ALLOCATE( ZLS(ICONV) )
! arrays using mask GTRIG
! ---------------------------------------------------
!
-GTRIG(:) = UNPACK( GTRIG1(:), MASK=GTRIG, FIELD=.FALSE. )
-IJINDEX(:) = PACK( IINDEX(:), MASK=GTRIG(:) )
+JL = 1
+DO JI = 1, KLON
+ IF ( GTRIG1(JI) ) THEN
+ IJINDEX(JL) = JI
+ JL = JL +1
+ END IF
+END DO
!
DO JK = IKB, IKE
DO JI = 1, ICONV
@@ -597,12 +556,8 @@ DO JI = 1, ICONV
END DO
END DO
!
-DO JI = 1, ITEST
- IJSINDEX(JI) = JI
-END DO
-IJPINDEX(:) = PACK( IJSINDEX(:), MASK=GTRIG1(:) )
DO JI = 1, ICONV
- JL = IJPINDEX(JI)
+ JL = IJINDEX(JI)
IDPL(JI) = ISDPL(JL)
IPBL(JI) = ISPBL(JL)
ILCL(JI) = ISLCL(JL)
@@ -614,14 +569,11 @@ DO JI = 1, ICONV
ZTHVELCL(JI) = ZSTHVELCL(JL)
ZDXDY(JI) = ZSDXDY(JL)
END DO
-ALLOCATE( GWORK(ICONV) )
-GWORK(:) = PACK( GTRIG1(:), MASK=GTRIG1(:) )
+
DEALLOCATE( GTRIG1 )
ALLOCATE( GTRIG1(ICONV) )
-GTRIG1(:) = GWORK(:)
-!
-DEALLOCATE( GWORK )
-DEALLOCATE( IJPINDEX )
+GTRIG1(:) = .true.
+
DEALLOCATE( ISDPL )
DEALLOCATE( ISPBL )
DEALLOCATE( ISLCL )
@@ -1014,9 +966,7 @@ DEALLOCATE( ZCAPE )
!
! work arrays
!
-DEALLOCATE( IINDEX )
DEALLOCATE( IJINDEX )
-DEALLOCATE( IJSINDEX )
DEALLOCATE( GTRIG1 )
!
!
diff --git a/src/MNH/subl_blowsnow.f90 b/src/MNH/subl_blowsnow.f90
index 015169c2628eb3ccb6d07a37e9ace991e0d18080..a0f99e6ceef189543a7e357c43d4326d1b8d8a33 100644
--- a/src/MNH/subl_blowsnow.f90
+++ b/src/MNH/subl_blowsnow.f90
@@ -1,7 +1,12 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2018-2019 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.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 28/05/2018: corrected truncated integer division (1*10**(-6) -> 1E-6)
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!-----------------------------------------------------------------
! ####################
MODULE MODI_SUBL_BLOWSNOW
! ####################
@@ -43,21 +48,19 @@ END MODULE MODI_SUBL_BLOWSNOW
SUBROUTINE SUBL_BLOWSNOW(PZZ, PRHODJ , PRHODREF, PEXNREF , PPABST, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PSVT, &
PTHS, PRVS, PSVS,PSNWSUBL3D,PVGK)
-!! MODIFICATIONS
-!! -------------
-!! Philippe Wautelet 28/05/2018: corrected truncated integer division (1*10**(-6) -> 1E-6)
-USE MODD_PARAMETERS
+USE MODD_BLOWSNOW
USE MODD_CST
USE MODD_CSTS_BLOWSNOW
-USE MODD_BLOWSNOW
+USE MODD_PARAMETERS
+
+USE MODE_BLOWSNOW_PSD
+use mode_tools, only: Countjv
USE MODI_GAMMA
USE MODI_GAMMA_INC
USE MODI_GAMMA_INC_LOW
-USE MODE_BLOWSNOW_PSD
-
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -728,44 +731,6 @@ END FUNCTION NUSSELT
!
!-------------------------------------------------------------------------------
!
-
-!
-!-------------------------------------------------------------------------------
-!
-
- FUNCTION COUNTJV(LTAB,I1,I2,I3) RESULT(IC)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* 0.2 declaration of local variables
-!
-!
-LOGICAL, DIMENSION(:,:,:) :: LTAB ! Mask
-INTEGER, DIMENSION(:) :: I1,I2,I3 ! Used to replace the COUNT and PACK
-INTEGER :: JI,JJ,JK,IC
-!
-!-------------------------------------------------------------------------------
-!
-IC = 0
-DO JK = 1,SIZE(LTAB,3)
- DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ,JK) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- I3(IC) = JK
- END IF
- END DO
- END DO
-END DO
-!
-END FUNCTION COUNTJV
-!
-!-------------------------------------------------------------------------------
END SUBROUTINE SUBL_BLOWSNOW
diff --git a/src/MNH/tools.f90 b/src/MNH/tools.f90
index 68a195fac3c0874493ec93b5f4ced23a6c58ab93..f75b6518e35bc67a9d46e35741692da0dbb3a20e 100644
--- a/src/MNH/tools.f90
+++ b/src/MNH/tools.f90
@@ -17,16 +17,121 @@ module mode_tools
! ------
! P. Wautelet 14/02/2019
!
+! Modifications:
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 05/06/2019: add Countjv_device
implicit none
private
-public :: upcase
+public :: Countjv
+public :: Upcase
+
+interface Countjv
+ module procedure Countjv2d, Countjv3d
+end interface
+
+#ifdef _OPENACC
+public :: Countjv_device
+
+interface Countjv_device
+ module procedure Countjv3d_device
+end interface
+#endif
contains
-function upcase(hstring)
+function Countjv2d(ltab,i1,i2) result(ic)
+ logical, dimension(:,:), intent(in) :: ltab ! Mask
+ integer, dimension(:), intent(out) :: i1, i2 ! Positions of elements with 'true' value
+ integer :: ic ! Total number of 'true' values
+
+ integer :: ji, jj
+
+ ic = 0
+
+ do jj = 1, size( ltab, 2 )
+ do ji = 1, size( ltab, 1 )
+ if ( ltab(ji, jj ) ) then
+ ic = ic +1
+ i1(ic) = ji
+ i2(ic) = jj
+ end if
+ end do
+ end do
+end function Countjv2d
+
+
+function Countjv3d(ltab,i1,i2,i3) result(ic)
+ logical, dimension(:,:,:), intent(in) :: ltab ! Mask
+ integer, dimension(:), intent(out) :: i1, i2, i3 ! Positions of elements with 'true' value
+ integer :: ic ! Total number of 'true' values
+
+ integer :: ji, jj, jk
+
+ ic = 0
+
+ do jk = 1, size( ltab, 3 )
+ do jj = 1, size( ltab, 2 )
+ do ji = 1, size( ltab, 1 )
+ if ( ltab(ji, jj, jk ) ) then
+ ic = ic +1
+ i1(ic) = ji
+ i2(ic) = jj
+ i3(ic) = jk
+ end if
+ end do
+ end do
+ end do
+end function Countjv3d
+
+#ifdef _OPENACC
+subroutine Countjv3d_device(ltab, i1, i2, i3, ic)
+ logical, dimension(:,:,:), intent(in) :: ltab ! Mask
+ integer, dimension(:), intent(out) :: i1, i2, i3 ! Positions of elements with 'true' value
+ integer, intent(out) :: ic ! Total number of 'true' values
+!$acc declare present(ltab, i1, i2, i3)
+
+ integer :: idx
+ integer :: ji, jj, jk
+
+!$acc kernels present(ltab, i1, i2, i3)
+
+!To allow comparisons... (i1/i2/i3 are not fully used)
+!Can be removed in production
+! i1(:) = -999
+! i2(:) = -999
+! i3(:) = -999
+
+ ic = 0
+
+!Warning: if "independent" is set, content of i1, i2 and i3 can vary between 2
+! different runs of this subroutine BUT final result should be the same
+!Comment the following line + atomic directives to have consistent values for debugging
+!Warning: huge impact on performance
+!$acc loop collapse(3) private(idx) independent
+ do jk = 1, size( ltab, 3 )
+ do jj = 1, size( ltab, 2 )
+ do ji = 1, size( ltab, 1 )
+ if ( ltab(ji, jj, jk ) ) then
+!$acc atomic capture
+ ic = ic +1
+ idx = ic
+!$acc end atomic
+ i1(idx) = ji
+ i2(idx) = jj
+ i3(idx) = jk
+ end if
+ end do
+ end do
+ end do
+!$acc end kernels
+
+end subroutine Countjv3d_device
+#endif
+
+function Upcase(hstring)
character(len=*), intent(in) :: hstring
character(len=len(hstring)) :: upcase
@@ -41,6 +146,6 @@ function upcase(hstring)
upcase(jc:jc) = hstring(jc:jc)
end if
end do
-end function upcase
+end function Upcase
end module mode_tools