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_nucleation_wrapper.f90 b/src/MNH/ice4_nucleation_wrapper.f90 index 662f7d67067af16f61606bdcad524f85bf7c5602..5a4c97f805b5745db402f2921117604c105c2590 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 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/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/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 9d11bd3ee900c037915978e883f7732a8fc8e407..b449c0a0c54b608cbced812ebc7ee87259eb3dde 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 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_nucleation.f90 b/src/MNH/rain_ice_nucleation.f90 index 4fd4b262504c3b33897ad10e7b435f1a1f02fce0..08b7a107e6ded4773c2628e5106937076909f007 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 eb85e8a2f1a4860e1c4adff09e0caea95cc3528a..50b6ef1ff5a03e395d4f1070536d22f823281945 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 9269417f6892d8681ac28cc58f4e172bf11a8ef9..3007adf386b93b66948b6452297b6ce4a1d29934 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 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/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/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..31d92b89a19a3634bb034ed22cb4a1b94bf08885 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