Sébastien 30/11/2021 AROME->COMMON *gamma*

src/arome/gmkpack_ignored_files

@@ -50,3 +50,11 @@ phyex/micro/ice4_sedimentation_stat.F90
 phyex/micro/modi_ice4_sedimentation_split.F90
 phyex/micro/ice4_sedimentation_split.F90
 phyex/micro/modi_ice4_sedimentation_stat.F90
+phyex/micro/modd_blank.F90
+phyex/micro/gamma.F90
+phyex/micro/gamma_inc.F90
+phyex/micro/general_gamma.F90
+phyex/micro/modi_gamma.F90
+phyex/micro/modi_gamma_inc.F90
+phyex/micro/modi_general_gamma.F90
+phyex/micro/moddb_intbudget.F90

src/arome/micro/modd_blank.F90

-!     ######spl
-      MODULE MODD_BLANK
-!     #################
-!
-!!****  *MODD_BLANK* -  Declarative module for MesoNH developpers namelist
-!!
-!!    PURPOSE
-!!    -------
-!!
-!!      Offer dummy real, integer, logical and character variables for
-!!    test and debugging purposes.
-!!
-!!**  METHOD
-!!    ------
-!!
-!!      Eight dummy real, integer, logical and character*80 variables are
-!!    defined and passed through the namelist read operations. None of the
-!!    MesoNH routines uses any of those variables. When a developper choses
-!!    to introduce temporarily a parameter to some subroutine, he has to
-!!    introduce a USE MODD_BLANK statement into that subroutine. Then he
-!!    can use any of the variables defined here and change them easily via
-!!    the namelist input.
-!!
-!!    REFERENCE
-!!    ---------
-!!      None
-!!
-!!    AUTHOR
-!!    ------
-!!      K. Suhre   *Laboratoire d'Aerologie*
-!!
-!!    MODIFICATIONS
-!!    -------------
-!!
-!!    Original 25/04/96
-!!      updated     17/11/00  (P Jabouille) Use dummy array
-!!
-!-------------------------------------------------------------------------------
-!
-!*       0.   DECLARATIONS
-!             ------------
-!
-USE MODD_PARAMETERS, ONLY : JPDUMMY
-!
-IMPLICIT NONE
-!
-REAL, SAVE         :: XDUMMY1, XDUMMY2, XDUMMY3, XDUMMY4, &
-                      XDUMMY5, XDUMMY6, XDUMMY7, XDUMMY8
-INTEGER, SAVE      :: NDUMMY1, NDUMMY2, NDUMMY3, NDUMMY4, &
-                      NDUMMY5, NDUMMY6, NDUMMY7, NDUMMY8
-LOGICAL, SAVE      :: LDUMMY1, LDUMMY2, LDUMMY3, LDUMMY4, &
-                      LDUMMY5, LDUMMY6, LDUMMY7, LDUMMY8
-CHARACTER*80, SAVE :: CDUMMY1, CDUMMY2, CDUMMY3, CDUMMY4, &
-                      CDUMMY5, CDUMMY6, CDUMMY7, CDUMMY8
-!
-REAL,    SAVE, DIMENSION(JPDUMMY) :: XDUMMY
-INTEGER, SAVE, DIMENSION(JPDUMMY) :: NDUMMY
-LOGICAL, SAVE, DIMENSION(JPDUMMY) :: LDUMMY
-CHARACTER*80, SAVE, DIMENSION(JPDUMMY) :: CDUMMY
-!
-END MODULE MODD_BLANK

src/arome/turb/turb_ver.F90

@@ -211,7 +211,6 @@ USE MODD_CTURB
 USE MODD_PARAMETERS
 USE MODD_LES
 USE MODD_NSV, ONLY : NSV
-USE MODD_BLANK
 !
 USE MODI_PRANDTL
 USE MODI_EMOIST

src/arome/micro/gamma.F90 → src/common/aux/gamma.F90

-!     ######spl
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
+!MNH_LIC for details. version 1.
+!########################
+!
+!--------------------------------------------------------------------------
+!
+!
+!*       1.   FUNCTION GAMMA FOR SCALAR VARIABLE
+! 
+!
+!     ######################################
       FUNCTION GAMMA_X0D(PX)  RESULT(PGAMMA)
       USE PARKIND1, ONLY : JPRB
       USE YOMHOOK , ONLY : LHOOK, DR_HOOK
@@ -35,11 +47,9 @@
 !!
 !!    MODIFICATIONS
 !!    -------------
-!!      Original     7/12/95
+!!      Original     7/11/95
 !!      C. Barthe    9/11/09  add a function for 1D arguments
-!!
-!!-------------------------------------------------------------------------------
-
+!
 !*       0. DECLARATIONS
 !           ------------
 !
@@ -105,7 +115,11 @@ END FUNCTION GAMMA_X0D
 !
 !-------------------------------------------------------------------------------
 !
-!     ######spl
+!
+!*       1.   FUNCTION GAMMA FOR 1D ARRAY
+! 
+!
+!     ######################################
       FUNCTION GAMMA_X1D(PX)  RESULT(PGAMMA)
       USE PARKIND1, ONLY : JPRB
       USE YOMHOOK , ONLY : LHOOK, DR_HOOK
@@ -153,14 +167,14 @@ IMPLICIT NONE
 !
 !*       0.1 declarations of arguments and result
 !
-REAL,DIMENSION(:), INTENT(IN)           :: PX
-REAL,DIMENSION(SIZE(PX))                :: PGAMMA
+REAL, DIMENSION(:), INTENT(IN)       :: PX
+REAL, DIMENSION(SIZE(PX))            :: PGAMMA
 !
 !*       0.2 declarations of local variables
 !
 INTEGER                              :: JJ ! Loop index
 INTEGER                              :: JI ! Loop index
-REAL                                 :: ZSER,ZSTP,ZTMP,ZX,ZY,ZCOEF(6)
+REAL                                 :: ZSER, ZSTP, ZTMP, ZX, ZY, ZCOEF(6)
 REAL                                 :: ZPI
 !
 REAL(KIND=JPRB) :: ZHOOK_HANDLE

src/arome/micro/gamma_inc.F90 → src/common/aux/gamma_inc.F90

-!     ######spl
+!MNH_LIC Copyright 1995-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.
       FUNCTION GAMMA_INC(PA,PX)  RESULT(PGAMMA_INC)
       USE PARKIND1, ONLY : JPRB
       USE YOMHOOK , ONLY : LHOOK, DR_HOOK
@@ -42,10 +45,14 @@
 !!    MODIFICATIONS
 !!    -------------
 !!      Original     7/12/95
+!  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
 !
 !*       0. DECLARATIONS
 !           ------------
 !
+USE MODE_MSG
+!
 USE MODI_GAMMA
 !
 IMPLICIT NONE
@@ -67,11 +74,8 @@ REAL                                 :: ZAN,ZB,ZC,ZD,ZH
 !
 REAL(KIND=JPRB) :: ZHOOK_HANDLE
 IF (LHOOK) CALL DR_HOOK('GAMMA_INC',0,ZHOOK_HANDLE)
-IF( (PX.LT.0.0).OR.(PA.LE.0.0) ) THEN
-  PRINT *,' BAD ARGUMENTS IN GAMMA_INC'
-!callabortstop
-CALL ABORT
-  STOP
+IF(PX<0.0 .OR. PA<=0.0) THEN
+  CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'GAMMA_INC', 'invalid arguments: PX<0.0 .OR. PA<=0.0')
 END IF
 !
 IF( (PX.LT.PA+1.0) ) THEN
@@ -87,12 +91,9 @@ IF( (PX.LT.PA+1.0) ) THEN
     IF( ABS(ZDEL).LT.ABS(ZSUM)*ZEPS ) EXIT LOOP_SERIES
     JN = JN + 1
     IF( JN.GT.ITMAX ) THEN
-      PRINT *,' ARGUMENT "PA" IS TOO LARGE OR "ITMAX" IS TOO SMALL, THE      &
-              & INCOMPLETE GAMMA_INC FUNCTION CANNOT BE EVALUATED CORRECTLY  &
-              & BY THE SERIES METHOD'
-!callabortstop
-CALL ABORT
-      STOP
+      CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'GAMMA_INC', 'PA argument is too large or ITMAX is too small,'// &
+                     ' the incomplete GAMMA_INC function cannot be evaluated correctly'// &
+                     ' by the series method')
     END IF
   END DO LOOP_SERIES
   PGAMMA_INC = ZSUM * EXP( -PX+PA*ALOG(PX)-ALOG(GAMMA(PA)) )
@@ -106,7 +107,7 @@ CALL ABORT
   JN = 1
 !
   LOOP_FRACTION: DO
-    ZAN = -FLOAT(JN)*(FLOAT(JN)-PA)
+    ZAN = -REAL(JN)*(REAL(JN)-PA)
     ZB = ZB + 2.0
     ZD = ZAN*ZD + ZB
     IF( ABS(ZD).LT.TINY(PX) ) THEN
@@ -122,12 +123,9 @@ CALL ABORT
     IF( ABS(ZDEL-1.0).LT.ZEPS ) EXIT LOOP_FRACTION
     JN = JN + 1
     IF( JN.GT.ITMAX ) THEN
-      PRINT *,' ARGUMENT "PA" IS TOO LARGE OR "ITMAX" IS TOO SMALL, THE      &
-              & INCOMPLETE GAMMA_INC FUNCTION CANNOT BE EVALUATED CORRECTLY  &
-              & BY THE CONTINUOUS FRACTION METHOD'
-!callabortstop
-CALL ABORT
-      STOP
+      CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'GAMMA_INC', 'PA argument is too large or ITMAX is too small,'// &
+                     ' the incomplete GAMMA_INC function cannot be evaluated correctly'// &
+                     ' by the continuous fraction method')
     END IF
   END DO LOOP_FRACTION
   PGAMMA_INC = 1.0 - ZH*EXP( -PX+PA*ALOG(PX)-ALOG(GAMMA(PA)) )

src/arome/micro/general_gamma.F90 → src/common/aux/general_gamma.F90

-!     ######spl
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
+!MNH_LIC for details. version 1.
       FUNCTION GENERAL_GAMMA(PALPHA,PNU,PLBDA,PX)  RESULT(PGENERAL_GAMMA)
       USE PARKIND1, ONLY : JPRB
       USE YOMHOOK , ONLY : LHOOK, DR_HOOK