From 3bf8ed0b6db945f29aa4c183c111efb2a4a271ef Mon Sep 17 00:00:00 2001
From: Gaelle TANGUY <gaelle.tanguy@meteo.fr>
Date: Fri, 4 Nov 2016 09:47:36 +0100
Subject: [PATCH] LIMA
---
src/MNH/ini_lima.f90 | 154 +++
src/MNH/ini_lima_cold_mixed.f90 | 1312 +++++++++++++++++++++
src/MNH/ini_lima_warm.f90 | 437 +++++++
src/MNH/init_aerosol_concentration.f90 | 152 +++
src/MNH/init_aerosol_properties.f90 | 341 ++++++
src/MNH/lima_adjust.f90 | 1216 ++++++++++++++++++++
src/MNH/lima_cold.f90 | 414 +++++++
src/MNH/lima_cold_hom_nucl.f90 | 684 +++++++++++
src/MNH/lima_cold_sedimentation.f90 | 378 +++++++
src/MNH/lima_cold_slow_processes.f90 | 568 ++++++++++
src/MNH/lima_functions.f90 | 326 ++++++
src/MNH/lima_meyers.f90 | 485 ++++++++
src/MNH/lima_mixed.f90 | 809 +++++++++++++
src/MNH/lima_mixed_fast_processes.f90 | 1321 ++++++++++++++++++++++
src/MNH/lima_mixed_slow_processes.f90 | 277 +++++
src/MNH/lima_phillips.f90 | 670 +++++++++++
src/MNH/lima_phillips_integ.f90 | 143 +++
src/MNH/lima_phillips_ref_spectrum.f90 | 136 +++
src/MNH/lima_precip_scavenging.f90 | 831 ++++++++++++++
src/MNH/lima_warm.f90 | 440 +++++++
src/MNH/lima_warm_coal.f90 | 495 ++++++++
src/MNH/lima_warm_evap.f90 | 352 ++++++
src/MNH/lima_warm_nucl.f90 | 818 ++++++++++++++
src/MNH/lima_warm_sedim.f90 | 397 +++++++
src/MNH/modd_lima_precip_scavengingn.f90 | 59 +
src/MNH/modd_param_lima.f90 | 185 +++
src/MNH/modd_param_lima_cold.f90 | 122 ++
src/MNH/modd_param_lima_mixed.f90 | 169 +++
src/MNH/modd_param_lima_warm.f90 | 119 ++
src/MNH/modn_param_lima.f90 | 29 +
src/MNH/set_conc_lima.f90 | 182 +++
31 files changed, 14021 insertions(+)
create mode 100644 src/MNH/ini_lima.f90
create mode 100644 src/MNH/ini_lima_cold_mixed.f90
create mode 100644 src/MNH/ini_lima_warm.f90
create mode 100644 src/MNH/init_aerosol_concentration.f90
create mode 100644 src/MNH/init_aerosol_properties.f90
create mode 100644 src/MNH/lima_adjust.f90
create mode 100644 src/MNH/lima_cold.f90
create mode 100644 src/MNH/lima_cold_hom_nucl.f90
create mode 100644 src/MNH/lima_cold_sedimentation.f90
create mode 100644 src/MNH/lima_cold_slow_processes.f90
create mode 100644 src/MNH/lima_functions.f90
create mode 100644 src/MNH/lima_meyers.f90
create mode 100644 src/MNH/lima_mixed.f90
create mode 100644 src/MNH/lima_mixed_fast_processes.f90
create mode 100644 src/MNH/lima_mixed_slow_processes.f90
create mode 100644 src/MNH/lima_phillips.f90
create mode 100644 src/MNH/lima_phillips_integ.f90
create mode 100644 src/MNH/lima_phillips_ref_spectrum.f90
create mode 100644 src/MNH/lima_precip_scavenging.f90
create mode 100644 src/MNH/lima_warm.f90
create mode 100644 src/MNH/lima_warm_coal.f90
create mode 100644 src/MNH/lima_warm_evap.f90
create mode 100644 src/MNH/lima_warm_nucl.f90
create mode 100644 src/MNH/lima_warm_sedim.f90
create mode 100644 src/MNH/modd_lima_precip_scavengingn.f90
create mode 100644 src/MNH/modd_param_lima.f90
create mode 100644 src/MNH/modd_param_lima_cold.f90
create mode 100644 src/MNH/modd_param_lima_mixed.f90
create mode 100644 src/MNH/modd_param_lima_warm.f90
create mode 100644 src/MNH/modn_param_lima.f90
create mode 100644 src/MNH/set_conc_lima.f90
diff --git a/src/MNH/ini_lima.f90 b/src/MNH/ini_lima.f90
new file mode 100644
index 000000000..ba15ca10c
--- /dev/null
+++ b/src/MNH/ini_lima.f90
@@ -0,0 +1,154 @@
+! ####################
+ MODULE MODI_INI_LIMA
+! ####################
+!
+INTERFACE
+ SUBROUTINE INI_LIMA (PTSTEP, PDZMIN, KSPLITR, KSPLITG)
+!
+INTEGER, INTENT(OUT):: KSPLITR ! Number of small time step
+ ! integration for rain
+ ! sedimendation
+INTEGER, INTENT(OUT):: KSPLITG ! Number of small time step
+ ! integration for graupel
+ ! sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Effective Time step
+REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
+!
+END SUBROUTINE INI_LIMA
+!
+END INTERFACE
+!
+END MODULE MODI_INI_LIMA
+! ######################################################
+ SUBROUTINE INI_LIMA (PTSTEP, PDZMIN, KSPLITR, KSPLITG)
+! ######################################################
+!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize the constants used in the
+!! microphysical scheme LIMA.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_REF
+USE MODD_PARAM_LIMA
+USE MODD_PARAMETERS
+USE MODD_LUNIT
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+INTEGER, INTENT(OUT):: KSPLITR ! Number of small time step
+ ! integration for rain
+ ! sedimendation
+INTEGER, INTENT(OUT):: KSPLITG ! Number of small time step
+ ! integration for graupel or hail
+ ! sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Effective Time step
+REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
+!
+!* 0.2 Declarations of local variables :
+!
+REAL :: ZT ! Work variable
+REAL :: ZVTRMAX
+!
+INTEGER :: ILUOUT0 ! Logical unit number for output-listing
+INTEGER :: IRESP ! Return code of FM-routines
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. INIT OUTPUT LISTING, COMPUTE KSPLITR AND KSPLITG
+! ------------------------------------------------
+!
+!
+! Init output listing
+CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT0,IRESP)
+!
+!
+! KSPLITR
+ZVTRMAX = 30. ! Maximum rain drop fall speed
+!
+KSPLITR = 1
+SPLITR : DO
+ ZT = PTSTEP / FLOAT(KSPLITR)
+ IF ( ZT * ZVTRMAX / PDZMIN < 1.0) EXIT SPLITR
+ KSPLITR = KSPLITR + 1
+END DO SPLITR
+!
+!
+! KSPLITG
+ZVTRMAX = 30.
+IF( LHAIL ) THEN
+ ZVTRMAX = 60. ! Hail case
+END IF
+!
+KSPLITG = 1
+SPLITG : DO
+ ZT = 2.* PTSTEP / FLOAT(KSPLITG)
+ IF ( ZT * ZVTRMAX / PDZMIN .LT. 1.) EXIT SPLITG
+ KSPLITG = KSPLITG + 1
+END DO SPLITG
+!
+!
+!
+IF (ALLOCATED(XRTMIN)) RETURN ! In case of nesting microphysics, constants of
+ ! MODD_RAIN_C2R2_PARAM are computed only once.
+!
+!
+! Set bounds for mixing ratios and concentrations
+ALLOCATE( XRTMIN(7) )
+XRTMIN(1) = 1.0E-20 ! rv
+XRTMIN(2) = 1.0E-20 ! rc
+!XRTMIN(3) = 1.0E-20 ! rr
+XRTMIN(3) = 1.0E-17 ! rr
+XRTMIN(4) = 1.0E-20 ! ri
+XRTMIN(5) = 1.0E-15 ! rs
+XRTMIN(6) = 1.0E-15 ! rg
+XRTMIN(7) = 1.0E-15 ! rh
+ALLOCATE( XCTMIN(7) )
+XCTMIN(1) = 1.0 ! Not used
+XCTMIN(2) = 1.0E+4 ! Nc
+!XCTMIN(3) = 1.0E+1 ! Nr
+XCTMIN(3) = 1.0E-3 ! Nr
+XCTMIN(4) = 1.0E-3 ! Ni
+XCTMIN(5) = 1.0E-3 ! Not used
+XCTMIN(6) = 1.0E-3 ! Not used
+XCTMIN(7) = 1.0E-3 ! Not used
+!
+!
+! Air density fall speed correction
+XCEXVT = 0.4
+!
+!------------------------------------------------------------------------------
+!
+!
+!
+!* 2. DEFINE SPECIES CHARACTERISTICS AND PROCESSES CONSTANTS
+! ------------------------------------------------------
+!
+!
+CALL INI_LIMA_WARM(PTSTEP, PDZMIN)
+!
+CALL INI_LIMA_COLD_MIXED(PTSTEP, PDZMIN)
+!
+!------------------------------------------------------------------------------
+!
+END SUBROUTINE INI_LIMA
diff --git a/src/MNH/ini_lima_cold_mixed.f90 b/src/MNH/ini_lima_cold_mixed.f90
new file mode 100644
index 000000000..a2c98df44
--- /dev/null
+++ b/src/MNH/ini_lima_cold_mixed.f90
@@ -0,0 +1,1312 @@
+! ###############################
+ MODULE MODI_INI_LIMA_COLD_MIXED
+! ###############################
+!
+INTERFACE
+ SUBROUTINE INI_LIMA_COLD_MIXED (PTSTEP, PDZMIN)
+!
+REAL, INTENT(IN) :: PTSTEP ! Effective Time step
+REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
+!
+END SUBROUTINE INI_LIMA_COLD_MIXED
+!
+END INTERFACE
+!
+END MODULE MODI_INI_LIMA_COLD_MIXED
+! ###############################################
+ SUBROUTINE INI_LIMA_COLD_MIXED (PTSTEP, PDZMIN)
+! ###############################################
+!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize the constants used in the
+!! microphysical scheme LIMA for the cold and mixed phase variables
+!! and processes.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODE_FM
+USE MODD_CST
+USE MODD_REF
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_LIMA_WARM
+USE MODD_PARAM_LIMA_COLD
+USE MODD_PARAM_LIMA_MIXED
+USE MODD_PARAMETERS
+USE MODD_LUNIT
+!
+USE MODI_LIMA_FUNCTIONS
+USE MODI_GAMMA
+USE MODI_GAMMA_INC
+USE MODI_RRCOLSS
+USE MODI_RZCOLX
+USE MODI_RSCOLRG
+USE MODI_READ_XKER_RACCS
+USE MODI_READ_XKER_SDRYG
+USE MODI_READ_XKER_RDRYG
+USE MODI_READ_XKER_SWETH
+USE MODI_READ_XKER_GWETH
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, INTENT(IN) :: PTSTEP ! Effective Time step
+REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IKB ! Coordinates of the first physical
+ ! points along z
+INTEGER :: J1,J2 ! Internal loop indexes
+!
+REAL, DIMENSION(8) :: ZGAMI ! parameters involving various moments
+REAL, DIMENSION(2) :: ZGAMS ! of the generalized gamma law
+!
+REAL :: ZT ! Work variable
+REAL :: ZVTRMAX ! Raindrop maximal fall velocity
+REAL :: ZRHO00 ! Surface reference air density
+REAL :: ZRATE ! Geometrical growth of Lbda in the tabulated
+ ! functions and kernels
+REAL :: ZBOUND ! XDCSLIM*Lbda_s: upper bound for the partial
+ ! integration of the riming rate of the aggregates
+REAL :: ZEGS, ZEGR, ZEHS, ZEHG! Bulk collection efficiencies
+!
+INTEGER :: IND ! Number of interval to integrate the kernels
+REAL :: ZESR ! Mean efficiency of rain-aggregate collection
+REAL :: ZFDINFTY ! Factor used to define the "infinite" diameter
+!
+!
+INTEGER :: ILUOUT0 ! Logical unit number for output-listing
+INTEGER :: IRESP ! Return code of FM-routines
+LOGICAL :: GFLAG ! Logical flag for printing the constatnts on the output
+ ! listing
+REAL :: ZCONC_MAX ! Maximal concentration for snow
+REAL :: ZFACT_NUCL! Amplification factor for the minimal ice concentration
+!
+INTEGER :: KND
+INTEGER :: KACCLBDAS,KACCLBDAR,KDRYLBDAG,KDRYLBDAS,KDRYLBDAR
+REAL :: PALPHAR,PALPHAS,PALPHAG,PALPHAH
+REAL :: PNUR,PNUS,PNUG,PNUH
+REAL :: PBR,PBS,PBG,PBH
+REAL :: PCR,PCS,PCG,PCH
+REAL :: PDR,PDS,PDG,PDH
+REAL :: PESR,PEGS,PEGR,PEHS,PEHG
+REAL :: PFDINFTY
+REAL :: PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN
+REAL :: PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN
+REAL :: PDRYLBDAR_MAX,PDRYLBDAR_MIN
+REAL :: PWETLBDAS_MAX,PWETLBDAG_MAX,PWETLBDAS_MIN,PWETLBDAG_MIN
+REAL :: PWETLBDAH_MAX,PWETLBDAH_MIN
+INTEGER :: KWETLBDAS,KWETLBDAG,KWETLBDAH
+!
+REAL :: ZFAC_ZRNIC ! Zrnic factor used to decrease Long Kernels
+!
+!-------------------------------------------------------------------------------
+!
+!
+! Initialize output listing
+CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT0,IRESP)
+!
+!
+!* 1. CHARACTERISTICS OF THE SPECIES
+! ------------------------------
+!
+!
+!* 1.2 Ice crystal characteristics
+!
+SELECT CASE (CPRISTINE_ICE_LIMA)
+ CASE('PLAT')
+ XAI = 0.82 ! Plates
+ XBI = 2.5 ! Plates
+ XC_I = 800. ! Plates
+ XDI = 1.0 ! Plates
+ XC1I = 1./XPI ! Plates
+ CASE('COLU')
+ XAI = 2.14E-3 ! Columns
+ XBI = 1.7 ! Columns
+ XC_I = 2.1E5 ! Columns
+ XDI = 1.585 ! Columns
+ XC1I = 0.8 ! Columns
+ CASE('BURO')
+ XAI = 44.0 ! Bullet rosettes
+ XBI = 3.0 ! Bullet rosettes
+ XC_I = 4.3E5 ! Bullet rosettes
+ XDI = 1.663 ! Bullet rosettes
+ XC1I = 0.5 ! Bullet rosettes
+END SELECT
+!
+! Note that XCCI=N_i (a locally predicted value) and XCXI=0.0, implicitly
+!
+XF0I = 1.00
+! Correction BVIE XF2I from Pruppacher 1997 eq 13-88
+!XF2I = 0.103
+XF2I = 0.14
+XF0IS = 0.86
+XF1IS = 0.28
+!
+!* 1.3 Snowflakes/aggregates characteristics
+!
+XAS = 0.02
+XBS = 1.9
+XCS = 5.1
+XDS = 0.27
+!
+XCCS = 5.0
+XCXS = 1.0
+!
+XF0S = 0.86
+XF1S = 0.28
+!
+XC1S = 1./XPI
+!
+!* 1.4 Graupel characteristics
+!
+XAG = 19.6 ! Lump graupel case
+XBG = 2.8 ! Lump graupel case
+XCG = 124. ! Lump graupel case
+XDG = 0.66 ! Lump graupel case
+!
+XCCG = 5.E5
+XCXG = -0.5
+! XCCG = 4.E4 ! Test of Ziegler (1988)
+! XCXG = -1.0 ! Test of Ziegler (1988)
+!
+XF0G = 0.86
+XF1G = 0.28
+!
+XC1G = 1./2.
+!
+!* 2.5 Hailstone characteristics
+!
+!
+XAH = 470.
+XBH = 3.0
+XCH = 207.
+XDH = 0.64
+!
+!XCCH = 5.E-4
+!XCXH = 2.0
+!!!!!!!!!!!!
+ XCCH = 4.E4 ! Test of Ziegler (1988)
+ XCXH = -1.0 ! Test of Ziegler (1988)
+!!! XCCH = 5.E5 ! Graupel_like
+!!! XCXH = -0.5 ! Graupel_like
+!!!!!!!!!!!!
+!
+XF0H = 0.86
+XF1H = 0.28
+!
+XC1H = 1./2.
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. DIMENSIONAL DISTRIBUTIONS OF THE SPECIES
+! ----------------------------------------
+!
+!
+!* 2.1 Ice, snow, graupel and hail distribution
+!
+!
+XALPHAI = 3.0 ! Gamma law for the ice crystal volume
+XNUI = 3.0 ! Gamma law with little dispersion
+!
+XALPHAS = 1.0 ! Exponential law
+XNUS = 1.0 ! Exponential law
+!
+XALPHAG = 1.0 ! Exponential law
+XNUG = 1.0 ! Exponential law
+!
+XALPHAH = 1.0 ! Gamma law
+XNUH = 8.0 ! Gamma law with little dispersion
+!
+!* 2.2 Constants for shape parameter
+!
+XLBEXI = 1.0/XBI
+XLBI = XAI*MOMG(XALPHAI,XNUI,XBI)
+!
+XLBEXS = 1.0/(XCXS-XBS)
+XLBS = ( XAS*XCCS*MOMG(XALPHAS,XNUS,XBS) )**(-XLBEXS)
+!
+XLBEXG = 1.0/(XCXG-XBG)
+XLBG = ( XAG*XCCG*MOMG(XALPHAG,XNUG,XBG))**(-XLBEXG)
+!
+XLBEXH = 1.0/(XCXH-XBH)
+XLBH = ( XAH*XCCH*MOMG(XALPHAH,XNUH,XBH) )**(-XLBEXH)
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" Shape Parameters")')
+ WRITE(UNIT=ILUOUT0,FMT='(" XLBEXI =",E13.6," XLBI =",E13.6)') XLBEXI,XLBI
+ WRITE(UNIT=ILUOUT0,FMT='(" XLBEXS =",E13.6," XLBS =",E13.6)') XLBEXS,XLBS
+ WRITE(UNIT=ILUOUT0,FMT='(" XLBEXG =",E13.6," XLBG =",E13.6)') XLBEXG,XLBG
+ WRITE(UNIT=ILUOUT0,FMT='(" XLBEXH =",E13.6," XLBH =",E13.6)') XLBEXH,XLBH
+END IF
+!
+XLBDAS_MAX = 100000.0
+XLBDAG_MAX = 100000.0
+!
+ZCONC_MAX = 1.E6 ! Maximal concentration for falling particules set to 1 per cc
+XLBDAS_MAX = ( ZCONC_MAX/XCCS )**(1./XCXS)
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3. CONSTANTS FOR THE SEDIMENTATION
+! -------------------------------
+!
+!
+!* 3.1 Exponent of the fall-speed air density correction
+!
+IKB = 1 + JPVEXT
+ZRHO00 = XP00/(XRD*XTHVREFZ(IKB))
+!
+!* 3.2 Constants for sedimentation
+!
+!! XEXRSEDI = (XBI+XDI)/XBI
+!! XEXCSEDI = 1.0-XEXRSEDI
+!! XFSEDI = (4.*XPI*900.)**(-XEXCSEDI) * &
+!! XC_I*XAI*MOMG(XALPHAI,XNUI,XBI+XDI) * &
+!! ((XAI*MOMG(XALPHAI,XNUI,XBI)))**(-XEXRSEDI) * &
+!! (ZRHO00)**XCEXVT
+!! !
+!! ! Computations made for Columns
+!! !
+!! XEXRSEDI = 1.9324
+!! XEXCSEDI =-0.9324
+!! XFSEDI = 3.89745E11*MOMG(XALPHAI,XNUI,3.285)* &
+!! MOMG(XALPHAI,XNUI,1.7)**(-XEXRSEDI)*(ZRHO00)**XCEXVT
+!! XEXCSEDI =-0.9324*3.0
+!! WRITE (ILUOUT0,FMT=*)' PRISTINE ICE SEDIMENTATION for columns XFSEDI=',XFSEDI
+!
+!
+XFSEDRI = XC_I*GAMMA_X0D(XNUI+(XDI+XBI)/XALPHAI)/GAMMA_X0D(XNUI+XBI/XALPHAI)* &
+ (ZRHO00)**XCEXVT
+XFSEDCI = XC_I*GAMMA_X0D(XNUI+XDI/XALPHAI)/GAMMA_X0D(XNUI)* &
+ (ZRHO00)**XCEXVT
+!
+XEXSEDS = (XBS+XDS-XCXS)/(XBS-XCXS)
+XFSEDS = XCS*XAS*XCCS*MOMG(XALPHAS,XNUS,XBS+XDS)* &
+ (XAS*XCCS*MOMG(XALPHAS,XNUS,XBS))**(-XEXSEDS)*(ZRHO00)**XCEXVT
+!
+XEXSEDG = (XBG+XDG-XCXG)/(XBG-XCXG)
+XFSEDG = XCG*XAG*XCCG*MOMG(XALPHAG,XNUG,XBG+XDG)* &
+ (XAG*XCCG*MOMG(XALPHAG,XNUG,XBG))**(-XEXSEDG)*(ZRHO00)**XCEXVT
+!
+XEXSEDH = (XBH+XDH-XCXH)/(XBH-XCXH)
+XFSEDH = XCH*XAH*XCCH*MOMG(XALPHAH,XNUH,XBH+XDH)* &
+ (XAH*XCCH*MOMG(XALPHAH,XNUH,XBH))**(-XEXSEDH)*(ZRHO00)**XCEXVT
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 4. CONSTANTS FOR HETEROGENEOUS NUCLEATION
+! --------------------------------------
+!
+!
+! ***************
+!* 4.1 LIMA_NUCLEATION
+! ***************
+!* 4.1.1 Constants for the computation of the number concentration
+! of active IN
+!
+XRHO_CFDC = 0.76
+!
+XGAMMA = 2.
+!
+IF (NPHILLIPS == 13) THEN
+ XAREA1(1) = 2.0E-6 !DM1
+ XAREA1(2) = XAREA1(1) !DM2
+ XAREA1(3) = 1.0E-7 !BC
+ XAREA1(4) = 8.9E-7 !BIO
+ELSE IF (NPHILLIPS == 8) THEN
+ XAREA1(1) = 2.0E-6 !DM1
+ XAREA1(2) = XAREA1(1) !DM2
+ XAREA1(3) = 2.7E-7 !BC
+ XAREA1(4) = 9.1E-7 !BIO
+ELSE
+ print *, "NPHILLIPS n'est pas égal à 8 ou 13"
+ STOP
+END IF
+!
+!* 4.1.2 Constants for the computation of H_X (the fraction-redu-
+! cing IN activity at low S_i and warm T) for X={DM1,DM2,BC,BIO}
+!
+!
+IF (NPHILLIPS == 13) THEN
+ XDT0(1) = 5. +273.15 !DM1
+ XDT0(2) = 5. +273.15 !DM2
+ XDT0(3) = 10. +273.15 !BC
+ XDT0(4) = 5. +273.15 !BIOO
+!
+ XT0(1) = -40. +273.15 !DM1
+ XT0(2) = XT0(1) !DM2
+ XT0(3) = -50. +273.15 !BC
+ XT0(4) = -20. +273.15 !BIO
+!
+ XSW0 = 0.97
+!
+ XDSI0(1) = 0.1 !DM1
+ XDSI0(2) = 0.1 !DM2
+ XDSI0(3) = 0.1 !BC
+ XDSI0(4) = 0.2 !BIO
+!
+ XH(1) = 0.15 !DM1
+ XH(2) = 0.15 !DM2
+ XH(3) = 0. !BC
+ XH(4) = 0. !O
+!
+ XTX1(1) = -30. +273.15 !DM1
+ XTX1(2) = XTX1(1) !DM2
+ XTX1(3) = -25. +273.15 !BC
+ XTX1(4) = -5. +273.15 !BIO
+!
+ XTX2(1) = -10. +273.15 !DM1
+ XTX2(2) = XTX2(1) !DM2
+ XTX2(3) = -15. +273.15 !BC
+ XTX2(4) = -2. +273.15 !BIO
+ELSE IF (NPHILLIPS == 8) THEN
+ XDT0(1) = 5. +273.15 !DM1
+ XDT0(2) = 5. +273.15 !DM2
+ XDT0(3) = 5. +273.15 !BC
+ XDT0(4) = 5. +273.15 !O
+!
+ XT0(1) = -40. +273.15 !DM1
+ XT0(2) = XT0(1) !DM2
+ XT0(3) = -50. +273.15 !BC
+ XT0(4) = -50. +273.15 !BIO
+!
+ XSW0 = 0.97
+!
+ XDSI0(1) = 0.1 !DM1
+ XDSI0(2) = 0.1 !DM2
+ XDSI0(3) = 0.1 !BC
+ XDSI0(4) = 0.1 !BIO
+!
+ XH(1) = 0.15 !DM1
+ XH(2) = 0.15 !DM2
+ XH(3) = 0. !BC
+ XH(4) = 0. !O
+!
+ XTX1(1) = -5. +273.15 !DM1
+ XTX1(2) = XTX1(1) !DM2
+ XTX1(3) = -5. +273.15 !BC
+ XTX1(4) = -5. +273.15 !BIO
+!
+ XTX2(1) = -2. +273.15 !DM1
+ XTX2(2) = XTX2(1) !DM2
+ XTX2(3) = -2. +273.15 !BC
+ XTX2(4) = -2. +273.15 !BIO
+END IF
+!
+!* 4.1.3 Constants for the computation of the Gauss Hermitte
+! quadrature method used for the integration of the total
+! crystal number over T>-35°C
+!
+NDIAM = 70
+!
+ALLOCATE(XABSCISS(NDIAM))
+ALLOCATE(XWEIGHT (NDIAM))
+!
+CALL GAUHER(XABSCISS, XWEIGHT, NDIAM)
+!
+! *****************
+!* 4.2 MEYERS NUCLEATION
+! *****************
+!
+ZFACT_NUCL = 1.0 ! Plates, Columns and Bullet rosettes
+!
+!* 5.2.1 Constants for nucleation from ice nuclei
+!
+XNUC_DEP = XFACTNUC_DEP*1000.*ZFACT_NUCL
+XEXSI_DEP = 12.96E-2
+XEX_DEP = -0.639
+!
+XNUC_CON = XFACTNUC_CON*1000.*ZFACT_NUCL
+XEXTT_CON = -0.262
+XEX_CON = -2.8
+!
+XMNU0 = 6.88E-13
+!
+IF (LMEYERS) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" Heterogeneous nucleation")')
+ WRITE(UNIT=ILUOUT0,FMT='(" XNUC_DEP=",E13.6," XEXSI=",E13.6," XEX=",E13.6)') &
+ XNUC_DEP,XEXSI_DEP,XEX_DEP
+ WRITE(UNIT=ILUOUT0,FMT='(" XNUC_CON=",E13.6," XEXTT=",E13.6," XEX=",E13.6)') &
+ XNUC_CON,XEXTT_CON,XEX_CON
+ WRITE(UNIT=ILUOUT0,FMT='(" mass of embryo XMNU0=",E13.6)') XMNU0
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 5. CONSTANTS FOR THE SLOW COLD PROCESSES
+! -------------------------------------
+!
+!
+!* 5.1.2 Constants for homogeneous nucleation from haze particules
+!
+XRHOI_HONH = 925.0
+XCEXP_DIFVAP_HONH = 1.94
+XCOEF_DIFVAP_HONH = (2.0*XPI)*0.211E-4*XP00/XTT**XCEXP_DIFVAP_HONH
+XCRITSAT1_HONH = 2.583
+XCRITSAT2_HONH = 207.83
+XTMIN_HONH = 180.0
+XTMAX_HONH = 240.0
+XDLNJODT1_HONH = 4.37
+XDLNJODT2_HONH = 0.03
+XC1_HONH = 100.0
+XC2_HONH = 22.6
+XC3_HONH = 0.1
+XRCOEF_HONH = (XPI/6.0)*XRHOI_HONH
+!
+!
+!* 5.1.3 Constants for homogeneous nucleation from cloud droplets
+!
+XTEXP1_HONC = -606.3952*LOG(10.0)
+XTEXP2_HONC = -52.6611*LOG(10.0)
+XTEXP3_HONC = -1.7439*LOG(10.0)
+XTEXP4_HONC = -0.0265*LOG(10.0)
+XTEXP5_HONC = -1.536E-4*LOG(10.0)
+IF (XALPHAC == 3.0) THEN
+ XC_HONC = XPI/6.0
+ XR_HONC = XPI/6.0
+ELSE
+ WRITE(UNIT=ILUOUT0,FMT='(" Homogeneous nucleation")')
+ WRITE(UNIT=ILUOUT0,FMT='(" XALPHAC=",E13.6," IS NOT 3.0")') XALPHAC
+ WRITE(UNIT=ILUOUT0,FMT='(" No algorithm yet developped in this case !")')
+ STOP
+END IF
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" Homogeneous nucleation")')
+ WRITE(UNIT=ILUOUT0,FMT='(" XTEXP1_HONC=",E13.6)') XTEXP1_HONC
+ WRITE(UNIT=ILUOUT0,FMT='(" XTEXP2_HONC=",E13.6)') XTEXP2_HONC
+ WRITE(UNIT=ILUOUT0,FMT='(" XTEXP3_HONC=",E13.6)') XTEXP3_HONC
+ WRITE(UNIT=ILUOUT0,FMT='(" XTEXP4_HONC=",E13.6)') XTEXP4_HONC
+ WRITE(UNIT=ILUOUT0,FMT='(" XTEXP5_HONC=",E13.6)') XTEXP5_HONC
+ WRITE(UNIT=ILUOUT0,FMT='("XC_HONC=",E13.6," XR_HONC=",E13.6)') XC_HONC,XR_HONC
+END IF
+!
+!
+!* 5.2 Constants for vapor deposition on ice
+!
+XSCFAC = (0.63**(1./3.))*SQRT((ZRHO00)**XCEXVT) ! One assumes Sc=0.63
+!
+X0DEPI = (4.0*XPI)*XC1I*XF0I*MOMG(XALPHAI,XNUI,1.)
+X2DEPI = (4.0*XPI)*XC1I*XF2I*XC_I*MOMG(XALPHAI,XNUI,XDI+2.0)
+!
+! Harrington parameterization for ice to snow conversion
+!
+XDICNVS_LIM = 125.E-6 ! size in microns
+XLBDAICNVS_LIM = (50.0**(1.0/(XALPHAI)))/XDICNVS_LIM ! ZLBDAI Limitation
+XC0DEPIS = ((4.0*XPI)/(XAI*XBI))*XC1I*XF0IS* &
+ (XALPHAI/GAMMA_X0D(XNUI))*XDICNVS_LIM**(1.0-XBI)
+XC1DEPIS = ((4.0*XPI)/(XAI*XBI))*XC1I*XF1IS*SQRT(XC_I)* &
+ (XALPHAI/GAMMA_X0D(XNUI))*XDICNVS_LIM**(1.0-XBI+(XDI+1.0)/2.0)
+XR0DEPIS = XC0DEPIS *(XAI*XDICNVS_LIM**XBI)
+XR1DEPIS = XC1DEPIS *(XAI*XDICNVS_LIM**XBI)
+!
+! Harrington parameterization for snow to ice conversion
+!
+XLBDASCNVI_MAX = 6000. ! lbdas max after Field (1999)
+!
+XDSCNVI_LIM = 125.E-6 ! size in microns
+XLBDASCNVI_LIM = (50.0**(1.0/(XALPHAS)))/XDSCNVI_LIM ! ZLBDAS Limitation
+XC0DEPSI = ((4.0*XPI)/(XAS*XBS))*XC1S*XF0IS* &
+ (XALPHAS/GAMMA_X0D(XNUS))*XDSCNVI_LIM**(1.0-XBS)
+XC1DEPSI = ((4.0*XPI)/(XAS*XBS))*XC1S*XF1IS*SQRT(XCS)* &
+ (XALPHAS/GAMMA_X0D(XNUS))*XDSCNVI_LIM**(1.0-XBS+(XDS+1.0)/2.0)
+XR0DEPSI = XC0DEPSI *(XAS*XDSCNVI_LIM**XBS)
+XR1DEPSI = XC1DEPSI *(XAS*XDSCNVI_LIM**XBS)
+!
+! Vapor deposition on snow and graupel and hail
+!
+X0DEPS = (4.0*XPI)*XCCS*XC1S*XF0S*MOMG(XALPHAS,XNUS,1.)
+X1DEPS = (4.0*XPI)*XCCS*XC1S*XF1S*SQRT(XCS)*MOMG(XALPHAS,XNUS,0.5*XDS+1.5)
+XEX0DEPS = XCXS-1.0
+XEX1DEPS = XCXS-0.5*(XDS+3.0)
+!
+X0DEPG = (4.0*XPI)*XCCG*XC1G*XF0G*MOMG(XALPHAG,XNUG,1.)
+X1DEPG = (4.0*XPI)*XCCG*XC1G*XF1G*SQRT(XCG)*MOMG(XALPHAG,XNUG,0.5*XDG+1.5)
+XEX0DEPG = XCXG-1.0
+XEX1DEPG = XCXG-0.5*(XDG+3.0)
+!
+X0DEPH = (4.0*XPI)*XCCH*XC1H*XF0H*MOMG(XALPHAH,XNUH,1.)
+X1DEPH = (4.0*XPI)*XCCH*XC1H*XF1H*SQRT(XCH)*MOMG(XALPHAH,XNUH,0.5*XDH+1.5)
+XEX0DEPH = XCXH-1.0
+XEX1DEPH = XCXH-0.5*(XDH+3.0)
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 6. CONSTANTS FOR THE COALESCENCE PROCESSES
+! ---------------------------------------
+!
+!
+!* 6.0 Precalculation of the gamma function momentum
+!
+ZGAMI(1) = GAMMA_X0D(XNUI)
+ZGAMI(2) = MOMG(XALPHAI,XNUI,3.)
+ZGAMI(3) = MOMG(XALPHAI,XNUI,6.)
+ZGAMI(4) = ZGAMI(3)-ZGAMI(2)**2 ! useful for Sig_I
+ZGAMI(5) = MOMG(XALPHAI,XNUI,9.)
+ZGAMI(6) = MOMG(XALPHAI,XNUI,3.+XBI)
+ZGAMI(7) = MOMG(XALPHAI,XNUI,XBI)
+ZGAMI(8) = MOMG(XALPHAI,XNUI,3.)/MOMG(XALPHAI,XNUI,2.)
+!
+ZGAMS(1) = GAMMA_X0D(XNUS)
+ZGAMS(2) = MOMG(XALPHAS,XNUS,3.)
+!
+!
+!* 6.1 Csts for the coalescence processes
+!
+ZFAC_ZRNIC = 0.1
+XKER_ZRNIC_A1 = 2.59E15*ZFAC_ZRNIC**2! From Long a1=9.44E9 cm-3
+ ! so XKERA1= 9.44E9*1E6*(PI/6)**2
+XKER_ZRNIC_A2 = 3.03E3*ZFAC_ZRNIC ! From Long a2=5.78E3
+ ! so XKERA2= 5.78E3* (PI/6)
+!
+!
+!* 6.2 Csts for the pristine ice selfcollection process
+!
+XSELFI = XKER_ZRNIC_A1*ZGAMI(3)
+XCOLEXII = 0.025 ! Temperature factor of the I+I collection efficiency
+!
+!
+!* 6.3 Constants for pristine ice autoconversion
+!
+XTEXAUTI = 0.025 ! Temperature factor of the I+I collection efficiency
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" pristine ice autoconversion")')
+ WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XTEXAUTI=",E13.6)') XTEXAUTI
+END IF
+!
+XAUTO3 = 6.25E18*(ZGAMI(2))**(1./3.)*SQRT(ZGAMI(4))
+XAUTO4 = 0.5E6*(ZGAMI(4))**(1./6.)
+XLAUTS = 2.7E-2
+XLAUTS_THRESHOLD = 0.4
+XITAUTS= 0.27 ! (Notice that T2 of BR74 is uncorrect and that 0.27=1./3.7
+XITAUTS_THRESHOLD = 7.5
+!
+!
+!* 6.4 Constants for snow aggregation
+!
+XCOLEXIS = 0.05 ! Temperature factor of the I+S collection efficiency
+XAGGS_CLARGE1 = XKER_ZRNIC_A2*ZGAMI(2)
+XAGGS_CLARGE2 = XKER_ZRNIC_A2*ZGAMS(2)
+XAGGS_RLARGE1 = XKER_ZRNIC_A2*ZGAMI(6)*XAI
+XAGGS_RLARGE2 = XKER_ZRNIC_A2*ZGAMI(7)*ZGAMS(2)*XAI
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" snow aggregation")')
+ WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XCOLEXIS=",E13.6)') XCOLEXIS
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 7. CONSTANTS FOR THE FAST COLD PROCESSES FOR THE AGGREGATES
+! --------------------------------------------------------
+!
+!
+!* 7.1 Constants for the riming of the aggregates
+!
+XDCSLIM = 0.007 ! D_cs^lim = 7 mm as suggested by Farley et al. (1989)
+XCOLCS = 1.0
+XEXCRIMSS= XCXS-XDS-2.0
+XCRIMSS = (XPI/4.0)*XCOLCS*XCCS*XCS*(ZRHO00**XCEXVT)*MOMG(XALPHAS,XNUS,XDS+2.0)
+XEXCRIMSG= XEXCRIMSS
+XCRIMSG = XCRIMSS
+XSRIMCG = XCCS*XAS*MOMG(XALPHAS,XNUS,XBS)
+XEXSRIMCG= XCXS-XBS
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" riming of the aggregates")')
+ WRITE(UNIT=ILUOUT0,FMT='(" D_cs^lim (Farley et al.) XDCSLIM=",E13.6)') XDCSLIM
+ WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLCS=",E13.6)') XCOLCS
+END IF
+!
+NGAMINC = 80
+XGAMINC_BOUND_MIN = 1.0E-1 ! Minimal value of (Lbda * D_cs^lim)**alpha
+XGAMINC_BOUND_MAX = 1.0E7 ! Maximal value of (Lbda * D_cs^lim)**alpha
+ZRATE = EXP(LOG(XGAMINC_BOUND_MAX/XGAMINC_BOUND_MIN)/FLOAT(NGAMINC-1))
+!
+ALLOCATE( XGAMINC_RIM1(NGAMINC) )
+ALLOCATE( XGAMINC_RIM2(NGAMINC) )
+!
+DO J1=1,NGAMINC
+ ZBOUND = XGAMINC_BOUND_MIN*ZRATE**(J1-1)
+ XGAMINC_RIM1(J1) = GAMMA_INC(XNUS+(2.0+XDS)/XALPHAS,ZBOUND)
+ XGAMINC_RIM2(J1) = GAMMA_INC(XNUS+XBS/XALPHAS ,ZBOUND)
+END DO
+!
+XRIMINTP1 = XALPHAS / LOG(ZRATE)
+XRIMINTP2 = 1.0 + XRIMINTP1*LOG( XDCSLIM/(XGAMINC_BOUND_MIN)**(1.0/XALPHAS) )
+!
+!* 7.1.1 Defining the constants for the Hallett-Mossop
+! secondary ice nucleation process
+!
+XHMTMIN = XTT - 8.0
+XHMTMAX = XTT - 3.0
+XHM1 = 9.3E-3 ! Obsolete parameterization
+XHM2 = 1.5E-3/LOG(10.0) ! from Ferrier (1995)
+XHM_YIELD = 5.E-3 ! A splinter is produced after the riming of 200 droplets
+XHM_COLLCS= 1.0 ! Collision efficiency snow/droplet (with Dc>25 microns)
+XHM_FACTS = XHM_YIELD*(XHM_COLLCS/XCOLCS)
+!
+! Notice: One magnitude of lambda discretized over 10 points for the droplets
+!
+XGAMINC_HMC_BOUND_MIN = 1.0E-3 ! Min value of (Lbda * (12,25) microns)**alpha
+XGAMINC_HMC_BOUND_MAX = 1.0E5 ! Max value of (Lbda * (12,25) microns)**alpha
+ZRATE = EXP(LOG(XGAMINC_HMC_BOUND_MAX/XGAMINC_HMC_BOUND_MIN)/FLOAT(NGAMINC-1))
+!
+ALLOCATE( XGAMINC_HMC(NGAMINC) )
+!
+DO J1=1,NGAMINC
+ ZBOUND = XGAMINC_HMC_BOUND_MIN*ZRATE**(J1-1)
+ XGAMINC_HMC(J1) = GAMMA_INC(XNUC,ZBOUND)
+END DO
+!
+XHMSINTP1 = XALPHAC / LOG(ZRATE)
+XHMSINTP2 = 1.0 + XHMSINTP1*LOG( 12.E-6/(XGAMINC_HMC_BOUND_MIN)**(1.0/XALPHAC) )
+XHMLINTP1 = XALPHAC / LOG(ZRATE)
+XHMLINTP2 = 1.0 + XHMLINTP1*LOG( 25.E-6/(XGAMINC_HMC_BOUND_MIN)**(1.0/XALPHAC) )
+!
+!
+!* 7.2 Constants for the accretion of raindrops onto aggregates
+!
+XFRACCSS = ((XPI**2)/24.0)*XCCS*XRHOLW*(ZRHO00**XCEXVT)
+!
+XLBRACCS1 = MOMG(XALPHAS,XNUS,2.)*MOMG(XALPHAR,XNUR,3.)
+XLBRACCS2 = 2.*MOMG(XALPHAS,XNUS,1.)*MOMG(XALPHAR,XNUR,4.)
+XLBRACCS3 = MOMG(XALPHAR,XNUR,5.)
+!
+XFSACCRG = (XPI/4.0)*XAS*XCCS*(ZRHO00**XCEXVT)
+!
+XLBSACCR1 = MOMG(XALPHAR,XNUR,2.)*MOMG(XALPHAS,XNUS,XBS)
+XLBSACCR2 = 2.*MOMG(XALPHAR,XNUR,1.)*MOMG(XALPHAS,XNUS,XBS+1.)
+XLBSACCR3 = MOMG(XALPHAS,XNUS,XBS+2.)
+!
+!* 7.2.1 Defining the ranges for the computation of the kernels
+!
+! Notice: One magnitude of lambda discretized over 10 points for rain
+! Notice: One magnitude of lambda discretized over 10 points for snow
+!
+NACCLBDAS = 40
+XACCLBDAS_MIN = 5.0E1 ! Minimal value of Lbda_s to tabulate XKER_RACCS
+XACCLBDAS_MAX = 5.0E5 ! Maximal value of Lbda_s to tabulate XKER_RACCS
+ZRATE = LOG(XACCLBDAS_MAX/XACCLBDAS_MIN)/FLOAT(NACCLBDAS-1)
+XACCINTP1S = 1.0 / ZRATE
+XACCINTP2S = 1.0 - LOG( XACCLBDAS_MIN ) / ZRATE
+NACCLBDAR = 40
+XACCLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RACCS
+XACCLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RACCS
+ZRATE = LOG(XACCLBDAR_MAX/XACCLBDAR_MIN)/FLOAT(NACCLBDAR-1)
+XACCINTP1R = 1.0 / ZRATE
+XACCINTP2R = 1.0 - LOG( XACCLBDAR_MIN ) / ZRATE
+!
+!* 7.2.2 Computations of the tabulated normalized kernels
+!
+IND = 50 ! Interval number, collection efficiency and infinite diameter
+ZESR = 1.0 ! factor used to integrate the dimensional distributions when
+ZFDINFTY = 20.0 ! computing the kernels XKER_RACCSS, XKER_RACCS and XKER_SACCRG
+!
+ALLOCATE( XKER_RACCSS(NACCLBDAS,NACCLBDAR) )
+ALLOCATE( XKER_RACCS (NACCLBDAS,NACCLBDAR) )
+ALLOCATE( XKER_SACCRG(NACCLBDAR,NACCLBDAS) )
+!
+CALL READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
+ PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PCR,PDR, &
+ PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN,&
+ PFDINFTY )
+IF( (KACCLBDAS/=NACCLBDAS) .OR. (KACCLBDAR/=NACCLBDAR) .OR. (KND/=IND) .OR. &
+ (PALPHAS/=XALPHAS) .OR. (PNUS/=XNUS) .OR. &
+ (PALPHAR/=XALPHAR) .OR. (PNUR/=XNUR) .OR. &
+ (PESR/=ZESR) .OR. (PBS/=XBS) .OR. (PBR/=XBR) .OR. &
+ (PCS/=XCS) .OR. (PDS/=XDS) .OR. (PCR/=XCR) .OR. (PDR/=XDR) .OR. &
+ (PACCLBDAS_MAX/=XACCLBDAS_MAX) .OR. (PACCLBDAR_MAX/=XACCLBDAR_MAX) .OR. &
+ (PACCLBDAS_MIN/=XACCLBDAS_MIN) .OR. (PACCLBDAR_MIN/=XACCLBDAR_MIN) .OR. &
+ (PFDINFTY/=ZFDINFTY) ) THEN
+ CALL RRCOLSS ( IND, XALPHAS, XNUS, XALPHAR, XNUR, &
+ ZESR, XBR, XCS, XDS, XCR, XDR, &
+ XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
+ ZFDINFTY, XKER_RACCSS, XAG, XBS, XAS )
+ CALL RZCOLX ( IND, XALPHAS, XNUS, XALPHAR, XNUR, &
+ ZESR, XBR, XCS, XDS, XCR, XDR, &
+ XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
+ ZFDINFTY, XKER_RACCS )
+ CALL RSCOLRG ( IND, XALPHAS, XNUS, XALPHAR, XNUR, &
+ ZESR, XBS, XCS, XDS, XCR, XDR, &
+ XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
+ ZFDINFTY, XKER_SACCRG,XAG, XBS, XAS )
+ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF RACSS KERNELS ****")')
+ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF RACS KERNELS ****")')
+ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF SACRG KERNELS ****")')
+ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
+ WRITE(UNIT=ILUOUT0,FMT='("KACCLBDAS=",I3)') NACCLBDAS
+ WRITE(UNIT=ILUOUT0,FMT='("KACCLBDAR=",I3)') NACCLBDAR
+ WRITE(UNIT=ILUOUT0,FMT='("PALPHAS=",E13.6)') XALPHAS
+ WRITE(UNIT=ILUOUT0,FMT='("PNUS=",E13.6)') XNUS
+ WRITE(UNIT=ILUOUT0,FMT='("PALPHAR=",E13.6)') XALPHAR
+ WRITE(UNIT=ILUOUT0,FMT='("PNUR=",E13.6)') XNUR
+ WRITE(UNIT=ILUOUT0,FMT='("PESR=",E13.6)') ZESR
+ WRITE(UNIT=ILUOUT0,FMT='("PBS=",E13.6)') XBS
+ WRITE(UNIT=ILUOUT0,FMT='("PBR=",E13.6)') XBR
+ WRITE(UNIT=ILUOUT0,FMT='("PCS=",E13.6)') XCS
+ WRITE(UNIT=ILUOUT0,FMT='("PDS=",E13.6)') XDS
+ WRITE(UNIT=ILUOUT0,FMT='("PCR=",E13.6)') XCR
+ WRITE(UNIT=ILUOUT0,FMT='("PDR=",E13.6)') XDR
+ WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAS_MAX=",E13.6)') &
+ XACCLBDAS_MAX
+ WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAR_MAX=",E13.6)') &
+ XACCLBDAR_MAX
+ WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAS_MIN=",E13.6)') &
+ XACCLBDAS_MIN
+ WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAR_MIN=",E13.6)') &
+ XACCLBDAR_MIN
+ WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_RACCSS) ) THEN")')
+ DO J1 = 1 , NACCLBDAS
+ DO J2 = 1 , NACCLBDAR
+ WRITE(UNIT=ILUOUT0,FMT='(" PKER_RACCSS(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_RACCSS(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_RACCS ) ) THEN")')
+ DO J1 = 1 , NACCLBDAS
+ DO J2 = 1 , NACCLBDAR
+ WRITE(UNIT=ILUOUT0,FMT='(" PKER_RACCS (",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_RACCS (J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_SACCRG) ) THEN")')
+ DO J1 = 1 , NACCLBDAR
+ DO J2 = 1 , NACCLBDAS
+ WRITE(UNIT=ILUOUT0,FMT='(" PKER_SACCRG(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_SACCRG(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+ ELSE
+ CALL READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
+ PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PCR,PDR, &
+ PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN,&
+ PFDINFTY,XKER_RACCSS,XKER_RACCS,XKER_SACCRG )
+ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_RACCSS")')
+ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_RACCS ")')
+ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_SACCRG")')
+END IF
+!
+!
+!* 7.3 Constant for the conversion-melting rate
+!
+XFSCVMG = 2.0
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" conversion-melting of the aggregates")')
+ WRITE(UNIT=ILUOUT0,FMT='(" Conv. factor XFSCVMG=",E13.6)') XFSCVMG
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 8. CONSTANTS FOR THE FAST COLD PROCESSES FOR THE GRAUPELN
+! --------------------------------------------------------
+!
+!
+!* 8.1 Constants for the rain contact freezing
+!
+XCOLIR = 1.0
+!
+! values of these coeficients differ from the single-momemt rain_ice case
+!
+XEXRCFRI = -XDR-5.0
+XRCFRI = ((XPI**2)/24.0)*XRHOLW*XCOLIR*XCR*(ZRHO00**XCEXVT) &
+ *MOMG(XALPHAR,XNUR,XDR+5.0)
+XEXICFRR = -XDR-2.0
+XICFRR = (XPI/4.0)*XCOLIR*XCR*(ZRHO00**XCEXVT) &
+ *MOMG(XALPHAR,XNUR,XDR+2.0)
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" rain contact freezing")')
+ WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLIR=",E13.6)') XCOLIR
+END IF
+!
+!
+!* 8.2 Constants for the dry growth of the graupeln
+!
+!* 8.2.1 Constants for the cloud droplet collection by the graupeln
+! and for the Hallett-Mossop process
+!
+XCOLCG = 0.6 ! Estimated from Cober and List (1993)
+XFCDRYG = (XPI/4.0)*XCOLCG*XCCG*XCG*(ZRHO00**XCEXVT)*MOMG(XALPHAG,XNUG,XDG+2.0)
+!
+XHM_COLLCG= 0.9 ! Collision efficiency graupel/droplet (with Dc>25 microns)
+XHM_FACTG = XHM_YIELD*(XHM_COLLCG/XCOLCG)
+!
+!* 8.2.2 Constants for the cloud ice collection by the graupeln
+!
+XCOLIG = 0.25 ! Collection efficiency of I+G
+XCOLEXIG = 0.05 ! Temperature factor of the I+G collection efficiency
+XCOLIG = 0.01 ! Collection efficiency of I+G
+XCOLEXIG = 0.1 ! Temperature factor of the I+G collection efficiency
+WRITE (ILUOUT0, FMT=*) ' NEW Constants for the cloud ice collection by the graupeln'
+WRITE (ILUOUT0, FMT=*) ' XCOLIG, XCOLEXIG = ',XCOLIG,XCOLEXIG
+XFIDRYG = (XPI/4.0)*XCOLIG*XCCG*XCG*(ZRHO00**XCEXVT)*MOMG(XALPHAG,XNUG,XDG+2.0)
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" cloud ice collection by the graupeln")')
+ WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLIG=",E13.6)') XCOLIG
+ WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XCOLEXIG=",E13.6)') XCOLEXIG
+END IF
+!
+!* 8.2.3 Constants for the aggregate collection by the graupeln
+!
+XCOLSG = 0.25 ! Collection efficiency of S+G
+XCOLEXSG = 0.05 ! Temperature factor of the S+G collection efficiency
+XCOLSG = 0.01 ! Collection efficiency of S+G
+XCOLEXSG = 0.1 ! Temperature factor of the S+G collection efficiency
+WRITE (ILUOUT0, FMT=*) ' NEW Constants for the aggregate collection by the graupeln'
+WRITE (ILUOUT0, FMT=*) ' XCOLSG, XCOLEXSG = ',XCOLSG,XCOLEXSG
+XFSDRYG = (XPI/4.0)*XCOLSG*XCCG*XCCS*XAS*(ZRHO00**XCEXVT)
+!
+XLBSDRYG1 = MOMG(XALPHAG,XNUG,2.)*MOMG(XALPHAS,XNUS,XBS)
+XLBSDRYG2 = 2.*MOMG(XALPHAG,XNUG,1.)*MOMG(XALPHAS,XNUS,XBS+1.)
+XLBSDRYG3 = MOMG(XALPHAS,XNUS,XBS+2.)
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" aggregate collection by the graupeln")')
+ WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLSG=",E13.6)') XCOLSG
+ WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XCOLEXSG=",E13.6)') XCOLEXSG
+END IF
+!
+!* 8.2.4 Constants for the raindrop collection by the graupeln
+!
+XFRDRYG = ((XPI**2)/24.0)*XCCG*XRHOLW*(ZRHO00**XCEXVT)
+!
+XLBRDRYG1 = MOMG(XALPHAG,XNUG,2.)*MOMG(XALPHAR,XNUR,3.)
+XLBRDRYG2 = 2.*MOMG(XALPHAG,XNUG,1.)*MOMG(XALPHAR,XNUR,4.)
+XLBRDRYG3 = MOMG(XALPHAR,XNUR,5.)
+!
+! Notice: One magnitude of lambda discretized over 10 points
+!
+NDRYLBDAR = 40
+XDRYLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RDRYG
+XDRYLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RDRYG
+ZRATE = LOG(XDRYLBDAR_MAX/XDRYLBDAR_MIN)/FLOAT(NDRYLBDAR-1)
+XDRYINTP1R = 1.0 / ZRATE
+XDRYINTP2R = 1.0 - LOG( XDRYLBDAR_MIN ) / ZRATE
+NDRYLBDAS = 80
+XDRYLBDAS_MIN = 2.5E1 ! Minimal value of Lbda_s to tabulate XKER_SDRYG
+XDRYLBDAS_MAX = 2.5E9 ! Maximal value of Lbda_s to tabulate XKER_SDRYG
+ZRATE = LOG(XDRYLBDAS_MAX/XDRYLBDAS_MIN)/FLOAT(NDRYLBDAS-1)
+XDRYINTP1S = 1.0 / ZRATE
+XDRYINTP2S = 1.0 - LOG( XDRYLBDAS_MIN ) / ZRATE
+NDRYLBDAG = 40
+XDRYLBDAG_MIN = 1.0E3 ! Min value of Lbda_g to tabulate XKER_SDRYG,XKER_RDRYG
+XDRYLBDAG_MAX = 1.0E7 ! Max value of Lbda_g to tabulate XKER_SDRYG,XKER_RDRYG
+ZRATE = LOG(XDRYLBDAG_MAX/XDRYLBDAG_MIN)/FLOAT(NDRYLBDAG-1)
+XDRYINTP1G = 1.0 / ZRATE
+XDRYINTP2G = 1.0 - LOG( XDRYLBDAG_MIN ) / ZRATE
+!
+!* 8.2.5 Computations of the tabulated normalized kernels
+!
+IND = 50 ! Interval number, collection efficiency and infinite diameter
+ZEGS = 1.0 ! factor used to integrate the dimensional distributions when
+ZFDINFTY = 20.0 ! computing the kernels XKER_SDRYG
+!
+ALLOCATE( XKER_SDRYG(NDRYLBDAG,NDRYLBDAS) )
+!
+CALL READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
+ PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS, &
+ PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
+ PFDINFTY )
+IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAS/=NDRYLBDAS) .OR. (KND/=IND) .OR. &
+ (PALPHAG/=XALPHAG) .OR. (PNUG/=XNUG) .OR. &
+ (PALPHAS/=XALPHAS) .OR. (PNUS/=XNUS) .OR. &
+ (PEGS/=ZEGS) .OR. (PBS/=XBS) .OR. &
+ (PCG/=XCG) .OR. (PDG/=XDG) .OR. (PCS/=XCS) .OR. (PDS/=XDS) .OR. &
+ (PDRYLBDAG_MAX/=XDRYLBDAG_MAX) .OR. (PDRYLBDAS_MAX/=XDRYLBDAS_MAX) .OR. &
+ (PDRYLBDAG_MIN/=XDRYLBDAG_MIN) .OR. (PDRYLBDAS_MIN/=XDRYLBDAS_MIN) .OR. &
+ (PFDINFTY/=ZFDINFTY) ) THEN
+ CALL RZCOLX ( IND, XALPHAG, XNUG, XALPHAS, XNUS, &
+ ZEGS, XBS, XCG, XDG, XCS, XDS, &
+ XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
+ ZFDINFTY, XKER_SDRYG )
+ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF SDRYG KERNELS ****")')
+ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
+ WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAG=",I3)') NDRYLBDAG
+ WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAS=",I3)') NDRYLBDAS
+ WRITE(UNIT=ILUOUT0,FMT='("PALPHAG=",E13.6)') XALPHAG
+ WRITE(UNIT=ILUOUT0,FMT='("PNUG=",E13.6)') XNUG
+ WRITE(UNIT=ILUOUT0,FMT='("PALPHAS=",E13.6)') XALPHAS
+ WRITE(UNIT=ILUOUT0,FMT='("PNUS=",E13.6)') XNUS
+ WRITE(UNIT=ILUOUT0,FMT='("PEGS=",E13.6)') ZEGS
+ WRITE(UNIT=ILUOUT0,FMT='("PBS=",E13.6)') XBS
+ WRITE(UNIT=ILUOUT0,FMT='("PCG=",E13.6)') XCG
+ WRITE(UNIT=ILUOUT0,FMT='("PDG=",E13.6)') XDG
+ WRITE(UNIT=ILUOUT0,FMT='("PCS=",E13.6)') XCS
+ WRITE(UNIT=ILUOUT0,FMT='("PDS=",E13.6)') XDS
+ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MAX=",E13.6)') &
+ XDRYLBDAG_MAX
+ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAS_MAX=",E13.6)') &
+ XDRYLBDAS_MAX
+ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MIN=",E13.6)') &
+ XDRYLBDAG_MIN
+ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAS_MIN=",E13.6)') &
+ XDRYLBDAS_MIN
+ WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_SDRYG) ) THEN")')
+ DO J1 = 1 , NDRYLBDAG
+ DO J2 = 1 , NDRYLBDAS
+ WRITE(UNIT=ILUOUT0,FMT='("PKER_SDRYG(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_SDRYG(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+ ELSE
+ CALL READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
+ PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS, &
+ PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
+ PFDINFTY,XKER_SDRYG )
+ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_SDRYG")')
+END IF
+!
+!
+IND = 50 ! Number of interval used to integrate the dimensional
+ZEGR = 1.0 ! distributions when computing the kernel XKER_RDRYG
+ZFDINFTY = 20.0
+!
+ALLOCATE( XKER_RDRYG(NDRYLBDAG,NDRYLBDAR) )
+!
+CALL READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
+ PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
+ PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, &
+ PFDINFTY )
+IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAR/=NDRYLBDAR) .OR. (KND/=IND) .OR. &
+ (PALPHAG/=XALPHAG) .OR. (PNUG/=XNUG) .OR. &
+ (PALPHAR/=XALPHAR) .OR. (PNUR/=XNUR) .OR. &
+ (PEGR/=ZEGR) .OR. (PBR/=XBR) .OR. &
+ (PCG/=XCG) .OR. (PDG/=XDG) .OR. (PCR/=XCR) .OR. (PDR/=XDR) .OR. &
+ (PDRYLBDAG_MAX/=XDRYLBDAG_MAX) .OR. (PDRYLBDAR_MAX/=XDRYLBDAR_MAX) .OR. &
+ (PDRYLBDAG_MIN/=XDRYLBDAG_MIN) .OR. (PDRYLBDAR_MIN/=XDRYLBDAR_MIN) .OR. &
+ (PFDINFTY/=ZFDINFTY) ) THEN
+ CALL RZCOLX ( IND, XALPHAG, XNUG, XALPHAR, XNUR, &
+ ZEGR, XBR, XCG, XDG, XCR, XDR, &
+ XDRYLBDAG_MAX, XDRYLBDAR_MAX, XDRYLBDAG_MIN, XDRYLBDAR_MIN, &
+ ZFDINFTY, XKER_RDRYG )
+ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF RDRYG KERNELS ****")')
+ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
+ WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAG=",I3)') NDRYLBDAG
+ WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAR=",I3)') NDRYLBDAR
+ WRITE(UNIT=ILUOUT0,FMT='("PALPHAG=",E13.6)') XALPHAG
+ WRITE(UNIT=ILUOUT0,FMT='("PNUG=",E13.6)') XNUG
+ WRITE(UNIT=ILUOUT0,FMT='("PALPHAR=",E13.6)') XALPHAR
+ WRITE(UNIT=ILUOUT0,FMT='("PNUR=",E13.6)') XNUR
+ WRITE(UNIT=ILUOUT0,FMT='("PEGR=",E13.6)') ZEGR
+ WRITE(UNIT=ILUOUT0,FMT='("PBR=",E13.6)') XBR
+ WRITE(UNIT=ILUOUT0,FMT='("PCG=",E13.6)') XCG
+ WRITE(UNIT=ILUOUT0,FMT='("PDG=",E13.6)') XDG
+ WRITE(UNIT=ILUOUT0,FMT='("PCR=",E13.6)') XCR
+ WRITE(UNIT=ILUOUT0,FMT='("PDR=",E13.6)') XDR
+ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MAX=",E13.6)') &
+ XDRYLBDAG_MAX
+ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAR_MAX=",E13.6)') &
+ XDRYLBDAR_MAX
+ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MIN=",E13.6)') &
+ XDRYLBDAG_MIN
+ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAR_MIN=",E13.6)') &
+ XDRYLBDAR_MIN
+ WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_RDRYG) ) THEN")')
+ DO J1 = 1 , NDRYLBDAG
+ DO J2 = 1 , NDRYLBDAR
+ WRITE(UNIT=ILUOUT0,FMT='("PKER_RDRYG(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_RDRYG(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+ ELSE
+ CALL READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
+ PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
+ PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, &
+ PFDINFTY,XKER_RDRYG )
+ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_RDRYG")')
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 9. CONSTANTS FOR THE FAST COLD PROCESSES FOR THE HAILSTONES
+! --------------------------------------------------------
+!
+!* 9.2 Constants for the wet growth of the hailstones
+!
+!
+!* 9.2.1 Constant for the cloud droplet and cloud ice collection
+! by the hailstones
+!
+XFWETH = (XPI/4.0)*XCCH*XCH*(ZRHO00**XCEXVT)*MOMG(XALPHAH,XNUH,XDH+2.0)
+!
+!* 9.2.2 Constants for the aggregate collection by the hailstones
+!
+XFSWETH = (XPI/4.0)*XCCH*XCCS*XAS*(ZRHO00**XCEXVT)
+!
+XLBSWETH1 = MOMG(XALPHAH,XNUH,2.)*MOMG(XALPHAS,XNUS,XBS)
+XLBSWETH2 = 2.*MOMG(XALPHAH,XNUH,1.)*MOMG(XALPHAS,XNUS,XBS+1.)
+XLBSWETH3 = MOMG(XALPHAS,XNUS,XBS+2.)
+!
+!* 9.2.3 Constants for the graupel collection by the hailstones
+!
+XFGWETH = (XPI/4.0)*XCCH*XCCG*XAG*(ZRHO00**XCEXVT)
+!
+XLBGWETH1 = MOMG(XALPHAH,XNUH,2.)*MOMG(XALPHAG,XNUG,XBG)
+XLBGWETH2 = 2.*MOMG(XALPHAH,XNUH,1.)*MOMG(XALPHAG,XNUG,XBG+1.)
+XLBGWETH3 = MOMG(XALPHAG,XNUG,XBG+2.)
+!
+! Notice: One magnitude of lambda discretized over 10 points
+!
+NWETLBDAS = 80
+XWETLBDAS_MIN = 2.5E1 ! Minimal value of Lbda_s to tabulate XKER_SWETH
+XWETLBDAS_MAX = 2.5E9 ! Maximal value of Lbda_s to tabulate XKER_SWETH
+ZRATE = LOG(XWETLBDAS_MAX/XWETLBDAS_MIN)/FLOAT(NWETLBDAS-1)
+XWETINTP1S = 1.0 / ZRATE
+XWETINTP2S = 1.0 - LOG( XWETLBDAS_MIN ) / ZRATE
+NWETLBDAG = 40
+XWETLBDAG_MIN = 1.0E3 ! Min value of Lbda_g to tabulate XKER_GWETH
+XWETLBDAG_MAX = 1.0E7 ! Max value of Lbda_g to tabulate XKER_GWETH
+ZRATE = LOG(XWETLBDAG_MAX/XWETLBDAG_MIN)/FLOAT(NWETLBDAG-1)
+XWETINTP1G = 1.0 / ZRATE
+XWETINTP2G = 1.0 - LOG( XWETLBDAG_MIN ) / ZRATE
+NWETLBDAH = 40
+XWETLBDAH_MIN = 1.0E3 ! Min value of Lbda_h to tabulate XKER_SWETH,XKER_GWETH
+XWETLBDAH_MAX = 1.0E7 ! Max value of Lbda_h to tabulate XKER_SWETH,XKER_GWETH
+ZRATE = LOG(XWETLBDAH_MAX/XWETLBDAH_MIN)/FLOAT(NWETLBDAH-1)
+XWETINTP1H = 1.0 / ZRATE
+XWETINTP2H = 1.0 - LOG( XWETLBDAH_MIN ) / ZRATE
+!
+!* 9.2.4 Computations of the tabulated normalized kernels
+!
+IND = 50 ! Interval number, collection efficiency and infinite diameter
+ZEHS = 1.0 ! factor used to integrate the dimensional distributions when
+ZFDINFTY = 20.0 ! computing the kernels XKER_SWETH
+!
+IF( .NOT.ALLOCATED(XKER_SWETH) ) ALLOCATE( XKER_SWETH(NWETLBDAH,NWETLBDAS) )
+!
+CALL READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
+ PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS, &
+ PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, &
+ PFDINFTY )
+IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAS/=NWETLBDAS) .OR. (KND/=IND) .OR. &
+ (PALPHAH/=XALPHAH) .OR. (PNUH/=XNUH) .OR. &
+ (PALPHAS/=XALPHAS) .OR. (PNUS/=XNUS) .OR. &
+ (PEHS/=ZEHS) .OR. (PBS/=XBS) .OR. &
+ (PCH/=XCH) .OR. (PDH/=XDH) .OR. (PCS/=XCS) .OR. (PDS/=XDS) .OR. &
+ (PWETLBDAH_MAX/=XWETLBDAH_MAX) .OR. (PWETLBDAS_MAX/=XWETLBDAS_MAX) .OR. &
+ (PWETLBDAH_MIN/=XWETLBDAH_MIN) .OR. (PWETLBDAS_MIN/=XWETLBDAS_MIN) .OR. &
+ (PFDINFTY/=ZFDINFTY) ) THEN
+ CALL RZCOLX ( IND, XALPHAH, XNUH, XALPHAS, XNUS, &
+ ZEHS, XBS, XCH, XDH, XCS, XDS, &
+ XWETLBDAH_MAX, XWETLBDAS_MAX, XWETLBDAH_MIN, XWETLBDAS_MIN, &
+ ZFDINFTY, XKER_SWETH )
+ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF SWETH KERNELS ****")')
+ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
+ WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAH=",I3)') NWETLBDAH
+ WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAS=",I3)') NWETLBDAS
+ WRITE(UNIT=ILUOUT0,FMT='("PALPHAH=",E13.6)') XALPHAH
+ WRITE(UNIT=ILUOUT0,FMT='("PNUH=",E13.6)') XNUH
+ WRITE(UNIT=ILUOUT0,FMT='("PALPHAS=",E13.6)') XALPHAS
+ WRITE(UNIT=ILUOUT0,FMT='("PNUS=",E13.6)') XNUS
+ WRITE(UNIT=ILUOUT0,FMT='("PEHS=",E13.6)') ZEHS
+ WRITE(UNIT=ILUOUT0,FMT='("PBS=",E13.6)') XBS
+ WRITE(UNIT=ILUOUT0,FMT='("PCH=",E13.6)') XCH
+ WRITE(UNIT=ILUOUT0,FMT='("PDH=",E13.6)') XDH
+ WRITE(UNIT=ILUOUT0,FMT='("PCS=",E13.6)') XCS
+ WRITE(UNIT=ILUOUT0,FMT='("PDS=",E13.6)') XDS
+ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MAX=",E13.6)') &
+ XWETLBDAH_MAX
+ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAS_MAX=",E13.6)') &
+ XWETLBDAS_MAX
+ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MIN=",E13.6)') &
+ XWETLBDAH_MIN
+ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAS_MIN=",E13.6)') &
+ XWETLBDAS_MIN
+ WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_SWETH) ) THEN")')
+ DO J1 = 1 , NWETLBDAH
+ DO J2 = 1 , NWETLBDAS
+ WRITE(UNIT=ILUOUT0,FMT='("PKER_SWETH(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_SWETH(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+ ELSE
+ CALL READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, &
+ PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS, &
+ PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, &
+ PFDINFTY,XKER_SWETH )
+ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_SWETH")')
+END IF
+!
+!
+IND = 50 ! Number of interval used to integrate the dimensional
+ZEHG = 1.0 ! distributions when computing the kernel XKER_GWETH
+ZFDINFTY = 20.0
+!
+IF( .NOT.ALLOCATED(XKER_GWETH) ) ALLOCATE( XKER_GWETH(NWETLBDAH,NWETLBDAG) )
+!
+CALL READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
+ PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
+ PWETLBDAH_MAX,PWETLBDAG_MAX,PWETLBDAH_MIN,PWETLBDAG_MIN, &
+ PFDINFTY )
+IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAG/=NWETLBDAG) .OR. (KND/=IND) .OR. &
+ (PALPHAH/=XALPHAH) .OR. (PNUH/=XNUH) .OR. &
+ (PALPHAG/=XALPHAG) .OR. (PNUG/=XNUG) .OR. &
+ (PEHG/=ZEHG) .OR. (PBG/=XBG) .OR. &
+ (PCH/=XCH) .OR. (PDH/=XDH) .OR. (PCG/=XCG) .OR. (PDG/=XDG) .OR. &
+ (PWETLBDAH_MAX/=XWETLBDAH_MAX) .OR. (PWETLBDAG_MAX/=XWETLBDAG_MAX) .OR. &
+ (PWETLBDAH_MIN/=XWETLBDAH_MIN) .OR. (PWETLBDAG_MIN/=XWETLBDAG_MIN) .OR. &
+ (PFDINFTY/=ZFDINFTY) ) THEN
+ CALL RZCOLX ( IND, XALPHAH, XNUH, XALPHAG, XNUG, &
+ ZEHG, XBG, XCH, XDH, XCG, XDG, &
+ XWETLBDAH_MAX, XWETLBDAG_MAX, XWETLBDAH_MIN, XWETLBDAG_MIN, &
+ ZFDINFTY, XKER_GWETH )
+ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF GWETH KERNELS ****")')
+ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
+ WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAH=",I3)') NWETLBDAH
+ WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAG=",I3)') NWETLBDAG
+ WRITE(UNIT=ILUOUT0,FMT='("PALPHAH=",E13.6)') XALPHAH
+ WRITE(UNIT=ILUOUT0,FMT='("PNUH=",E13.6)') XNUH
+ WRITE(UNIT=ILUOUT0,FMT='("PALPHAG=",E13.6)') XALPHAG
+ WRITE(UNIT=ILUOUT0,FMT='("PNUG=",E13.6)') XNUG
+ WRITE(UNIT=ILUOUT0,FMT='("PEHG=",E13.6)') ZEHG
+ WRITE(UNIT=ILUOUT0,FMT='("PBG=",E13.6)') XBG
+ WRITE(UNIT=ILUOUT0,FMT='("PCH=",E13.6)') XCH
+ WRITE(UNIT=ILUOUT0,FMT='("PDH=",E13.6)') XDH
+ WRITE(UNIT=ILUOUT0,FMT='("PCG=",E13.6)') XCG
+ WRITE(UNIT=ILUOUT0,FMT='("PDG=",E13.6)') XDG
+ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MAX=",E13.6)') &
+ XWETLBDAH_MAX
+ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAG_MAX=",E13.6)') &
+ XWETLBDAG_MAX
+ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MIN=",E13.6)') &
+ XWETLBDAH_MIN
+ WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAG_MIN=",E13.6)') &
+ XWETLBDAG_MIN
+ WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_GWETH) ) THEN")')
+ DO J1 = 1 , NWETLBDAH
+ DO J2 = 1 , NWETLBDAG
+ WRITE(UNIT=ILUOUT0,FMT='("PKER_GWETH(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_GWETH(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+ ELSE
+ CALL READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, &
+ PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, &
+ PWETLBDAH_MAX,PWETLBDAG_MAX,PWETLBDAH_MIN,PWETLBDAG_MIN, &
+ PFDINFTY,XKER_GWETH )
+ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_GWETH")')
+END IF
+!
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 10. SET-UP RADIATIVE PARAMETERS
+! ---------------------------
+!
+!
+! R_eff_i = XFREFFI * (rho*r_i/N_i)**(1/3)
+!
+XFREFFI = 0.5 * ZGAMI(8) * (1.0/XLBI)**XLBEXI
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 11. SOME PRINTS FOR CONTROL
+! -----------------------
+!
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" Summary of the ice particule characteristics")')
+ WRITE(UNIT=ILUOUT0,FMT='(" PRISTINE ICE")')
+ WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+ XAI,XBI
+ WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+ XC_I,XDI
+ WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+ XALPHAI,XNUI
+ WRITE(UNIT=ILUOUT0,FMT='(" SNOW")')
+ WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+ XAS,XBS
+ WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+ XCS,XDS
+ WRITE(UNIT=ILUOUT0,FMT='(" concentration:CC=",E13.6," x=",E13.6)') &
+ XCCS,XCXS
+ WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+ XALPHAS,XNUS
+ WRITE(UNIT=ILUOUT0,FMT='(" GRAUPEL")')
+ WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+ XAG,XBG
+ WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+ XCG,XDG
+ WRITE(UNIT=ILUOUT0,FMT='(" concentration:CC=",E13.6," x=",E13.6)') &
+ XCCG,XCXG
+ WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+ XALPHAG,XNUG
+END IF
+!
+!------------------------------------------------------------------------------
+!
+END SUBROUTINE INI_LIMA_COLD_MIXED
diff --git a/src/MNH/ini_lima_warm.f90 b/src/MNH/ini_lima_warm.f90
new file mode 100644
index 000000000..53748aa7a
--- /dev/null
+++ b/src/MNH/ini_lima_warm.f90
@@ -0,0 +1,437 @@
+! #########################
+ MODULE MODI_INI_LIMA_WARM
+! #########################
+!
+INTERFACE
+ SUBROUTINE INI_LIMA_WARM (PTSTEP, PDZMIN)
+!
+REAL, INTENT(IN) :: PTSTEP ! Effective Time step
+REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
+!
+END SUBROUTINE INI_LIMA_WARM
+!
+END INTERFACE
+!
+END MODULE MODI_INI_LIMA_WARM
+! #########################################
+ SUBROUTINE INI_LIMA_WARM (PTSTEP, PDZMIN)
+! #########################################
+!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize the constants used in the
+!! microphysical scheme LIMA for the warm phase species and processes.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_REF
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_LIMA_WARM
+USE MODD_PARAMETERS
+USE MODD_LUNIT
+!
+USE MODI_LIMA_FUNCTIONS
+USE MODI_HYPGEO
+USE MODI_GAMMA
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, INTENT(IN) :: PTSTEP ! Effective Time step
+REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IKB ! Coordinates of the first and last physical
+ ! points along z
+INTEGER :: J1 ! Internal loop indexes
+INTEGER :: JMOD ! Internal loop to index the CCN modes
+!
+REAL, DIMENSION(6) :: ZGAMC, ZGAMR ! parameters involving various moments of
+ ! the generalized gamma law
+!
+REAL :: ZTT ! Temperature in Celsius
+REAL :: ZLV ! Latent heat of vaporization
+REAL :: ZSS ! Supersaturation
+REAL :: ZPSI1, ZG ! Psi1 and G functions
+REAL :: ZAHENR ! r_star (FH92)
+REAL :: ZVTRMAX ! Raindrop maximal fall velocity
+REAL :: ZRHO00 ! Surface reference air density
+REAL :: ZSURF_TEN ! Water drop surface tension
+REAL :: ZSMIN, ZSMAX ! Minimal and maximal supersaturation used to
+ ! discretize the HYP functions
+!
+!
+INTEGER :: ILUOUT0 ! Logical unit number for output-listing
+INTEGER :: IRESP ! Return code of FM-routines
+LOGICAL :: GFLAG ! Logical flag for printing the constatnts on the output
+ ! listing
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. CHARACTERISTICS OF THE SPECIES
+! ------------------------------
+!
+!
+!* 1.1 Cloud droplet characteristics
+!
+XAC = (XPI/6.0)*XRHOLW
+XBC = 3.0
+XCC = XRHOLW*XG/(18.0*1.816E-5) ! Stokes flow (Pruppacher p 322 for T=293K)
+XCC = XRHOLW*XG/(18.0*1.7E-5) ! Stokes flow (Pruppacher p 322 for T=273K)
+XDC = 2.0
+!
+XF0C = 1.00
+XF2C = 0.108
+!
+XC1C = 1./2.
+!
+!* 1.2 Raindrops characteristics
+!
+XAR = (XPI/6.0)*XRHOLW
+XBR = 3.0
+XCR = 842.
+XDR = 0.8
+!
+XF0R = 0.780
+!Correction BVIE Pruppacher 1997 eq. 13-61
+!XF1R = 0.265
+XF1R = 0.308
+!
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 2. DIMENSIONAL DISTRIBUTIONS OF THE SPECIES
+! ----------------------------------------
+!
+!
+!* 2.1 Cloud droplet distribution
+!
+!XALPHAC = 3.0 ! Gamma law of the Cloud droplet (here volume-like distribution)
+!XNUC = 3.0 ! Gamma law with little dispersion
+!
+!* 2.2 Raindrop distribution
+!
+!XALPHAR = 3.0 ! Gamma law of the raindrops (here volume-like distribution)
+!XNUR = 3.0 ! Gamma law for the raindrops
+!XNUR = 0.1
+!
+!* 2.3 Precalculation of the gamma function momentum
+!
+!
+ZGAMC(1) = GAMMA_X0D(XNUC)
+ZGAMC(2) = MOMG(XALPHAC,XNUC,3.)
+ZGAMC(3) = MOMG(XALPHAC,XNUC,6.)
+ZGAMC(4) = ZGAMC(3)-ZGAMC(2)**2 ! useful for Sig_c
+ZGAMC(5) = MOMG(XALPHAC,XNUC,9.)
+ZGAMC(6) = MOMG(XALPHAC,XNUC,3.)**(2./3.)/MOMG(XALPHAC,XNUC,2.)
+!
+ZGAMR(1) = GAMMA_X0D(XNUR)
+ZGAMR(2) = MOMG(XALPHAR,XNUR,3.)
+ZGAMR(3) = MOMG(XALPHAR,XNUR,6.)
+ZGAMR(4) = MOMG(XALPHAR,XNUR,6.)
+ZGAMR(5) = MOMG(XALPHAR,XNUR,9.)
+ZGAMR(6) = MOMG(XALPHAR,XNUR,3.)**(2./3.)/MOMG(XALPHAR,XNUR,2.)
+!
+!* 2.4 Csts for the shape parameter
+!
+XLBC = XAR*ZGAMC(2)
+XLBEXC = 1.0/XBC
+XLBR = XAR*ZGAMR(2)
+XLBEXR = 1.0/XBR
+!
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 3. CONSTANTS FOR THE SEDIMENTATION
+! -------------------------------
+!
+!
+!* 4.1 Exponent of the fall-speed air density correction
+!
+IKB = 1 + JPVEXT
+ZRHO00 = XP00/(XRD*XTHVREFZ(IKB))
+!
+!* 4.2 Constants for sedimentation
+!
+XFSEDRR = XCR*GAMMA_X0D(XNUR+(XDR+3.)/XALPHAR)/GAMMA_X0D(XNUR+3./XALPHAR)* &
+ (ZRHO00)**XCEXVT
+XFSEDCR = XCR*GAMMA_X0D(XNUR+XDR/XALPHAR)/GAMMA_X0D(XNUR)* &
+ (ZRHO00)**XCEXVT
+XFSEDRC = XCC*GAMMA_X0D(XNUC+(XDC+3.)/XALPHAC)/GAMMA_X0D(XNUC+3./XALPHAC)* &
+ (ZRHO00)**XCEXVT
+XFSEDCC = XCC*GAMMA_X0D(XNUC+XDC/XALPHAC)/GAMMA_X0D(XNUC)* &
+ (ZRHO00)**XCEXVT
+
+!
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 4. CONSTANTS FOR THE NUCLEATION PROCESS
+! ------------------------------------
+!
+!
+XWMIN = 0.01 ! Minimal positive vertical velocity required
+ ! for the activation process in Twomey and CPB scheme
+XTMIN = -0.000278 ! Minimal cooling required 1K/h
+!
+XDIVA = 226.E-7 ! Diffusivity of water vapor in the air
+XTHCO = 24.3E-3 ! Air thermal conductivity
+!
+! ( 8 Mw (Sigma)sw )3 Pi*Rho_l
+! XCSTDCRIT = ( -------------- ) * --------
+! ( 3 Ra Rhow ) 6
+!
+ZSURF_TEN = 76.1E-3 ! Surface tension of a water drop at T=0 C
+XCSTDCRIT = (XPI/6.)*XRHOLW*( (8.0*ZSURF_TEN )/( 3.0*XRV*XRHOLW ) )**3
+!
+!
+!
+! 4.1 Tabulation of the hypergeometric functions in 'no units'
+! --------------------------------------------------------
+!
+! In LIMA's nucleation parameterization,
+! supersaturation is not in % : Smax=0.01 for a 1% supersaturation.
+! This is accounted for in the modified Beta and C values.
+!
+! Here, we tabulate the
+! F(mu,k/2, k/2+1 ,-Beta S**2) -> XHYPF12
+! F(mu,k/2,(k+3)/2,-Beta S**2) -> XHYPF32 functions
+! using a logarithmic scale for S
+!
+NHYP = 500 ! Number of points for the tabulation
+ALLOCATE (XHYPF12( NHYP, NMOD_CCN ))
+ALLOCATE (XHYPF32( NHYP, NMOD_CCN ))
+!
+ZSMIN = 1.0E-5 ! Minimum supersaturation set at 0.001 %
+ZSMAX = 5.0E-2 ! Maximum supersaturation set at 5 %
+XHYPINTP1 = FLOAT(NHYP-1)/LOG(ZSMAX/ZSMIN)
+XHYPINTP2 = FLOAT(NHYP)-XHYPINTP1*LOG(ZSMAX)
+!
+DO JMOD = 1,NMOD_CCN
+ DO J1 = 1,NHYP
+ ZSS =ZSMAX*(ZSMIN/ZSMAX)**(FLOAT(NHYP-J1)/FLOAT(NHYP-1))
+ XHYPF12(J1,JMOD) = HYPGEO(XMUHEN_MULTI(JMOD),0.5*XKHEN_MULTI(JMOD),&
+ 0.5*XKHEN_MULTI(JMOD)+1.0,XBETAHEN_MULTI(JMOD),ZSS)
+ XHYPF32(J1,JMOD) = HYPGEO(XMUHEN_MULTI(JMOD),0.5*XKHEN_MULTI(JMOD),&
+ 0.5*XKHEN_MULTI(JMOD)+1.5,XBETAHEN_MULTI(JMOD),ZSS)
+ END DO
+ENDDO
+!
+NAHEN = 81 ! Tabulation for each Kelvin degree in the range XTT-40 to XTT+40
+XAHENINTP1 = 1.0
+XAHENINTP2 = 0.5*FLOAT(NAHEN-1) - XTT
+!
+! Compute the tabulation of function of T :
+!
+! 1
+! XAHENG = -----------------------
+! XCSTHEN * G**(3/2)
+!
+! Compute constants for the calculation of Smax.
+! XCSTHEN = 1/(rho_l 2 pi)
+! PSI1
+! PSI3
+! T
+! Lv
+! G
+!
+ALLOCATE (XAHENG(NAHEN))
+ALLOCATE (XPSI1(NAHEN))
+ALLOCATE (XPSI3(NAHEN))
+XCSTHEN = 1.0 / ( XRHOLW*2.0*XPI )
+DO J1 = 1,NAHEN
+ ZTT = XTT + FLOAT(J1-(NAHEN-1)/2) ! T
+ ZLV = XLVTT+(XCPV-XCL)*(ZTT-XTT) ! Lv
+ XPSI1(J1) = (XG/(XRD*ZTT))*(XMV*ZLV/(XMD*XCPD*ZTT)-1.) ! Psi1
+ XPSI3(J1) = -1*XMV*ZLV/(XMD*XRD*(ZTT**2)) ! Psi3
+ ZG = 1./( XRHOLW*( (XRV*ZTT)/ & ! G
+ (XDIVA*EXP(XALPW-(XBETAW/ZTT)-(XGAMW*ALOG(ZTT)))) &
+ + (ZLV/ZTT)**2/(XTHCO*XRV) ) )
+ XAHENG(J1) = XCSTHEN/(ZG)**(3./2.)
+END DO
+!-------------------------------------------------------------------------------
+!
+! Parameters used to initialise the droplet and drop concentration
+! from the respective mixing ratios (used in RESTART_RAIN_C2R2)
+!
+! Droplet case
+!
+!!ALLOCATE(XCONCC_INI(SIZE(PNFS,1),SIZE(PNFS,2),SIZE(PNFS,3),SIZE(PNFS,4))) !NMOD_CCN))
+!! XCONCC_INI(:,:,:,:) = 0.8 * PNFS(:,:,:,:) ! 80% of the maximum CCN conc. is assumed
+!
+! Raindrop case
+!
+XCONCR_PARAM_INI = (1.E7)**3/(XPI*XRHOLW) ! MP law with N_O=1.E7 m-1 is assumed
+!
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 5. CONSTANTS FOR THE COALESCENCE PROCESSES
+! ---------------------------------------
+!
+!
+!* 6.1 Csts for the coalescence processes
+!
+XKERA1 = 2.59E15 ! From Long a1=9.44E9 cm-3 so XKERA1= 9.44E9*1E6*(PI/6)**2
+XKERA2 = 3.03E3 ! From Long a2=5.78E3 so XKERA2= 5.78E3* (PI/6)
+!
+! Cst for the cloud droplet selfcollection process
+!
+XSELFC = XKERA1*ZGAMC(3)
+!
+! Cst for the autoconversion process
+!
+XAUTO1 = 6.25E18*(ZGAMC(2))**(1./3.)*SQRT(ZGAMC(4))
+XAUTO2 = 0.5E6*(ZGAMC(4))**(1./6.)
+XLAUTR = 2.7E-2
+XLAUTR_THRESHOLD = 0.4
+XITAUTR= 0.27 ! (Notice that T2 of BR74 is uncorrect and that 0.27=1./3.7
+XITAUTR_THRESHOLD = 7.5
+XCAUTR = 3.5E9
+!
+! Cst for the accretion process
+!
+XACCR1 = ZGAMR(2)**(1./3.)
+XACCR2 = 5.0E-6
+XACCR3 = 12.6E-4
+XACCR4 = XAUTO2
+XACCR5 = 3.5
+XACCR6 = 1.2*XCAUTR
+XACCR_CLARGE1 = XKERA2*ZGAMC(2)
+XACCR_CLARGE2 = XKERA2*ZGAMR(2)
+XACCR_RLARGE1 = XKERA2*ZGAMC(3)*XRHOLW*(XPI/6.0)
+XACCR_RLARGE2 = XKERA2*ZGAMC(2)*ZGAMR(2)*XRHOLW*(XPI/6.0)
+XACCR_CSMALL1 = XKERA1*ZGAMC(3)
+XACCR_CSMALL2 = XKERA1*ZGAMR(3)
+XACCR_RSMALL1 = XKERA1*ZGAMC(5)*XRHOLW*(XPI/6.0)
+XACCR_RSMALL2 = XKERA1*ZGAMC(2)*ZGAMR(3)*XRHOLW*(XPI/6.0)
+!
+! Cst for the raindrop self-collection/breakup process
+!
+XSCBU2 = XKERA2*ZGAMR(2)
+XSCBU3 = XKERA1*ZGAMR(3)
+XSCBU_EFF1 = 0.6E-3
+XSCBU_EFF2 = 2.0E-3
+XSCBUEXP1 = -2500.0
+!
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 6. CONSTANTS FOR THE "SONTANEOUS" BREAK-UP
+! ---------------------------------------
+!
+!
+XSPONBUD1 = 3.0E-3
+XSPONBUD2 = 4.0E-3
+XSPONBUD3 = 5.0E-3
+XSPONCOEF2 = ((XSPONBUD3/XSPONBUD2)**3 - 1.0)/(XSPONBUD3-XSPONBUD1)**2
+!
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 7. CONSTANTS FOR EVAPORATION PROCESS
+! ---------------------------------------
+!
+!
+X0CNDC = (4.0*XPI)*XC1C*XF0C*MOMG(XALPHAC,XNUC,1.)
+X2CNDC = (4.0*XPI)*XC1C*XF2C*XCC*MOMG(XALPHAC,XNUC,XDC+2.0)
+!
+! Valeurs utiles pour le calcul de l'évaporation en fonction de N_r
+!
+!XEX0EVAR = -1.0
+!XEX1EVAR = -1.0 - (XDR+1.0)*0.5
+!XEX2EVAR = -0.5*XCEXVT
+!
+!X0EVAR = (2.0*XPI)*XF0R*GAMMA_X0D(XNUR+1./XALPHAR)/GAMMA_X0D(XNUR)
+!X1EVAR = (2.0*XPI)*XF1R*((ZRHO00)**(XCEXVT)*(XCR/0.15E-4))**0.5* &
+! GAMMA_X0D(XNUR+(XDR+3.0)/(2.0*XALPHAR))/GAMMA_X0D(XNUR)
+!
+!
+! Valeurs utiles pour le calcul de l'évaporation en fonction de r_r
+!
+XEX0EVAR = 2.0
+XEX1EVAR = 2.0 - (XDR+1.0)*0.5
+XEX2EVAR = -0.5*XCEXVT
+!
+X0EVAR = (12.0)*XF0R*GAMMA_X0D(XNUR+1./XALPHAR)/GAMMA_X0D(XNUR+3./XALPHAR)
+X1EVAR = (12.0)*XF1R*((ZRHO00)**(XCEXVT)*(XCR/0.15E-4))**0.5* &
+ GAMMA_X0D(XNUR+(XDR+3.0)/(2.0*XALPHAR))/GAMMA_X0D(XNUR+3./XALPHAR)
+!
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 8. SET-UP RADIATIVE PARAMETERS
+! ---------------------------
+!
+!
+! R_eff_c = XFREFFC * (rho*r_c/N_c)**(1/3)
+!
+!
+XFREFFC = 0.5 * ZGAMC(6) * (1.0/XAC)**(1.0/3.0)
+XFREFFR = 0.5 * ZGAMR(6) * (1.0/XAR)**(1.0/3.0)
+!
+! Coefficients used to compute reff when both cloud and rain are present
+!
+XCREC = 1.0/ (ZGAMC(6) * XAC**(2.0/3.0))
+XCRER = 1.0/ (ZGAMR(6) * XAR**(2.0/3.0))
+!
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 9. SOME PRINTS FOR CONTROL
+! -----------------------
+!
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT0,IRESP)
+ WRITE(UNIT=ILUOUT0,FMT='(" Summary of the cloud particule characteristics")')
+ WRITE(UNIT=ILUOUT0,FMT='(" CLOUD")')
+ WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+ XAR,XBR
+ WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+ XCC,XDC
+ WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+ XALPHAC,XNUC
+ WRITE(UNIT=ILUOUT0,FMT='(" RAIN")')
+ WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+ XAR,XBR
+ WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+ XCR,XDR
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+!!$ XALPHAR,XNUR
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Description of the nucleation spectrum")')
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" C=",E13.6," k=",E13.6)') XCHEN, XKHEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" Beta=",E13.6," MU=",E13.6)') XBETAHEN, XMUHEN
+!!$ WRITE(UNIT=ILUOUT0,FMT='(" CCN max=",E13.6)') XCONC_CCN
+END IF
+!
+!------------------------------------------------------------------------------
+!
+END SUBROUTINE INI_LIMA_WARM
diff --git a/src/MNH/init_aerosol_concentration.f90 b/src/MNH/init_aerosol_concentration.f90
new file mode 100644
index 000000000..3ff2fef9b
--- /dev/null
+++ b/src/MNH/init_aerosol_concentration.f90
@@ -0,0 +1,152 @@
+!######################################
+ MODULE MODI_INIT_AEROSOL_CONCENTRATION
+!######################################
+!
+INTERFACE INIT_AEROSOL_CONCENTRATION
+ SUBROUTINE INIT_AEROSOL_CONCENTRATION(PRHODREF, PSVT, PZZ)
+!
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF !Air Density [kg/m**3]
+ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT !Particles Concentration [/m**3]
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+!
+ END SUBROUTINE INIT_AEROSOL_CONCENTRATION
+END INTERFACE INIT_AEROSOL_CONCENTRATION
+!
+END MODULE MODI_INIT_AEROSOL_CONCENTRATION
+!
+! ##########################################################
+ SUBROUTINE INIT_AEROSOL_CONCENTRATION(PRHODREF, PSVT, PZZ)
+! ##########################################################
+!!
+!! PURPOSE
+!! -------
+!! Define the aerosol distributions
+!!
+!!
+!! MODD_BLANK :
+!! CDUMMY2 : CCN ou IFN pour le panache
+!! NDUMMY1 : hauteur base du panache
+!! NDUMMY2 : hauteur sommet du panache
+!! XDUMMY8 : Concentration du panache (N/cm3 pour des CCN, N/L pour des IFN)
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! Modification 01/2016 (JP Pinty) Add LIMA
+!!
+!!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_NSV
+USE MODD_PARAM_n, ONLY : CCLOUD
+USE MODD_PARAM_LIMA, ONLY : LWARM, LACTI, NMOD_CCN, LSCAV, LAERO_MASS, &
+ XCCN_CONC, LCCN_HOM, &
+ LCOLD, LNUCL, NMOD_IFN, LMEYERS, &
+ XIFN_CONC, LIFN_HOM
+USE MODD_PARAMETERS, ONLY : JPVEXT
+USE MODD_BLANK, ONLY : CDUMMY2, NDUMMY1, NDUMMY2, XDUMMY8
+!
+IMPLICIT NONE
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF !Air Density [kg/m**3]
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT !Particles Concentration
+ ![particles/kg of dry air]
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+!
+! Local variables
+INTEGER :: JMOD_IFN
+INTEGER :: JSV, JINIT
+INTEGER :: IKB, IKE
+!
+!-------------------------------------------------------------------------------
+!
+!
+!*initialization of N_FREE_CCN/N_ACTIVATED_CCN et N_FREE_IN/N_ACTIVATED_IN
+!
+!
+IF ( LWARM .AND. LACTI ) THEN
+ DO JSV = NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI+NMOD_CCN-1
+ PSVT(:,:,:,JSV) = 0.0
+ ENDDO
+ IKB = 1+JPVEXT
+ IKE = SIZE(PSVT,3)-JPVEXT
+!
+! Initialisation des concentrations en CCN
+!
+!
+ IF (LCCN_HOM) THEN
+! concentration homogène (en nombre par m3) sur la verticale
+ DO JSV = 1, NMOD_CCN
+ PSVT(:,:,IKB:IKE,NSV_LIMA_CCN_FREE+JSV-1) = &
+ XCCN_CONC(JSV)*1.0E6 / PRHODREF(:,:,IKB:IKE)
+ END DO
+ ELSE
+! concentration décroissante selon z
+ DO JSV = 1, NMOD_CCN
+ WHERE (PZZ(:,:,:) .LE. 1000.)
+ PSVT(:,:,:,NSV_LIMA_CCN_FREE+JSV-1) = XCCN_CONC(JSV)*1.0E6 / PRHODREF(:,:,:)
+ ELSEWHERE (PZZ(:,:,:) .LE. 10000.)
+ PSVT(:,:,:,NSV_LIMA_CCN_FREE+JSV-1) = XCCN_CONC(JSV)*1.0E6 &
+ / PRHODREF(:,:,:) * EXP(-LOG(XCCN_CONC(JSV)/0.01)*PZZ(:,:,:)/10000.)
+ ELSEWHERE
+ PSVT(:,:,:,NSV_LIMA_CCN_FREE+JSV-1) = 0.01*1.0E6 / PRHODREF(:,:,:)
+ ENDWHERE
+ END DO
+ ENDIF
+END IF ! LWARM AND LACTI
+!
+! Initialisation des concentrations en IFN
+!
+IF ( LCOLD .AND. LNUCL .AND. (.NOT. LMEYERS) ) THEN
+ DO JSV = NSV_LIMA_IFN_FREE, NSV_LIMA_IFN_NUCL+NMOD_IFN-1
+ PSVT(:,:,:,JSV) = 0.0
+ ENDDO
+ IKB = 1+JPVEXT
+ IKE = SIZE(PSVT,3)-JPVEXT
+!
+ IF (LIFN_HOM) THEN
+! concentration homogène (en nombre par m3) sur la verticale
+ DO JSV = 1, NMOD_IFN
+ PSVT(:,:,IKB:IKE,NSV_LIMA_IFN_FREE+JSV-1) = &
+ XIFN_CONC(JSV)*1.0E3 / PRHODREF(:,:,IKB:IKE)
+ END DO
+ ELSE
+! concentration décroissante selon z
+ DO JSV = 1, NMOD_IFN
+ WHERE (PZZ(:,:,:) .LE. 1000.)
+ PSVT(:,:,:,NSV_LIMA_IFN_FREE+JSV-1) = XIFN_CONC(JSV)*1.0E3 / PRHODREF(:,:,:)
+ ELSEWHERE (PZZ(:,:,:) .LE. 10000.)
+ PSVT(:,:,:,NSV_LIMA_IFN_FREE+JSV-1) = XIFN_CONC(JSV)*1.0E3 &
+ / PRHODREF(:,:,:) * EXP(-LOG(XIFN_CONC(JSV)/1.)*PZZ(:,:,:)/10000.)
+ ELSEWHERE
+ PSVT(:,:,:,NSV_LIMA_IFN_FREE+JSV-1) = 1*1.0E3 / PRHODREF(:,:,:)
+ ENDWHERE
+ END DO
+ ENDIF
+END IF ! LCOLD AND LNUCL AND NOT LMEYERS
+!
+!
+! Cas d'un panache de "pollution", concentration homogène dans le panache :
+!
+SELECT CASE (CDUMMY2)
+ CASE ('CCN')
+ PSVT(:,:,:,NSV_LIMA_CCN_FREE+NMOD_CCN-1)=0.
+ WHERE ( (PZZ(:,:,:) .GE. NDUMMY1) .AND. (PZZ(:,:,:) .LE. NDUMMY2) ) &
+ PSVT(:,:,:,NSV_LIMA_CCN_FREE+NMOD_CCN-1)=XDUMMY8*1.0E6 / PRHODREF(:,:,:)
+ CASE ('IFN')
+ PSVT(:,:,:,NSV_LIMA_IFN_FREE+NMOD_IFN-1)=0.
+ WHERE ( (PZZ(:,:,:) .GE. NDUMMY1) .AND. (PZZ(:,:,:) .LE. NDUMMY2) ) &
+ PSVT(:,:,:,NSV_LIMA_IFN_FREE+NMOD_IFN-1)=XDUMMY8*1.0E3 / PRHODREF(:,:,:)
+END SELECT
+!
+!
+END SUBROUTINE INIT_AEROSOL_CONCENTRATION
diff --git a/src/MNH/init_aerosol_properties.f90 b/src/MNH/init_aerosol_properties.f90
new file mode 100644
index 000000000..cdce0986f
--- /dev/null
+++ b/src/MNH/init_aerosol_properties.f90
@@ -0,0 +1,341 @@
+! #############################################################
+ SUBROUTINE INIT_AEROSOL_PROPERTIES
+! #############################################################
+
+!!
+!!
+!! PURPOSE
+!! -------
+!!
+!! Define the aerosol properties
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAM_n, ONLY : CCLOUD
+USE MODD_LUNIT, ONLY : CLUOUT0
+USE MODD_PARAM_LIMA, ONLY : LWARM, LACTI, NMOD_CCN, HINI_CCN, HTYPE_CCN, &
+ XR_MEAN_CCN, XLOGSIG_CCN, XRHO_CCN, &
+ XKHEN_MULTI, XMUHEN_MULTI, XBETAHEN_MULTI, &
+ XLIMIT_FACTOR, CCCN_MODES, LSCAV, &
+ XACTEMP_CCN, XFSOLUB_CCN, &
+ LCOLD, LNUCL, NMOD_IFN, NSPECIE, CIFN_SPECIES, &
+ XMDIAM_IFN, XSIGMA_IFN, XRHO_IFN, XFRAC, XFRAC_REF, &
+ CINT_MIXING, NMOD_IMM, NINDICE_CCN_IMM, NIMM, &
+ NPHILLIPS
+!
+USE MODI_GAMMA
+!
+IMPLICIT NONE
+!
+REAL :: XKHEN0
+REAL :: XLOGSIG0
+REAL :: XALPHA1
+REAL :: XMUHEN0
+REAL :: XALPHA2
+REAL :: XBETAHEN0
+REAL :: XR_MEAN0
+REAL :: XALPHA3
+REAL :: XALPHA4
+REAL :: XALPHA5
+REAL :: XACTEMP0
+REAL :: XALPHA6
+!
+REAL, DIMENSION(6) :: XKHEN_TMP = (/1.56, 1.56, 1.56, 1.56, 1.56, 1.56 /)
+REAL, DIMENSION(6) :: XMUHEN_TMP = (/0.80, 0.80, 0.80, 0.80, 0.80, 0.80 /)
+REAL, DIMENSION(6) :: XBETAHEN_TMP= (/136., 136., 136., 136., 136., 136. /)
+!
+REAL, DIMENSION(3) :: RCCN
+REAL, DIMENSION(3) :: LOGSIGCCN
+REAL, DIMENSION(3) :: RHOCCN
+!
+INTEGER :: I,J,JMOD
+!
+INTEGER :: ILUOUT0 ! Logical unit number for output-listing
+INTEGER :: IRESP ! Return code of FM-routines
+
+!
+!-------------------------------------------------------------------------------
+!
+CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT0,IRESP)
+!
+!!!!!!!!!!!!!!!!
+! CCN properties
+!!!!!!!!!!!!!!!!
+!
+IF ( NMOD_CCN .GE. 1 ) THEN
+!
+ IF (.NOT.(ALLOCATED(XR_MEAN_CCN))) ALLOCATE(XR_MEAN_CCN(NMOD_CCN))
+ IF (.NOT.(ALLOCATED(XLOGSIG_CCN))) ALLOCATE(XLOGSIG_CCN(NMOD_CCN))
+ IF (.NOT.(ALLOCATED(XRHO_CCN))) ALLOCATE(XRHO_CCN(NMOD_CCN))
+!
+ SELECT CASE (CCCN_MODES)
+ CASE ('JUNGFRAU')
+ RCCN(:) = (/ 0.02E-6 , 0.058E-6 , 0.763E-6 /)
+ LOGSIGCCN(:) = (/ 0.28 , 0.57 , 0.34 /)
+ RHOCCN(:) = (/ 1500. , 1500. , 1500. /)
+ CASE ('COPT')
+ RCCN(:) = (/ 0.125E-6 , 0.4E-6 , 1.0E-6 /)
+ LOGSIGCCN(:) = (/ 0.69 , 0.41 , 0.47 /)
+ RHOCCN(:) = (/ 1000. , 1000. , 1000. /)
+ CASE ('MACC')
+ RCCN(:) = (/ 0.4E-6 , 0.25E-6 , 0.1E-6 /)
+ LOGSIGCCN(:) = (/ 0.64 , 0.47 , 0.47 /)
+ RHOCCN(:) = (/ 2160. , 2000. , 1750. /)
+ CASE ('MACC_JPP')
+! sea-salt, sulfate, hydrophilic (GADS data)
+ RCCN(:) = (/ 0.209E-6 , 0.0695E-6 , 0.0212E-6 /)
+ LOGSIGCCN(:) = (/ 0.708 , 0.708 , 0.806 /)
+ RHOCCN(:) = (/ 2200. , 1700. , 1800. /)
+ CASE ('SIRTA')
+ RCCN(:) = (/ 0.153E-6 , 0.058E-6 , 0.763E-6 /)
+ LOGSIGCCN(:) = (/ 0.846 , 0.57 , 0.34 /)
+ RHOCCN(:) = (/ 1500. , 1500. , 1500. /)
+ CASE ('CPS00')
+ RCCN(:) = (/ 0.0218E-6 , 0.058E-6 , 0.763E-6 /)
+ LOGSIGCCN(:) = (/ 1.16 , 0.57 , 0.34 /)
+ RHOCCN(:) = (/ 1500. , 1500. , 1500. /)
+ CASE DEFAULT
+! d'après Jaenicke 1993, aerosols troposphere libre, masse volumique typique
+ RCCN(:) = (/ 0.0035E-6 , 0.125E-6 , 0.26E-6 /)
+ LOGSIGCCN(:) = (/ 0.645 , 0.253 , 0.425 /)
+ RHOCCN(:) = (/ 1000. , 1000. , 1000. /)
+ ENDSELECT
+!
+ DO I=1, MIN(NMOD_CCN,3)
+ XR_MEAN_CCN(I) = RCCN(I)
+ XLOGSIG_CCN(I) = LOGSIGCCN(I)
+ XRHO_CCN(I) = RHOCCN(I)
+ END DO
+!
+ IF (NMOD_CCN .EQ. 4) THEN
+! default values as coarse sea salt mode
+ XR_MEAN_CCN(4) = 1.75E-6
+ XLOGSIG_CCN(4) = 0.708
+ XRHO_CCN(4) = 2200.
+ END IF
+!
+!
+! Compute CCN spectra parameters from CCN characteristics
+!
+!* INPUT : XBETAHEN_TEST is in 'percent' and XBETAHEN_MULTI in 'no units',
+! XK... and XMU... are invariant
+!
+ IF (.NOT.(ALLOCATED(XKHEN_MULTI))) ALLOCATE(XKHEN_MULTI(NMOD_CCN))
+ IF (.NOT.(ALLOCATED(XMUHEN_MULTI))) ALLOCATE(XMUHEN_MULTI(NMOD_CCN))
+ IF (.NOT.(ALLOCATED(XBETAHEN_MULTI))) ALLOCATE(XBETAHEN_MULTI(NMOD_CCN))
+ IF (.NOT.(ALLOCATED(XLIMIT_FACTOR))) ALLOCATE(XLIMIT_FACTOR(NMOD_CCN))
+!
+ IF (HINI_CCN == 'CCN'.AND. (.NOT. LSCAV) ) THEN
+! Numerical initialization without dependence on AP physical properties
+100 DO JMOD = 1, NMOD_CCN
+ XKHEN_MULTI(JMOD) = XKHEN_TMP(JMOD)
+ XMUHEN_MULTI(JMOD) = XMUHEN_TMP(JMOD)
+ XBETAHEN_MULTI(JMOD) = XBETAHEN_TMP(JMOD)*(100.)**2
+! no units relative to smax
+ XLIMIT_FACTOR(JMOD) = ( GAMMA_X0D(0.5*XKHEN_MULTI(JMOD)+1.)&
+ *GAMMA_X0D(XMUHEN_MULTI(JMOD)-0.5*XKHEN_MULTI(JMOD)) ) &
+ /( XBETAHEN_MULTI(JMOD)**(0.5*XKHEN_MULTI(JMOD)) &
+ *GAMMA_X0D(XMUHEN_MULTI(JMOD)) ) ! N/C
+ END DO
+ ELSE IF (HINI_CCN == 'CCN'.AND. LSCAV ) THEN
+! Attention !
+ WRITE(UNIT=ILUOUT0,FMT='("You are using a numerical initialization &
+ not depending on the aerosol properties, however you need it for &
+ scavenging. &
+ With LSCAV = true, HINI_CCN should be set to AER for consistency")')
+ go to 100
+ ELSE IF (HINI_CCN == 'AER') THEN
+!
+! Initialisation depending on aerosol physical properties
+!
+! First, computing k, mu, beta, and XLIMIT_FACTOR as in CPS2000 (eqs 9a-9c)
+!
+! XLIMIT_FACTOR replaces C, because C depends on the CCN number concentration
+! which is therefore determined at each grid point and time step as
+! Nccn / XLIMIT_FACTOR
+!
+ DO JMOD = 1, NMOD_CCN
+!
+ SELECT CASE (HTYPE_CCN(JMOD))
+ CASE ('M') ! CCN marins
+ XKHEN0 = 3.251
+ XLOGSIG0 = 0.4835
+ XALPHA1 = -1.297
+ XMUHEN0 = 2.589
+ XALPHA2 = -1.511
+ XBETAHEN0 = 621.689
+ XR_MEAN0 = 0.133E-6
+ XALPHA3 = 3.002
+ XALPHA4 = 1.081
+ XALPHA5 = 1.0
+ XACTEMP0 = 290.16
+ XALPHA6 = 2.995
+ CASE ('C') ! CCN continentaux
+ XKHEN0 = 1.403
+ XLOGSIG0 = 1.16
+ XALPHA1 = -1.172
+ XMUHEN0 = 0.834
+ XALPHA2 = -1.350
+ XBETAHEN0 = 25.499
+ XR_MEAN0 = 0.0218E-6
+ XALPHA3 = 3.057
+ XALPHA4 = 4.092
+ XALPHA5 = 1.011
+ XACTEMP0 = 290.16
+ XALPHA6 = 3.076
+ CASE DEFAULT
+ WRITE(UNIT=ILUOUT0,FMT='("You must specify HTYPE_CNN(JMOD)=C or M &
+ in EXSEG1.nam for each CCN mode")')
+ CALL ABORT
+ ENDSELECT
+!
+ XKHEN_MULTI(JMOD) = XKHEN0*(XLOGSIG_CCN(JMOD)/XLOGSIG0)**XALPHA1
+ XMUHEN_MULTI(JMOD) = XMUHEN0*(XLOGSIG_CCN(JMOD)/XLOGSIG0)**XALPHA2
+ XBETAHEN_MULTI(JMOD)=XBETAHEN0*(XR_MEAN_CCN(JMOD)/XR_MEAN0)**XALPHA3 &
+ * EXP( XALPHA4*((XLOGSIG_CCN(JMOD)/XLOGSIG0)-1.) ) &
+ * XFSOLUB_CCN**XALPHA5 &
+ * (XACTEMP_CCN/XACTEMP0)**XALPHA6
+ XLIMIT_FACTOR(JMOD) = ( GAMMA_X0D(0.5*XKHEN_MULTI(JMOD)+1.) &
+ *GAMMA_X0D(XMUHEN_MULTI(JMOD)-0.5*XKHEN_MULTI(JMOD)) ) &
+ /( XBETAHEN_MULTI(JMOD)**(0.5*XKHEN_MULTI(JMOD)) &
+ *GAMMA_X0D(XMUHEN_MULTI(JMOD)) )
+ ENDDO
+!
+! These parameters are correct for a nucleation spectra
+! Nccn(Smax) = C Smax^k F(mu,k/2,1+k/2,-beta Smax^2)
+! with Smax expressed in % (Smax=1 for a supersaturation of 1%).
+!
+! All the computations in LIMA are done for an adimensional Smax (Smax=0.01 for
+! a 1% supersaturation). So beta and C (XLIMIT_FACTOR) are changed :
+! new_beta = beta * 100^2
+! new_C = C * 100^k (ie XLIMIT_FACTOR = XLIMIT_FACTOR / 100^k)
+!
+ XBETAHEN_MULTI(:) = XBETAHEN_MULTI(:) * 10000
+ XLIMIT_FACTOR(:) = XLIMIT_FACTOR(:) / (100**XKHEN_MULTI(:))
+ END IF
+END IF ! NMOD_CCN > 0
+!
+!!!!!!!!!!!!!!!!
+! IFN properties
+!!!!!!!!!!!!!!!!
+!
+IF ( NMOD_IFN .GE. 1 ) THEN
+ SELECT CASE (CIFN_SPECIES)
+ CASE ('MACC_JPP')
+! sea-salt, sulfate, hydrophilic (GADS data)
+! 2 species, dust-metallic and hydrophobic (as BC)
+! (Phillips et al. 2013 and GADS data)
+ NSPECIE = 4 ! DM1, DM2, BC, BIO+(O)
+ IF (.NOT.(ALLOCATED(XMDIAM_IFN))) ALLOCATE(XMDIAM_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XSIGMA_IFN))) ALLOCATE(XSIGMA_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XRHO_IFN))) ALLOCATE(XRHO_IFN(NSPECIE))
+ XMDIAM_IFN = (/0.8E-6, 3.0E-6, 0.025E-6, 0.2E-6/)
+ XSIGMA_IFN = (/2.0, 2.15, 2.0, 1.6 /)
+ XRHO_IFN = (/2600., 2600., 1000., 1500./)
+ CASE DEFAULT
+ IF (NPHILLIPS == 8) THEN
+! 4 species, according to Phillips et al. 2008
+ NSPECIE = 4
+ IF (.NOT.(ALLOCATED(XMDIAM_IFN))) ALLOCATE(XMDIAM_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XSIGMA_IFN))) ALLOCATE(XSIGMA_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XRHO_IFN))) ALLOCATE(XRHO_IFN(NSPECIE))
+ XMDIAM_IFN = (/0.8E-6, 3.0E-6, 0.2E-6, 0.2E-6/)
+ XSIGMA_IFN = (/1.9, 1.6, 1.6, 1.6 /)
+ XRHO_IFN = (/2300., 2300., 1860., 1500./)
+ ELSE IF (NPHILLIPS == 13) THEN
+! 4 species, according to Phillips et al. 2013
+ NSPECIE = 4
+ IF (.NOT.(ALLOCATED(XMDIAM_IFN))) ALLOCATE(XMDIAM_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XSIGMA_IFN))) ALLOCATE(XSIGMA_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XRHO_IFN))) ALLOCATE(XRHO_IFN(NSPECIE))
+ XMDIAM_IFN = (/0.8E-6, 3.0E-6, 90.E-9, 0.163E-6/)
+ XSIGMA_IFN = (/1.9, 1.6, 1.6, 2.54 /)
+ XRHO_IFN = (/2300., 2300., 1860., 1000./)
+ END IF
+ ENDSELECT
+!
+! internal mixing
+!
+ IF (.NOT.(ALLOCATED(XFRAC))) ALLOCATE(XFRAC(NSPECIE,NMOD_IFN))
+ XFRAC(:,:)=0.
+ SELECT CASE (CINT_MIXING)
+ CASE ('DM1')
+ XFRAC(1,:)=1.
+ CASE ('DM2')
+ XFRAC(2,:)=1.
+ CASE ('BC')
+ XFRAC(3,:)=1.
+ CASE ('O')
+ XFRAC(4,:)=1.
+ CASE ('MACC')
+ XFRAC(1,1)=0.99
+ XFRAC(2,1)=0.01
+ XFRAC(3,1)=0.
+ XFRAC(4,1)=0.
+ XFRAC(1,2)=0.
+ XFRAC(2,2)=0.
+ XFRAC(3,2)=0.5
+ XFRAC(4,2)=0.5
+ CASE ('MACC_JPP')
+ XFRAC(1,1)=1.0
+ XFRAC(2,1)=0.0
+ XFRAC(3,1)=0.0
+ XFRAC(4,1)=0.0
+ XFRAC(1,2)=0.0
+ XFRAC(2,2)=0.0
+ XFRAC(3,2)=0.5
+ XFRAC(4,2)=0.5
+ CASE DEFAULT
+ XFRAC(1,:)=0.6
+ XFRAC(2,:)=0.009
+ XFRAC(3,:)=0.33
+ XFRAC(4,:)=0.06
+ ENDSELECT
+!
+! Phillips 08 alpha (table 1)
+ IF (.NOT.(ALLOCATED(XFRAC_REF))) ALLOCATE(XFRAC_REF(4))
+ IF (NPHILLIPS == 13) THEN
+ XFRAC_REF(1)=0.66
+ XFRAC_REF(2)=0.66
+ XFRAC_REF(3)=0.31
+ XFRAC_REF(4)=0.03
+ ELSE IF (NPHILLIPS == 8) THEN
+ XFRAC_REF(1)=0.66
+ XFRAC_REF(2)=0.66
+ XFRAC_REF(3)=0.28
+ XFRAC_REF(4)=0.06
+ END IF
+!
+! Immersion modes
+!
+ IF (.NOT.(ALLOCATED(NIMM))) ALLOCATE(NIMM(NMOD_CCN))
+ NIMM(:)=0
+ IF (ALLOCATED(NINDICE_CCN_IMM)) DEALLOCATE(NINDICE_CCN_IMM)
+ ALLOCATE(NINDICE_CCN_IMM(MAX(1,NMOD_IMM)))
+ IF (NMOD_IMM .GE. 1) THEN
+ DO J = 0, NMOD_IMM-1
+ NIMM(NMOD_CCN-J)=1
+ NINDICE_CCN_IMM(NMOD_IMM-J) = NMOD_CCN-J
+ END DO
+! ELSE IF (NMOD_IMM == 0) THEN ! PNIS existe mais vaut 0, pour l'appel à resolved_cloud
+! NMOD_IMM = 1
+! NINDICE_CCN_IMM(1) = 0
+ END IF
+!
+END IF ! NMOD_IFN > 0
+!
+END SUBROUTINE INIT_AEROSOL_PROPERTIES
diff --git a/src/MNH/lima_adjust.f90 b/src/MNH/lima_adjust.f90
new file mode 100644
index 000000000..02450c133
--- /dev/null
+++ b/src/MNH/lima_adjust.f90
@@ -0,0 +1,1216 @@
+! #######################
+ MODULE MODI_LIMA_ADJUST
+! #######################
+!
+INTERFACE
+!
+ SUBROUTINE LIMA_ADJUST(KRR, KMI, HFMFILE, HLUOUT, HRAD, &
+ HTURBDIM, OCLOSE_OUT, OSUBG_COND, PTSTEP, &
+ PRHODREF, PRHODJ, PEXNREF, PPABSM, PSIGS, PPABST, &
+ PRT, PRS, PSVT, PSVS, &
+ PTHS, PSRCS, PCLDFR )
+ !
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KMI ! Model index
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+CHARACTER*4, INTENT(IN) :: HTURBDIM ! Dimensionality of the
+ ! turbulence scheme
+CHARACTER*4, INTENT(IN) :: HRAD ! Radiation scheme name
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
+ ! the OUTPUT FM-file
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
+ ! Condensation
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Dry density of the
+ ! reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Absolute Pressure at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
+!
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+!
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at t
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentration source
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! Cloud fraction
+!
+END SUBROUTINE LIMA_ADJUST
+!
+END INTERFACE
+!
+END MODULE MODI_LIMA_ADJUST
+!
+! ##########################################################################
+ SUBROUTINE LIMA_ADJUST(KRR, KMI, HFMFILE, HLUOUT, HRAD, &
+ HTURBDIM, OCLOSE_OUT, OSUBG_COND, PTSTEP, &
+ PRHODREF, PRHODJ, PEXNREF, PPABSM, PSIGS, PPABST, &
+ PRT, PRS, PSVT, PSVS, &
+ PTHS, PSRCS, PCLDFR )
+! ##########################################################################
+!
+!!**** *MIMA_ADJUST* - compute the fast microphysical sources
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the fast microphysical sources
+!! through an explict scheme and a saturation ajustement procedure.
+!!
+!!
+!!** METHOD
+!! ------
+!! Reisin et al., 1996 for the explicit scheme when ice is present
+!! Langlois, Tellus, 1973 for the implict adjustment for the cloud water
+!! (refer also to book 1 of the documentation).
+!!
+!! Computations are done separately for three cases :
+!! - ri>0 and rc=0
+!! - rc>0 and ri=0
+!! - ri>0 and rc>0
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST
+!! XP00 ! Reference pressure
+!! XMD,XMV ! Molar mass of dry air and molar mass of vapor
+!! XRD,XRV ! Gaz constant for dry air, gaz constant for vapor
+!! XCPD,XCPV ! Cpd (dry air), Cpv (vapor)
+!! XCL ! Cl (liquid)
+!! XTT ! Triple point temperature
+!! XLVTT ! Vaporization heat constant
+!! XALPW,XBETAW,XGAMW ! Constants for saturation vapor
+!! ! pressure function
+!! Module MODD_CONF
+!! CCONF
+!! Module MODD_BUDGET:
+!! NBUMOD
+!! CBUTYPE
+!! NBUPROCCTR
+!! LBU_RTH
+!! LBU_RRV
+!! LBU_RRC
+!! Module MODD_LES : NCTR_LES,LTURB_LES,NMODNBR_LES
+!! XNA declaration (cloud fraction as global var)
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book 1 and Book2 of documentation ( routine FAST_TERMS )
+!! Langlois, Tellus, 1973
+!!
+!! AUTHOR
+!! ------
+!! E. Richard * Laboratoire d'Aerologie*
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! C. Barthe * LACy* jan. 2014 add budgets
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+USE MODD_CST
+USE MODD_CONF
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_LIMA_WARM
+USE MODD_PARAM_LIMA_COLD
+USE MODD_PARAM_LIMA_MIXED
+USE MODD_NSV
+USE MODD_BUDGET
+!
+USE MODI_CONDENS
+USE MODI_BUDGET
+USE MODI_LIMA_FUNCTIONS
+!
+USE MODE_FM
+USE MODE_FMWRIT
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KMI ! Model index
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+CHARACTER*4, INTENT(IN) :: HTURBDIM ! Dimensionality of the
+ ! turbulence scheme
+CHARACTER*4, INTENT(IN) :: HRAD ! Radiation scheme name
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
+ ! the OUTPUT FM-file
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
+ ! Condensation
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Dry density of the
+ ! reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Absolute Pressure at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
+!
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+!
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at t
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentration source
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! Cloud fraction
+!
+!
+!* 0.2 Declarations of local variables :
+!
+! 3D Microphysical variables
+REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) &
+ :: PRVT, & ! Water vapor m.r. at t
+ PRCT, & ! Cloud water m.r. at t
+ PRRT, & ! Rain water m.r. at t
+ PRIT, & ! Cloud ice m.r. at t
+ PRST, & ! Aggregate m.r. at t
+ PRGT, & ! Graupel m.r. at t
+!
+ PRVS, & ! Water vapor m.r. source
+ PRCS, & ! Cloud water m.r. source
+ PRRS, & ! Rain water m.r. source
+ PRIS, & ! Cloud ice m.r. source
+ PRSS, & ! Aggregate m.r. source
+ PRGS, & ! Graupel m.r. source
+!
+ PCCT, & ! Cloud water conc. at t
+ PCIT, & ! Cloud ice conc. at t
+!
+ PCCS, & ! Cloud water C. source
+ PMAS, & ! Mass of scavenged AP
+ PCIS ! Ice crystal C. source
+!
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE &
+ :: PNFS, & ! Free CCN C. source
+ PNAS, & ! Activated CCN C. source
+ PIFS, & ! Free IFN C. source
+ PINS, & ! Nucleated IFN C. source
+ PNIS ! Acti. IMM. nuclei C. source
+!
+!
+!
+REAL :: ZEPS ! Mv/Md
+REAL :: ZDT ! Time increment (2*Delta t or Delta t if cold start)
+REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) &
+ :: ZEXNS,& ! guess of the Exner function at t+1
+ ZT, & ! guess of the temperature at t+1
+ ZCPH, & ! guess of the CPh for the mixing
+ ZW, &
+ ZW1, &
+ ZW2, &
+ ZLV, & ! guess of the Lv at t+1
+ ZLS, & ! guess of the Ls at t+1
+ ZMASK
+LOGICAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) &
+ :: GMICRO, GMICRO_RI, GMICRO_RC ! Test where to compute cond/dep proc.
+INTEGER :: IMICRO
+REAL, DIMENSION(:), ALLOCATABLE &
+ :: ZRVT, ZRCT, ZRIT, ZRVS, ZRCS, ZRIS, ZTHS, &
+ ZCCT, ZCIT, ZCCS, ZCIS, &
+ ZRHODREF, ZZT, ZPRES, ZEXNREF, ZZCPH, &
+ ZZW, ZLVFACT, ZLSFACT, &
+ ZRVSATW, ZRVSATI, ZRVSATW_PRIME, ZRVSATI_PRIME, &
+ ZAW, ZAI, ZCJ, ZKA, ZDV, ZITW, ZITI, ZAWW, ZAIW, &
+ ZAWI, ZAII, ZFACT, ZDELTW, &
+ ZDELTI, ZDELT1, ZDELT2, ZCND, ZDEP
+!
+INTEGER :: IRESP ! Return code of FM routines
+INTEGER :: ILENG ! Length of comment string in LFIFM file
+INTEGER :: IGRID ! C-grid indicator in LFIFM file
+INTEGER :: ILENCH ! Length of comment string in LFIFM file
+INTEGER :: IKB ! K index value of the first inner mass point
+INTEGER :: IKE ! K index value of the last inner mass point
+INTEGER :: IIB,IJB ! Horz index values of the first inner mass points
+INTEGER :: IIE,IJE ! Horz index values of the last inner mass points
+INTEGER :: JITER,ITERMAX ! iterative loop for first order adjustment
+INTEGER :: ILUOUT ! Logical unit of output listing
+CHARACTER (LEN=100) :: YCOMMENT ! Comment string in LFIFM file
+CHARACTER (LEN=16) :: YRECFM ! Name of the desired field in LFIFM file
+!
+INTEGER :: ISIZE
+REAL, DIMENSION(:), ALLOCATABLE :: ZRTMIN
+REAL, DIMENSION(:), ALLOCATABLE :: ZCTMIN
+!
+INTEGER , DIMENSION(SIZE(GMICRO)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+INTEGER :: JMOD, JMOD_IFN, JMOD_IMM
+!
+INTEGER , DIMENSION(3) :: BV
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. PRELIMINARIES
+! -------------
+!
+CALL FMLOOK_ll(HLUOUT,HLUOUT,ILUOUT,IRESP)
+!
+IIB = 1 + JPHEXT
+IIE = SIZE(PRHODJ,1) - JPHEXT
+IJB = 1 + JPHEXT
+IJE = SIZE(PRHODJ,2) - JPHEXT
+IKB = 1 + JPVEXT
+IKE = SIZE(PRHODJ,3) - JPVEXT
+!
+ZEPS= XMV / XMD
+!
+IF (OSUBG_COND) THEN
+ ITERMAX=2
+ELSE
+ ITERMAX=1
+END IF
+!
+ZDT = PTSTEP
+!
+ISIZE = SIZE(XRTMIN)
+ALLOCATE(ZRTMIN(ISIZE))
+ZRTMIN(:) = XRTMIN(:) / ZDT
+ISIZE = SIZE(XCTMIN)
+ALLOCATE(ZCTMIN(ISIZE))
+ZCTMIN(:) = XCTMIN(:) / ZDT
+!
+! Prepare 3D water mixing ratios
+PRVT(:,:,:) = PRT(:,:,:,1)
+PRVS(:,:,:) = PRS(:,:,:,1)
+!
+PRCT(:,:,:) = 0.
+PRCS(:,:,:) = 0.
+PRRT(:,:,:) = 0.
+PRRS(:,:,:) = 0.
+PRIT(:,:,:) = 0.
+PRIS(:,:,:) = 0.
+PRST(:,:,:) = 0.
+PRSS(:,:,:) = 0.
+PRGT(:,:,:) = 0.
+PRGS(:,:,:) = 0.
+!
+IF ( KRR .GE. 2 ) PRCT(:,:,:) = PRT(:,:,:,2)
+IF ( KRR .GE. 2 ) PRCS(:,:,:) = PRS(:,:,:,2)
+IF ( KRR .GE. 3 ) PRRT(:,:,:) = PRT(:,:,:,3)
+IF ( KRR .GE. 3 ) PRRS(:,:,:) = PRS(:,:,:,3)
+IF ( KRR .GE. 4 ) PRIT(:,:,:) = PRT(:,:,:,4)
+IF ( KRR .GE. 4 ) PRIS(:,:,:) = PRS(:,:,:,4)
+IF ( KRR .GE. 5 ) PRST(:,:,:) = PRT(:,:,:,5)
+IF ( KRR .GE. 5 ) PRSS(:,:,:) = PRS(:,:,:,5)
+IF ( KRR .GE. 6 ) PRGT(:,:,:) = PRT(:,:,:,6)
+IF ( KRR .GE. 6 ) PRGS(:,:,:) = PRS(:,:,:,6)
+!
+! Prepare 3D number concentrations
+PCCT(:,:,:) = 0.
+PCIT(:,:,:) = 0.
+PCCS(:,:,:) = 0.
+PCIS(:,:,:) = 0.
+!
+IF ( LWARM ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
+IF ( LCOLD ) PCIT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NI)
+!
+IF ( LWARM ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
+IF ( LCOLD ) PCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
+!
+IF ( LSCAV .AND. LAERO_MASS ) PMAS(:,:,:) = PSVS(:,:,:,NSV_LIMA_SCAVMASS)
+!
+IF ( LWARM .AND. NMOD_CCN.GE.1 ) THEN
+ ALLOCATE( PNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ ALLOCATE( PNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ PNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)
+ PNAS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)
+END IF
+!
+IF ( LCOLD .AND. NMOD_IFN .GE. 1 ) THEN
+ ALLOCATE( PIFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
+ ALLOCATE( PINS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
+ PIFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1)
+ PINS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1)
+END IF
+!
+IF ( NMOD_IMM .GE. 1 ) THEN
+ ALLOCATE( PNIS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IMM) )
+ PNIS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1)
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. COMPUTE QUANTITIES WITH THE GUESS OF THE FUTURE INSTANT
+! -------------------------------------------------------
+!
+!* 2.1 remove negative non-precipitating negative water
+! ------------------------------------------------
+!
+IF (ANY(PRVS(:,:,:)+PRCS(:,:,:)+PRIS(:,:,:) < 0.) .AND. NVERB>5) THEN
+ WRITE(ILUOUT,*) 'LIMA_ADJUST: negative values of total water (reset to zero)'
+ WRITE(ILUOUT,*) ' location of minimum PRVS+PRCS+PRIS:',MINLOC(PRVS+PRCS+PRIS)
+ WRITE(ILUOUT,*) ' value of minimum PRVS+PRCS+PRIS:',MINVAL(PRVS+PRCS+PRIS)
+END IF
+!
+WHERE ( PRVS(:,:,:)+PRCS(:,:,:)+PRIS(:,:,:) < 0.)
+ PRVS(:,:,:) = - PRCS(:,:,:) - PRIS(:,:,:)
+END WHERE
+!
+!* 2.2 estimate the Exner function at t+1
+!
+ZEXNS(:,:,:) = ( (2. * PPABST(:,:,:) - PPABSM(:,:,:)) / XP00 ) ** (XRD/XCPD)
+!
+! beginning of the iterative loop
+!
+DO JITER =1,ITERMAX
+!
+!* 2.3 compute the intermediate temperature at t+1, T*
+!
+ ZT(:,:,:) = ( PTHS(:,:,:) * ZDT ) * ZEXNS(:,:,:)
+!
+!* 2.4 compute the specific heat for moist air (Cph) at t+1
+!
+ ZCPH(:,:,:) = XCPD + XCPV *ZDT* PRVS(:,:,:) &
+ + XCL *ZDT* ( PRCS(:,:,:) + PRRS(:,:,:) ) &
+ + XCI *ZDT* ( PRIS(:,:,:) + PRSS(:,:,:) + PRGS(:,:,:) )
+!
+!* 2.5 compute the latent heat of vaporization Lv(T*) at t+1
+! and of sublimation Ls(T*) at t+1
+!
+ ZLV(:,:,:) = XLVTT + ( XCPV - XCL ) * ( ZT(:,:,:) -XTT )
+ ZLS(:,:,:) = XLSTT + ( XCPV - XCI ) * ( ZT(:,:,:) -XTT )
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. FIRST ORDER SUBGRID CONDENSATION SCHEME
+! ---------------------------------------
+!
+ IF ( OSUBG_COND ) THEN
+!
+! not yet available
+!
+ STOP
+ ELSE
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 4. FULLY EXPLICIT SCHEME FROM TZIVION et al. (1989)
+! -----------------------------------------------
+!
+!* select cases where r_i>0 and r_c=0
+!
+GMICRO(:,:,:) = .FALSE.
+GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ (PRIS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(4) .AND. &
+ PCIS(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(4) ) &
+ .AND. .NOT. (PRCS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(2) .AND. &
+ PCCS(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(2) )
+GMICRO_RI(:,:,:) = GMICRO(:,:,:)
+IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
+IF( IMICRO >= 1 ) THEN
+ ALLOCATE(ZRVT(IMICRO))
+ ALLOCATE(ZRIT(IMICRO))
+ ALLOCATE(ZCIT(IMICRO))
+!
+ ALLOCATE(ZRVS(IMICRO))
+ ALLOCATE(ZRIS(IMICRO))
+ ALLOCATE(ZCIS(IMICRO)) !!!BVIE!!!
+ ALLOCATE(ZTHS(IMICRO))
+!
+ ALLOCATE(ZRHODREF(IMICRO))
+ ALLOCATE(ZZT(IMICRO))
+ ALLOCATE(ZPRES(IMICRO))
+ ALLOCATE(ZEXNREF(IMICRO))
+ ALLOCATE(ZZCPH(IMICRO))
+ DO JL=1,IMICRO
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
+ ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
+!
+ ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
+ ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
+ ZCIS(JL) = PCIS(I1(JL),I2(JL),I3(JL)) !!!BVIE!!!
+ ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+!
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = 2.0*PPABST(I1(JL),I2(JL),I3(JL))-PPABSM(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ ZZCPH(JL) = ZCPH(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ ALLOCATE(ZZW(IMICRO))
+ ALLOCATE(ZLSFACT(IMICRO))
+ ZLSFACT(:) = (XLSTT+(XCPV-XCI)*(ZZT(:)-XTT))/ZZCPH(:) ! L_s/C_ph
+ ALLOCATE(ZRVSATI(IMICRO))
+ ALLOCATE(ZRVSATI_PRIME(IMICRO))
+ ALLOCATE(ZDELTI(IMICRO))
+ ALLOCATE(ZAI(IMICRO))
+ ALLOCATE(ZCJ(IMICRO))
+ ALLOCATE(ZKA(IMICRO))
+ ALLOCATE(ZDV(IMICRO))
+ ALLOCATE(ZITI(IMICRO))
+!
+ ZKA(:) = 2.38E-2 + 0.0071E-2 * ( ZZT(:) - XTT ) ! k_a
+ ZDV(:) = 0.211E-4 * (ZZT(:)/XTT)**1.94 * (XP00/ZPRES(:)) ! D_v
+ ZCJ(:) = XSCFAC * ZRHODREF(:)**0.3 / SQRT( 1.718E-5+0.0049E-5*(ZZT(:)-XTT) )
+!
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZRVSATI(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_si
+ ZRVSATI_PRIME(:) = (( XBETAI/ZZT(:) - XGAMI ) / ZZT(:)) & ! r'_si
+ * ZRVSATI(:) * ( 1. + ZRVSATI(:)/ZEPS )
+!
+ ZDELTI(:) = ZRVS(:)*ZDT - ZRVSATI(:)
+ ZAI(:) = ( XLSTT + (XCPV-XCI)*(ZZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZZT(:)**2) &
+ + ( XRV*ZZT(:) ) / (ZDV(:)*ZZW(:))
+ ZZW(:) = MIN(1.E8,( XLBI* MAX(ZCIT(:),XCTMIN(4)) &
+ /(MAX(ZRIT(:),XRTMIN(4))) )**XLBEXI)
+ ! Lbda_I
+ ZITI(:) = ZCIT(:) * (X0DEPI/ZZW(:) + X2DEPI*ZCJ(:)*ZCJ(:)/ZZW(:)**(XDI+2.0)) &
+ / (ZRVSATI(:)*ZAI(:))
+!
+ ALLOCATE(ZAII(IMICRO))
+ ALLOCATE(ZDEP(IMICRO))
+!
+ ZAII(:) = 1.0 + ZRVSATI_PRIME(:)*ZLSFACT(:)
+ ZDEP(:) = 0.0
+!
+ ZZW(:) = ZAII(:)*ZITI(:)*ZDT ! R*delta_T
+ WHERE( ZZW(:)<1.0E-2 )
+ ZDEP(:) = ZITI(:)*ZDELTI(:)*(1.0 - (ZZW(:)/2.0)*(1.0-ZZW(:)/3.0))
+ ELSEWHERE
+ ZDEP(:) = ZITI(:)*ZDELTI(:)*(1.0 - EXP(-ZZW(:)))/ZZW(:)
+ END WHERE
+!
+! Integration
+!
+ WHERE( ZDEP(:) < 0.0 )
+ ZDEP(:) = MAX ( ZDEP(:), -ZRIS(:) )
+ ELSEWHERE
+ ZDEP(:) = MIN ( ZDEP(:), ZRVS(:) )
+! ZDEP(:) = MIN ( ZDEP(:), ZCIS(:)*5.E-10 ) !!!BVIE!!!
+ END WHERE
+ WHERE( ZRIS(:) < ZRTMIN(4) )
+ ZDEP(:) = 0.0
+ END WHERE
+ ZRVS(:) = ZRVS(:) - ZDEP(:)
+ ZRIS(:) = ZRIS(:) + ZDEP(:)
+ ZTHS(:) = ZTHS(:) + ZDEP(:) * ZLSFACT(:) / ZEXNREF(:)
+!
+! Implicit ice crystal sublimation if ice saturated conditions are not met
+!
+ ZZT(:) = ( ZTHS(:) * ZDT ) * ( ZPRES(:) / XP00 ) ** (XRD/XCPD)
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZRVSATI(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_si
+ WHERE( ZRVS(:)*ZDT<ZRVSATI(:) )
+ ZZW(:) = ZRVS(:) + ZRIS(:)
+ ZRVS(:) = MIN( ZZW(:),ZRVSATI(:)/ZDT )
+ ZTHS(:) = ZTHS(:) + ( MAX( 0.0,ZZW(:)-ZRVS(:) )-ZRIS(:) ) &
+ * ZLSFACT(:) / ZEXNREF(:)
+ ZRIS(:) = MAX( 0.0,ZZW(:)-ZRVS(:) )
+ END WHERE
+!
+!
+ ZW(:,:,:) = PRVS(:,:,:)
+ PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRIS(:,:,:)
+ PRIS(:,:,:) = UNPACK( ZRIS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PTHS(:,:,:)
+ PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZRIT)
+ DEALLOCATE(ZCIT)
+ DEALLOCATE(ZRVS)
+ DEALLOCATE(ZRIS)
+ DEALLOCATE(ZCIS) !!!BVIE!!!
+ DEALLOCATE(ZTHS)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZEXNREF)
+ DEALLOCATE(ZZCPH)
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZLSFACT)
+ DEALLOCATE(ZRVSATI)
+ DEALLOCATE(ZRVSATI_PRIME)
+ DEALLOCATE(ZDELTI)
+ DEALLOCATE(ZAI)
+ DEALLOCATE(ZCJ)
+ DEALLOCATE(ZKA)
+ DEALLOCATE(ZDV)
+ DEALLOCATE(ZITI)
+ DEALLOCATE(ZAII)
+ DEALLOCATE(ZDEP)
+END IF ! IMICRO
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 5. FULLY IMPLICIT CONDENSATION SCHEME
+! ---------------------------------
+!
+!* select cases where r_c>0 and r_i=0
+!
+!
+GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ .NOT. GMICRO_RI(IIB:IIE,IJB:IJE,IKB:IKE) &
+ .AND. ( PRCS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(2) .AND. &
+ PCCS(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(2) ) &
+ .AND. .NOT. ( PRIS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(4) .AND. &
+ PCIS(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(4) )
+GMICRO_RC(:,:,:) = GMICRO(:,:,:)
+IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
+IF( IMICRO >= 1 ) THEN
+ ALLOCATE(ZRVT(IMICRO))
+ ALLOCATE(ZRCT(IMICRO))
+!
+ ALLOCATE(ZRVS(IMICRO))
+ ALLOCATE(ZRCS(IMICRO))
+ ALLOCATE(ZTHS(IMICRO))
+!
+ ALLOCATE(ZRHODREF(IMICRO))
+ ALLOCATE(ZZT(IMICRO))
+ ALLOCATE(ZPRES(IMICRO))
+ ALLOCATE(ZEXNREF(IMICRO))
+ ALLOCATE(ZZCPH(IMICRO))
+ DO JL=1,IMICRO
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+!
+ ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
+ ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
+ ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+!
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = 2.0*PPABST(I1(JL),I2(JL),I3(JL))-PPABSM(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ ZZCPH(JL) = ZCPH(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ ALLOCATE(ZZW(IMICRO))
+ ALLOCATE(ZLVFACT(IMICRO))
+ ZLVFACT(:) = (XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZCPH(:) ! L_v/C_ph
+ ALLOCATE(ZRVSATW(IMICRO))
+ ALLOCATE(ZRVSATW_PRIME(IMICRO))
+!
+ ZZW(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
+ ZRVSATW(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_sw
+ ZRVSATW_PRIME(:) = (( XBETAW/ZZT(:) - XGAMW ) / ZZT(:)) & ! r'_sw
+ * ZRVSATW(:) * ( 1. + ZRVSATW(:)/ZEPS )
+ ALLOCATE(ZAWW(IMICRO))
+ ALLOCATE(ZDELT1(IMICRO))
+ ALLOCATE(ZDELT2(IMICRO))
+ ALLOCATE(ZCND(IMICRO))
+!
+ ZAWW(:) = 1.0 + ZRVSATW_PRIME(:)*ZLVFACT(:)
+ ZDELT2(:) = (ZRVSATW_PRIME(:)*ZLVFACT(:)/ZAWW(:)) * &
+ ( ((-2.*XBETAW+XGAMW*ZZT(:))/(XBETAW-XGAMW*ZZT(:)) &
+ + (XBETAW/ZZT(:)-XGAMW)*(1.0+2.0*ZRVSATW(:)/ZEPS))/ZZT(:) )
+ ZDELT1(:) = (ZLVFACT(:)/ZAWW(:)) * ( ZRVSATW(:) - ZRVS(:)*ZDT )
+ ZCND(:) = - ZDELT1(:)*( 1.0 + 0.5*ZDELT1(:)*ZDELT2(:) ) / (ZLVFACT(:)*ZDT)
+!
+! Integration
+!
+ WHERE( ZCND(:) < 0.0 )
+ ZCND(:) = MAX ( ZCND(:), -ZRCS(:) )
+ ELSEWHERE
+ ZCND(:) = MIN ( ZCND(:), ZRVS(:) )
+ END WHERE
+ ZRVS(:) = ZRVS(:) - ZCND(:)
+ ZRCS(:) = ZRCS(:) + ZCND(:)
+ ZTHS(:) = ZTHS(:) + ZCND(:) * ZLVFACT(:) / ZEXNREF(:)
+!
+ ZW(:,:,:) = PRVS(:,:,:)
+ PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRCS(:,:,:)
+ PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PTHS(:,:,:)
+ PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZRVS)
+ DEALLOCATE(ZRCS)
+ DEALLOCATE(ZTHS)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZEXNREF)
+ DEALLOCATE(ZZCPH)
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZLVFACT)
+ DEALLOCATE(ZRVSATW)
+ DEALLOCATE(ZRVSATW_PRIME)
+ DEALLOCATE(ZAWW)
+ DEALLOCATE(ZDELT1)
+ DEALLOCATE(ZDELT2)
+ DEALLOCATE(ZCND)
+END IF ! IMICRO
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 6. IMPLICIT-EXPLICIT SCHEME USING REISIN et al. (1996)
+! ---------------------------------------------------
+!
+!* select cases where r_i>0 and r_c>0 (supercooled water)
+!
+!
+GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ .NOT. GMICRO_RI(IIB:IIE,IJB:IJE,IKB:IKE) &
+ .AND. .NOT. GMICRO_RC(IIB:IIE,IJB:IJE,IKB:IKE) &
+ .AND. ( PRIS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(4) .AND. &
+ PCIS(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(4) ) &
+ .AND. ( PRCS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(2) .AND. &
+ PCCS(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(2) )
+IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
+IF( IMICRO >= 1 ) THEN
+ ALLOCATE(ZRVT(IMICRO))
+ ALLOCATE(ZRCT(IMICRO))
+ ALLOCATE(ZRIT(IMICRO))
+ ALLOCATE(ZCCT(IMICRO))
+ ALLOCATE(ZCIT(IMICRO))
+!
+ ALLOCATE(ZRVS(IMICRO))
+ ALLOCATE(ZRCS(IMICRO))
+ ALLOCATE(ZRIS(IMICRO))
+ ALLOCATE(ZCCS(IMICRO))
+ ALLOCATE(ZCIS(IMICRO))
+ ALLOCATE(ZTHS(IMICRO))
+!
+ ALLOCATE(ZRHODREF(IMICRO))
+ ALLOCATE(ZZT(IMICRO))
+ ALLOCATE(ZPRES(IMICRO))
+ ALLOCATE(ZEXNREF(IMICRO))
+ ALLOCATE(ZZCPH(IMICRO))
+ DO JL=1,IMICRO
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
+ ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
+ ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
+!
+ ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
+ ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
+ ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
+ ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
+ ZCIS(JL) = PCIS(I1(JL),I2(JL),I3(JL))
+ ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+!
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = 2.0*PPABST(I1(JL),I2(JL),I3(JL))-PPABSM(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ ZZCPH(JL) = ZCPH(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ ALLOCATE(ZZW(IMICRO))
+ ALLOCATE(ZLVFACT(IMICRO))
+ ALLOCATE(ZLSFACT(IMICRO))
+ ZLVFACT(:) = (XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZCPH(:) ! L_v/C_ph
+ ZLSFACT(:) = (XLSTT+(XCPV-XCI)*(ZZT(:)-XTT))/ZZCPH(:) ! L_s/C_ph
+ ALLOCATE(ZRVSATW(IMICRO))
+ ALLOCATE(ZRVSATI(IMICRO))
+ ALLOCATE(ZRVSATW_PRIME(IMICRO))
+ ALLOCATE(ZRVSATI_PRIME(IMICRO))
+ ALLOCATE(ZDELTW(IMICRO))
+ ALLOCATE(ZDELTI(IMICRO))
+ ALLOCATE(ZAW(IMICRO))
+ ALLOCATE(ZAI(IMICRO))
+ ALLOCATE(ZCJ(IMICRO))
+ ALLOCATE(ZKA(IMICRO))
+ ALLOCATE(ZDV(IMICRO))
+ ALLOCATE(ZITW(IMICRO))
+ ALLOCATE(ZITI(IMICRO))
+!
+ ZKA(:) = 2.38E-2 + 0.0071E-2 * ( ZZT(:) - XTT ) ! k_a
+ ZDV(:) = 0.211E-4 * (ZZT(:)/XTT)**1.94 * (XP00/ZPRES(:)) ! D_v
+ ZCJ(:) = XSCFAC * ZRHODREF(:)**0.3 / SQRT( 1.718E-5+0.0049E-5*(ZZT(:)-XTT) )
+!
+!* 6.2 implicit adjustment at water saturation
+!
+ ZZW(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
+ ZRVSATW(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_sw
+ ZRVSATW_PRIME(:) = (( XBETAW/ZZT(:) - XGAMW ) / ZZT(:)) & ! r'_sw
+ * ZRVSATW(:) * ( 1. + ZRVSATW(:)/ZEPS )
+ ZDELTW(:) = ABS( ZRVS(:)*ZDT - ZRVSATW(:) )
+ ZAW(:) = ( XLSTT + (XCPV-XCL)*(ZZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZZT(:)**2) &
+ + ( XRV*ZZT(:) ) / (ZDV(:)*ZZW(:))
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZRVSATI(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_si
+ ZRVSATI_PRIME(:) = (( XBETAI/ZZT(:) - XGAMI ) / ZZT(:)) & ! r'_si
+ * ZRVSATI(:) * ( 1. + ZRVSATI(:)/ZEPS )
+ ZDELTI(:) = ABS( ZRVS(:)*ZDT - ZRVSATI(:) )
+ ZAI(:) = ( XLSTT + (XCPV-XCI)*(ZZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZZT(:)**2) &
+ + ( XRV*ZZT(:) ) / (ZDV(:)*ZZW(:))
+!
+ ZZW(:) = MIN(1.E8,( XLBC* MAX(ZCCT(:),XCTMIN(2)) &
+ /(MAX(ZRCT(:),XRTMIN(2))) )**XLBEXC)
+ ! Lbda_c
+ ZITW(:) = ZCCT(:) * (X0CNDC/ZZW(:) + X2CNDC*ZCJ(:)*ZCJ(:)/ZZW(:)**(XDC+2.0)) &
+ / (ZRVSATW(:)*ZAW(:))
+ ZZW(:) = MIN(1.E8,( XLBI* MAX(ZCIT(:),XCTMIN(4)) &
+ /(MAX(ZRIT(:),XRTMIN(4))) )**XLBEXI)
+ ! Lbda_I
+ ZITI(:) = ZCIT(:) * (X0DEPI/ZZW(:) + X2DEPI*ZCJ(:)*ZCJ(:)/ZZW(:)**(XDI+2.0)) &
+ / (ZRVSATI(:)*ZAI(:))
+!
+ ALLOCATE(ZAWW(IMICRO))
+ ALLOCATE(ZAIW(IMICRO))
+ ALLOCATE(ZAWI(IMICRO))
+ ALLOCATE(ZAII(IMICRO))
+!
+ ALLOCATE(ZFACT(IMICRO))
+ ALLOCATE(ZDELT1(IMICRO))
+ ALLOCATE(ZDELT2(IMICRO))
+!
+ ZAII(:) = ZITI(:)*ZDELTI(:)
+ WHERE( ZAII(:)<1.0E-15 )
+ ZFACT(:) = ZLVFACT(:)
+ ELSEWHERE
+ ZFACT(:) = (ZLVFACT(:)*ZITW(:)*ZDELTW(:)+ZLSFACT(:)*ZITI(:)*ZDELTI(:)) &
+ / (ZITW(:)*ZDELTW(:)+ZITI(:)*ZDELTI(:))
+ END WHERE
+ ZAWW(:) = 1.0 + ZRVSATW_PRIME(:)*ZFACT(:)
+!
+ ZDELT2(:) = (ZRVSATW_PRIME(:)*ZFACT(:)/ZAWW(:)) * &
+ ( ((-2.*XBETAW+XGAMW*ZZT(:))/(XBETAW-XGAMW*ZZT(:)) &
+ + (XBETAW/ZZT(:)-XGAMW)*(1.0+2.0*ZRVSATW(:)/ZEPS))/ZZT(:) )
+ ZDELT1(:) = (ZFACT(:)/ZAWW(:)) * ( ZRVSATW(:) - ZRVS(:)*ZDT )
+!
+ ALLOCATE(ZCND(IMICRO))
+ ALLOCATE(ZDEP(IMICRO))
+ ZCND(:) = 0.0
+ ZDEP(:) = 0.0
+!
+ ZZW(:) = - ZDELT1(:)*( 1.0 + 0.5*ZDELT1(:)*ZDELT2(:) ) / (ZFACT(:)*ZDT)
+ WHERE( ZAII(:)<1.0E-15 )
+ ZCND(:) = ZZW(:)
+ ZDEP(:) = 0.0
+ ELSEWHERE
+ ZCND(:) = ZZW(:)*ZITW(:)*ZDELTW(:) / (ZITW(:)*ZDELTW(:)+ZITI(:)*ZDELTI(:))
+ ZDEP(:) = ZZW(:)*ZITI(:)*ZDELTI(:) / (ZITW(:)*ZDELTW(:)+ZITI(:)*ZDELTI(:))
+ END WHERE
+!
+! Integration
+!
+ WHERE( ZCND(:) < 0.0 )
+ ZCND(:) = MAX ( ZCND(:), -ZRCS(:) )
+ ELSEWHERE
+ ZCND(:) = MIN ( ZCND(:), ZRVS(:) )
+ END WHERE
+ ZRVS(:) = ZRVS(:) - ZCND(:)
+ ZRCS(:) = ZRCS(:) + ZCND(:)
+ ZTHS(:) = ZTHS(:) + ZCND(:) * ZLVFACT(:) / ZEXNREF(:)
+!
+ WHERE( ZDEP(:) < 0.0 )
+ ZDEP(:) = MAX ( ZDEP(:), -ZRIS(:) )
+ ELSEWHERE
+ ZDEP(:) = MIN ( ZDEP(:), ZRVS(:) )
+ END WHERE
+ ZRVS(:) = ZRVS(:) - ZDEP(:)
+ ZRIS(:) = ZRIS(:) + ZDEP(:)
+ ZTHS(:) = ZTHS(:) + ZDEP(:) * ZLSFACT(:) / ZEXNREF(:)
+!
+!* 6.3 explicit integration of the final eva/dep rates
+!
+ ZZT(:) = ( ZTHS(:) * ZDT ) * ( ZPRES(:) / XP00 ) ** (XRD/XCPD)
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZRVSATI(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_si
+!
+! If Si < 0, implicit adjustment to Si=0 using ice only
+!
+ WHERE( ZRVS(:)*ZDT<ZRVSATI(:) )
+ ZZW(:) = ZRVS(:) + ZRIS(:)
+ ZRVS(:) = MIN( ZZW(:),ZRVSATI(:)/ZDT )
+ ZTHS(:) = ZTHS(:) + ( MAX( 0.0,ZZW(:)-ZRVS(:) )-ZRIS(:) ) &
+ * ZLSFACT(:) / ZEXNREF(:)
+ ZRIS(:) = MAX( 0.0,ZZW(:)-ZRVS(:) )
+ END WHERE
+!
+! Following the previous adjustment, the real procedure begins
+!
+ ZZT(:) = ( ZTHS(:) * ZDT ) * ( ZPRES(:) / XP00 ) ** (XRD/XCPD)
+!
+ ZLVFACT(:) = (XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZCPH(:) ! L_v/C_ph
+ ZLSFACT(:) = (XLSTT+(XCPV-XCI)*(ZZT(:)-XTT))/ZZCPH(:) ! L_s/C_ph
+!
+ ZKA(:) = 2.38E-2 + 0.0071E-2 * ( ZZT(:) - XTT ) ! k_a
+ ZDV(:) = 0.211E-4 * (ZZT(:)/XTT)**1.94 * (XP00/ZPRES(:)) ! D_v
+ ZCJ(:) = XSCFAC * ZRHODREF(:)**0.3 / SQRT( 1.718E-5+0.0049E-5*(ZZT(:)-XTT) )
+!
+ ZZW(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
+ ZRVSATW(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_sw
+ ZRVSATW_PRIME(:) = (( XBETAW/ZZT(:) - XGAMW ) / ZZT(:)) & ! r'_sw
+ * ZRVSATW(:) * ( 1. + ZRVSATW(:)/ZEPS )
+ ZDELTW(:) = ZRVS(:)*ZDT - ZRVSATW(:)
+ ZAW(:) = ( XLSTT + (XCPV-XCL)*(ZZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZZT(:)**2) &
+ + ( XRV*ZZT(:) ) / (ZDV(:)*ZZW(:))
+!
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZRVSATI(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_si
+ ZRVSATI_PRIME(:) = (( XBETAI/ZZT(:) - XGAMI ) / ZZT(:)) & ! r'_si
+ * ZRVSATI(:) * ( 1. + ZRVSATI(:)/ZEPS )
+ ZDELTI(:) = ZRVS(:)*ZDT - ZRVSATI(:)
+ ZAI(:) = ( XLSTT + (XCPV-XCI)*(ZZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZZT(:)**2) &
+ + ( XRV*ZZT(:) ) / (ZDV(:)*ZZW(:))
+!
+ ZZW(:) = MIN(1.E8,( XLBC* MAX(ZCCS(:),ZCTMIN(2)) &
+ /(MAX(ZRCS(:),ZRTMIN(2))) )**XLBEXC)
+ ! Lbda_c
+ ZITW(:) = ZCCT(:) * (X0CNDC/ZZW(:) + X2CNDC*ZCJ(:)*ZCJ(:)/ZZW(:)**(XDC+2.0)) &
+ / (ZRVSATW(:)*ZAW(:))
+ ZZW(:) = MIN(1.E8,( XLBI* MAX(ZCIS(:),ZCTMIN(4)) &
+ /(MAX(ZRIS(:),ZRTMIN(4))) )**XLBEXI)
+ ! Lbda_I
+ ZITI(:) = ZCIT(:) * (X0DEPI/ZZW(:) + X2DEPI*ZCJ(:)*ZCJ(:)/ZZW(:)**(XDI+2.0)) &
+ / (ZRVSATI(:)*ZAI(:))
+!
+ ZAWW(:) = 1.0 + ZRVSATW_PRIME(:)*ZLVFACT(:)
+ ZAIW(:) = 1.0 + ZRVSATI_PRIME(:)*ZLVFACT(:)
+ ZAWI(:) = 1.0 + ZRVSATW_PRIME(:)*ZLSFACT(:)
+ ZAII(:) = 1.0 + ZRVSATI_PRIME(:)*ZLSFACT(:)
+!
+ ZCND(:) = 0.0
+ ZDEP(:) = 0.0
+ ZZW(:) = ZAWW(:)*ZITW(:) + ZAII(:)*ZITI(:) ! R
+ WHERE( ZZW(:)<1.0E-2 )
+ ZFACT(:) = ZDT*(0.5 - (ZZW(:)*ZDT)/6.0)
+ ELSEWHERE
+ ZFACT(:) = (1.0/ZZW(:))*(1.0-(1.0-EXP(-ZZW(:)*ZDT))/(ZZW(:)*ZDT))
+ END WHERE
+ ZCND(:) = ZITW(:)*(ZDELTW(:)-( ZAWW(:)*ZITW(:)*ZDELTW(:) &
+ + ZAWI(:)*ZITI(:)*ZDELTI(:) )*ZFACT(:))
+ ZDEP(:) = ZITI(:)*(ZDELTI(:)-( ZAIW(:)*ZITW(:)*ZDELTW(:) &
+ + ZAII(:)*ZITI(:)*ZDELTI(:) )*ZFACT(:))
+!
+! Integration
+!
+ WHERE( ZCND(:) < 0.0 )
+ ZCND(:) = MAX ( ZCND(:), -ZRCS(:) )
+ ELSEWHERE
+ ZCND(:) = MIN ( ZCND(:), ZRVS(:) )
+ END WHERE
+ WHERE( ZRCS(:) < ZRTMIN(2) )
+ ZCND(:) = 0.0
+ END WHERE
+ ZRVS(:) = ZRVS(:) - ZCND(:)
+ ZRCS(:) = ZRCS(:) + ZCND(:)
+ ZTHS(:) = ZTHS(:) + ZCND(:) * ZLVFACT(:) / ZEXNREF(:)
+!
+ WHERE( ZDEP(:) < 0.0 )
+ ZDEP(:) = MAX ( ZDEP(:), -ZRIS(:) )
+ ELSEWHERE
+ ZDEP(:) = MIN ( ZDEP(:), ZRVS(:) )
+ END WHERE
+ WHERE( ZRIS(:) < ZRTMIN(4) )
+ ZDEP(:) = 0.0
+ END WHERE
+ ZRVS(:) = ZRVS(:) - ZDEP(:)
+ ZRIS(:) = ZRIS(:) + ZDEP(:)
+ ZTHS(:) = ZTHS(:) + ZDEP(:) * ZLSFACT(:) / ZEXNREF(:)
+!
+! Implicit ice crystal sublimation if ice saturated conditions are not met
+!
+ ZZT(:) = ( ZTHS(:) * ZDT ) * ( ZPRES(:) / XP00 ) ** (XRD/XCPD)
+ ZLVFACT(:) = (XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZCPH(:) ! L_v/C_ph
+ ZLSFACT(:) = (XLSTT+(XCPV-XCI)*(ZZT(:)-XTT))/ZZCPH(:) ! L_s/C_ph
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZRVSATI(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_si
+ WHERE( ZRVS(:)*ZDT<ZRVSATI(:) )
+ ZZW(:) = ZRVS(:) + ZRIS(:)
+ ZRVS(:) = MIN( ZZW(:),ZRVSATI(:)/ZDT )
+ ZTHS(:) = ZTHS(:) + ( MAX( 0.0,ZZW(:)-ZRVS(:) )-ZRIS(:) ) &
+ * ZLSFACT(:) / ZEXNREF(:)
+ ZRIS(:) = MAX( 0.0,ZZW(:)-ZRVS(:) )
+ END WHERE
+!
+!
+!
+ ZW(:,:,:) = PRVS(:,:,:)
+ PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRCS(:,:,:)
+ PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRIS(:,:,:)
+ PRIS(:,:,:) = UNPACK( ZRIS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PTHS(:,:,:)
+ PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZRIT)
+ DEALLOCATE(ZCCT)
+ DEALLOCATE(ZCIT)
+ DEALLOCATE(ZRVS)
+ DEALLOCATE(ZRCS)
+ DEALLOCATE(ZRIS)
+ DEALLOCATE(ZCCS)
+ DEALLOCATE(ZCIS)
+ DEALLOCATE(ZTHS)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZEXNREF)
+ DEALLOCATE(ZZCPH)
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZLVFACT)
+ DEALLOCATE(ZLSFACT)
+ DEALLOCATE(ZRVSATW)
+ DEALLOCATE(ZRVSATI)
+ DEALLOCATE(ZRVSATW_PRIME)
+ DEALLOCATE(ZRVSATI_PRIME)
+ DEALLOCATE(ZDELTW)
+ DEALLOCATE(ZDELTI)
+ DEALLOCATE(ZAW)
+ DEALLOCATE(ZAI)
+ DEALLOCATE(ZCJ)
+ DEALLOCATE(ZKA)
+ DEALLOCATE(ZDV)
+ DEALLOCATE(ZITW)
+ DEALLOCATE(ZITI)
+ DEALLOCATE(ZAWW)
+ DEALLOCATE(ZAIW)
+ DEALLOCATE(ZAWI)
+ DEALLOCATE(ZAII)
+ DEALLOCATE(ZFACT)
+ DEALLOCATE(ZDELT1)
+ DEALLOCATE(ZDELT2)
+ DEALLOCATE(ZCND)
+ DEALLOCATE(ZDEP)
+END IF ! IMICRO
+!
+END IF ! OSUBG_COND
+!
+! full sublimation of the cloud ice crystals if there are few
+!
+ZMASK(:,:,:) = 0.0
+ZW(:,:,:) = 0.
+WHERE (PRIS(:,:,:) <= ZRTMIN(4) .OR. PCIS(:,:,:) <= ZCTMIN(4))
+ PRVS(:,:,:) = PRVS(:,:,:) + PRIS(:,:,:)
+ PTHS(:,:,:) = PTHS(:,:,:) - PRIS(:,:,:)*ZLS(:,:,:)/(ZCPH(:,:,:)*ZEXNS(:,:,:))
+ PRIS(:,:,:) = 0.0
+ ZW(:,:,:) = MAX(PCIS(:,:,:),0.)
+ PCIS(:,:,:) = 0.0
+END WHERE
+!
+IF (LCOLD .AND. (NMOD_IFN .GE. 1 .OR. NMOD_IMM .GE. 1)) THEN
+ ZW1(:,:,:) = 0.
+ IF (NMOD_IFN .GE. 1) ZW1(:,:,:) = ZW1(:,:,:) + SUM(PINS,DIM=4)
+ IF (NMOD_IMM .GE. 1) ZW1(:,:,:) = ZW1(:,:,:) + SUM(PNIS,DIM=4)
+ ZW (:,:,:) = MIN( ZW(:,:,:), ZW1(:,:,:) )
+ ZW2(:,:,:) = 0.
+ WHERE ( ZW(:,:,:) > 0. )
+ ZMASK(:,:,:) = 1.0
+ ZW2(:,:,:) = ZW(:,:,:) / ZW1(:,:,:)
+ ENDWHERE
+END IF
+!
+IF (LCOLD .AND. NMOD_IFN.GE.1) THEN
+ DO JMOD_IFN = 1, NMOD_IFN
+ PIFS(:,:,:,JMOD_IFN) = PIFS(:,:,:,JMOD_IFN) + &
+ ZMASK(:,:,:) * PINS(:,:,:,JMOD_IFN) * ZW2(:,:,:)
+ PINS(:,:,:,JMOD_IFN) = PINS(:,:,:,JMOD_IFN) - &
+ ZMASK(:,:,:) * PINS(:,:,:,JMOD_IFN) * ZW2(:,:,:)
+ PINS(:,:,:,JMOD_IFN) = MAX( 0.0 , PINS(:,:,:,JMOD_IFN) )
+ ENDDO
+END IF
+!
+IF (LCOLD .AND. NMOD_IMM.GE.1) THEN
+ JMOD_IMM = 0
+ DO JMOD = 1, NMOD_CCN
+ IF (NIMM(JMOD) == 1) THEN
+ JMOD_IMM = JMOD_IMM + 1
+ PNAS(:,:,:,JMOD) = PNAS(:,:,:,JMOD) + &
+ ZMASK(:,:,:) * PNIS(:,:,:,JMOD_IMM) * ZW2(:,:,:)
+ PNIS(:,:,:,JMOD_IMM) = PNIS(:,:,:,JMOD_IMM) - &
+ ZMASK(:,:,:) * PNIS(:,:,:,JMOD_IMM) * ZW2(:,:,:)
+ PNIS(:,:,:,JMOD_IMM) = MAX( 0.0 , PNIS(:,:,:,JMOD_IMM) )
+ END IF
+ ENDDO
+END IF
+!
+! complete evaporation of the cloud droplets if there are few
+!
+ZMASK(:,:,:) = 0.0
+ZW(:,:,:) = 0.
+WHERE (PRCS(:,:,:) <= ZRTMIN(2) .OR. PCCS(:,:,:) <= ZCTMIN(2))
+ PRVS(:,:,:) = PRVS(:,:,:) + PRCS(:,:,:)
+ PTHS(:,:,:) = PTHS(:,:,:) - PRCS(:,:,:)*ZLV(:,:,:)/(ZCPH(:,:,:)*ZEXNS(:,:,:))
+ PRCS(:,:,:) = 0.0
+ ZW(:,:,:) = MAX(PCCS(:,:,:),0.)
+ PCCS(:,:,:) = 0.0
+END WHERE
+!
+ZW1(:,:,:) = 0.
+IF (LWARM .AND. NMOD_CCN.GE.1) ZW1(:,:,:) = SUM(PNAS,DIM=4)
+ZW (:,:,:) = MIN( ZW(:,:,:), ZW1(:,:,:) )
+ZW2(:,:,:) = 0.
+WHERE ( ZW(:,:,:) > 0. )
+ ZMASK(:,:,:) = 1.0
+ ZW2(:,:,:) = ZW(:,:,:) / ZW1(:,:,:)
+ENDWHERE
+!
+IF (LWARM .AND. NMOD_CCN.GE.1) THEN
+ DO JMOD = 1, NMOD_CCN
+ PNFS(:,:,:,JMOD) = PNFS(:,:,:,JMOD) + &
+ ZMASK(:,:,:) * PNAS(:,:,:,JMOD) * ZW2(:,:,:)
+ PNAS(:,:,:,JMOD) = PNAS(:,:,:,JMOD) - &
+ ZMASK(:,:,:) * PNAS(:,:,:,JMOD) * ZW2(:,:,:)
+ PNAS(:,:,:,JMOD) = MAX( 0.0 , PNAS(:,:,:,JMOD) )
+ ENDDO
+END IF
+!
+IF (LSCAV .AND. LAERO_MASS) PMAS(:,:,:) = PMAS(:,:,:) * (1-ZMASK(:,:,:))
+!
+! end of the iterative loop
+!
+END DO
+!
+DEALLOCATE(ZRTMIN)
+DEALLOCATE(ZCTMIN)
+!
+!* 5.2 compute the cloud fraction PCLDFR (binary !!!!!!!)
+!
+IF ( .NOT. OSUBG_COND ) THEN
+ WHERE (PRCS(:,:,:) > 1.E-12 / ZDT)
+ ZW(:,:,:) = 1.
+ ELSEWHERE
+ ZW(:,:,:) = 0.
+ ENDWHERE
+ IF ( SIZE(PSRCS,3) /= 0 ) THEN
+ PSRCS(:,:,:) = ZW(:,:,:)
+ END IF
+END IF
+!
+IF ( HRAD /= 'NONE' ) THEN
+ PCLDFR(:,:,:) = ZW(:,:,:)
+END IF
+!
+IF ( OCLOSE_OUT ) THEN
+ ILENCH=LEN(YCOMMENT)
+ YRECFM ='NEB'
+ YCOMMENT='X_Y_Z_NEB (0)'
+ IGRID = 1
+ ILENG = SIZE(ZW,1)*SIZE(ZW,2)*SIZE(ZW,3)
+ CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZW,IGRID,ILENCH,YCOMMENT,IRESP)
+END IF
+!
+!
+!* 6. SAVE CHANGES IN PRS AND PSVS
+! ----------------------------
+!
+!
+! Prepare 3D water mixing ratios
+PRS(:,:,:,1) = PRVS(:,:,:)
+IF ( KRR .GE. 2 ) PRS(:,:,:,2) = PRCS(:,:,:)
+IF ( KRR .GE. 3 ) PRS(:,:,:,3) = PRRS(:,:,:)
+IF ( KRR .GE. 4 ) PRS(:,:,:,4) = PRIS(:,:,:)
+IF ( KRR .GE. 5 ) PRS(:,:,:,5) = PRSS(:,:,:)
+IF ( KRR .GE. 6 ) PRS(:,:,:,6) = PRGS(:,:,:)
+!
+! Prepare 3D number concentrations
+!
+IF ( LWARM ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
+IF ( LCOLD ) PSVS(:,:,:,NSV_LIMA_NI) = PCIS(:,:,:)
+!
+IF ( LSCAV .AND. LAERO_MASS ) PSVS(:,:,:,NSV_LIMA_SCAVMASS) = PMAS(:,:,:)
+!
+IF ( LWARM .AND. NMOD_CCN .GE. 1 ) THEN
+ PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = PNFS(:,:,:,:)
+ PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) = PNAS(:,:,:,:)
+END IF
+!
+IF ( LCOLD .AND. NMOD_IFN .GE. 1 ) THEN
+ PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1) = PIFS(:,:,:,:)
+ PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1) = PINS(:,:,:,:)
+END IF
+!
+IF ( LCOLD .AND. NMOD_IMM .GE. 1 ) THEN
+ PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1) = PNIS(:,:,:,:)
+END IF
+!
+! write SSI in LFI
+!
+IF ( OCLOSE_OUT ) THEN
+ ZT(:,:,:) = ( PTHS(:,:,:) * ZDT ) * ZEXNS(:,:,:)
+ ZW(:,:,:) = EXP( XALPI - XBETAI/ZT(:,:,:) - XGAMI*ALOG(ZT(:,:,:) ) )
+ ZW1(:,:,:)= 2.0*PPABST(:,:,:)-PPABSM(:,:,:)
+ ZW(:,:,:) = PRVT(:,:,:)*( ZW1(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) ) - 1.0
+
+ ILENCH=LEN(YCOMMENT)
+ YRECFM ='SSI'
+ YCOMMENT='X_Y_Z_SSI'
+ IGRID = 1
+ ILENG = SIZE(ZW,1)*SIZE(ZW,2)*SIZE(ZW,3)
+ CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZW,IGRID,ILENCH,YCOMMENT,IRESP)
+END IF
+!
+!
+!* 7. STORE THE BUDGET TERMS
+! ----------------------
+!
+!
+IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:) * PRHODJ(:,:,:),4,'CEDS_BU_RTH')
+ IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:) * PRHODJ(:,:,:),6,'CEDS_BU_RRV')
+ IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:) * PRHODJ(:,:,:),7,'CEDS_BU_RRC')
+ IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:) * PRHODJ(:,:,:),9,'CEDS_BU_RRI')
+ IF (LBUDGET_SV) THEN
+ CALL BUDGET (PCCS(:,:,:) * PRHODJ(:,:,:),12+NSV_LIMA_NC,'CEDS_BU_RSV') ! RCC
+ CALL BUDGET (PCIS(:,:,:) * PRHODJ(:,:,:),12+NSV_LIMA_NI,'CEDS_BU_RSV') ! RCI
+ IF (NMOD_CCN .GE. 1) THEN
+ DO JL = 1, NMOD_CCN
+ CALL BUDGET (PNFS(:,:,:,JL)*PRHODJ(:,:,:),12+NSV_LIMA_CCN_FREE+JL-1,'CEDS_BU_RSV') ! RCC
+ END DO
+ END IF
+ IF (NMOD_IFN .GE. 1) THEN
+ DO JL = 1, NMOD_IFN
+ CALL BUDGET (PIFS(:,:,:,JL)*PRHODJ(:,:,:),12+NSV_LIMA_IFN_FREE+JL-1,'CEDS_BU_RSV') ! RCC
+ END DO
+ END IF
+ END IF
+END IF
+!++cb++
+IF (ALLOCATED(PNFS)) DEALLOCATE(PNFS)
+IF (ALLOCATED(PNAS)) DEALLOCATE(PNAS)
+IF (ALLOCATED(PIFS)) DEALLOCATE(PIFS)
+IF (ALLOCATED(PINS)) DEALLOCATE(PINS)
+IF (ALLOCATED(PNIS)) DEALLOCATE(PNIS)
+!--cb--
+!
+!------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_ADJUST
diff --git a/src/MNH/lima_cold.f90 b/src/MNH/lima_cold.f90
new file mode 100644
index 000000000..fe9e92e6b
--- /dev/null
+++ b/src/MNH/lima_cold.f90
@@ -0,0 +1,414 @@
+! #####################
+ MODULE MODI_LIMA_COLD
+! #####################
+!
+INTERFACE
+ SUBROUTINE LIMA_COLD (OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
+ HFMFILE, HLUOUT, OCLOSE_OUT, KRR, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PW_NU, &
+ PTHM, PPABSM, &
+ PTHT, PRT, PSVT, &
+ PTHS, PRS, PSVS, &
+ PINPRS, PINPRG, PINPRH)
+!
+LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
+ ! cloud ice sedimentation
+LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
+INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
+ ! for ice sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
+ ! the tput FM fileoutp
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+ ! the nucleation param.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
+!
+END SUBROUTINE LIMA_COLD
+END INTERFACE
+END MODULE MODI_LIMA_COLD
+!
+! ######################################################################
+ SUBROUTINE LIMA_COLD (OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
+ HFMFILE, HLUOUT, OCLOSE_OUT, KRR, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PW_NU, &
+ PTHM, PPABSM, &
+ PTHT, PRT, PSVT, &
+ PTHS, PRS, PSVS, &
+ PINPRS, PINPRG, PINPRH)
+! ######################################################################
+!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the cold-phase
+!! microphysical sources involving only primary ice and snow, except for
+!! the sedimentation which also includes graupelns, and the homogeneous
+!! freezing of CCNs, cloud droplets and raindrops.
+!!
+!!
+!!** METHOD
+!! ------
+!! The nucleation of IFN is parameterized following either Meyers (1992)
+!! or Phillips (2008, 2013).
+!!
+!! The sedimentation rates are computed with a time spliting technique:
+!! an upstream scheme, written as a difference of non-advective fluxes.
+!! This source term is added to the next coming time step (split-implicit
+!! process).
+!!
+!!
+!! REFERENCES
+!! ----------
+!!
+!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
+!! microphysical bulk scheme.
+!! Part I: Description and tests
+!! Part II: 2D experiments with a non-hydrostatic model
+!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
+!!
+!! Phillips et al., 2008: An empirical parameterization of heterogeneous
+!! ice nucleation for multiple chemical species of aerosols, J. Atmos. Sci.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODD_NSV
+USE MODD_PARAM_LIMA
+!
+USE MODI_LIMA_COLD_SEDIMENTATION
+USE MODI_LIMA_MEYERS
+USE MODI_LIMA_PHILLIPS
+USE MODI_LIMA_COLD_HOM_NUCL
+USE MODI_LIMA_COLD_SLOW_PROCESSES
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
+ ! cloud ice sedimentation
+LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
+INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
+ ! for ice sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
+ ! the tput FM fileoutp
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+ ! the nucleation param.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
+ :: PRVT, & ! Water vapor m.r. at t
+ PRCT, & ! Cloud water m.r. at t
+ PRRT, & ! Rain water m.r. at t
+ PRIT, & ! Cloud ice m.r. at t
+ PRST, & ! Snow/aggregate m.r. at t
+ PRGT, & ! Graupel m.r. at t
+ PRHT, & ! Graupel m.r. at t
+ !
+ PRVS, & ! Water vapor m.r. source
+ PRCS, & ! Cloud water m.r. source
+ PRRS, & ! Rain water m.r. source
+ PRIS, & ! Pristine ice m.r. source
+ PRSS, & ! Snow/aggregate m.r. source
+ PRGS, & ! Graupel/hail m.r. source
+ PRHS, & ! Graupel/hail m.r. source
+ !
+ PCCT, & ! Cloud water C. at t
+ PCRT, & ! Rain water C. at t
+ PCIT, & ! Ice crystal C. at t
+ !
+ PCCS, & ! Cloud water C. source
+ PCRS, & ! Rain water C. source
+ PCIS ! Ice crystal C. source
+!
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PNFS ! CCN C. available source
+ !used as Free ice nuclei for
+ !HOMOGENEOUS nucleation of haze
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PNAS ! Cloud C. nuclei C. source
+ !used as Free ice nuclei for
+ !IMMERSION freezing
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PIFS ! Free ice nuclei C. source
+ !for DEPOSITION and CONTACT
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PINS ! Activated ice nuclei C. source
+ !for DEPOSITION and CONTACT
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PNIS ! Activated ice nuclei C. source
+ !for IMMERSION
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: PNHS ! Haze homogeneous activation
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 0. 3D MICROPHYSCAL VARIABLES
+! -------------------------
+!
+!
+! Prepare 3D water mixing ratios
+PRVT(:,:,:) = PRT(:,:,:,1)
+PRVS(:,:,:) = PRS(:,:,:,1)
+!
+PRCT(:,:,:) = 0.
+PRCS(:,:,:) = 0.
+PRRT(:,:,:) = 0.
+PRRS(:,:,:) = 0.
+PRIT(:,:,:) = 0.
+PRIS(:,:,:) = 0.
+PRST(:,:,:) = 0.
+PRSS(:,:,:) = 0.
+PRGT(:,:,:) = 0.
+PRGS(:,:,:) = 0.
+PRHT(:,:,:) = 0.
+PRHS(:,:,:) = 0.
+!
+IF ( KRR .GE. 2 ) PRCT(:,:,:) = PRT(:,:,:,2)
+IF ( KRR .GE. 2 ) PRCS(:,:,:) = PRS(:,:,:,2)
+IF ( KRR .GE. 3 ) PRRT(:,:,:) = PRT(:,:,:,3)
+IF ( KRR .GE. 3 ) PRRS(:,:,:) = PRS(:,:,:,3)
+IF ( KRR .GE. 4 ) PRIT(:,:,:) = PRT(:,:,:,4)
+IF ( KRR .GE. 4 ) PRIS(:,:,:) = PRS(:,:,:,4)
+IF ( KRR .GE. 5 ) PRST(:,:,:) = PRT(:,:,:,5)
+IF ( KRR .GE. 5 ) PRSS(:,:,:) = PRS(:,:,:,5)
+IF ( KRR .GE. 6 ) PRGT(:,:,:) = PRT(:,:,:,6)
+IF ( KRR .GE. 6 ) PRGS(:,:,:) = PRS(:,:,:,6)
+IF ( KRR .GE. 7 ) PRHT(:,:,:) = PRT(:,:,:,7)
+IF ( KRR .GE. 7 ) PRHS(:,:,:) = PRS(:,:,:,7)
+!
+! Prepare 3D number concentrations
+PCCT(:,:,:) = 0.
+PCRT(:,:,:) = 0.
+PCIT(:,:,:) = 0.
+PCCS(:,:,:) = 0.
+PCRS(:,:,:) = 0.
+PCIS(:,:,:) = 0.
+!
+IF ( LWARM ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
+IF ( LWARM .AND. LRAIN ) PCRT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NR)
+IF ( LCOLD ) PCIT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NI)
+!
+IF ( LWARM ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
+IF ( LWARM .AND. LRAIN ) PCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
+IF ( LCOLD ) PCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
+!
+IF ( NMOD_CCN .GE. 1 ) THEN
+ ALLOCATE( PNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ ALLOCATE( PNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ PNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)
+ PNAS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)
+ELSE
+ ALLOCATE( PNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
+ ALLOCATE( PNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
+ PNFS(:,:,:,:) = 0.
+ PNAS(:,:,:,:) = 0.
+END IF
+!
+IF ( NMOD_IFN .GE. 1 ) THEN
+ ALLOCATE( PIFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
+ ALLOCATE( PINS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
+ PIFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1)
+ PINS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1)
+ELSE
+ ALLOCATE( PIFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
+ ALLOCATE( PINS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
+ PIFS(:,:,:,:) = 0.
+ PINS(:,:,:,:) = 0.
+END IF
+!
+IF ( NMOD_IMM .GE. 1 ) THEN
+ ALLOCATE( PNIS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IMM) )
+ PNIS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1)
+ELSE
+ ALLOCATE( PNIS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
+ PNIS(:,:,:,:) = 0.0
+END IF
+!
+IF ( OHHONI ) THEN
+ ALLOCATE( PNHS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) )
+ PNHS(:,:,:) = PSVS(:,:,:,NSV_LIMA_HOM_HAZE)
+ELSE
+ ALLOCATE( PNHS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) )
+ PNHS(:,:,:) = 0.0
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. COMPUTE THE SEDIMENTATION (RS) SOURCE
+! -------------------------------------
+!
+CALL LIMA_COLD_SEDIMENTATION (OSEDI, KSPLITG, PTSTEP, KMI, &
+ HFMFILE, HLUOUT, OCLOSE_OUT, &
+ PZZ, PRHODJ, PRHODREF, &
+ PRIT, PCIT, &
+ PRIS, PRSS, PRGS, PRHS, PCIS, &
+ PINPRS, PINPRG,&
+ PINPRH )
+!-------------------------------------------------------------------------------
+!
+!
+! COMPUTE THE NUCLEATION PROCESS SOURCES
+! --------------------------------------
+!
+IF (LNUCL) THEN
+!
+ IF ( LMEYERS ) THEN
+ PIFS(:,:,:,:) = 0.0
+ PNIS(:,:,:,:) = 0.0
+ CALL LIMA_MEYERS (OHHONI, PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT, &
+ PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PCCT, &
+ PTHS, PRVS, PRCS, PRIS, &
+ PCCS, PCIS, PINS )
+ ELSE
+ CALL LIMA_PHILLIPS (OHHONI, PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT, &
+ PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PTHS, PRVS, PRCS, PRIS, &
+ PCIT, PCCS, PCIS, &
+ PNAS, PIFS, PINS, PNIS )
+ END IF
+!
+ IF (LWARM) THEN
+ CALL LIMA_COLD_HOM_NUCL (OHHONI, PTSTEP, KMI, &
+ HFMFILE, HLUOUT, OCLOSE_OUT, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PW_NU, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PTHS, PRVS, PRCS, PRRS, PRIS, PRGS, &
+ PCCT, &
+ PCCS, PCRS, PNFS, &
+ PCIS, PNIS, PNHS )
+ END IF
+!
+END IF
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 4. SLOW PROCESSES: depositions, aggregation
+! ----------------------------------------
+!
+IF (LSNOW) THEN
+!
+ CALL LIMA_COLD_SLOW_PROCESSES(PTSTEP, KMI, HFMFILE, HLUOUT, &
+ OCLOSE_OUT, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PTHS, PRVS, PRIS, PRSS, &
+ PCIT, PCIS )
+!
+END IF
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 4. REPORT 3D MICROPHYSICAL VARIABLES IN PRS AND PSVS
+! -------------------------------------------------
+!
+PRS(:,:,:,1) = PRVS(:,:,:)
+IF ( KRR .GE. 2 ) PRS(:,:,:,2) = PRCS(:,:,:)
+IF ( KRR .GE. 3 ) PRS(:,:,:,3) = PRRS(:,:,:)
+IF ( KRR .GE. 4 ) PRS(:,:,:,4) = PRIS(:,:,:)
+IF ( KRR .GE. 5 ) PRS(:,:,:,5) = PRSS(:,:,:)
+IF ( KRR .GE. 6 ) PRS(:,:,:,6) = PRGS(:,:,:)
+IF ( KRR .GE. 7 ) PRS(:,:,:,7) = PRHS(:,:,:)
+!
+! Prepare 3D number concentrations
+!
+IF ( LWARM ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
+IF ( LWARM .AND. LRAIN ) PSVS(:,:,:,NSV_LIMA_NR) = PCRS(:,:,:)
+IF ( LCOLD ) PSVS(:,:,:,NSV_LIMA_NI) = PCIS(:,:,:)
+!
+IF ( NMOD_CCN .GE. 1 ) THEN
+ PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = PNFS(:,:,:,:)
+ PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) = PNAS(:,:,:,:)
+END IF
+!
+IF ( NMOD_IFN .GE. 1 ) THEN
+ PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1) = PIFS(:,:,:,:)
+ PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1) = PINS(:,:,:,:)
+END IF
+!
+IF ( NMOD_IMM .GE. 1 ) THEN
+ PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1) = PNIS(:,:,:,:)
+END IF
+
+IF ( OHHONI ) PSVS(:,:,:,NSV_LIMA_HOM_HAZE) = PNHS(:,:,:)
+!
+!++cb++
+IF (ALLOCATED(PNFS)) DEALLOCATE(PNFS)
+IF (ALLOCATED(PNAS)) DEALLOCATE(PNAS)
+IF (ALLOCATED(PIFS)) DEALLOCATE(PIFS)
+IF (ALLOCATED(PINS)) DEALLOCATE(PINS)
+IF (ALLOCATED(PNIS)) DEALLOCATE(PNIS)
+IF (ALLOCATED(PNHS)) DEALLOCATE(PNHS)
+!--cb--
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_COLD
diff --git a/src/MNH/lima_cold_hom_nucl.f90 b/src/MNH/lima_cold_hom_nucl.f90
new file mode 100644
index 000000000..a8e8c6f94
--- /dev/null
+++ b/src/MNH/lima_cold_hom_nucl.f90
@@ -0,0 +1,684 @@
+! ######################
+ MODULE MODI_LIMA_COLD_HOM_NUCL
+! ######################
+!
+INTERFACE
+ SUBROUTINE LIMA_COLD_HOM_NUCL (OHHONI, PTSTEP, KMI, &
+ HFMFILE, HLUOUT, OCLOSE_OUT, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PW_NU, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PTHS, PRVS, PRCS, PRRS, PRIS, PRGS, &
+ PCCT, &
+ PCCS, PCRS, PNFS, &
+ PCIS, PNIS, PNHS )
+!
+LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
+ ! the tput FM fileoutp
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+ ! the nucleation param.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel/hail m.r. source
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFS ! CCN C. available source
+ !used as Free ice nuclei for
+ !HOMOGENEOUS nucleation of haze
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIS ! Activated ice nuclei C. source
+ !for IMMERSION
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHS ! haze homogeneous freezing
+!
+END SUBROUTINE LIMA_COLD_HOM_NUCL
+END INTERFACE
+END MODULE MODI_LIMA_COLD_HOM_NUCL
+!
+! ######################################################################
+ SUBROUTINE LIMA_COLD_HOM_NUCL (OHHONI, PTSTEP, KMI, &
+ HFMFILE, HLUOUT, OCLOSE_OUT, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PW_NU, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PTHS, PRVS, PRCS, PRRS, PRIS, PRGS, &
+ PCCT, &
+ PCCS, PCRS, PNFS, &
+ PCIS, PNIS, PNHS )
+! ######################################################################
+!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the cold-phase homogeneous
+!! freezing of CCN, droplets and drops (T<-35°C)
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! C. Barthe * LACy* jan. 2014 add budgets
+!!
+!-------------------------------------------------------------------------------
+!
+!* 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 MODI_BUDGET
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
+ ! the tput FM fileoutp
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+ ! the nucleation param.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel/hail m.r. source
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFS ! CCN C. available source
+ !used as Free ice nuclei for
+ !HOMOGENEOUS nucleation of haze
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIS ! Activated ice nuclei C. source
+ !for IMMERSION
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHS ! haze homogeneous freezing
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel/hail m.r. at t
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZCCT ! Cloud water conc. at t
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHS ! Theta source
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVS ! Water vapor m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRS ! Rain water m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRGS ! Graupel/hail m.r. source
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZCCS ! Cloud water conc. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZCRS ! Rain water conc. source
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFS ! available nucleus conc. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZCIS ! Pristine ice conc. source
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNIS ! Nucleated Ice nuclei conc. source
+ !by Immersion
+REAL, DIMENSION(:), ALLOCATABLE :: ZZNHS ! Nucleated Ice nuclei conc. source
+ !by Homogeneous freezing
+!
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZNHS ! Nucleated Ice nuclei conc. source
+ ! by Homogeneous freezing of haze
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZW, ZT ! work arrays
+!
+REAL, DIMENSION(:), ALLOCATABLE &
+ :: ZRHODREF, & ! RHO Dry REFerence
+ ZRHODJ, & ! RHO times Jacobian
+ ZZT, & ! Temperature
+ ZPRES, & ! Pressure
+ ZEXNREF, & ! EXNer Pressure REFerence
+ ZZW, & ! Work array
+ ZZX, & ! Work array
+ ZZY, & ! Work array
+ ZLSFACT, & ! L_s/(Pi_ref*C_ph)
+ ZLVFACT, & ! L_v/(Pi_ref*C_ph)
+ ZLBDAC, & ! Slope parameter of the cloud droplet distr.
+ ZSI, & ! Saturation over ice
+ ZTCELSIUS,&
+ ZLS, &
+ ZPSI1, &
+ ZPSI2, &
+ ZTAU, &
+ ZBFACT, &
+ ZW_NU, &
+ ZFREECCN, &
+ ZCCNFROZEN
+!
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
+INTEGER :: JL, JMOD_CCN, JMOD_IMM ! Loop index
+!
+INTEGER :: INEGT ! Case number of hom. nucleation
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: GNEGT ! Test where to compute the hom. nucleation
+INTEGER , DIMENSION(SIZE(GNEGT)) :: I1,I2,I3 ! Used to replace the COUNT
+!
+REAL :: ZEPS ! molar mass ratio
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+!
+!
+! Physical domain
+IIB=1+JPHEXT
+IIE=SIZE(PZZ,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PZZ,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PZZ,3) - JPVEXT
+!
+! Temperature
+ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
+!
+IF( OHHONI ) THEN
+ ZNHS(:,:,:) = PNHS(:,:,:)
+ELSE
+ ZNHS(:,:,:) = 0.0
+END IF
+!
+! Computations only where the temperature is below -35°C
+! PACK variables
+!
+GNEGT(:,:,:) = .FALSE.
+GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<XTT-35.0
+INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
+!
+IF (INEGT.GT.0) THEN
+
+ ALLOCATE(ZRVT(INEGT))
+ ALLOCATE(ZRCT(INEGT))
+ ALLOCATE(ZRRT(INEGT))
+ ALLOCATE(ZRIT(INEGT))
+ ALLOCATE(ZRST(INEGT))
+ ALLOCATE(ZRGT(INEGT))
+ !
+ ALLOCATE(ZCCT(INEGT))
+ !
+ ALLOCATE(ZRVS(INEGT))
+ ALLOCATE(ZRCS(INEGT))
+ ALLOCATE(ZRRS(INEGT))
+ ALLOCATE(ZRIS(INEGT))
+ ALLOCATE(ZRGS(INEGT))
+ !
+ ALLOCATE(ZTHS(INEGT))
+ !
+ ALLOCATE(ZCCS(INEGT))
+ ALLOCATE(ZCRS(INEGT))
+ ALLOCATE(ZCIS(INEGT))
+ !
+ ALLOCATE(ZNFS(INEGT,NMOD_CCN))
+ ALLOCATE(ZNIS(INEGT,NMOD_IMM))
+ ALLOCATE(ZZNHS(INEGT))
+ !
+ ALLOCATE(ZRHODREF(INEGT))
+ ALLOCATE(ZZT(INEGT))
+ ALLOCATE(ZPRES(INEGT))
+ ALLOCATE(ZEXNREF(INEGT))
+ !
+ DO JL=1,INEGT
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
+ ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
+ ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
+ !
+ ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
+ !
+ ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
+ ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
+ ZRRS(JL) = PRRS(I1(JL),I2(JL),I3(JL))
+ ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
+ ZRGS(JL) = PRGS(I1(JL),I2(JL),I3(JL))
+ !
+ ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+ !
+ ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
+ ZCRS(JL) = PCRS(I1(JL),I2(JL),I3(JL))
+ ZCIS(JL) = PCIS(I1(JL),I2(JL),I3(JL))
+ !
+ DO JMOD_CCN = 1, NMOD_CCN
+ ZNFS(JL,JMOD_CCN) = PNFS(I1(JL),I2(JL),I3(JL),JMOD_CCN)
+ ENDDO
+ DO JMOD_IMM = 1, NMOD_IMM
+ ZNIS(JL,JMOD_IMM) = PNIS(I1(JL),I2(JL),I3(JL),JMOD_IMM)
+ ENDDO
+ ZZNHS(JL) = ZNHS(I1(JL),I2(JL),I3(JL))
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ ENDDO
+!
+! PACK : done
+! Prepare computations
+!
+ ALLOCATE( ZLSFACT (INEGT) )
+ ALLOCATE( ZLVFACT (INEGT) )
+ ALLOCATE( ZSI (INEGT) )
+ ALLOCATE( ZTCELSIUS (INEGT) )
+ ALLOCATE( ZLBDAC (INEGT) )
+!
+ ALLOCATE( ZZW (INEGT) ) ; ZZW(:) = 0.0
+ ALLOCATE( ZZX (INEGT) ) ; ZZX(:) = 0.0
+ ALLOCATE( ZZY (INEGT) ) ; ZZY(:) = 0.0
+!
+ ZTCELSIUS(:) = ZZT(:)-XTT ! T [°C]
+ ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
+ +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
+ ZLSFACT(:) = (XLSTT+(XCPV-XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
+ ZLVFACT(:) = (XLVTT+(XCPV-XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
+!
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((XMV/XMD)*ZZW(:)) ! Saturation over ice
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. Haze homogeneous freezing
+! ------------------------
+!
+!
+! Compute the haze homogeneous nucleation source: RHHONI
+!
+ IF( OHHONI .AND. NMOD_CCN.GT.0 ) THEN
+
+! Sum of the available CCN
+ ALLOCATE( ZFREECCN(INEGT) )
+ ALLOCATE( ZCCNFROZEN(INEGT) )
+ ZFREECCN(:)=0.
+ ZCCNFROZEN(:)=0.
+ DO JMOD_CCN = 1, NMOD_CCN
+ ZFREECCN(:) = ZFREECCN(:) + ZNFS(:,JMOD_CCN)
+ END DO
+!
+ ALLOCATE(ZW_NU(INEGT))
+ DO JL=1,INEGT
+ ZW_NU(JL) = PW_NU(I1(JL),I2(JL),I3(JL))
+ END DO
+!
+ ZZW(:) = 0.0
+ ZZX(:) = 0.0
+ ZEPS = XMV / XMD
+ ZZY(:) = XCRITSAT1_HONH - & ! Critical Sat.
+ (MIN( XTMAX_HONH,MAX( XTMIN_HONH,ZZT(:) ) )/XCRITSAT2_HONH)
+!
+ ALLOCATE(ZLS(INEGT))
+ ALLOCATE(ZPSI1(INEGT))
+ ALLOCATE(ZPSI2(INEGT))
+ ALLOCATE(ZTAU(INEGT))
+ ALLOCATE(ZBFACT(INEGT))
+!
+ WHERE( (ZZT(:)<XTT-35.0) .AND. (ZSI(:)>ZZY(:)) .AND. (ZTHS(:)<-1.0E-6) )
+ ZLS(:) = XLSTT+(XCPV-XCI)*ZTCELSIUS(:) ! Ls
+!
+ ZPSI1(:) = ZZY(:) * (XG/(XRD*ZZT(:)))*(ZEPS*ZLS(:)/(XCPD*ZZT(:))-1.)
+! ! Psi1 (a1*Scr in KL01)
+! BV correction PSI2 enlever 1/ZEPS ?
+! ZPSI2(:) = ZSI(:) * (1.0/ZEPS+1.0/ZRVT(:)) + &
+ ZPSI2(:) = ZSI(:) * (1.0/ZRVT(:)) + &
+ ZZY(:) * ((ZLS(:)/ZZT(:))**2)/(XCPD*XRV)
+! ! Psi2 (a2+a3*Scr in KL01)
+ ZTAU(:) = 1.0 / ( MAX( XC1_HONH,XC1_HONH*(XC2_HONH-XC3_HONH*ZZT(:)) ) *&
+ ABS( (XDLNJODT1_HONH - XDLNJODT2_HONH*ZZT(:)) * &
+ ((ZPRES(:)/XP00)**(XRD/XCPD))*ZTHS(:) ) )
+!
+ ZBFACT(:) = (XRHOI_HONH/ZRHODREF(:)) * (ZSI(:)/(ZZY(:)-1.0)) &
+! BV correction ZBFACT enlever 1/ZEPS ?
+! * (1.0/ZRVT(:)+1.0/ZEPS) &
+ * (1.0/ZRVT(:)) &
+ / (XCOEF_DIFVAP_HONH*(ZZT(:)**XCEXP_DIFVAP_HONH /ZPRES(:)))
+!
+! BV correction ZZX rho_i{-1} ?
+! ZZX(:) = MAX( MIN( XRHOI_HONH*ZBFACT(:)**1.5 * (ZPSI1(:)/ZPSI2(:)) &
+ ZZX(:) = MAX( MIN( (1/XRHOI_HONH)*ZBFACT(:)**1.5 * (ZPSI1(:)/ZPSI2(:)) &
+! BV correction ZZX PTSTEP wrong place ?
+! * (ZW_NU(:)/SQRT(ZTAU(:))), ZNFS(:,JMOD_CCN) )/PTSTEP , 0.)
+ * (ZW_NU(:)/SQRT(ZTAU(:)))/PTSTEP , ZFREECCN(:) ) , 0.)
+!
+ ZZW(:) = MIN( XRCOEF_HONH*ZZX(:)*(ZTAU(:)/ZBFACT(:))**1.5 , ZRVS(:) )
+ END WHERE
+!
+! Apply the changes to ZNFS,
+ DO JMOD_CCN = 1, NMOD_CCN
+ ZCCNFROZEN(:) = ZZX(:) * ZNFS(:,JMOD_CCN)/ZFREECCN(:)
+ ZNFS(:,JMOD_CCN) = ZNFS(:,JMOD_CCN) - ZCCNFROZEN(:)
+ ZW(:,:,:) = PNFS(:,:,:,JMOD_CCN)
+ PNFS(:,:,:,JMOD_CCN)=UNPACK( ZNFS(:,JMOD_CCN), MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:))
+ END DO
+!
+ ZZNHS(:) = ZZNHS(:) + ZZX(:)
+ ZNHS(:,:,:) = ZNHS(:,:,:) + UNPACK( ZZNHS(:), MASK=GNEGT(:,:,:),FIELD=0.0)
+ PNHS(:,:,:) = ZNHS(:,:,:)
+!
+ DEALLOCATE(ZFREECCN)
+ DEALLOCATE(ZCCNFROZEN)
+ DEALLOCATE(ZLS)
+ DEALLOCATE(ZPSI1)
+ DEALLOCATE(ZPSI2)
+ DEALLOCATE(ZTAU)
+ DEALLOCATE(ZBFACT)
+ DEALLOCATE(ZW_NU)
+!
+ ZRVS(:) = ZRVS(:) - ZZW(:)
+ ZRIS(:) = ZRIS(:) + ZZW(:)
+ ZTHS(:) = ZTHS(:) + ZZW(:) * (ZLSFACT(:)-ZLVFACT(:)) ! f(L_s*(RHHONI))
+ ZCIS(:) = ZCIS(:) + ZZX(:)
+!
+ END IF ! OHHONI
+!
+! Budget storage
+ IF (NBUMOD==KMI .AND. LBU_ENABLE .AND. OHHONI) THEN
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
+ 4,'HONH_BU_RTH')
+ IF (LBUDGET_RV) CALL BUDGET ( &
+ UNPACK(ZRVS(:),MASK=GNEGT(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:),&
+ 6,'HONH_BU_RRV')
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(ZRIS(:),MASK=GNEGT(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
+ 9,'HONH_BU_RRI')
+ IF (LBUDGET_SV) THEN
+ CALL BUDGET ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
+ 12+NSV_LIMA_NI,'HONH_BU_RSV') ! RCI
+ IF (NMOD_CCN.GE.1) THEN
+ DO JL=1, NMOD_CCN
+ CALL BUDGET ( UNPACK(ZNFS(:,JL),MASK=GNEGT(:,:,:),FIELD=PNFS(:,:,:,JL))*PRHODJ(:,:,:),&
+ 12+NSV_LIMA_CCN_FREE+JL-1,'HONH_BU_RSV')
+ END DO
+ END IF
+ END IF
+ END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3. Cloud droplets homogeneous freezing
+! -----------------------------------
+!
+!
+! Compute the droplet homogeneous nucleation source: RCHONI
+! -> Pruppacher(1995)
+!
+ ZZW(:) = 0.0
+ ZZX(:) = 0.0
+ WHERE( (ZZT(:)<XTT-35.0) .AND. (ZCCT(:)>XCTMIN(2)) .AND. (ZRCT(:)>XRTMIN(2)) )
+ ZLBDAC(:) = XLBC*ZCCT(:) / (ZRCT(:)) ! Lambda_c**3
+ ZZX(:) = 1.0 / ( 1.0 + (XC_HONC/ZLBDAC(:))*PTSTEP* &
+ EXP( XTEXP1_HONC + ZTCELSIUS(:)*( &
+ XTEXP2_HONC + ZTCELSIUS(:)*( &
+ XTEXP3_HONC + ZTCELSIUS(:)*( &
+ XTEXP4_HONC + ZTCELSIUS(:)*XTEXP5_HONC))) ) )**XNUC
+ ZZW(:) = ZCCS(:) * (1.0 - ZZX(:)) ! CCHONI
+!
+ ZCCS(:) = ZCCS(:) - ZZW(:)
+ ZCIS(:) = ZCIS(:) + ZZW(:)
+!
+ ZZW(:) = ZRCS(:) * (1.0 - ZZX(:)) ! RCHONI
+!
+ ZRCS(:) = ZRCS(:) - ZZW(:)
+ ZRIS(:) = ZRIS(:) + ZZW(:)
+ ZTHS(:) = ZTHS(:) + ZZW(:) * (ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RCHONI))
+ END WHERE
+!
+! Budget storage
+ IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
+ 4,'HONC_BU_RTH')
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(ZRCS(:),MASK=GNEGT(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:),&
+ 7,'HONC_BU_RRC')
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(ZRIS(:),MASK=GNEGT(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
+ 9,'HONC_BU_RRI')
+ IF (LBUDGET_SV) THEN
+ CALL BUDGET ( UNPACK(ZCCS(:),MASK=GNEGT(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:),&
+ 12+NSV_LIMA_NC,'HONC_BU_RSV')
+ CALL BUDGET ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
+ 12+NSV_LIMA_NI,'HONC_BU_RSV')
+ END IF
+ END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 4. Rain drops homogeneous freezing
+! -------------------------------
+!
+!
+! Compute the drop homogeneous nucleation source: RRHONG
+!
+ ZZW(:) = 0.0
+ WHERE( (ZZT(:)<XTT-35.0) .AND. (ZRRS(:)>0.) )
+ ZZW(:) = ZRRS(:) ! Instantaneous freezing of the raindrops
+ ZRRS(:) = ZRRS(:) - ZZW(:)
+ ZRGS(:) = ZRGS(:) + ZZW(:)
+ ZTHS(:) = ZTHS(:) + ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RRHONG))
+!
+ ZCRS(:) = 0.0 ! No more raindrops when T<-35 C
+ ENDWHERE
+!
+! Budget storage
+ IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
+ 4,'HONR_BU_RTH')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(ZRRS(:),MASK=GNEGT(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:),&
+ 8,'HONR_BU_RRR')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(ZRGS(:),MASK=GNEGT(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:),&
+ 11,'HONR_BU_RRG')
+ IF (LBUDGET_SV) THEN
+ CALL BUDGET ( UNPACK(ZCRS(:),MASK=GNEGT(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:),&
+ 12+NSV_LIMA_NR,'HONR_BU_RSV')
+ END IF
+ END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 4. Unpack variables, clean
+! -----------------------
+!
+!
+! End of homogeneous nucleation processes
+!
+ ZW(:,:,:) = PRVS(:,:,:)
+ PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRCS(:,:,:)
+ PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRRS(:,:,:)
+ PRRS(:,:,:) = UNPACK( ZRRS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRIS(:,:,:)
+ PRIS(:,:,:) = UNPACK( ZRIS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRGS(:,:,:)
+ PRGS(:,:,:) = UNPACK( ZRGS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PTHS(:,:,:)
+ PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PCCS(:,:,:)
+ PCCS(:,:,:) = UNPACK( ZCCS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PCRS(:,:,:)
+ PCRS(:,:,:) = UNPACK( ZCRS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PCIS(:,:,:)
+ PCIS(:,:,:) = UNPACK( ZCIS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+!
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZRIT)
+ DEALLOCATE(ZRST)
+ DEALLOCATE(ZRGT)
+!
+ DEALLOCATE(ZCCT)
+!
+ DEALLOCATE(ZRVS)
+ DEALLOCATE(ZRCS)
+ DEALLOCATE(ZRRS)
+ DEALLOCATE(ZRIS)
+ DEALLOCATE(ZRGS)
+!
+ DEALLOCATE(ZTHS)
+!
+ DEALLOCATE(ZCCS)
+ DEALLOCATE(ZCRS)
+ DEALLOCATE(ZCIS)
+!
+ DEALLOCATE(ZNFS)
+ DEALLOCATE(ZNIS)
+ DEALLOCATE(ZZNHS)
+!
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZEXNREF)
+!
+ DEALLOCATE(ZLSFACT)
+ DEALLOCATE(ZLVFACT)
+ DEALLOCATE(ZSI)
+ DEALLOCATE(ZTCELSIUS)
+ DEALLOCATE(ZLBDAC)
+!
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZZX)
+ DEALLOCATE(ZZY)
+!
+ELSE
+!
+! Advance the budget calls
+!
+ IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_TH) THEN
+ ZW(:,:,:) = PTHS(:,:,:)*PRHODJ(:,:,:)
+ IF( OHHONI ) CALL BUDGET (ZW,4,'HONH_BU_RTH')
+ CALL BUDGET (ZW,4,'HONC_BU_RTH')
+ CALL BUDGET (ZW,4,'HONR_BU_RTH')
+ ENDIF
+ IF (LBUDGET_RV) THEN
+ ZW(:,:,:) = PRVS(:,:,:)*PRHODJ(:,:,:)
+ IF( OHHONI ) CALL BUDGET (ZW,6,'HONH_BU_RRV')
+ ENDIF
+ IF (LBUDGET_RC) THEN
+ ZW(:,:,:) = PRCS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,7,'HONC_BU_RRC')
+ ENDIF
+ IF (LBUDGET_RR) THEN
+ ZW(:,:,:) = PRRS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,8,'HONR_BU_RRR')
+ ENDIF
+ IF (LBUDGET_RI) THEN
+ ZW(:,:,:) = PRIS(:,:,:)*PRHODJ(:,:,:)
+ IF( OHHONI ) CALL BUDGET (ZW,9,'HONH_BU_RRI')
+ CALL BUDGET (ZW,9,'HONC_BU_RRI')
+ ENDIF
+ IF (LBUDGET_RG) THEN
+ ZW(:,:,:) = PRGS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,11,'HONR_BU_RRG')
+ ENDIF
+ IF (LBUDGET_SV) THEN
+ ZW(:,:,:) = PCCS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,12+NSV_LIMA_NC,'HONC_BU_RSV')
+ ZW(:,:,:) = PCRS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,12+NSV_LIMA_NR,'HONR_BU_RSV')
+ ZW(:,:,:) = PCIS(:,:,:)*PRHODJ(:,:,:)
+ IF( OHHONI ) CALL BUDGET (ZW,12+NSV_LIMA_NI,'HONH_BU_RSV')
+ CALL BUDGET (ZW,12+NSV_LIMA_NI,'HONC_BU_RSV')
+ IF (NMOD_CCN.GE.1) THEN
+ DO JL=1, NMOD_CCN
+ CALL BUDGET ( UNPACK(ZNFS(:,JL),MASK=GNEGT(:,:,:),FIELD=PNFS(:,:,:,JL))*PRHODJ(:,:,:),&
+ 12+NSV_LIMA_CCN_FREE+JL-1,'HONH_BU_RSV')
+ END DO
+ END IF
+ END IF
+ END IF
+!
+END IF ! INEGT>0
+!
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_COLD_HOM_NUCL
diff --git a/src/MNH/lima_cold_sedimentation.f90 b/src/MNH/lima_cold_sedimentation.f90
new file mode 100644
index 000000000..dc65c211c
--- /dev/null
+++ b/src/MNH/lima_cold_sedimentation.f90
@@ -0,0 +1,378 @@
+! ###################################
+ MODULE MODI_LIMA_COLD_SEDIMENTATION
+! ###################################
+!
+INTERFACE
+ SUBROUTINE LIMA_COLD_SEDIMENTATION (OSEDI, KSPLITG, PTSTEP, KMI, &
+ HFMFILE, HLUOUT, OCLOSE_OUT, &
+ PZZ, PRHODJ, PRHODREF, &
+ PRIT, PCIT, &
+ PRIS, PRSS, PRGS, PRHS, PCIS, &
+ PINPRS, PINPRG, PINPRH )
+!
+LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
+ ! cloud ice sedimentation
+INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
+ ! for ice sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
+ ! the FM file output
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian (Budgets)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Ice crystal C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
+
+!
+ END SUBROUTINE LIMA_COLD_SEDIMENTATION
+END INTERFACE
+END MODULE MODI_LIMA_COLD_SEDIMENTATION
+!
+!
+! ######################################################################
+ SUBROUTINE LIMA_COLD_SEDIMENTATION (OSEDI, KSPLITG, PTSTEP, KMI, &
+ HFMFILE, HLUOUT, OCLOSE_OUT, &
+ PZZ, PRHODJ, PRHODREF, &
+ PRIT, PCIT, &
+ PRIS, PRSS, PRGS, PRHS, PCIS, &
+ PINPRS,PINPRG,&
+ PINPRH )
+! ######################################################################
+!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the sediimentation
+!! of primary ice, snow and graupel.
+!!
+!! METHOD
+!! ------
+!! The sedimentation rates are computed with a time spliting technique:
+!! an upstream scheme, written as a difference of non-advective fluxes.
+!! This source term is added to the next coming time step (split-implicit
+!! process).
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! C. Barthe * LACy * jan. 2014 add budgets
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+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
+USE MODD_BUDGET
+USE MODI_BUDGET
+!++cb++
+IMPLICIT NONE
+!--cb--
+
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
+ ! cloud ice sedimentation
+INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
+ ! for ice sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
+ ! the FM file output
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian (Budgets)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Ice crystal C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
+
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: JK, JL, JN ! Loop index
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
+INTEGER :: ISEDIM ! Case number of sedimentation
+!
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: GSEDIM ! Test where to compute the SED processes
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZW, & ! Work array
+ ZWSEDR, & ! Sedimentation of MMR
+ ZWSEDC ! Sedimentation of number conc.
+!
+REAL, DIMENSION(:), ALLOCATABLE &
+ :: ZRIS, & ! Pristine ice m.r. source
+ ZCIS, & ! Pristine ice conc. source
+ ZRSS, & ! Snow/aggregate m.r. source
+ ZRGS, & ! Graupel/hail m.r. source
+ ZRHS, & ! Graupel/hail m.r. source
+ ZRIT, & ! Pristine ice m.r. at t
+ ZCIT, & ! Pristine ice conc. at t
+ ZRHODREF, & ! RHO Dry REFerence
+ ZRHODJ, & ! RHO times Jacobian
+ ZZW, & ! Work array
+ ZZX, & ! Work array
+ ZZY, & ! Work array
+ ZLBDAI, & ! Slope parameter of the ice crystal distr.
+ ZRTMIN
+!
+INTEGER , DIMENSION(SIZE(PRHODREF)) :: I1,I2,I3 ! Indexes for PACK replacement
+!
+REAL :: ZTSPLITG ! Small time step for rain sedimentation
+!
+!
+!-------------------------------------------------------------------------------
+!
+! Physical domain
+!
+IIB=1+JPHEXT
+IIE=SIZE(PZZ,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PZZ,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PZZ,3) - JPVEXT
+!
+! Time splitting and ZRTMIN
+!
+ALLOCATE(ZRTMIN(SIZE(XRTMIN)))
+ZRTMIN(:) = XRTMIN(:) / PTSTEP
+!
+ZTSPLITG= PTSTEP / FLOAT(KSPLITG)
+!
+! ################################
+! Compute the sedimentation fluxes
+! ################################
+!
+DO JN = 1 , KSPLITG
+ ! Computation only where enough ice, snow, graupel or hail
+ GSEDIM(:,:,:) = .FALSE.
+ GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = PRSS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(5) &
+ .OR. PRGS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(6) &
+ .OR. PRHS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(7)
+ IF( OSEDI ) THEN
+ GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) &
+ .OR. PRIS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(4)
+ END IF
+!
+ ISEDIM = COUNTJV( GSEDIM(:,:,:),I1(:),I2(:),I3(:))
+ IF( ISEDIM >= 1 ) THEN
+!
+ IF( JN==1 ) THEN
+ IF( OSEDI ) THEN
+ PCIS(:,:,:) = PCIS(:,:,:) * PTSTEP
+ PRIS(:,:,:) = PRIS(:,:,:) * PTSTEP
+ END IF
+ PRSS(:,:,:) = PRSS(:,:,:) * PTSTEP
+ PRGS(:,:,:) = PRGS(:,:,:) * PTSTEP
+ PRHS(:,:,:) = PRHS(:,:,:) * PTSTEP
+ DO JK = IKB , IKE
+ ZW(:,:,JK)=ZTSPLITG/(PZZ(:,:,JK+1)-PZZ(:,:,JK))
+ END DO
+ END IF
+!
+ ALLOCATE(ZRHODREF(ISEDIM))
+ DO JL = 1,ISEDIM
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ END DO
+!
+ ALLOCATE(ZZW(ISEDIM)) ; ZZW(:) = 0.0
+ ALLOCATE(ZZX(ISEDIM)) ; ZZX(:) = 0.0
+ ALLOCATE(ZZY(ISEDIM)) ; ZZY(:) = 0.0
+!
+!* 2.21 for pristine ice
+!
+ IF( OSEDI.AND.MAXVAL(PRIS(:,:,:))>ZRTMIN(4) ) THEN
+ ALLOCATE(ZRIS(ISEDIM))
+ ALLOCATE(ZCIS(ISEDIM))
+ ALLOCATE(ZRIT(ISEDIM))
+ ALLOCATE(ZCIT(ISEDIM))
+ ALLOCATE(ZLBDAI(ISEDIM))
+ DO JL = 1,ISEDIM
+ ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
+ ZCIS(JL) = PCIS(I1(JL),I2(JL),I3(JL))
+ ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
+ ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
+ END DO
+ ZLBDAI(:) = 1.E10
+ WHERE (ZRIT(:)>XRTMIN(4) .AND. ZCIT(:)>XCTMIN(4))
+ ZLBDAI(:) = ( XLBI*ZCIT(:) / ZRIT(:) )**XLBEXI
+ END WHERE
+ WHERE( ZRIS(:)>ZRTMIN(4) )
+ ZZY(:) = ZRHODREF(:)**(-XCEXVT) * ZLBDAI(:)**(-XDI)
+ ZZW(:) = XFSEDRI * ZRIS(:) * ZZY(:) * ZRHODREF(:)
+ ZZX(:) = XFSEDCI * ZCIS(:) * ZZY(:) * ZRHODREF(:)
+ END WHERE
+ ZWSEDR(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ ZWSEDC(:,:,:) = UNPACK( ZZX(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ DO JK = IKB , IKE
+ PRIS(:,:,JK) = PRIS(:,:,JK) + ZW(:,:,JK)* &
+ (ZWSEDR(:,:,JK+1)-ZWSEDR(:,:,JK))/PRHODREF(:,:,JK)
+ PCIS(:,:,JK) = PCIS(:,:,JK) + ZW(:,:,JK)* &
+ (ZWSEDC(:,:,JK+1)-ZWSEDC(:,:,JK))/PRHODREF(:,:,JK)
+ END DO
+ DEALLOCATE(ZRIS)
+ DEALLOCATE(ZCIS)
+ DEALLOCATE(ZRIT)
+ DEALLOCATE(ZCIT)
+ DEALLOCATE(ZLBDAI)
+ END IF
+!
+!* 2.22 for aggregates
+!
+ ZZW(:) = 0.
+ IF( MAXVAL(PRSS(:,:,:))>ZRTMIN(5) ) THEN
+ ALLOCATE(ZRSS(ISEDIM))
+ DO JL = 1,ISEDIM
+ ZRSS(JL) = PRSS(I1(JL),I2(JL),I3(JL))
+ END DO
+ WHERE( ZRSS(:)>ZRTMIN(5) )
+! Correction BVIE ZRHODREF
+! ZZW(:) = XFSEDS * ZRSS(:)**XEXSEDS * ZRHODREF(:)**(XEXSEDS-XCEXVT)
+ ZZW(:) = XFSEDS * ZRSS(:)**XEXSEDS * ZRHODREF(:)**(-XCEXVT) * ZRHODREF(:)
+ END WHERE
+ ZWSEDR(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ DO JK = IKB , IKE
+ PRSS(:,:,JK) = PRSS(:,:,JK) + ZW(:,:,JK)* &
+ (ZWSEDR(:,:,JK+1)-ZWSEDR(:,:,JK))/PRHODREF(:,:,JK)
+ END DO
+ DEALLOCATE(ZRSS)
+ ELSE
+ ZWSEDR(:,:,IKB) = 0.0
+ END IF
+!
+ IF( JN.EQ.1 ) THEN
+ PINPRS(:,:) = ZWSEDR(:,:,IKB)/XRHOLW ! in m/s
+ END IF
+!
+!* 2.23 for graupeln
+!
+ ZZW(:) = 0.
+ IF( MAXVAL(PRGS(:,:,:))>ZRTMIN(6) ) THEN
+ ALLOCATE(ZRGS(ISEDIM))
+ DO JL = 1,ISEDIM
+ ZRGS(JL) = PRGS(I1(JL),I2(JL),I3(JL))
+ END DO
+ WHERE( ZRGS(:)>ZRTMIN(6) )
+! Correction BVIE ZRHODREF
+! ZZW(:) = XFSEDG * ZRGS(:)**XEXSEDG * ZRHODREF(:)**(XEXSEDG-XCEXVT)
+ ZZW(:) = XFSEDG * ZRGS(:)**XEXSEDG * ZRHODREF(:)**(-XCEXVT) * ZRHODREF(:)
+ END WHERE
+ ZWSEDR(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ DO JK = IKB , IKE
+ PRGS(:,:,JK) = PRGS(:,:,JK) + ZW(:,:,JK)* &
+ (ZWSEDR(:,:,JK+1)-ZWSEDR(:,:,JK))/PRHODREF(:,:,JK)
+ END DO
+ DEALLOCATE(ZRGS)
+ ELSE
+ ZWSEDR(:,:,IKB) = 0.0
+ END IF
+!
+ IF( JN.EQ.1 ) THEN
+ PINPRG(:,:) = ZWSEDR(:,:,IKB)/XRHOLW ! in m/s
+ END IF
+!
+!* 2.23 for hail
+!
+ ZZW(:) = 0.
+ IF( MAXVAL(PRHS(:,:,:))>ZRTMIN(7) ) THEN
+ ALLOCATE(ZRHS(ISEDIM))
+ DO JL = 1,ISEDIM
+ ZRHS(JL) = PRHS(I1(JL),I2(JL),I3(JL))
+ END DO
+ WHERE( ZRHS(:)>ZRTMIN(7) )
+! Correction BVIE ZRHODREF
+! ZZW(:) = XFSEDH * ZRHS(:)**XEXSEDH * ZRHODREF(:)**(XEXSEDH-XCEXVT)
+ ZZW(:) = XFSEDH * ZRHS(:)**XEXSEDH * ZRHODREF(:)**(-XCEXVT) * ZRHODREF(:)
+ END WHERE
+ ZWSEDR(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ DO JK = IKB , IKE
+ PRHS(:,:,JK) = PRHS(:,:,JK) + ZW(:,:,JK)* &
+ (ZWSEDR(:,:,JK+1)-ZWSEDR(:,:,JK))/PRHODREF(:,:,JK)
+ END DO
+ DEALLOCATE(ZRHS)
+ ELSE
+ ZWSEDR(:,:,IKB) = 0.0
+ END IF
+!
+ IF( JN.EQ.1 ) THEN
+ PINPRH(:,:) = ZWSEDR(:,:,IKB)/XRHOLW ! in m/s
+ END IF
+!
+!* 2.24 End of sedimentation
+!
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZZX)
+ DEALLOCATE(ZZY)
+ IF( JN==KSPLITG ) THEN
+ IF( OSEDI ) THEN
+ PRIS(:,:,:) = PRIS(:,:,:) / PTSTEP
+ PCIS(:,:,:) = PCIS(:,:,:) / PTSTEP
+ END IF
+ PRSS(:,:,:) = PRSS(:,:,:) / PTSTEP
+ PRGS(:,:,:) = PRGS(:,:,:) / PTSTEP
+ PRHS(:,:,:) = PRHS(:,:,:) / PTSTEP
+ END IF
+ END IF
+END DO
+!
+!
+! Budget storage
+IF (LBU_ENABLE) THEN
+ IF (LBUDGET_RI .AND. OSEDI) &
+ CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9 ,'SEDI_BU_RRI')
+ IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10 ,'SEDI_BU_RRS')
+ IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11 ,'SEDI_BU_RRG')
+ IF (LBUDGET_RH) CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),12 ,'SEDI_BU_RRH')
+ IF (LBUDGET_SV) THEN
+ IF (OSEDI) CALL BUDGET (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'SEDI_BU_RSV') ! RCI
+ END IF
+END IF
+!++cb++
+DEALLOCATE(ZRTMIN)
+!--cb--
+!
+END SUBROUTINE LIMA_COLD_SEDIMENTATION
+!
+!-------------------------------------------------------------------------------
diff --git a/src/MNH/lima_cold_slow_processes.f90 b/src/MNH/lima_cold_slow_processes.f90
new file mode 100644
index 000000000..bdbb4c64e
--- /dev/null
+++ b/src/MNH/lima_cold_slow_processes.f90
@@ -0,0 +1,568 @@
+! #####################
+ MODULE MODI_LIMA_COLD_SLOW_PROCESSES
+! #####################
+!
+INTERFACE
+ SUBROUTINE LIMA_COLD_SLOW_PROCESSES (PTSTEP, KMI, HFMFILE, HLUOUT, &
+ OCLOSE_OUT, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PTHS, PRVS, PRIS, PRSS, &
+ PCIT, PCIS )
+!
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
+ ! the tput FM fileoutp
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Ice crystal C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
+!
+END SUBROUTINE LIMA_COLD_SLOW_PROCESSES
+END INTERFACE
+END MODULE MODI_LIMA_COLD_SLOW_PROCESSES
+!
+! ######################################################################
+ SUBROUTINE LIMA_COLD_SLOW_PROCESSES (PTSTEP, KMI, HFMFILE, HLUOUT, &
+ OCLOSE_OUT, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PTHS, PRVS, PRIS, PRSS, &
+ PCIT, PCIS )
+! ######################################################################
+!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the microphysical sources
+!! for slow cold processes :
+!! - conversion of snow to ice
+!! - deposition of vapor on snow
+!! - conversion of ice to snow (Harrington 1995)
+!! - aggregation of ice on snow
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! C. Barthe * LACy * jan. 2014 add budgets
+!!
+!-------------------------------------------------------------------------------
+!
+!* 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
+
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
+ ! the tput FM fileoutp
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Ice crystal C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
+!
+!* 0.2 Declarations of local variables :
+!
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: GMICRO ! Computations only where necessary
+INTEGER :: IMICRO
+INTEGER , DIMENSION(SIZE(GMICRO)) :: I1,I2,I3 ! Used to replace PACK
+INTEGER :: JL ! and PACK intrinsics
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel/hail m.r. at t
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZCIT ! Pristine ice conc. at t
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVS ! Water vapor m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRSS ! Snow/aggregate m.r. source
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHS ! Theta source
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZCIS ! Pristine ice conc. source
+!
+REAL, DIMENSION(:), ALLOCATABLE &
+ :: ZRHODREF, & ! RHO Dry REFerence
+ ZRHODJ, & ! RHO times Jacobian
+ ZZT, & ! Temperature
+ ZPRES, & ! Pressure
+ ZEXNREF, & ! EXNer Pressure REFerence
+ ZZW, & ! Work array
+ ZZX, & ! Work array
+ ZLSFACT, & ! L_s/(Pi_ref*C_ph)
+ ZSSI, & ! Supersaturation over ice
+ ZLBDAI, & ! Slope parameter of the ice crystal distr.
+ ZLBDAS, & ! Slope parameter of the aggregate distr.
+ ZAI, & ! Thermodynamical function
+ ZCJ, & ! used to compute the ventilation coefficient
+ ZKA, & ! Thermal conductivity of the air
+ ZDV, & ! Diffusivity of water vapor in the air
+ ZVISCA ! Viscosity of air
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZZW1 ! Work arrays
+!
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZT, ZW ! Temperature
+!
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRTMIN, ZCTMIN
+!
+!-------------------------------------------------------------------------------
+!
+! Physical domain
+!
+IIB=1+JPHEXT
+IIE=SIZE(PZZ,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PZZ,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PZZ,3) - JPVEXT
+!
+! Physical limitations
+!
+ALLOCATE(ZRTMIN(SIZE(XRTMIN)))
+ALLOCATE(ZCTMIN(SIZE(XCTMIN)))
+ZRTMIN(:) = XRTMIN(:) / PTSTEP
+ZCTMIN(:) = XCTMIN(:) / PTSTEP
+!
+! Temperature
+ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
+!
+! Looking for regions where computations are necessary
+!
+GMICRO(:,:,:) = .FALSE.
+GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRIT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(4) .OR. &
+ PRST(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(5)
+!
+IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
+!
+IF( IMICRO >= 1 ) THEN
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 1. Optimization : packing variables
+! --------------------------------
+!
+!
+!
+ ALLOCATE(ZRVT(IMICRO))
+ ALLOCATE(ZRCT(IMICRO))
+ ALLOCATE(ZRRT(IMICRO))
+ ALLOCATE(ZRIT(IMICRO))
+ ALLOCATE(ZRST(IMICRO))
+ ALLOCATE(ZRGT(IMICRO))
+!
+ ALLOCATE(ZCIT(IMICRO))
+!
+ ALLOCATE(ZRVS(IMICRO))
+ ALLOCATE(ZRIS(IMICRO))
+ ALLOCATE(ZRSS(IMICRO))
+!
+ ALLOCATE(ZTHS(IMICRO))
+!
+ ALLOCATE(ZCIS(IMICRO))
+!
+ ALLOCATE(ZRHODREF(IMICRO))
+ ALLOCATE(ZZT(IMICRO))
+ ALLOCATE(ZPRES(IMICRO))
+ ALLOCATE(ZEXNREF(IMICRO))
+ DO JL=1,IMICRO
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
+ ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
+ ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
+!
+ ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
+!
+ ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
+ ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
+ ZRSS(JL) = PRSS(I1(JL),I2(JL),I3(JL))
+!
+ ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+!
+ ZCIS(JL) = PCIS(I1(JL),I2(JL),I3(JL))
+!
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ ENDDO
+!
+ IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ ALLOCATE(ZRHODJ(IMICRO))
+ ZRHODJ(:) = PACK( PRHODJ(:,:,:),MASK=GMICRO(:,:,:) )
+ END IF
+!
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 2. Microphysical computations
+! --------------------------
+!
+!
+ ALLOCATE(ZZW(IMICRO))
+ ALLOCATE(ZZX(IMICRO))
+ ALLOCATE(ZLSFACT(IMICRO))
+ ALLOCATE(ZSSI(IMICRO))
+ ALLOCATE(ZLBDAI(IMICRO))
+ ALLOCATE(ZLBDAS(IMICRO))
+ ALLOCATE(ZAI(IMICRO))
+ ALLOCATE(ZCJ(IMICRO))
+ ALLOCATE(ZKA(IMICRO))
+ ALLOCATE(ZDV(IMICRO))
+ ALLOCATE(ZZW1(IMICRO,7))
+!
+! Preliminary computations
+!
+ ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
+ +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
+!
+ ZLSFACT(:) = (XLSTT+(XCPV-XCI)*(ZZT(:)-XTT))/ZZW(:) ! L_s/(Pi_ref*C_ph)
+!
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) )
+ ZSSI(:) = ZRVT(:)*( ZPRES(:)-ZZW(:) ) / ( (XMV/XMD) * ZZW(:) ) - 1.0
+ ! Supersaturation over ice
+! Distribution parameters for ice and snow
+ ZLBDAI(:) = 1.E10
+ WHERE (ZRIT(:)>XRTMIN(4) .AND. ZCIT(:)>XCTMIN(4))
+ ZLBDAI(:) = ( XLBI*ZCIT(:) / ZRIT(:) )**XLBEXI
+ END WHERE
+ ZLBDAS(:) = 1.E10
+ WHERE (ZRST(:)>XRTMIN(5) )
+ ZLBDAS(:) = XLBS*( ZRHODREF(:)*ZRST(:) )**XLBEXS
+ END WHERE
+!
+ ZKA(:) = 2.38E-2 + 0.0071E-2 * ( ZZT(:) - XTT ) ! k_a
+ ZDV(:) = 0.211E-4 * (ZZT(:)/XTT)**1.94 * (XP00/ZPRES(:)) ! D_v
+!
+! Thermodynamical function ZAI = A_i(T,P)
+ ZAI(:) = ( XLSTT + (XCPV-XCI)*(ZZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZZT(:)**2) &
+ + ( XRV*ZZT(:) ) / (ZDV(:)*ZZW(:))
+! ZCJ = c^prime_j/c_i (in the ventilation factor) ( c_i from v(D)=c_i*D^(d_i) )
+ ZCJ(:) = XSCFAC * ZRHODREF(:)**0.3 / SQRT( 1.718E-5+0.0049E-5*(ZZT(:)-XTT) )
+!
+!
+!
+!
+!* 2.1 Conversion of snow to r_i: RSCNVI
+! ----------------------------------------
+!
+!
+ WHERE ( ZRST(:)>0.0 )
+ ZLBDAS(:) = MIN( XLBDAS_MAX, &
+ XLBS*( ZRHODREF(:)*MAX( ZRST(:),XRTMIN(5) ) )**XLBEXS )
+ END WHERE
+ ZZW(:) = 0.0
+ WHERE ( ZLBDAS(:)<XLBDASCNVI_MAX .AND. (ZRST(:)>XRTMIN(5)) &
+ .AND. (ZSSI(:)<0.0) )
+ ZZW(:) = (ZLBDAS(:)*XDSCNVI_LIM)**(XALPHAS)
+ ZZX(:) = ( -ZSSI(:)/ZAI(:) ) * (XCCS*ZLBDAS(:)**XCXS) * (ZZW(:)**XNUI) &
+ * EXP(-ZZW(:))
+!
+! Correction BVIE RHODREF
+! ZZW(:) = MIN( ( XR0DEPSI+XR1DEPSI*ZCJ(:) )*ZZX(:)/ZRHODREF(:),ZRSS(:) )
+ ZZW(:) = MIN( ( XR0DEPSI+XR1DEPSI*ZCJ(:) )*ZZX(:),ZRSS(:) )
+ ZRIS(:) = ZRIS(:) + ZZW(:)
+ ZRSS(:) = ZRSS(:) - ZZW(:)
+!
+ ZZW(:) = ZZW(:)*( XC0DEPSI+XC1DEPSI*ZCJ(:) )/( XR0DEPSI+XR1DEPSI*ZCJ(:) )
+ ZCIS(:) = ZCIS(:) + ZZW(:)
+ END WHERE
+!
+! Budget storage
+ IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
+ 9,'CNVI_BU_RRI')
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:),&
+ 10,'CNVI_BU_RRS')
+ IF (LBUDGET_SV) CALL BUDGET ( &
+ UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
+ 12+NSV_LIMA_NI,'CNVI_BU_RSV')
+ END IF
+!
+!
+!* 2.2 Deposition of water vapor on r_s: RVDEPS
+! -----------------------------------------------
+!
+!
+ ZZW(:) = 0.0
+ WHERE ( (ZRST(:)>0.0) .AND. (ZRSS(:)>0.0) )
+!Correction BVIE rhodref
+! ZZW(:) = ( ZSSI(:)/(ZRHODREF(:)*ZAI(:)) ) * &
+ ZZW(:) = ( ZSSI(:)/(ZAI(:)) ) * &
+ ( X0DEPS*ZLBDAS(:)**XEX0DEPS + X1DEPS*ZCJ(:)*ZLBDAS(:)**XEX1DEPS )
+ ZZW(:) = MIN( ZRVS(:),ZZW(:) )*(0.5+SIGN(0.5,ZZW(:))) &
+ - MIN( ZRSS(:),ABS(ZZW(:)) )*(0.5-SIGN(0.5,ZZW(:)))
+ ZRSS(:) = ZRSS(:) + ZZW(:)
+ ZRVS(:) = ZRVS(:) - ZZW(:)
+ ZTHS(:) = ZTHS(:) + ZZW(:)*ZLSFACT(:)
+ END WHERE
+!
+! Budget storage
+ IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
+ 4,'DEPS_BU_RTH')
+ IF (LBUDGET_RV) CALL BUDGET ( &
+ UNPACK(ZRVS(:),MASK=GMICRO(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:),&
+ 6,'DEPS_BU_RRV')
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:),&
+ 10,'DEPS_BU_RRS')
+ END IF
+!
+!
+!* 2.3 Conversion of pristine ice to r_s: RICNVS
+! ------------------------------------------------
+!
+!
+ ZZW(:) = 0.0
+ WHERE ( (ZLBDAI(:)<XLBDAICNVS_LIM) .AND. (ZCIT(:)>XCTMIN(4)) &
+ .AND. (ZSSI(:)>0.0) )
+ ZZW(:) = (ZLBDAI(:)*XDICNVS_LIM)**(XALPHAI)
+ ZZX(:) = ( ZSSI(:)/ZAI(:) )*ZCIT(:) * (ZZW(:)**XNUI) *EXP(-ZZW(:))
+!
+! Correction BVIE
+! ZZW(:) = MAX( MIN( ( XR0DEPIS + XR1DEPIS*ZCJ(:) )*ZZX(:)/ZRHODREF(:) &
+ ZZW(:) = MAX( MIN( ( XR0DEPIS + XR1DEPIS*ZCJ(:) )*ZZX(:) &
+ ,ZRIS(:) ) + ZRTMIN(5), ZRTMIN(5) ) - ZRTMIN(5)
+ ZRIS(:) = ZRIS(:) - ZZW(:)
+ ZRSS(:) = ZRSS(:) + ZZW(:)
+!
+ ZZW(:) = MIN( ZZW(:)*(( XC0DEPIS+XC1DEPIS*ZCJ(:) ) &
+ /( XR0DEPIS+XR1DEPIS*ZCJ(:) )),ZCIS(:) )
+ ZCIS(:) = ZCIS(:) - ZZW(:)
+ END WHERE
+!
+! Budget storage
+ IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
+ 9,'CNVS_BU_RRI')
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:),&
+ 10,'CNVS_BU_RRS')
+ IF (LBUDGET_SV) CALL BUDGET ( &
+ UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
+ 12+NSV_LIMA_NI,'CNVS_BU_RSV')
+ END IF
+!
+!
+!* 2.4 Aggregation of r_i on r_s: CIAGGS and RIAGGS
+! ---------------------------------------------------
+!
+!
+ WHERE ( (ZRIT(:)>XRTMIN(4)) .AND. (ZRST(:)>XRTMIN(5)) .AND. (ZRIS(:)>0.0) &
+ .AND. (ZCIS(:)>0.0) )
+ ZZW1(:,3) = (ZLBDAI(:) / ZLBDAS(:))**3
+ ZZW1(:,1) = (ZCIT(:)*(XCCS*ZLBDAS(:)**XCXS)*EXP( XCOLEXIS*(ZZT(:)-XTT) )) &
+ / (ZLBDAI(:)**3)
+ ZZW1(:,2) = MIN( ZZW1(:,1)*(XAGGS_CLARGE1+XAGGS_CLARGE2*ZZW1(:,3)),ZCIS(:) )
+ ZCIS(:) = ZCIS(:) - ZZW1(:,2)
+!
+ ZZW1(:,1) = ZZW1(:,1) / ZLBDAI(:)**XBI
+ ZZW1(:,2) = MIN( ZZW1(:,1)*(XAGGS_RLARGE1+XAGGS_RLARGE2*ZZW1(:,3)),ZRIS(:) )
+ ZRIS(:) = ZRIS(:) - ZZW1(:,2)
+ ZRSS(:) = ZRSS(:) + ZZW1(:,2)
+ END WHERE
+!
+! Budget storage
+ IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
+ 9,'AGGS_BU_RRI')
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
+ 10,'AGGS_BU_RRS')
+ IF (LBUDGET_SV) CALL BUDGET ( &
+ UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
+ 12+NSV_LIMA_NI,'AGGS_BU_RSV')
+ END IF
+!
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 3. Unpacking & Deallocating
+! ------------------------
+!
+!
+!
+ ZW(:,:,:) = PRVS(:,:,:)
+ PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRIS(:,:,:)
+ PRIS(:,:,:) = UNPACK( ZRIS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRSS(:,:,:)
+ PRSS(:,:,:) = UNPACK( ZRSS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!
+ ZW(:,:,:) = PCIS(:,:,:)
+ PCIS(:,:,:) = UNPACK( ZCIS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!
+ ZW(:,:,:) = PTHS(:,:,:)
+ PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZRIT)
+ DEALLOCATE(ZRST)
+ DEALLOCATE(ZRGT)
+ DEALLOCATE(ZCIT)
+ DEALLOCATE(ZRVS)
+ DEALLOCATE(ZRIS)
+ DEALLOCATE(ZRSS)
+ DEALLOCATE(ZTHS)
+ DEALLOCATE(ZCIS)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZEXNREF)
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZZX)
+ DEALLOCATE(ZLSFACT)
+ DEALLOCATE(ZSSI)
+ DEALLOCATE(ZLBDAI)
+ DEALLOCATE(ZLBDAS)
+ DEALLOCATE(ZAI)
+ DEALLOCATE(ZCJ)
+ DEALLOCATE(ZKA)
+ DEALLOCATE(ZDV)
+ DEALLOCATE(ZZW1)
+ IF (NBUMOD==KMI .AND. LBU_ENABLE) DEALLOCATE(ZRHODJ)
+!
+!
+ELSE
+!
+! Advance the budget calls
+!
+ IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_TH) THEN
+ ZW(:,:,:) = PTHS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,4,'DEPS_BU_RTH')
+ ENDIF
+ IF (LBUDGET_RV) THEN
+ ZW(:,:,:) = PRVS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,6,'DEPS_BU_RRV')
+ ENDIF
+ IF (LBUDGET_RI) THEN
+ ZW(:,:,:) = PRIS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,9,'CNVI_BU_RRI')
+ CALL BUDGET (ZW,9,'CNVS_BU_RRI')
+ CALL BUDGET (ZW,9,'AGGS_BU_RRI')
+ ENDIF
+ IF (LBUDGET_RS) THEN
+ ZW(:,:,:) = PRSS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,10,'CNVI_BU_RRS')
+ CALL BUDGET (ZW,10,'DEPS_BU_RRS')
+ CALL BUDGET (ZW,10,'CNVS_BU_RRS')
+ CALL BUDGET (ZW,10,'AGGS_BU_RRS')
+ ENDIF
+ IF (LBUDGET_SV) THEN
+ ZW(:,:,:) = PCIS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,12+NSV_LIMA_NI,'CNVI_BU_RSV')
+ CALL BUDGET (ZW,12+NSV_LIMA_NI,'CNVS_BU_RSV')
+ CALL BUDGET (ZW,12+NSV_LIMA_NI,'AGGS_BU_RSV')
+ ENDIF
+ ENDIF
+!
+END IF
+!
+!++cb++
+DEALLOCATE(ZRTMIN)
+DEALLOCATE(ZCTMIN)
+!--cb--
+!
+END SUBROUTINE LIMA_COLD_SLOW_PROCESSES
diff --git a/src/MNH/lima_functions.f90 b/src/MNH/lima_functions.f90
new file mode 100644
index 000000000..8a7f46893
--- /dev/null
+++ b/src/MNH/lima_functions.f90
@@ -0,0 +1,326 @@
+!#################################
+ MODULE MODI_LIMA_FUNCTIONS
+!#################################
+!
+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
+ REAL, INTENT(IN) :: PP
+ REAL :: PMOMG
+END FUNCTION MOMG
+!
+FUNCTION RECT(PA,PB,PX,PX1,PX2) RESULT(PRECT)
+ REAL, INTENT(IN) :: PA
+ REAL, INTENT(IN) :: PB
+ REAL, DIMENSION(:), INTENT(IN) :: PX
+ REAL, INTENT(IN) :: PX1
+ REAL, INTENT(IN) :: PX2
+ REAL, DIMENSION(SIZE(PX,1)) :: PRECT
+END FUNCTION RECT
+!
+FUNCTION DELTA(PA,PB,PX,PX1,PX2) RESULT(PDELTA)
+ REAL, INTENT(IN) :: PA
+ REAL, INTENT(IN) :: PB
+ REAL, DIMENSION(:), INTENT(IN) :: PX
+ REAL, INTENT(IN) :: PX1
+ REAL, INTENT(IN) :: PX2
+ REAL, DIMENSION(SIZE(PX,1)) :: PDELTA
+END FUNCTION DELTA
+!
+FUNCTION DELTA_VEC(PA,PB,PX,PX1,PX2) RESULT(PDELTA_VEC)
+ REAL, INTENT(IN) :: PA
+ REAL, INTENT(IN) :: PB
+ REAL, DIMENSION(:), INTENT(IN) :: PX
+ REAL, DIMENSION(:), INTENT(IN) :: PX1
+ REAL, DIMENSION(:), INTENT(IN) :: PX2
+ REAL, DIMENSION(SIZE(PX,1)) :: PDELTA_VEC
+END FUNCTION DELTA_VEC
+!
+SUBROUTINE GAULAG(x,w,n,alf)
+ INTEGER, INTENT(IN) :: n
+ REAL, INTENT(IN) :: alf
+ REAL, DIMENSION(n), INTENT(INOUT) :: w, x
+END SUBROUTINE GAULAG
+!
+SUBROUTINE GAUHER(x,w,n)
+ INTEGER, INTENT(IN) :: n
+ REAL, DIMENSION(n), INTENT(INOUT) :: w, x
+END SUBROUTINE GAUHER
+!
+END INTERFACE
+!
+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)
+!###########################################
+!
+! auxiliary routine used to compute the Pth moment order of the generalized
+! gamma law
+!
+ USE MODI_GAMMA
+!
+ IMPLICIT NONE
+!
+ REAL :: PALPHA ! first shape parameter of the dimensionnal distribution
+ REAL :: PNU ! second shape parameter of the dimensionnal distribution
+ REAL :: PP ! order of the moment
+ REAL :: PMOMG ! result: moment of order ZP
+!
+ PMOMG = GAMMA_X0D(PNU+PP/PALPHA)/GAMMA_X0D(PNU)
+!
+END FUNCTION MOMG
+!
+!------------------------------------------------------------------------------
+!
+!#############################################
+FUNCTION RECT(PA,PB,PX,PX1,PX2) RESULT(PRECT)
+!#############################################
+!
+! PRECT takes the value PA if PX1<=PX<PX2, and PB outside the [PX1;PX2[ interval
+!
+ IMPLICIT NONE
+!
+ REAL, INTENT(IN) :: PA
+ REAL, INTENT(IN) :: PB
+ REAL, DIMENSION(:), INTENT(IN) :: PX
+ REAL, INTENT(IN) :: PX1
+ REAL, INTENT(IN) :: PX2
+ REAL, DIMENSION(SIZE(PX,1)) :: PRECT
+!
+ PRECT(:) = PB
+ WHERE (PX(:).GE.PX1 .AND. PX(:).LT.PX2)
+ PRECT(:) = PA
+ END WHERE
+ RETURN
+!
+END FUNCTION RECT
+!
+!-------------------------------------------------------------------------------
+!
+!###############################################
+FUNCTION DELTA(PA,PB,PX,PX1,PX2) RESULT(PDELTA)
+!###############################################
+!
+! PDELTA takes the value PA if PX<PX1, and PB if PX>=PX2
+! PDELTA is a cubic interpolation between PA and PB for PX between PX1 and PX2
+!
+ IMPLICIT NONE
+!
+ REAL, INTENT(IN) :: PA
+ REAL, INTENT(IN) :: PB
+ REAL, DIMENSION(:), INTENT(IN) :: PX
+ REAL, INTENT(IN) :: PX1
+ REAL, INTENT(IN) :: PX2
+ REAL, DIMENSION(SIZE(PX,1)) :: PDELTA
+!
+!* local variable
+!
+ REAL :: ZA
+!
+ ZA = 6.0*(PA-PB)/(PX2-PX1)**3
+ WHERE (PX(:).LT.PX1)
+ PDELTA(:) = PA
+ ELSEWHERE (PX(:).GE.PX2)
+ PDELTA(:) = PB
+ ELSEWHERE
+ PDELTA(:) = PA + ZA*PX1**2*(PX1/6.0 - 0.5*PX2) &
+ + ZA*PX1*PX2* (PX(:)) &
+ - (0.5*ZA*(PX1+PX2))* (PX(:)**2) &
+ + (ZA/3.0)* (PX(:)**3)
+ END WHERE
+ RETURN
+!
+END FUNCTION DELTA
+!
+!-------------------------------------------------------------------------------
+!
+!#######################################################
+FUNCTION DELTA_VEC(PA,PB,PX,PX1,PX2) RESULT(PDELTA_VEC)
+!#######################################################
+!
+! Same as DELTA for vectorized PX1 and PX2 arguments
+!
+ IMPLICIT NONE
+!
+ REAL, INTENT(IN) :: PA
+ REAL, INTENT(IN) :: PB
+ REAL, DIMENSION(:), INTENT(IN) :: PX
+ REAL, DIMENSION(:), INTENT(IN) :: PX1
+ REAL, DIMENSION(:), INTENT(IN) :: PX2
+ REAL, DIMENSION(SIZE(PX,1)) :: PDELTA_VEC
+!
+!* local variable
+!
+ REAL, DIMENSION(SIZE(PX,1)) :: ZA
+!
+ ZA(:) = 0.0
+ wHERE (PX(:)<=PX1(:))
+ PDELTA_VEC(:) = PA
+ ELSEWHERE (PX(:)>=PX2(:))
+ PDELTA_VEC(:) = PB
+ ELSEWHERE
+ ZA(:) = 6.0*(PA-PB)/(PX2(:)-PX1(:))**3
+ PDELTA_VEC(:) = PA + ZA(:)*PX1(:)**2*(PX1(:)/6.0 - 0.5*PX2(:)) &
+ + ZA(:)*PX1(:)*PX2(:)* (PX(:)) &
+ - (0.5*ZA(:)*(PX1(:)+PX2(:)))* (PX(:)**2) &
+ + (ZA(:)/3.0)* (PX(:)**3)
+ END WHERE
+ RETURN
+!
+END FUNCTION DELTA_VEC
+!
+!-------------------------------------------------------------------------------
+!
+!###########################
+SUBROUTINE gaulag(x,w,n,alf)
+!###########################
+ INTEGER n,MAXIT
+ REAL alf,w(n),x(n)
+ DOUBLE PRECISION EPS
+ PARAMETER (EPS=3.D-14,MAXIT=10)
+ INTEGER i,its,j
+ REAL ai
+ DOUBLE PRECISION p1,p2,p3,pp,z,z1
+!
+ REAL SUMW
+!
+ do 13 i=1,n
+ if(i.eq.1)then
+ z=(1.+alf)*(3.+.92*alf)/(1.+2.4*n+1.8*alf)
+ else if(i.eq.2)then
+ z=z+(15.+6.25*alf)/(1.+.9*alf+2.5*n)
+ else
+ ai=i-2
+ z=z+((1.+2.55*ai)/(1.9*ai)+1.26*ai*alf/(1.+3.5*ai))* &
+ (z-x(i-2))/(1.+.3*alf)
+ endif
+ do 12 its=1,MAXIT
+ p1=1.d0
+ p2=0.d0
+ do 11 j=1,n
+ p3=p2
+ p2=p1
+ p1=((2*j-1+alf-z)*p2-(j-1+alf)*p3)/j
+11 continue
+ pp=(n*p1-(n+alf)*p2)/z
+ z1=z
+ z=z1-p1/pp
+ if(abs(z-z1).le.EPS)goto 1
+12 continue
+1 x(i)=z
+ w(i)=-exp(gammln(alf+n)-gammln(float(n)))/(pp*n*p2)
+13 continue
+!
+! NORMALISATION
+!
+ SUMW = 0.0
+ DO 14 I=1,N
+ SUMW = SUMW + W(I)
+14 CONTINUE
+ DO 15 I=1,N
+ W(I) = W(I)/SUMW
+15 CONTINUE
+!
+ return
+END SUBROUTINE gaulag
+!
+!------------------------------------------------------------------------------
+!
+!##########################################
+SUBROUTINE gauher(x,w,n)
+!##########################################
+ INTEGER n,MAXIT
+ REAL w(n),x(n)
+ DOUBLE PRECISION EPS,PIM4
+ PARAMETER (EPS=3.D-14,PIM4=.7511255444649425D0,MAXIT=10)
+ INTEGER i,its,j,m
+ DOUBLE PRECISION p1,p2,p3,pp,z,z1
+!
+ REAL SUMW
+!
+ m=(n+1)/2
+ do 13 i=1,m
+ if(i.eq.1)then
+ z=sqrt(float(2*n+1))-1.85575*(2*n+1)**(-.16667)
+ else if(i.eq.2)then
+ z=z-1.14*n**.426/z
+ else if (i.eq.3)then
+ z=1.86*z-.86*x(1)
+ else if (i.eq.4)then
+ z=1.91*z-.91*x(2)
+ else
+ z=2.*z-x(i-2)
+ endif
+ do 12 its=1,MAXIT
+ p1=PIM4
+ p2=0.d0
+ do 11 j=1,n
+ p3=p2
+ p2=p1
+ p1=z*sqrt(2.d0/j)*p2-sqrt(dble(j-1)/dble(j))*p3
+11 continue
+ pp=sqrt(2.d0*n)*p2
+ z1=z
+ z=z1-p1/pp
+ if(abs(z-z1).le.EPS)goto 1
+12 continue
+1 x(i)=z
+ x(n+1-i)=-z
+ pp=pp/PIM4 ! NORMALIZATION
+ w(i)=2.0/(pp*pp)
+ w(n+1-i)=w(i)
+13 continue
+!
+! NORMALISATION
+!
+ SUMW = 0.0
+ DO 14 I=1,N
+ SUMW = SUMW + W(I)
+14 CONTINUE
+ DO 15 I=1,N
+ W(I) = W(I)/SUMW
+15 CONTINUE
+!
+ return
+END SUBROUTINE gauher
+!
+!------------------------------------------------------------------------------
diff --git a/src/MNH/lima_meyers.f90 b/src/MNH/lima_meyers.f90
new file mode 100644
index 000000000..1751a96eb
--- /dev/null
+++ b/src/MNH/lima_meyers.f90
@@ -0,0 +1,485 @@
+! #######################
+ MODULE MODI_LIMA_MEYERS
+! #######################
+!
+INTERFACE
+ SUBROUTINE LIMA_MEYERS (OHHONI, PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT, &
+ PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PCCT, &
+ PTHS, PRVS, PRCS, PRIS, &
+ PCCS, PCIS, PINS )
+!
+LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
+ ! the tput FM fileoutp
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINS ! Activated ice nuclei C. source
+ !for DEPOSITION and CONTACT
+ !for IMMERSION
+!
+END SUBROUTINE LIMA_MEYERS
+END INTERFACE
+END MODULE MODI_LIMA_MEYERS
+!
+! ######################################################################
+ SUBROUTINE LIMA_MEYERS (OHHONI, PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT, &
+ PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PCCT, &
+ PTHS, PRVS, PRCS, PRIS, &
+ PCCS, PCIS, PINS )
+! ######################################################################
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the heterogeneous nucleation
+!! following Phillips (2008).
+!!
+!!
+!!** METHOD
+!! ------
+!! The parameterization of Phillips (2008) is based on observed nucleation
+!! in the CFDC for a range of T and Si values. Phillips therefore defines a
+!! reference activity spectrum, that is, for given T and Si values, the
+!! reference concentration of primary ice crystals.
+!!
+!! The activation of IFN is closely related to their total surface. Thus,
+!! the activable fraction of each IFN specie is determined by an integration
+!! over the particle size distributions.
+!!
+!! Subroutine organisation :
+!!
+!! 1- Preliminary computations
+!! 2- Check where computations are necessary, and pack variables
+!! 3- Compute the saturation over water and ice
+!! 4- Compute the reference activity spectrum
+!! -> CALL LIMA_PHILLIPS_REF_SPECTRUM
+!! Integrate over the size distributions to compute the IFN activable fraction
+!! -> CALL LIMA_PHILLIPS_INTEG
+!! 5- Heterogeneous nucleation of insoluble IFN
+!! 6- Heterogeneous nucleation of coated IFN
+!! 7- Unpack variables & deallocations
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Phillips et al., 2008: An empirical parameterization of heterogeneous
+!! ice nucleation for multiple chemical species of aerosols, J. Atmos. Sci.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! C. Barthe * LACy * jan. 2014 add budgets
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+USE MODD_CST
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_LIMA_COLD
+USE MODD_BUDGET
+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 :
+!
+LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
+ ! the tput FM fileoutp
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINS ! Activated ice nuclei C. source
+ !for DEPOSITION and CONTACT
+!
+!
+!* 0.2 Declarations of local variables :
+!
+!
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
+INTEGER :: JL ! Loop index
+INTEGER :: INEGT ! Case number of nucleation
+!
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: GNEGT ! Test where to compute the nucleation
+!
+INTEGER, DIMENSION(SIZE(PRHODREF)) :: I1,I2,I3 ! Indexes for PACK replacement
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel/hail m.r. at t
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZCCT ! Cloud water conc. at t
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVS ! Water vapor m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZCCS ! Cloud water conc. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZCIS ! Pristine ice conc. source
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHS ! Theta source
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZINS ! Nucleated Ice nuclei conc. source
+ ! by Deposition/Contact
+!
+REAL, DIMENSION(:), ALLOCATABLE &
+ :: ZRHODREF, & ! RHO Dry REFerence
+ ZRHODJ, & ! RHO times Jacobian
+ ZZT, & ! Temperature
+ ZPRES, & ! Pressure
+ ZEXNREF, & ! EXNer Pressure REFerence
+ ZZW, & ! Work array
+ ZZX, & ! Work array
+ ZZY, & ! Work array
+ ZLSFACT, & ! L_s/(Pi_ref*C_ph)
+ ZLVFACT, & ! L_v/(Pi_ref*C_ph)
+ ZSSI
+!
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZW, ZT ! work arrays
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZTCELSIUS
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+!
+!
+! Physical domain
+!
+IIB=1+JPHEXT
+IIE=SIZE(PZZ,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PZZ,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PZZ,3) - JPVEXT
+!
+! Temperature
+!
+ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
+!
+! Saturation over ice
+!
+ZW(:,:,:) = EXP( XALPI - XBETAI/ZT(:,:,:) - XGAMI*ALOG(ZT(:,:,:) ) )
+ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) )
+!
+!
+!-------------------------------------------------------------------------------
+!
+! optimization by looking for locations where
+! the temperature is negative only !!!
+!
+GNEGT(:,:,:) = .FALSE.
+GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<XTT .AND. &
+ ZW(IIB:IIE,IJB:IJE,IKB:IKE)>0.8
+INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
+IF( INEGT >= 1 ) THEN
+ ALLOCATE(ZRVT(INEGT))
+ ALLOCATE(ZRCT(INEGT))
+ ALLOCATE(ZRRT(INEGT))
+ ALLOCATE(ZRIT(INEGT))
+ ALLOCATE(ZRST(INEGT))
+ ALLOCATE(ZRGT(INEGT))
+!
+ ALLOCATE(ZCCT(INEGT))
+!
+ ALLOCATE(ZRVS(INEGT))
+ ALLOCATE(ZRCS(INEGT))
+ ALLOCATE(ZRIS(INEGT))
+!
+ ALLOCATE(ZTHS(INEGT))
+!
+ ALLOCATE(ZCCS(INEGT))
+ ALLOCATE(ZINS(INEGT,1))
+ ALLOCATE(ZCIS(INEGT))
+!
+ ALLOCATE(ZRHODREF(INEGT))
+ ALLOCATE(ZZT(INEGT))
+ ALLOCATE(ZPRES(INEGT))
+ ALLOCATE(ZEXNREF(INEGT))
+ DO JL=1,INEGT
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
+ ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
+ ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
+!
+ ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
+!
+ ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
+ ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
+ ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
+!
+ ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+!
+ ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
+ ZCIS(JL) = PCIS(I1(JL),I2(JL),I3(JL))
+!
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ ALLOCATE(ZZW(INEGT))
+ ALLOCATE(ZZX(INEGT))
+ ALLOCATE(ZZY(INEGT))
+ ALLOCATE(ZLSFACT(INEGT))
+ ALLOCATE(ZLVFACT(INEGT))
+ ALLOCATE(ZSSI(INEGT))
+ ALLOCATE(ZTCELSIUS(INEGT))
+!
+ ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
+ +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
+ ZTCELSIUS(:) = MAX( ZZT(:)-XTT,-50.0 )
+ ZLSFACT(:) = (XLSTT+(XCPV-XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
+ ZLVFACT(:) = (XLVTT+(XCPV-XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
+!
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:)) ) ! es_i
+ ZSSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((XMV/XMD)*ZZW(:)) - 1.0
+ ! Supersaturation over ice
+!
+!* compute the heterogeneous nucleation by deposition: RVHNDI
+!
+ DO JL=1,INEGT
+ ZINS(JL,1) = PINS(I1(JL),I2(JL),I3(JL),1)
+ END DO
+ ZZW(:) = 0.0
+ ZZX(:) = 0.0
+ ZZY(:) = 0.0
+!
+ WHERE( ZZT(:)<XTT-5.0 .AND. ZSSI(:)>0.0 )
+ ZZY(:) = XNUC_DEP*EXP( XEXSI_DEP*100.*MIN(1.,ZSSI(:))+XEX_DEP)/(PTSTEP*ZRHODREF(:))
+ ZZX(:) = MAX( ZZY(:)-ZINS(:,1) , 0.0 )
+ ZZW(:) = MIN( XMNU0*ZZX(:) , ZRVS(:) )
+ END WHERE
+!
+ ZINS(:,1) = ZINS(:,1) + ZZX(:)
+ ZW(:,:,:) = PINS(:,:,:,1)
+ PINS(:,:,:,1) = UNPACK( ZINS(:,1), MASK=GNEGT(:,:,:), FIELD=ZW(:,:,:) )
+!
+ ZRVS(:) = ZRVS(:) - ZZW(:)
+ ZRIS(:) = ZRIS(:) + ZZW(:)
+ ZTHS(:) = ZTHS(:) + ZZW(:) * (ZLSFACT(:)-ZLVFACT(:)) ! f(L_s*(RVHNDI))
+ ZCIS(:) = ZCIS(:) + ZZX(:)
+!
+!
+! Budget storage
+ IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
+ 4,'HIND_BU_RTH')
+ IF (LBUDGET_RV) CALL BUDGET ( &
+ UNPACK(ZRVS(:),MASK=GNEGT(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:),&
+ 6,'HIND_BU_RRV')
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(ZRIS(:),MASK=GNEGT(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
+ 9,'HIND_BU_RRI')
+ IF (LBUDGET_SV) THEN
+ CALL BUDGET ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
+ 12+NSV_LIMA_NI,'HIND_BU_RSV')
+ END IF
+ END IF
+!
+!* compute the heterogeneous nucleation by contact: RVHNCI
+!
+ DO JL=1,INEGT
+ ZINS(JL,1) = PINS(I1(JL),I2(JL),I3(JL),1)
+ END DO
+ ZZW(:) = 0.0
+ ZZX(:) = 0.0
+ ZZY(:) = 0.0
+!
+ WHERE( ZZT(:)<XTT-2.0 .AND. ZCCT(:)>XCTMIN(2) .AND. ZRCT(:)>XRTMIN(2) )
+ ZZY(:) = MIN( XNUC_CON * EXP( XEXTT_CON*ZTCELSIUS(:)+XEX_CON ) &
+ /(PTSTEP*ZRHODREF(:)) , ZCCS(:) )
+ ZZX(:) = MAX( ZZY(:)-ZINS(:,1),0.0 )
+ ZZW(:) = MIN( (ZRCT(:)/ZCCT(:))*ZZX(:),ZRCS(:) )
+ END WHERE
+!
+ ZINS(:,1) = ZINS(:,1) + ZZX(:)
+ ZW(:,:,:) = PINS(:,:,:,1)
+ PINS(:,:,:,1) = UNPACK( ZINS(:,1), MASK=GNEGT(:,:,:), FIELD=ZW(:,:,:) )
+!
+ ZRCS(:) = ZRCS(:) - ZZW(:)
+ ZRIS(:) = ZRIS(:) + ZZW(:)
+ ZTHS(:) = ZTHS(:) + ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_s*(RVHNCI))
+ ZCCS(:) = ZCCS(:) - ZZX(:)
+ ZCIS(:) = ZCIS(:) + ZZX(:)
+!
+!* unpack variables
+!
+ ZW(:,:,:) = PRVS(:,:,:)
+ PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRCS(:,:,:)
+ PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRIS(:,:,:)
+ PRIS(:,:,:) = UNPACK( ZRIS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PTHS(:,:,:)
+ PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PCCS(:,:,:)
+ PCCS(:,:,:) = UNPACK( ZCCS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PCIS(:,:,:)
+ PCIS(:,:,:) = UNPACK( ZCIS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+!
+! Budget storage
+ IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:), 4,'HINC_BU_RTH')
+ IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), 7,'HINC_BU_RRC')
+ IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:), 9,'HINC_BU_RRI')
+ IF (LBUDGET_SV) THEN
+ CALL BUDGET ( PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'HINC_BU_RSV')
+ CALL BUDGET ( PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HINC_BU_RSV')
+ END IF
+ END IF
+
+!
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZRIT)
+ DEALLOCATE(ZRST)
+ DEALLOCATE(ZRGT)
+!
+ DEALLOCATE(ZCCT)
+!
+ DEALLOCATE(ZRVS)
+ DEALLOCATE(ZRCS)
+ DEALLOCATE(ZRIS)
+!
+ DEALLOCATE(ZTHS)
+!
+ DEALLOCATE(ZCCS)
+ DEALLOCATE(ZINS)
+ DEALLOCATE(ZCIS)
+!
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZTCELSIUS)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZEXNREF)
+ DEALLOCATE(ZSSI)
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZZX)
+ DEALLOCATE(ZZY)
+ DEALLOCATE(ZLSFACT)
+ DEALLOCATE(ZLVFACT)
+!
+ELSE
+!
+! Advance the budget calls
+!
+ IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_TH) THEN
+ ZW(:,:,:) = PTHS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,4,'HIND_BU_RTH')
+ CALL BUDGET (ZW,4,'HINC_BU_RTH')
+ ENDIF
+ IF (LBUDGET_RV) THEN
+ ZW(:,:,:) = PRVS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,6,'HIND_BU_RRV')
+ ENDIF
+ IF (LBUDGET_RC) THEN
+ ZW(:,:,:) = PRCS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,7,'HINC_BU_RRC')
+ ENDIF
+ IF (LBUDGET_RI) THEN
+ ZW(:,:,:) = PRIS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,9,'HIND_BU_RRI')
+ CALL BUDGET (ZW,9,'HINC_BU_RRI')
+ ENDIF
+ IF (LBUDGET_SV) THEN
+ ZW(:,:,:) = PCCS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,12+NSV_LIMA_NC,'HINC_BU_RSV')
+ ZW(:,:,:) = PCIS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,12+NSV_LIMA_NI,'HIND_BU_RSV')
+ CALL BUDGET (ZW,12+NSV_LIMA_NI,'HINC_BU_RSV')
+ END IF
+ END IF
+!
+END IF
+
+
+
+
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_MEYERS
diff --git a/src/MNH/lima_mixed.f90 b/src/MNH/lima_mixed.f90
new file mode 100644
index 000000000..e557a1c3f
--- /dev/null
+++ b/src/MNH/lima_mixed.f90
@@ -0,0 +1,809 @@
+! ######################
+ MODULE MODI_LIMA_MIXED
+! ######################
+!
+INTERFACE
+ SUBROUTINE LIMA_MIXED (OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
+ HFMFILE, HLUOUT, OCLOSE_OUT, KRR, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PW_NU, &
+ PTHM, PPABSM, &
+ PTHT, PRT, PSVT, &
+ PTHS, PRS, PSVS )
+!
+LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
+ ! cloud ice sedimentation
+LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
+INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
+ ! integration for ice sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
+ ! the tput FM fileoutp
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+ ! the nucleation param.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at t
+
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
+!
+END SUBROUTINE LIMA_MIXED
+END INTERFACE
+END MODULE MODI_LIMA_MIXED
+!
+! #######################################################################
+ SUBROUTINE LIMA_MIXED (OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
+ HFMFILE, HLUOUT, OCLOSE_OUT, KRR, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PW_NU, &
+ PTHM, PPABSM, &
+ PTHT, PRT, PSVT, &
+ PTHS, PRS, PSVS )
+! #######################################################################
+!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the mixed-phase
+!! microphysical processes
+!!
+!!
+!!** METHOD
+!! ------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Most of the parameterizations come from the ICE3 scheme, described in
+!! the MESO-NH scientific documentation.
+!!
+!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
+!! microphysical bulk scheme.
+!! Part I: Description and tests
+!! Part II: 2D experiments with a non-hydrostatic model
+!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! C. Barthe * LACy * jan. 2014 add budgets
+!!
+!-------------------------------------------------------------------------------
+!
+!* 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, 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 MODI_BUDGET
+!
+USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
+USE MODI_LIMA_MIXED_SLOW_PROCESSES
+USE MODI_LIMA_MIXED_FAST_PROCESSES
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
+ ! cloud ice sedimentation
+LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
+INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
+ ! integration for ice sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
+ ! the tput FM fileoutp
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+ ! the nucleation param.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at t
+
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
+!
+!* 0.2 Declarations of local variables :
+!
+!3D microphysical variables
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
+ :: PRVT, & ! Water vapor m.r. at t
+ PRCT, & ! Cloud water m.r. at t
+ PRRT, & ! Rain water m.r. at t
+ PRIT, & ! Cloud ice m.r. at t
+ PRST, & ! Snow/aggregate m.r. at t
+ PRGT, & ! Graupel m.r. at t
+ PRHT, & ! Hail m.r. at t
+ !
+ PRVS, & ! Water vapor m.r. source
+ PRCS, & ! Cloud water m.r. source
+ PRRS, & ! Rain water m.r. source
+ PRIS, & ! Pristine ice m.r. source
+ PRSS, & ! Snow/aggregate m.r. source
+ PRGS, & ! Graupel m.r. source
+ PRHS, & ! Hail m.r. source
+ !
+ PCCT, & ! Cloud water C. at t
+ PCRT, & ! Rain water C. at t
+ PCIT, & ! Ice crystal C. at t
+ !
+ PCCS, & ! Cloud water C. source
+ PCRS, & ! Rain water C. source
+ PCIS ! Ice crystal C. source
+!
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PNFS ! CCN C. available source
+ !used as Free ice nuclei for
+ !HOMOGENEOUS nucleation of haze
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PNAS ! Cloud C. nuclei C. source
+ !used as Free ice nuclei for
+ !IMMERSION freezing
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PIFS ! Free ice nuclei C. source
+ !for DEPOSITION and CONTACT
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PINS ! Activated ice nuclei C. source
+ !for DEPOSITION and CONTACT
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PNIS ! Activated ice nuclei C. source
+ !for IMMERSION
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: PNHS ! Hom. freezing of CCN
+!
+! Replace PACK
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: GMICRO
+INTEGER :: IMICRO
+INTEGER , DIMENSION(SIZE(GMICRO)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+!
+! Packed microphysical variables
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRHT ! Hail m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZCCT ! Cloud water conc. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZCRT ! Rain water conc. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZCIT ! Pristine ice conc. at t
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVS ! Water vapor m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRS ! Rain water m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRGS ! Graupel m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRHS ! Hail m.r. source
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHS ! Theta source
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZCCS ! Cloud water conc. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZCRS ! Rain water conc. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZCIS ! Pristine ice conc. source
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZIFS ! Free Ice nuclei conc. source
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZINS ! Nucleated Ice nuclei conc. source
+!
+! Other packed variables
+REAL, DIMENSION(:), ALLOCATABLE &
+ :: ZRHODREF, & ! RHO Dry REFerence
+ ZRHODJ, & ! RHO times Jacobian
+ ZZT, & ! Temperature
+ ZPRES, & ! Pressure
+ ZEXNREF, & ! EXNer Pressure REFerence
+ ZZW, & ! Work array
+ ZLSFACT, & ! L_s/(Pi_ref*C_ph)
+ ZLVFACT, & ! L_v/(Pi_ref*C_ph)
+ ZSSI, & ! Supersaturation over ice
+ ZLBDAC, & ! Slope parameter of the cloud droplet distr.
+ ZLBDAR, & ! Slope parameter of the raindrop distr.
+ ZLBDAI, & ! Slope parameter of the ice crystal distr.
+ ZLBDAS, & ! Slope parameter of the aggregate distr.
+ ZLBDAG, & ! Slope parameter of the graupel distr.
+ ZLBDAH, & ! Slope parameter of the hail distr.
+ ZAI, & ! Thermodynamical function
+ ZCJ, & ! used to compute the ventilation coefficient
+ ZKA, & ! Thermal conductivity of the air
+ ZDV ! Diffusivity of water vapor in the air
+!
+! 3D Temperature
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZT, ZW
+!
+!
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
+INTEGER :: JMOD_IFN ! Loop index
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 0. 3D MICROPHYSCAL VARIABLES
+! -------------------------
+!
+!
+! Prepare 3D water mixing ratios
+PRVT(:,:,:) = PRT(:,:,:,1)
+PRVS(:,:,:) = PRS(:,:,:,1)
+!
+PRCT(:,:,:) = 0.
+PRCS(:,:,:) = 0.
+PRRT(:,:,:) = 0.
+PRRS(:,:,:) = 0.
+PRIT(:,:,:) = 0.
+PRIS(:,:,:) = 0.
+PRST(:,:,:) = 0.
+PRSS(:,:,:) = 0.
+PRGT(:,:,:) = 0.
+PRGS(:,:,:) = 0.
+PRHT(:,:,:) = 0.
+PRHS(:,:,:) = 0.
+!
+IF ( KRR .GE. 2 ) PRCT(:,:,:) = PRT(:,:,:,2)
+IF ( KRR .GE. 2 ) PRCS(:,:,:) = PRS(:,:,:,2)
+IF ( KRR .GE. 3 ) PRRT(:,:,:) = PRT(:,:,:,3)
+IF ( KRR .GE. 3 ) PRRS(:,:,:) = PRS(:,:,:,3)
+IF ( KRR .GE. 4 ) PRIT(:,:,:) = PRT(:,:,:,4)
+IF ( KRR .GE. 4 ) PRIS(:,:,:) = PRS(:,:,:,4)
+IF ( KRR .GE. 5 ) PRST(:,:,:) = PRT(:,:,:,5)
+IF ( KRR .GE. 5 ) PRSS(:,:,:) = PRS(:,:,:,5)
+IF ( KRR .GE. 6 ) PRGT(:,:,:) = PRT(:,:,:,6)
+IF ( KRR .GE. 6 ) PRGS(:,:,:) = PRS(:,:,:,6)
+IF ( KRR .GE. 7 ) PRHT(:,:,:) = PRT(:,:,:,7)
+IF ( KRR .GE. 7 ) PRHS(:,:,:) = PRS(:,:,:,7)
+!
+! Prepare 3D number concentrations
+PCCT(:,:,:) = 0.
+PCRT(:,:,:) = 0.
+PCIT(:,:,:) = 0.
+PCCS(:,:,:) = 0.
+PCRS(:,:,:) = 0.
+PCIS(:,:,:) = 0.
+!
+IF ( LWARM ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
+IF ( LWARM .AND. LRAIN ) PCRT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NR)
+IF ( LCOLD ) PCIT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NI)
+!
+IF ( LWARM ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
+IF ( LWARM .AND. LRAIN ) PCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
+IF ( LCOLD ) PCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
+!
+IF ( NMOD_CCN .GE. 1 ) THEN
+ ALLOCATE( PNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ ALLOCATE( PNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ PNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)
+ PNAS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)
+ELSE
+ ALLOCATE( PNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
+ ALLOCATE( PNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
+ PNFS(:,:,:,:) = 0.
+ PNAS(:,:,:,:) = 0.
+END IF
+!
+IF ( NMOD_IFN .GE. 1 ) THEN
+ ALLOCATE( PIFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
+ ALLOCATE( PINS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
+ PIFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1)
+ PINS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1)
+ELSE
+ ALLOCATE( PIFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
+ ALLOCATE( PINS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
+ PIFS(:,:,:,:) = 0.
+ PINS(:,:,:,:) = 0.
+END IF
+!
+IF ( NMOD_IMM .GE. 1 ) THEN
+ ALLOCATE( PNIS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IMM) )
+ PNIS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1)
+ELSE
+ ALLOCATE( PNIS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
+ PNIS(:,:,:,:) = 0.0
+END IF
+!
+IF ( OHHONI ) THEN
+ ALLOCATE( PNHS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) )
+ PNHS(:,:,:) = PSVS(:,:,:,NSV_LIMA_HOM_HAZE)
+ELSE
+ ALLOCATE( PNHS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) )
+ PNHS(:,:,:) = 0.0
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. Pack variables, computations only where necessary
+! -------------------------------------------------
+!
+! Physical domain
+!
+IIB=1+JPHEXT
+IIE=SIZE(PZZ,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PZZ,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PZZ,3) - JPVEXT
+!
+! Temperature
+ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
+!
+! Looking for regions where computations are necessary
+GMICRO(:,:,:) = .FALSE.
+GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = PRCT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(2) .OR. &
+ PRRT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(3) .OR. &
+ PRIT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(4) .OR. &
+ PRST(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(5) .OR. &
+ PRGT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(6) .OR. &
+ PRHT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(7)
+!
+IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
+!
+IF( IMICRO >= 1 ) THEN
+!
+ ALLOCATE(ZRVT(IMICRO))
+ ALLOCATE(ZRCT(IMICRO))
+ ALLOCATE(ZRRT(IMICRO))
+ ALLOCATE(ZRIT(IMICRO))
+ ALLOCATE(ZRST(IMICRO))
+ ALLOCATE(ZRGT(IMICRO))
+ ALLOCATE(ZRHT(IMICRO))
+ !
+ ALLOCATE(ZCCT(IMICRO))
+ ALLOCATE(ZCRT(IMICRO))
+ ALLOCATE(ZCIT(IMICRO))
+ !
+ ALLOCATE(ZRVS(IMICRO))
+ ALLOCATE(ZRCS(IMICRO))
+ ALLOCATE(ZRRS(IMICRO))
+ ALLOCATE(ZRIS(IMICRO))
+ ALLOCATE(ZRSS(IMICRO))
+ ALLOCATE(ZRGS(IMICRO))
+ ALLOCATE(ZRHS(IMICRO))
+ ALLOCATE(ZTHS(IMICRO))
+ !
+ ALLOCATE(ZCCS(IMICRO))
+ ALLOCATE(ZCRS(IMICRO))
+ ALLOCATE(ZCIS(IMICRO))
+ ALLOCATE(ZIFS(IMICRO,NMOD_IFN))
+ ALLOCATE(ZINS(IMICRO,NMOD_IFN))
+ !
+ ALLOCATE(ZRHODREF(IMICRO))
+ ALLOCATE(ZZT(IMICRO))
+ ALLOCATE(ZPRES(IMICRO))
+ ALLOCATE(ZEXNREF(IMICRO))
+ DO JL=1,IMICRO
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
+ ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
+ ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
+ ZRHT(JL) = PRHT(I1(JL),I2(JL),I3(JL))
+ !
+ ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
+ ZCRT(JL) = PCRT(I1(JL),I2(JL),I3(JL))
+ ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
+ !
+ ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
+ ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
+ ZRRS(JL) = PRRS(I1(JL),I2(JL),I3(JL))
+ ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
+ ZRSS(JL) = PRSS(I1(JL),I2(JL),I3(JL))
+ ZRGS(JL) = PRGS(I1(JL),I2(JL),I3(JL))
+ ZRHS(JL) = PRHS(I1(JL),I2(JL),I3(JL))
+ ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+ !
+ ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
+ ZCRS(JL) = PCRS(I1(JL),I2(JL),I3(JL))
+ ZCIS(JL) = PCIS(I1(JL),I2(JL),I3(JL))
+ DO JMOD_IFN = 1, NMOD_IFN
+ ZIFS(JL,JMOD_IFN) = PIFS(I1(JL),I2(JL),I3(JL),JMOD_IFN)
+ ZINS(JL,JMOD_IFN) = PINS(I1(JL),I2(JL),I3(JL),JMOD_IFN)
+ ENDDO
+ !
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ ALLOCATE(ZRHODJ(IMICRO))
+ ZRHODJ(:) = PACK( PRHODJ(:,:,:),MASK=GMICRO(:,:,:) )
+ END IF
+!
+! Atmospheric parameters
+!
+ ALLOCATE(ZZW(IMICRO))
+ ALLOCATE(ZLSFACT(IMICRO))
+ ALLOCATE(ZLVFACT(IMICRO))
+ ALLOCATE(ZSSI(IMICRO))
+ ALLOCATE(ZAI(IMICRO))
+ ALLOCATE(ZCJ(IMICRO))
+ ALLOCATE(ZKA(IMICRO))
+ ALLOCATE(ZDV(IMICRO))
+!
+ ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
+ +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
+!
+ ZLSFACT(:) = (XLSTT+(XCPV-XCI)*(ZZT(:)-XTT))/ZZW(:) ! L_s/(Pi_ref*C_ph)
+ ZLVFACT(:) = (XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZW(:) ! L_v/(Pi_ref*C_ph)
+!
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) )
+ ZSSI(:) = ZRVT(:)*( ZPRES(:)-ZZW(:) ) / ( (XMV/XMD) * ZZW(:) ) - 1.0
+ ! Supersaturation over ice
+!
+ ZKA(:) = 2.38E-2 + 0.0071E-2 * ( ZZT(:) - XTT ) ! k_a
+ ZDV(:) = 0.211E-4 * (ZZT(:)/XTT)**1.94 * (XP00/ZPRES(:)) ! D_v
+!
+! Thermodynamical function ZAI = A_i(T,P)
+ ZAI(:) = ( XLSTT + (XCPV-XCI)*(ZZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZZT(:)**2) &
+ + ( XRV*ZZT(:) ) / (ZDV(:)*ZZW(:))
+! ZCJ = c^prime_j (in the ventilation factor)
+ ZCJ(:) = XSCFAC * ZRHODREF(:)**0.3 / SQRT( 1.718E-5+0.0049E-5*(ZZT(:)-XTT) )
+!
+!
+! Particle distribution parameters
+!
+ ALLOCATE(ZLBDAC(IMICRO))
+ ALLOCATE(ZLBDAR(IMICRO))
+ ALLOCATE(ZLBDAI(IMICRO))
+ ALLOCATE(ZLBDAS(IMICRO))
+ ALLOCATE(ZLBDAG(IMICRO))
+ ALLOCATE(ZLBDAH(IMICRO))
+ ZLBDAC(:) = 1.E10
+ WHERE (ZRCT(:)>XRTMIN(2) .AND. ZCCT(:)>XCTMIN(2))
+ ZLBDAC(:) = ( XLBC*ZCCT(:) / ZRCT(:) )**XLBEXC
+ END WHERE
+ ZLBDAR(:) = 1.E10
+ WHERE (ZRRT(:)>XRTMIN(3) .AND. ZCRT(:)>XCTMIN(3))
+ ZLBDAR(:) = ( XLBR*ZCRT(:) / ZRRT(:) )**XLBEXR
+ END WHERE
+ ZLBDAI(:) = 1.E10
+ WHERE (ZRIT(:)>XRTMIN(4) .AND. ZCIT(:)>XCTMIN(4))
+ ZLBDAI(:) = ( XLBI*ZCIT(:) / ZRIT(:) )**XLBEXI
+ END WHERE
+ ZLBDAS(:) = 1.E10
+ WHERE (ZRST(:)>XRTMIN(5) )
+ ZLBDAS(:) = XLBS*( ZRHODREF(:)*ZRST(:) )**XLBEXS
+ END WHERE
+ ZLBDAG(:) = 1.E10
+ WHERE (ZRGT(:)>XRTMIN(6) )
+ ZLBDAG(:) = XLBG*( ZRHODREF(:)*ZRGT(:) )**XLBEXG
+ END WHERE
+ ZLBDAH(:) = 1.E10
+ WHERE (ZRHT(:)>XRTMIN(7) )
+ ZLBDAH(:) = XLBH*( ZRHODREF(:)*ZRHT(:) )**XLBEXH
+ END WHERE
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. Compute the slow processes involving cloud water and graupel
+! ------------------------------------------------------------
+!
+ CALL LIMA_MIXED_SLOW_PROCESSES(ZRHODREF, ZZT, ZSSI, &
+ ZLSFACT, ZLVFACT, ZAI, ZCJ, &
+ ZRGT, ZCIT, &
+ ZRVS, ZRCS, ZRIS, ZRGS, ZTHS, &
+ ZCCS, ZCIS, ZIFS, ZINS, &
+ ZLBDAI, ZLBDAG, &
+ ZRHODJ, GMICRO, PRHODJ, KMI, &
+ PTHS, PRVS, PRCS, PRIS, PRGS, &
+ PCCS, PCIS )
+!
+!-------------------------------------------------------------------------------
+!
+!
+! 3. Compute the fast RS and RG processes
+! ------------------------------------
+!
+ CALL LIMA_MIXED_FAST_PROCESSES(ZRHODREF, ZZT, ZPRES, PTSTEP, &
+ ZLSFACT, ZLVFACT, ZKA, ZDV, ZCJ, &
+ ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
+ ZRHT, ZCCT, ZCRT, ZCIT, &
+ ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, &
+ ZTHS, ZCCS, ZCRS, ZCIS, &
+ ZLBDAC, ZLBDAR, ZLBDAS, ZLBDAG, ZLBDAH, &
+ ZRHODJ, GMICRO, PRHODJ, KMI, PTHS, &
+ PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, &
+ PCCS, PCRS, PCIS )
+!
+!-------------------------------------------------------------------------------
+!
+!
+!
+! 4. Unpack variables
+! ----------------
+!
+!
+ ZW(:,:,:) = PRVS(:,:,:)
+ PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRCS(:,:,:)
+ PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRRS(:,:,:)
+ PRRS(:,:,:) = UNPACK( ZRRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRIS(:,:,:)
+ PRIS(:,:,:) = UNPACK( ZRIS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRSS(:,:,:)
+ PRSS(:,:,:) = UNPACK( ZRSS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRGS(:,:,:)
+ PRGS(:,:,:) = UNPACK( ZRGS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRHS(:,:,:)
+ PRHS(:,:,:) = UNPACK( ZRHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!
+ ZW(:,:,:) = PTHS(:,:,:)
+ PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!
+ ZW(:,:,:) = PCCS(:,:,:)
+ PCCS(:,:,:) = UNPACK( ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PCRS(:,:,:)
+ PCRS(:,:,:) = UNPACK( ZCRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PCIS(:,:,:)
+ PCIS(:,:,:) = UNPACK( ZCIS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!
+ DO JMOD_IFN = 1, NMOD_IFN
+ ZW(:,:,:) = PIFS(:,:,:,JMOD_IFN)
+ PIFS(:,:,:,JMOD_IFN) = UNPACK( ZIFS(:,JMOD_IFN),MASK=GMICRO(:,:,:), &
+ FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PINS(:,:,:,JMOD_IFN)
+ PINS(:,:,:,JMOD_IFN) = UNPACK( ZINS(:,JMOD_IFN),MASK=GMICRO(:,:,:), &
+ FIELD=ZW(:,:,:) )
+ ENDDO
+!
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZRIT)
+ DEALLOCATE(ZRST)
+ DEALLOCATE(ZRGT)
+ DEALLOCATE(ZRHT)
+!
+ DEALLOCATE(ZCCT)
+ DEALLOCATE(ZCRT)
+ DEALLOCATE(ZCIT)
+!
+ DEALLOCATE(ZRVS)
+ DEALLOCATE(ZRCS)
+ DEALLOCATE(ZRRS)
+ DEALLOCATE(ZRIS)
+ DEALLOCATE(ZRSS)
+ DEALLOCATE(ZRGS)
+ DEALLOCATE(ZRHS)
+ DEALLOCATE(ZTHS)
+!
+ DEALLOCATE(ZCCS)
+ DEALLOCATE(ZCRS)
+ DEALLOCATE(ZCIS)
+ DEALLOCATE(ZIFS)
+ DEALLOCATE(ZINS)
+!
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZEXNREF)
+!
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZLSFACT)
+ DEALLOCATE(ZLVFACT)
+ DEALLOCATE(ZSSI)
+ DEALLOCATE(ZAI)
+ DEALLOCATE(ZCJ)
+ DEALLOCATE(ZKA)
+ DEALLOCATE(ZDV)
+!
+ DEALLOCATE(ZLBDAC)
+ DEALLOCATE(ZLBDAR)
+ DEALLOCATE(ZLBDAI)
+ DEALLOCATE(ZLBDAS)
+ DEALLOCATE(ZLBDAG)
+ DEALLOCATE(ZLBDAH)
+!
+ IF (NBUMOD==KMI .AND. LBU_ENABLE) DEALLOCATE(ZRHODJ)
+!
+!
+ELSE
+!
+! Advance the budget calls
+!
+ IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_TH) THEN
+ ZW(:,:,:) = PTHS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,4,'DEPG_BU_RTH')
+ CALL BUDGET (ZW,4,'IMLT_BU_RTH')
+ CALL BUDGET (ZW,4,'BERFI_BU_RTH')
+ CALL BUDGET (ZW,4,'RIM_BU_RTH')
+ CALL BUDGET (ZW,4,'ACC_BU_RTH')
+ CALL BUDGET (ZW,4,'CFRZ_BU_RTH')
+ CALL BUDGET (ZW,4,'WETG_BU_RTH')
+ CALL BUDGET (ZW,4,'DRYG_BU_RTH')
+ CALL BUDGET (ZW,4,'GMLT_BU_RTH')
+ IF (LHAIL) CALL BUDGET (ZW,4,'WETH_BU_RTH')
+ IF (LHAIL) CALL BUDGET (ZW,4,'HMLT_BU_RTH')
+ ENDIF
+ IF (LBUDGET_RV) THEN
+ ZW(:,:,:) = PRVS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,6,'DEPG_BU_RRV')
+ ENDIF
+ IF (LBUDGET_RC) THEN
+ ZW(:,:,:) = PRCS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,7,'IMLT_BU_RRC')
+ CALL BUDGET (ZW,7,'BERFI_BU_RRC')
+ CALL BUDGET (ZW,7,'RIM_BU_RRC')
+ CALL BUDGET (ZW,7,'WETG_BU_RRC')
+ CALL BUDGET (ZW,7,'DRYG_BU_RRC')
+ IF (LHAIL) CALL BUDGET (ZW,7,'WETH_BU_RRC')
+ ENDIF
+ IF (LBUDGET_RR) THEN
+ ZW(:,:,:) = PRRS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,8,'ACC_BU_RRR')
+ CALL BUDGET (ZW,8,'CFRZ_BU_RRR')
+ CALL BUDGET (ZW,8,'WETG_BU_RRR')
+ CALL BUDGET (ZW,8,'DRYG_BU_RRR')
+ CALL BUDGET (ZW,8,'GMLT_BU_RRR')
+ IF (LHAIL) CALL BUDGET (ZW,8,'WETH_BU_RRR')
+ IF (LHAIL) CALL BUDGET (ZW,8,'HMLT_BU_RRR')
+ ENDIF
+ IF (LBUDGET_RI) THEN
+ ZW(:,:,:) = PRIS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,9,'IMLT_BU_RRI')
+ CALL BUDGET (ZW,9,'BERFI_BU_RRI')
+ CALL BUDGET (ZW,9,'HMS_BU_RRI')
+ CALL BUDGET (ZW,9,'CFRZ_BU_RRI')
+ CALL BUDGET (ZW,9,'WETG_BU_RRI')
+ CALL BUDGET (ZW,9,'DRYG_BU_RRI')
+ CALL BUDGET (ZW,9,'HMG_BU_RRI')
+ IF (LHAIL) CALL BUDGET (ZW,9,'WETH_BU_RRI')
+ ENDIF
+ IF (LBUDGET_RS) THEN
+ ZW(:,:,:) = PRSS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,10,'RIM_BU_RRS')
+ CALL BUDGET (ZW,10,'HMS_BU_RRS')
+ CALL BUDGET (ZW,10,'ACC_BU_RRS')
+ CALL BUDGET (ZW,10,'CMEL_BU_RRS')
+ CALL BUDGET (ZW,10,'WETG_BU_RRS')
+ CALL BUDGET (ZW,10,'DRYG_BU_RRS')
+ IF (LHAIL) CALL BUDGET (ZW,10,'WETH_BU_RRS')
+ ENDIF
+ IF (LBUDGET_RG) THEN
+ ZW(:,:,:) = PRGS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,11,'DEPG_BU_RRG')
+ CALL BUDGET (ZW,11,'RIM_BU_RRG')
+ CALL BUDGET (ZW,11,'ACC_BU_RRG')
+ CALL BUDGET (ZW,11,'CMEL_BU_RRG')
+ CALL BUDGET (ZW,11,'CFRZ_BU_RRG')
+ CALL BUDGET (ZW,11,'WETG_BU_RRG')
+ CALL BUDGET (ZW,11,'DRYG_BU_RRG')
+ CALL BUDGET (ZW,11,'HMG_BU_RRG')
+ CALL BUDGET (ZW,11,'GMLT_BU_RRG')
+ IF (LHAIL) CALL BUDGET (ZW,11,'WETH_BU_RRG')
+ IF (LHAIL) CALL BUDGET (ZW,11,'COHG_BU_RRG')
+ ENDIF
+ IF (LBUDGET_RH) THEN
+ ZW(:,:,:) = PRHS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,12,'WETG_BU_RRH')
+ IF (LHAIL) CALL BUDGET (ZW,12,'WETH_BU_RRH')
+ IF (LHAIL) CALL BUDGET (ZW,12,'COHG_BU_RRH')
+ IF (LHAIL) CALL BUDGET (ZW,12,'HMLT_BU_RRH')
+ ENDIF
+ IF (LBUDGET_SV) THEN
+ ZW(:,:,:) = PCCS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,12+NSV_LIMA_NC,'IMLT_BU_RSV')
+ CALL BUDGET (ZW,12+NSV_LIMA_NC,'RIM_BU_RSV')
+ CALL BUDGET (ZW,12+NSV_LIMA_NC,'WETG_BU_RSV')
+ CALL BUDGET (ZW,12+NSV_LIMA_NC,'DRYG_BU_RSV')
+ IF (LHAIL) CALL BUDGET (ZW,12+NSV_LIMA_NC,'WETH_BU_RSV')
+!
+ ZW(:,:,:) = PCRS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,12+NSV_LIMA_NR,'ACC_BU_RSV')
+ CALL BUDGET (ZW,12+NSV_LIMA_NR,'CFRZ_BU_RSV')
+ CALL BUDGET (ZW,12+NSV_LIMA_NR,'WETG_BU_RSV')
+ CALL BUDGET (ZW,12+NSV_LIMA_NR,'DRYG_BU_RSV')
+ CALL BUDGET (ZW,12+NSV_LIMA_NR,'GMLT_BU_RSV')
+ IF (LHAIL) CALL BUDGET (ZW,12+NSV_LIMA_NR,'WETH_BU_RSV')
+ IF (LHAIL) CALL BUDGET (ZW,12+NSV_LIMA_NR,'HMLT_BU_RSV')
+!
+ ZW(:,:,:) = PCIS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,12+NSV_LIMA_NI,'IMLT_BU_RSV')
+ CALL BUDGET (ZW,12+NSV_LIMA_NI,'HMS_BU_RSV')
+ CALL BUDGET (ZW,12+NSV_LIMA_NI,'CFRZ_BU_RSV')
+ CALL BUDGET (ZW,12+NSV_LIMA_NI,'WETG_BU_RSV')
+ CALL BUDGET (ZW,12+NSV_LIMA_NI,'DRYG_BU_RSV')
+ CALL BUDGET (ZW,12+NSV_LIMA_NI,'HMG_BU_RSV')
+ IF (LHAIL) CALL BUDGET (ZW,12+NSV_LIMA_NI,'WETH_BU_RSV')
+ ENDIF
+ ENDIF
+!
+END IF ! IMICRO >= 1
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 5. REPORT 3D MICROPHYSICAL VARIABLES IN PRS AND PSVS
+! -------------------------------------------------
+!
+PRS(:,:,:,1) = PRVS(:,:,:)
+IF ( KRR .GE. 2 ) PRS(:,:,:,2) = PRCS(:,:,:)
+IF ( KRR .GE. 3 ) PRS(:,:,:,3) = PRRS(:,:,:)
+IF ( KRR .GE. 4 ) PRS(:,:,:,4) = PRIS(:,:,:)
+IF ( KRR .GE. 5 ) PRS(:,:,:,5) = PRSS(:,:,:)
+IF ( KRR .GE. 6 ) PRS(:,:,:,6) = PRGS(:,:,:)
+IF ( KRR .GE. 7 ) PRS(:,:,:,7) = PRHS(:,:,:)
+!
+! Prepare 3D number concentrations
+!
+PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
+IF ( LRAIN ) PSVS(:,:,:,NSV_LIMA_NR) = PCRS(:,:,:)
+PSVS(:,:,:,NSV_LIMA_NI) = PCIS(:,:,:)
+!
+IF ( NMOD_CCN .GE. 1 ) THEN
+ PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = PNFS(:,:,:,:)
+ PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) = PNAS(:,:,:,:)
+END IF
+!
+IF ( NMOD_IFN .GE. 1 ) THEN
+ PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1) = PIFS(:,:,:,:)
+ PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1) = PINS(:,:,:,:)
+END IF
+!
+IF ( NMOD_IMM .GE. 1 ) THEN
+ PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1) = PNIS(:,:,:,:)
+END IF
+!
+!++cb++
+IF (ALLOCATED(PNFS)) DEALLOCATE(PNFS)
+IF (ALLOCATED(PNAS)) DEALLOCATE(PNAS)
+IF (ALLOCATED(PIFS)) DEALLOCATE(PIFS)
+IF (ALLOCATED(PINS)) DEALLOCATE(PINS)
+IF (ALLOCATED(PNIS)) DEALLOCATE(PNIS)
+IF (ALLOCATED(PNHS)) DEALLOCATE(PNHS)
+!--cb--
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_MIXED
diff --git a/src/MNH/lima_mixed_fast_processes.f90 b/src/MNH/lima_mixed_fast_processes.f90
new file mode 100644
index 000000000..e7b9d55fe
--- /dev/null
+++ b/src/MNH/lima_mixed_fast_processes.f90
@@ -0,0 +1,1321 @@
+! #####################################
+ MODULE MODI_LIMA_MIXED_FAST_PROCESSES
+! #####################################
+!
+INTERFACE
+ SUBROUTINE LIMA_MIXED_FAST_PROCESSES (ZRHODREF, ZZT, ZPRES, PTSTEP, &
+ ZLSFACT, ZLVFACT, ZKA, ZDV, ZCJ, &
+ ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
+ ZRHT, ZCCT, ZCRT, ZCIT, &
+ ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, &
+ ZTHS, ZCCS, ZCRS, ZCIS, &
+ ZLBDAC, ZLBDAR, ZLBDAS, ZLBDAG, ZLBDAH, &
+ ZRHODJ, GMICRO, PRHODJ, KMI, PTHS, &
+ PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, &
+ PCCS, PCRS, PCIS )
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZRHODREF ! RHO Dry REFerence
+REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature
+REAL, DIMENSION(:), INTENT(IN) :: ZPRES ! Pressure
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZLSFACT ! L_s/(Pi_ref*C_ph)
+REAL, DIMENSION(:), INTENT(IN) :: ZLVFACT ! L_v/(Pi_ref*C_ph)
+REAL, DIMENSION(:), INTENT(IN) :: ZKA ! Thermal conductivity of the air
+REAL, DIMENSION(:), INTENT(IN) :: ZDV ! Diffusivity of water vapor in the air
+REAL, DIMENSION(:), INTENT(IN) :: ZCJ ! Ventilation coefficient ?
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZRGT ! Graupel m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZRHT ! Hail m.r. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZCCT ! Cloud water conc. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZCRT ! Rain water conc. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZCIT ! Pristine ice conc. at t
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRRS ! Rain water m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRGS ! Graupel/hail m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRHS ! Hail m.r. source
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: ZTHS ! Theta source
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: ZCCS ! Cloud water conc. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZCRS ! Rain water conc. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZCIS ! Pristine ice conc. source
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAC ! Slope param of the cloud droplet distr.
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAR ! Slope param of the raindrop distr
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAS ! Slope param of the aggregate distr.
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAG ! Slope param of the graupel distr.
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAH ! Slope param of the hail distr.
+!
+! used for budget storage
+REAL, DIMENSION(:), INTENT(IN) :: ZRHODJ
+LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GMICRO
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
+INTEGER, INTENT(IN) :: KMI
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRSS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIS
+!
+END SUBROUTINE LIMA_MIXED_FAST_PROCESSES
+END INTERFACE
+END MODULE MODI_LIMA_MIXED_FAST_PROCESSES
+!
+! #######################################################################
+ SUBROUTINE LIMA_MIXED_FAST_PROCESSES (ZRHODREF, ZZT, ZPRES, PTSTEP, &
+ ZLSFACT, ZLVFACT, ZKA, ZDV, ZCJ, &
+ ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
+ ZRHT, ZCCT, ZCRT, ZCIT, &
+ ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, &
+ ZTHS, ZCCS, ZCRS, ZCIS, &
+ ZLBDAC, ZLBDAR, ZLBDAS, ZLBDAG, ZLBDAH, &
+ ZRHODJ, GMICRO, PRHODJ, KMI, PTHS, &
+ PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, &
+ PCCS, PCRS, PCIS )
+! #######################################################################
+!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the mixed-phase
+!! fast processes :
+!!
+!! - Fast RS processes :
+!! - Cloud droplet riming of the aggregates
+!! - Hallett-Mossop ice multiplication process due to snow riming
+!! - Rain accretion onto the aggregates
+!! - Conversion-Melting of the aggregates
+!!
+!! - Fast RG processes :
+!! - Rain contact freezing
+!! - Wet/Dry growth of the graupel
+!! - Hallett-Mossop ice multiplication process due to graupel riming
+!! - Melting of the graupeln
+!!
+!!
+!!** METHOD
+!! ------
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Most of the parameterizations come from the ICE3 scheme, described in
+!! the MESO-NH scientific documentation.
+!!
+!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
+!! microphysical bulk scheme.
+!! Part I: Description and tests
+!! Part II: 2D experiments with a non-hydrostatic model
+!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! C. Barthe * LACy * jan. 2014 add budgets
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_LIMA_COLD
+USE MODD_PARAM_LIMA_MIXED
+!
+USE MODD_NSV
+USE MODD_BUDGET
+USE MODI_BUDGET
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZRHODREF ! RHO Dry REFerence
+REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature
+REAL, DIMENSION(:), INTENT(IN) :: ZPRES ! Pressure
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZLSFACT ! L_s/(Pi_ref*C_ph)
+REAL, DIMENSION(:), INTENT(IN) :: ZLVFACT ! L_v/(Pi_ref*C_ph)
+REAL, DIMENSION(:), INTENT(IN) :: ZKA ! Thermal conductivity of the air
+REAL, DIMENSION(:), INTENT(IN) :: ZDV ! Diffusivity of water vapor in the air
+REAL, DIMENSION(:), INTENT(IN) :: ZCJ ! Ventilation coefficient ?
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZRHT ! Hail m.r. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZCCT ! Cloud water conc. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZCRT ! Rain water conc. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZCIT ! Pristine ice conc. at t
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRRS ! Rain water m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRGS ! Graupel/hail m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRHS ! Hail m.r. source
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: ZTHS ! Theta source
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: ZCCS ! Cloud water conc. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZCRS ! Rain water conc. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZCIS ! Pristine ice conc. source
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAC ! Slope param of the cloud droplet distr.
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAR ! Slope param of the raindrop distr
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAS ! Slope param of the aggregate distr.
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAG ! Slope param of the graupel distr.
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAH ! Slope param of the hail distr.
+!
+! used for budget storage
+REAL, DIMENSION(:), INTENT(IN) :: ZRHODJ
+LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GMICRO
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
+INTEGER, INTENT(IN) :: KMI
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRSS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIS
+
+!
+!* 0.2 Declarations of local variables :
+!
+LOGICAL, DIMENSION(SIZE(ZZT)) :: GRIM, GACC, GDRY, GWET, GHAIL ! Test where to compute
+INTEGER :: IGRIM, IGACC, IGDRY, IGWET, IHAIL
+INTEGER :: JJ
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1,IVEC2 ! Vectors of indices
+REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2, ZVEC3 ! Work vectors
+REAL, DIMENSION(SIZE(ZZT)) :: ZZW, ZZX
+REAL, DIMENSION(SIZE(ZZT)) :: ZRDRYG, ZRWETG
+REAL, DIMENSION(SIZE(ZZT),7) :: ZZW1
+REAL :: NHAIL
+REAL :: ZTHRH, ZTHRC
+!
+!-------------------------------------------------------------------------------
+!
+! #################
+! FAST RS PROCESSES
+! #################
+!
+IF (LSNOW) THEN
+!
+!
+!* 1.1 Cloud droplet riming of the aggregates
+! -------------------------------------------
+!
+!
+ZZW1(:,:) = 0.0
+!
+GRIM(:) = (ZRCT(:)>0.0) .AND. (ZRST(:)>0.0) .AND. (ZRCS(:)>0.0) .AND. (ZZT(:)<XTT)
+IGRIM = COUNT( GRIM(:) )
+!
+IF( IGRIM>0 ) THEN
+!
+! 1.1.0 allocations
+!
+ ALLOCATE(ZVEC1(IGRIM))
+ ALLOCATE(ZVEC2(IGRIM))
+ ALLOCATE(IVEC1(IGRIM))
+ ALLOCATE(IVEC2(IGRIM))
+!
+! 1.1.1 select the ZLBDAS
+!
+ ZVEC1(:) = PACK( ZLBDAS(:),MASK=GRIM(:) )
+!
+! 1.1.2 find the next lower indice for the ZLBDAS in the geometrical
+! set of Lbda_s used to tabulate some moments of the incomplete
+! gamma function
+!
+ ZVEC2(1:IGRIM) = MAX( 1.00001, MIN( FLOAT(NGAMINC)-0.00001, &
+ XRIMINTP1 * LOG( ZVEC1(1:IGRIM) ) + XRIMINTP2 ) )
+ IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) )
+ ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - FLOAT( IVEC2(1:IGRIM) )
+!
+! 1.1.3 perform the linear interpolation of the normalized
+! "2+XDS"-moment of the incomplete gamma function
+!
+ ZVEC1(1:IGRIM) = XGAMINC_RIM1( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
+ - XGAMINC_RIM1( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
+ ZZW(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GRIM,FIELD=0.0 )
+!
+! 1.1.4 riming of the small sized aggregates
+!
+ WHERE ( GRIM(:) )
+ ZZW1(:,1) = MIN( ZRCS(:), &
+ XCRIMSS * ZZW(:) * ZRCT(:) & ! RCRIMSS
+ * ZLBDAS(:)**XEXCRIMSS &
+ * ZRHODREF(:)**(-XCEXVT) )
+ ZRCS(:) = ZRCS(:) - ZZW1(:,1)
+ ZRSS(:) = ZRSS(:) + ZZW1(:,1)
+ ZTHS(:) = ZTHS(:) + ZZW1(:,1)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RCRIMSS))
+!
+ ZCCS(:) = MAX( ZCCS(:)-ZZW1(:,1)*(ZCCT(:)/ZRCT(:)),0.0 ) ! Lambda_c**3
+ END WHERE
+!
+! 1.1.5 perform the linear interpolation of the normalized
+! "XBS"-moment of the incomplete gamma function
+!
+ ZVEC1(1:IGRIM) = XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
+ - XGAMINC_RIM2( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
+ ZZW(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GRIM,FIELD=0.0 )
+!
+! 1.1.6 riming-conversion of the large sized aggregates into graupeln
+!
+!
+ WHERE ( GRIM(:) .AND. (ZRSS(:)>0.0) )
+ ZZW1(:,2) = MIN( ZRCS(:), &
+ XCRIMSG * ZRCT(:) & ! RCRIMSG
+ * ZLBDAS(:)**XEXCRIMSG &
+ * ZRHODREF(:)**(-XCEXVT) &
+ - ZZW1(:,1) )
+ ZZW1(:,3) = MIN( ZRSS(:), &
+ XSRIMCG * ZLBDAS(:)**XEXSRIMCG & ! RSRIMCG
+ * (1.0 - ZZW(:) )/(PTSTEP*ZRHODREF(:)))
+ ZRCS(:) = ZRCS(:) - ZZW1(:,2)
+ ZRSS(:) = ZRSS(:) - ZZW1(:,3)
+ ZRGS(:) = ZRGS(:) + ZZW1(:,2) + ZZW1(:,3)
+ ZTHS(:) = ZTHS(:) + ZZW1(:,2)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RCRIMSG))
+!
+ ZCCS(:) = MAX( ZCCS(:)-ZZW1(:,2)*(ZCCT(:)/ZRCT(:)),0.0 ) ! Lambda_c**3
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+END IF
+!
+! Budget storage
+IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
+ 4,'RIM_BU_RTH')
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
+ 7,'RIM_BU_RRC')
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
+ 10,'RIM_BU_RRS')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
+ 11,'RIM_BU_RRG')
+ IF (LBUDGET_SV) THEN
+ CALL BUDGET (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
+ 12+NSV_LIMA_NC,'RIM_BU_RSV')
+ END IF
+END IF
+!
+!
+!* 1.2 Hallett-Mossop ice multiplication process due to snow riming
+! -----------------------------------------------------------------
+!
+!
+GRIM(:) = (ZZT(:)<XHMTMAX) .AND. (ZZT(:)>XHMTMIN) &
+ .AND. (ZRST(:)>XRTMIN(5)) .AND. (ZRCT(:)>XRTMIN(2))
+IGRIM = COUNT( GRIM(:) )
+IF( IGRIM>0 ) THEN
+ ALLOCATE(ZVEC1(IGRIM))
+ ALLOCATE(ZVEC2(IGRIM))
+ ALLOCATE(IVEC2(IGRIM))
+!
+ ZVEC1(:) = PACK( ZLBDAC(:),MASK=GRIM(:) )
+ ZVEC2(1:IGRIM) = MAX( 1.00001, MIN( FLOAT(NGAMINC)-0.00001, &
+ XHMLINTP1 * LOG( ZVEC1(1:IGRIM) ) + XHMLINTP2 ) )
+ IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) )
+ ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - FLOAT( IVEC2(1:IGRIM) )
+ ZVEC1(1:IGRIM) = XGAMINC_HMC( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
+ - XGAMINC_HMC( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
+ ZZX(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GRIM,FIELD=0.0 ) ! Large droplets
+!
+ WHERE ( GRIM(:) .AND. ZZX(:)<0.99 )
+ ZZW1(:,5) = (ZZW1(:,1)+ZZW1(:,2))*(ZCCT(:)/ZRCT(:))*(1.0-ZZX(:))* &
+ XHM_FACTS* &
+ MAX( 0.0, MIN( (ZZT(:)-XHMTMIN)/3.0,(XHMTMAX-ZZT(:))/2.0 ) ) ! CCHMSI
+ ZCIS(:) = ZCIS(:) + ZZW1(:,5)
+!
+ ZZW1(:,6) = ZZW1(:,5) * XMNU0 ! RCHMSI
+ ZRIS(:) = ZRIS(:) + ZZW1(:,6)
+ ZRSS(:) = ZRSS(:) - ZZW1(:,6)
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+END IF
+!
+! Budget storage
+IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(ZRIS(:),MASK=GMICRO,FIELD=PRIS)*PRHODJ(:,:,:), &
+ 9,'HMS_BU_RRI')
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(ZRSS(:),MASK=GMICRO,FIELD=PRSS)*PRHODJ(:,:,:), &
+ 10,'HMS_BU_RRS')
+ IF (LBUDGET_SV) CALL BUDGET ( &
+ UNPACK(ZCIS(:),MASK=GMICRO,FIELD=PCIS)*PRHODJ(:,:,:), &
+ 12+NSV_LIMA_NI,'HMS_BU_RSV')
+END IF
+!
+!
+!* 1.3 Rain accretion onto the aggregates
+! ---------------------------------------
+!
+!
+ZZW1(:,2:3) = 0.0
+GACC(:) = (ZRRT(:)>0.0) .AND. (ZRST(:)>0.0) .AND. (ZRRS(:)>0.0) .AND. (ZZT(:)<XTT)
+IGACC = COUNT( GACC(:) )
+!
+IF( IGACC>0 ) THEN
+!
+! 1.3.0 allocations
+!
+ ALLOCATE(ZVEC1(IGACC))
+ ALLOCATE(ZVEC2(IGACC))
+ ALLOCATE(ZVEC3(IGACC))
+ ALLOCATE(IVEC1(IGACC))
+ ALLOCATE(IVEC2(IGACC))
+!
+! 1.3.1 select the (ZLBDAS,ZLBDAR) couplet
+!
+ ZVEC1(:) = PACK( ZLBDAS(:),MASK=GACC(:) )
+ ZVEC2(:) = PACK( ZLBDAR(:),MASK=GACC(:) )
+!
+! 1.3.2 find the next lower indice for the ZLBDAS and for the ZLBDAR
+! in the geometrical set of (Lbda_s,Lbda_r) couplet use to
+! tabulate the RACCSS-kernel
+!
+ ZVEC1(1:IGACC) = MAX( 1.00001, MIN( FLOAT(NACCLBDAS)-0.00001, &
+ XACCINTP1S * LOG( ZVEC1(1:IGACC) ) + XACCINTP2S ) )
+ IVEC1(1:IGACC) = INT( ZVEC1(1:IGACC) )
+ ZVEC1(1:IGACC) = ZVEC1(1:IGACC) - FLOAT( IVEC1(1:IGACC) )
+!
+ ZVEC2(1:IGACC) = MAX( 1.00001, MIN( FLOAT(NACCLBDAR)-0.00001, &
+ XACCINTP1R * LOG( ZVEC2(1:IGACC) ) + XACCINTP2R ) )
+ IVEC2(1:IGACC) = INT( ZVEC2(1:IGACC) )
+ ZVEC2(1:IGACC) = ZVEC2(1:IGACC) - FLOAT( IVEC2(1:IGACC) )
+!
+! 1.3.3 perform the bilinear interpolation of the normalized
+! RACCSS-kernel
+!
+ DO JJ = 1,IGACC
+ ZVEC3(JJ) = ( XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GACC,FIELD=0.0 )
+!
+! 1.3.4 raindrop accretion on the small sized aggregates
+!
+ WHERE ( GACC(:) )
+ ZZW1(:,2) = & !! coef of RRACCS
+ XFRACCSS*( ZLBDAS(:)**XCXS )*( ZRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBRACCS1/((ZLBDAS(:)**2) ) + &
+ XLBRACCS2/( ZLBDAS(:) * ZLBDAR(:) ) + &
+ XLBRACCS3/( (ZLBDAR(:)**2)) )/ZLBDAR(:)**3
+ ZZW1(:,4) = MIN( ZRRS(:),ZZW1(:,2)*ZZW(:) ) ! RRACCSS
+ ZRRS(:) = ZRRS(:) - ZZW1(:,4)
+ ZRSS(:) = ZRSS(:) + ZZW1(:,4)
+ ZTHS(:) = ZTHS(:) + ZZW1(:,4)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RRACCSS))
+!
+ ZCRS(:) = MAX( ZCRS(:)-ZZW1(:,4)*(ZCRT(:)/ZRRT(:)),0.0 ) ! Lambda_r**3
+ END WHERE
+!
+! 1.3.4b perform the bilinear interpolation of the normalized
+! RACCS-kernel
+!
+ DO JJ = 1,IGACC
+ ZVEC3(JJ) = ( XKER_RACCS(IVEC2(JJ)+1,IVEC1(JJ)+1)* ZVEC1(JJ) &
+ - XKER_RACCS(IVEC2(JJ)+1,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
+ * ZVEC2(JJ) &
+ - ( XKER_RACCS(IVEC2(JJ) ,IVEC1(JJ)+1)* ZVEC1(JJ) &
+ - XKER_RACCS(IVEC2(JJ) ,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
+ * (ZVEC2(JJ) - 1.0)
+ END DO
+ ZZW1(:,2) = ZZW1(:,2)*UNPACK( VECTOR=ZVEC3(:),MASK=GACC(:),FIELD=0.0 ) !! RRACCS
+!
+! 1.3.5 perform the bilinear interpolation of the normalized
+! SACCRG-kernel
+!
+ DO JJ = 1,IGACC
+ ZVEC3(JJ) = ( XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ)+1)* ZVEC1(JJ) &
+ - XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
+ * ZVEC2(JJ) &
+ - ( XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ)+1)* ZVEC1(JJ) &
+ - XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
+ * (ZVEC2(JJ) - 1.0)
+ END DO
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GACC,FIELD=0.0 )
+!
+! 1.3.6 raindrop accretion-conversion of the large sized aggregates
+! into graupeln
+!
+ WHERE ( GACC(:) .AND. (ZRSS(:)>0.0) )
+ ZZW1(:,2) = MIN( ZRRS(:),ZZW1(:,2)-ZZW1(:,4) ) ! RRACCSG
+ ZZW1(:,3) = MIN( ZRSS(:),XFSACCRG*ZZW(:)* & ! RSACCRG
+ ( ZLBDAS(:)**(XCXS-XBS) )*( ZRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBSACCR1/((ZLBDAR(:)**2) ) + &
+ XLBSACCR2/( ZLBDAR(:) * ZLBDAS(:) ) + &
+ XLBSACCR3/( (ZLBDAS(:)**2)) ) )
+ ZRRS(:) = ZRRS(:) - ZZW1(:,2)
+ ZRSS(:) = ZRSS(:) - ZZW1(:,3)
+ ZRGS(:) = ZRGS(:) + ZZW1(:,2)+ZZW1(:,3)
+ ZTHS(:) = ZTHS(:) + ZZW1(:,2)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RRACCSG))
+!
+ ZCRS(:) = MAX( ZCRS(:)-ZZW1(:,2)*(ZCRT(:)/ZRRT(:)),0.0 ) ! Lambda_r**3
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+END IF
+!
+IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
+ 4,'ACC_BU_RTH')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
+ 8,'ACC_BU_RRR')
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
+ 10,'ACC_BU_RRS')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
+ 11,'ACC_BU_RRG')
+ IF (LBUDGET_SV) THEN
+ CALL BUDGET (UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
+ 12+NSV_LIMA_NR,'ACC_BU_RSV')
+ END IF
+END IF
+!
+!
+!* 1.4 Conversion-Melting of the aggregates
+! -----------------------------------------
+!
+!
+ZZW(:) = 0.0
+WHERE( (ZRST(:)>0.0) .AND. (ZRSS(:)>0.0) .AND. (ZZT(:)>XTT) )
+ ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
+ ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + &
+ ( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) &
+ *(XESTT-ZZW(:))/(XRV*ZZT(:)) )
+!
+! compute RSMLT
+!
+ ZZW(:) = MIN( ZRSS(:), XFSCVMG*MAX( 0.0,( -ZZW(:) * &
+ ( X0DEPS* ZLBDAS(:)**XEX0DEPS + &
+ X1DEPS*ZCJ(:)*ZLBDAS(:)**XEX1DEPS ) - &
+ ( ZZW1(:,1)+ZZW1(:,4) ) * &
+ ( ZRHODREF(:)*XCL*(XTT-ZZT(:))) ) / &
+ ( ZRHODREF(:)*XLMTT ) ) )
+!
+! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT)
+! because the graupeln produced by this process are still icy!!!
+!
+ ZRSS(:) = ZRSS(:) - ZZW(:)
+ ZRGS(:) = ZRGS(:) + ZZW(:)
+END WHERE
+!
+! Budget storage
+IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
+ 10,'CMEL_BU_RRS')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
+ 11,'CMEL_BU_RRG')
+END IF
+!
+END IF ! LSNOW
+!
+!------------------------------------------------------------------------------
+!
+! #################
+! FAST RG PROCESSES
+! #################
+!
+!
+!* 2.1 Rain contact freezing
+! --------------------------
+!
+!
+ZZW1(:,3:4) = 0.0
+WHERE( (ZRIT(:)>0.0) .AND. (ZRRT(:)>0.0) .AND. (ZRIS(:)>0.0) .AND. (ZRRS(:)>0.0) )
+ ZZW1(:,3) = MIN( ZRIS(:),XICFRR * ZRIT(:) * ZCRT(:) & ! RICFRRG
+ * ZLBDAR(:)**XEXICFRR &
+ * ZRHODREF(:)**(-XCEXVT-1.0) )
+!
+ ZZW1(:,4) = MIN( ZRRS(:),XRCFRI * ZCIT(:) * ZCRT(:) & ! RRCFRIG
+ * ZLBDAR(:)**XEXRCFRI &
+ * ZRHODREF(:)**(-XCEXVT-2.0) )
+ ZRIS(:) = ZRIS(:) - ZZW1(:,3)
+ ZRRS(:) = ZRRS(:) - ZZW1(:,4)
+ ZRGS(:) = ZRGS(:) + ZZW1(:,3)+ZZW1(:,4)
+ ZTHS(:) = ZTHS(:) + ZZW1(:,4)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*RRCFRIG)
+!
+ ZCIS(:) = MAX( ZCIS(:)-ZZW1(:,3)*(ZCIT(:)/ZRIT(:)),0.0 ) ! CICFRRG
+ ZCRS(:) = MAX( ZCRS(:)-ZZW1(:,4)*(ZCRT(:)/ZRRT(:)),0.0 ) ! CRCFRIG
+END WHERE
+!
+IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
+ 4,'CFRZ_BU_RTH')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
+ 8,'CFRZ_BU_RRR')
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
+ 9,'CFRZ_BU_RRI')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
+ 11,'CFRZ_BU_RRG')
+ IF (LBUDGET_SV) THEN
+ CALL BUDGET ( UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
+ 12+NSV_LIMA_NR,'CFRZ_BU_RSV')
+ CALL BUDGET ( UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
+ 12+NSV_LIMA_NI,'CFRZ_BU_RSV')
+ END IF
+END IF
+!
+!
+!* 2.2 Compute the Dry growth case
+! --------------------------------
+!
+!
+ZZW1(:,:) = 0.0
+WHERE( ((ZRCT(:)>0.0) .AND. (ZRGT(:)>0.0) .AND. (ZRCS(:)>0.0)) .OR. &
+ ((ZRIT(:)>0.0) .AND. (ZRGT(:)>0.0) .AND. (ZRIS(:)>0.0)) )
+ ZZW(:) = ZLBDAG(:)**(XCXG-XDG-2.0) * ZRHODREF(:)**(-XCEXVT)
+ ZZW1(:,1) = MIN( ZRCS(:),XFCDRYG * ZRCT(:) * ZZW(:) ) ! RCDRYG
+ ZZW1(:,2) = MIN( ZRIS(:),XFIDRYG * EXP( XCOLEXIG*(ZZT(:)-XTT) ) &
+ * ZRIT(:) * ZZW(:) ) ! RIDRYG
+END WHERE
+!
+!* 2.2.1 accretion of aggregates on the graupeln
+! ----------------------------------------------
+!
+GDRY(:) = (ZRST(:)>0.0) .AND. (ZRGT(:)>0.0) .AND. (ZRSS(:)>0.0)
+IGDRY = COUNT( GDRY(:) )
+!
+IF( IGDRY>0 ) THEN
+!
+!* 2.2.2 allocations
+!
+ ALLOCATE(ZVEC1(IGDRY))
+ ALLOCATE(ZVEC2(IGDRY))
+ ALLOCATE(ZVEC3(IGDRY))
+ ALLOCATE(IVEC1(IGDRY))
+ ALLOCATE(IVEC2(IGDRY))
+!
+!* 2.2.3 select the (ZLBDAG,ZLBDAS) couplet
+!
+ ZVEC1(:) = PACK( ZLBDAG(:),MASK=GDRY(:) )
+ ZVEC2(:) = PACK( ZLBDAS(:),MASK=GDRY(:) )
+!
+!* 2.2.4 find the next lower indice for the ZLBDAG and for the ZLBDAS
+! in the geometrical set of (Lbda_g,Lbda_s) couplet use to
+! tabulate the SDRYG-kernel
+!
+ ZVEC1(1:IGDRY) = MAX( 1.00001, MIN( FLOAT(NDRYLBDAG)-0.00001, &
+ XDRYINTP1G * LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) )
+ IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) )
+ ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - FLOAT( IVEC1(1:IGDRY) )
+!
+ ZVEC2(1:IGDRY) = MAX( 1.00001, MIN( FLOAT(NDRYLBDAS)-0.00001, &
+ XDRYINTP1S * LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2S ) )
+ IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
+ ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - FLOAT( IVEC2(1:IGDRY) )
+!
+!* 2.2.5 perform the bilinear interpolation of the normalized
+! SDRYG-kernel
+!
+ DO JJ = 1,IGDRY
+ ZVEC3(JJ) = ( XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 )
+!
+ WHERE( GDRY(:) )
+ ZZW1(:,3) = MIN( ZRSS(:),XFSDRYG*ZZW(:) & ! RSDRYG
+ * EXP( XCOLEXSG*(ZZT(:)-XTT) ) &
+ *( ZLBDAS(:)**(XCXS-XBS) )*( ZLBDAG(:)**XCXG ) &
+ *( ZRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBSDRYG1/( ZLBDAG(:)**2 ) + &
+ XLBSDRYG2/( ZLBDAG(:) * ZLBDAS(:) ) + &
+ XLBSDRYG3/( ZLBDAS(:)**2) ) )
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+END IF
+!
+!* 2.2.6 accretion of raindrops on the graupeln
+! ---------------------------------------------
+!
+GDRY(:) = (ZRRT(:)>0.0) .AND. (ZRGT(:)>0.0) .AND. (ZRRS(:)>0.0)
+IGDRY = COUNT( GDRY(:) )
+!
+IF( IGDRY>0 ) THEN
+!
+!* 2.2.7 allocations
+!
+ ALLOCATE(ZVEC1(IGDRY))
+ ALLOCATE(ZVEC2(IGDRY))
+ ALLOCATE(ZVEC3(IGDRY))
+ ALLOCATE(IVEC1(IGDRY))
+ ALLOCATE(IVEC2(IGDRY))
+!
+!* 2.2.8 select the (ZLBDAG,ZLBDAR) couplet
+!
+ ZVEC1(:) = PACK( ZLBDAG(:),MASK=GDRY(:) )
+ ZVEC2(:) = PACK( ZLBDAR(:),MASK=GDRY(:) )
+!
+!* 2.2.9 find the next lower indice for the ZLBDAG and for the ZLBDAR
+! in the geometrical set of (Lbda_g,Lbda_r) couplet use to
+! tabulate the RDRYG-kernel
+!
+ ZVEC1(1:IGDRY) = MAX( 1.00001, MIN( FLOAT(NDRYLBDAG)-0.00001, &
+ XDRYINTP1G * LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) )
+ IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) )
+ ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - FLOAT( IVEC1(1:IGDRY) )
+!
+ ZVEC2(1:IGDRY) = MAX( 1.00001, MIN( FLOAT(NDRYLBDAR)-0.00001, &
+ XDRYINTP1R * LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2R ) )
+ IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
+ ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - FLOAT( IVEC2(1:IGDRY) )
+!
+!* 2.2.10 perform the bilinear interpolation of the normalized
+! RDRYG-kernel
+!
+ DO JJ = 1,IGDRY
+ ZVEC3(JJ) = ( XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 )
+!
+ WHERE( GDRY(:) )
+ ZZW1(:,4) = MIN( ZRRS(:),XFRDRYG*ZZW(:) & ! RRDRYG
+ *( ZLBDAR(:)**(-3) )*( ZLBDAG(:)**XCXG ) &
+ *( ZRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBRDRYG1/( ZLBDAG(:)**2 ) + &
+ XLBRDRYG2/( ZLBDAG(:) * ZLBDAR(:) ) + &
+ XLBRDRYG3/( ZLBDAR(:)**2) ) )
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+END IF
+!
+ZRDRYG(:) = ZZW1(:,1) + ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,4)
+!
+!
+!* 2.3 Compute the Wet growth case
+! --------------------------------
+!
+!
+ZZW(:) = 0.0
+ZRWETG(:) = 0.0
+WHERE( ZRGT(:)>0.0 )
+ ZZW1(:,5) = MIN( ZRIS(:), &
+ ZZW1(:,2) / (XCOLIG*EXP(XCOLEXIG*(ZZT(:)-XTT)) ) ) ! RIWETG
+ ZZW1(:,6) = MIN( ZRSS(:), &
+ ZZW1(:,3) / (XCOLSG*EXP(XCOLEXSG*(ZZT(:)-XTT)) ) ) ! RSWETG
+!
+ ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
+ ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + &
+ ( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) &
+ *(XESTT-ZZW(:))/(XRV*ZZT(:)) )
+!
+! compute RWETG
+!
+ ZRWETG(:) = MAX( 0.0, &
+ ( ZZW(:) * ( X0DEPG* ZLBDAG(:)**XEX0DEPG + &
+ X1DEPG*ZCJ(:)*ZLBDAG(:)**XEX1DEPG ) + &
+ ( ZZW1(:,5)+ZZW1(:,6) ) * &
+ ( ZRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-ZZT(:))) ) ) / &
+ ( ZRHODREF(:)*(XLMTT-XCL*(XTT-ZZT(:))) ) )
+END WHERE
+!
+!
+!* 2.4 Select Wet or Dry case
+! ---------------------------
+!
+!
+! Wet case and partial conversion to hail
+!
+ZZW(:) = 0.0
+NHAIL = 0.
+IF (LHAIL) NHAIL = 1.
+WHERE( ZRGT(:)>XRTMIN(6) .AND. ZZT(:)<XTT &
+ .AND. ZRDRYG(:)>=ZRWETG(:) .AND. ZRWETG(:)>0.0 )
+!
+ ZZW(:) = ZRWETG(:) - ZZW1(:,5) - ZZW1(:,6) ! RCWETG+RRWETG
+!
+! limitation of the available rainwater mixing ratio (RRWETH < RRS !)
+!
+ ZZW1(:,7) = MAX( 0.0,MIN( ZZW(:),ZRRS(:)+ZZW1(:,1) ) )
+ ZZX(:) = ZZW1(:,7) / ZZW(:)
+ ZZW1(:,5) = ZZW1(:,5)*ZZX(:)
+ ZZW1(:,6) = ZZW1(:,6)*ZZX(:)
+ ZRWETG(:) = ZZW1(:,7) + ZZW1(:,5) + ZZW1(:,6)
+!
+ ZRCS(:) = ZRCS(:) - ZZW1(:,1)
+ ZRIS(:) = ZRIS(:) - ZZW1(:,5)
+ ZRSS(:) = ZRSS(:) - ZZW1(:,6)
+!
+! assume a linear percent of conversion of graupel into hail
+!
+ ZRGS(:) = ZRGS(:) + ZRWETG(:)
+ ZZW(:) = ZRGS(:)*ZRDRYG(:)*NHAIL/(ZRWETG(:)+ZRDRYG(:))
+ ZRGS(:) = ZRGS(:) - ZZW(:)
+ ZRHS(:) = ZRHS(:) + ZZW(:)
+ ZRRS(:) = MAX( 0.0,ZRRS(:) - ZZW1(:,7) + ZZW1(:,1) )
+ ZTHS(:) = ZTHS(:) + ZZW1(:,7)*(ZLSFACT(:)-ZLVFACT(:))
+ ! f(L_f*(RCWETG+RRWETG))
+!
+ ZCCS(:) = MAX( ZCCS(:)-ZZW1(:,1)*(ZCCT(:)/MAX(ZRCT(:),XRTMIN(2))),0.0 )
+ ZCIS(:) = MAX( ZCIS(:)-ZZW1(:,5)*(ZCIT(:)/MAX(ZRIT(:),XRTMIN(4))),0.0 )
+ ZCRS(:) = MAX( ZCRS(:)-MAX( ZZW1(:,7)-ZZW1(:,1),0.0 ) &
+ *(ZCRT(:)/MAX(ZRRT(:),XRTMIN(3))),0.0 )
+END WHERE
+!
+! Budget storage
+ IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
+ 4,'WETG_BU_RTH')
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
+ 7,'WETG_BU_RRC')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
+ 8,'WETG_BU_RRR')
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
+ 9,'WETG_BU_RRI')
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
+ 10,'WETG_BU_RRS')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
+ 11,'WETG_BU_RRG')
+ IF (LBUDGET_RH) CALL BUDGET ( &
+ UNPACK(ZRHS(:),MASK=GMICRO(:,:,:),FIELD=PRHS)*PRHODJ(:,:,:), &
+ 12,'WETG_BU_RRH')
+ IF (LBUDGET_SV) THEN
+ CALL BUDGET (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
+ 12+NSV_LIMA_NC,'WETG_BU_RSV')
+ CALL BUDGET (UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
+ 12+NSV_LIMA_NR,'WETG_BU_RSV')
+ CALL BUDGET (UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
+ 12+NSV_LIMA_NI,'WETG_BU_RSV')
+ END IF
+ END IF
+!
+! Dry case
+!
+WHERE( ZRGT(:)>XRTMIN(6) .AND. ZZT(:)<XTT &
+ .AND. ZRDRYG(:)<ZRWETG(:) .AND. ZRDRYG(:)>0.0 ) ! case
+ ZRCS(:) = ZRCS(:) - ZZW1(:,1)
+ ZRIS(:) = ZRIS(:) - ZZW1(:,2)
+ ZRSS(:) = ZRSS(:) - ZZW1(:,3)
+ ZRRS(:) = ZRRS(:) - ZZW1(:,4)
+ ZRGS(:) = ZRGS(:) + ZRDRYG(:)
+ ZTHS(:) = ZTHS(:) + (ZZW1(:,1)+ZZW1(:,4))*(ZLSFACT(:)-ZLVFACT(:)) !
+ ! f(L_f*(RCDRYG+RRDRYG))
+!
+ ZCCS(:) = MAX( ZCCS(:)-ZZW1(:,1)*(ZCCT(:)/MAX(ZRCT(:),XRTMIN(2))),0.0 )
+ ZCIS(:) = MAX( ZCIS(:)-ZZW1(:,2)*(ZCIT(:)/MAX(ZRIT(:),XRTMIN(4))),0.0 )
+ ZCRS(:) = MAX( ZCRS(:)-ZZW1(:,4)*(ZCRT(:)/MAX(ZRRT(:),XRTMIN(3))),0.0 )
+ ! Approximate rates
+END WHERE
+!
+! Budget storage
+IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
+ 4,'DRYG_BU_RTH')
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
+ 7,'DRYG_BU_RRC')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
+ 8,'DRYG_BU_RRR')
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
+ 9,'DRYG_BU_RRI')
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
+ 10,'DRYG_BU_RRS')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
+ 11,'DRYG_BU_RRG')
+ IF (LBUDGET_SV) THEN
+ CALL BUDGET ( UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
+ 12+NSV_LIMA_NC,'DRYG_BU_RSV')
+ CALL BUDGET ( UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
+ 12+NSV_LIMA_NR,'DRYG_BU_RSV')
+ CALL BUDGET ( UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
+ 12+NSV_LIMA_NI,'DRYG_BU_RSV')
+ END IF
+END IF
+!
+!
+!* 2.5 Hallett-Mossop ice multiplication process due to graupel riming
+! --------------------------------------------------------------------
+!
+!
+GDRY(:) = (ZZT(:)<XHMTMAX) .AND. (ZZT(:)>XHMTMIN) .AND. (ZRDRYG(:)<ZZW(:))&
+ .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRCT(:)>XRTMIN(2))
+IGDRY = COUNT( GDRY(:) )
+IF( IGDRY>0 ) THEN
+ ALLOCATE(ZVEC1(IGDRY))
+ ALLOCATE(ZVEC2(IGDRY))
+ ALLOCATE(IVEC2(IGDRY))
+!
+ ZVEC1(:) = PACK( ZLBDAC(:),MASK=GDRY(:) )
+ ZVEC2(1:IGDRY) = MAX( 1.00001, MIN( FLOAT(NGAMINC)-0.00001, &
+ XHMLINTP1 * LOG( ZVEC1(1:IGDRY) ) + XHMLINTP2 ) )
+ IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
+ ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - FLOAT( IVEC2(1:IGDRY) )
+ ZVEC1(1:IGDRY) = XGAMINC_HMC( IVEC2(1:IGDRY)+1 )* ZVEC2(1:IGDRY) &
+ - XGAMINC_HMC( IVEC2(1:IGDRY) )*(ZVEC2(1:IGDRY) - 1.0)
+ ZZX(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GDRY,FIELD=0.0 ) ! Large droplets
+!
+ WHERE ( GDRY(:) .AND. ZZX(:)<0.99 ) ! Dry case
+ ZZW1(:,5) = ZZW1(:,1)*(ZCCT(:)/ZRCT(:))*(1.0-ZZX(:))*XHM_FACTG* &
+ MAX( 0.0, MIN( (ZZT(:)-XHMTMIN)/3.0,(XHMTMAX-ZZT(:))/2.0 ) ) ! CCHMGI
+ ZCIS(:) = ZCIS(:) + ZZW1(:,5)
+!
+ ZZW1(:,6) = ZZW1(:,5) * XMNU0 ! RCHMGI
+ ZRIS(:) = ZRIS(:) + ZZW1(:,6)
+ ZRGS(:) = ZRGS(:) - ZZW1(:,6)
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+END IF
+!
+! Budget storage
+IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(ZRIS(:),MASK=GMICRO,FIELD=PRIS)*PRHODJ(:,:,:), &
+ 9,'HMG_BU_RRI')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(ZRGS(:),MASK=GMICRO,FIELD=PRGS)*PRHODJ(:,:,:), &
+ 11,'HMG_BU_RRG')
+ IF (LBUDGET_SV) CALL BUDGET ( &
+ UNPACK(ZCIS(:),MASK=GMICRO,FIELD=PCIS)*PRHODJ(:,:,:), &
+ 12+NSV_LIMA_NI,'HMG_BU_RSV')
+END IF
+!
+!
+!* 2.6 Melting of the graupeln
+! ----------------------------
+!
+!
+ZZW(:) = 0.0
+WHERE( (ZRGT(:)>0.0) .AND. (ZRGS(:)>0.0) .AND. (ZZT(:)>XTT) )
+ ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
+ ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + &
+ ( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) &
+ *(XESTT-ZZW(:))/(XRV*ZZT(:)) )
+!
+! compute RGMLTR
+!
+ ZZW(:) = MIN( ZRGS(:), MAX( 0.0,( -ZZW(:) * &
+ ( X0DEPG* ZLBDAG(:)**XEX0DEPG + &
+ X1DEPG*ZCJ(:)*ZLBDAG(:)**XEX1DEPG ) - &
+ ( ZZW1(:,1)+ZZW1(:,4) ) * &
+ ( ZRHODREF(:)*XCL*(XTT-ZZT(:))) ) / &
+ ( ZRHODREF(:)*XLMTT ) ) )
+ ZRRS(:) = ZRRS(:) + ZZW(:)
+ ZRGS(:) = ZRGS(:) - ZZW(:)
+ ZTHS(:) = ZTHS(:) - ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(-RGMLTR))
+!
+! ZCRS(:) = MAX( ZCRS(:) + ZZW(:)*(XCCG*ZLBDAG(:)**XCXG/ZRGT(:)),0.0 )
+ ZCRS(:) = ZCRS(:) + ZZW(:)*5.0E6 ! obtained after averaging
+ ! Dshed=1mm and 500 microns
+END WHERE
+!
+IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
+ 4,'GMLT_BU_RTH')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
+ 8,'GMLT_BU_RRR')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
+ 11,'GMLT_BU_RRG')
+ IF (LBUDGET_SV) THEN
+ CALL BUDGET ( UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
+ 12+NSV_LIMA_NR,'GMLT_BU_RSV')
+ END IF
+END IF
+!
+!
+!------------------------------------------------------------------------------
+!
+! #################
+! FAST RH PROCESSES
+! #################
+!
+!
+IF (LHAIL) THEN
+!
+GHAIL(:) = ZRHT(:)>XRTMIN(7)
+IHAIL = COUNT(GHAIL(:))
+!
+IF( IHAIL>0 ) THEN
+!
+!* 3.1 Wet growth of hail
+! ----------------------------
+!
+ ZZW1(:,:) = 0.0
+ WHERE( GHAIL(:) .AND. ( (ZRCT(:)>XRTMIN(2) .AND. ZRCS(:)>0.0) .OR. &
+ (ZRIT(:)>XRTMIN(4) .AND. ZRIS(:)>0.0) ) )
+ ZZW(:) = ZLBDAH(:)**(XCXH-XDH-2.0) * ZRHODREF(:)**(-XCEXVT)
+ ZZW1(:,1) = MIN( ZRCS(:),XFWETH * ZRCT(:) * ZZW(:) ) ! RCWETH
+ ZZW1(:,2) = MIN( ZRIS(:),XFWETH * ZRIT(:) * ZZW(:) ) ! RIWETH
+ END WHERE
+!
+!* 3.1.1 accretion of aggregates on the hailstones
+! ------------------------------------------------
+!
+ GWET(:) = GHAIL(:) .AND. (ZRST(:)>XRTMIN(5) .AND. ZRSS(:)>0.0)
+ IGWET = COUNT( GWET(:) )
+!
+ IF( IGWET>0 ) THEN
+!
+!* 3.1.2 allocations
+!
+ ALLOCATE(ZVEC1(IGWET))
+ ALLOCATE(ZVEC2(IGWET))
+ ALLOCATE(ZVEC3(IGWET))
+ ALLOCATE(IVEC1(IGWET))
+ ALLOCATE(IVEC2(IGWET))
+!
+!* 3.1.3 select the (ZLBDAH,ZLBDAS) couplet
+!
+ ZVEC1(:) = PACK( ZLBDAH(:),MASK=GWET(:) )
+ ZVEC2(:) = PACK( ZLBDAS(:),MASK=GWET(:) )
+!
+!* 3.1.4 find the next lower indice for the ZLBDAG and for the ZLBDAS
+! in the geometrical set of (Lbda_h,Lbda_s) couplet use to
+! tabulate the SWETH-kernel
+!
+ ZVEC1(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAH)-0.00001, &
+ XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
+ IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
+ ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - FLOAT( IVEC1(1:IGWET) )
+!
+ ZVEC2(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAS)-0.00001, &
+ XWETINTP1S * LOG( ZVEC2(1:IGWET) ) + XWETINTP2S ) )
+ IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
+ ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - FLOAT( IVEC2(1:IGWET) )
+!
+!* 3.1.5 perform the bilinear interpolation of the normalized
+! SWETH-kernel
+!
+ DO JJ = 1,IGWET
+ ZVEC3(JJ) = ( XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GWET,FIELD=0.0 )
+!
+ WHERE( GWET(:) )
+ ZZW1(:,3) = MIN( ZRSS(:),XFSWETH*ZZW(:) & ! RSWETH
+ *( ZLBDAS(:)**(XCXS-XBS) )*( ZLBDAH(:)**XCXH ) &
+ *( ZRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBSWETH1/( ZLBDAH(:)**2 ) + &
+ XLBSWETH2/( ZLBDAH(:) * ZLBDAS(:) ) + &
+ XLBSWETH3/( ZLBDAS(:)**2) ) )
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ END IF
+!
+!* 3.1.6 accretion of graupeln on the hailstones
+! ----------------------------------------------
+!
+ GWET(:) = GHAIL(:) .AND. (ZRGT(:)>XRTMIN(6) .AND. ZRGS(:)>0.0)
+ IGWET = COUNT( GWET(:) )
+!
+ IF( IGWET>0 ) THEN
+!
+!* 3.1.7 allocations
+!
+ ALLOCATE(ZVEC1(IGWET))
+ ALLOCATE(ZVEC2(IGWET))
+ ALLOCATE(ZVEC3(IGWET))
+ ALLOCATE(IVEC1(IGWET))
+ ALLOCATE(IVEC2(IGWET))
+!
+!* 3.1.8 select the (ZLBDAH,ZLBDAG) couplet
+!
+ ZVEC1(:) = PACK( ZLBDAH(:),MASK=GWET(:) )
+ ZVEC2(:) = PACK( ZLBDAG(:),MASK=GWET(:) )
+!
+!* 3.1.9 find the next lower indice for the ZLBDAH and for the ZLBDAG
+! in the geometrical set of (Lbda_h,Lbda_g) couplet use to
+! tabulate the GWETH-kernel
+!
+ ZVEC1(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAG)-0.00001, &
+ XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
+ IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
+ ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - FLOAT( IVEC1(1:IGWET) )
+!
+ ZVEC2(1:IGWET) = MAX( 1.00001, MIN( FLOAT(NWETLBDAG)-0.00001, &
+ XWETINTP1G * LOG( ZVEC2(1:IGWET) ) + XWETINTP2G ) )
+ IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
+ ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - FLOAT( IVEC2(1:IGWET) )
+!
+!* 3.1.10 perform the bilinear interpolation of the normalized
+! GWETH-kernel
+!
+ DO JJ = 1,IGWET
+ ZVEC3(JJ) = ( XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
+ - XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GWET,FIELD=0.0 )
+!
+ WHERE( GWET(:) )
+ ZZW1(:,5) = MAX(MIN( ZRGS(:),XFGWETH*ZZW(:) & ! RGWETH
+ *( ZLBDAG(:)**(XCXG-XBG) )*( ZLBDAH(:)**XCXH ) &
+ *( ZRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBGWETH1/( ZLBDAH(:)**2 ) + &
+ XLBGWETH2/( ZLBDAH(:) * ZLBDAG(:) ) + &
+ XLBGWETH3/( ZLBDAG(:)**2) ) ),0. )
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ END IF
+!
+!* 3.2 compute the Wet growth of hail
+! -------------------------------------
+!
+ ZZW(:) = 0.0
+ WHERE( GHAIL(:) .AND. ZZT(:)<XTT )
+ ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
+ ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + &
+ ( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) &
+ *(XESTT-ZZW(:))/(XRV*ZZT(:)) )
+!
+! compute RWETH
+!
+ ZZW(:) = MAX(0., ( ZZW(:) * ( X0DEPH* ZLBDAH(:)**XEX0DEPH + &
+ X1DEPH*ZCJ(:)*ZLBDAH(:)**XEX1DEPH ) + &
+ ( ZZW1(:,2)+ZZW1(:,3)+ZZW1(:,5) ) * &
+ ( ZRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-ZZT(:))) ) ) / &
+ ( ZRHODREF(:)*(XLMTT-XCL*(XTT-ZZT(:))) ) )
+!
+ ZZW1(:,6) = MAX( ZZW(:) - ZZW1(:,2) - ZZW1(:,3) - ZZW1(:,5),0.) ! RCWETH+RRWETH
+ END WHERE
+ WHERE ( GHAIL(:) .AND. ZZT(:)<XTT .AND. ZZW1(:,6)/=0.)
+!
+! limitation of the available rainwater mixing ratio (RRWETH < RRS !)
+!
+ ZZW1(:,4) = MAX( 0.0,MIN( ZZW1(:,6),ZRRS(:)+ZZW1(:,1) ) )
+ ZZX(:) = ZZW1(:,4) / ZZW1(:,6)
+ ZZW1(:,2) = ZZW1(:,2)*ZZX(:)
+ ZZW1(:,3) = ZZW1(:,3)*ZZX(:)
+ ZZW1(:,5) = ZZW1(:,5)*ZZX(:)
+ ZZW(:) = ZZW1(:,4) + ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,5)
+!
+!* 3.2.1 integrate the Wet growth of hail
+!
+ ZRCS(:) = ZRCS(:) - ZZW1(:,1)
+ ZRIS(:) = ZRIS(:) - ZZW1(:,2)
+ ZRSS(:) = ZRSS(:) - ZZW1(:,3)
+ ZRGS(:) = ZRGS(:) - ZZW1(:,5)
+ ZRHS(:) = ZRHS(:) + ZZW(:)
+ ZRRS(:) = MAX( 0.0,ZRRS(:) - ZZW1(:,4) + ZZW1(:,1) )
+ ZTHS(:) = ZTHS(:) + ZZW1(:,4)*(ZLSFACT(:)-ZLVFACT(:))
+ ! f(L_f*(RCWETH+RRWETH))
+!
+ ZCCS(:) = MAX( ZCCS(:)-ZZW1(:,1)*(ZCCT(:)/MAX(ZRCT(:),XRTMIN(2))),0.0 )
+ ZCIS(:) = MAX( ZCIS(:)-ZZW1(:,2)*(ZCIT(:)/MAX(ZRIT(:),XRTMIN(4))),0.0 )
+ ZCRS(:) = MAX( ZCRS(:)-MAX( ZZW1(:,4)-ZZW1(:,1),0.0 ) &
+ *(ZCRT(:)/MAX(ZRRT(:),XRTMIN(3))),0.0 )
+ END WHERE
+!
+END IF ! IHAIL>0
+!
+!
+IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
+ 4,'WETH_BU_RTH')
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
+ 7,'WETH_BU_RRC')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
+ 8,'WETH_BU_RRR')
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
+ 9,'WETH_BU_RRI')
+ IF (LBUDGET_RS) CALL BUDGET ( &
+ UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
+ 10,'WETH_BU_RRS')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
+ 11,'WETH_BU_RRG')
+ IF (LBUDGET_RH) CALL BUDGET ( &
+ UNPACK(ZRHS(:),MASK=GMICRO(:,:,:),FIELD=PRHS)*PRHODJ(:,:,:), &
+ 12,'WETH_BU_RRH')
+ IF (LBUDGET_SV) THEN
+ CALL BUDGET (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
+ 12+NSV_LIMA_NC,'WETH_BU_RSV')
+ CALL BUDGET (UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
+ 12+NSV_LIMA_NR,'WETH_BU_RSV')
+ CALL BUDGET (UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
+ 12+NSV_LIMA_NI,'WETH_BU_RSV')
+ END IF
+END IF
+!
+!
+! Partial reconversion of hail to graupel when rc and rh are small
+!
+!
+!* 3.3 Conversion of the hailstones into graupel
+! -----------------------------------------------
+!
+IF ( IHAIL>0 ) THEN
+ ZTHRH=0.01E-3
+ ZTHRC=0.001E-3
+ ZZW(:) = 0.0
+ WHERE( ZRHT(:)<ZTHRH .AND. ZRCT(:)<ZTHRC .AND. ZZT(:)<XTT )
+ ZZW(:) = MIN( 1.0,MAX( 0.0,1.0-(ZRCT(:)/ZTHRC) ) )
+!
+! assume a linear percent conversion rate of hail into graupel
+!
+ ZZW(:) = ZRHS(:)*ZZW(:)
+ ZRGS(:) = ZRGS(:) + ZZW(:) ! partial conversion
+ ZRHS(:) = ZRHS(:) - ZZW(:) ! of hail into graupel
+!
+ END WHERE
+END IF
+!
+IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
+ 11,'COHG_BU_RRG')
+ IF (LBUDGET_RH) CALL BUDGET ( &
+ UNPACK(ZRHS(:),MASK=GMICRO(:,:,:),FIELD=PRHS)*PRHODJ(:,:,:), &
+ 12,'COHG_BU_RRH')
+END IF
+!
+!
+!* 3.4 Melting of the hailstones
+!
+IF ( IHAIL>0 ) THEN
+ ZZW(:) = 0.0
+ WHERE( GHAIL(:) .AND. (ZRHS(:)>0.0) .AND. (ZRHT(:)>0.0) .AND. (ZZT(:)>XTT) )
+ ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
+ ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + &
+ ( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) &
+ *(XESTT-ZZW(:))/(XRV*ZZT(:)) )
+!
+! compute RHMLTR
+!
+ ZZW(:) = MIN( ZRHS(:), MAX( 0.0,( -ZZW(:) * &
+ ( X0DEPH* ZLBDAH(:)**XEX0DEPH + &
+ X1DEPH*ZCJ(:)*ZLBDAH(:)**XEX1DEPH ) - &
+ ZZW1(:,6)*( ZRHODREF(:)*XCL*(XTT-ZZT(:))) ) / &
+ ( ZRHODREF(:)*XLMTT ) ) )
+ ZRRS(:) = ZRRS(:) + ZZW(:)
+ ZRHS(:) = ZRHS(:) - ZZW(:)
+ ZTHS(:) = ZTHS(:) - ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(-RHMLTR))
+!
+ ZCRS(:) = MAX( ZCRS(:) + ZZW(:)*(XCCH*ZLBDAH(:)**XCXH/ZRHT(:)),0.0 )
+!
+ END WHERE
+END IF
+!
+IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
+ 4,'HMLT_BU_RTH')
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
+ 8,'HMLT_BU_RRR')
+ IF (LBUDGET_RH) CALL BUDGET ( &
+ UNPACK(ZRHS(:),MASK=GMICRO(:,:,:),FIELD=PRHS)*PRHODJ(:,:,:), &
+ 12,'HMLT_BU_RRH')
+ IF (LBUDGET_SV) THEN
+ CALL BUDGET ( UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
+ 12+NSV_LIMA_NR,'HMLT_BU_RSV')
+ END IF
+END IF
+!
+END IF
+!
+!------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_MIXED_FAST_PROCESSES
diff --git a/src/MNH/lima_mixed_slow_processes.f90 b/src/MNH/lima_mixed_slow_processes.f90
new file mode 100644
index 000000000..85c78adeb
--- /dev/null
+++ b/src/MNH/lima_mixed_slow_processes.f90
@@ -0,0 +1,277 @@
+! #####################################
+ MODULE MODI_LIMA_MIXED_SLOW_PROCESSES
+! #####################################
+!
+INTERFACE
+ SUBROUTINE LIMA_MIXED_SLOW_PROCESSES(ZRHODREF, ZZT, ZSSI, &
+ ZLSFACT, ZLVFACT, ZAI, ZCJ, &
+ ZRGT, ZCIT, &
+ ZRVS, ZRCS, ZRIS, ZRGS, ZTHS, &
+ ZCCS, ZCIS, ZIFS, ZINS, &
+ ZLBDAI, ZLBDAG, &
+ ZRHODJ, GMICRO, PRHODJ, KMI, &
+ PTHS, PRVS, PRCS, PRIS, PRGS, &
+ PCCS, PCIS )
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZRHODREF ! RHO Dry REFerence
+REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature
+REAL, DIMENSION(:), INTENT(IN) :: ZSSI ! Supersaturation over ice
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZLSFACT ! L_s/(Pi_ref*C_ph)
+REAL, DIMENSION(:), INTENT(IN) :: ZLVFACT ! L_v/(Pi_ref*C_ph)
+REAL, DIMENSION(:), INTENT(IN) :: ZAI ! Thermodynamical function
+REAL, DIMENSION(:), INTENT(IN) :: ZCJ ! for the ventilation coefficient
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZCIT ! Pristine ice conc. at t
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRVS ! Water vapor m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRGS ! Graupel/hail m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZTHS ! Theta source
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: ZCCS ! Cloud water conc. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZCIS ! Pristine ice conc. source
+REAL, DIMENSION(:,:), INTENT(INOUT) :: ZIFS ! Free Ice nuclei conc. source
+REAL, DIMENSION(:,:), INTENT(INOUT) :: ZINS ! Nucleated Ice nuclei conc. source
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAI ! Slope parameter of the ice crystal distr.
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAG ! Slope parameter of the graupel distr.
+!
+! used for budget storage
+REAL, DIMENSION(:), INTENT(IN) :: ZRHODJ
+LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GMICRO
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
+INTEGER, INTENT(IN) :: KMI
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIS
+!
+END SUBROUTINE LIMA_MIXED_SLOW_PROCESSES
+END INTERFACE
+END MODULE MODI_LIMA_MIXED_SLOW_PROCESSES
+!
+! #######################################################################
+ SUBROUTINE LIMA_MIXED_SLOW_PROCESSES(ZRHODREF, ZZT, ZSSI, &
+ ZLSFACT, ZLVFACT, ZAI, ZCJ, &
+ ZRGT, ZCIT, &
+ ZRVS, ZRCS, ZRIS, ZRGS, ZTHS, &
+ ZCCS, ZCIS, ZIFS, ZINS, &
+ ZLBDAI, ZLBDAG, &
+ ZRHODJ, GMICRO, PRHODJ, KMI, &
+ PTHS, PRVS, PRCS, PRIS, PRGS, &
+ PCCS, PCIS )
+! #######################################################################
+!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the mixed-phase
+!! slow processes :
+!!
+!! Deposition of water vapor on graupeln
+!! Cloud ice Melting
+!! Bergeron-Findeisen effect
+!!
+!!** METHOD
+!! ------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Most of the parameterizations come from the ICE3 scheme, described in
+!! the MESO-NH scientific documentation.
+!!
+!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
+!! microphysical bulk scheme.
+!! Part I: Description and tests
+!! Part II: 2D experiments with a non-hydrostatic model
+!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! C. Barthe * LACy * jan. 2014 add budgets
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XTT, XALPI, XBETAI, XGAMI, &
+ XALPW, XBETAW, XGAMW
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, NMOD_IFN
+USE MODD_PARAM_LIMA_COLD, ONLY : XDI, X0DEPI, X2DEPI, XSCFAC
+USE MODD_PARAM_LIMA_MIXED, ONLY : XLBG, XLBEXG, XLBDAG_MAX, &
+ X0DEPG, XEX0DEPG, X1DEPG, XEX1DEPG
+!
+USE MODD_NSV
+USE MODD_BUDGET
+USE MODI_BUDGET
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZRHODREF ! RHO Dry REFerence
+REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature
+REAL, DIMENSION(:), INTENT(IN) :: ZSSI ! Supersaturation over ice
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZLSFACT ! L_s/(Pi_ref*C_ph)
+REAL, DIMENSION(:), INTENT(IN) :: ZLVFACT ! L_v/(Pi_ref*C_ph)
+REAL, DIMENSION(:), INTENT(IN) :: ZAI ! Thermodynamical function
+REAL, DIMENSION(:), INTENT(IN) :: ZCJ ! for the ventilation coefficient
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: ZCIT ! Pristine ice conc. at t
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRVS ! Water vapor m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZRGS ! Graupel/hail m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZTHS ! Theta source
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: ZCCS ! Cloud water conc. source
+REAL, DIMENSION(:), INTENT(INOUT) :: ZCIS ! Pristine ice conc. source
+REAL, DIMENSION(:,:), INTENT(INOUT) :: ZIFS ! Free Ice nuclei conc. source
+REAL, DIMENSION(:,:), INTENT(INOUT) :: ZINS ! Nucleated Ice nuclei conc. source
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAI ! Slope parameter of the ice crystal distr.
+REAL, DIMENSION(:), INTENT(IN) :: ZLBDAG ! Slope parameter of the graupel distr.
+!
+! used for budget storage
+REAL, DIMENSION(:), INTENT(IN) :: ZRHODJ
+LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GMICRO
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
+INTEGER, INTENT(IN) :: KMI
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIS
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(SIZE(ZZT)) :: ZZW, ZMASK ! Work vectors
+!
+INTEGER :: JMOD_IFN
+!
+!-------------------------------------------------------------------------------
+!
+!* 1 Deposition of water vapor on r_g: RVDEPG
+! ---------------------------------------------
+!
+!
+ ZZW(:) = 0.0
+ WHERE ( (ZRGT(:)>XRTMIN(6)) .AND. (ZRGS(:)>0.0) )
+!Correction BVIE RHODREF
+! ZZW(:) = ( ZSSI(:)/(ZRHODREF(:)*ZAI(:)) ) * &
+ ZZW(:) = ( ZSSI(:)/(ZAI(:)) ) * &
+ ( X0DEPG*ZLBDAG(:)**XEX0DEPG + X1DEPG*ZCJ(:)*ZLBDAG(:)**XEX1DEPG )
+ ZZW(:) = MIN( ZRVS(:),ZZW(:) )*(0.5+SIGN(0.5,ZZW(:))) &
+ - MIN( ZRGS(:),ABS(ZZW(:)) )*(0.5-SIGN(0.5,ZZW(:)))
+ ZRGS(:) = ZRGS(:) + ZZW(:)
+ ZRVS(:) = ZRVS(:) - ZZW(:)
+ ZTHS(:) = ZTHS(:) + ZZW(:)*ZLSFACT(:)
+ END WHERE
+!
+! Budget storage
+ IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
+ 4,'DEPG_BU_RTH')
+ IF (LBUDGET_RV) CALL BUDGET ( &
+ UNPACK(ZRVS(:),MASK=GMICRO(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:),&
+ 6,'DEPG_BU_RRV')
+ IF (LBUDGET_RG) CALL BUDGET ( &
+ UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
+ 11,'DEPG_BU_RRG')
+ END IF
+!
+!
+!* 2 cloud ice Melting: RIMLTC and CIMLTC
+! -----------------------------------------
+!
+!
+ ZMASK(:) = 1.0
+ WHERE( (ZRIS(:)>0.0) .AND. (ZZT(:)>XTT) )
+ ZRCS(:) = ZRCS(:) + ZRIS(:)
+ ZTHS(:) = ZTHS(:) - ZRIS(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(-RIMLTC))
+ ZRIS(:) = 0.0
+!
+ ZCCS(:) = ZCCS(:) + ZCIS(:)
+ ZCIS(:) = 0.0
+ ZMASK(:)= 0.0
+ END WHERE
+ DO JMOD_IFN = 1,NMOD_IFN
+! Correction BVIE aerosols not released but in droplets
+! ZIFS(:,JMOD_IFN) = ZIFS(:,JMOD_IFN) + ZINS(:,JMOD_IFN)*(1.-ZMASK(:))
+ ZINS(:,JMOD_IFN) = ZINS(:,JMOD_IFN) * ZMASK(:)
+ ENDDO
+!
+! Budget storage
+ IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
+ 4,'IMLT_BU_RTH')
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
+ 7,'IMLT_BU_RRC')
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
+ 9,'IMLT_BU_RRI')
+ IF (LBUDGET_SV) THEN
+ CALL BUDGET (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
+ 12+NSV_LIMA_NC,'IMLT_BU_RSV')
+ CALL BUDGET (UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
+ 12+NSV_LIMA_NI,'IMLT_BU_RSV')
+ END IF
+ END IF
+!
+!
+!* 3 Bergeron-Findeisen effect: RCBERI
+! --------------------------------------
+!
+!
+ ZZW(:) = 0.0
+ WHERE( (ZRCS(:)>0.0) .AND. (ZRIS(:)>0.0) .AND. (ZCIT(:)>XCTMIN(4)) )
+ ZZW(:) = EXP( (XALPW-XALPI) - (XBETAW-XBETAI)/ZZT(:) &
+ - (XGAMW-XGAMI)*ALOG(ZZT(:)) ) -1.0
+ ! supersaturation of saturated water over ice
+ ZZW(:) = MIN( ZRCS(:),( ZZW(:) / ZAI(:) ) * ZCIT(:) * &
+ ( X0DEPI/ZLBDAI(:)+X2DEPI*ZCJ(:)*ZCJ(:)/ZLBDAI(:)**(XDI+2.0) ) )
+ ZRCS(:) = ZRCS(:) - ZZW(:)
+ ZRIS(:) = ZRIS(:) + ZZW(:)
+ ZTHS(:) = ZTHS(:) + ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RCBERI))
+ END WHERE
+!
+! Budget storage
+ IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
+ 4,'BERFI_BU_RTH')
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
+ 7,'BERFI_BU_RRC')
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
+ 9,'BERFI_BU_RRI')
+ END IF
+!
+!------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_MIXED_SLOW_PROCESSES
diff --git a/src/MNH/lima_phillips.f90 b/src/MNH/lima_phillips.f90
new file mode 100644
index 000000000..f0674dc86
--- /dev/null
+++ b/src/MNH/lima_phillips.f90
@@ -0,0 +1,670 @@
+! #########################
+ MODULE MODI_LIMA_PHILLIPS
+! #########################
+!
+INTERFACE
+ SUBROUTINE LIMA_PHILLIPS (OHHONI, PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT, &
+ PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PTHS, PRVS, PRCS, PRIS, &
+ PCIT, PCCS, PCIS, &
+ PNAS, PIFS, PINS, PNIS )
+!
+LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
+ ! the tput FM fileoutp
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Ice crystal C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAS ! Cloud C. nuclei C. source
+ !used as Free ice nuclei for
+ !IMMERSION freezing
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIFS ! Free ice nuclei C. source
+ !for DEPOSITION and CONTACT
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINS ! Activated ice nuclei C. source
+ !for DEPOSITION and CONTACT
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIS ! Activated ice nuclei C. source
+ !for IMMERSION
+!
+END SUBROUTINE LIMA_PHILLIPS
+END INTERFACE
+END MODULE MODI_LIMA_PHILLIPS
+!
+! ######################################################################
+ SUBROUTINE LIMA_PHILLIPS (OHHONI, PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT, &
+ PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PTHS, PRVS, PRCS, PRIS, &
+ PCIT, PCCS, PCIS, &
+ PNAS, PIFS, PINS, PNIS )
+! ######################################################################
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the heterogeneous nucleation
+!! following Phillips (2008).
+!!
+!!
+!!** METHOD
+!! ------
+!! The parameterization of Phillips (2008) is based on observed nucleation
+!! in the CFDC for a range of T and Si values. Phillips therefore defines a
+!! reference activity spectrum, that is, for given T and Si values, the
+!! reference concentration of primary ice crystals.
+!!
+!! The activation of IFN is closely related to their total surface. Thus,
+!! the activable fraction of each IFN specie is determined by an integration
+!! over the particle size distributions.
+!!
+!! Subroutine organisation :
+!!
+!! 1- Preliminary computations
+!! 2- Check where computations are necessary, and pack variables
+!! 3- Compute the saturation over water and ice
+!! 4- Compute the reference activity spectrum
+!! -> CALL LIMA_PHILLIPS_REF_SPECTRUM
+!! Integrate over the size distributions to compute the IFN activable fraction
+!! -> CALL LIMA_PHILLIPS_INTEG
+!! 5- Heterogeneous nucleation of insoluble IFN
+!! 6- Heterogeneous nucleation of coated IFN
+!! 7- Unpack variables & deallocations
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Phillips et al., 2008: An empirical parameterization of heterogeneous
+!! ice nucleation for multiple chemical species of aerosols, J. Atmos. Sci.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! C. Barthe * LACy * jan. 2014 add budgets
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
+USE MODD_CST, ONLY : XP00, XRD, XMV, XMD, XCPD, XCPV, XCL, XCI, &
+ XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
+ XALPW, XBETAW, XGAMW, XPI
+USE MODD_PARAM_LIMA, ONLY : NMOD_IFN, NSPECIE, XFRAC, &
+ 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 MODI_BUDGET
+USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_IFN_FREE
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! Model index
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
+ ! the tput FM fileoutp
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Ice crystal C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAS ! Cloud C. nuclei C. source
+ !used as Free ice nuclei for
+ !IMMERSION freezing
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIFS ! Free ice nuclei C. source
+ !for DEPOSITION and CONTACT
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINS ! Activated ice nuclei C. source
+ !for DEPOSITION and CONTACT
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIS ! Activated ice nuclei C. source
+ !for IMMERSION
+!
+!
+!* 0.2 Declarations of local variables :
+!
+!
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
+INTEGER :: JL, JMOD_CCN, JMOD_IFN, JSPECIE, JMOD_IMM ! Loop index
+INTEGER :: INEGT ! Case number of sedimentation, nucleation,
+!
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: GNEGT ! Test where to compute the nucleation
+!
+INTEGER, DIMENSION(SIZE(PRHODREF)) :: I1,I2,I3 ! Indexes for PACK replacement
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZCIT ! Pristine ice conc. at t
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRVS ! Water vapor m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCS ! Cloud water m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZRIS ! Pristine ice m.r. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZCCS ! Cloud water conc. source
+REAL, DIMENSION(:), ALLOCATABLE :: ZCIS ! Pristine ice conc. source
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZTHS ! Theta source
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNAS ! Cloud Cond. nuclei conc. source
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZIFS ! Free Ice nuclei conc. source
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZINS ! Nucleated Ice nuclei conc. source
+ !by Deposition/Contact
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNIS ! Nucleated Ice nuclei conc. source
+ !by Immersion
+!
+REAL, DIMENSION(:), ALLOCATABLE &
+ :: ZRHODREF, & ! RHO Dry REFerence
+ ZRHODJ, & ! RHO times Jacobian
+ ZZT, & ! Temperature
+ ZPRES, & ! Pressure
+ ZEXNREF, & ! EXNer Pressure REFerence
+ ZZW, & ! Work array
+ ZZX, & ! Work array
+ ZZY, & ! Work array
+ ZLSFACT, & ! L_s/(Pi_ref*C_ph)
+ ZLVFACT, & ! L_v/(Pi_ref*C_ph)
+ ZLBDAC, & ! Slope parameter of the cloud droplet distr.
+ ZSI, &
+ ZSW, &
+ ZSI_W
+!
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZW, ZT ! work arrays
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRTMIN, ZCTMIN
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSI0, & ! Si threshold in H_X for X={DM,BC,O}
+ Z_FRAC_ACT ! Activable frac. of each AP species
+REAL, DIMENSION(:), ALLOCATABLE :: ZTCELSIUS, ZZT_SI0_BC
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+!
+!
+! Physical domain
+!
+IIB=1+JPHEXT
+IIE=SIZE(PZZ,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PZZ,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PZZ,3) - JPVEXT
+!
+! Physical limitations
+!
+ALLOCATE(ZRTMIN(SIZE(XRTMIN)))
+ALLOCATE(ZCTMIN(SIZE(XCTMIN)))
+ZRTMIN(:) = XRTMIN(:) / PTSTEP
+ZCTMIN(:) = XCTMIN(:) / PTSTEP
+!
+! Temperature
+!
+ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
+!
+! Saturation over ice
+!
+ZW(:,:,:) = EXP( XALPI - XBETAI/ZT(:,:,:) - XGAMI*ALOG(ZT(:,:,:) ) )
+ZW(:,:,:) = PRVT(:,:,:)*( PPABST(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) )
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. COMPUTATIONS ONLY WHERE NECESSARY : PACK
+! ----------------------------------------
+!
+!
+GNEGT(:,:,:) = .FALSE.
+GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE)<XTT-2.0 .AND. &
+ ZW(IIB:IIE,IJB:IJE,IKB:IKE)>0.95
+INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
+!
+IF (INEGT > 0) THEN
+!
+ALLOCATE(ZRVT(INEGT))
+ALLOCATE(ZRCT(INEGT))
+ALLOCATE(ZRRT(INEGT))
+ALLOCATE(ZRIT(INEGT))
+ALLOCATE(ZRST(INEGT))
+ALLOCATE(ZRGT(INEGT))
+!
+ALLOCATE(ZCIT(INEGT))
+!
+ALLOCATE(ZRVS(INEGT))
+ALLOCATE(ZRCS(INEGT))
+ALLOCATE(ZRIS(INEGT))
+!
+ALLOCATE(ZTHS(INEGT))
+!
+ALLOCATE(ZCCS(INEGT))
+ALLOCATE(ZCIS(INEGT))
+!
+ALLOCATE(ZNAS(INEGT,NMOD_CCN))
+ALLOCATE(ZIFS(INEGT,NMOD_IFN))
+ALLOCATE(ZINS(INEGT,NMOD_IFN))
+ALLOCATE(ZNIS(INEGT,NMOD_IMM))
+!
+ALLOCATE(ZRHODREF(INEGT))
+ALLOCATE(ZZT(INEGT))
+ALLOCATE(ZPRES(INEGT))
+ALLOCATE(ZEXNREF(INEGT))
+!
+DO JL=1,INEGT
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
+ ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
+ ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
+!
+ ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
+!
+ ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
+ ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
+ ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL))
+!
+ ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+!
+ ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
+ ZCIS(JL) = PCIS(I1(JL),I2(JL),I3(JL))
+!
+ DO JMOD_CCN = 1, NMOD_CCN
+ ZNAS(JL,JMOD_CCN) = PNAS(I1(JL),I2(JL),I3(JL),JMOD_CCN)
+ ENDDO
+ DO JMOD_IFN = 1, NMOD_IFN
+ ZIFS(JL,JMOD_IFN) = PIFS(I1(JL),I2(JL),I3(JL),JMOD_IFN)
+ ZINS(JL,JMOD_IFN) = PINS(I1(JL),I2(JL),I3(JL),JMOD_IFN)
+ ENDDO
+ DO JMOD_IMM = 1, NMOD_IMM
+ ZNIS(JL,JMOD_IMM) = PNIS(I1(JL),I2(JL),I3(JL),JMOD_IMM)
+ ENDDO
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ENDDO
+!
+! PACK : done
+! Prepare computations
+!
+ALLOCATE( ZLSFACT (INEGT) )
+ALLOCATE( ZLVFACT (INEGT) )
+ALLOCATE( ZSI (INEGT) )
+ALLOCATE( ZTCELSIUS (INEGT) )
+ALLOCATE( ZZT_SI0_BC (INEGT) )
+ALLOCATE( ZLBDAC (INEGT) )
+ALLOCATE( ZSI0 (INEGT,NSPECIE) )
+ALLOCATE( Z_FRAC_ACT (INEGT,NSPECIE) ) ; Z_FRAC_ACT(:,:) = 0.0
+ALLOCATE( ZSW (INEGT) )
+ALLOCATE( ZSI_W (INEGT) )
+!
+ALLOCATE( ZZW (INEGT) ) ; ZZW(:) = 0.0
+ALLOCATE( ZZX (INEGT) ) ; ZZX(:) = 0.0
+ALLOCATE( ZZY (INEGT) ) ; ZZY(:) = 0.0
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3. COMPUTE THE SATURATION OVER WATER AND ICE
+! -----------------------------------------
+!
+!
+ZTCELSIUS(:) = ZZT(:)-XTT ! T [°C]
+ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) &
+ +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) )
+ZLSFACT(:) = (XLSTT+(XCPV-XCI)*ZTCELSIUS(:))/ZZW(:) ! L_s/(Pi_ref*C_ph)
+ZLVFACT(:) = (XLVTT+(XCPV-XCL)*ZTCELSIUS(:))/ZZW(:) ! L_v/(Pi_ref*C_ph)
+!
+ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ZSI(:) = ZRVT(:)*(ZPRES(:)-ZZW(:))/((XMV/XMD)*ZZW(:)) ! Saturation over ice
+!
+ZZY(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
+ZSW(:) = ZRVT(:)*(ZPRES(:)-ZZY(:))/((XMV/XMD)*ZZY(:)) ! Saturation over water
+!
+ZSI_W(:)= ZZY(:)/ZZW(:) ! Saturation over ice at water saturation: es_w/es_i
+!
+! Saturation parameters for H_X, with X={Dust/Metallic (2 modes), Black Carbon, Organic}
+!
+ZSI0(:,1) = 1.0 + 10.0**( -1.0261 + 3.1656E-3* ZTCELSIUS(:) &
+ + 5.3938E-4*(ZTCELSIUS(:)**2) &
+ + 8.2584E-6*(ZTCELSIUS(:)**3) ) ! with T [°C]
+ZSI0(:,2) = ZSI0(:,1) ! DM2 = DM1
+ZSI0(:,3) = 0.0 ! BC
+ZZT_SI0_BC(:) = MAX( 198.0, MIN( 239.0,ZZT(:) ) )
+ZSI0(:,3) = (-3.118E-5*ZZT_SI0_BC(:)+1.085E-2)*ZZT_SI0_BC(:)+0.5652 - XDSI0(3)
+IF (NPHILLIPS == 8) THEN
+ ZSI0(:,4) = ZSI0(:,3) ! O = BC
+ELSE IF (NPHILLIPS == 13) THEN
+ ZSI0(:,4) = 1.15 ! BIO
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 4. COMPUTE THE ACTIVABLE FRACTION OF EACH IFN SPECIE
+! -------------------------------------------------
+!
+!
+! Computation of the reference activity spectrum ( ZZY = N_{IN,1,*} )
+!
+CALL LIMA_PHILLIPS_REF_SPECTRUM(ZZT, ZSI, ZSI_W, ZZY)
+!
+! For each aerosol species (DM1, DM2, BC, O), compute the fraction that may be activated
+! Z_FRAC_ACT(INEGT,NSPECIE) = fraction of each species that may be activated
+!
+CALL LIMA_PHILLIPS_INTEG(ZZT, ZSI, ZSI0, ZSW, ZZY, Z_FRAC_ACT)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 5. COMPUTE THE HETEROGENEOUS NUCLEATION OF INSOLUBLE IFN
+! -----------------------------------------------------
+!
+!
+!
+DO JMOD_IFN = 1,NMOD_IFN ! IFN modes
+ ZZX(:)=0.
+ DO JSPECIE = 1, NSPECIE ! Each IFN mode is mixed with DM1, DM2, BC, O
+ ZZX(:)=ZZX(:)+XFRAC(JSPECIE,JMOD_IFN)*(ZIFS(:,JMOD_IFN)+ZINS(:,JMOD_IFN))* &
+ Z_FRAC_ACT(:,JSPECIE)
+ END DO
+! Now : ZZX(:) = number of activable AP.
+! Activated AP at this time step = activable AP - already activated AP
+ ZZX(:) = MIN( ZIFS(:,JMOD_IFN), MAX( (ZZX(:)-ZINS(:,JMOD_IFN)),0.0 ))
+! Correction BVIE division by PTSTEP ?
+! ZZW(:) = MIN( XMNU0*ZZX(:) / PTSTEP , ZRVS(:) )
+ ZZW(:) = MIN( XMNU0*ZZX(:), ZRVS(:) )
+!
+! Update the concentrations and MMR
+!
+ ZIFS(:,JMOD_IFN) = ZIFS(:,JMOD_IFN) - ZZX(:)
+ ZW(:,:,:) = PIFS(:,:,:,JMOD_IFN)
+ PIFS(:,:,:,JMOD_IFN) = UNPACK( ZIFS(:,JMOD_IFN), MASK=GNEGT(:,:,:), &
+ FIELD=ZW(:,:,:) )
+!
+ ZINS(:,JMOD_IFN) = ZINS(:,JMOD_IFN) + ZZX(:)
+ ZW(:,:,:) = PINS(:,:,:,JMOD_IFN)
+ PINS(:,:,:,JMOD_IFN) = UNPACK( ZINS(:,JMOD_IFN), MASK=GNEGT(:,:,:), &
+ FIELD=ZW(:,:,:) )
+!
+ ZRVS(:) = ZRVS(:) - ZZW(:)
+ ZRIS(:) = ZRIS(:) + ZZW(:)
+ ZTHS(:) = ZTHS(:) + ZZW(:)*ZLSFACT(:) !-ZLVFACT(:)) ! f(L_s*(RVHNDI))
+ ZCIS(:) = ZCIS(:) + ZZX(:)
+END DO
+!
+!
+! Budget storage
+IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
+ 4,'HIND_BU_RTH')
+ IF (LBUDGET_RV) CALL BUDGET ( &
+ UNPACK(ZRVS(:),MASK=GNEGT(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:),&
+ 6,'HIND_BU_RRV')
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(ZRIS(:),MASK=GNEGT(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
+ 9,'HIND_BU_RRI')
+ IF (LBUDGET_SV) THEN
+ CALL BUDGET ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
+ 12+NSV_LIMA_NI,'HIND_BU_RSV')
+ IF (NMOD_IFN.GE.1) THEN
+ DO JL=1, NMOD_IFN
+ CALL BUDGET ( PIFS(:,:,:,JL)*PRHODJ(:,:,:),12+NSV_LIMA_IFN_FREE+JL-1,'HIND_BU_RSV')
+ END DO
+ END IF
+ END IF
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 6. COMPUTE THE HETEROGENEOUS NUCLEATION OF COATED IFN
+! --------------------------------------------------
+!
+!
+! Heterogeneous nucleation by immersion of the activated CCN
+! Currently, we represent coated IFN as a pure aerosol type (NIND_SPECIE)
+!
+!
+DO JMOD_IMM = 1,NMOD_IMM ! Coated IFN modes
+ JMOD_CCN = NINDICE_CCN_IMM(JMOD_IMM) ! Corresponding CCN mode
+ IF (JMOD_CCN .GT. 0) THEN
+!
+! OLD LIMA : Compute the appropriate mean diameter and sigma
+! XMDIAM_IMM = MIN( XMDIAM_IFN(NIND_SPECIE) , XR_MEAN_CCN(JMOD_CCN)*2. )
+! XSIGMA_IMM = MIN( XSIGMA_IFN(JSPECIE) , EXP(XLOGSIG_CCN(JMOD_CCN)) )
+!
+ ZZW(:) = MIN( ZCCS(:) , ZNAS(:,JMOD_CCN) )
+ ZZX(:)= ( ZZW(:)+ZNIS(:,JMOD_IMM) ) * Z_FRAC_ACT(:,NIND_SPECIE)
+! Now : ZZX(:) = number of activable AP.
+! Activated AP at this time step = activable AP - already activated AP
+ ZZX(:) = MIN( ZZW(:), MAX( (ZZX(:)-ZNIS(:,JMOD_IMM)),0.0 ) )
+! Correction BVIE division by PTSTEP ?
+! ZZY(:) = MIN( XMNU0*ZZX(:) / PTSTEP , ZRVS(:) )
+ ZZY(:) = MIN( XMNU0*ZZX(:) , ZRVS(:) )
+!
+! Update the concentrations and MMR
+!
+ ZNAS(:,JMOD_CCN) = ZNAS(:,JMOD_CCN) - ZZX(:)
+ ZW(:,:,:) = PNAS(:,:,:,JMOD_CCN)
+ PNAS(:,:,:,JMOD_CCN) = UNPACK(ZNAS(:,JMOD_CCN),MASK=GNEGT(:,:,:), &
+ FIELD=ZW(:,:,:))
+ ZNIS(:,JMOD_IMM) = ZNIS(:,JMOD_IMM) + ZZX(:)
+ ZW(:,:,:) = PNIS(:,:,:,JMOD_IMM)
+ PNIS(:,:,:,JMOD_IMM) = UNPACK(ZNIS(:,JMOD_IMM),MASK=GNEGT(:,:,:), &
+ FIELD=ZW(:,:,:))
+!
+ ZRCS(:) = ZRCS(:) - ZZY(:)
+ ZRIS(:) = ZRIS(:) + ZZY(:)
+ ZTHS(:) = ZTHS(:) + ZZY(:)*ZLSFACT(:) !-ZLVFACT(:)) ! f(L_s*(RVHNCI))
+ ZCCS(:) = ZCCS(:) - ZZX(:)
+ ZCIS(:) = ZCIS(:) + ZZX(:)
+ END IF
+END DO
+!
+! Budget storage
+IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_TH) CALL BUDGET ( &
+ UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
+ 4,'HINC_BU_RTH')
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(ZRCS(:),MASK=GNEGT(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:),&
+ 7,'HINC_BU_RRC')
+ IF (LBUDGET_RI) CALL BUDGET ( &
+ UNPACK(ZRIS(:),MASK=GNEGT(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
+ 9,'HINC_BU_RRI')
+ IF (LBUDGET_SV) THEN
+ CALL BUDGET ( UNPACK(ZCCS(:),MASK=GNEGT(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:),&
+ 12+NSV_LIMA_NC,'HINC_BU_RSV')
+ CALL BUDGET ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
+ 12+NSV_LIMA_NI,'HINC_BU_RSV')
+ END IF
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 7. UNPACK VARIABLES AND CLEAN
+! --------------------------
+!
+!
+! End of the heterogeneous nucleation following Phillips 08
+! Unpack variables, deallocate...
+!
+!
+ZW(:,:,:) = PRVS(:,:,:)
+PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ZW(:,:,:) = PRCS(:,:,:)
+PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ZW(:,:,:) = PRIS(:,:,:)
+PRIS(:,:,:) = UNPACK( ZRIS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ZW(:,:,:) = PTHS(:,:,:)
+PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ZW(:,:,:) = PCCS(:,:,:)
+PCCS(:,:,:) = UNPACK( ZCCS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+ZW(:,:,:) = PCIS(:,:,:)
+PCIS(:,:,:) = UNPACK( ZCIS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
+!
+DEALLOCATE(ZRTMIN)
+DEALLOCATE(ZCTMIN)
+DEALLOCATE(ZRVT)
+DEALLOCATE(ZRCT)
+DEALLOCATE(ZRRT)
+DEALLOCATE(ZRIT)
+DEALLOCATE(ZRST)
+DEALLOCATE(ZRGT)
+DEALLOCATE(ZCIT)
+DEALLOCATE(ZRVS)
+DEALLOCATE(ZRCS)
+DEALLOCATE(ZRIS)
+DEALLOCATE(ZTHS)
+DEALLOCATE(ZCCS)
+DEALLOCATE(ZCIS)
+DEALLOCATE(ZNAS)
+DEALLOCATE(ZIFS)
+DEALLOCATE(ZINS)
+DEALLOCATE(ZNIS)
+DEALLOCATE(ZRHODREF)
+DEALLOCATE(ZZT)
+DEALLOCATE(ZPRES)
+DEALLOCATE(ZEXNREF)
+DEALLOCATE(ZLSFACT)
+DEALLOCATE(ZLVFACT)
+DEALLOCATE(ZSI)
+DEALLOCATE(ZTCELSIUS)
+DEALLOCATE(ZZT_SI0_BC)
+DEALLOCATE(ZLBDAC)
+DEALLOCATE(ZSI0)
+DEALLOCATE(Z_FRAC_ACT)
+DEALLOCATE(ZSW)
+DEALLOCATE(ZZW)
+DEALLOCATE(ZZX)
+DEALLOCATE(ZZY)
+!++cb++
+ DEALLOCATE(ZSI_W)
+!--cb--
+!
+!
+ELSE
+!
+! Advance the budget calls
+!
+ IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
+ IF (LBUDGET_TH) THEN
+ ZW(:,:,:) = PTHS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,4,'HIND_BU_RTH')
+ CALL BUDGET (ZW,4,'HINC_BU_RTH')
+ ENDIF
+ IF (LBUDGET_RV) THEN
+ ZW(:,:,:) = PRVS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,6,'HIND_BU_RRV')
+ ENDIF
+ IF (LBUDGET_RC) THEN
+ ZW(:,:,:) = PRCS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,7,'HINC_BU_RRC')
+ ENDIF
+ IF (LBUDGET_RI) THEN
+ ZW(:,:,:) = PRIS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,9,'HIND_BU_RRI')
+ CALL BUDGET (ZW,9,'HINC_BU_RRI')
+ ENDIF
+ IF (LBUDGET_SV) THEN
+!print*, 'LBUDGET_SV dans lima_phillips = ', LBUDGET_SV
+ ZW(:,:,:) = PCCS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,12+NSV_LIMA_NC,'HINC_BU_RSV')
+ ZW(:,:,:) = PCIS(:,:,:)*PRHODJ(:,:,:)
+ CALL BUDGET (ZW,12+NSV_LIMA_NI,'HIND_BU_RSV')
+ CALL BUDGET (ZW,12+NSV_LIMA_NI,'HINC_BU_RSV')
+ IF (NMOD_IFN.GE.1) THEN
+ DO JL=1, NMOD_IFN
+ CALL BUDGET ( PIFS(:,:,:,JL)*PRHODJ(:,:,:),12+NSV_LIMA_IFN_FREE+JL-1,'HIND_BU_RSV')
+ END DO
+ END IF
+ END IF
+ END IF
+!
+!
+END IF ! INEGT > 0
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_PHILLIPS
diff --git a/src/MNH/lima_phillips_integ.f90 b/src/MNH/lima_phillips_integ.f90
new file mode 100644
index 000000000..26a653b6a
--- /dev/null
+++ b/src/MNH/lima_phillips_integ.f90
@@ -0,0 +1,143 @@
+! ###############################
+ MODULE MODI_LIMA_PHILLIPS_INTEG
+! ###############################
+!
+INTERFACE
+ SUBROUTINE LIMA_PHILLIPS_INTEG (ZZT, ZSI, ZSI0, ZSW, ZZY, Z_FRAC_ACT)
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZZT
+REAL, DIMENSION(:), INTENT(IN) :: ZSI
+REAL, DIMENSION(:,:), INTENT(IN) :: ZSI0
+REAL, DIMENSION(:), INTENT(IN) :: ZSW
+REAL, DIMENSION(:), INTENT(IN) :: ZZY
+REAL, DIMENSION(:,:), INTENT(INOUT) :: Z_FRAC_ACT
+!
+END SUBROUTINE LIMA_PHILLIPS_INTEG
+END INTERFACE
+END MODULE MODI_LIMA_PHILLIPS_INTEG
+!
+! ######################################################################
+ SUBROUTINE LIMA_PHILLIPS_INTEG (ZZT, ZSI, ZSI0, ZSW, ZZY, Z_FRAC_ACT)
+! ######################################################################
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the fraction of each aerosol
+!! species (DM1, DM2, BC, O) that may be activated, following Phillips (2008)
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Phillips et al., 2008: An empirical parameterization of heterogeneous
+!! ice nucleation for multiple chemical species of aerosols, J. Atmos. Sci.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XTT, XPI
+USE MODD_PARAM_LIMA, ONLY : XMDIAM_IFN, XSIGMA_IFN, NSPECIE, XFRAC_REF, &
+ XH, XAREA1, XGAMMA, XABSCISS, XWEIGHT, NDIAM, &
+ XT0, XDT0, XDSI0, XSW0, XTX1, XTX2
+USE MODI_LIMA_FUNCTIONS, ONLY : DELTA, DELTA_VEC
+USE MODI_GAMMA_INC
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZZT
+REAL, DIMENSION(:), INTENT(IN) :: ZSI
+REAL, DIMENSION(:,:), INTENT(IN) :: ZSI0
+REAL, DIMENSION(:), INTENT(IN) :: ZSW
+REAL, DIMENSION(:), INTENT(IN) :: ZZY
+REAL, DIMENSION(:,:), INTENT(INOUT) :: Z_FRAC_ACT
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: JSPECIE, JL
+REAL :: XB
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZZX, & ! Work array
+ ZFACTOR, &
+ ZSUBSAT, &
+ ZEMBRYO
+!
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GINTEG ! Mask to integrate over the
+ ! AP size spectrum
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+DO JSPECIE = 1, NSPECIE ! = 4 = {DM1, DM2, BC, O} respectively
+!
+ ALLOCATE(ZZX (SIZE(ZZT)) ) ; ZZX(:) = 0.0
+ ALLOCATE(ZFACTOR (SIZE(ZZT)) )
+ ALLOCATE(ZSUBSAT (SIZE(ZZT)) )
+ ALLOCATE(ZEMBRYO (SIZE(ZZT)) )
+ ALLOCATE(GINTEG (SIZE(ZZT)) )
+
+! Compute log in advance for efficiency
+ XB = LOG(0.1E-6/XMDIAM_IFN(JSPECIE))/(SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE)))
+! ZFACTOR = f_c
+ ZFACTOR(:) = DELTA(1.,XH(JSPECIE),ZZT(:),XT0(JSPECIE),XT0(JSPECIE)+XDT0(JSPECIE)) &
+ * DELTA_VEC(0.,1.,ZSI(:),ZSI0(:,JSPECIE),ZSI0(:,JSPECIE)+XDSI0(JSPECIE)) / XGAMMA
+! ZSUBSAT = H_X
+ ZSUBSAT(:) = MIN(ZFACTOR(:)+(1.0-ZFACTOR(:))*DELTA(0.,1.,ZSW(:),XSW0,1.) , 1.0)
+! ZEMBRYO = µ_X/(pi*(D_X)**2) = A
+ ZEMBRYO(:) = ZSUBSAT(:)*DELTA(1.,0.,ZZT(:),XTX1(JSPECIE),XTX2(JSPECIE)) &
+ * XFRAC_REF(JSPECIE)*ZZY(:)/XAREA1(JSPECIE)
+!
+! For T warmer than -35°C, the integration is approximated with µ_X << 1
+! Error function : GAMMA_INC(1/2, x**2) = ERF(x) !!! for x>=0 !!!
+!
+ WHERE (ZZT(:)>(XTT-35.) .AND. ZEMBRYO(:)>1.0E-8)
+ ZZX(:) = ZZX(:) + ZEMBRYO(:) * XPI * (XMDIAM_IFN(JSPECIE))**2 / 2.0 &
+ * EXP(2*(LOG(XSIGMA_IFN(JSPECIE)))**2) &
+ * (1.0+GAMMA_INC(0.5,(SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)**2))
+ END WHERE
+!
+! For other T, integration between 0 and infinity is made with a Gauss-Hermite
+! quadrature method and integration between 0 and 0.1 uses e(x) ~ 1+x+O(x**2)
+! Beware : here, weights are normalized : XWEIGHT = wi/sqrt(pi)
+!
+ GINTEG(:) = ZZT(:)<=(XTT-35.) .AND. ZSI(:)>1.0 .AND. ZEMBRYO(:)>1.0E-8
+!
+ DO JL = 1, NDIAM
+ WHERE (GINTEG(:))
+ ZZX(:) = ZZX(:) - XWEIGHT(JL)*EXP(-ZEMBRYO(:)*XPI*(XMDIAM_IFN(JSPECIE))**2 &
+ * EXP(2.0*SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE)) * XABSCISS(JL)) )
+ END WHERE
+ ENDDO
+!
+ WHERE (GINTEG(:))
+ ZZX(:) = ZZX(:) + 0.5* XPI*ZEMBRYO(:)*(XMDIAM_IFN(JSPECIE))**2 &
+ * (1.0-( 1.0-GAMMA_INC(0.5,(SQRT(2.0)*LOG(XSIGMA_IFN(JSPECIE))-XB)**2)) &
+ * EXP( 2.0*(LOG(XSIGMA_IFN(JSPECIE)))**2) )
+ END WHERE
+!
+ Z_FRAC_ACT(:,JSPECIE)=ZZX(:)
+!
+ DEALLOCATE(ZZX)
+ DEALLOCATE(ZFACTOR)
+ DEALLOCATE(ZSUBSAT)
+ DEALLOCATE(ZEMBRYO)
+ DEALLOCATE(GINTEG)
+!
+ENDDO
+!
+END SUBROUTINE LIMA_PHILLIPS_INTEG
diff --git a/src/MNH/lima_phillips_ref_spectrum.f90 b/src/MNH/lima_phillips_ref_spectrum.f90
new file mode 100644
index 000000000..c2fcff114
--- /dev/null
+++ b/src/MNH/lima_phillips_ref_spectrum.f90
@@ -0,0 +1,136 @@
+! ######################################
+ MODULE MODI_LIMA_PHILLIPS_REF_SPECTRUM
+! ######################################
+!
+INTERFACE
+ SUBROUTINE LIMA_PHILLIPS_REF_SPECTRUM (ZZT, ZSI, ZSI_W, ZZY)
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature
+REAL, DIMENSION(:), INTENT(IN) :: ZSI ! Saturation over ice
+REAL, DIMENSION(:), INTENT(IN) :: ZSI_W ! Saturation over ice at water sat.
+REAL, DIMENSION(:), INTENT(INOUT) :: ZZY ! Reference activity spectrum
+!
+END SUBROUTINE LIMA_PHILLIPS_REF_SPECTRUM
+END INTERFACE
+END MODULE MODI_LIMA_PHILLIPS_REF_SPECTRUM
+!
+! ######################################################################
+ SUBROUTINE LIMA_PHILLIPS_REF_SPECTRUM (ZZT, ZSI, ZSI_W, ZZY)
+! ######################################################################
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the reference activation spectrum
+!! described by Phillips (2008)
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Phillips et al., 2008: An empirical parameterization of heterogeneous
+!! ice nucleation for multiple chemical species of aerosols, J. Atmos. Sci.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XTT
+USE MODD_PARAM_LIMA, ONLY : XGAMMA, XRHO_CFDC
+USE MODI_LIMA_FUNCTIONS, ONLY : RECT, DELTA
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature
+REAL, DIMENSION(:), INTENT(IN) :: ZSI ! Saturation over ice
+REAL, DIMENSION(:), INTENT(IN) :: ZSI_W ! Saturation over ice at water sat.
+REAL, DIMENSION(:), INTENT(INOUT) :: ZZY ! Reference activity spectrum
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZMAX, &
+ ZMOY, &
+ ZZY1, &
+ ZZY2, &
+ Z1, &
+ Z2
+!
+REAL :: XPSI
+!
+!-------------------------------------------------------------------------------
+!
+ALLOCATE(ZMAX(SIZE(ZZT))) ; ZMAX(:)= 0.0
+ALLOCATE(ZMOY(SIZE(ZZT))) ; ZMOY(:)= 0.0
+ALLOCATE(ZZY1(SIZE(ZZT))) ; ZZY1(:)= 0.0
+ALLOCATE(ZZY2(SIZE(ZZT))) ; ZZY2(:)= 0.0
+ALLOCATE(Z1(SIZE(ZZT))) ; Z1(:) = 0.0
+ALLOCATE(Z2(SIZE(ZZT))) ; Z2(:) = 0.0
+!
+ZZY(:) = 0.0
+!
+XPSI = 0.058707*XGAMMA/XRHO_CFDC
+!
+WHERE( ZSI(:)>1.0 )
+!
+!* T <= -35 C
+!
+ ZZY(:) =1000.*XGAMMA/XRHO_CFDC &
+ * ( EXP(12.96*(MIN(ZSI(:),7.)-1.1)) )**0.3 &
+ * RECT(1.,0.,ZZT(:),(XTT-80.),(XTT-35.))
+!
+!* -35 C < T <= -25 C (in Appendix A)
+!
+ ZZY1(:) =1000.*XGAMMA/XRHO_CFDC &
+ * ( EXP(12.96*(MIN(ZSI(:),7.)-1.1)) )**0.3
+ ZZY2(:) =1000.*XPSI &
+ * EXP(12.96*(MIN(ZSI(:),7.)-1.0)-0.639)
+!
+!* -35 C < T <= -30 C
+!
+ ZMAX(:) =1000.*XGAMMA/XRHO_CFDC &
+ * ( EXP(12.96*(ZSI_W(:)-1.1)) )**0.3 &
+ * RECT(1.,0.,ZZT(:),(XTT-35.),(XTT-30.))
+!
+!* -30 C < T <= -25 C
+!
+ ZMAX(:) = ZMAX(:) +1000.*XPSI &
+ * EXP( 12.96*(ZSI_W(:)-1.0)-0.639 ) &
+ * RECT(1.,0.,ZZT(:),(XTT-30.),(XTT-25.))
+ Z1(:) = MIN(ZZY1(:), ZMAX(:))
+ Z2(:) = MIN(ZZY2(:), ZMAX(:))
+!
+!* T > -25 C
+!
+ ZZY(:) = ZZY(:) + 1000.*XPSI &
+ * EXP( 12.96*(MIN(ZSI(:),7.)-1.0)-0.639 ) &
+ * RECT(1.,0.,ZZT(:),(XTT-25.),(XTT-2.))
+END WHERE
+!
+WHERE (Z2(:)>0.0 .AND. Z1(:)>0.0)
+ ZMOY(:) = Z2(:)*(Z1(:)/Z2(:))**DELTA(1.,0.,ZZT(:),(XTT-35.),(XTT-25.))
+ ZZY(:) = ZZY(:) + MIN(ZMOY(:),ZMAX(:)) ! N_{IN,1,*}
+END WHERE
+!
+!++cb++
+DEALLOCATE(ZMAX)
+DEALLOCATE(ZMOY)
+DEALLOCATE(ZZY1)
+DEALLOCATE(ZZY2)
+DEALLOCATE(Z1)
+DEALLOCATE(Z2)
+!--cb--
+!
+END SUBROUTINE LIMA_PHILLIPS_REF_SPECTRUM
diff --git a/src/MNH/lima_precip_scavenging.f90 b/src/MNH/lima_precip_scavenging.f90
new file mode 100644
index 000000000..4daf15b8a
--- /dev/null
+++ b/src/MNH/lima_precip_scavenging.f90
@@ -0,0 +1,831 @@
+! ##################################
+ MODULE MODI_LIMA_PRECIP_SCAVENGING
+! ##################################
+!
+INTERFACE
+ SUBROUTINE LIMA_PRECIP_SCAVENGING (HCLOUD, KLUOUT, KTCOUNT, PTSTEP, &
+ PRRT, PRHODREF, PRHODJ, PZZ, &
+ PPABST, PTHT, PSVT, PRSVS, PINPAP )
+!
+CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! cloud paramerization
+INTEGER, INTENT(IN) :: KLUOUT ! unit for output listing
+INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
+REAL, INTENT(IN) :: PTSTEP ! Double timestep except
+ ! for the first time step
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain mixing ratio at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Air Density [kg/m**3]
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry Density [kg]
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Altitude
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+!
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Particle Concentration [kg-1]
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Total Number Scavenging Rate
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPAP
+!
+END SUBROUTINE LIMA_PRECIP_SCAVENGING
+END INTERFACE
+END MODULE MODI_LIMA_PRECIP_SCAVENGING
+!
+!########################################################################
+ SUBROUTINE LIMA_PRECIP_SCAVENGING (HCLOUD, KLUOUT, KTCOUNT, PTSTEP, &
+ PRRT, PRHODREF, PRHODJ, PZZ, &
+ PPABST, PTHT, PSVT, PRSVS, PINPAP )
+!########################################################################x
+!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the total number
+!! below-cloud scavenging rate.
+!!
+!!
+!!** METHOD
+!! ------
+!! We assume a generalized gamma distribution law for the raindrop.
+!! The aerosols particles distribution follows a log-normal law.
+!! First, we have to compute the Collision Efficiency, which takes
+!! account of the three most important wet removal mechanism :
+!! Brownian diffusion, interception and inertial impaction.
+!! It is a function of several number (like Reynolds, Schmidt
+!! or Stokes number for instance). Consequently,
+!! we need first to calculate these numbers.
+!!
+!! Then the scavenging coefficient is deduced from the integration
+!! of the droplet size distribution, the falling velocity of
+!! raindrop and aerosol, their diameter, and the collision
+!! (or collection) efficiency, over the spectrum of droplet
+!! diameters.
+!!
+!! The total scavenging rate of aerosol is computed from the
+!! integration, over all the spectrum of particles aerosols
+!! diameters, of the scavenging coefficient.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! Subroutine SCAV_MASS_SEDIMENTATION
+!!
+!! Function COLL_EFFIC : computes the collision efficiency
+!!
+!! Function CONTJV |
+!! Function GAUHER |
+!! Function GAULAG |-> in lima_functions.f90
+!! Function GAMMLN |
+!!
+!!
+!! REFERENCES
+!! ----------
+!! Seinfeld and Pandis
+!! Andronache
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0.DECLARATIONS
+! --------------
+!
+USE MODD_NSV
+USE MODD_CST
+USE MODD_PARAMETERS
+USE MODI_INI_NSV
+USE MODI_GAMMA
+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 :
+!
+CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! cloud paramerization
+INTEGER, INTENT(IN) :: KLUOUT ! unit for output listing
+INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
+REAL, INTENT(IN) :: PTSTEP ! Double timestep except
+ ! for the first time step
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain mixing ratio at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Air Density [kg/m**3]
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry Density [kg]
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Altitude
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+!
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Particle Concentration [/m**3]
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Total Number Scavenging Rate
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPAP
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIB ! Define the domain where is
+INTEGER :: IIE ! the microphysical sources have to be computed
+INTEGER :: IJB !
+INTEGER :: IJE !
+INTEGER :: IKB !
+INTEGER :: IKE !
+!
+INTEGER :: JSV ! CCN or IFN mode
+INTEGER :: J1, J2, IJ, JMOD
+!
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: GRAIN, &! Test where rain is present
+ GSCAV ! Test where rain is present
+INTEGER , DIMENSION(SIZE(GSCAV)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+INTEGER :: ISCAV
+!
+REAL :: ZDENS_RATIO, & !density ratio
+ ZNUM, & !PNU-1.
+ ZSHAPE_FACTOR
+!
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZW ! work array
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: PCRT ! cloud droplet conc.
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZLAMBDAR, & !slope parameter of the
+ ! generalized Gamma
+ !distribution law for the
+ !raindrop
+ ZVISC_RATIO, & !viscosity ratio
+ ZMFPA, & !Mean Free Path
+ ZRHODREF, & !Air Density [kg/m**3]
+ ZVISCA, & !Viscosity of Air [kg/(m*s)]
+ ZT, & !Absolute Temperature
+ ZPABST, &
+ ZRRT, &
+ ZCONCP, &
+ ZCONCR, &
+ ZTOT_SCAV_RATE,&
+ ZTOT_MASS_RATE,&
+ ZMEAN_SCAV_COEF
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: &
+ ZVOLDR, & !Mean volumic Raindrop diameter [m]
+ ZBC_SCAV_COEF, &
+ ZCUNSLIP, & !CUnningham SLIP correction factor
+ ZST_STAR, & !critical Stokes number for impaction
+ ZSC, & !aerosol particle Schmidt number
+ ZRE, & !raindrop Reynolds number (for radius)
+ ZFVELR, & !Falling VELocity of the Raindrop
+ ZRELT, & !RELaxation Time of the particle [s]
+ ZDIFF !Particle Diffusivity
+!
+REAL, DIMENSION(NDIAMP) :: ZVOLDP, & !Mean volumic diameter [m]
+ ZABSCISSP, & !Aerosol Abscisses
+ ZWEIGHTP !Aerosol Weights
+REAL, DIMENSION(NDIAMR) :: ZABSCISSR, & !Raindrop Abscisses
+ ZWEIGHTR !Raindrop Weights
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCOL_EF, &! Collision efficiency
+ ZSIZE_RATIO, &! Size Ratio
+ ZST ! Stokes number
+!
+REAL, DIMENSION(SIZE(PRRT,1),SIZE(PRRT,2),SIZE(PRRT,3)) :: ZRRS
+!
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: PMEAN_SCAV_COEF, & !Mean Scavenging
+ ! Coefficient
+ PTOT_SCAV_RATE, & !Total Number
+ ! Scavenging Rate
+ PTOT_MASS_RATE !Total Mass
+ ! Scavenging Rate
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3),NDIAMP) &
+ ::PBC_SCAV_COEF !Scavenging Coefficient
+REAL, DIMENSION(:), ALLOCATABLE :: ZKNUDSEN ! Knuudsen number
+!
+! Opt. BVIE
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZT_3D, ZCONCR_3D, ZVISCA_3D, ZMFPA_3D, &
+ ZVISC_RATIO_3D, ZLAMBDAR_3D, FACTOR_3D
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3),NDIAMP) &
+ :: ZVOLDR_3D, ZVOLDR_3D_INV, ZVOLDR_3D_POW, &
+ ZFVELR_3D, ZRE_3D, ZRE_3D_SQRT, ZST_STAR_3D
+REAL, DIMENSION(:), ALLOCATABLE :: FACTOR
+REAL, DIMENSION(:,:), ALLOCATABLE :: &
+ ZRE_SQRT, & ! SQRT of raindrop Reynolds number
+ ZRE_INV, & ! INV of raindrop Reynolds number
+ ZSC_INV, & ! INV of aerosol particle Schmidt number
+ ZSC_SQRT, & ! SQRT of aerosol particle Schmidt number
+ ZSC_3SQRT, & ! aerosol particle Schmidt number**(1./3.)
+ ZVOLDR_POW, & ! Mean volumic Raindrop diameter [m] **(2+ZDR)
+ ZVOLDR_INV ! INV of Mean volumic Raindrop diameter [m]
+REAL :: ZDENS_RATIO_SQRT
+INTEGER :: SV_VAR, NM, JM
+REAL :: XMDIAMP
+REAL :: XSIGMAP
+REAL :: XRHOP
+REAL :: XFRACP
+!
+!
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+!
+!
+IIB=1+JPHEXT
+IIE=SIZE(PRHODREF,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PRHODREF,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PRHODREF,3) - JPVEXT
+!
+! PCRT
+PCRT(:,:,:)=PSVT(:,:,:,NSV_LIMA_NR)
+!
+! Rain mask
+GRAIN(:,:,:) = .FALSE.
+GRAIN(IIB:IIE,IJB:IJE,IKB:IKE) = (PRRT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(3) &
+ .AND. PCRT(IIB:IIE,IJB:IJE,IKB:IKE)>XCTMIN(3) )
+!
+! Initialize the total mass scavenging rate if LAERO_MASS=T
+IF (LAERO_MASS) PTOT_MASS_RATE(:,:,:) = 0.
+!
+! Quadrature method: compute absissae and weights
+CALL GAUHER(ZABSCISSP,ZWEIGHTP,NDIAMP)
+ZNUM = XNUR-1.0E0
+CALL GAULAG(ZABSCISSR,ZWEIGHTR,NDIAMR,ZNUM)
+!
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 2. NUMERICAL OPTIMIZATION
+! ----------------------
+!
+!
+! Optimization : compute in advance parameters depending on rain particles and
+! environment conditions only, to avoid multiple identical computations in loops
+!
+!
+ZSHAPE_FACTOR = GAMMA_X0D(XNUR+3./XALPHAR)/GAMMA_X0D(XNUR)
+!
+WHERE ( GRAIN(:,:,:) )
+ !
+ ZT_3D(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:)/XP00 )**(XRD/XCPD)
+ ZCONCR_3D(:,:,:) = PCRT(:,:,:) * PRHODREF(:,:,:) ![/m3]
+ ! Sutherland law for viscosity of air
+ ZVISCA_3D(:,:,:) = XMUA0*(ZT_3D(:,:,:)/XTREF)**(3/2)*(XTREF+XT_SUTH_A) &
+ /(XT_SUTH_A+ZT_3D(:,:,:))
+ ! Air mean free path
+ ZMFPA_3D(:,:,:) = XMFPA0*(XP00*ZT_3D(:,:,:))/(PPABST(:,:,:)*XT0SCAV)
+ ! Viscosity ratio
+ ZVISC_RATIO_3D(:,:,:) = ZVISCA_3D(:,:,:)/XVISCW !!!!! inversé par rapport à orig. !
+ ! Rain drops parameters
+ ZLAMBDAR_3D(:,:,:) = ( ((XPI/6.)*ZSHAPE_FACTOR*XRHOLW*ZCONCR_3D(:,:,:)) &
+ /(PRHODREF(:,:,:)*PRRT(:,:,:)) )**(1./3.) ![/m]
+ FACTOR_3D(:,:,:) = XPI*0.25*ZCONCR_3D(:,:,:)*XCR*(XRHO00/PRHODREF(:,:,:))**(0.4)
+ !
+END WHERE
+!
+DO J2=1,NDIAMR
+ WHERE ( GRAIN(:,:,:) )
+ ! exchange of variables: [m]
+ ZVOLDR_3D(:,:,:,J2) = ZABSCISSR(J2)**(1./XALPHAR)/ZLAMBDAR_3D(:,:,:)
+ ZVOLDR_3D_INV(:,:,:,J2) = 1./ZVOLDR_3D(:,:,:,J2)
+ ZVOLDR_3D_POW(:,:,:,J2) = ZVOLDR_3D(:,:,:,J2)**(2.+XDR)
+ ! Raindrop Falling VELocity [m/s]
+ ZFVELR_3D(:,:,:,J2) = XCR*(ZVOLDR_3D(:,:,:,J2)**XDR)*(XRHO00/PRHODREF(:,:,:))**(0.4)
+ ! Reynolds number
+ ZRE_3D(:,:,:,J2) = ZVOLDR_3D(:,:,:,J2)*ZFVELR_3D(:,:,:,J2) &
+ *PRHODREF(:,:,:)/(2.0*ZVISCA_3D(:,:,:))
+ ZRE_3D_SQRT(:,:,:,J2) = SQRT( ZRE_3D(:,:,:,J2) )
+ ! Critical Stokes number
+ ZST_STAR_3D(:,:,:,J2) = (1.2+(LOG(1.+ZRE_3D(:,:,:,J2)))/12.) &
+ /(1.+LOG(1.+ZRE_3D(:,:,:,J2)))
+ END WHERE
+END DO
+!
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 3. AEROSOL SCAVENGING
+! ------------------
+!
+!
+! Iteration over the aerosol type and mode
+!
+DO JSV = 1, NMOD_CCN+NMOD_IFN
+!
+ IF (JSV .LE. NMOD_CCN) THEN
+ JMOD = JSV
+ SV_VAR = NSV_LIMA_CCN_FREE -1 + JMOD ! Variable number in PSVT
+ NM = 1 ! Number of species (for IFN int. mixing)
+ ELSE
+ JMOD = JSV - NMOD_CCN
+ SV_VAR = NSV_LIMA_IFN_FREE -1 + JMOD
+ NM = NSPECIE
+ END IF
+!
+ PBC_SCAV_COEF(:,:,:,:) = 0.
+ PMEAN_SCAV_COEF(:,:,:) = 0.
+ PTOT_SCAV_RATE(:,:,:) = 0.
+!
+ GSCAV(:,:,:) = .FALSE.
+ GSCAV(IIB:IIE,IJB:IJE,IKB:IKE) =GRAIN(IIB:IIE,IJB:IJE,IKB:IKE) .AND. &
+ (PSVT(IIB:IIE,IJB:IJE,IKB:IKE,SV_VAR)>1.0E-2)
+ ISCAV = COUNTJV(GSCAV(:,:,:),I1(:),I2(:),I3(:))
+!
+ IF( ISCAV>=1 ) THEN
+ ALLOCATE(ZVISC_RATIO(ISCAV))
+ ALLOCATE(ZRHODREF(ISCAV))
+ ALLOCATE(ZVISCA(ISCAV))
+ ALLOCATE(ZT(ISCAV))
+ ALLOCATE(ZRRT(ISCAV))
+ ALLOCATE(ZCONCR(ISCAV))
+ ALLOCATE(ZLAMBDAR(ISCAV))
+ ALLOCATE(ZCONCP(ISCAV))
+ ALLOCATE(ZMFPA(ISCAV))
+ ALLOCATE(ZTOT_SCAV_RATE(ISCAV))
+ ALLOCATE(ZTOT_MASS_RATE(ISCAV))
+ ALLOCATE(ZMEAN_SCAV_COEF(ISCAV))
+ ALLOCATE(ZPABST(ISCAV))
+ ALLOCATE(ZKNUDSEN(ISCAV))
+ ALLOCATE(FACTOR(ISCAV))
+!
+ ALLOCATE(ZCUNSLIP(ISCAV,NDIAMP))
+ ALLOCATE(ZBC_SCAV_COEF(ISCAV,NDIAMP))
+ ALLOCATE(ZSC(ISCAV,NDIAMP))
+ ALLOCATE(ZSC_INV(ISCAV,NDIAMP))
+ ALLOCATE(ZSC_SQRT(ISCAV,NDIAMP))
+ ALLOCATE(ZSC_3SQRT(ISCAV,NDIAMP))
+ ALLOCATE(ZRELT(ISCAV,NDIAMP))
+ ALLOCATE(ZDIFF(ISCAV,NDIAMP))
+ ALLOCATE(ZVOLDR(ISCAV,NDIAMR))
+ ALLOCATE(ZVOLDR_POW(ISCAV,NDIAMR))
+ ALLOCATE(ZVOLDR_INV(ISCAV,NDIAMR))
+ ALLOCATE(ZRE(ISCAV,NDIAMR))
+ ALLOCATE(ZRE_INV(ISCAV,NDIAMR))
+ ALLOCATE(ZRE_SQRT(ISCAV,NDIAMR))
+ ALLOCATE(ZST_STAR(ISCAV,NDIAMR))
+ ALLOCATE(ZFVELR(ISCAV,NDIAMR))
+ ALLOCATE(ZST(ISCAV,NDIAMP,NDIAMR))
+ ALLOCATE(ZCOL_EF(ISCAV,NDIAMP,NDIAMR))
+ ALLOCATE(ZSIZE_RATIO(ISCAV,NDIAMP,NDIAMR))
+!
+ ZMEAN_SCAV_COEF(:)=0.
+ ZTOT_SCAV_RATE(:) =0.
+ ZTOT_MASS_RATE(:) =0.
+ DO JL=1,ISCAV
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZT(JL) = ZT_3D(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZPABST(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ZCONCP(JL) = PSVT(I1(JL),I2(JL),I3(JL),SV_VAR)*ZRHODREF(JL)![/m3]
+ ZCONCR(JL) = ZCONCR_3D(I1(JL),I2(JL),I3(JL)) ![/m3]
+ ZVISCA(JL) = ZVISCA_3D(I1(JL),I2(JL),I3(JL))
+ ZMFPA(JL) = ZMFPA_3D(I1(JL),I2(JL),I3(JL))
+ ZVISC_RATIO(JL) = ZVISC_RATIO_3D(I1(JL),I2(JL),I3(JL))
+ ZLAMBDAR(JL) = ZLAMBDAR_3D(I1(JL),I2(JL),I3(JL))
+ FACTOR(JL) = FACTOR_3D(I1(JL),I2(JL),I3(JL))
+ ZVOLDR(JL,:) = ZVOLDR_3D(I1(JL),I2(JL),I3(JL),:)
+ ZVOLDR_POW(JL,:) = ZVOLDR_3D_POW(I1(JL),I2(JL),I3(JL),:)
+ ZVOLDR_INV(JL,:) = ZVOLDR_3D_INV(I1(JL),I2(JL),I3(JL),:)
+ ZFVELR(JL,:) = ZFVELR_3D(I1(JL),I2(JL),I3(JL),:)
+ ZRE(JL,:) = ZRE_3D(I1(JL),I2(JL),I3(JL),:)
+ ZRE_SQRT(JL,:) = ZRE_3D_SQRT(I1(JL),I2(JL),I3(JL),:)
+ ZST_STAR(JL,:) = ZST_STAR_3D(I1(JL),I2(JL),I3(JL),:)
+ ENDDO
+ ZRE_INV(:,:) = 1./ZRE(:,:)
+
+ IF (ANY(ZCONCR .eq. 0.)) print *, 'valeur nulle dans ZLAMBDAR !'
+ IF (ANY(ZLAMBDAR .eq. 0.)) print *, 'valeur nulle dans ZLAMBDAR !'
+!
+!------------------------------------------------------------------------------------
+!
+! Loop over the different species (for IFN int. mixing)
+!
+ DO JM = 1, NM ! species (DM1,DM2,BC,O) for IFN
+ IF ( JSV .LE. NMOD_CCN ) THEN ! CCN case
+ XRHOP = XRHO_CCN(JMOD)
+ XMDIAMP = 2*XR_MEAN_CCN(JMOD)
+ XSIGMAP = EXP(XLOGSIG_CCN(JMOD))
+ XFRACP = 1.0
+ ELSE ! IFN case
+ XRHOP = XRHO_IFN(JM)
+ XMDIAMP = XMDIAM_IFN(JM)
+ XSIGMAP = XSIGMA_IFN(JM)
+ XFRACP = XFRAC(JM,JMOD)
+ END IF
+ !-----------------------------------------------------------------------------
+ ! Loop over the aerosols particles diameters (log normal distribution law) :
+ !
+ DO J1=1,NDIAMP
+ ! exchange of variables: [m]
+ ZVOLDP(J1) = XMDIAMP * EXP(ZABSCISSP(J1)*SQRT(2.)*LOG(XSIGMAP))
+ ! Cunningham slip correction factor (1+alpha*Knudsen)
+ ZKNUDSEN(:) = MIN( 20.,ZVOLDP(J1)/ZMFPA(:) )
+ ZCUNSLIP(:,J1) = 1.0+2.0/ZKNUDSEN(:)*(1.257+0.4*EXP(-0.55*ZKNUDSEN(:)))
+ ! Diffusion coefficient
+ ZDIFF(:,J1) = XBOLTZ*ZT(:)*ZCUNSLIP(:,J1)/(3.*XPI*ZVISCA(:)*ZVOLDP(J1))
+ ! Schmidt number
+ ZSC(:,J1) = ZVISCA(:)/(ZRHODREF(:)*ZDIFF(:,J1))
+ ZSC_INV(:,J1) = 1./ZSC(:,J1)
+ ZSC_SQRT(:,J1) = SQRT( ZSC(:,J1) )
+ ZSC_3SQRT(:,J1) = ZSC(:,J1)**(1./3.)
+ ! Characteristic Time Required for reaching terminal velocity
+ ZRELT(:,J1) = (ZVOLDP(J1)**2)*ZCUNSLIP(:,J1)*XRHOP/(18.*ZVISCA(:))
+ ! Density number
+ ZDENS_RATIO = XRHOP/XRHOLW
+ ZDENS_RATIO_SQRT = SQRT(ZDENS_RATIO)
+ ! Initialisation
+ ZBC_SCAV_COEF(:,J1)=0.
+ !-------------------------------------------------------------------------
+ ! Loop over the drops diameters (generalized Gamma distribution) :
+ !
+ DO J2=1,NDIAMR
+ ! Stokes number
+ ZST(:,J1,J2) = 2.*ZRELT(:,J1)*(ZFVELR(:,J2)-ZRELT(1,J1)*XG) &
+ *ZVOLDR_INV(:,J2)
+ ! Size Ratio
+ ZSIZE_RATIO(:,J1,J2) = ZVOLDP(J1)*ZVOLDR_INV(:,J2)
+ ! Collision Efficiency
+ ZCOL_EF(:,J1,J2) = COLL_EFFI(ZRE, ZRE_INV, ZRE_SQRT, ZSC, ZSC_INV, &
+ ZSC_SQRT, ZSC_3SQRT, ZST, ZST_STAR, &
+ ZSIZE_RATIO, ZVISC_RATIO, ZDENS_RATIO_SQRT)
+ ! Below-Cloud Scavenging Coefficient for a fixed ZVOLDP: [/s]
+ ZBC_SCAV_COEF(:,J1) = ZBC_SCAV_COEF(:,J1) + &
+ ZCOL_EF(:,J1,J2) * ZWEIGHTR(J2) * FACTOR(:) * ZVOLDR_POW(:,J2)
+ END DO
+ ! End of the loop over the drops diameters
+ !--------------------------------------------------------------------------
+
+ ! Total NUMBER Scavenging Rate of aerosol [m**-3.s**-1]
+ ZTOT_SCAV_RATE(:) = ZTOT_SCAV_RATE(:) - &
+ ZWEIGHTP(J1)*XFRACP*ZCONCP(:)*ZBC_SCAV_COEF(:,J1)
+ ! Total MASS Scavenging Rate of aerosol [kg.m**-3.s**-1]
+ ZTOT_MASS_RATE(:) = ZTOT_MASS_RATE(:) + &
+ ZWEIGHTP(J1)*XFRACP*ZCONCP(:)*ZBC_SCAV_COEF(:,J1) &
+ *XPI/6.*XRHOP*(ZVOLDP(J1)**3)
+ END DO
+ ! End of the loop over the drops diameters
+ !--------------------------------------------------------------------------
+
+ ! Total NUMBER Scavenging Rate of aerosol [m**-3.s**-1]
+ PTOT_SCAV_RATE(:,:,:)=UNPACK(ZTOT_SCAV_RATE(:),MASK=GSCAV(:,:,:),FIELD=0.0)
+ ! Free particles (CCN or IFN) [/s]:
+ PRSVS(:,:,:,SV_VAR) = max(PRSVS(:,:,:,SV_VAR)+PTOT_SCAV_RATE(:,:,:) &
+ * PRHODJ(:,:,:)/PRHODREF(:,:,:) , 0.0 )
+ ! Total MASS Scavenging Rate of aerosol which REACH THE FLOOR because of
+ ! rain sedimentation [kg.m**-3.s**-1]
+ IF (LAERO_MASS)THEN
+ PTOT_MASS_RATE(:,:,:) = PTOT_MASS_RATE(:,:,:) + &
+ UNPACK(ZTOT_MASS_RATE(:), MASK=GSCAV(:,:,:), FIELD=0.0)
+ CALL SCAV_MASS_SEDIMENTATION( HCLOUD, PTSTEP, KTCOUNT, PZZ, PRHODJ, &
+ PRHODREF, PRRT, PSVT(:,:,:,NSV_LIMA_SCAVMASS),&
+ PRSVS(:,:,:,NSV_LIMA_SCAVMASS), PINPAP )
+ PRSVS(:,:,:,NSV_LIMA_SCAVMASS)=PRSVS(:,:,:,NSV_LIMA_SCAVMASS) + &
+ PTOT_MASS_RATE(:,:,:)*PRHODJ(:,:,:)/PRHODREF(:,:,:)
+ END IF
+ ENDDO
+! End of the loop over the aerosol species
+!--------------------------------------------------------------------------
+!
+!
+!
+ DEALLOCATE(FACTOR)
+ DEALLOCATE(ZSC_INV)
+ DEALLOCATE(ZSC_SQRT)
+ DEALLOCATE(ZSC_3SQRT)
+ DEALLOCATE(ZRE_INV)
+ DEALLOCATE(ZRE_SQRT)
+ DEALLOCATE(ZVOLDR_POW)
+ DEALLOCATE(ZVOLDR_INV)
+!
+ DEALLOCATE(ZFVELR)
+ DEALLOCATE(ZRE)
+ DEALLOCATE(ZST_STAR)
+ DEALLOCATE(ZST)
+ DEALLOCATE(ZSIZE_RATIO)
+ DEALLOCATE(ZCOL_EF)
+ DEALLOCATE(ZVOLDR)
+ DEALLOCATE(ZDIFF)
+ DEALLOCATE(ZRELT)
+ DEALLOCATE(ZSC)
+ DEALLOCATE(ZCUNSLIP)
+ DEALLOCATE(ZBC_SCAV_COEF)
+!
+ DEALLOCATE(ZTOT_SCAV_RATE)
+ DEALLOCATE(ZTOT_MASS_RATE)
+ DEALLOCATE(ZMEAN_SCAV_COEF)
+!
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZCONCR)
+ DEALLOCATE(ZLAMBDAR)
+ DEALLOCATE(ZCONCP)
+ DEALLOCATE(ZVISC_RATIO)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZVISCA)
+ DEALLOCATE(ZPABST)
+ DEALLOCATE(ZKNUDSEN)
+ DEALLOCATE(ZT)
+ DEALLOCATE(ZMFPA)
+ ENDIF
+ENDDO
+!
+IF (LBUDGET_SV) THEN
+ IF (NMOD_CCN.GE.1) THEN
+ DO JL=1, NMOD_CCN
+ CALL BUDGET ( PRSVS(:,:,:,NSV_LIMA_CCN_FREE+JL-1), &
+ 12+NSV_LIMA_CCN_FREE+JL-1,'SCAV_BU_RSV')
+ END DO
+ END IF
+ IF (NMOD_IFN.GE.1) THEN
+ DO JL=1, NMOD_IFN
+ CALL BUDGET ( PRSVS(:,:,:,NSV_LIMA_IFN_FREE+JL-1), &
+ 12+NSV_LIMA_IFN_FREE+JL-1,'SCAV_BU_RSV')
+ END DO
+ END IF
+END IF
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 3. SUBROUTINE AND FUNCTION
+! -----------------------
+!
+!
+CONTAINS
+!
+!------------------------------------------------------------------------------
+! ##########################################################################
+ SUBROUTINE SCAV_MASS_SEDIMENTATION( HCLOUD, PTSTEP, KTCOUNT, PZZ, PRHODJ,&
+ PRHODREF, PRAIN, PSVT_MASS, PRSVS_MASS, PINPAP )
+! ##########################################################################
+!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the total mass of aerosol
+!! scavenged by precipitations
+!!
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS
+!! JPHEXT : Horizontal external points number
+!! JPVEXT : Vertical external points number
+!! Module MODD_CONF :
+!! CCONF configuration of the model for the first time step
+!!
+!! REFERENCE
+!! ---------
+!! Book1 of the documentation ( routine CH_AQUEOUS_SEDIMENTATION )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 22/07/07
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+USE MODD_CONF
+!
+USE MODD_PARAM_LIMA, ONLY : XCEXVT, XRTMIN
+USE MODD_PARAM_LIMA_WARM, ONLY : XBR, XDR, XFSEDRR
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Cloud parameterization
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KTCOUNT ! Current time step number
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry Density [kg]
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRAIN ! Rain water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVT_MASS ! Precip. aerosols at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSVS_MASS ! Precip. aerosols source
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPAP
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: JJ, JK, JN, JRR ! Loop indexes
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
+!
+REAL :: ZTSPLITR ! Small time step for rain sedimentation
+REAL :: ZTSTEP ! Large time step for rain sedimentation
+!
+!
+LOGICAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
+ :: GSEDIM ! where to compute the SED processes
+INTEGER :: ISEDIM
+INTEGER , DIMENSION(SIZE(GSEDIM)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+!
+!
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
+ :: ZW, & ! work array
+ ZWSED, & ! sedimentation fluxes
+ ZZS ! Rain water m.r. source
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZRRS, & ! Rain water m.r. source
+ ZRHODREF, & ! RHO Dry REFerence
+ ZZW ! Work array
+!
+REAL, DIMENSION(3) :: ZRTMIN
+!
+!
+REAL :: ZVTRMAX, ZDZMIN, ZT
+REAL, SAVE :: ZEXSEDR
+LOGICAL, SAVE :: GSFIRSTCALL = .TRUE.
+INTEGER, SAVE :: ISPLITR
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE LOOP BOUNDS
+! -----------------------
+!
+IIB=1+JPHEXT
+IIE=SIZE(PZZ,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PZZ,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PZZ,3) - JPVEXT
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. COMPUTE THE SEDIMENTATION (RS) SOURCE
+! -------------------------------------
+!
+!* 2.1 splitting factor for high Courant number C=v_fall*(del_Z/del_T)
+!
+firstcall : IF (GSFIRSTCALL) THEN
+ GSFIRSTCALL = .FALSE.
+ ZVTRMAX = 10.
+ ZDZMIN = MINVAL(PZZ(IIB:IIE,IJB:IJE,IKB+1:IKE+1)-PZZ(IIB:IIE,IJB:IJE,IKB:IKE))
+ ISPLITR = 1
+ SPLIT : DO
+ ZT = 2.* PTSTEP / FLOAT(ISPLITR)
+ IF ( ZT * ZVTRMAX / ZDZMIN .LT. 1.) EXIT SPLIT
+ ISPLITR = ISPLITR + 1
+ END DO SPLIT
+!
+ ZEXSEDR = (XBR+XDR+1.0)/(XBR+1.0)
+!
+END IF firstcall
+!
+!* 2.2 time splitting loop initialization
+!
+IF( (KTCOUNT==1) .AND. (CCONF=='START') ) THEN
+ ZTSPLITR = PTSTEP / FLOAT(ISPLITR) ! Small time step
+ ZTSTEP = PTSTEP ! Large time step
+ ELSE
+ ZTSPLITR= 2. * PTSTEP / FLOAT(ISPLITR)
+ ZTSTEP = 2. * PTSTEP
+END IF
+!
+!* 2.3 compute the fluxes
+!
+! optimization by looking for locations where
+! the precipitating fields are larger than a minimal value only !!!
+!
+ZRTMIN(:) = XRTMIN(:) / ZTSTEP
+ZZS(:,:,:) = PRAIN(:,:,:)
+DO JN = 1 , ISPLITR
+ GSEDIM(:,:,:) = .FALSE.
+ GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = ZZS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN(3)
+!
+ ISEDIM = COUNTJV( GSEDIM(:,:,:),I1(:),I2(:),I3(:))
+ IF( ISEDIM >= 1 ) THEN
+ IF( JN==1 ) THEN
+ ZZS(:,:,:) = ZZS(:,:,:) * ZTSTEP
+ DO JK = IKB , IKE-1
+ ZW(:,:,JK) =ZTSPLITR*2./(PRHODREF(:,:,JK)*(PZZ(:,:,JK+2)-PZZ(:,:,JK)))
+ END DO
+ ZW(:,:,IKE) =ZTSPLITR/(PRHODREF(:,:,IKE)*(PZZ(:,:,IKE+1)-PZZ(:,:,IKE)))
+ END IF
+ ALLOCATE(ZRRS(ISEDIM))
+ ALLOCATE(ZRHODREF(ISEDIM))
+ DO JL=1,ISEDIM
+ ZRRS(JL) = ZZS(I1(JL),I2(JL),I3(JL))
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ ALLOCATE(ZZW(ISEDIM)) ; ZZW(:) = 0.0
+!
+!* 2.2.1 for rain
+!
+ ZZW(:) = XFSEDRR * ZRRS(:)**(ZEXSEDR) * ZRHODREF(:)**(ZEXSEDR-XCEXVT)
+ ZWSED(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ DO JK = IKB , IKE
+ ZZS(:,:,JK) = ZZS(:,:,JK) + ZW(:,:,JK)*(ZWSED(:,:,JK+1)-ZWSED(:,:,JK))
+ END DO
+ IF( JN==1 ) THEN
+ PINPAP(:,:) = ZWSED(:,:,IKB)* &
+ ( PSVT_MASS(:,:,IKB)/MAX(ZRTMIN(3),PRRT(:,:,IKB)) )
+ END IF
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZRRS)
+ DEALLOCATE(ZZW)
+ IF( JN==ISPLITR ) THEN
+ GSEDIM(:,:,:) = .FALSE.
+ GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = ZZS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN(3)
+ ZWSED(:,:,:) = 0.0
+ WHERE( GSEDIM(:,:,:) )
+ ZWSED(:,:,:) = 1.0/ZTSTEP - PRAIN(:,:,:)/ZZS(:,:,:)
+ END WHERE
+ END IF
+ END IF
+END DO
+!
+! Apply the rain sedimentation rate to the WR_xxx aqueous species
+!
+PRSVS_MASS(:,:,:) = PRSVS_MASS(:,:,:) + ZWSED(:,:,:)*PSVT_MASS(:,:,:)
+!
+END SUBROUTINE SCAV_MASS_SEDIMENTATION
+!
+!------------------------------------------------------------------------------
+!
+!###################################################################
+ FUNCTION COLL_EFFI (PRE, PRE_INV, PRE_SQRT, PSC, PSC_INV, PSC_SQRT, &
+ PSC_3SQRT, PST, PST_STAR, PSIZE_RATIO, &
+ PVISC_RATIO, PDENS_RATIO_SQRT) RESULT(PCOL_EF)
+!###################################################################
+!
+!Compute the Raindrop-Aerosol Collision Efficiency
+!
+!* 0. DECLARATIONS
+! ---------------
+!
+ IMPLICIT NONE
+!
+ INTEGER :: I
+!
+ REAL, DIMENSION(:,:), INTENT(IN) :: PRE
+ REAL, DIMENSION(:,:), INTENT(IN) :: PRE_INV
+ REAL, DIMENSION(:,:), INTENT(IN) :: PRE_SQRT
+ REAL, DIMENSION(:,:), INTENT(IN) :: PSC
+ REAL, DIMENSION(:,:), INTENT(IN) :: PSC_INV
+ REAL, DIMENSION(:,:), INTENT(IN) :: PSC_SQRT
+ REAL, DIMENSION(:,:), INTENT(IN) :: PSC_3SQRT
+ REAL, DIMENSION(:,:), INTENT(IN) :: PST_STAR
+!
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PST
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIZE_RATIO
+!
+ REAL, DIMENSION(:), INTENT(IN) :: PVISC_RATIO
+ REAL, INTENT(IN) :: PDENS_RATIO_SQRT
+!
+ REAL, DIMENSION(SIZE(ZRE,1)) :: PCOL_EF !result : collision efficiency
+!
+!-------------------------------------------------------------------------------
+!
+ PCOL_EF(:) = (4.*PSC_INV(:,J1)*PRE_INV(:,J2)*(1.+0.4*PRE_SQRT(:,J2) &
+ *PSC_3SQRT(:,J1)+0.16*PRE_SQRT(:,J2)*PSC_SQRT(:,J1))) &
+ +(4.*PSIZE_RATIO(:,J1,J2)*(PVISC_RATIO(:) &
+ +(1.+2.*PRE_SQRT(:,J2))*PSIZE_RATIO(:,J1,J2)))
+ DO I=1,ISCAV
+ IF (PST(I,J1,J2)>PST_STAR(I,J2)) THEN
+ PCOL_EF(I) = PCOL_EF(I) &
+ +(PDENS_RATIO_SQRT*((PST(I,J1,J2)-PST_STAR(I,J2)) &
+ /(PST(I,J1,J2)-PST_STAR(I,J2)+2./3.))**(3./2.))
+ ENDIF
+ ENDDO
+ END FUNCTION COLL_EFFI
+!
+!------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_PRECIP_SCAVENGING
diff --git a/src/MNH/lima_warm.f90 b/src/MNH/lima_warm.f90
new file mode 100644
index 000000000..ef46126cc
--- /dev/null
+++ b/src/MNH/lima_warm.f90
@@ -0,0 +1,440 @@
+! #####################
+ MODULE MODI_LIMA_WARM
+! #####################
+!
+INTERFACE
+ SUBROUTINE LIMA_WARM (OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
+ HFMFILE, HLUOUT, OCLOSE_OUT, KRR, PZZ, PRHODJ,&
+ PRHODREF, PEXNREF, PW_NU, PPABSM, PPABST, &
+ PTHM, PRCM, &
+ PTHT, PRT, PSVT, &
+ PTHS, PRS, PSVS, &
+ PINPRC, PINPRR, PINPRR3D, PEVAP3D )
+!
+LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
+ ! activation by radiative
+ ! tendency
+LOGICAL, INTENT(IN) :: OSEDC ! switch to activate the
+ ! cloud droplet sedimentation
+LOGICAL, INTENT(IN) :: ORAIN ! switch to activate the
+ ! rain formation by coalescence
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! for sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KMI ! Model index
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
+ ! the tput FM fileoutp
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+ ! the nucleation param.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at t-dt
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
+!
+!
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! Rain inst precip 3D
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
+!
+END SUBROUTINE LIMA_WARM
+END INTERFACE
+END MODULE MODI_LIMA_WARM
+! #####################################################################
+ SUBROUTINE LIMA_WARM (OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
+ HFMFILE, HLUOUT, OCLOSE_OUT, KRR, PZZ, PRHODJ,&
+ PRHODREF, PEXNREF, PW_NU, PPABSM, PPABST, &
+ PTHM, PRCM, &
+ PTHT, PRT, PSVT, &
+ PTHS, PRS, PSVS, &
+ PINPRC, PINPRR, PINPRR3D, PEVAP3D )
+! #####################################################################
+!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the warm microphysical
+!! sources: nucleation, sedimentation, autoconversion, accretion,
+!! self-collection and vaporisation which are parameterized according
+!! to Cohard and Pinty, QJRMS, 2000
+!!
+!!
+!!** METHOD
+!! ------
+!! The activation of CCN is checked for quasi-saturated air parcels
+!! to update the cloud droplet number concentration. Then assuming a
+!! generalized gamma distribution law for the cloud droplets and the
+!! raindrops, the zeroth and third order moments tendencies are evaluated
+!! for all the coalescence terms by integrating the Stochastic Collection
+!! Equation. As autoconversion is a process that cannot be resolved
+!! analytically, the Berry-Reinhardt parameterisation is employed with
+!! modifications to initiate the raindrop spectrum mode. The integration
+!! of the raindrop evaporation below clouds is straightforward.
+!!
+!! The sedimentation rates are computed with a time spliting technique:
+!! an upstream scheme, written as a difference of non-advective fluxes.
+!! This source term is added to the next coming time step (split-implicit
+!! process).
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
+!! microphysical bulk scheme.
+!! Part I: Description and tests
+!! Part II: 2D experiments with a non-hydrostatic model
+!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! C. Barthe * LACy * jan. 2014 add budgets
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+USE MODD_CST
+USE MODD_CONF
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_LIMA_WARM
+USE MODD_NSV
+!
+!
+USE MODD_BUDGET
+USE MODI_BUDGET
+!
+USE MODE_FM
+USE MODE_FMWRIT
+!
+USE MODI_LIMA_WARM_SEDIM
+USE MODI_LIMA_WARM_NUCL
+USE MODI_LIMA_WARM_COAL
+USE MODI_LIMA_WARM_EVAP
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
+ ! activation by radiative
+ ! tendency
+LOGICAL, INTENT(IN) :: OSEDC ! switch to activate the
+ ! cloud droplet sedimentation
+LOGICAL, INTENT(IN) :: ORAIN ! switch to activate the
+ ! rain formation by coalescence
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! for sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KMI ! Model index
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
+ ! the tput FM fileoutp
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+ ! the nucleation param.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at t-dt
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
+!
+!
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! Rain inst precip 3D
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: PRVT, & ! Water vapor m.r. at t
+ PRCT, & ! Cloud water m.r. at t
+ PRRT, & ! Rain water m.r. at t
+ !
+ PRVS, & ! Water vapor m.r. source
+ PRCS, & ! Cloud water m.r. source
+ PRRS, & ! Rain water m.r. source
+ !
+ PCCT, & ! Cloud water C. at t
+ PCRT, & ! Rain water C. at t
+ !
+ PCCS, & ! Cloud water C. source
+ PCRS ! Rain water C. source
+!
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PNFS ! CCN C. available source
+ !used as Free ice nuclei for
+ !HOMOGENEOUS nucleation of haze
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PNAS ! Cloud C. nuclei C. source
+ !used as Free ice nuclei for
+ !IMMERSION freezing
+!
+!
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZT, ZTM
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZWLBDR,ZWLBDR3,ZWLBDC,ZWLBDC3
+INTEGER :: JL
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 0. 3D MICROPHYSCAL VARIABLES
+! -------------------------
+!
+!
+! Prepare 3D water mixing ratios
+PRVT(:,:,:) = PRT(:,:,:,1)
+PRVS(:,:,:) = PRS(:,:,:,1)
+!
+PRCT(:,:,:) = 0.
+PRCS(:,:,:) = 0.
+PRRT(:,:,:) = 0.
+PRRS(:,:,:) = 0.
+!
+IF ( KRR .GE. 2 ) PRCT(:,:,:) = PRT(:,:,:,2)
+IF ( KRR .GE. 2 ) PRCS(:,:,:) = PRS(:,:,:,2)
+IF ( KRR .GE. 3 ) PRRT(:,:,:) = PRT(:,:,:,3)
+IF ( KRR .GE. 3 ) PRRS(:,:,:) = PRS(:,:,:,3)
+!
+! Prepare 3D number concentrations
+PCCT(:,:,:) = 0.
+PCRT(:,:,:) = 0.
+PCCS(:,:,:) = 0.
+PCRS(:,:,:) = 0.
+!
+IF ( LWARM ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
+IF ( LWARM .AND. LRAIN ) PCRT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NR)
+!
+IF ( LWARM ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
+IF ( LWARM .AND. LRAIN ) PCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
+!
+IF ( NMOD_CCN .GE. 1 ) THEN
+ ALLOCATE( PNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ ALLOCATE( PNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ PNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)
+ PNAS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)
+ELSE
+ ALLOCATE( PNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
+ ALLOCATE( PNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
+ PNFS(:,:,:,:) = 0.
+ PNAS(:,:,:,:) = 0.
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. COMPUTE THE SLOPE PARAMETERS ZLBDC,ZLBDR
+! ----------------------------------------
+!
+!
+ZWLBDC3(:,:,:) = 1.E45
+ZWLBDC(:,:,:) = 1.E15
+!
+WHERE (PRCT(:,:,:)>XRTMIN(2) .AND. PCCT(:,:,:)>XCTMIN(2))
+ ZWLBDC3(:,:,:) = XLBC * PCCT(:,:,:) / PRCT(:,:,:)
+ ZWLBDC(:,:,:) = ZWLBDC3(:,:,:)**XLBEXC
+END WHERE
+!
+ZWLBDR3(:,:,:) = 1.E30
+ZWLBDR(:,:,:) = 1.E10
+WHERE (PRRT(:,:,:)>XRTMIN(3) .AND. PCRT(:,:,:)>XCTMIN(3))
+ ZWLBDR3(:,:,:) = XLBR * PCRT(:,:,:) / PRRT(:,:,:)
+ ZWLBDR(:,:,:) = ZWLBDR3(:,:,:)**XLBEXR
+END WHERE
+ZT(:,:,:) = PTHT(:,:,:) * (PPABST(:,:,:)/XP00)**(XRD/XCPD)
+ZTM(:,:,:) = PTHM(:,:,:) * (PPABSM(:,:,:)/XP00)**(XRD/XCPD)
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. COMPUTE THE SEDIMENTATION (RS) SOURCE
+! -------------------------------------
+!
+!
+CALL LIMA_WARM_SEDIM (OSEDC, KSPLITR, PTSTEP, KMI, &
+ HFMFILE, HLUOUT, OCLOSE_OUT, &
+ PZZ, PRHODREF, PPABST, ZT, &
+ ZWLBDC, &
+ PRCT, PRRT, PCCT, PCRT, &
+ PRCS, PRRS, PCCS, PCRS, &
+ PINPRC, PINPRR, &
+ PINPRR3D )
+!
+IF (LBUDGET_RC .AND. OSEDC) &
+ CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'SEDI_BU_RRC')
+IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'SEDI_BU_RRR')
+IF (LBUDGET_SV) THEN
+ IF (OSEDC) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,&
+ &'SEDI_BU_RSV') ! RCC
+ IF (ORAIN) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,&
+ &'SEDI_BU_RSV') ! RCR
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. COMPUTES THE NUCLEATION PROCESS SOURCES
+! --------------------------------------
+!
+!
+IF (LACTI) THEN
+!
+ CALL LIMA_WARM_NUCL (OACTIT, PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT,&
+ PRHODREF, PEXNREF, PPABST, ZT, ZTM, PW_NU, &
+ PRCM, PRVT, PRCT, PRRT, &
+ PTHS, PRVS, PRCS, PCCS, PNFS, PNAS )
+!
+ IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HENU_BU_RTH')
+ IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),6,'HENU_BU_RRV')
+ IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'HENU_BU_RRC')
+ IF (LBUDGET_SV) THEN
+ CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'HENU_BU_RSV') ! RCN
+ IF (NMOD_CCN.GE.1) THEN
+ DO JL=1, NMOD_CCN
+ CALL BUDGET ( PNFS(:,:,:,JL)*PRHODJ(:,:,:),12+NSV_LIMA_CCN_FREE+JL-1,'HENU_BU_RSV')
+ END DO
+ END IF
+ END IF
+!
+END IF ! LACTI
+!
+!
+!------------------------------------------------------------------------------
+!
+!* 3. COALESCENCE PROCESSES
+! ---------------------
+!
+!
+ CALL LIMA_WARM_COAL (PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT, &
+ PRHODREF, ZWLBDC3, ZWLBDC, ZWLBDR3, ZWLBDR, &
+ PRCT, PRRT, PCCT, PCRT, &
+ PRCS, PRRS, PCCS, PCRS, &
+ PRHODJ )
+!
+!
+!-------------------------------------------------------------------------------
+!
+! 4. EVAPORATION OF RAINDROPS
+! ------------------------
+!
+!
+IF (ORAIN) THEN
+!
+ CALL LIMA_WARM_EVAP (PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT, &
+ PRHODREF, PEXNREF, PPABST, ZT, &
+ ZWLBDC3, ZWLBDC, ZWLBDR3, ZWLBDR, &
+ PRVT, PRCT, PRRT, PCRT, &
+ PRVS, PRCS, PRRS, PCCS, PCRS, PTHS, &
+ PEVAP3D )
+!
+ IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),6 ,'REVA_BU_RRV')
+ IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'REVA_BU_RRC')
+ IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'REVA_BU_RRR')
+ IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4 ,'REVA_BU_RTH')
+ IF (LBUDGET_SV) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'REVA_BU_RSV')
+ IF (LBUDGET_SV) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'REVA_BU_RSV')
+!
+!
+!-------------------------------------------------------------------------------
+!
+! 5. SPONTANEOUS BREAK-UP (NUMERICAL FILTER)
+! --------------------
+!
+ ZWLBDR(:,:,:) = 1.E10
+ WHERE (PRRS(:,:,:)>0.0.AND.PCRS(:,:,:)>0.0 )
+ ZWLBDR3(:,:,:) = XLBR * PCRS(:,:,:) / PRRS(:,:,:)
+ ZWLBDR(:,:,:) = ZWLBDR3(:,:,:)**XLBEXR
+ END WHERE
+ WHERE (ZWLBDR(:,:,:)<(XACCR1/XSPONBUD1))
+ PCRS(:,:,:) = PCRS(:,:,:)*MAX((1.+XSPONCOEF2*(XACCR1/ZWLBDR(:,:,:)-XSPONBUD1)**2),&
+ (XACCR1/ZWLBDR(:,:,:)/XSPONBUD3)**3)
+ END WHERE
+!
+! Budget storage
+ IF (LBUDGET_SV) &
+ CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,&
+ &'BRKU_BU_RSV')
+
+!
+ENDIF ! ORAIN
+!
+!------------------------------------------------------------------------------
+!
+!
+!* 6. REPORT 3D MICROPHYSICAL VARIABLES IN PRS AND PSVS
+! -------------------------------------------------
+!
+PRS(:,:,:,1) = PRVS(:,:,:)
+IF ( KRR .GE. 2 ) PRS(:,:,:,2) = PRCS(:,:,:)
+IF ( KRR .GE. 3 ) PRS(:,:,:,3) = PRRS(:,:,:)
+!
+! Prepare 3D number concentrations
+!
+IF ( LWARM ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
+IF ( LWARM .AND. LRAIN ) PSVS(:,:,:,NSV_LIMA_NR) = PCRS(:,:,:)
+!
+IF ( NMOD_CCN .GE. 1 ) THEN
+ PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = PNFS(:,:,:,:)
+ PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) = PNAS(:,:,:,:)
+END IF
+!
+!++cb++
+IF (ALLOCATED(PNFS)) DEALLOCATE(PNFS)
+IF (ALLOCATED(PNAS)) DEALLOCATE(PNAS)
+!--cb--
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_WARM
diff --git a/src/MNH/lima_warm_coal.f90 b/src/MNH/lima_warm_coal.f90
new file mode 100644
index 000000000..db696298c
--- /dev/null
+++ b/src/MNH/lima_warm_coal.f90
@@ -0,0 +1,495 @@
+! ##########################
+ MODULE MODI_LIMA_WARM_COAL
+! ##########################
+!
+INTERFACE
+ SUBROUTINE LIMA_WARM_COAL (PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT, &
+ PRHODREF, ZWLBDC3, ZWLBDC, ZWLBDR3, ZWLBDR, &
+ PRCT, PRRT, PCCT, PCRT, &
+ PRCS, PRRS, PCCS, PCRS, &
+ PRHODJ )
+!
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KMI ! Model index
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
+ ! the tput FM fileoutp
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDC3 ! Lambda(cloud) **3
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDC ! Lambda(cloud)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDR3 ! Lambda(rain) **3
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDR ! Lambda(rain)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
+!
+ END SUBROUTINE LIMA_WARM_COAL
+END INTERFACE
+END MODULE MODI_LIMA_WARM_COAL
+! #############################################################################
+ SUBROUTINE LIMA_WARM_COAL (PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT, &
+ PRHODREF, ZWLBDC3, ZWLBDC, ZWLBDR3, ZWLBDR, &
+ PRCT, PRRT, PCCT, PCRT, &
+ PRCS, PRRS, PCCS, PCRS, &
+ PRHODJ )
+! #############################################################################
+!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the microphysical sources:
+!! nucleation, sedimentation, autoconversion, accretion, self-collection
+!! and vaporisation which are parameterized according to Cohard and Pinty
+!! QJRMS, 2000
+!!
+!!
+!!** METHOD
+!! ------
+!! Assuming a generalized gamma distribution law for the cloud droplets
+!! and the raindrops, the zeroth and third order moments tendencies
+!! are evaluated for all the coalescence terms by integrating the
+!! Stochastic Collection Equation. As autoconversion is a process that
+!! cannot be resolved analytically, the Berry-Reinhardt parameterisation
+!! is employed with modifications to initiate the raindrop spectrum mode.
+!!
+!! Computation steps :
+!! 1- Check where computations are necessary, pack variables
+!! 2- Self collection of cloud droplets
+!! 3- Autoconversion of cloud droplets (Berry-Reinhardt parameterization)
+!! 4- Accretion sources
+!! 5- Self collection - Coalescence/Break-up
+!! 6- Unpack variables, clean
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
+!! microphysical bulk scheme.
+!! Part I: Description and tests
+!! Part II: 2D experiments with a non-hydrostatic model
+!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!! C. Barthe * LACy * jan. 2014 add budgets
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+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 MODI_BUDGET
+!
+USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KMI ! Model index
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
+ ! the tput FM fileoutp
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDC3 ! Lambda(cloud) **3
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDC ! Lambda(cloud)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDR3 ! Lambda(rain) **3
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDR ! Lambda(rain)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
+!
+!* 0.1 Declarations of local variables :
+!
+! Packing variables
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: GMICRO
+INTEGER :: IMICRO
+INTEGER , DIMENSION(SIZE(GMICRO)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+!
+! Packed micophysical variables
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:) , ALLOCATABLE :: ZCCT ! cloud conc. at t
+REAL, DIMENSION(:) , ALLOCATABLE :: ZCRT ! rain conc. at t
+!
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRCS ! Cloud water m.r. source
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRRS ! Rain water m.r. source
+REAL, DIMENSION(:) , ALLOCATABLE :: ZCCS ! cloud conc. source
+REAL, DIMENSION(:) , ALLOCATABLE :: ZCRS ! rain conc. source
+!
+! Other packed variables
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRHODREF ! RHO Dry REFerence
+REAL, DIMENSION(:) , ALLOCATABLE :: ZLBDC3
+REAL, DIMENSION(:) , ALLOCATABLE :: ZLBDC
+REAL, DIMENSION(:) , ALLOCATABLE :: ZLBDR3
+REAL, DIMENSION(:) , ALLOCATABLE :: ZLBDR
+!
+! Work arrays
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZW
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4, ZSCBU
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GSELF, &
+ GACCR, &
+ GSCBU, &
+ GENABLE_ACCR_SCBU
+!
+!
+INTEGER :: ISELF, IACCR, ISCBU
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. PREPARE COMPUTATIONS - PACK
+! ---------------------------
+!
+!
+IIB=1+JPHEXT
+IIE=SIZE(PRHODREF,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PRHODREF,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PRHODREF,3) - JPVEXT
+!
+GMICRO(:,:,:) = .FALSE.
+GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRCT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(2) .OR. &
+ PRRT(IIB:IIE,IJB:IJE,IKB:IKE)>XRTMIN(3)
+!
+IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
+!
+IF( IMICRO >= 1 ) THEN
+ ALLOCATE(ZRCT(IMICRO))
+ ALLOCATE(ZRRT(IMICRO))
+ ALLOCATE(ZCCT(IMICRO))
+ ALLOCATE(ZCRT(IMICRO))
+!
+ ALLOCATE(ZRCS(IMICRO))
+ ALLOCATE(ZRRS(IMICRO))
+ ALLOCATE(ZCCS(IMICRO))
+ ALLOCATE(ZCRS(IMICRO))
+!
+ ALLOCATE(ZLBDC(IMICRO))
+ ALLOCATE(ZLBDC3(IMICRO))
+ ALLOCATE(ZLBDR(IMICRO))
+ ALLOCATE(ZLBDR3(IMICRO))
+!
+ ALLOCATE(ZRHODREF(IMICRO))
+ DO JL=1,IMICRO
+ ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZCRT(JL) = PCRT(I1(JL),I2(JL),I3(JL))
+ ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
+ ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
+ ZRRS(JL) = PRRS(I1(JL),I2(JL),I3(JL))
+ ZCRS(JL) = PCRS(I1(JL),I2(JL),I3(JL))
+ ZLBDR(JL) = ZWLBDR(I1(JL),I2(JL),I3(JL))
+ ZLBDR3(JL) = ZWLBDR3(I1(JL),I2(JL),I3(JL))
+ ZLBDC(JL) = ZWLBDC(I1(JL),I2(JL),I3(JL))
+ ZLBDC3(JL) = ZWLBDC3(I1(JL),I2(JL),I3(JL))
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ END DO
+!
+ ALLOCATE(GSELF(IMICRO))
+ ALLOCATE(GACCR(IMICRO))
+ ALLOCATE(GSCBU(IMICRO))
+ ALLOCATE(ZZW1(IMICRO))
+ ALLOCATE(ZZW2(IMICRO))
+ ALLOCATE(ZZW3(IMICRO))
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. Self-collection of cloud droplets
+! ------------------------------------
+!
+!
+ GSELF(:) = ZCCT(:)>XCTMIN(2)
+ ISELF = COUNT(GSELF(:))
+ IF( ISELF>0 ) THEN
+ ZZW1(:) = XSELFC*(ZCCT(:)/ZLBDC3(:))**2 * ZRHODREF(:) ! analytical integration
+ WHERE( GSELF(:) )
+ ZCCS(:) = ZCCS(:) - MIN( ZCCS(:),ZZW1(:) )
+ END WHERE
+ END IF
+!
+!
+ ZW(:,:,:) = PCCS(:,:,:)
+ IF (LBUDGET_SV) CALL BUDGET ( &
+ UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:))&
+ &*PRHODJ(:,:,:),12+NSV_LIMA_NC,'SELF_BU_RSV')
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3. Autoconversion of cloud droplets (Berry-Reinhardt parameterization)
+! ----------------------------------------------------------------------
+!
+!
+IF (LRAIN) THEN
+!
+ ZZW2(:) = 0.0
+ ZZW1(:) = 0.0
+ WHERE( ZRCT(:)>XRTMIN(2) )
+ ZZW2(:) = MAX( 0.0,XLAUTR*ZRHODREF(:)*ZRCT(:)* &
+ (XAUTO1/ZLBDC(:)**4-XLAUTR_THRESHOLD) ) ! L
+!
+ ZZW3(:) = MIN( ZRCS(:), MAX( 0.0,XITAUTR*ZZW2(:)*ZRCT(:)* &
+ (XAUTO2/ZLBDC(:)-XITAUTR_THRESHOLD) ) ) ! L/tau
+!
+ ZRCS(:) = ZRCS(:) - ZZW3(:)
+ ZRRS(:) = ZRRS(:) + ZZW3(:)
+!
+ ZZW1(:) = MIN( MIN( 1.2E4,(XACCR4/ZLBDC(:)-XACCR5)/XACCR3), &
+ ZLBDR(:)/XACCR1 ) ! D**-1 threshold diameter for
+ ! switching the autoconversion regimes
+ ! min (80 microns, D_h, D_r)
+ ZZW3(:) = ZZW3(:) * MAX( 0.0,ZZW1(:) )**3 / XAC
+ ZCRS(:) = ZCRS(:) + ZZW3(:)
+ END WHERE
+!
+!
+ ZW(:,:,:) = PRCS(:,:,:)
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
+ *PRHODJ(:,:,:),7 ,'AUTO_BU_RRC')
+
+ ZW(:,:,:) = PRRS(:,:,:)
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
+ *PRHODJ(:,:,:),8 ,'AUTO_BU_RRR')
+ ZW(:,:,:) = PCRS(:,:,:)
+ IF (LBUDGET_SV) THEN
+ ZW(:,:,:) = PCRS(:,:,:)
+ CALL BUDGET (UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
+ *PRHODJ(:,:,:),12+NSV_LIMA_NR,'AUTO_BU_RSV')
+ ZW(:,:,:) = PCCS(:,:,:)
+ CALL BUDGET (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
+ *PRHODJ(:,:,:),12+NSV_LIMA_NC,'AUTO_BU_RSV')
+ END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 4. Accretion sources
+! --------------------
+!
+!
+ GACCR(:) = ZRRT(:)>XRTMIN(3) .AND. ZCRT(:)>XCTMIN(3)
+ IACCR = COUNT(GACCR(:))
+ IF( IACCR>0 ) THEN
+ ALLOCATE(ZZW4(IMICRO)); ZZW4(:) = XACCR1/ZLBDR(:)
+ ALLOCATE(GENABLE_ACCR_SCBU(IMICRO))
+ GENABLE_ACCR_SCBU(:) = ZRRT(:)>1.2*ZZW2(:)/ZRHODREF(:) .OR. &
+ ZZW4(:)>=MAX( XACCR2,XACCR3/(XACCR4/ZLBDC(:)-XACCR5) )
+ GACCR(:) = GACCR(:) .AND. ZRCT(:)>XRTMIN(2) .AND. GENABLE_ACCR_SCBU(:)
+ END IF
+!
+ IACCR = COUNT(GACCR(:))
+ IF( IACCR>0 ) THEN
+ WHERE( GACCR(:).AND.(ZZW4(:)>1.E-4) ) ! Accretion for D>100 10-6 m
+ ZZW3(:) = ZLBDC3(:) / ZLBDR3(:)
+ ZZW1(:) = ( ZCCT(:)*ZCRT(:) / ZLBDC3(:) )*ZRHODREF(:)
+ ZZW2(:) = MIN( ZZW1(:)*(XACCR_CLARGE1+XACCR_CLARGE2*ZZW3(:)),ZCCS(:) )
+ ZCCS(:) = ZCCS(:) - ZZW2(:)
+!
+ ZZW1(:) = ( ZZW1(:) / ZLBDC3(:) )
+ ZZW2(:) = MIN( ZZW1(:)*(XACCR_RLARGE1+XACCR_RLARGE2*ZZW3(:)),ZRCS(:) )
+ ZRCS(:) = ZRCS(:) - ZZW2(:)
+ ZRRS(:) = ZRRS(:) + ZZW2(:)
+ END WHERE
+ WHERE( GACCR(:).AND.(ZZW4(:)<=1.E-4) ) ! Accretion for D<100 10-6 m
+ ZZW3(:) = ZLBDC3(:) / ZLBDR3(:)
+ ZZW1(:) = ( ZCCT(:)*ZCRT(:) / ZLBDC3(:)**2 )*ZRHODREF(:)
+ ZZW3(:) = ZZW3(:)**2
+ ZZW2(:) = MIN( ZZW1(:)*(XACCR_CSMALL1+XACCR_CSMALL2*ZZW3(:)),ZCCS(:) )
+ ZCCS(:) = ZCCS(:) - ZZW2(:)
+!
+ ZZW1(:) = ZZW1(:) / ZLBDC3(:)
+ ZZW2(:) = MIN( ZZW1(:)*(XACCR_RSMALL1+XACCR_RSMALL2*ZZW3(:)) &
+ ,ZRCS(:) )
+ ZRCS(:) = ZRCS(:) - ZZW2(:)
+ ZRRS(:) = ZRRS(:) + ZZW2(:)
+ END WHERE
+ END IF
+!
+!
+ ZW(:,:,:) = PRCS(:,:,:)
+ IF (LBUDGET_RC) CALL BUDGET ( &
+ UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
+ *PRHODJ(:,:,:),7 ,'ACCR_BU_RRC')
+ ZW(:,:,:) = PRRS(:,:,:)
+ IF (LBUDGET_RR) CALL BUDGET ( &
+ UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
+ *PRHODJ(:,:,:),8 ,'ACCR_BU_RRR')
+ ZW(:,:,:) = PCCS(:,:,:)
+ IF (LBUDGET_SV) CALL BUDGET ( &
+ UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
+ *PRHODJ(:,:,:),12+NSV_LIMA_NC,'ACCR_BU_RSV')
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 5. Self collection - Coalescence/Break-up
+! -----------------------------------------
+!
+!
+ IF( IACCR>0 ) THEN
+ GSCBU(:) = ZCRT(:)>XCTMIN(3) .AND. GENABLE_ACCR_SCBU(:)
+ ISCBU = COUNT(GSCBU(:))
+ ELSE
+ ISCBU = 0.0
+ END IF
+ IF( ISCBU>0 ) THEN
+!
+!* 5.1 efficiencies
+!
+ IF (.NOT.ALLOCATED(ZZW4)) ALLOCATE(ZZW4(IMICRO))
+ ZZW4(:) = XACCR1 / ZLBDR(:) ! Mean diameter
+ ALLOCATE(ZSCBU(IMICRO))
+ ZSCBU(:) = 1.0
+ WHERE (ZZW4(:)>=XSCBU_EFF1 .AND. GSCBU(:)) ZSCBU(:) = & ! Coalescence
+ EXP(XSCBUEXP1*(ZZW4(:)-XSCBU_EFF1)) ! efficiency
+ WHERE (ZZW4(:)>=XSCBU_EFF2) ZSCBU(:) = 0.0 ! Break-up
+!
+!* 5.2 integration
+!
+ ZZW1(:) = 0.0
+ ZZW2(:) = 0.0
+ ZZW3(:) = 0.0
+ ZZW4(:) = XACCR1 / ZLBDR(:) ! Mean volume drop diameter
+ WHERE (GSCBU(:).AND.(ZZW4(:)>1.E-4)) ! analytical integration
+ ZZW1(:) = XSCBU2 * ZCRT(:)**2 / ZLBDR3(:) ! D>100 10-6 m
+ ZZW3(:) = ZZW1(:)*ZSCBU(:)
+ END WHERE
+ WHERE (GSCBU(:).AND.(ZZW4(:)<=1.E-4))
+ ZZW2(:) = XSCBU3 *(ZCRT(:) / ZLBDR3(:))**2 ! D<100 10-6 m
+ ZZW3(:) = ZZW2(:)
+ END WHERE
+ ZCRS(:) = ZCRS(:) - MIN( ZCRS(:),ZZW3(:) * ZRHODREF(:) )
+ DEALLOCATE(ZSCBU)
+ END IF
+!
+!
+ ZW(:,:,:) = PCRS(:,:,:)
+ IF (LBUDGET_SV) CALL BUDGET ( &
+ UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
+ *PRHODJ(:,:,:),12+NSV_LIMA_NR,'SCBU_BU_RSV')
+!
+END IF ! LRAIN
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 6. Unpack and clean
+! -------------------
+!
+!
+ ZW(:,:,:) = PRCS(:,:,:)
+ PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRRS(:,:,:)
+ PRRS(:,:,:) = UNPACK( ZRRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PCCS(:,:,:)
+ PCCS(:,:,:) = UNPACK( ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PCRS(:,:,:)
+ PCRS(:,:,:) = UNPACK( ZCRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZCCT)
+ DEALLOCATE(ZCRT)
+ DEALLOCATE(ZRCS)
+ DEALLOCATE(ZRRS)
+ DEALLOCATE(ZCRS)
+ DEALLOCATE(ZCCS)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(GSELF)
+ DEALLOCATE(GACCR)
+ DEALLOCATE(GSCBU)
+ IF( ALLOCATED(GENABLE_ACCR_SCBU) ) DEALLOCATE(GENABLE_ACCR_SCBU)
+ DEALLOCATE(ZZW1)
+ DEALLOCATE(ZZW2)
+ DEALLOCATE(ZZW3)
+ IF( ALLOCATED(ZZW4) ) DEALLOCATE(ZZW4)
+ DEALLOCATE(ZLBDR3)
+ DEALLOCATE(ZLBDC3)
+ DEALLOCATE(ZLBDR)
+ DEALLOCATE(ZLBDC)
+!
+!
+!-------------------------------------------------------------------------------
+!
+ELSE
+!* 7. Budgets are forwarded
+! ------------------------
+!
+!
+ IF (LBUDGET_SV) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'SELF_BU_RSV')
+!
+ IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'AUTO_BU_RRC')
+ IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'AUTO_BU_RRR')
+ IF (LBUDGET_SV) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'AUTO_BU_RSV')
+ IF (LBUDGET_SV) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'AUTO_BU_RSV')
+!
+ IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'ACCR_BU_RRC')
+ IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'ACCR_BU_RRR')
+ IF (LBUDGET_SV) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'ACCR_BU_RSV')
+!
+ IF (LBUDGET_SV) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'SCBU_BU_RSV')
+
+END IF ! IMICRO
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_WARM_COAL
diff --git a/src/MNH/lima_warm_evap.f90 b/src/MNH/lima_warm_evap.f90
new file mode 100644
index 000000000..09a90d093
--- /dev/null
+++ b/src/MNH/lima_warm_evap.f90
@@ -0,0 +1,352 @@
+! ##########################
+ MODULE MODI_LIMA_WARM_EVAP
+! ##########################
+!
+INTERFACE
+ SUBROUTINE LIMA_WARM_EVAP (PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT, &
+ PRHODREF, PEXNREF, PPABST, ZT, &
+ ZWLBDC3, ZWLBDC, ZWLBDR3, ZWLBDR, &
+ PRVT, PRCT, PRRT, PCRT, &
+ PRVS, PRCS, PRRS, PCCS, PCRS, PTHS, &
+ PEVAP3D)
+!
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KMI ! Model index
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
+ ! the tput FM fileoutp
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZT ! Temperature
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: ZWLBDC3 ! Lambda(cloud) **3
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: ZWLBDC ! Lambda(cloud)
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: ZWLBDR3 ! Lambda(rain) **3
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: ZWLBDR ! Lambda(rain)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
+!
+ END SUBROUTINE LIMA_WARM_EVAP
+END INTERFACE
+END MODULE MODI_LIMA_WARM_EVAP
+! #############################################################################
+ SUBROUTINE LIMA_WARM_EVAP (PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT, &
+ PRHODREF, PEXNREF, PPABST, ZT, &
+ ZWLBDC3, ZWLBDC, ZWLBDR3, ZWLBDR, &
+ PRVT, PRCT, PRRT, PCRT, &
+ PRVS, PRCS, PRRS, PCCS, PCRS, PTHS, &
+ PEVAP3D)
+! #############################################################################
+!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the raindrop evaporation
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
+USE MODD_CST
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_LIMA_WARM
+!
+USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KMI ! Model index
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
+ ! the tput FM fileoutp
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZT ! Temperature
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: ZWLBDC3 ! Lambda(cloud) **3
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: ZWLBDC ! Lambda(cloud)
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: ZWLBDR3 ! Lambda(rain) **3
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: ZWLBDR ! Lambda(rain)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
+!
+!* 0.1 Declarations of local variables :
+!
+! Packing variables
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: GEVAP, GMICRO
+INTEGER :: IEVAP, IMICRO
+INTEGER , DIMENSION(SIZE(GEVAP)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+!
+! Packed micophysical variables
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:) , ALLOCATABLE :: ZCRT ! rain conc. at t
+!
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRVS ! Water vapor m.r. source
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRRS ! Rain water m.r. source
+REAL, DIMENSION(:) , ALLOCATABLE :: ZTHS ! Theta source
+!
+! Other packed variables
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRHODREF ! RHO Dry REFerence
+REAL, DIMENSION(:) , ALLOCATABLE :: ZEXNREF ! EXNer Pressure REFerence
+REAL, DIMENSION(:) , ALLOCATABLE :: ZZT ! Temperature
+REAL, DIMENSION(:) , ALLOCATABLE :: ZLBDR ! Lambda(rain)
+!
+! Work arrays
+REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, &
+ ZRTMIN, ZCTMIN, &
+ ZZLV ! Latent heat of vaporization at T
+!
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZW, ZW2, ZRVSAT
+!
+!
+REAL :: ZEPS, ZFACT
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. PREPARE COMPUTATIONS - PACK
+! ---------------------------
+!
+!
+IIB=1+JPHEXT
+IIE=SIZE(PRHODREF,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PRHODREF,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PRHODREF,3) - JPVEXT
+!
+ALLOCATE(ZRTMIN(SIZE(XRTMIN)))
+ALLOCATE(ZCTMIN(SIZE(XCTMIN)))
+ZRTMIN(:) = XRTMIN(:) / PTSTEP
+ZCTMIN(:) = XCTMIN(:) / PTSTEP
+!
+ZEPS= XMV / XMD
+ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:) * &
+ EXP(-XALPW+XBETAW/ZT(:,:,:)+XGAMW*ALOG(ZT(:,:,:))) - 1.0)
+
+!
+GEVAP(:,:,:) = .FALSE.
+GEVAP(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRRS(IIB:IIE,IJB:IJE,IKB:IKE)> 0.0 .AND. &
+ PRVT(IIB:IIE,IJB:IJE,IKB:IKE)<ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE)
+!
+IEVAP = COUNTJV( GEVAP(:,:,:),I1(:),I2(:),I3(:))
+!
+IF( IEVAP >= 1 ) THEN
+ ALLOCATE(ZRVT(IEVAP))
+ ALLOCATE(ZRCT(IEVAP))
+ ALLOCATE(ZRRT(IEVAP))
+ ALLOCATE(ZCRT(IEVAP))
+!
+ ALLOCATE(ZRVS(IEVAP))
+ ALLOCATE(ZRRS(IEVAP))
+ ALLOCATE(ZTHS(IEVAP))
+!
+ ALLOCATE(ZLBDR(IEVAP))
+!
+ ALLOCATE(ZRHODREF(IEVAP))
+ ALLOCATE(ZEXNREF(IEVAP))
+!
+ ALLOCATE(ZZT(IEVAP))
+ ALLOCATE(ZZLV(IEVAP))
+ ALLOCATE(ZZW1(IEVAP))
+ DO JL=1,IEVAP
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZCRT(JL) = PCRT(I1(JL),I2(JL),I3(JL))
+ ZRRS(JL) = PRRS(I1(JL),I2(JL),I3(JL))
+ ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
+ ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZZW1(JL) = ZRVSAT(I1(JL),I2(JL),I3(JL))
+ ZLBDR(JL) = ZWLBDR(I1(JL),I2(JL),I3(JL))
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ END DO
+ ZZLV(:) = XLVTT + (XCPV-XCL)*(ZZT(:)-XTT)
+!
+ ALLOCATE(ZZW2(IEVAP))
+ ALLOCATE(ZZW3(IEVAP))
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. compute the evaporation of rain drops
+! ----------------------------------------
+!
+!
+ ZZW3(:) = MAX((1.0 - ZRVT(:)/ZZW1(:)),0.0) ! Subsaturation
+!
+! Compute the function G(T)
+!
+ ZZW2(:) = 1. / ( XRHOLW*((((ZZLV(:)/ZZT(:))**2)/(XTHCO*XRV)) + & ! G
+ (XRV*ZZT(:))/(XDIVA*EXP(XALPW-XBETAW/ZZT(:)-XGAMW*ALOG(ZZT(:))))))
+!
+! Compute the evaporation tendency
+!
+ ZZW2(:) = MIN( ZZW2(:) * ZZW3(:) * ZRRT(:) * &
+ (X0EVAR*ZLBDR(:)**XEX0EVAR + X1EVAR*ZRHODREF(:)**XEX2EVAR* &
+ ZLBDR(:)**XEX1EVAR),ZRRS(:) )
+ ZZW2(:) = MAX(ZZW2(:),0.0)
+!
+! Adjust sources
+!
+ ZRVS(:) = ZRVS(:) + ZZW2(:)
+ ZRRS(:) = ZRRS(:) - ZZW2(:)
+ ZTHS(:) = ZTHS(:) - ZZW2(:)*ZZLV(:) / &
+ ( ZEXNREF(:)*(XCPD + XCPV*ZRVT(:) + XCL*(ZRCT(:) + ZRRT(:)) ) )
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3. Unpack and clean
+! -------------------
+!
+!
+ ZW(:,:,:) = PRVS(:,:,:)
+ PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GEVAP(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRRS(:,:,:)
+ PRRS(:,:,:) = UNPACK( ZRRS(:),MASK=GEVAP(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PTHS(:,:,:)
+ PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GEVAP(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:)= PEVAP3D(:,:,:)
+ PEVAP3D(:,:,:) = UNPACK( ZZW2(:),MASK=GEVAP(:,:,:),FIELD=ZW(:,:,:) )
+!
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZCRT)
+ DEALLOCATE(ZRVS)
+ DEALLOCATE(ZRRS)
+ DEALLOCATE(ZTHS)
+ DEALLOCATE(ZZLV)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZEXNREF)
+ DEALLOCATE(ZZW1)
+ DEALLOCATE(ZZW2)
+ DEALLOCATE(ZZW3)
+ DEALLOCATE(ZLBDR)
+!
+!
+!-----------------------------------------------------------------------------
+!
+!
+!* 4. Update Nr if: 80 microns < Dr < D_h
+! ---------------------------------------
+!
+!
+ GEVAP(:,:,:) = PRRS(:,:,:)>ZRTMIN(3) .AND. PCRS(:,:,:)>ZCTMIN(3) .AND. &
+ PRCS(:,:,:)>ZRTMIN(2) .AND. PCCS(:,:,:)>ZCTMIN(2)
+ WHERE (GEVAP(:,:,:))
+ ZWLBDR3(:,:,:) = XLBR * PCRS(:,:,:) / PRRS(:,:,:)
+ ZWLBDR(:,:,:) = ZWLBDR3(:,:,:)**XLBEXR
+!
+ ZWLBDC3(:,:,:) = XLBC * PCCS(:,:,:) / PRCS(:,:,:)
+ ZWLBDC(:,:,:) = ZWLBDC3(:,:,:)**XLBEXC
+ ZWLBDC3(:,:,:) = (XACCR1/XACCR3)*(XACCR4/ZWLBDC(:,:,:)-XACCR5) ! 1/D_h, not "Lambda_h"
+ END WHERE
+!
+ GMICRO(:,:,:) = GEVAP(:,:,:) .AND. ZWLBDR(:,:,:)>ZWLBDC3(:,:,:)
+ ! the raindrops are too small, that is lower than D_h
+ ZFACT = 1.2E4*XACCR1
+ WHERE (GMICRO(:,:,:))
+ ZWLBDC(:,:,:) = XLBR / MIN( ZFACT,ZWLBDC3(:,:,:) )**3
+ ZW(:,:,:) = MIN( MAX( &
+ (PRHODREF(:,:,:)*PRRS(:,:,:) - ZWLBDC(:,:,:)*PCRS(:,:,:)) / &
+ (PRHODREF(:,:,:)*PRCS(:,:,:)/PCCS(:,:,:) - ZWLBDC(:,:,:)) , &
+ 0.0 ),PCRS(:,:,:), &
+ PCCS(:,:,:)*PRRS(:,:,:)/(PRCS(:,:,:)))
+!
+! Compute the percent (=1 if (ZWLBDR/XACCR1) >= 1.2E4
+! of transfer with (=0 if (ZWLBDR/XACCR1) <= (XACCR4/ZWLBDC-XACCR5)/XACCR3
+!
+ ZW(:,:,:) = ZW(:,:,:)*( (MIN(ZWLBDR(:,:,:),1.2E4*XACCR1)-ZWLBDC3(:,:,:)) / &
+ ( 1.2E4*XACCR1 -ZWLBDC3(:,:,:)) )
+!
+ ZW2(:,:,:) = PCCS(:,:,:) !temporary storage
+ PCCS(:,:,:) = PCCS(:,:,:)+ZW(:,:,:)
+ PCRS(:,:,:) = PCRS(:,:,:)-ZW(:,:,:)
+ ZW(:,:,:) = ZW(:,:,:) * (PRHODREF(:,:,:)*PRCS(:,:,:)/ZW2(:,:,:))
+ PRCS(:,:,:) = PRCS(:,:,:)+ZW(:,:,:)
+ PRRS(:,:,:) = PRRS(:,:,:)-ZW(:,:,:)
+ END WHERE
+!
+ GEVAP(:,:,:) = PRRS(:,:,:)<ZRTMIN(3) .OR. PCRS(:,:,:)<ZCTMIN(3)
+ WHERE (GEVAP(:,:,:))
+ PCRS(:,:,:) = 0.0
+ PRRS(:,:,:) = 0.0
+ END WHERE
+!
+END IF ! IEVAP
+!
+!++cb++
+DEALLOCATE(ZRTMIN)
+DEALLOCATE(ZCTMIN)
+!--cb--
+!
+!-----------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_WARM_EVAP
diff --git a/src/MNH/lima_warm_nucl.f90 b/src/MNH/lima_warm_nucl.f90
new file mode 100644
index 000000000..165ac242d
--- /dev/null
+++ b/src/MNH/lima_warm_nucl.f90
@@ -0,0 +1,818 @@
+! ##########################
+ MODULE MODI_LIMA_WARM_NUCL
+! ##########################
+!
+INTERFACE
+ SUBROUTINE LIMA_WARM_NUCL (OACTIT, PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT,&
+ PRHODREF, PEXNREF, PPABST, ZT, ZTM, PW_NU, &
+ PRCM, PRVT, PRCT, PRRT, &
+ PTHS, PRVS, PRCS, PCCS, PNFS, PNAS )
+!
+LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
+ ! activation by radiative
+ ! tendency
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KMI ! Model index
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
+ ! the output FM file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZT ! Temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZTM ! Temperature at time t-dt
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+ ! the nucleation param.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at t-dt
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+!
+REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFS ! CCN C. available source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAS ! CCN C. activated source
+!
+END SUBROUTINE LIMA_WARM_NUCL
+END INTERFACE
+END MODULE MODI_LIMA_WARM_NUCL
+! #############################################################################
+ SUBROUTINE LIMA_WARM_NUCL (OACTIT, PTSTEP, KMI, HFMFILE, HLUOUT, OCLOSE_OUT,&
+ PRHODREF, PEXNREF, PPABST, ZT, ZTM, PW_NU, &
+ PRCM, PRVT, PRCT, PRRT, &
+ PTHS, PRVS, PRCS, PCCS, PNFS, PNAS )
+! #############################################################################
+!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the activation of CCN
+!! according to Cohard and Pinty, QJRMS, 2000
+!!
+!!
+!!** METHOD
+!! ------
+!! The activation of CCN is checked for quasi-saturated air parcels
+!! to update the cloud droplet number concentration.
+!!
+!! Computation steps :
+!! 1- Check where computations are necessary
+!! 2- and 3- Compute the maximum of supersaturation using the iterative
+!! Ridder algorithm
+!! 4- Compute the nucleation source
+!! 5- Deallocate local variables
+!!
+!! Contains :
+!! 6- Functions : Ridder algorithm
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
+!! microphysical bulk scheme.
+!! Part I: Description and tests
+!! Part II: 2D experiments with a non-hydrostatic model
+!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
+USE MODD_CST
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_LIMA_WARM
+!
+USE MODI_GAMMA
+USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
+ ! activation by radiative
+ ! tendency
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KMI ! Model index
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
+ ! the output FM file
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZT ! Temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZTM ! Temperature at time t-dt
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+ ! the nucleation param.
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at t-dt
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+!
+REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFS ! CCN C. available source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAS ! CCN C. activated source
+!
+!
+!* 0.1 Declarations of local variables :
+!
+! Packing variables
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: GNUCT
+INTEGER :: INUCT
+INTEGER , DIMENSION(SIZE(GNUCT)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+!
+! Packed micophysical variables
+REAL, DIMENSION(:) , ALLOCATABLE :: ZCCS ! cloud conc. source
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFS ! available nucleus conc. source
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNAS ! activated nucleus conc. source
+!
+! Other packed variables
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRHODREF ! RHO Dry REFerence
+REAL, DIMENSION(:) , ALLOCATABLE :: ZEXNREF ! EXNer Pressure REFerence
+REAL, DIMENSION(:) , ALLOCATABLE :: ZZT ! Temperature
+!
+! Work arrays
+REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4, ZZW5, ZZW6, &
+ ZCTMIN, &
+ ZZTDT, & ! dT/dt
+ ZSMAX, & ! Maximum supersaturation
+ ZVEC1
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTMP, ZCHEN_MULTI
+!
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZTDT, ZDRC, ZRVSAT, ZW
+REAL, DIMENSION(SIZE(PNFS,1),SIZE(PNFS,2),SIZE(PNFS,3)) &
+ :: ZCONC_TOT ! total CCN C. available
+!
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1 ! Vectors of indices for
+ ! interpolations
+!
+!
+REAL :: ZEPS ! molar mass ratio
+REAL :: ZS1, ZS2, ZXACC
+INTEGER :: JMOD
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. PREPARE COMPUTATIONS - PACK
+! ---------------------------
+!
+!
+IIB=1+JPHEXT
+IIE=SIZE(PRHODREF,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PRHODREF,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PRHODREF,3) - JPVEXT
+!
+!++cb++
+!ALLOCATE(ZRTMIN(SIZE(XRTMIN)))
+!--cb--
+ALLOCATE(ZCTMIN(SIZE(XCTMIN)))
+!++cb++
+!ZRTMIN(:) = XRTMIN(:) / PTSTEP
+!--cb--
+ZCTMIN(:) = XCTMIN(:) / PTSTEP
+!
+! Saturation vapor mixing ratio and radiative tendency
+!
+ZEPS= XMV / XMD
+!
+ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:) * &
+ EXP(-XALPW+XBETAW/ZT(:,:,:)+XGAMW*ALOG(ZT(:,:,:))) - 1.0)
+ZTDT(:,:,:) = 0.
+ZDRC(:,:,:) = 0.
+IF (OACTIT) THEN
+ ZTDT(:,:,:) = (ZT(:,:,:)-ZTM(:,:,:))/PTSTEP ! dT/dt
+!!! JPP
+!!! JPP
+!!! ZDRC(:,:,:) = (PRCT(:,:,:)-PRCM(:,:,:))/PTSTEP ! drc/dt
+ ZDRC(:,:,:) = PRCS(:,:,:)-(PRCT(:,:,:)/PTSTEP) ! drc/dt
+!!! JPP
+!!! JPP
+ ZTDT(:,:,:) = MIN(0.,ZTDT(:,:,:)+(XG*PW_NU(:,:,:))/XCPD- &
+ (XLVTT+(XCPV-XCL)*(ZT(:,:,:)-XTT))*ZDRC(:,:,:)/XCPD)
+END IF
+!
+! find locations where CCN are available
+!
+ZCONC_TOT(:,:,:) = 0.0
+DO JMOD = 1, NMOD_CCN
+ ZCONC_TOT(:,:,:) = ZCONC_TOT(:,:,:) + PNFS(:,:,:,JMOD) ! sum over the free CCN
+ENDDO
+!
+! optimization by looking for locations where
+! the updraft velocity is positive!!!
+!
+GNUCT(:,:,:) = .FALSE.
+!
+! NEW : -22°C = limit sup for condensation freezing in Fridlin et al., 2007
+IF( OACTIT ) THEN
+ GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = (PW_NU(IIB:IIE,IJB:IJE,IKB:IKE)>XWMIN .OR. &
+ ZTDT(IIB:IIE,IJB:IJE,IKB:IKE)<XTMIN) .AND.&
+ PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>(0.98*ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE))&
+ .AND. ZT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
+ .AND. ZCONC_TOT(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(4)
+ELSE
+ GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = PW_NU(IIB:IIE,IJB:IJE,IKB:IKE)>XWMIN .AND.&
+ PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>(0.98*ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE))&
+ .AND. ZT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
+ .AND. ZCONC_TOT(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(4)
+END IF
+INUCT = COUNTJV( GNUCT(:,:,:),I1(:),I2(:),I3(:))
+!
+!
+IF( INUCT >= 1 ) THEN
+!
+ ALLOCATE(ZNFS(INUCT,NMOD_CCN))
+ ALLOCATE(ZNAS(INUCT,NMOD_CCN))
+ ALLOCATE(ZTMP(INUCT,NMOD_CCN))
+ ALLOCATE(ZCCS(INUCT))
+ ALLOCATE(ZZT(INUCT))
+ ALLOCATE(ZZTDT(INUCT))
+ ALLOCATE(ZZW1(INUCT))
+ ALLOCATE(ZZW2(INUCT))
+ ALLOCATE(ZZW3(INUCT))
+ ALLOCATE(ZZW4(INUCT))
+ ALLOCATE(ZZW5(INUCT))
+ ALLOCATE(ZZW6(INUCT))
+ ALLOCATE(ZCHEN_MULTI(INUCT,NMOD_CCN))
+ ALLOCATE(ZVEC1(INUCT))
+ ALLOCATE(IVEC1(INUCT))
+ ALLOCATE(ZRHODREF(INUCT))
+ ALLOCATE(ZEXNREF(INUCT))
+ DO JL=1,INUCT
+ ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZZW1(JL) = ZRVSAT(I1(JL),I2(JL),I3(JL))
+ ZZW2(JL) = PW_NU(I1(JL),I2(JL),I3(JL))
+ ZZTDT(JL) = ZTDT(I1(JL),I2(JL),I3(JL))
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ DO JMOD = 1,NMOD_CCN
+ ZNFS(JL,JMOD) = PNFS(I1(JL),I2(JL),I3(JL),JMOD)
+ ZNAS(JL,JMOD) = PNAS(I1(JL),I2(JL),I3(JL),JMOD)
+ ZCHEN_MULTI(JL,JMOD) = (ZNFS(JL,JMOD)+ZNAS(JL,JMOD))*PTSTEP*ZRHODREF(JL) &
+ / XLIMIT_FACTOR(JMOD)
+ ENDDO
+ ENDDO
+!
+ ZZW1(:) = 1.0/ZEPS + 1.0/ZZW1(:) &
+ + (((XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZT(:))**2)/(XCPD*XRV) ! Psi2
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. compute the constant term (ZZW3) relative to smax
+! ----------------------------------------------------
+!
+! Remark : in LIMA's nucleation parameterization, Smax=0.01 for a supersaturation of 1% !
+!
+!
+ ZVEC1(:) = MAX( 1.00001, MIN( FLOAT(NAHEN)-0.00001, &
+ XAHENINTP1 * ZZT(:) + XAHENINTP2 ) )
+ IVEC1(:) = INT( ZVEC1(:) )
+ ZVEC1(:) = ZVEC1(:) - FLOAT( IVEC1(:) )
+ ALLOCATE(ZSMAX(INUCT))
+!
+!
+ IF (OACTIT) THEN ! including a cooling rate
+!
+! Compute the tabulation of function of ZZW3 :
+!
+! (Psi1*w+Psi3*DT/Dt)**1.5
+! ZZW3 = XAHENG*(Psi1*w + Psi3*DT/Dt)**1.5 = ------------------------
+! 2*pi*rho_l*G**(3/2)
+!
+!
+ ZZW4(:)=XPSI1( IVEC1(:)+1)*ZZW2(:)+XPSI3(IVEC1(:)+1)*ZZTDT(:)
+ ZZW5(:)=XPSI1( IVEC1(:) )*ZZW2(:)+XPSI3(IVEC1(:) )*ZZTDT(:)
+ WHERE (ZZW4(:) < 0. .OR. ZZW5(:) < 0.)
+ ZZW4(:) = 0.
+ ZZW5(:) = 0.
+ END WHERE
+ ZZW3(:) = XAHENG( IVEC1(:)+1)*(ZZW4(:)**1.5)* ZVEC1(:) &
+ - XAHENG( IVEC1(:) )*(ZZW5(:)**1.5)*(ZVEC1(:) - 1.0)
+ ! Cste*((Psi1*w+Psi3*dT/dt)/(G))**1.5
+!
+!
+ ELSE ! OACTIT , for clouds
+!
+!
+! Compute the tabulation of function of ZZW3 :
+!
+! (Psi1 * w)**1.5
+! ZZW3 = XAHENG * (Psi1 * w)**1.5 = -------------------------
+! 2 pi rho_l * G**(3/2)
+!
+!
+ ZZW3(:)=XAHENG(IVEC1(:)+1)*((XPSI1(IVEC1(:)+1)*ZZW2(:))**1.5)* ZVEC1(:) &
+ -XAHENG(IVEC1(:) )*((XPSI1(IVEC1(:) )*ZZW2(:))**1.5)*(ZVEC1(:)-1.0)
+!
+ END IF ! OACTIT
+!
+!
+! (Psi1*w+Psi3*DT/Dt)**1.5 rho_air
+! ZZW3 = ------------------------ * -------
+! 2*pi*rho_l*G**(3/2) Psi2
+!
+ ZZW5(:) = 1.
+ ZZW3(:) = (ZZW3(:)/ZZW1(:))*ZRHODREF(:) ! R.H.S. of Eq 9 of CPB 98 but
+ ! for multiple aerosol modes
+ WHERE (ZZW3(:) == 0.)
+ ZZW5(:) = -1.
+ END WHERE
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3. Compute the maximum of supersaturation
+! -----------------------------------------
+!
+!
+! estimate S_max for the CPB98 parameterization with SEVERAL aerosols mode
+! Reminder : Smax=0.01 for a 1% supersaturation
+!
+! Interval bounds to tabulate sursaturation Smax
+! Check with values used for tabulation in ini_lima_warm.f90
+ ZS1 = 1.0E-5 ! corresponds to 0.001% supersaturation
+ ZS2 = 5.0E-2 ! corresponds to 5.0% supersaturation
+ ZXACC = 1.0E-7 ! Accuracy needed for the search in [NO UNITS]
+!
+ ZSMAX(:) = ZRIDDR(ZS1,ZS2,ZXACC,ZZW3(:),INUCT) ! ZSMAX(:) is in [NO UNITS]
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 4. Compute the nucleus source
+! -----------------------------
+!
+!
+! Again : Smax=0.01 for a 1% supersaturation
+! Modified values for Beta and C (see in init_aerosol_properties) account for that
+!
+ WHERE (ZZW5(:) > 0. .AND. ZSMAX(:) > 0.)
+ ZVEC1(:) = MAX( 1.00001, MIN( FLOAT(NHYP)-0.00001, &
+ XHYPINTP1*LOG(ZSMAX(:))+XHYPINTP2 ) )
+ IVEC1(:) = INT( ZVEC1(:) )
+ ZVEC1(:) = ZVEC1(:) - FLOAT( IVEC1(:) )
+ END WHERE
+ ZZW6(:) = 0. ! initialize the change of cloud droplet concentration
+!
+ ZTMP(:,:)=0.0
+!
+! Compute the concentration of activable aerosols for each mode
+! based on the max of supersaturation ( -> ZTMP )
+!
+ DO JMOD = 1, NMOD_CCN ! iteration on mode number
+ ZZW1(:) = 0.
+ ZZW2(:) = 0.
+ ZZW3(:) = 0.
+ !
+ WHERE( ZSMAX(:)>0.0 )
+ ZZW2(:) = XHYPF12( IVEC1(:)+1,JMOD )* ZVEC1(:) & ! hypergeo function
+ - XHYPF12( IVEC1(:) ,JMOD )*(ZVEC1(:) - 1.0) ! XHYPF12 is tabulated
+ !
+ ZTMP(:,JMOD) = (ZCHEN_MULTI(:,JMOD)/ZRHODREF(:))*ZSMAX(:)**XKHEN_MULTI(JMOD) &
+ *ZZW2(:)/PTSTEP
+ ENDWHERE
+ ENDDO
+!
+! Compute the concentration of aerosols activated at this time step
+! as the difference between ZTMP and the aerosols already activated at t-dt (ZZW1)
+!
+ DO JMOD = 1, NMOD_CCN ! iteration on mode number
+ ZZW1(:) = 0.
+ ZZW2(:) = 0.
+ ZZW3(:) = 0.
+ !
+ WHERE( SUM(ZTMP(:,:),DIM=2)*PTSTEP .GT. 25.E6/ZRHODREF(:) )
+ ZZW1(:) = MIN( ZNFS(:,JMOD),MAX( ZTMP(:,JMOD)- ZNAS(:,JMOD) , 0.0 ) )
+ ENDWHERE
+ !
+ !* update the concentration of activated CCN = Na
+ !
+ PNAS(:,:,:,JMOD) = PNAS(:,:,:,JMOD) + &
+ UNPACK( ZZW1(:), MASK=GNUCT(:,:,:), FIELD=0.0 )
+ !
+ !* update the concentration of free CCN = Nf
+ !
+ PNFS(:,:,:,JMOD) = PNFS(:,:,:,JMOD) - &
+ UNPACK( ZZW1(:), MASK=GNUCT(:,:,:), FIELD=0.0 )
+ !
+ !* prepare to update the cloud water concentration
+ !
+ ZZW6(:) = ZZW6(:) + ZZW1(:)
+ ENDDO
+!
+! Update PRVS, PRCS, PCCS, and PTHS
+!
+ ZZW1(:)=0.
+ WHERE (ZZW5(:)>0.0 .AND. ZSMAX(:)>0.0) ! ZZW1 is computed with ZSMAX [NO UNIT]
+ ZZW1(:) = MIN(XCSTDCRIT*ZZW6(:)/(((ZZT(:)*ZSMAX(:))**3)*ZRHODREF(:)),1.E-5)
+ END WHERE
+ ZW(:,:,:) = MIN( UNPACK( ZZW1(:),MASK=GNUCT(:,:,:),FIELD=0.0 ),PRVS(:,:,:) )
+!
+ PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
+ PRCS(:,:,:) = PRCS(:,:,:) + ZW(:,:,:)
+ ZW(:,:,:) = ZW(:,:,:) * (XLVTT+(XCPV-XCL)*(ZT(:,:,:)-XTT))/ &
+ (PEXNREF(:,:,:)*(XCPD+XCPV*PRVT(:,:,:)+XCL*(PRCT(:,:,:)+PRRT(:,:,:))))
+ PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)
+!
+ ZW(:,:,:) = PCCS(:,:,:)
+ PCCS(:,:,:) = UNPACK( ZZW6(:)+ZCCS(:),MASK=GNUCT(:,:,:),FIELD=ZW(:,:,:) )
+!
+ ZW(:,:,:) = UNPACK( 100.0*ZSMAX(:),MASK=GNUCT(:,:,:),FIELD=0.0 )
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 5. Cleaning
+! -----------
+!
+!
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC1)
+ DEALLOCATE(ZNFS)
+ DEALLOCATE(ZNAS)
+ DEALLOCATE(ZCCS)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZSMAX)
+ DEALLOCATE(ZZW1)
+ DEALLOCATE(ZZW2)
+ DEALLOCATE(ZZW3)
+ DEALLOCATE(ZZW4)
+ DEALLOCATE(ZZW5)
+ DEALLOCATE(ZZW6)
+ DEALLOCATE(ZZTDT)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZCHEN_MULTI)
+ DEALLOCATE(ZEXNREF)
+!
+END IF ! INUCT
+!
+!++cb++
+DEALLOCATE(ZCTMIN)
+!--cb--
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 6. Functions used to compute the maximum of supersaturation
+! -----------------------------------------------------------
+!
+!
+CONTAINS
+!------------------------------------------------------------------------------
+!
+ FUNCTION ZRIDDR(PX1,PX2INIT,PXACC,PZZW3,NPTS) RESULT(PZRIDDR)
+!
+!
+!!**** *ZRIDDR* - iterative algorithm to find root of a function
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this function is to find the root of a given function
+!! the arguments are the brackets bounds (the interval where to find the root)
+!! the accuracy needed and the input parameters of the given function.
+!! Using Ridders' method, return the root of a function known to lie between
+!! PX1 and PX2. The root, returned as PZRIDDR, will be refined to an approximate
+!! accuracy PXACC.
+!!
+!!** METHOD
+!! ------
+!! Ridders' method
+!!
+!! EXTERNAL
+!! --------
+!! FUNCSMAX
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!! NUMERICAL RECIPES IN FORTRAN 77: THE ART OF SCIENTIFIC COMPUTING
+!! (ISBN 0-521-43064-X)
+!! Copyright (C) 1986-1992 by Cambridge University Press.
+!! Programs Copyright (C) 1986-1992 by Numerical Recipes Software.
+!!
+!! AUTHOR
+!! ------
+!! Frederick Chosson *CERFACS*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 12/07/07
+!! S.BERTHET 2008 vectorization
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN) :: NPTS
+REAL, DIMENSION(:), INTENT(IN) :: PZZW3
+REAL, INTENT(IN) :: PX1, PX2INIT, PXACC
+REAL, DIMENSION(:), ALLOCATABLE :: PZRIDDR
+!
+!* 0.2 declarations of local variables
+!
+!
+INTEGER, PARAMETER :: MAXIT=60
+REAL, PARAMETER :: UNUSED=0.0 !-1.11e30
+REAL, DIMENSION(:), ALLOCATABLE :: fh,fl, fm,fnew
+REAL :: s,xh,xl,xm,xnew
+REAL :: PX2
+INTEGER :: j, JL
+!
+ALLOCATE( fh(NPTS))
+ALLOCATE( fl(NPTS))
+ALLOCATE( fm(NPTS))
+ALLOCATE(fnew(NPTS))
+ALLOCATE(PZRIDDR(NPTS))
+!
+PZRIDDR(:)= UNUSED
+PX2 = PX2INIT
+fl(:) = FUNCSMAX(PX1,PZZW3(:),NPTS)
+fh(:) = FUNCSMAX(PX2,PZZW3(:),NPTS)
+!
+DO JL = 1, NPTS
+ PX2 = PX2INIT
+100 if ((fl(JL) > 0.0 .and. fh(JL) < 0.0) .or. (fl(JL) < 0.0 .and. fh(JL) > 0.0)) then
+ xl = PX1
+ xh = PX2
+ do j=1,MAXIT
+ xm = 0.5*(xl+xh)
+ fm(JL) = SINGL_FUNCSMAX(xm,PZZW3(JL),JL)
+ s = sqrt(fm(JL)**2-fl(JL)*fh(JL))
+ if (s == 0.0) then
+ GO TO 101
+ endif
+ xnew = xm+(xm-xl)*(sign(1.0,fl(JL)-fh(JL))*fm(JL)/s)
+ if (abs(xnew - PZRIDDR(JL)) <= PXACC) then
+ GO TO 101
+ endif
+ PZRIDDR(JL) = xnew
+ fnew(JL) = SINGL_FUNCSMAX(PZRIDDR(JL),PZZW3(JL),JL)
+ if (fnew(JL) == 0.0) then
+ GO TO 101
+ endif
+ if (sign(fm(JL),fnew(JL)) /= fm(JL)) then
+ xl =xm
+ fl(JL)=fm(JL)
+ xh =PZRIDDR(JL)
+ fh(JL)=fnew(JL)
+ else if (sign(fl(JL),fnew(JL)) /= fl(JL)) then
+ xh =PZRIDDR(JL)
+ fh(JL)=fnew(JL)
+ else if (sign(fh(JL),fnew(JL)) /= fh(JL)) then
+ xl =PZRIDDR(JL)
+ fl(JL)=fnew(JL)
+ else if (PX2 .lt. 0.05) then
+ PX2 = PX2 + 1.0E-2
+ PRINT*, 'PX2 ALWAYS too small, we put a greater one : PX2 =',PX2
+ fh(JL) = SINGL_FUNCSMAX(PX2,PZZW3(JL),JL)
+ go to 100
+ print*, 'PZRIDDR: never get here'
+ STOP
+ end if
+ if (abs(xh-xl) <= PXACC) then
+ GO TO 101
+ endif
+!!SB
+!!$ if (j == MAXIT .and. (abs(xh-xl) > PXACC) ) then
+!!$ PZRIDDR(JL)=0.0
+!!$ go to 101
+!!$ endif
+!!SB
+ end do
+ print*, 'PZRIDDR: exceeded maximum iterations',j
+ STOP
+ else if (fl(JL) == 0.0) then
+ PZRIDDR(JL)=PX1
+ else if (fh(JL) == 0.0) then
+ PZRIDDR(JL)=PX2
+ else if (PX2 .lt. 0.05) then
+ PX2 = PX2 + 1.0E-2
+ PRINT*, 'PX2 too small, we put a greater one : PX2 =',PX2
+ fh(JL) = SINGL_FUNCSMAX(PX2,PZZW3(JL),JL)
+ go to 100
+ else
+!!$ print*, 'PZRIDDR: root must be bracketed'
+!!$ print*,'npts ',NPTS,'jl',JL
+!!$ print*, 'PX1,PX2,fl,fh',PX1,PX2,fl(JL),fh(JL)
+!!$ print*, 'PX2 = 30 % of supersaturation, there is no solution for Smax'
+!!$ print*, 'try to put greater PX2 (upper bound for Smax research)'
+!!$ STOP
+ PZRIDDR(JL)=0.0
+ go to 101
+ end if
+101 ENDDO
+!
+DEALLOCATE( fh)
+DEALLOCATE( fl)
+DEALLOCATE( fm)
+DEALLOCATE(fnew)
+!
+END FUNCTION ZRIDDR
+!
+!------------------------------------------------------------------------------
+!
+ FUNCTION FUNCSMAX(PPZSMAX,PPZZW3,NPTS) RESULT(PFUNCSMAX)
+!
+!
+!!**** *FUNCSMAX* - function describing SMAX function that you want to find the root
+!!
+!!
+!! PURPOSE
+!! -------
+!! This function describe the equilibrium between Smax and two aerosol mode
+!! acting as CCN. This function is derive from eq. (9) of CPB98 but for two
+!! aerosols mode described by their respective parameters C, k, Mu, Beta.
+!! the arguments are the supersaturation in "no unit" and the r.h.s. of this eq.
+!! and the ratio of concentration of injected aerosols on maximum concentration
+!! of injected aerosols ever.
+!!** METHOD
+!! ------
+!! This function is called by zriddr.f90
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAM_LIMA_WARM
+!! XHYPF32
+!!
+!! XHYPINTP1
+!! XHYPINTP2
+!!
+!! Module MODD_PARAM_C2R2
+!! XKHEN_MULTI()
+!! NMOD_CCN
+!!
+!! REFERENCE
+!! ---------
+!! Cohard, J.M., J.P.Pinty, K.Suhre, 2000:"On the parameterization of activation
+!! spectra from cloud condensation nuclei microphysical properties",
+!! J. Geophys. Res., Vol.105, N0.D9, pp. 11753-11766
+!!
+!! AUTHOR
+!! ------
+!! Frederick Chosson *CERFACS*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 12/07/07
+!! S.Berthet 19/03/08 Extension a une population multimodale d aerosols
+!
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN) :: NPTS
+REAL, INTENT(IN) :: PPZSMAX ! supersaturation is already in no units
+REAL, DIMENSION(:), INTENT(IN) :: PPZZW3 !
+REAL, DIMENSION(:), ALLOCATABLE :: PFUNCSMAX !
+!
+!* 0.2 declarations of local variables
+!
+REAL :: ZHYPF
+!
+REAL :: PZVEC1
+INTEGER :: PIVEC1
+!
+ALLOCATE(PFUNCSMAX(NPTS))
+!
+PFUNCSMAX(:) = 0.
+PZVEC1 = MAX( 1.00001,MIN( FLOAT(NHYP)-0.00001, &
+ XHYPINTP1*LOG(PPZSMAX)+XHYPINTP2 ) )
+PIVEC1 = INT( PZVEC1 )
+PZVEC1 = PZVEC1 - FLOAT( PIVEC1 )
+DO JMOD = 1, NMOD_CCN
+ ZHYPF = 0. ! XHYPF32 is tabulated with ZSMAX in [NO UNITS]
+ ZHYPF = XHYPF32( PIVEC1+1,JMOD ) * PZVEC1 &
+ - XHYPF32( PIVEC1 ,JMOD ) *(PZVEC1 - 1.0)
+ ! sum of s**(ki+2) * F32 * Ci * ki * beta(ki/2,3/2)
+ PFUNCSMAX(:) = PFUNCSMAX(:) + (PPZSMAX)**(XKHEN_MULTI(JMOD) + 2) &
+ * ZHYPF* XKHEN_MULTI(JMOD) * ZCHEN_MULTI(:,JMOD) &
+ * GAMMA_X0D( XKHEN_MULTI(JMOD)/2.0)*GAMMA_X0D(3.0/2.0) &
+ / GAMMA_X0D((XKHEN_MULTI(JMOD)+3.0)/2.0)
+ENDDO
+! function l.h.s. minus r.h.s. of eq. (9) of CPB98 but for NMOD_CCN aerosol mode
+PFUNCSMAX(:) = PFUNCSMAX(:) - PPZZW3(:)
+!
+END FUNCTION FUNCSMAX
+!
+!------------------------------------------------------------------------------
+!
+ FUNCTION SINGL_FUNCSMAX(PPZSMAX,PPZZW3,KINDEX) RESULT(PSINGL_FUNCSMAX)
+!
+!
+!!**** *SINGL_FUNCSMAX* - same function as FUNCSMAX
+!!
+!!
+!! PURPOSE
+!! -------
+! As for FUNCSMAX but for a scalar
+!!
+!!** METHOD
+!! ------
+!! This function is called by zriddr.f90
+!!
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN) :: KINDEX
+REAL, INTENT(IN) :: PPZSMAX ! supersaturation is "no unit"
+REAL, INTENT(IN) :: PPZZW3 !
+REAL :: PSINGL_FUNCSMAX !
+!
+!* 0.2 declarations of local variables
+!
+REAL :: ZHYPF
+!
+REAL :: PZVEC1
+INTEGER :: PIVEC1
+!
+PSINGL_FUNCSMAX = 0.
+PZVEC1 = MAX( 1.00001,MIN( FLOAT(NHYP)-0.00001, &
+ XHYPINTP1*LOG(PPZSMAX)+XHYPINTP2 ) )
+PIVEC1 = INT( PZVEC1 )
+PZVEC1 = PZVEC1 - FLOAT( PIVEC1 )
+DO JMOD = 1, NMOD_CCN
+ ZHYPF = 0. ! XHYPF32 is tabulated with ZSMAX in [NO UNITS]
+ ZHYPF = XHYPF32( PIVEC1+1,JMOD ) * PZVEC1 &
+ - XHYPF32( PIVEC1 ,JMOD ) *(PZVEC1 - 1.0)
+ ! sum of s**(ki+2) * F32 * Ci * ki * bêta(ki/2,3/2)
+ PSINGL_FUNCSMAX = PSINGL_FUNCSMAX + (PPZSMAX)**(XKHEN_MULTI(JMOD) + 2) &
+ * ZHYPF* XKHEN_MULTI(JMOD) * ZCHEN_MULTI(KINDEX,JMOD) &
+ * GAMMA_X0D( XKHEN_MULTI(JMOD)/2.0)*GAMMA_X0D(3.0/2.0) &
+ / GAMMA_X0D((XKHEN_MULTI(JMOD)+3.0)/2.0)
+ENDDO
+! function l.h.s. minus r.h.s. of eq. (9) of CPB98 but for NMOD_CCN aerosol mode
+PSINGL_FUNCSMAX = PSINGL_FUNCSMAX - PPZZW3
+!
+END FUNCTION SINGL_FUNCSMAX
+!
+!-----------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_WARM_NUCL
diff --git a/src/MNH/lima_warm_sedim.f90 b/src/MNH/lima_warm_sedim.f90
new file mode 100644
index 000000000..416291ed8
--- /dev/null
+++ b/src/MNH/lima_warm_sedim.f90
@@ -0,0 +1,397 @@
+! ###########################
+ MODULE MODI_LIMA_WARM_SEDIM
+! ###########################
+!
+INTERFACE
+ SUBROUTINE LIMA_WARM_SEDIM (OSEDC, KSPLITR, PTSTEP, KMI, &
+ HFMFILE, HLUOUT, OCLOSE_OUT, &
+ PZZ, PRHODREF, PPABST, ZT, &
+ ZWLBDC, &
+ PRCT, PRRT, PCCT, PCRT, &
+ PRCS, PRRS, PCCS, PCRS, &
+ PINPRC, PINPRR, PINPRR3D )
+!
+LOGICAL, INTENT(IN) :: OSEDC ! switch to activate the
+ ! cloud droplet sedimentation
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! for sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KMI ! Model index
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
+ ! the tput FM fileoutp
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZT ! Temperature
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDC ! libre parcours moyen
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! Rain inst precip 3D
+!
+END SUBROUTINE LIMA_WARM_SEDIM
+END INTERFACE
+END MODULE MODI_LIMA_WARM_SEDIM
+! #####################################################################
+ SUBROUTINE LIMA_WARM_SEDIM (OSEDC, KSPLITR, PTSTEP, KMI, &
+ HFMFILE, HLUOUT, OCLOSE_OUT, &
+ PZZ, PRHODREF, PPABST, ZT, &
+ ZWLBDC, &
+ PRCT, PRRT, PCCT, PCRT, &
+ PRCS, PRRS, PCCS, PCRS, &
+ PINPRC, PINPRR, PINPRR3D )
+! #####################################################################
+!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the sedimentation
+!! of cloud droplets and rain drops
+!!
+!!
+!!** METHOD
+!! ------
+!! The sedimentation rates are computed with a time spliting technique:
+!! an upstream scheme, written as a difference of non-advective fluxes.
+!! This source term is added to the next coming time step (split-implicit
+!! process).
+!!
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
+!! microphysical bulk scheme.
+!! Part I: Description and tests
+!! Part II: 2D experiments with a non-hydrostatic model
+!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!!
+!-------------------------------------------------------------------------------
+!
+!* 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, &
+ XFSEDRC, XFSEDCC, XFSEDRR, XFSEDCR,&
+ XDC, XDR
+USE MODI_LIMA_FUNCTIONS, ONLY : COUNTJV
+USE MODI_GAMMA, ONLY : GAMMA_X0D
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, INTENT(IN) :: OSEDC ! switch to activate the
+ ! cloud droplet sedimentation
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! for sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KMI ! Model index
+CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output FM-file
+CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
+ ! model n
+LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
+ ! the tput FM fileoutp
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZT ! Temperature
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZWLBDC ! libre parcours moyen
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! Rain inst precip 3D
+!
+!
+!* 0.2 Declarations of local variables :
+!
+! Packing variables
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: GSEDIM
+INTEGER :: ISEDIM
+INTEGER , DIMENSION(SIZE(GSEDIM)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+!
+! Packed micophysical variables
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(:) , ALLOCATABLE :: ZCCT ! cloud conc. at t
+REAL, DIMENSION(:) , ALLOCATABLE :: ZCRT ! rain conc. at t
+!
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRCS ! Cloud water m.r. source
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRRS ! Rain water m.r. source
+REAL, DIMENSION(:) , ALLOCATABLE :: ZCCS ! cloud conc. source
+REAL, DIMENSION(:) , ALLOCATABLE :: ZCRS ! rain conc. source
+!
+! Other packed variables
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRHODREF ! RHO Dry REFerence
+REAL, DIMENSION(:) , ALLOCATABLE :: ZLBDC
+REAL, DIMENSION(:) , ALLOCATABLE :: ZLBDR
+!
+! Work arrays
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: ZW, &
+ ZWLBDA, & ! Mean free path
+ ZWSEDR, ZWSEDC, & ! Sedim. fluxes
+ ZRAY, & ! Mean volumic radius
+ ZCC ! Terminal vertical velocity
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, &
+ ZTCC, &
+ ZRTMIN, ZCTMIN
+!
+!
+INTEGER :: JK ! Vertical loop index for the rain sedimentation
+INTEGER :: JN ! Temporal loop index for the rain sedimentation
+INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
+REAL :: ZTSPLITR ! Small time step for rain sedimentation
+!
+!-------------------------------------------------------------------------------
+!
+! 0. Prepare computations
+! -----------------------
+!
+!
+ALLOCATE(ZRTMIN(SIZE(XCTMIN)))
+ALLOCATE(ZCTMIN(SIZE(XCTMIN)))
+ZRTMIN(:) = XRTMIN(:) / PTSTEP
+ZCTMIN(:) = XCTMIN(:) / PTSTEP
+!
+IIB=1+JPHEXT
+IIE=SIZE(PZZ,1) - JPHEXT
+IJB=1+JPHEXT
+IJE=SIZE(PZZ,2) - JPHEXT
+IKB=1+JPVEXT
+IKE=SIZE(PZZ,3) - JPVEXT
+!
+ZTSPLITR= PTSTEP / FLOAT(KSPLITR)
+!
+IF (OSEDC) THEN
+ ZWLBDA(:,:,:) = 0.
+ ZRAY(:,:,:) = 0.
+ ZCC(:,:,:) = 1.
+ DO JK=IKB,IKE
+ ZWLBDA(:,:,JK) = 6.6E-8*(101325./PPABST(:,:,JK))*(ZT(:,:,JK)/293.15)
+ END DO
+ WHERE (PRCT(:,:,:)>XRTMIN(2) .AND. PCCT(:,:,:)>XCTMIN(2))
+ ZRAY(:,:,:) = 0.5*GAMMA_X0D(XNUC+1./XALPHAC)/(GAMMA_X0D(XNUC)*ZWLBDC(:,:,:))
+ ! ZCC : Corrective Cunningham term for the terminal velocity
+ ZCC(:,:,:)=1.+1.26*ZWLBDA(:,:,:)/ZRAY(:,:,:)
+ END WHERE
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+! 1. Computations only where necessary
+! ------------------------------------
+!
+!
+DO JN = 1 , KSPLITR
+ GSEDIM(:,:,:) = .FALSE.
+ GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = PRRS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(3) &
+ .AND. PCRS(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(3)
+ IF( OSEDC ) THEN
+ GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) .OR. &
+ (PRCS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(2) &
+ .AND. PCCS(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(2) )
+ END IF
+!
+ ISEDIM = COUNTJV( GSEDIM(:,:,:),I1(:),I2(:),I3(:))
+ IF( ISEDIM >= 1 ) THEN
+!
+ IF( JN==1 ) THEN
+ IF( OSEDC ) THEN
+ PRCS(:,:,:) = PRCS(:,:,:) * PTSTEP
+ PCCS(:,:,:) = PCCS(:,:,:) * PTSTEP
+ END IF
+ PRRS(:,:,:) = PRRS(:,:,:) * PTSTEP
+ PCRS(:,:,:) = PCRS(:,:,:) * PTSTEP
+ DO JK = IKB , IKE
+ ZW(:,:,JK)=ZTSPLITR/(PZZ(:,:,JK+1)-PZZ(:,:,JK))
+ END DO
+ END IF
+!
+ ALLOCATE(ZRHODREF(ISEDIM))
+ DO JL = 1,ISEDIM
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ END DO
+!
+ ALLOCATE(ZZW1(ISEDIM))
+ ALLOCATE(ZZW2(ISEDIM))
+ ALLOCATE(ZZW3(ISEDIM))
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+! 2. Cloud droplets sedimentation
+! -------------------------------
+!
+!
+ IF( OSEDC .AND. MAXVAL(PRCS(:,:,:))>ZRTMIN(2) ) THEN
+ ZZW1(:) = 0.0
+ ZZW2(:) = 0.0
+ ZZW3(:) = 0.0
+ ALLOCATE(ZRCS(ISEDIM))
+ ALLOCATE(ZCCS(ISEDIM))
+ ALLOCATE(ZRCT(ISEDIM))
+ ALLOCATE(ZCCT(ISEDIM))
+ ALLOCATE(ZTCC(ISEDIM))
+ ALLOCATE(ZLBDC(ISEDIM))
+ DO JL = 1,ISEDIM
+ ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
+ ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
+ ZTCC(JL) = ZCC (I1(JL),I2(JL),I3(JL))
+ END DO
+ ZLBDC(:) = 1.E15
+ WHERE (ZRCT(:)>XRTMIN(2) .AND. ZCCT(:)>XCTMIN(2))
+ ZLBDC(:) = ( XLBC*ZCCT(:) / ZRCT(:) )**XLBEXC
+ END WHERE
+ WHERE( ZRCS(:)>XRTMIN(2) )
+ ZZW3(:) = ZRHODREF(:)**(-XCEXVT) * ZLBDC(:)**(-XDC)
+ ZZW1(:) = ZTCC(:) * XFSEDRC * ZRCS(:) * ZZW3(:) * ZRHODREF(:)
+ ZZW2(:) = ZTCC(:) * XFSEDCC * ZCCS(:) * ZZW3(:) * ZRHODREF(:)
+ END WHERE
+ ZWSEDR(:,:,:) = UNPACK( ZZW1(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ ZWSEDC(:,:,:) = UNPACK( ZZW2(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ DO JK = IKB , IKE
+ PRCS(:,:,JK) = PRCS(:,:,JK) + ZW(:,:,JK)* &
+ (ZWSEDR(:,:,JK+1)-ZWSEDR(:,:,JK))/PRHODREF(:,:,JK)
+ PCCS(:,:,JK) = PCCS(:,:,JK) + ZW(:,:,JK)* &
+ (ZWSEDC(:,:,JK+1)-ZWSEDC(:,:,JK))/PRHODREF(:,:,JK)
+ END DO
+ DEALLOCATE(ZRCS)
+ DEALLOCATE(ZCCS)
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZCCT)
+ DEALLOCATE(ZTCC)
+ DEALLOCATE(ZLBDC)
+!
+ PINPRC(:,:) = ZWSEDR(:,:,IKB)/XRHOLW ! in m/s
+ ELSE
+ ZWSEDR(:,:,IKB) = 0.0
+ END IF ! OSEDC
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+! 2. Rain drops sedimentation
+! ---------------------------
+!
+!
+ IF( MAXVAL(PRRS(:,:,:))>ZRTMIN(3) ) THEN
+ ZZW1(:) = 0.0
+ ZZW2(:) = 0.0
+ ZZW3(:) = 0.0
+ ALLOCATE(ZRRS(ISEDIM))
+ ALLOCATE(ZCRS(ISEDIM))
+ ALLOCATE(ZRRT(ISEDIM))
+ ALLOCATE(ZCRT(ISEDIM))
+ ALLOCATE(ZLBDR(ISEDIM))
+ DO JL = 1,ISEDIM
+ ZRRS(JL) = PRRS(I1(JL),I2(JL),I3(JL))
+ ZCRS(JL) = PCRS(I1(JL),I2(JL),I3(JL))
+ ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
+ ZCRT(JL) = PCRT(I1(JL),I2(JL),I3(JL))
+ END DO
+ ZLBDR(:) = 1.E10
+ WHERE (ZRRT(:)>XRTMIN(3) .AND. ZCRT(:)>XCTMIN(3))
+ ZLBDR(:) = ( XLBR*ZCRT(:) / ZRRT(:) )**XLBEXR
+ END WHERE
+ WHERE( ZRRS(:)>XRTMIN(3) )
+ ZZW3(:) = ZRHODREF(:)**(-XCEXVT) * (ZLBDR(:)**(-XDR))
+ ZZW1(:) = XFSEDRR * ZRRS(:) * ZZW3(:) * ZRHODREF(:)
+ ZZW2(:) = XFSEDCR * ZCRS(:) * ZZW3(:) * ZRHODREF(:)
+ END WHERE
+ ZWSEDR(:,:,:) = UNPACK( ZZW1(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ ZWSEDC(:,:,:) = UNPACK( ZZW2(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ DO JK = IKB , IKE
+ PRRS(:,:,JK) = PRRS(:,:,JK) + ZW(:,:,JK)* &
+ (ZWSEDR(:,:,JK+1)-ZWSEDR(:,:,JK))/PRHODREF(:,:,JK)
+ PCRS(:,:,JK) = PCRS(:,:,JK) + ZW(:,:,JK)* &
+ (ZWSEDC(:,:,JK+1)-ZWSEDC(:,:,JK))/PRHODREF(:,:,JK)
+ END DO
+ DEALLOCATE(ZRRS)
+ DEALLOCATE(ZCRS)
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZCRT)
+ DEALLOCATE(ZLBDR)
+ ELSE
+ ZWSEDR(:,:,IKB) = 0.0
+ END IF ! max PRRS > ZRTMIN(3)
+!
+ IF( JN.EQ.1 ) THEN
+ PINPRR(:,:) = ZWSEDR(:,:,IKB)/XRHOLW ! in m/s
+ PINPRR3D(:,:,:) = ZWSEDR(:,:,:)/XRHOLW ! in m/s
+ END IF
+!
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZW1)
+ DEALLOCATE(ZZW2)
+ DEALLOCATE(ZZW3)
+ IF( JN==KSPLITR ) THEN
+ IF( OSEDC ) THEN
+ PRCS(:,:,:) = PRCS(:,:,:) / PTSTEP
+ PCCS(:,:,:) = PCCS(:,:,:) / PTSTEP
+ END IF
+ PRRS(:,:,:) = PRRS(:,:,:) / PTSTEP
+ PCRS(:,:,:) = PCRS(:,:,:) / PTSTEP
+ END IF
+ END IF ! ISEDIM
+END DO ! KSPLITR
+!
+!++cb++
+DEALLOCATE(ZRTMIN)
+DEALLOCATE(ZCTMIN)
+!--cb--
+
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_WARM_SEDIM
diff --git a/src/MNH/modd_lima_precip_scavengingn.f90 b/src/MNH/modd_lima_precip_scavengingn.f90
new file mode 100644
index 000000000..a0866da9d
--- /dev/null
+++ b/src/MNH/modd_lima_precip_scavengingn.f90
@@ -0,0 +1,59 @@
+! ####################################
+ MODULE MODD_LIMA_PRECIP_SCAVENGING_n
+! ####################################
+!
+!!**** *MODD_PRECIP_SCAVENGING$n* - declaration of scavenged aerosols
+!! precipitating fields
+!!
+!! PURPOSE
+!! -------
+! Stores the INstantaneous and ACcumulated PRecipitating fields of
+!! scavenged aerosol by rain
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
+!
+IMPLICIT NONE
+!
+TYPE LIMA_PRECIP_SCAVENGING_t
+ REAL, DIMENSION(:,:), POINTER :: XINPAP=>NULL(), XACPAP=>NULL()
+ ! Instant and cumul of ground
+ ! precipitation fields of Scavenged
+ ! Aerosol Particles
+END TYPE LIMA_PRECIP_SCAVENGING_t
+
+TYPE(LIMA_PRECIP_SCAVENGING_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: PRECIP_SCAVENGING_MODEL
+
+REAL, DIMENSION(:,:), POINTER :: XINPAP=>NULL(), XACPAP=>NULL()
+
+CONTAINS
+
+SUBROUTINE LIMA_PRECIP_SCAVENGING_GOTO_MODEL(KFROM, KTO)
+ INTEGER, INTENT(IN) :: KFROM, KTO
+ !
+ ! Save current state for allocated arrays
+ PRECIP_SCAVENGING_MODEL(KFROM)%XINPAP=>XINPAP
+ PRECIP_SCAVENGING_MODEL(KFROM)%XACPAP=>XACPAP
+ !
+ ! Current model is set to model KTO
+ XINPAP=>PRECIP_SCAVENGING_MODEL(KTO)%XINPAP
+ XACPAP=>PRECIP_SCAVENGING_MODEL(KTO)%XACPAP
+ !
+END SUBROUTINE LIMA_PRECIP_SCAVENGING_GOTO_MODEL
+!
+!
+END MODULE MODD_LIMA_PRECIP_SCAVENGING_n
diff --git a/src/MNH/modd_param_lima.f90 b/src/MNH/modd_param_lima.f90
new file mode 100644
index 000000000..6c838bb17
--- /dev/null
+++ b/src/MNH/modd_param_lima.f90
@@ -0,0 +1,185 @@
+! ######################
+ MODULE MODD_PARAM_LIMA
+! ######################
+!
+!!**** *MODD_PARAM_LIMA* - declaration of the control parameters
+!! for use in the LIMA scheme.
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this declarative module is to declare the microphysical
+!! constants. This includes the descriptive parameters for the raindrop
+!! and the parameters relevant of the dimensional distributions.
+!!
+!!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty *Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODD_PARAMETERS, ONLY : JPLIMACCNMAX, JPLIMAIFNMAX
+!
+IMPLICIT NONE
+!
+LOGICAL, SAVE :: LLIMA_DIAG ! Compute diagnostics for concentration /m3
+!
+!* 1. COLD SCHEME
+! -----------
+!
+! 1.1 Cold scheme configuration
+!
+LOGICAL, SAVE :: LCOLD ! TRUE to enable the cold scheme
+LOGICAL, SAVE :: LNUCL ! TRUE to enable ice nucleation
+LOGICAL, SAVE :: LSEDI ! TRUE to enable pristine ice sedimentation
+LOGICAL, SAVE :: LHHONI ! TRUE to enable freezing of haze particules
+LOGICAL, SAVE :: LSNOW ! TRUE to enable snow and graupel
+LOGICAL, SAVE :: LHAIL ! TRUE to enable hail
+LOGICAL, SAVE :: LMEYERS ! TRUE to use Meyers nucleation
+!
+! 1.2 IFN initialisation
+!
+INTEGER, SAVE :: NMOD_IFN ! Number of IFN modes
+REAL, DIMENSION(JPLIMAIFNMAX), SAVE :: XIFN_CONC ! Ref. concentration of IFN(#/L)
+LOGICAL, SAVE :: LIFN_HOM ! True for z-homogeneous IFN concentrations
+CHARACTER(LEN=8), SAVE :: CIFN_SPECIES ! Internal mixing species definitions
+CHARACTER(LEN=8), SAVE :: CINT_MIXING ! Internal mixing type selection (pure DM1 ...)
+INTEGER, SAVE :: NMOD_IMM ! Number of CCN modes acting by immersion
+INTEGER, SAVE :: NIND_SPECIE ! CCN acting by immersion are considered pure
+ ! IFN of either DM = 1, BC = 2 or O = 3
+INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: NIMM ! Link between CCN and IMM modes
+INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: NINDICE_CCN_IMM ! ??????????
+INTEGER, SAVE :: NSPECIE ! Internal mixing number of species
+REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XMDIAM_IFN ! Mean diameter of IFN modes
+REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XSIGMA_IFN ! Sigma of IFN modes
+REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XRHO_IFN ! Density of IFN modes
+REAL, DIMENSION(:,:), SAVE, ALLOCATABLE :: XFRAC ! Composition of each IFN mode
+REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XFRAC_REF ! AP compostion in Phillips 08
+!
+! 1.3 Ice characteristics
+!
+CHARACTER(LEN=4), SAVE :: CPRISTINE_ICE_LIMA ! Pristine type PLAT, COLU or BURO
+CHARACTER(LEN=4), SAVE :: CHEVRIMED_ICE_LIMA ! Heavily rimed type GRAU or HAIL
+REAL,SAVE :: XALPHAI,XNUI, & ! Pristine ice distribution parameters
+ XALPHAS,XNUS, & ! Snow/aggregate distribution parameters
+ XALPHAG,XNUG ! Graupel distribution parameters
+!
+! 1.4 Phillips (2013) nucleation parameterization
+!
+INTEGER, SAVE :: NPHILLIPS ! =8 for Phillips08, =13 for Phillips13
+!
+REAL, DIMENSION(4), SAVE :: XT0 ! Threshold of T in H_X for X={DM1,DM2,BC,O} [K]
+REAL, DIMENSION(4), SAVE :: XDT0 ! Range in T for transition of H_X near XT0 [K]
+REAL, DIMENSION(4), SAVE :: XDSI0 ! Range in Si for transition of H_X near XSI0
+REAL, SAVE :: XSW0 ! Threshold of Sw in H_X
+REAL, SAVE :: XRHO_CFDC ! Air density at which CFDC data were reported [kg m**3]
+REAL, DIMENSION(4), SAVE :: XH ! Fraction<<1 of aerosol for X={DM,BC,O}
+REAL, DIMENSION(4), SAVE :: XAREA1 ! Total surface of all aerosols in group X with
+ ! diameters between 0.1 and 1 µm, for X={DM1,DM2,BC,O} [m**2 kg**-1]
+REAL, SAVE :: XGAMMA ! Factor boosting IN concentration due to
+ ! bulk-liquid modes
+!
+REAL, DIMENSION(4), SAVE :: XTX1 ! Threshold of T in Xi for X={DM1,DM2,BC,O} [K]
+REAL, DIMENSION(4), SAVE :: XTX2 ! Threshold of T in Xi for X={DM1,DM2,BC,O} [K]
+!
+REAL,DIMENSION(:), SAVE, ALLOCATABLE :: XABSCISS, XWEIGHT ! Gauss quadrature method
+INTEGER, SAVE :: NDIAM ! Gauss quadrature accuracy
+!
+! 1.5 Meyers (1992) nucleation parameterization
+!
+REAL,SAVE :: XFACTNUC_DEP,XFACTNUC_CON ! Amplification factor for IN conc.
+ ! DEP refers to DEPosition mode
+ ! CON refers to CONtact mode
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. WARM SCHEME
+! -----------
+!
+! 2.1 Warm scheme configuration
+!
+LOGICAL, SAVE :: LWARM ! TRUE to enable the warm scheme
+LOGICAL, SAVE :: LACTI ! TRUE to enable CCN activation
+LOGICAL, SAVE :: LRAIN ! TRUE to enable the formation of rain
+LOGICAL, SAVE :: LSEDC ! TRUE to enable the droplet sedimentation
+LOGICAL, SAVE :: LACTIT ! TRUE to enable the usage of dT/dt in CCN activation
+LOGICAL, SAVE :: LBOUND ! TRUE to enable the continuously replenishing
+ ! aerosol concentrations through the open
+ ! lateral boundaries -> boundaries.f90
+!
+! 2.2 CCN initialisation
+!
+INTEGER, SAVE :: NMOD_CCN ! Number of CCN modes
+REAL, DIMENSION(JPLIMACCNMAX), SAVE :: XCCN_CONC ! CCN conc. (#/cm3)
+LOGICAL, SAVE :: LCCN_HOM ! True for z-homogeneous CCN concentrations
+CHARACTER(LEN=8),SAVE :: CCCN_MODES ! CCN modes characteristics (Jungfraujoch ...)
+REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XR_MEAN_CCN, & ! Mean radius of CCN modes
+ XLOGSIG_CCN, & ! Log of geometric dispersion of the CCN modes
+ XRHO_CCN ! Density of the CCN modes
+REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XKHEN_MULTI, & ! Parameters defining the CCN activation
+ XMUHEN_MULTI, & ! spectra for a multimodal aerosol distribution
+ XBETAHEN_MULTI !
+REAL, DIMENSION(:,:,:) ,SAVE, ALLOCATABLE :: XCONC_CCN_TOT !* Total aerosol number concentration
+REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XLIMIT_FACTOR !* compute CHEN ????????????
+!
+! 2.3 Water particles characteristics
+!
+REAL,SAVE :: XALPHAR,XNUR, & ! Raindrop distribution parameters
+ XALPHAC,XNUC ! Cloud droplet distribution parameters
+!
+! 2.4 CCN activation
+!
+CHARACTER(LEN=3),SAVE :: HPARAM_CCN = 'CPB' ! Parameterization of the CCN activation
+CHARACTER(LEN=3),SAVE :: HINI_CCN ! Initialization type of CCN activation
+CHARACTER(LEN=1),DIMENSION(JPLIMACCNMAX),SAVE :: HTYPE_CCN ! 'M' or 'C' CCN type
+REAL,SAVE :: XFSOLUB_CCN, & ! Fractionnal solubility of the CCN
+ XACTEMP_CCN, & ! Expected temperature of CCN activation
+ XAERDIFF, XAERHEIGHT ! For the vertical gradient of aerosol distribution
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3. BELOW CLOUD SCAVENGING
+! ----------------------
+!
+LOGICAL, SAVE :: LSCAV ! TRUE for aerosol scavenging by precipitations
+LOGICAL, SAVE :: LAERO_MASS ! TRUE to compute the total aerosol mass scavenging rate
+!
+INTEGER :: NDIAMR = 20 ! Max Number of droplet for quadrature method
+INTEGER :: NDIAMP = 20 ! Max Number of aerosol particle for quadrature method
+!
+REAL, SAVE :: XT0SCAV = 293.15 ! [K]
+REAL, SAVE :: XTREF = 273.15 ! [K]
+REAL, SAVE :: XNDO = 8.*1.0E6 ! [/m**4]
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 4. ATMOSPHERIC & OTHER PARAMETERS
+! ------------------------------
+!
+REAL, SAVE :: XMUA0 = 1.711E-05 ![Pa.s] Air Viscosity at T=273.15K
+REAL, SAVE :: XT_SUTH_A = 110.4 ![K] Sutherland Temperature for Air
+REAL, SAVE :: XMFPA0 = 6.6E-08 ![m] Mean Free Path of Air under standard conditions
+!
+REAL, SAVE :: XVISCW = 1.0E-3 ![Pa.s] water viscosity at 20°C
+REAL, SAVE :: XRHO00 = 1.292 !rho on the floor [Kg/m**3]
+!
+REAL,SAVE :: XCEXVT ! air density fall speed correction
+!
+REAL,DIMENSION(:),SAVE,ALLOCATABLE :: XRTMIN ! Min values of the mixing ratios
+REAL,DIMENSION(:),SAVE,ALLOCATABLE :: XCTMIN ! Min values of the drop concentrations
+!
+END MODULE MODD_PARAM_LIMA
diff --git a/src/MNH/modd_param_lima_cold.f90 b/src/MNH/modd_param_lima_cold.f90
new file mode 100644
index 000000000..2df3032ba
--- /dev/null
+++ b/src/MNH/modd_param_lima_cold.f90
@@ -0,0 +1,122 @@
+! ###########################
+ MODULE MODD_PARAM_LIMA_COLD
+! ###########################
+!
+!!**** *MODD_PARAM_LIMA_COLD* - declaration of some descriptive parameters and
+!! microphysical factors extensively used in
+!! the LIMA cold scheme.
+!! AUTHOR
+!! ------
+!! J.-P. Pinty *Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!!
+!-------------------------------------------------------------------------------
+!
+IMPLICIT NONE
+!
+!* 1. DESCRIPTIVE PARAMETERS
+! ----------------------
+!
+! Declaration of microphysical constants, including the descriptive
+! parameters for the raindrop and the ice crystal habits, and the
+! parameters relevant of the dimensional distributions.
+!
+! m(D) = XAx * D**XBx : Mass-MaxDim relationship
+! v(D) = XCx * D**XDx : Fallspeed-MaxDim relationship
+! N(Lbda) = XCCx * Lbda**XCXx : NumberConc-Slopeparam relationship
+! XF0x, XF1x, XF2x : Ventilation factors
+! XC1x : Shape parameter for deposition
+!
+! and
+!
+! XALPHAx, XNUx : Generalized GAMMA law
+! Lbda = XLBx * (r_x*rho_dref)**XLBEXx : Slope parameter of the
+! distribution law
+!
+REAL,SAVE :: XLBEXI,XLBI ! Prist. ice distribution parameters
+REAL,SAVE :: XLBEXS,XLBS ! Snow/agg. distribution parameters
+!
+REAL,SAVE :: XAI,XBI,XC_I,XDI ,XF0I,XF2I,XC1I ! Cloud ice charact.
+REAL,SAVE :: XF0IS,XF1IS ! (large Di vent. coef.)
+REAL,SAVE :: XAS,XBS,XCS,XDS,XCCS,XCXS,XF0S,XF1S,XC1S ! Snow/agg. charact.
+!
+REAL,SAVE :: XLBDAS_MAX ! Max values allowed for the shape
+ ! parameter of snow
+!
+CHARACTER(LEN=8),DIMENSION(5),PARAMETER &
+ :: CLIMA_COLD_NAMES=(/'CICE ','CIFNFREE','CIFNNUCL', &
+ 'CCNINIMM','CCCNNUCL'/)
+ ! basenames of the SV articles stored
+ ! in the binary files
+ !with IF:Ice-nuclei Free (nonactivated IFN by Dep/Cond)
+ ! IN:Ice-nuclei Nucleated (activated IFN by Dep/Cond)
+ ! NI:Nuclei Immersed (activated IFN by Imm)
+ ! HF:Homogeneous Freezing
+CHARACTER(LEN=3),DIMENSION(5),PARAMETER &
+ :: CLIMA_COLD_CONC=(/'NI ','NIF','NIN','NNI','NNH'/)!for DIAG
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. MICROPHYSICAL FACTORS
+! ---------------------
+!
+REAL,SAVE :: XFSEDRI,XFSEDCI, & ! Constants for sedimentation
+ XFSEDS, XEXSEDS ! fluxes of ice and snow
+!
+REAL,SAVE :: XNUC_DEP,XEXSI_DEP,XEX_DEP, & ! Constants for heterogeneous
+ XNUC_CON,XEXTT_CON,XEX_CON, & ! ice nucleation : DEP et CON
+ XMNU0 ! mass of nucleated ice crystal
+!
+REAL,SAVE :: XRHOI_HONH,XCEXP_DIFVAP_HONH, & ! Constants for homogeneous
+ XCOEF_DIFVAP_HONH,XRCOEF_HONH, & ! haze freezing : HHONI
+ XCRITSAT1_HONH,XCRITSAT2_HONH, &
+ XTMIN_HONH,XTMAX_HONH, &
+ XDLNJODT1_HONH,XDLNJODT2_HONH, &
+ XC1_HONH,XC2_HONH,XC3_HONH
+!
+REAL,SAVE :: XC_HONC,XR_HONC, & ! Constants for homogeneous
+ XTEXP1_HONC,XTEXP2_HONC, & ! droplet freezing : CHONI
+ XTEXP3_HONC,XTEXP4_HONC, &
+ XTEXP5_HONC
+!
+REAL,SAVE :: XCSCNVI_MAX, XLBDASCNVI_MAX, &
+ XRHORSMIN, &
+ XDSCNVI_LIM, XLBDASCNVI_LIM, & ! Constants for snow
+ XC0DEPSI,XC1DEPSI, & ! sublimation conversion to
+ XR0DEPSI,XR1DEPSI ! pristine ice : SCNVI
+!
+REAL,SAVE :: XSCFAC, & ! Constants for the Bergeron
+ X0DEPI,X2DEPI, & ! Findeisen process and
+ X0DEPS,X1DEPS,XEX0DEPS,XEX1DEPS ! deposition
+!
+REAL,SAVE :: XDICNVS_LIM, XLBDAICNVS_LIM, & ! Constants for pristine ice
+ XC0DEPIS,XC1DEPIS, & ! deposition conversion to
+ XR0DEPIS,XR1DEPIS ! snow : ICNVS
+!
+REAL,SAVE :: XCOLEXIS, & ! Constants for snow
+ XAGGS_CLARGE1,XAGGS_CLARGE2, & ! aggregation : AGG
+ XAGGS_RLARGE1,XAGGS_RLARGE2
+!
+!??????????????????
+REAL,SAVE :: XKER_ZRNIC_A1,XKER_ZRNIC_A2 ! Long-Zrnic Kernels (ini_ice_coma)
+!
+REAL,SAVE :: XSELFI,XCOLEXII ! Constants for pristine ice
+ ! self-collection (ini_ice_coma)
+!
+REAL,SAVE :: XAUTO3, XAUTO4, & ! Constants for pristine ice
+ XLAUTS, XLAUTS_THRESHOLD, & ! autoconversion : AUT
+ XITAUTS, XITAUTS_THRESHOLD, & ! (ini_ice_com)
+ XTEXAUTI
+!
+REAL,SAVE :: XCONCI_MAX ! Limitation of the pristine
+ ! ice concentration (init and grid-nesting)
+REAL,SAVE :: XFREFFI ! Factor to compute the cloud ice effective radius
+!
+!-------------------------------------------------------------------------------
+!
+END MODULE MODD_PARAM_LIMA_COLD
diff --git a/src/MNH/modd_param_lima_mixed.f90 b/src/MNH/modd_param_lima_mixed.f90
new file mode 100644
index 000000000..f13accfc6
--- /dev/null
+++ b/src/MNH/modd_param_lima_mixed.f90
@@ -0,0 +1,169 @@
+! ############################
+ MODULE MODD_PARAM_LIMA_MIXED
+! ###########################{
+!
+!!**** *MODD_PARAM_LIMA_MIXED* - declaration of some descriptive parameters and
+!! microphysical factors extensively used in
+!! the LIMA mixed scheme.
+!! AUTHOR
+!! ------
+!! J.-P. Pinty *Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!!
+!-------------------------------------------------------------------------------
+!
+IMPLICIT NONE
+!
+!* 1. DESCRIPTIVE PARAMETERS
+! ----------------------
+!
+! Declaration of microphysical constants, including the descriptive
+! parameters for the raindrop and the ice crystal habits, and the
+! parameters relevant of the dimensional distributions.
+!
+! m(D) = XAx * D**XBx : Mass-MaxDim relationship
+! v(D) = XCx * D**XDx : Fallspeed-MaxDim relationship
+! N(Lbda) = XCCx * Lbda**XCXx : NumberConc-Slopeparam relationship
+! XF0x, XF1x, XF2x : Ventilation factors
+! XC1x : Shape parameter for deposition
+!
+! and
+!
+! XALPHAx, XNUx : Generalized GAMMA law
+! Lbda = XLBx * (r_x*rho_dref)**XLBEXx : Slope parameter of the
+! distribution law
+!
+REAL,SAVE :: XAG,XBG,XCG,XDG,XCCG,XCXG,XF0G,XF1G,XC1G ! Graupel charact.
+REAL,SAVE :: XLBEXG,XLBG ! Graupel distribution parameters
+REAL,SAVE :: XLBDAG_MAX ! Max values allowed for the shape
+ ! parameter of graupeln
+!
+REAL,SAVE :: XAH,XBH,XCH,XDH,XCCH,XCXH,XF0H,XF1H,XC1H ! Hail charact.
+REAL,SAVE :: XALPHAH,XNUH,XLBEXH,XLBH ! Hail distribution parameters
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. MICROPHYSICAL FACTORS - Graupel
+! -------------------------------
+!
+REAL,SAVE :: XFSEDG, XEXSEDG ! Sedimentation fluxes of Graupel
+!
+REAL,SAVE :: X0DEPG,X1DEPG,XEX0DEPG,XEX1DEPG ! Deposition on graupel
+!
+REAL,SAVE :: XHMTMIN,XHMTMAX,XHM1,XHM2, & ! Constants for the
+ XHM_YIELD,XHM_COLLCS,XHM_FACTS, & ! revised
+ XHM_COLLCG,XHM_FACTG, & ! Hallett-Mossop process
+ XGAMINC_HMC_BOUND_MIN, & ! Min val. of Lbda_c for HMC
+ XGAMINC_HMC_BOUND_MAX, & ! Max val. of Lbda_c for HMC
+ XHMSINTP1,XHMSINTP2, & ! (this is no more used !)
+ XHMLINTP1,XHMLINTP2
+!
+REAL,SAVE :: XDCSLIM,XCOLCS, & ! Constants for the riming of
+ XEXCRIMSS,XCRIMSS, & ! the aggregates : RIM
+ XEXCRIMSG,XCRIMSG, & !
+ XEXSRIMCG,XSRIMCG, & !
+ XGAMINC_BOUND_MIN, & ! Min val. of Lbda_s for RIM
+ XGAMINC_BOUND_MAX, & ! Max val. of Lbda_s for RIM
+ XRIMINTP1,XRIMINTP2 ! Csts for lin. interpol. of
+ ! the tab. incomplete Gamma law
+INTEGER,SAVE :: NGAMINC ! Number of tab. Lbda_s
+REAL, DIMENSION(:), SAVE, ALLOCATABLE &
+ :: XGAMINC_RIM1, & ! Tab. incomplete Gamma funct.
+ XGAMINC_RIM2, & ! for XDS+2 and for XBS
+ XGAMINC_HMC ! and for the HM process
+!
+REAL,SAVE :: XFRACCSS, & ! Constants for the accretion
+ XLBRACCS1,XLBRACCS2,XLBRACCS3, & ! raindrops onto the aggregates
+ XFSACCRG, & ! ACC (processes RACCSS and
+ XLBSACCR1,XLBSACCR2,XLBSACCR3, & ! SACCRG)
+ XACCLBDAS_MIN, & ! Min val. of Lbda_s for ACC
+ XACCLBDAS_MAX, & ! Max val. of Lbda_s for ACC
+ XACCLBDAR_MIN, & ! Min val. of Lbda_r for ACC
+ XACCLBDAR_MAX, & ! Max val. of Lbda_r for ACC
+ XACCINTP1S,XACCINTP2S, & ! Csts for bilin. interpol. of
+ XACCINTP1R,XACCINTP2R ! Lbda_s and Lbda_r in the
+ ! XKER_RACCSS and XKER_SACCRG
+ ! tables
+INTEGER,SAVE :: NACCLBDAS, & ! Number of Lbda_s values and
+ NACCLBDAR ! of Lbda_r values in the
+ ! XKER_RACCSS and XKER_SACCRG
+ ! tables
+REAL,DIMENSION(:,:), SAVE, ALLOCATABLE &
+ :: XKER_RACCSS, & ! Normalized kernel for RACCSS
+ XKER_RACCS, & ! Normalized kernel for RACCS
+ XKER_SACCRG ! Normalized kernel for SACCRG
+REAL,SAVE :: XFSCVMG ! Melting-conversion factor of
+ ! the aggregates
+!
+REAL,SAVE :: XCOLIR, & ! Constants for rain contact
+ XEXRCFRI,XRCFRI, & ! freezing : CFR
+ XEXICFRR,XICFRR !
+!
+REAL,SAVE :: XFCDRYG, & ! Constants for the dry growth
+ XCOLCG, & ! of the graupeln :
+ XCOLIG,XCOLEXIG,XFIDRYG, & !
+ XCOLSG,XCOLEXSG,XFSDRYG, & ! RCDRYG
+ XLBSDRYG1,XLBSDRYG2,XLBSDRYG3, & ! RIDRYG
+ XFRDRYG, & ! RSDRYG
+ XLBRDRYG1,XLBRDRYG2,XLBRDRYG3, & ! RRDRYG
+ XDRYLBDAR_MIN, & ! Min val. of Lbda_r for DRY
+ XDRYLBDAR_MAX, & ! Max val. of Lbda_r for DRY
+ XDRYLBDAS_MIN, & ! Min val. of Lbda_s for DRY
+ XDRYLBDAS_MAX, & ! Max val. of Lbda_s for DRY
+ XDRYLBDAG_MIN, & ! Min val. of Lbda_g for DRY
+ XDRYLBDAG_MAX, & ! Max val. of Lbda_g for DRY
+ XDRYINTP1R,XDRYINTP2R, & ! Csts for bilin. interpol. of
+ XDRYINTP1S,XDRYINTP2S, & ! Lbda_r, Lbda_s and Lbda_g in
+ XDRYINTP1G,XDRYINTP2G ! the XKER_SDRYG and XKER_RDRYG
+ ! tables
+INTEGER,SAVE :: NDRYLBDAR, & ! Number of Lbda_r,
+ NDRYLBDAS, & ! of Lbda_s and
+ NDRYLBDAG ! of Lbda_g values in
+ ! the XKER_SDRYG and XKER_RDRYG
+ ! tables
+REAL,DIMENSION(:,:), SAVE, ALLOCATABLE &
+ :: XKER_SDRYG, & ! Normalized kernel for SDRYG
+ XKER_RDRYG ! Normalized kernel for RDRYG
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. MICROPHYSICAL FACTORS - Hail
+! ----------------------------
+!
+REAL,SAVE :: XFSEDH,XEXSEDH ! Constants for sedimentation
+!
+!
+REAL,SAVE :: X0DEPH,X1DEPH,XEX0DEPH,XEX1DEPH ! Constants for deposition
+!
+REAL,SAVE :: XFWETH,XFSWETH, & ! Constants for the wet growth
+ XLBSWETH1,XLBSWETH2,XLBSWETH3, & ! of the hailstones : WET
+ XFGWETH, & ! processes RSWETH
+ XLBGWETH1,XLBGWETH2,XLBGWETH3, & ! RGWETH
+ XWETLBDAS_MIN, & ! Min val. of Lbda_s for WET
+ XWETLBDAS_MAX, & ! Max val. of Lbda_s for WET
+ XWETLBDAG_MIN, & ! Min val. of Lbda_g for WET
+ XWETLBDAG_MAX, & ! Max val. of Lbda_g for WET
+ XWETLBDAH_MIN, & ! Min val. of Lbda_h for WET
+ XWETLBDAH_MAX, & ! Max val. of Lbda_h for WET
+ XWETINTP1S,XWETINTP2S, & ! Csts for bilin. interpol. of
+ XWETINTP1G,XWETINTP2G, & ! Lbda_r, Lbda_s and Lbda_g in
+ XWETINTP1H,XWETINTP2H ! the XKER_SWETH and XKER_GWETH
+ ! tables
+INTEGER,SAVE :: NWETLBDAS, & ! Number of Lbda_s,
+ NWETLBDAG, & ! of Lbda_g and
+ NWETLBDAH ! of Lbda_h values in
+ ! the XKER_SWETH and XKER_GWETH
+ ! tables
+REAL,DIMENSION(:,:), SAVE, ALLOCATABLE &
+ :: XKER_SWETH, & ! Normalized kernel for SWETH
+ XKER_GWETH ! Normalized kernel for GWETH
+
+!
+!-------------------------------------------------------------------------------
+!
+END MODULE MODD_PARAM_LIMA_MIXED
diff --git a/src/MNH/modd_param_lima_warm.f90 b/src/MNH/modd_param_lima_warm.f90
new file mode 100644
index 000000000..d0688aa72
--- /dev/null
+++ b/src/MNH/modd_param_lima_warm.f90
@@ -0,0 +1,119 @@
+! ###########################
+ MODULE MODD_PARAM_LIMA_WARM
+! ###########################
+!
+!!**** *MODD_PARAM_LIMA_WARM* - declaration of some descriptive parameters and
+!! microphysical factors extensively used in
+!! the LIMA warm scheme.
+!! AUTHOR
+!! ------
+!! J.-P. Pinty *Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!!
+!-------------------------------------------------------------------------------
+!
+IMPLICIT NONE
+!
+!* 1. DESCRIPTIVE PARAMETERS
+! ----------------------
+!
+REAL,SAVE :: XLBC, XLBEXC, & ! shape parameters of the cloud droplets
+ XLBR, XLBEXR ! shape parameters of the raindrops
+!
+REAL,SAVE :: XAR,XBR,XCR,XDR,XF0R,XF1R, & ! Raindrop charact.
+ XCCR, & !For diagnostics
+ XAC,XBC,XCC,XDC,XF0C,XF2C,XC1C ! Cloud droplet charact.
+!
+!
+CHARACTER(LEN=8),DIMENSION(4),PARAMETER &
+ :: CLIMA_WARM_NAMES=(/'CCLOUD ','CRAIN ','CCCNFREE','CCCNACTI'/)
+ ! basenames of the SV articles stored
+ ! in the binary files
+CHARACTER(LEN=5),DIMENSION(4),PARAMETER &
+ :: CLIMA_WARM_CONC=(/'NC ','NR ','NFREE','NCCN '/)
+! ! basenames of the SV articles stored
+! ! in the binary files for DIAG
+!
+!* Special issue for Below-Cloud SCAVenging of Aerosol particles
+CHARACTER(LEN=6),DIMENSION(2) :: CAERO_MASS =(/'MASSAP', 'MAP '/)
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. MICROPHYSICAL FACTORS
+! ---------------------
+!
+REAL,SAVE :: XFSEDRR,XFSEDCR, & ! Constants for sedimentation
+ XFSEDRC,XFSEDCC ! fluxes of R, C
+!
+!
+REAL,SAVE :: XDIVA, & ! Diffusivity of water vapor
+ XTHCO ! Thermal conductivity
+REAL,SAVE :: XWMIN ! Min value of updraft velocity
+ ! to enable nucleation process
+REAL,SAVE :: XTMIN ! Min value of
+ ! temperature evolution
+ ! to enable nucleation process
+REAL,SAVE :: XCSTHEN,XCSTDCRIT ! Cst for HEN precalculations
+INTEGER, SAVE :: NHYP ! Number of value of the HYP
+ ! functions
+REAL,SAVE :: XHYPINTP1, XHYPINTP2 ! Factors defining the
+ ! supersaturation log scale
+REAL, DIMENSION(:,:), SAVE, ALLOCATABLE & ! Tabulated HYPgeometric
+ :: XHYPF12, XHYPF32 ! functions used in HEN
+INTEGER, SAVE :: NAHEN ! Number of value of the AHEN
+ ! functions
+REAL,SAVE :: XAHENINTP1, XAHENINTP2 ! Factors defining the
+ ! temperatures in lin scale
+REAL, DIMENSION(:), SAVE, ALLOCATABLE & !
+ :: XAHENG,XPSI1, XPSI3, & ! Twomey-CPB98 and
+ XAHENF,XAHENY ! Feingold-Heymsfield
+ ! parameterization to compute Smax
+REAL,SAVE :: XWCOEF_F1, XWCOEF_F2, XWCOEF_F3, & ! COEF_F of the polynomial temp.
+ XWCOEF_Y1, XWCOEF_Y2, XWCOEF_Y3 ! COEF_Y of the polynomial temp.
+ ! function powering W
+!
+!
+REAL,SAVE :: XKERA1, XKERA2 ! Constants to define the lin
+ ! and parabolic kernel param.
+REAL,SAVE :: XSELFC ! Constants for cloud droplet
+ ! selfcollection : SELF
+!
+REAL,SAVE :: XAUTO1, XAUTO2, XCAUTR, & ! Constants for cloud droplet
+ XLAUTR, XLAUTR_THRESHOLD, & ! autoconversion : AUT
+ XITAUTR, XITAUTR_THRESHOLD
+!
+REAL,SAVE :: XACCR1, XACCR2, XACCR3, & ! Constants for the accretion
+ XACCR4, XACCR5, XACCR6, & ! process
+ XACCR_CLARGE1, XACCR_CLARGE2, XACCR_RLARGE1, XACCR_RLARGE2, &
+ XACCR_CSMALL1, XACCR_CSMALL2, XACCR_RSMALL1, XACCR_RSMALL2
+!
+REAL,SAVE :: XSCBU2, XSCBU3, & ! Constants for the raindrop
+ XSCBU_EFF1, XSCBU_EFF2, XSCBUEXP1 ! breakup-selfcollection: SCBU
+!
+REAL,SAVE :: XSPONBUD1,XSPONBUD2,XSPONBUD3, & ! Spontaneous Break-up
+ XSPONCOEF2 ! (drop size limiter)
+!
+REAL,SAVE :: X0EVAR, X1EVAR, & ! Constants for raindrop
+ XEX0EVAR, XEX1EVAR, XEX2EVAR ! evaporation: EVA
+!
+REAL,DIMENSION(:,:,:,:), SAVE, ALLOCATABLE :: XCONCC_INI
+REAL,SAVE :: XCONCR_PARAM_INI
+ ! Used to initialize the
+ ! concentrations from mixing ratios
+ ! (init and grid-nesting from Kessler)
+!
+REAL,SAVE :: X0CNDC, X2CNDC ! Constants for cloud droplet
+ ! condensation/evaporation
+REAL,SAVE :: XFREFFC ! Factor to compute the cloud droplet effective radius
+REAL,SAVE :: XFREFFR ! Factor to compute the rain drop effective radius
+REAL,SAVE :: XCREC, XCRER
+ ! Factors to compute reff when cloud and rain are present
+!
+!-------------------------------------------------------------------------------
+!
+END MODULE MODD_PARAM_LIMA_WARM
diff --git a/src/MNH/modn_param_lima.f90 b/src/MNH/modn_param_lima.f90
new file mode 100644
index 000000000..e65579400
--- /dev/null
+++ b/src/MNH/modn_param_lima.f90
@@ -0,0 +1,29 @@
+! ######################
+ MODULE MODN_PARAM_LIMA
+! ######################
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAM_LIMA
+!
+IMPLICIT NONE
+!
+!
+NAMELIST/NAM_PARAM_LIMA/LCOLD, LNUCL, LSEDI, LSNOW, LHAIL, LHHONI, LMEYERS,&
+ NMOD_IFN, XIFN_CONC, LIFN_HOM, &
+ CIFN_SPECIES, CINT_MIXING, NMOD_IMM, NIND_SPECIE, &
+ CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA, &
+ XALPHAI, XNUI, XALPHAS, XNUS, XALPHAG, XNUG, &
+ XFACTNUC_DEP, XFACTNUC_CON, NPHILLIPS, &
+!
+ LWARM, LACTI, LRAIN, LSEDC, LACTIT, LBOUND, &
+ NMOD_CCN, XCCN_CONC, &
+ LCCN_HOM, CCCN_MODES, HINI_CCN, HTYPE_CCN, &
+ XALPHAC, XNUC, XALPHAR, XNUR, &
+ XFSOLUB_CCN, XACTEMP_CCN, XAERDIFF, XAERHEIGHT, &
+ LSCAV, LAERO_MASS
+!
+END MODULE MODN_PARAM_LIMA
diff --git a/src/MNH/set_conc_lima.f90 b/src/MNH/set_conc_lima.f90
new file mode 100644
index 000000000..05c009405
--- /dev/null
+++ b/src/MNH/set_conc_lima.f90
@@ -0,0 +1,182 @@
+! #######################################
+ MODULE MODI_SET_CONC_LIMA
+! #######################################
+!
+INTERFACE
+!
+ SUBROUTINE SET_CONC_LIMA (HLUOUT,HGETCLOUD,PRHODREF,PRT,PSVT)
+!
+CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! name of the output-listing
+CHARACTER (LEN=4), INTENT(IN) :: HGETCLOUD ! Get indicator
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT ! microphysical mixing ratios
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PSVT ! microphys. concentrations
+!
+!
+END SUBROUTINE SET_CONC_LIMA
+!
+END INTERFACE
+!
+END MODULE MODI_SET_CONC_LIMA
+!
+! ###########################################################################
+ SUBROUTINE SET_CONC_LIMA (HLUOUT,HGETCLOUD,PRHODREF,PRT,PSVT)
+! ###########################################################################
+!
+!!**** *SET_CONC_LIMA * - initialize droplet, raindrop and ice
+!! concentration for a RESTArt simulation of the LIMA scheme
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize cloud droplet and rain drop
+!! concentrations when the cloud droplet and rain drop mixing ratios are
+!! only available (generally from a previous run using the Kessler scheme).
+!! This routine is used to initialize the droplet/drop concentrations
+!! using the r_c and r_r of a previous REVE or KESS run but also to compute
+!! the LB tendencies in ONE_WAY$n in case of grid-nesting when the optional
+!! argument PTIME is set (a LIMA run embedded in a KESS or REVE run).
+!!
+!!** METHOD
+!! ------
+!! The method assumes a Csk law for the activation of aerososl with "s"
+!! the supersaturation (here 0.05 % is chosen). A Marshall-Palmer law with
+!! N_o=10**(-7) m**(-4) is assumed for the rain drop concentration.
+!! The initialization of the PSVT is straightforward for the cloud droplets
+!! while N_r=N_0/Lambda_r with Rho*r_r=Pi*Rho_w*N_0/(Lambda_r**4) is used for
+!! the rain drops. The HGETCLOUD test is used to discriminate between the
+!! 'REVE' and 'KESS' options for CCLOUD in the previous run (from which
+!! PRT was calculated).
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_RAIN_C2R2_DESCR, ONLY : XRTMIN, XCTMIN
+!! Module MODD_RAIN_C2R2_KHKO_PARAM, ONLY : XCONCC_INI, XCONCR_PARAM_INI
+!! Module MODD_CONF, ONLY : NVERB
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation ( routine SET_CONC_RAIN_C2R2 )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! P. Jabouille * CNRM/GMME *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/11/00
+!! 2014 G.Delautier : remplace MODD_RAIN_C2R2_PARAM par MODD_RAIN_C2R2_KHKO_PARAM
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, LCOLD, LWARM
+USE MODD_PARAM_LIMA_COLD, ONLY : XAI, XBI
+USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_ACTI, NSV_LIMA_NI, NSV_LIMA_IFN_NUCL
+USE MODD_CST, ONLY : XPI, XRHOLW, XRHOLI
+USE MODD_CONF, ONLY : NVERB
+!
+USE MODE_FM
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+CHARACTER (LEN=*), INTENT(IN) :: HLUOUT ! name of the output-listing
+CHARACTER (LEN=4), INTENT(IN) :: HGETCLOUD ! Get indicator
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT ! microphysical mixing ratios
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PSVT ! microphys. concentrations
+!
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IRESP ! Return code of FM routines
+INTEGER :: ILUOUT ! Logical unit number of output-listing
+REAL :: ZCONCC, ZCONCR, ZCONCI
+!
+!-------------------------------------------------------------------------------
+!* 1. RETRIEVE LOGICAL UNIT NUMBER
+! ----------------------------
+!
+CALL FMLOOK_ll(HLUOUT,HLUOUT,ILUOUT,IRESP)
+!
+!* 2. INITIALIZATION
+! --------------
+!
+IF (LWARM) THEN
+!
+! droplets
+!
+ ZCONCC = 300 ! droplet concentration set at 300 cm-3
+ WHERE ( PRT(:,:,:,2) > XRTMIN(2) )
+ PSVT(:,:,:,NSV_LIMA_NC) = ZCONCC
+ PSVT(:,:,:,NSV_LIMA_CCN_ACTI) = ZCONCC
+ END WHERE
+ WHERE ( PRT(:,:,:,2) <= XRTMIN(2) )
+ PRT(:,:,:,2) = 0.0
+ PSVT(:,:,:,NSV_LIMA_NC) = 0.0
+ PSVT(:,:,:,NSV_LIMA_CCN_ACTI) = 0.0
+ END WHERE
+ IF( NVERB >= 5 ) THEN
+ WRITE (UNIT=ILUOUT,FMT=*) "!INI_MODEL$n: The droplet concentration has "
+ WRITE (UNIT=ILUOUT,FMT=*) "been roughly initialised"
+ END IF
+!
+! drops
+!
+ ZCONCR = (1.E7)**3/(XPI*XRHOLW) ! cf XCONCR_PARAM_INI in ini_rain_c2r2.f90
+ IF (HGETCLOUD == 'INI1') THEN ! init from REVE scheme
+ PSVT(:,:,:,NSV_LIMA_NR) = 0.0
+ ELSE ! init from KESS, ICE3...
+ WHERE ( PRT(:,:,:,3) > XRTMIN(3) )
+ PSVT(:,:,:,NSV_LIMA_NR) = MAX( SQRT(SQRT(PRHODREF(:,:,:)*PRT(:,:,:,3) &
+ *ZCONCR)),XCTMIN(3) )
+ END WHERE
+ WHERE ( PRT(:,:,:,3) <= XRTMIN(3) )
+ PRT(:,:,:,3) = 0.0
+ PSVT(:,:,:,NSV_LIMA_NR) = 0.0
+ END WHERE
+ IF( NVERB >= 5 ) THEN
+ WRITE (UNIT=ILUOUT,FMT=*) "!INI_MODEL$n: The raindrop concentration has "
+ WRITE (UNIT=ILUOUT,FMT=*) "been roughly initialised"
+ END IF
+ END IF
+!
+ENDIF
+!
+IF (LCOLD) THEN
+!
+! ice crystals
+!
+ ZCONCI = 100.E3 ! maximum ice concentration set at 100/L
+ WHERE ( PRT(:,:,:,4) > XRTMIN(4) )
+ PSVT(:,:,:,NSV_LIMA_NI) = MIN( PRHODREF(:,:,:) / &
+ ( XRHOLI * XAI*(10.E-06)**XBI * PRT(:,:,:,4) ), &
+ ZCONCI )
+ PSVT(:,:,:,NSV_LIMA_IFN_NUCL) = PSVT(:,:,:,NSV_LIMA_NI)
+ END WHERE
+ WHERE ( PRT(:,:,:,4) <= XRTMIN(4) )
+ PRT(:,:,:,4) = 0.0
+ PSVT(:,:,:,NSV_LIMA_NI) = 0.0
+ PSVT(:,:,:,NSV_LIMA_IFN_NUCL) = 0.0
+ END WHERE
+ IF( NVERB >= 5 ) THEN
+ WRITE (UNIT=ILUOUT,FMT=*) "!INI_MODEL$n: The cloud ice concentration has "
+ WRITE (UNIT=ILUOUT,FMT=*) "been roughly initialised"
+ END IF
+!
+END IF
+!
+END SUBROUTINE SET_CONC_LIMA
--
GitLab