From 963f906b11bddb8d1391a8fcc337bfe144671bc9 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Tue, 28 May 2019 15:57:40 +0200
Subject: [PATCH] Philippe 28/05/2019: move COUNTJV function to tools.f90
---
src/MNH/aer_wet_dep_kmt_warm.f90 | 43 +-----------
src/MNH/ch_aqueous_check.f90 | 51 +++-----------
src/MNH/ch_aqueous_sedim1mom.f90 | 40 +----------
src/MNH/ch_aqueous_sedim2mom.f90 | 41 +----------
src/MNH/ch_aqueous_sedimc2r2.f90JPP | 43 ++----------
src/MNH/ch_aqueous_tmicc2r2.f90 | 48 +++----------
src/MNH/ch_aqueous_tmicice.f90 | 41 +----------
src/MNH/ch_aqueous_tmickess.f90 | 49 +++----------
src/MNH/ch_aqueous_tmickhko.f90 | 48 +++----------
src/MNH/ice4_nucleation_wrapper.f90 | 35 +++-------
src/MNH/ice4_sedimentation_split_momentum.f90 | 58 ++++-----------
src/MNH/ice4_sedimentation_split_old.f90 | 58 ++++-----------
src/MNH/ice4_sedimentation_stat.f90 | 51 ++++----------
src/MNH/khko_notadjust.f90 | 35 +---------
src/MNH/lima.f90 | 38 +++++-----
src/MNH/lima_adjust.f90 | 4 +-
src/MNH/lima_ccn_activation.f90 | 17 ++---
src/MNH/lima_ccn_hom_freezing.f90 | 38 +++++-----
src/MNH/lima_cold_hom_nucl.f90 | 38 +++++-----
src/MNH/lima_cold_sedimentation.f90 | 15 ++--
src/MNH/lima_cold_slow_processes.f90 | 40 ++++++-----
src/MNH/lima_functions.f90 | 35 +---------
src/MNH/lima_meyers.f90 | 20 +++---
src/MNH/lima_meyers_nucleation.f90 | 19 ++---
src/MNH/lima_mixed.f90 | 34 +++++----
src/MNH/lima_phillips.f90 | 28 ++++----
src/MNH/lima_phillips_ifn_nucleation.f90 | 29 ++++----
src/MNH/lima_precip_scavenging.f90 | 34 ++++-----
src/MNH/lima_sedimentation.f90 | 19 ++---
src/MNH/lima_warm_coal.f90 | 21 +++---
src/MNH/lima_warm_evap.f90 | 11 +--
src/MNH/lima_warm_nucl.f90 | 19 ++---
src/MNH/lima_warm_sedimentation.f90 | 17 +++--
src/MNH/rain_c2r2_khko.f90 | 59 ++++------------
src/MNH/rain_ice.f90 | 58 +++------------
src/MNH/rain_ice_elec.f90 | 70 +++++--------------
src/MNH/rain_ice_nucleation.f90 | 47 +++----------
src/MNH/rain_ice_red.f90 | 58 ++++-----------
src/MNH/rain_ice_sedimentation_split.f90 | 39 ++---------
src/MNH/rain_ice_sedimentation_stat.f90 | 61 +++++-----------
src/MNH/series_cloud_elec.f90 | 64 ++++-------------
src/MNH/subl_blowsnow.f90 | 59 ++++------------
src/MNH/tools.f90 | 59 +++++++++++++++-
43 files changed, 497 insertions(+), 1194 deletions(-)
diff --git a/src/MNH/aer_wet_dep_kmt_warm.f90 b/src/MNH/aer_wet_dep_kmt_warm.f90
index 450f34b47..8d80ec2e9 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 9a59b9385..d99d0caa9 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 86e477296..bddef28fa 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 926a552b3..55b2d3090 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 b34aae9d1..2627365be 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 b034de2e0..463ce4238 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 213f6cdf5..c0fc81221 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 a428772a7..ff4a0bf33 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 c93eb3a9d..7369be14e 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_nucleation_wrapper.f90 b/src/MNH/ice4_nucleation_wrapper.f90
index 662f7d670..5a4c97f80 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,14 +39,17 @@ SUBROUTINE ICE4_NUCLEATION_WRAPPER(KIT, KJT, KKT, LDMASK, &
!!
!! MODIFICATIONS
!! -------------
-!!
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+!
!
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY : XTT
-!
+USE MODD_CST, ONLY: XTT
+
+use mode_tools, only: Countjv
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -111,7 +115,7 @@ ZB_TH(:) = 0.
ZB_RV(:) = 0.
ZB_RI(:) = 0.
!
-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(:))
!
PRVHENI_MR(:,:,:)=0.
IF(INEGT>0) THEN
@@ -139,27 +143,4 @@ DEALLOCATE(GLDCOMPUTE)
DEALLOCATE(I1,I2,I3)
DEALLOCATE(ZZT,ZPRES,ZRVT,ZCIT,ZTHT,ZRHODREF,ZEXN,ZLSFACT,ZRVHENI_MR,ZB_TH,ZB_RV,ZB_RI)
!
-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
- !
END SUBROUTINE ICE4_NUCLEATION_WRAPPER
diff --git a/src/MNH/ice4_sedimentation_split_momentum.f90 b/src/MNH/ice4_sedimentation_split_momentum.f90
index 866948ea3..927eb8ba5 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 777b82a30..47095b89e 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 4bb2957cc..4194c3677 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/khko_notadjust.f90 b/src/MNH/khko_notadjust.f90
index 58d8e8a59..adf6eee1c 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 7da0841e1..851660cf9 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 5cad38d69..752c861b9 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 97b12f95c..211fbd35f 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 1e5f382eb..26948c4f4 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 4007c1355..f6c3f4211 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 d4e99f68c..6a62652b7 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 0aeb16cfc..1973c65f3 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 a40d500c0..b5a8f17d7 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 5d5607815..775a104ec 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 8f2018952..0aa09ccba 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 63a64e3c4..7525be5b3 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 e91caa983..03af388b7 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 053422c95..a6cd6aa80 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 cbbf3f3dd..351ee92f0 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 a4e824713..88a0a544b 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 4623cd61e..aaae2a04b 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 aa8b7a984..9a67a4b82 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 6887edea9..3cd2f7052 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 4aa56b4b4..f74899b38 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/rain_c2r2_khko.f90 b/src/MNH/rain_c2r2_khko.f90
index 75a99204c..070607530 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 9d11bd3ee..b449c0a0c 100644
--- a/src/MNH/rain_ice.f90
+++ b/src/MNH/rain_ice.f90
@@ -242,21 +242,25 @@ 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
!
!* 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_MSG
+#ifdef MNH_PGI
+USE MODE_PACK_PGI
+#endif
use MODE_RAIN_ICE_FAST_RG, only: RAIN_ICE_FAST_RG
use MODE_RAIN_ICE_FAST_RH, only: RAIN_ICE_FAST_RH
use MODE_RAIN_ICE_FAST_RI, only: RAIN_ICE_FAST_RI
@@ -266,14 +270,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
-!
-#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 :
@@ -1055,45 +1056,6 @@ END IF
!sedimentation of rain fraction
CALL ICE4_RAINFR_VERT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, PRRS(:,:,:)*PTSTEP)
!
-!
-!-------------------------------------------------------------------------------
-!
-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 RAIN_ICE
diff --git a/src/MNH/rain_ice_elec.f90 b/src/MNH/rain_ice_elec.f90
index 94b30788f..37e0c3d04 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_nucleation.f90 b/src/MNH/rain_ice_nucleation.f90
index 4fd4b2625..08b7a107e 100644
--- a/src/MNH/rain_ice_nucleation.f90
+++ b/src/MNH/rain_ice_nucleation.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_NUCLEATION
@@ -23,13 +24,15 @@ 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_tools, only: Countjv
+
use MODI_BUDGET
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -163,36 +166,4 @@ IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HENU_BU_RRI')
!
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 eb85e8a2f..50b6ef1ff 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
! ########################
@@ -240,6 +241,7 @@ 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
!
!* 0. DECLARATIONS
! ------------
@@ -251,21 +253,21 @@ 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_MSG
+#ifdef MNH_PGI
+USE MODE_PACK_PGI
+#endif
+use mode_tools, only: Countjv
+
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_MSG
-!
-#ifdef MNH_PGI
-USE MODE_PACK_PGI
-#endif
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -607,8 +609,8 @@ ENDIF
! optimization by looking for locations where
! the microphysical fields are larger than a minimal value only !!!
!
-IMICRO=0
-IF(COUNT(ODMICRO)/=0) IMICRO=RAIN_ICE_COUNTJV(ODMICRO(:,:,:), IIT, IJT, IKT, SIZE(I1), I1(:), I2(:), I3(:))
+! IMICRO=0
+IMICRO=COUNTJV(ODMICRO(:,:,:), I1(:), I2(:), I3(:))
!Packing
IF(IMICRO>0) THEN
DO JL=1, IMICRO
@@ -1536,40 +1538,6 @@ ENDIF
!
!
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
- !
!
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 9269417f6..3007adf38 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,9 +33,11 @@ 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_tools, only: Countjv
+
use MODI_BUDGET
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -609,36 +612,4 @@ IF ( LBUDGET_RC .AND. ODEPOSC ) &
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 e8d07221c..3156ab84c 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/series_cloud_elec.f90 b/src/MNH/series_cloud_elec.f90
index 48f463e99..234692560 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/subl_blowsnow.f90 b/src/MNH/subl_blowsnow.f90
index 015169c26..a0f99e6ce 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 68a195fac..31d92b89a 100644
--- a/src/MNH/tools.f90
+++ b/src/MNH/tools.f90
@@ -17,16 +17,69 @@ module mode_tools
! ------
! P. Wautelet 14/02/2019
!
+! Modifications:
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
implicit none
private
-public :: upcase
+public :: Countjv
+public :: Upcase
+
+interface Countjv
+ module procedure Countjv2d, Countjv3d
+end interface
+
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
+
+
+function Upcase(hstring)
character(len=*), intent(in) :: hstring
character(len=len(hstring)) :: upcase
@@ -41,6 +94,6 @@ function upcase(hstring)
upcase(jc:jc) = hstring(jc:jc)
end if
end do
-end function upcase
+end function Upcase
end module mode_tools
--
GitLab