diff --git a/src/ICCARE_BASE/default_desfmn.f90 b/src/ICCARE_BASE/default_desfmn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8324b19c679c3742d0f6e031920810107f840163
--- /dev/null
+++ b/src/ICCARE_BASE/default_desfmn.f90
@@ -0,0 +1,1409 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###########################
+ MODULE MODI_DEFAULT_DESFM_n
+! ###########################
+!
+INTERFACE
+!
+SUBROUTINE DEFAULT_DESFM_n(KMI)
+INTEGER, INTENT(IN) :: KMI ! Model index
+END SUBROUTINE DEFAULT_DESFM_n
+!
+END INTERFACE
+!
+END MODULE MODI_DEFAULT_DESFM_n
+!
+!
+!
+! ###############################
+ SUBROUTINE DEFAULT_DESFM_n(KMI)
+! ###############################
+!
+!!**** *DEFAULT_DESFM_n * - set default values for descriptive variables of
+!! model KMI
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to set default values for the variables
+! in descriptor files by filling the corresponding variables which
+! are stored in modules.
+!
+!
+!!** METHOD
+!! ------
+!! Each variable in modules, which can be initialized by reading its
+!! value in the descriptor file is set to a default value.
+!! When this routine is used during INIT, the modules of the first model
+!! are used to temporarily store the variables associated with a nested
+!! model.
+!! When this routine is used during SPAWNING, the modules of a second
+!! model must be initialized.
+!! Default values for variables common to all models are set only
+!! at the first call of DEFAULT_DESFM_n (i.e. when KMI=1)
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS : JPHEXT,JPVEXT
+!!
+!! Module MODD_CONF : CCONF,L2D,L1D,LFLAT,NMODEL,NVERB
+!!
+!! Module MODD_DYN : XSEGLEN,XASSELIN,LCORIO,LNUMDIFF
+!! XALKTOP,XALZBOT
+!!
+!! Module MODD_BAKOUT
+!!
+!! Module MODD_NESTING : NDAD(m),NDTRATIO(m),XWAY(m)
+!!
+!! Module MODD_CONF_n : LUSERV,LUSERC,LUSERR,LUSERI,LUSERS
+!! LUSERG,LUSERH,CSEG,CEXP
+!!
+!! Module MODD_LUNIT_n : CINIFILE,CCPLFILE
+!!
+!!
+!! Module MODD_DYN_n : XTSTEP,CPRESOPT,NITR,XRELAX,LHO_RELAX
+!! LVE_RELAX,XRIMKMAX,NRIMX,NRIMY
+!!
+!! Module MODD_ADV_n : CUVW_ADV_SCHEME,CMET_ADV_SCHEME,CSV_ADV_SCHEME,NLITER
+!!
+!! Module MODD_PARAM_n : CTURB,CRAD,CDCONV,CSCONV
+!!
+!! Module MODD_LBC_n : CLBCX, CLBCY,NLBLX,NLBLY,XCPHASE,XCPHASE_PBL,XPOND
+!!
+!! Module MODD_TURB_n : XIMPL,CTURBLEN,CTURBDIM,LTURB_FLX,LTURB_DIAG,LSUBG_COND
+!! LTGT_FLX
+!!
+!!
+!! Module MODD_PARAM_RAD_n:
+!! XDTRAD,XDTRAD_CLONLY,LCLEAR_SKY,NRAD_COLNBR, NRAD_DIAG
+!!
+!! Module MODD_BUDGET : CBUTYPE,NBUMOD,XBULEN,NBUKL, NBUKH,LBU_KCP,XBUWRI
+!! NBUIL, NBUIH,NBUJL, NBUJH,LBU_ICP,LBU_JCP,NBUMASK
+!!
+!! Module MODD_BLANK_n:
+!!
+!! XDUMMYi, NDUMMYi, LDUMMYi, CDUMMYi
+!!
+!! Module MODD_FRC :
+!!
+!! LGEOST_UV_FRC,LGEOST_TH_FRC,LTEND_THRV_FRC
+!! LVERT_MOTION_FRC,LRELAX_THRV_FRC,LRELAX_UV_FRC,LRELAX_UVMEAN_FRC,
+!! XRELAX_TIME_FRC
+!! XRELAX_HEIGHT_FRC,CRELAX_HEIGHT_TYPE,LTRANS,XUTRANS,XVTRANS,
+!! LPGROUND_FRC
+!!
+!! Module MODD_PARAM_ICE :
+!!
+!! LWARM,CPRISTINE_ICE
+!!
+!! Module MODD_PARAM_KAFR_n :
+!!
+!! XDTCONV,LREFRESH_ALL,LDOWN,NICE,LCHTRANS
+!!
+!! Module MODD_PARAM_MFSHALL_n :
+!!
+!! CMF_UPDRAFT,LMIXUV,CMF_CLOUD,XIMPL_MF,LMF_FLX
+!!
+!!
+!!
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of the documentation (routine DEFAULT_DESFM_n)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 02/06/94
+!! Modifications 17/10/94 (Stein) For LCORIO
+!! Modifications 06/12/94 (Stein) remove LBOUSS+add LABSLAYER, LNUMDIFF
+!! ,LSTEADYLS
+!! Modifications 06/12/94 (Stein) remove LABSLAYER, add LHO_RELAX,
+!! LVE_RELAX, NRIMX, NRIMY, XRIMKMAX
+!! Modifications 09/01/95 (Lafore) add LSTEADY_DMASS
+!! Modifications 09/01/95 (Stein) add the turbulence scheme namelist
+!! Modifications 09/01/95 (Stein) add the 1D switch
+!! Modifications 10/03/95 (Mallet) add the coupling files
+!! 29/06/95 ( Stein, Nicolau, Hereil) add the budgets
+!! Modifications 25/09/95 ( Stein )add the LES tools
+!! Modifications 25/10/95 ( Stein )add the radiations
+!! Modifications 23/10/95 (Vila, lafore) new scalar advection scheme
+!! Modifications 24/02/96 (Stein) change the default value for CCPLFILE
+!! Modifications 12/02/96 (Lafore) transformation to DEFAULT_DESFM_n for
+!! spawning
+!! Modifications 25/04/96 (Suhre) add the blank module
+!! Modifications 29/07/96 (Pinty&Suhre) add module MODD_FRC
+!! Modifications 11/04/96 (Pinty) add the rain-ice scheme and modify
+!! the split arrays in MODD_PARAM_RAD_n
+!! Modifications 11/01/97 (Pinty) add the deep convection scheme
+!! Modifications 24/11/96 (Masson) add LREFRESH_ALL in deep convection
+!! Modifications 12/02/96 (Lafore) transformation to DEFAULT_DESFM_n for spawning
+!! Modifications 22/07/96 (Lafore) gridnesting implementation
+!! Modifications 29/07/96 (Lafore) add the module MODD_FMOUT (renamed MODD_BAKOUT)
+!! Modifications 23/06/97 (Stein) add the equation system name
+!! Modifications 10/07/97 (Masson) add MODD_PARAM_GROUNDn : CROUGH
+!! Modifications 28/07/97 (Masson) remove LREFRESH_ALL and LSTEADY_DMASS
+!! Modifications 08/10/97 (Stein) switch (_n=1) to initialize the
+!! parameters common to all models
+!! Modifications 24/01/98 (Bechtold) add LREFRESH_ALL, LCHTRANS,
+!! LTEND_THRV_FR and LSST_FRC
+!! Modifications 18/07/99 (Stein) add LRAD_DIAG
+!! Modification 15/03/99 (Masson) use of XUNDEF
+!! Modification 11/12/00 (Tomasini) Add CSEA_FLUX to MODD_PARAMn
+!! Modification 22/01/01 (Gazen) delete NSV and add LHORELAX_SVC2R2
+!! LHORELAX_SVCHEM,LHORELAX_SVLG
+!! Modification 15/03/02 (Solmon) radiation scheme: remove NSPOT and add
+!! default for aerosol and cloud rad. prop. control
+!! Modification 22/05/02 (Jabouille) put chimical default here
+!! Modification 01/2004 (Masson) removes surface (externalization)
+!! 09/04 (M. Tomasini) New namelist to modify the
+!! Cloud mixing length
+!! 07/05 (P.Tulet) New namelists for dust and aerosol
+!! Modification 01/2007 (Malardel, Pergaud) Add MODD_PARAM_MFSHALL_n
+!! Modification 10/2009 (Aumond) Add user multimasks for LES
+!! Modification 10/2009 (Aumond) Add MEAN_FIELD
+!! Modification 12/04/07 (Leriche) add LUSECHAQ for aqueous chemistry
+!! Modification 30/05/07 (Leriche) add LCH_PH and XCH_PHINIT for pH
+!! Modification 25/04/08 (Leriche) add XRTMIN_AQ LWC threshold for aq. chemistry
+!! 16/07/10 add LHORELAX_SVIC
+!! 16/09/10 add LUSECHIC
+!! 13/01/11 add LCH_RET_ICE
+!! 01/07/11 (F.Couvreux) Add CONDSAMP
+!! 01/07/11 (B.Aouizerats) Add CAOP
+!! 07/2013 (C.Lac) add WENO, LCHECK
+!! 07/2013 (Bosseur & Filippi) adds Forefire
+!! 08/2015 (Redelsperger & Pianezze) add XPOND coefficient for LBC
+!! Modification 24/03/16 (Leriche) remove LCH_SURFACE_FLUX
+!! put NCH_VEC_LENGTH = 50 instead of 1000
+!!
+!! 04/2016 (C.LAC) negative contribution to the budget split between advection, turbulence and microphysics for KHKO/C2R2
+!! Modification 01/2016 (JP Pinty) Add LIMA
+!! Modification 24/03/16 (Leriche) remove LCH_SURFACE_FLUX
+!! put NCH_VEC_LENGTH = 50 instead of 1000
+!! 10/2016 (C.Lac) VSIGQSAT change from 0 to 0.02 for coherence with AROME
+!! 10/2016 (C.Lac) Add droplet deposition
+!! 10/2016 (R.Honnert and S.Riette) : Improvement of EDKF and adaptation to the grey zone
+!! 10/2016 (F Brosse) add prod/loss terms computation for chemistry
+!! 07/2017 (V. Masson) adds time step for output files writing.
+!! 09/2017 Q.Rodier add LTEND_UV_FRC
+!! 02/2018 Q.Libois ECRAD
+! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! 01/2018 (S. Riette) new budgets and variables for ICE3/ICE4
+!! 01/2018 (J.Colin) add VISC and DRAG
+!! 07/2017 (V. Vionnet) add blowing snow variables
+!! 01/2019 (R. Honnert) add reduction of the mass-flux surface closure with the resolution
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+!! 05/2019 F.Brient add tracer emission from the top of the boundary-layer
+!! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
+! P. Wautelet 17/04/2020: move budgets switch values into modd_budget
+! P. Wautelet 30/06/2020: add NNETURSV, NNEADVSV and NNECONSV variables
+! F. Auguste, T. Nagel 02/2021: add IBM defaults parameters
+! T. Nagel 02/2021: add turbulence recycling defaults parameters
+! P-A Joulin 21/05/2021: add Wind turbines
+! S. Riette 21/05/2021: add options to PDF subgrid scheme
+! D. Ricard 05/2021: add the contribution of Leonard terms in the turbulence scheme
+! JL Redelsperger 06/2021: add parameters allowing to active idealized oceanic convection
+! B. Vie 06/2021: add prognostic supersaturation for LIMA
+! Q. Rodier 06/2021: modify default value to LGZ=F (grey-zone corr.), LSEDI and OSEDC=T (LIMA sedimentation)
+! F. Couvreux 06/2021: add LRELAX_UVMEAN_FRC
+! Q. Rodier 07/2021: modify XPOND=1
+! C. Barthe 03/2022: add CIBU and RDSF options in LIMA
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODD_PARAMETERS
+USE MODD_CONF ! For INIT only DEFAULT_DESFM1
+USE MODD_CONFZ
+USE MODD_DYN
+USE MODD_NESTING
+USE MODD_BAKOUT
+USE MODD_SERIES
+USE MODD_CONF_n ! modules used to set the default values is only
+USE MODD_LUNIT_n ! the one corresponding to model 1. These memory
+USE MODD_DIM_n ! addresses will then be filled by the values read in
+USE MODD_DYN_n ! the DESFM corresponding to model n which may have
+USE MODD_ADV_n ! missing values. This is why we affect default values.
+USE MODD_PARAM_n ! For SPAWNING DEFAULT_DESFM2 is also used
+USE MODD_LBC_n
+USE MODD_OUT_n
+USE MODD_TURB_n
+USE MODD_BUDGET
+USE MODD_LES
+USE MODD_PARAM_RAD_n
+#ifdef MNH_ECRAD
+USE MODD_PARAM_ECRAD_n
+#if ( VER_ECRAD == 140 )
+USE MODD_RADIATIONS_n , ONLY : NSWB_MNH, NLWB_MNH
+#endif
+#endif
+USE MODD_BLANK_n
+USE MODD_FRC
+USE MODD_PARAM_ICE
+USE MODD_PARAM_C2R2
+USE MODD_TURB_CLOUD
+USE MODD_PARAM_KAFR_n
+USE MODD_PARAM_MFSHALL_n
+USE MODD_CH_MNHC_n
+USE MODD_SERIES_n
+USE MODD_NUDGING_n
+USE MODD_CH_AEROSOL
+USE MODD_DUST
+USE MODD_SALT
+USE MODD_PASPOL
+USE MODD_CONDSAMP
+USE MODD_MEAN_FIELD
+USE MODD_DRAGTREE_n
+USE MODD_DRAGBLDG_n
+USE MODD_EOL_MAIN
+USE MODD_EOL_ADNR
+USE MODD_EOL_ALM
+USE MODD_EOL_SHARED_IO
+USE MODD_ALLSTATION_n
+!
+!
+USE MODD_PARAM_LIMA, ONLY : LCOLD, LNUCL, LSEDI, LHHONI, LSNOW, LHAIL, LMEYERS, &
+ NMOD_IFN, XIFN_CONC, LIFN_HOM, CIFN_SPECIES, &
+ CINT_MIXING, NMOD_IMM, NIND_SPECIE, &
+ CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA, &
+ XFACTNUC_DEP, XFACTNUC_CON, &
+ OWARM=>LWARM, LACTI, ORAIN=>LRAIN, OSEDC=>LSEDC, &
+ OACTIT=>LACTIT, LBOUND, LSPRO, LADJ, &
+ NMOD_CCN, XCCN_CONC, &
+ LCCN_HOM, CCCN_MODES, &
+ YALPHAR=>XALPHAR, YNUR=>XNUR, &
+ YALPHAC=>XALPHAC, YNUC=>XNUC, CINI_CCN=>HINI_CCN, &
+ CTYPE_CCN=>HTYPE_CCN, YFSOLUB_CCN=>XFSOLUB_CCN, &
+ YACTEMP_CCN=>XACTEMP_CCN, YAERDIFF=>XAERDIFF, &
+ YAERHEIGHT=>XAERHEIGHT, &
+ LSCAV, LAERO_MASS, NPHILLIPS, &
+ LCIBU, XNDEBRIS_CIBU, LRDSF, &
+ ODEPOC=>LDEPOC, OVDEPOC=>XVDEPOC, OACTTKE=>LACTTKE, &
+ LPTSPLIT, L_LFEEDBACKT=>LFEEDBACKT, L_NMAXITER=>NMAXITER, &
+ L_XMRSTEP=>XMRSTEP, L_XTSTEP_TS=>XTSTEP_TS
+!
+USE MODD_LATZ_EDFLX
+USE MODD_2D_FRC
+USE MODD_BLOWSNOW
+USE MODD_BLOWSNOW_n
+USE MODD_DRAG_n
+USE MODD_VISCOSITY
+USE MODD_RECYCL_PARAM_n
+USE MODD_IBM_PARAM_n
+USE MODD_IBM_LSF
+#ifdef MNH_FOREFIRE
+USE MODD_FOREFIRE
+#endif
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KMI ! Model index
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: JM ! loop index
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. SET DEFAULT VALUES FOR MODD_LUNIT_n :
+! ----------------------------------
+!
+! CINIFILE='INIFILE'
+CINIFILEPGD='' !Necessary to keep this line to prevent problems with spawning
+CCPLFILE(:)=' '
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. SET DEFAULT VALUES FOR MODD_CONF AND MODD_CONF_n :
+! ------------------------------------------------
+!
+IF (KMI == 1) THEN
+ CCONF ='START'
+ LTHINSHELL = .FALSE.
+ L2D = .FALSE.
+ L1D = .FALSE.
+ LFLAT = .FALSE.
+ NMODEL = 1
+ CEQNSYS = 'DUR'
+ NVERB = 5
+ CEXP = 'EXP01'
+ CSEG = 'SEG01'
+ LFORCING = .FALSE.
+ L2D_ADV_FRC= .FALSE.
+ L2D_REL_FRC= .FALSE.
+ XRELAX_HEIGHT_BOT = 0.
+ XRELAX_HEIGHT_TOP = 30000.
+ XRELAX_TIME = 864000.
+ LPACK = .TRUE.
+ NHALO = 1
+#ifdef MNH_SX5
+ CSPLIT ='YSPLITTING' ! NEC vectoriel architecture , low number of PROC
+#else
+ CSPLIT ='BSPLITTING' ! Scalaire architecture , high number of PROC
+#endif
+ NZ_PROC = 0 !JUAN Z_SPLITTING :: number of proc in Z splitting
+ NZ_SPLITTING = 10 !JUAN Z_SPLITTING :: for debug NZ=1=flat_inv; NZ=10=flat_invz; NZ=1+2 the two
+ LLG = .FALSE.
+ LINIT_LG = .FALSE.
+ CINIT_LG = 'FMOUT'
+ LNOMIXLG = .FALSE.
+ LCHECK = .FALSE.
+END IF
+!
+CCLOUD = 'NONE'
+LUSERV = .TRUE.
+LUSERC = .FALSE.
+LUSERR = .FALSE.
+LUSERI = .FALSE.
+LUSERS = .FALSE.
+LUSERG = .FALSE.
+LUSERH = .FALSE.
+LOCEAN = .FALSE.
+!NSV = 0
+!NSV_USER = 0
+LUSECI = .FALSE.
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. SET DEFAULT VALUES FOR MODD_DYN AND MODD_DYN_n :
+! -----------------------------------------------
+!
+IF (KMI == 1) THEN
+ XSEGLEN = 43200.
+ XASSELIN = 0.2
+ XASSELIN_SV = 0.02
+ LCORIO = .TRUE.
+ LNUMDIFU = .TRUE.
+ LNUMDIFTH = .FALSE.
+ LNUMDIFSV = .FALSE.
+ XALZBOT = 4000.
+ XALKTOP = 0.01
+ XALKGRD = 0.01
+ XALZBAS = 0.01
+END IF
+!
+XTSTEP = 60.
+CPRESOPT = 'CRESI'
+NITR = 4
+LITRADJ = .TRUE.
+LRES = .FALSE.
+XRES = 1.E-07
+XRELAX = 1.
+LVE_RELAX = .FALSE.
+LVE_RELAX_GRD = .FALSE.
+XRIMKMAX = 0.01 / XTSTEP
+XT4DIFU = 1800.
+XT4DIFTH = 1800.
+XT4DIFSV = 1800.
+!
+IF (KMI == 1) THEN ! for model 1 we have a Large scale information
+ NRIMX = JPRIMMAX ! for U,V,W,TH,Rv used for the hor. relaxation
+ NRIMY = JPRIMMAX
+ELSE
+ NRIMX = 0 ! for inner models we use only surfacic fields to
+ NRIMY = 0 ! give the lbc and no hor. relaxation is used
+END IF
+!
+LHORELAX_UVWTH = .FALSE.
+LHORELAX_RV = .FALSE.
+LHORELAX_RC = .FALSE. ! for all these fields, no large scale is usally available
+LHORELAX_RR = .FALSE. ! for model 1 and for inner models, we only use surfacic
+LHORELAX_RS = .FALSE. ! fiels ( no hor. relax. )
+LHORELAX_RI = .FALSE.
+LHORELAX_RG = .FALSE.
+LHORELAX_RH = .FALSE.
+LHORELAX_TKE = .FALSE.
+LHORELAX_SV(:) = .FALSE.
+LHORELAX_SVC2R2 = .FALSE.
+LHORELAX_SVC1R3 = .FALSE.
+LHORELAX_SVELEC = .FALSE.
+LHORELAX_SVLG = .FALSE.
+LHORELAX_SVCHEM = .FALSE.
+LHORELAX_SVCHIC = .FALSE.
+LHORELAX_SVDST = .FALSE.
+LHORELAX_SVSLT = .FALSE.
+LHORELAX_SVPP = .FALSE.
+LHORELAX_SVCS = .FALSE.
+LHORELAX_SVAER = .FALSE.
+!
+LHORELAX_SVLIMA = .FALSE.
+!
+#ifdef MNH_FOREFIRE
+LHORELAX_SVFF = .FALSE.
+#endif
+LHORELAX_SVSNW = .FALSE.
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. SET DEFAULT VALUES FOR MODD_NESTING :
+! -----------------------------------
+!
+IF (KMI == 1) THEN
+ NDAD(1)=1
+ DO JM=2,JPMODELMAX
+ NDAD(JM) = JM - 1
+ END DO
+ NDTRATIO(:) = 1
+ XWAY(:) = 2. ! two-way interactive gridnesting
+ XWAY(1) = 0. ! except for model 1
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. SET DEFAULT VALUES FOR MODD_ADV_n :
+! ----------------------------------
+!
+CUVW_ADV_SCHEME = 'CEN4TH'
+CMET_ADV_SCHEME = 'PPM_01'
+CSV_ADV_SCHEME = 'PPM_01'
+CTEMP_SCHEME = 'RKC4'
+NWENO_ORDER = 3
+NSPLIT = 1
+LSPLIT_CFL = .TRUE.
+LSPLIT_WENO = .TRUE.
+XSPLIT_CFL = 0.8
+LCFL_WRIT = .FALSE.
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. SET DEFAULT VALUES FOR MODD_PARAM_n :
+! -----------------------------------
+!
+CTURB = 'NONE'
+CRAD = 'NONE'
+CDCONV = 'NONE'
+CSCONV = 'NONE'
+CELEC = 'NONE'
+CACTCCN = 'NONE'
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. SET DEFAULT VALUES FOR MODD_LBC_n :
+! ---------------------------------
+!
+CLBCX(1) ='CYCL'
+CLBCX(2) ='CYCL'
+CLBCY(1) ='CYCL'
+CLBCY(2) ='CYCL'
+NLBLX(:) = 1
+NLBLY(:) = 1
+XCPHASE = 20.
+XCPHASE_PBL = 0.
+XCARPKMAX = XUNDEF
+XPOND = 1.0
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. SET DEFAULT VALUES FOR MODD_NUDGING_n :
+! ---------------------------------
+!
+LNUDGING = .FALSE.
+XTNUDGING = 21600.
+!
+!-------------------------------------------------------------------------------
+!
+!* 9. SET DEFAULT VALUES FOR MODD_BAKOUT and MODD_OUT_n :
+! ------------------------------------------------
+!
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 10. SET DEFAULT VALUES FOR MODD_TURB_n :
+! ----------------------------------
+!
+XIMPL = 1.
+XKEMIN = 0.01
+XCEDIS = 0.84
+XCADAP = 0.5
+CTURBLEN = 'BL89'
+CTURBDIM = '1DIM'
+LTURB_FLX =.FALSE.
+LTURB_DIAG=.FALSE.
+LSUBG_COND=.FALSE.
+CSUBG_AUCV='NONE'
+CSUBG_AUCV_RI='NONE'
+LSIGMAS =.TRUE.
+LSIG_CONV =.FALSE.
+LRMC01 =.FALSE.
+CTOM ='NONE'
+VSIGQSAT = 0.02
+CCONDENS='CB02'
+CLAMBDA3='CB'
+CSUBG_MF_PDF='TRIANGLE'
+LHGRAD =.FALSE.
+XCOEFHGRADTHL = 1.0
+XCOEFHGRADRM = 1.0
+XALTHGRAD = 2000.0
+XCLDTHOLD = -1.0
+
+!-------------------------------------------------------------------------------
+!
+!* 10b. SET DEFAULT VALUES FOR MODD_DRAGTREE :
+! ----------------------------------
+!
+LDRAGTREE = .FALSE.
+LDEPOTREE = .FALSE.
+XVDEPOTREE = 0.02 ! 2 cm/s
+!------------------------------------------------------------------------------
+!
+!* 10c. SET DEFAULT VALUES FOR MODD_DRAGB
+! ----------------------------------
+!
+LDRAGBLDG = .FALSE.
+!
+!* 10d. SET DEFAULT VALUES FOR MODD_EOL* :
+! ----------------------------------
+!
+! 10d.i) MODD_EOL_MAIN
+!
+LMAIN_EOL = .FALSE.
+CMETH_EOL = 'ADNR'
+CSMEAR = '3LIN'
+NMODEL_EOL = 1
+!
+! 10d.ii) MODD_EOL_SHARED_IO
+!
+CFARM_CSVDATA = 'data_farm.csv'
+CTURBINE_CSVDATA = 'data_turbine.csv'
+CBLADE_CSVDATA = 'data_blade.csv'
+CAIRFOIL_CSVDATA = 'data_airfoil.csv'
+!
+CINTERP = 'CLS'
+!
+! 10d.iii) MODD_EOL_ALM
+!
+NNB_BLAELT = 42
+LTIMESPLIT = .FALSE.
+LTIPLOSSG = .TRUE.
+LTECOUTPTS = .FALSE.
+!
+!------------------------------------------------------------------------------
+!* 10.e SET DEFAULT VALUES FOR MODD_ALLSTATION_n :
+! ----------------------------------
+!
+NNUMB_STAT = 0
+XSTEP_STAT = 60.0
+XX_STAT(:) = XUNDEF
+XY_STAT(:) = XUNDEF
+XZ_STAT(:) = XUNDEF
+XLAT_STAT(:) = XUNDEF
+XLON_STAT(:) = XUNDEF
+CNAME_STAT(:) = ''
+CTYPE_STAT(:) = ''
+CFILE_STAT = 'NO_INPUT_CSV'
+LDIAG_SURFRAD = .TRUE.
+!
+!-------------------------------------------------------------------------------
+!
+!* 11. SET DEFAULT VALUES FOR MODD_BUDGET :
+! ------------------------------------
+!
+! 11.1 General budget variables
+!
+IF (KMI == 1) THEN
+ CBUTYPE = 'NONE'
+ NBUMOD = 1
+ XBULEN = XSEGLEN
+ XBUWRI = XSEGLEN
+ NBUKL = 1
+ NBUKH = 0
+ LBU_KCP = .TRUE.
+!
+! 11.2 Variables for the cartesian box
+!
+ NBUIL = 1
+ NBUIH = 0
+ NBUJL = 1
+ NBUJH = 0
+ LBU_ICP = .TRUE.
+ LBU_JCP = .TRUE.
+!
+! 11.3 Variables for the mask
+!
+ NBUMASK = 1
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 12. SET DEFAULT VALUES FOR MODD_LES :
+! ---------------------------------
+!
+IF (KMI == 1) THEN
+ LLES_MEAN = .FALSE.
+ LLES_RESOLVED = .FALSE.
+ LLES_SUBGRID = .FALSE.
+ LLES_UPDRAFT = .FALSE.
+ LLES_DOWNDRAFT = .FALSE.
+ LLES_SPECTRA = .FALSE.
+!
+ NLES_LEVELS = NUNDEF
+ XLES_ALTITUDES = XUNDEF
+ NSPECTRA_LEVELS = NUNDEF
+ XSPECTRA_ALTITUDES = XUNDEF
+ NLES_TEMP_SERIE_I = NUNDEF
+ NLES_TEMP_SERIE_J = NUNDEF
+ NLES_TEMP_SERIE_Z = NUNDEF
+ CLES_NORM_TYPE = 'NONE'
+ CBL_HEIGHT_DEF = 'KE'
+ XLES_TEMP_SAMPLING = XUNDEF
+ XLES_TEMP_MEAN_START = XUNDEF
+ XLES_TEMP_MEAN_END = XUNDEF
+ XLES_TEMP_MEAN_STEP = 3600.
+ LLES_CART_MASK = .FALSE.
+ NLES_IINF = NUNDEF
+ NLES_ISUP = NUNDEF
+ NLES_JINF = NUNDEF
+ NLES_JSUP = NUNDEF
+ LLES_NEB_MASK = .FALSE.
+ LLES_CORE_MASK = .FALSE.
+ LLES_MY_MASK = .FALSE.
+ NLES_MASKS_USER = NUNDEF
+ LLES_CS_MASK = .FALSE.
+
+ LLES_PDF = .FALSE.
+ NPDF = 1
+ XTH_PDF_MIN = 270.
+ XTH_PDF_MAX = 350.
+ XW_PDF_MIN = -10.
+ XW_PDF_MAX = 10.
+ XTHV_PDF_MIN = 270.
+ XTHV_PDF_MAX = 350.
+ XRV_PDF_MIN = 0.
+ XRV_PDF_MAX = 20.
+ XRC_PDF_MIN = 0.
+ XRC_PDF_MAX = 1.
+ XRR_PDF_MIN = 0.
+ XRR_PDF_MAX = 1.
+ XRI_PDF_MIN = 0.
+ XRI_PDF_MAX = 1.
+ XRS_PDF_MIN = 0.
+ XRS_PDF_MAX = 1.
+ XRG_PDF_MIN = 0.
+ XRG_PDF_MAX = 1.
+ XRT_PDF_MIN = 0.
+ XRT_PDF_MAX = 20.
+ XTHL_PDF_MIN = 270.
+ XTHL_PDF_MAX = 350.
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 13. SET DEFAULT VALUES FOR MODD_PARAM_RAD_n :
+! ---------------------------------------
+!
+XDTRAD = XTSTEP
+XDTRAD_CLONLY = XTSTEP
+LCLEAR_SKY =.FALSE.
+NRAD_COLNBR = 1000
+NRAD_DIAG = 0
+CLW ='RRTM'
+CAER='SURF'
+CAOP='CLIM'
+CEFRADL='MART'
+CEFRADI='LIOU'
+COPWSW = 'FOUQ'
+COPISW = 'EBCU'
+COPWLW = 'SMSH'
+COPILW = 'EBCU'
+XFUDG = 1.
+LAERO_FT=.FALSE.
+LFIX_DAT=.FALSE.
+!
+#ifdef MNH_ECRAD
+!* 13bis. SET DEFAULT VALUES FOR MODD_PARAM_ECRAD_n :
+! ---------------------------------------
+!
+#if ( VER_ECRAD == 101 )
+NSWSOLVER = 0 ! 0: 'McICA 1: 'SPARTACUS' 2: 'SPARTACUS' + 3D effect
+NLWSOLVER = 0 ! 0: 'McICA 1: 'SPARTACUS' 2: 'SPARTACUS' + 3D effect
+#endif
+#if ( VER_ECRAD == 140 )
+LSPEC_ALB = .FALSE.
+LSPEC_EMISS = .FALSE.
+
+
+!ALLOCATE(USER_ALB_DIFF(NSWB_MNH))
+!ALLOCATE(USER_ALB_DIR(NSWB_MNH))
+!ALLOCATE(USER_EMISS(NLWB_MNH))
+!PRINT*,USER_ALB_DIFF
+!USER_ALB_DIFF = (/0,0,0,0,0,0,0,0,0,0,0,0,0,0/)
+!USER_ALB_DIR = (/0,0,0,0,0,0,0,0,0,0,0,0,0,0/)
+!USER_EMISS = (/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0/)
+SURF_TYPE="SNOW"
+
+NLWSOLVER = 1 ! 0: 'McICA 1: 'SPARTACUS' 2: 'SPARTACUS' + 3D effect
+NSWSOLVER = 1 ! 0: 'McICA 1: 'SPARTACUS' 2: 'SPARTACUS' + 3D effect
+#endif
+! LEFF3D = .TRUE.
+! LSIDEM = .TRUE.
+NREG = 3 ! Number of cloudy regions (3=TripleClouds)
+! LLWCSCA = .TRUE. ! LW cloud scattering
+! LLWASCA = .TRUE. ! LW aerosols scattering
+NLWSCATTERING = 2
+NAERMACC = 0
+! CGAS = 'RRTMG-IFS' ! Gas optics model
+NOVLP = 1 ! overlap assumption ; 0= 'Max-Ran' ; 1= 'Exp-Ran'; 2 = 'Exp-Exp'
+NLIQOPT = 3 ! 1: 'Monochromatic', 2: 'HuStamnes', 3: 'SOCRATES', 4: 'Slingo'
+NICEOPT = 3 ! 1: 'Monochromatic', 2: 'Fu-PSRAD', 3: 'Fu-IFS', 4: 'Baran', 5: 'Baran2016', 6: 'Baran2017'
+! LSW_ML_E = .FALSE.
+! LLW_ML_E = .FALSE.
+! LPSRAD = .FALSE.
+!
+NRADLP = 1 ! 0: ERA-15, 1: Zhang and Rossow, 2: Martin (1994) et Woods (2000)
+NRADIP = 1 ! 0: 40 mum, 1: Liou and Ou (1994), 2: Liou and Ou (1994) improved, 3: Sun and Rikus (1999)
+XCLOUD_FRAC_STD = 1.0_JPRB ! change to 0.75 for more realistic distribution
+#endif
+!-------------------------------------------------------------------------------
+!
+!* 14. SET DEFAULT VALUES FOR MODD_BLANK_n :
+! -----------------------------------
+!
+XDUMMY1 = 0.
+XDUMMY2 = 0.
+XDUMMY3 = 0.
+XDUMMY4 = 0.
+XDUMMY5 = 0.
+XDUMMY6 = 0.
+XDUMMY7 = 0.
+XDUMMY8 = 0.
+!
+NDUMMY1 = 0
+NDUMMY2 = 0
+NDUMMY3 = 0
+NDUMMY4 = 0
+NDUMMY5 = 0
+NDUMMY6 = 0
+NDUMMY7 = 0
+NDUMMY8 = 0
+!
+LDUMMY1 = .TRUE.
+LDUMMY2 = .TRUE.
+LDUMMY3 = .TRUE.
+LDUMMY4 = .TRUE.
+LDUMMY5 = .TRUE.
+LDUMMY6 = .TRUE.
+LDUMMY7 = .TRUE.
+LDUMMY8 = .TRUE.
+!
+CDUMMY1 = ' '
+CDUMMY2 = ' '
+CDUMMY3 = ' '
+CDUMMY4 = ' '
+CDUMMY5 = ' '
+CDUMMY6 = ' '
+CDUMMY7 = ' '
+CDUMMY8 = ' '
+!
+!------------------------------------------------------------------------------
+!
+!* 15. SET DEFAULT VALUES FOR MODD_FRC :
+! ---------------------------------
+!
+IF (KMI == 1) THEN
+ LGEOST_UV_FRC = .FALSE.
+ LGEOST_TH_FRC = .FALSE.
+ LTEND_THRV_FRC = .FALSE.
+ LTEND_UV_FRC = .FALSE.
+ LVERT_MOTION_FRC = .FALSE.
+ LRELAX_THRV_FRC = .FALSE.
+ LRELAX_UV_FRC = .FALSE.
+ LRELAX_UVMEAN_FRC = .FALSE.
+ XRELAX_TIME_FRC = 10800.
+ XRELAX_HEIGHT_FRC = 0.
+ CRELAX_HEIGHT_TYPE = "FIXE"
+ LTRANS = .FALSE.
+ XUTRANS = 0.0
+ XVTRANS = 0.0
+ LPGROUND_FRC = .FALSE.
+ LDEEPOC = .FALSE.
+ XCENTX_OC = 16000.
+ XCENTY_OC = 16000.
+ XRADX_OC = 8000.
+ XRADY_OC = 8000.
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 16. SET DEFAULT VALUES FOR MODD_PARAM_ICE :
+! ---------------------------------------
+!
+IF (KMI == 1) THEN
+ LRED = .TRUE.
+ LWARM = .TRUE.
+ CPRISTINE_ICE = 'PLAT'
+ LSEDIC = .TRUE.
+ LCONVHG = .FALSE.
+ CSEDIM = 'SPLI'
+ LFEEDBACKT = .TRUE.
+ LEVLIMIT = .TRUE.
+ LNULLWETG = .TRUE.
+ LWETGPOST = .TRUE.
+ LNULLWETH = .TRUE.
+ LWETHPOST = .TRUE.
+ CSNOWRIMING = 'M90 '
+ CSUBG_RC_RR_ACCR = 'NONE'
+ CSUBG_RR_EVAP = 'NONE'
+ CSUBG_PR_PDF = 'SIGM'
+ XFRACM90 = 0.1
+ LCRFLIMIT = .TRUE.
+ NMAXITER = 5
+ XMRSTEP = 0.00005
+ XTSTEP_TS = 0.
+ LADJ_BEFORE = .TRUE.
+ LADJ_AFTER = .TRUE.
+ CFRAC_ICE_ADJUST = 'S'
+ XSPLIT_MAXCFL = 0.8
+ CFRAC_ICE_SHALLOW_MF = 'S'
+ LSEDIM_AFTER = .FALSE.
+ LDEPOSC = .FALSE.
+ XVDEPOSC= 0.02 ! 2 cm/s
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 17. SET DEFAULT VALUES FOR MODD_PARAM_KAFR_n :
+! --------------------------------------------
+!
+XDTCONV = MAX( 300.0,XTSTEP )
+NICE = 1
+LREFRESH_ALL = .TRUE.
+LCHTRANS = .FALSE.
+LDOWN = .TRUE.
+LSETTADJ = .FALSE.
+XTADJD = 3600.
+XTADJS = 10800.
+LDIAGCONV = .FALSE.
+NENSM = 0
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 18. SET DEFAULT VALUES FOR MODD_PARAM_MFSHALL_n :
+! --------------------------------------------
+!
+XIMPL_MF = 1.
+CMF_UPDRAFT = 'EDKF'
+CMF_CLOUD = 'DIRE'
+LMIXUV = .TRUE.
+LMF_FLX = .FALSE.
+!
+XALP_PERT = 0.3
+XABUO = 1.
+XBENTR = 1.
+XBDETR = 0.
+XCMF = 0.065
+XENTR_MF = 0.035
+XCRAD_MF = 50.
+XENTR_DRY = 0.55
+XDETR_DRY = 10.
+XDETR_LUP = 1.
+XKCF_MF = 2.75
+XKRC_MF = 1.
+XTAUSIGMF = 600.
+XPRES_UV = 0.5
+XFRAC_UP_MAX= 0.33
+XALPHA_MF = 2.
+XSIGMA_MF = 20.
+!
+XA1 = 2./3.
+XB = 0.002
+XC = 0.012
+XBETA1 = 0.9
+XR = 2.
+XLAMBDA_MF= 0.
+LGZ = .FALSE.
+XGZ = 1.83 ! between 1.83 and 1.33
+!
+!-------------------------------------------------------------------------------
+!
+!* 19. SET DEFAULT VALUES FOR MODD_PARAM_C2R2 :
+! ----------------------------------------
+!
+IF (KMI == 1) THEN
+ XNUC = 1.0
+ XALPHAC = 3.0
+ XNUR = 2.0
+ XALPHAR = 1.0
+!
+ LRAIN = .TRUE.
+ LSEDC = .TRUE.
+ LACTIT = .FALSE.
+ LSUPSAT = .FALSE.
+ LDEPOC = .FALSE.
+ XVDEPOC = 0.02 ! 2 cm/s
+ LACTTKE = .TRUE.
+!
+ HPARAM_CCN = 'XXX'
+ HINI_CCN = 'XXX'
+ HTYPE_CCN = 'X'
+!
+ XCHEN = 0.0
+ XKHEN = 0.0
+ XMUHEN = 0.0
+ XBETAHEN = 0.0
+!
+ XCONC_CCN = 0.0
+ XAERDIFF = 0.0
+ XAERHEIGHT = 2000
+ XR_MEAN_CCN = 0.0
+ XLOGSIG_CCN = 0.0
+ XFSOLUB_CCN = 1.0
+ XACTEMP_CCN = 280.
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 19.BIS SET DEFAULT VALUES FOR MODD_PARAM_LIMA :
+! ----------------------------------------
+!
+LPTSPLIT = .FALSE.
+L_LFEEDBACKT = .TRUE.
+L_NMAXITER = 1
+L_XMRSTEP = 0.
+L_XTSTEP_TS = 0.
+!
+IF (KMI == 1) THEN
+ YNUC = 1.0
+ YALPHAC = 3.0
+ YNUR = 2.0
+ YALPHAR = 1.0
+!
+ OWARM = .TRUE.
+ LACTI = .TRUE.
+ ORAIN = .TRUE.
+ OSEDC = .TRUE.
+ OACTIT = .FALSE.
+ LADJ = .TRUE.
+ LSPRO = .FALSE.
+ ODEPOC = .FALSE.
+ LBOUND = .FALSE.
+ OACTTKE = .TRUE.
+!
+ OVDEPOC = 0.02 ! 2 cm/s
+!
+ CINI_CCN = 'AER'
+ CTYPE_CCN(:) = 'M'
+!
+ YAERDIFF = 0.0
+ YAERHEIGHT = 2000.
+! YR_MEAN_CCN = 0.0 ! In case of 'CCN' initialization
+! YLOGSIG_CCN = 0.0
+ YFSOLUB_CCN = 1.0
+ YACTEMP_CCN = 280.
+!
+ NMOD_CCN = 1
+!
+!* AP Scavenging
+!
+ LSCAV = .FALSE.
+ LAERO_MASS = .FALSE.
+!
+ LCCN_HOM = .TRUE.
+ CCCN_MODES = 'COPT'
+ XCCN_CONC(:)=300.
+ENDIF
+!
+IF (KMI == 1) THEN
+ LHHONI = .FALSE.
+ LCOLD = .TRUE.
+ LNUCL = .TRUE.
+ LSEDI = .TRUE.
+ LSNOW = .TRUE.
+ LHAIL = .FALSE.
+ CPRISTINE_ICE_LIMA = 'PLAT'
+ CHEVRIMED_ICE_LIMA = 'GRAU'
+ XFACTNUC_DEP = 1.0
+ XFACTNUC_CON = 1.0
+ NMOD_IFN = 1
+ NIND_SPECIE = 1
+ LMEYERS = .FALSE.
+ LIFN_HOM = .TRUE.
+ CIFN_SPECIES = 'PHILLIPS'
+ CINT_MIXING = 'DM2'
+ XIFN_CONC(:) = 100.
+ NMOD_IMM = 0
+ NPHILLIPS=8
+ LCIBU = .FALSE.
+ XNDEBRIS_CIBU = 50.0
+ LRDSF = .FALSE.
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 20. SET DEFAULT VALUES FOR MODD_CH_MNHC_n
+! -------------------------------------
+!
+LUSECHEM = .FALSE.
+LUSECHAQ = .FALSE.
+LUSECHIC = .FALSE.
+LCH_INIT_FIELD = .FALSE.
+LCH_CONV_SCAV = .FALSE.
+LCH_CONV_LINOX = .FALSE.
+LCH_PH = .FALSE.
+LCH_RET_ICE = .FALSE.
+XCH_PHINIT = 5.2
+XRTMIN_AQ = 5.e-8
+CCHEM_INPUT_FILE = 'EXSEG1.nam'
+CCH_TDISCRETIZATION = 'SPLIT'
+NCH_SUBSTEPS = 1
+LCH_TUV_ONLINE = .FALSE.
+CCH_TUV_LOOKUP = 'PHOTO.TUV39'
+CCH_TUV_CLOUDS = 'NONE'
+XCH_TUV_ALBNEW = -1.
+XCH_TUV_DOBNEW = -1.
+XCH_TUV_TUPDATE = 600.
+CCH_VEC_METHOD = 'MAX'
+NCH_VEC_LENGTH = 50
+XCH_TS1D_TSTEP = 600.
+CCH_TS1D_COMMENT = 'no comment'
+CCH_TS1D_FILENAME = 'IO1D'
+CSPEC_PRODLOSS = ''
+CSPEC_BUDGET = ''
+!
+!-------------------------------------------------------------------------------
+!
+!* 21. SET DEFAULT VALUES FOR MODD_SERIES AND MODD_SERIE_n
+! ---------------------------------------------------
+!
+IF (KMI == 1) THEN
+ LSERIES = .FALSE.
+ LMASKLANDSEA = .FALSE.
+ LWMINMAX = .FALSE.
+ LSURF = .FALSE.
+ENDIF
+!
+NIBOXL = 1 !+ JPHEXT
+NIBOXH = 1 !+ 2*JPHEXT
+NJBOXL = 1 !+ JPHEXT
+NJBOXH = 1 !+ 2*JPHEXT
+NKCLS = 1 !+ JPVEXT
+NKLOW = 1 !+ JPVEXT
+NKMID = 1 !+ JPVEXT
+NKUP = 1 !+ JPVEXT
+NKCLA = 1 !+ JPVEXT
+NBJSLICE = 1
+NJSLICEL(:) = 1 !+ JPHEXT
+NJSLICEH(:) = 1 !+ 2*JPHEXT
+NFREQSERIES = INT(XSEGLEN /(100.*XTSTEP) )
+NFREQSERIES = MAX(NFREQSERIES,1)
+!
+!-------------------------------------------------------------------------------
+!
+!* 22. SET DEFAULT VALUES FOR MODD_TURB_CLOUD
+! --------------------------------------
+!
+IF (KMI == 1) THEN
+ NMODEL_CLOUD = NUNDEF
+ CTURBLEN_CLOUD = 'DELT'
+ XCOEF_AMPL_SAT = 5.
+ XCEI_MIN = 0.001E-06
+ XCEI_MAX = 0.01E-06
+ENDIF
+!-------------------------------------------------------------------------------
+!
+!* 22. SET DEFAULT VALUES FOR MODD_MEAN_FIELD
+! --------------------------------------
+!
+IF (KMI == 1) THEN
+ LMEAN_FIELD = .FALSE.
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 22. SET DEFAULT VALUES FOR MODD_AEROSOL
+! -----------------------------------
+IF (KMI == 1) THEN ! other values are defined in modd_ch_aerosol
+!
+! aerosol lognormal parameterization
+
+LVARSIGI = .FALSE. ! switch to active pronostic dispersion for I mode
+LVARSIGJ = .FALSE. ! switch to active pronostic dispersion for J mode
+LHETEROSO4 = .FALSE. ! switch to active sulfates heteronegeous
+ ! production
+LSEDIMAERO = .FALSE. ! switch to active aerosol sedimentation
+LAERINIT = .FALSE. ! switch to initialize aerosol in arome
+CMINERAL = "NONE" ! mineral equilibrium scheme
+CORGANIC = "NONE" ! mineral equilibrium scheme
+CNUCLEATION = "NONE" ! sulfates nucleation scheme
+LDEPOS_AER(:) = .FALSE.
+
+ENDIF
+
+!* 23. SET DEFAULT VALUES FOR MODD_DUST and MODD_SALT
+! ----------------------------------------------
+!
+IF (KMI == 1) THEN ! other values initialized in modd_dust
+ LDUST = .FALSE.
+ NMODE_DST = 3
+ LVARSIG = .FALSE.
+ LSEDIMDUST = .FALSE.
+ LDEPOS_DST(:) = .FALSE.
+
+ LSALT = .FALSE.
+ LVARSIG_SLT= .FALSE.
+ LSEDIMSALT = .FALSE.
+ LDEPOS_SLT(:) = .FALSE.
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 24. SET DEFAULT VALUES FOR MODD_PASPOL
+! ----------------------------------
+!
+! other values initialized in modd_paspol
+!
+IF (KMI == 1) THEN
+ LPASPOL = .FALSE.
+ NRELEASE = 0
+ CPPINIT(:) ='1PT'
+ XPPLAT(:) = 0.
+ XPPLON (:) = 0.
+ XPPMASS(:) = 0.
+ XPPBOT(:) = 0.
+ XPPTOP(:) = 0.
+ CPPT1(:) = "20010921090000"
+ CPPT2(:) = "20010921090000"
+ CPPT3(:) = "20010921091500"
+ CPPT4(:) = "20010921091500"
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 25. SET DEFAULT VALUES FOR MODD_CONDSAMP
+! ----------------------------------
+!
+! other values initialized in modd_condsamp
+!
+IF (KMI == 1) THEN
+ LCONDSAMP = .FALSE.
+ NCONDSAMP = 3
+ XRADIO(:) = 900.
+ XSCAL(:) = 1.
+ XHEIGHT_BASE = 100.
+ XDEPTH_BASE = 100.
+ XHEIGHT_TOP = 100.
+ XDEPTH_TOP = 100.
+ NFINDTOP = 0
+ XTHVP = 0.25
+ LTPLUS = .TRUE.
+ENDIF
+!-------------------------------------------------------------------------------
+!
+!
+!* 26. SET DEFAULT VALUES FOR MODD_LATZ_EDFLX
+! ----------------------------------
+!
+IF (KMI == 1) THEN
+ LUV_FLX=.FALSE.
+ XUV_FLX1=3.E+14
+ XUV_FLX2=0.
+ LTH_FLX=.FALSE.
+ XTH_FLX=0.75
+ENDIF
+#ifdef MNH_FOREFIRE
+!-------------------------------------------------------------------------------
+!
+!* 27. SET DEFAULT VALUES FOR MODD_FOREFIRE
+! ----------------------------------
+!
+! other values initialized in modd_forefire
+!
+IF (KMI == 1) THEN
+ LFOREFIRE = .FALSE.
+ LFFCHEM = .FALSE.
+ COUPLINGRES = 100.
+ NFFSCALARS = 0
+ENDIF
+#endif
+!-------------------------------------------------------------------------------
+!
+!* 28. SET DEFAULT VALUES FOR MODD_BLOWSNOW AND MODD_BLOWSNOW_n
+! ----------------------------------------
+!
+IF (KMI == 1) THEN
+ LBLOWSNOW = .FALSE.
+ XALPHA_SNOW = 3.
+ XRSNOW = 4.
+ CSNOWSEDIM = 'TABC'
+END IF
+LSNOWSUBL = .FALSE.
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 29. SET DEFAULT VALUES FOR MODD_VISC
+! ----------------------------------
+!
+! other values initialized in modd_VISC
+!
+IF (KMI == 1) THEN
+ LVISC = .FALSE.
+ LVISC_UVW = .FALSE.
+ LVISC_TH = .FALSE.
+ LVISC_SV = .FALSE.
+ LVISC_R = .FALSE.
+ XMU_V = 0.
+ XPRANDTL = 0.
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 30. SET DEFAULT VALUES FOR MODD_DRAG
+! ----------------------------------
+!
+! other values initialized in modd_DRAG
+!
+IF (KMI == 1) THEN
+ LDRAG = .FALSE.
+ LMOUNT = .FALSE.
+ NSTART = 1
+ XHSTART = 0.
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 31. SET DEFAULT VALUES FOR MODD_IBM_PARAMn
+! --------------------------------------
+!
+ LIBM = .FALSE.
+ LIBM_TROUBLE = .FALSE.
+ CIBM_ADV = 'NOTHIN'
+ XIBM_EPSI = 1.E-9
+ XIBM_IEPS = 1.E+9
+ NIBM_ITR = 8
+ XIBM_RUG = 0.01 ! (m^1.s^-0)
+ XIBM_VISC = 1.56e-5 ! (m^2.s^-1)
+ XIBM_CNU = 0.06 ! (m^0.s^-0)
+
+ NIBM_LAYER_P = 2
+ NIBM_LAYER_Q = 2
+ NIBM_LAYER_R = 2
+ NIBM_LAYER_S = 2
+ NIBM_LAYER_T = 2
+ NIBM_LAYER_E = 2
+ NIBM_LAYER_V = 2
+
+ XIBM_RADIUS_P = 2.
+ XIBM_RADIUS_Q = 2.
+ XIBM_RADIUS_R = 2.
+ XIBM_RADIUS_S = 2.
+ XIBM_RADIUS_T = 2.
+ XIBM_RADIUS_E = 2.
+ XIBM_RADIUS_V = 2.
+
+ XIBM_POWERS_P = 1.
+ XIBM_POWERS_Q = 1.
+ XIBM_POWERS_R = 1.
+ XIBM_POWERS_S = 1.
+ XIBM_POWERS_T = 1.
+ XIBM_POWERS_E = 1.
+ XIBM_POWERS_V = 1.
+
+ CIBM_MODE_INTE3_P = 'LAI'
+ CIBM_MODE_INTE3_Q = 'LAI'
+ CIBM_MODE_INTE3_R = 'LAI'
+ CIBM_MODE_INTE3_S = 'LAI'
+ CIBM_MODE_INTE3_T = 'LAI'
+ CIBM_MODE_INTE3_E = 'LAI'
+ CIBM_MODE_INTE3_V = 'LAI'
+
+ CIBM_MODE_INTE1_P = 'CL2'
+ CIBM_MODE_INTE1_Q = 'CL2'
+ CIBM_MODE_INTE1_R = 'CL2'
+ CIBM_MODE_INTE1_S = 'CL2'
+ CIBM_MODE_INTE1_T = 'CL2'
+ CIBM_MODE_INTE1_E = 'CL2'
+ CIBM_MODE_INTE1NV = 'CL2'
+ CIBM_MODE_INTE1TV = 'CL2'
+ CIBM_MODE_INTE1CV = 'CL2'
+
+ CIBM_MODE_BOUND_P = 'SYM'
+ CIBM_MODE_BOUND_Q = 'SYM'
+ CIBM_MODE_BOUND_R = 'SYM'
+ CIBM_MODE_BOUND_S = 'SYM'
+ CIBM_MODE_BOUND_T = 'SYM'
+ CIBM_MODE_BOUND_E = 'SYM'
+ CIBM_MODE_BOUNT_V = 'ASY'
+ CIBM_MODE_BOUNN_V = 'ASY'
+ CIBM_MODE_BOUNC_V = 'ASY'
+
+ XIBM_FORC_BOUND_P = 0.
+ XIBM_FORC_BOUND_Q = 0.
+ XIBM_FORC_BOUND_R = 0.
+ XIBM_FORC_BOUND_S = 0.
+ XIBM_FORC_BOUND_T = 0.
+ XIBM_FORC_BOUND_E = 0.
+ XIBM_FORC_BOUNN_V = 0.
+ XIBM_FORC_BOUNT_V = 0.
+ XIBM_FORC_BOUNC_V = 0.
+
+ CIBM_TYPE_BOUND_P = 'NEU'
+ CIBM_TYPE_BOUND_Q = 'NEU'
+ CIBM_TYPE_BOUND_R = 'NEU'
+ CIBM_TYPE_BOUND_S = 'NEU'
+ CIBM_TYPE_BOUND_T = 'NEU'
+ CIBM_TYPE_BOUND_E = 'NEU'
+ CIBM_TYPE_BOUNT_V = 'DIR'
+ CIBM_TYPE_BOUNN_V = 'DIR'
+ CIBM_TYPE_BOUNC_V = 'DIR'
+
+ CIBM_FORC_BOUND_P = 'CST'
+ CIBM_FORC_BOUND_Q = 'CST'
+ CIBM_FORC_BOUND_R = 'CST'
+ CIBM_FORC_BOUND_S = 'CST'
+ CIBM_FORC_BOUND_T = 'CST'
+ CIBM_FORC_BOUND_E = 'CST'
+ CIBM_FORC_BOUNN_V = 'CST'
+ CIBM_FORC_BOUNT_V = 'CST'
+ CIBM_FORC_BOUNC_V = 'CST'
+ CIBM_FORC_BOUNR_V = 'CST'
+
+!
+!-------------------------------------------------------------------------------
+!
+!* 32. SET DEFAULT VALUES FOR MODD_RECYCL_PARAMn
+! --------------------------------------
+!
+ LRECYCL = .FALSE.
+ LRECYCLN = .FALSE.
+ LRECYCLW = .FALSE.
+ LRECYCLE = .FALSE.
+ LRECYCLS = .FALSE.
+ XDRECYCLN = 0.
+ XARECYCLN = 0.
+ XDRECYCLW = 0.
+ XARECYCLW = 0.
+ XDRECYCLS = 0.
+ XARECYCLS = 0.
+ XDRECYCLE = 0.
+ XARECYCLE = 0.
+ XTMOY = 0.
+ XTMOYCOUNT = 0.
+ XNUMBELT = 28.
+ XRCOEFF = 0.2
+ XTBVTOP = 500.
+ XTBVBOT = 300.
+!
+!
+END SUBROUTINE DEFAULT_DESFM_n
diff --git a/src/ICCARE_BASE/ini_budget.f90 b/src/ICCARE_BASE/ini_budget.f90
new file mode 100644
index 0000000000000000000000000000000000000000..20cdbb4a448a63d2de3d2e65f37efd5c87973d16
--- /dev/null
+++ b/src/ICCARE_BASE/ini_budget.f90
@@ -0,0 +1,4727 @@
+!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 17/08/2020: add Budget_preallocate subroutine
+!-----------------------------------------------------------------
+module mode_ini_budget
+
+ use mode_msg
+
+ implicit none
+
+ private
+
+ public :: Budget_preallocate, Ini_budget
+
+ integer, parameter :: NSOURCESMAX = 60 !Maximum number of sources in a budget
+
+contains
+
+subroutine Budget_preallocate()
+
+use modd_budget, only: nbudgets, tbudgets, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_TKE, &
+ NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, &
+ NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1
+use modd_nsv, only: csvnames, nsv
+
+integer :: ibudget
+integer :: jsv
+
+call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_preallocate', 'called' )
+
+if ( allocated( tbudgets ) ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Budget_preallocate', 'tbudgets already allocated' )
+ return
+end if
+
+nbudgets = NBUDGET_SV1 - 1 + nsv
+allocate( tbudgets( nbudgets ) )
+
+tbudgets(NBUDGET_U)%cname = "UU"
+tbudgets(NBUDGET_U)%ccomment = "Budget for U"
+tbudgets(NBUDGET_U)%nid = NBUDGET_U
+
+tbudgets(NBUDGET_V)%cname = "VV"
+tbudgets(NBUDGET_V)%ccomment = "Budget for V"
+tbudgets(NBUDGET_V)%nid = NBUDGET_V
+
+tbudgets(NBUDGET_W)%cname = "WW"
+tbudgets(NBUDGET_W)%ccomment = "Budget for W"
+tbudgets(NBUDGET_W)%nid = NBUDGET_W
+
+tbudgets(NBUDGET_TH)%cname = "TH"
+tbudgets(NBUDGET_TH)%ccomment = "Budget for potential temperature"
+tbudgets(NBUDGET_TH)%nid = NBUDGET_TH
+
+tbudgets(NBUDGET_TKE)%cname = "TK"
+tbudgets(NBUDGET_TKE)%ccomment = "Budget for turbulent kinetic energy"
+tbudgets(NBUDGET_TKE)%nid = NBUDGET_TKE
+
+tbudgets(NBUDGET_RV)%cname = "RV"
+tbudgets(NBUDGET_RV)%ccomment = "Budget for water vapor mixing ratio"
+tbudgets(NBUDGET_RV)%nid = NBUDGET_RV
+
+tbudgets(NBUDGET_RC)%cname = "RC"
+tbudgets(NBUDGET_RC)%ccomment = "Budget for cloud water mixing ratio"
+tbudgets(NBUDGET_RC)%nid = NBUDGET_RC
+
+tbudgets(NBUDGET_RR)%cname = "RR"
+tbudgets(NBUDGET_RR)%ccomment = "Budget for rain water mixing ratio"
+tbudgets(NBUDGET_RR)%nid = NBUDGET_RR
+
+tbudgets(NBUDGET_RI)%cname = "RI"
+tbudgets(NBUDGET_RI)%ccomment = "Budget for cloud ice mixing ratio"
+tbudgets(NBUDGET_RI)%nid = NBUDGET_RI
+
+tbudgets(NBUDGET_RS)%cname = "RS"
+tbudgets(NBUDGET_RS)%ccomment = "Budget for snow/aggregate mixing ratio"
+tbudgets(NBUDGET_RS)%nid = NBUDGET_RS
+
+tbudgets(NBUDGET_RG)%cname = "RG"
+tbudgets(NBUDGET_RG)%ccomment = "Budget for graupel mixing ratio"
+tbudgets(NBUDGET_RG)%nid = NBUDGET_RG
+
+tbudgets(NBUDGET_RH)%cname = "RH"
+tbudgets(NBUDGET_RH)%ccomment = "Budget for hail mixing ratio"
+tbudgets(NBUDGET_RH)%nid = NBUDGET_RH
+
+do jsv = 1, nsv
+ ibudget = NBUDGET_SV1 - 1 + jsv
+ tbudgets(ibudget)%cname = Trim( csvnames(jsv) )
+ tbudgets(ibudget)%ccomment = 'Budget for scalar variable ' // Trim( csvnames(jsv) )
+ tbudgets(ibudget)%nid = ibudget
+end do
+
+
+end subroutine Budget_preallocate
+
+
+! #################################################################
+ SUBROUTINE Ini_budget(KLUOUT,PTSTEP,KSV,KRR, &
+ ONUMDIFU,ONUMDIFTH,ONUMDIFSV, &
+ OHORELAX_UVWTH,OHORELAX_RV,OHORELAX_RC,OHORELAX_RR, &
+ OHORELAX_RI,OHORELAX_RS, OHORELAX_RG, OHORELAX_RH,OHORELAX_TKE, &
+ OHORELAX_SV, OVE_RELAX, ove_relax_grd, OCHTRANS, &
+ ONUDGING,ODRAGTREE,ODEPOTREE, OAERO_EOL, &
+ HRAD,HDCONV,HSCONV,HTURB,HTURBDIM,HCLOUD )
+! #################################################################
+!
+!!**** *INI_BUDGET* - routine to initialize the parameters for the budgets
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to set or compute the parameters used
+! by the MESONH budgets. Names of files for budget recording are processed
+! and storage arrays are initialized.
+!
+!!** METHOD
+!! ------
+!! The essential of information is passed by modules. The choice of budgets
+!! and processes set by the user as integers is converted in "actions"
+!! readable by the subroutine BUDGET under the form of string characters.
+!! For each complete process composed of several elementary processes, names
+!! of elementary processes are concatenated in order to have an explicit name
+!! in the comment of the recording file for budget.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Modules MODD_*
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation (routine INI_BUDGET)
+!!
+!!
+!! AUTHOR
+!! ------
+!! P. Hereil * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/03/95
+!! J. Stein 25/06/95 put the sources in phase with the code
+!! J. Stein 20/07/95 reset to FALSE of all the switches when
+!! CBUTYPE /= MASK or CART
+!! J. Stein 26/06/96 add the new sources + add the increment between
+!! 2 active processes
+!! J.-P. Pinty 13/12/96 Allowance of multiple SVs
+!! J.-P. Pinty 11/01/97 Includes deep convection ice and forcing processes
+!! J.-P. Lafore 10/02/98 Allocation of the RHODJs for budget
+!! V. Ducrocq 04/06/99 //
+!! N. Asencio 18/06/99 // MASK case : delete KIMAX and KJMAX arguments,
+!! GET_DIM_EXT_ll initializes the dimensions of the
+!! extended local domain.
+!! LBU_MASK and NBUSURF are allocated on the extended
+!! local domain.
+!! add 3 local variables IBUDIM1,IBUDIM2,IBUDIM3
+!! to define the dimensions of the budget arrays
+!! in the different cases CART and MASK
+!! J.-P. Pinty 23/09/00 add budget for C2R2
+!! V. Masson 18/11/02 add budget for 2way nesting
+!! O.Geoffroy 03/2006 Add KHKO scheme
+!! J.-P. Pinty 22/04/97 add the explicit hail processes
+!! C.Lac 10/08/07 Add ADV for PPM without contribution
+!! of each direction
+!! C. Barthe 19/11/09 Add atmospheric electricity
+!! C.Lac 01/07/11 Add vegetation drag
+!! P. Peyrille, M. Tomasini : include in the forcing term the 2D forcing
+!! terms in term 2DFRC search for modif PP . but Not very clean!
+!! C .Lac 27/05/14 add negativity corrections for chemical species
+!! C.Lac 29/01/15 Correction for NSV_USER
+!! J.Escobar 02/10/2015 modif for JPHEXT(JPVEXT) variable
+!! C.Lac 04/12/15 Correction for LSUPSAT
+! C. Lac 04/2016: negative contribution to the budget split between advection, turbulence and microphysics for KHKO/C2R2
+! C. Barthe 01/2016: add budget for LIMA
+! C. Lac 10/2016: add budget for droplet deposition
+! S. Riette 11/2016: new budgets for ICE3/ICE4
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 15/11/2019: remove unused CBURECORD variable
+! P. Wautelet 24/02/2020: bugfix: corrected condition for budget NCDEPITH
+! P. Wautelet 26/02/2020: bugfix: rename CEVA->REVA for budget for raindrop evaporation in C2R2 (necessary after commit 4ed805fc)
+! P. Wautelet 26/02/2020: bugfix: add missing condition on OCOLD for NSEDIRH budget in LIMA case
+! P. Wautelet 02-03/2020: use the new data structures and subroutines for budgets
+! B. Vie 02/03/2020: LIMA negativity checks after turbulence, advection and microphysics budgets
+! P .Wautelet 09/03/2020: add missing budgets for electricity
+! P. Wautelet 25/03/2020: add missing ove_relax_grd
+! P. Wautelet 23/04/2020: add nid in tbudgetdata datatype
+! P. Wautelet + Benoit Vié 11/06/2020: improve removal of negative scalar variables + adapt the corresponding budgets
+! P. Wautelet 30/06/2020: use NADVSV when possible
+! P. Wautelet 30/06/2020: add NNETURSV, NNEADVSV and NNECONSV variables
+! P. Wautelet 06/07/2020: bugfix: add condition on HTURB for NETUR sources for SV budgets
+! P. Wautelet 08/12/2020: add nbusubwrite and nbutotwrite
+! P. Wautelet 11/01/2021: ignore xbuwri for cartesian boxes (write at every xbulen interval)
+! P. Wautelet 01/02/2021: bugfix: add missing CEDS source terms for SV budgets
+! P. Wautelet 02/02/2021: budgets: add missing source terms for SV budgets in LIMA
+! P. Wautelet 03/02/2021: budgets: add new source if LIMA splitting: CORR2
+! P. Wautelet 10/02/2021: budgets: add missing sources for NSV_C2R2BEG+3 budget
+! P. Wautelet 11/02/2021: budgets: add missing term SCAV for NSV_LIMA_SCAVMASS budget
+! P. Wautelet 02/03/2021: budgets: add terms for blowing snow
+! P. Wautelet 04/03/2021: budgets: add terms for drag due to buildings
+! P. Wautelet 17/03/2021: choose source terms for budgets with character strings instead of multiple integer variables
+! C. Barthe 14/03/2022: budgets: add terms for CIBU and RDSF in LIMA
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_2d_frc, only: l2d_adv_frc, l2d_rel_frc
+use modd_blowsnow, only: lblowsnow
+use modd_blowsnow_n, only: lsnowsubl
+use modd_budget
+use modd_ch_aerosol, only: lorilam
+use modd_conf, only: l1d, lcartesian, lforcing, lthinshell, nmodel
+use modd_dim_n, only: nimax_ll, njmax_ll, nkmax
+use modd_dragbldg_n, only: ldragbldg
+use modd_dust, only: ldust
+use modd_dyn, only: lcorio, xseglen
+use modd_dyn_n, only: xtstep, locean
+use modd_elec_descr, only: linductive, lrelax2fw_ion
+use modd_field, only: TYPEREAL
+use modd_nsv, only: csvnames, &
+ nsv_aerbeg, nsv_aerend, nsv_aerdepbeg, nsv_aerdepend, nsv_c2r2beg, nsv_c2r2end, &
+ nsv_chembeg, nsv_chemend, nsv_chicbeg, nsv_chicend, nsv_csbeg, nsv_csend, &
+ nsv_dstbeg, nsv_dstend, nsv_dstdepbeg, nsv_dstdepend, nsv_elecbeg, nsv_elecend, &
+#ifdef MNH_FOREFIRE
+ nsv_ffbeg, nsv_ffend, &
+#endif
+ nsv_lgbeg, nsv_lgend, &
+ nsv_lima_beg, nsv_lima_end, nsv_lima_ccn_acti, nsv_lima_ccn_free, nsv_lima_hom_haze, &
+ nsv_lima_ifn_free, nsv_lima_ifn_nucl, nsv_lima_imm_nucl, &
+ nsv_lima_nc, nsv_lima_nr, nsv_lima_ni, nsv_lima_scavmass, nsv_lima_spro, &
+ nsv_lnoxbeg, nsv_lnoxend, nsv_ppbeg, nsv_ppend, &
+ nsv_sltbeg, nsv_sltend, nsv_sltdepbeg, nsv_sltdepend, nsv_snwbeg, nsv_snwend, &
+ nsv_user
+use modd_parameters, only: jphext
+use modd_param_c2r2, only: ldepoc_c2r2 => ldepoc, lrain_c2r2 => lrain, lsedc_c2r2 => lsedc, lsupsat_c2r2 => lsupsat
+use modd_param_ice, only: ladj_after, ladj_before, ldeposc_ice => ldeposc, lred, lsedic_ice => lsedic, lwarm_ice => lwarm
+use modd_param_n, only: cactccn, celec
+use modd_param_lima, only: laero_mass_lima => laero_mass, lacti_lima => lacti, lcold_lima => lcold, ldepoc_lima => ldepoc, &
+ lhail_lima => lhail, lhhoni_lima => lhhoni, lmeyers_lima => lmeyers, lnucl_lima => lnucl, &
+ lptsplit, &
+ lrain_lima => lrain, lscav_lima => lscav, lsedc_lima => lsedc, lsedi_lima => lsedi, &
+ lsnow_lima => lsnow, lspro_lima => lspro, lwarm_lima => lwarm, lcibu, lrdsf, &
+ nmod_ccn, nmod_ifn, nmod_imm
+use modd_ref, only: lcouples
+use modd_salt, only: lsalt
+use modd_turb_n, only: lsubg_cond
+use modd_viscosity, only: lvisc, lvisc_r, lvisc_sv, lvisc_th, lvisc_uvw
+
+USE MODE_ll
+
+IMPLICIT NONE
+!
+!* 0.1 declarations of argument
+!
+!
+INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
+REAL, INTENT(IN) :: PTSTEP ! time step
+INTEGER, INTENT(IN) :: KSV ! number of scalar variables
+INTEGER, INTENT(IN) :: KRR ! number of moist variables
+LOGICAL, INTENT(IN) :: ONUMDIFU ! switch to activate the numerical
+ ! diffusion for momentum
+LOGICAL, INTENT(IN) :: ONUMDIFTH ! for meteorological scalar variables
+LOGICAL, INTENT(IN) :: ONUMDIFSV ! for tracer scalar variables
+LOGICAL, INTENT(IN) :: OHORELAX_UVWTH ! switch for the
+ ! horizontal relaxation for U,V,W,TH
+LOGICAL, INTENT(IN) :: OHORELAX_RV ! switch for the
+ ! horizontal relaxation for Rv
+LOGICAL, INTENT(IN) :: OHORELAX_RC ! switch for the
+ ! horizontal relaxation for Rc
+LOGICAL, INTENT(IN) :: OHORELAX_RR ! switch for the
+ ! horizontal relaxation for Rr
+LOGICAL, INTENT(IN) :: OHORELAX_RI ! switch for the
+ ! horizontal relaxation for Ri
+LOGICAL, INTENT(IN) :: OHORELAX_RS ! switch for the
+ ! horizontal relaxation for Rs
+LOGICAL, INTENT(IN) :: OHORELAX_RG ! switch for the
+ ! horizontal relaxation for Rg
+LOGICAL, INTENT(IN) :: OHORELAX_RH ! switch for the
+ ! horizontal relaxation for Rh
+LOGICAL, INTENT(IN) :: OHORELAX_TKE ! switch for the
+ ! horizontal relaxation for tke
+LOGICAL,DIMENSION(:),INTENT(IN):: OHORELAX_SV ! switch for the
+ ! horizontal relaxation for scalar variables
+LOGICAL, INTENT(IN) :: OVE_RELAX ! switch to activate the vertical
+ ! relaxation
+logical, intent(in) :: ove_relax_grd ! switch to activate the vertical
+ ! relaxation to the lowest verticals
+LOGICAL, INTENT(IN) :: OCHTRANS ! switch to activate convective
+ !transport for SV
+LOGICAL, INTENT(IN) :: ONUDGING ! switch to activate nudging
+LOGICAL, INTENT(IN) :: ODRAGTREE ! switch to activate vegetation drag
+LOGICAL, INTENT(IN) :: ODEPOTREE ! switch to activate droplet deposition on tree
+LOGICAL, INTENT(IN) :: OAERO_EOL ! switch to activate wind turbine wake
+CHARACTER (LEN=*), INTENT(IN) :: HRAD ! type of the radiation scheme
+CHARACTER (LEN=*), INTENT(IN) :: HDCONV ! type of the deep convection scheme
+CHARACTER (LEN=*), INTENT(IN) :: HSCONV ! type of the shallow convection scheme
+CHARACTER (LEN=*), INTENT(IN) :: HTURB ! type of the turbulence scheme
+CHARACTER (LEN=*), INTENT(IN) :: HTURBDIM! dimensionnality of the turbulence
+ ! scheme
+CHARACTER (LEN=*), INTENT(IN) :: HCLOUD ! type of microphysical scheme
+!
+!* 0.2 declarations of local variables
+!
+real, parameter :: ITOL = 1e-6
+
+INTEGER :: JI, JJ ! loop indices
+INTEGER :: IIMAX_ll, IJMAX_ll ! size of the physical global domain
+INTEGER :: IIU, IJU ! size along x and y directions
+ ! of the extended subdomain
+INTEGER :: IBUDIM1 ! first dimension of the budget arrays
+ ! = NBUIMAX in CART case
+ ! = NBUKMAX in MASK case
+INTEGER :: IBUDIM2 ! second dimension of the budget arrays
+ ! = NBUJMAX in CART case
+ ! = nbusubwrite in MASK case
+INTEGER :: IBUDIM3 ! third dimension of the budget arrays
+ ! = NBUKMAX in CART case
+ ! = NBUMASK in MASK case
+INTEGER :: JSV ! loop indice for the SVs
+INTEGER :: IINFO_ll ! return status of the interface routine
+integer :: ibudget
+logical :: gtmp
+type(tbusourcedata) :: tzsource ! Used to prepare metadate of source terms
+
+call Print_msg( NVERB_DEBUG, 'BUD', 'Ini_budget', 'called' )
+!
+!* 1. COMPUTE BUDGET VARIABLES
+! ------------------------
+!
+NBUSTEP = NINT (XBULEN / PTSTEP)
+NBUTSHIFT=0
+!
+! common dimension for all CBUTYPE values
+!
+IF (LBU_KCP) THEN
+ NBUKMAX = 1
+ELSE
+ NBUKMAX = NBUKH - NBUKL +1
+END IF
+!
+if ( cbutype == 'CART' .or. cbutype == 'MASK' ) then
+ !Check if xbulen is a multiple of xtstep (within tolerance)
+ if ( Abs( Nint( xbulen / xtstep ) * xtstep - xbulen ) > ( ITOL * xtstep ) ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xbulen is not a multiple of xtstep' )
+
+ if ( cbutype == 'CART' ) then
+ !Check if xseglen is a multiple of xbulen (within tolerance)
+ if ( Abs( Nint( xseglen / xbulen ) * xbulen - xseglen ) > ( ITOL * xseglen ) ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xseglen is not a multiple of xbulen' )
+
+ !Write cartesian budgets every xbulen time period (do not take xbuwri into account)
+ xbuwri = xbulen
+
+ nbusubwrite = 1 !Number of budget time average periods for each write
+ nbutotwrite = nbusubwrite * Nint( xseglen / xbulen ) !Total number of budget time average periods
+ else if ( cbutype == 'MASK' ) then
+ !Check if xbuwri is a multiple of xtstep (within tolerance)
+ if ( Abs( Nint( xbuwri / xtstep ) * xtstep - xbuwri ) > ( ITOL * xtstep ) ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xbuwri is not a multiple of xtstep' )
+
+ !Check if xbuwri is a multiple of xbulen (within tolerance)
+ if ( Abs( Nint( xbuwri / xbulen ) * xbulen - xbuwri ) > ( ITOL * xbulen ) ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xbuwri is not a multiple of xbulen' )
+
+ !Check if xseglen is a multiple of xbuwri (within tolerance)
+ if ( Abs( Nint( xseglen / xbuwri ) * xbuwri - xseglen ) > ( ITOL * xseglen ) ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xseglen is not a multiple of xbuwri' )
+
+ nbusubwrite = Nint ( xbuwri / xbulen ) !Number of budget time average periods for each write
+ nbutotwrite = nbusubwrite * Nint( xseglen / xbuwri ) !Total number of budget time average periods
+ end if
+end if
+
+IF (CBUTYPE=='CART') THEN ! cartesian case only
+!
+ IF ( NBUIL < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIL too small (<1)' )
+ IF ( NBUIL > NIMAX_ll ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIL too large (>NIMAX)' )
+ IF ( NBUIH < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIH too small (<1)' )
+ IF ( NBUIH > NIMAX_ll ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIH too large (>NIMAX)' )
+ IF ( NBUIH < NBUIL ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIH < NBUIL' )
+ IF (LBU_ICP) THEN
+ NBUIMAX_ll = 1
+ ELSE
+ NBUIMAX_ll = NBUIH - NBUIL +1
+ END IF
+
+ IF ( NBUJL < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJL too small (<1)' )
+ IF ( NBUJL > NJMAX_ll ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJL too large (>NJMAX)' )
+ IF ( NBUJH < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJH too small (<1)' )
+ IF ( NBUJH > NJMAX_ll ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJH too large (>NJMAX)' )
+ IF ( NBUJH < NBUJL ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJH < NBUJL' )
+ IF (LBU_JCP) THEN
+ NBUJMAX_ll = 1
+ ELSE
+ NBUJMAX_ll = NBUJH - NBUJL +1
+ END IF
+
+ IF ( NBUKL < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKL too small (<1)' )
+ IF ( NBUKL > NKMAX ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKL too large (>NKMAX)' )
+ IF ( NBUKH < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKH too small (<1)' )
+ IF ( NBUKH > NKMAX ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKH too large (>NKMAX)' )
+ IF ( NBUKH < NBUKL ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKH < NBUKL' )
+
+ CALL GET_INTERSECTION_ll(NBUIL+JPHEXT,NBUJL+JPHEXT,NBUIH+JPHEXT,NBUJH+JPHEXT, &
+ NBUSIL,NBUSJL,NBUSIH,NBUSJH,"PHYS",IINFO_ll)
+ IF ( IINFO_ll /= 1 ) THEN !
+ IF (LBU_ICP) THEN
+ NBUIMAX = 1
+ ELSE
+ NBUIMAX = NBUSIH - NBUSIL +1
+ END IF
+ IF (LBU_JCP) THEN
+ NBUJMAX = 1
+ ELSE
+ NBUJMAX = NBUSJH - NBUSJL +1
+ END IF
+ ELSE ! the intersection is void
+ CBUTYPE='SKIP' ! no budget on this processor
+ NBUIMAX = 0 ! in order to allocate void arrays
+ NBUJMAX = 0
+ ENDIF
+! three first dimensions of budget arrays in cart and skip cases
+ IBUDIM1=NBUIMAX
+ IBUDIM2=NBUJMAX
+ IBUDIM3=NBUKMAX
+! these variables are not be used
+ NBUMASK=-1
+!
+ELSEIF (CBUTYPE=='MASK') THEN ! mask case only
+!
+ LBU_ENABLE=.TRUE.
+ ! result on the FM_FILE
+ NBUTIME = 1
+
+ CALL GET_DIM_EXT_ll ('B', IIU,IJU)
+ ALLOCATE( LBU_MASK( IIU ,IJU, NBUMASK) )
+ LBU_MASK(:,:,:)=.FALSE.
+ ALLOCATE( NBUSURF( IIU, IJU, NBUMASK, nbusubwrite) )
+ NBUSURF(:,:,:,:) = 0
+!
+! three first dimensions of budget arrays in mask case
+! the order of the dimensions are the order expected in WRITE_DIACHRO routine:
+! x,y,z,time,mask,processus and in this case x and y are missing
+! first dimension of the arrays : dimension along K
+! second dimension of the arrays : number of the budget time period
+! third dimension of the arrays : number of the budget masks zones
+ IBUDIM1=NBUKMAX
+ IBUDIM2=nbusubwrite
+ IBUDIM3=NBUMASK
+! these variables are not used in this case
+ NBUIMAX=-1
+ NBUJMAX=-1
+! the beginning and the end along x and y direction : global extended domain
+ ! get dimensions of the physical global domain
+ CALL GET_GLOBALDIMS_ll (IIMAX_ll,IJMAX_ll)
+ NBUIL=1
+ NBUIH=IIMAX_ll + 2 * JPHEXT
+ NBUJL=1
+ NBUJH=IJMAX_ll + 2 * JPHEXT
+!
+ELSE ! default case
+!
+ LBU_ENABLE=.FALSE.
+ NBUIMAX = -1
+ NBUJMAX = -1
+ LBU_RU = .FALSE.
+ LBU_RV = .FALSE.
+ LBU_RW = .FALSE.
+ LBU_RTH= .FALSE.
+ LBU_RTKE= .FALSE.
+ LBU_RRV= .FALSE.
+ LBU_RRC= .FALSE.
+ LBU_RRR= .FALSE.
+ LBU_RRI= .FALSE.
+ LBU_RRS= .FALSE.
+ LBU_RRG= .FALSE.
+ LBU_RRH= .FALSE.
+ LBU_RSV= .FALSE.
+!
+! three first dimensions of budget arrays in default case
+ IBUDIM1=0
+ IBUDIM2=0
+ IBUDIM3=0
+!
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. ALLOCATE MEMORY FOR BUDGET ARRAYS AND INITIALIZE
+! ------------------------------------------------
+!
+LBU_BEG =.TRUE.
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. INITALIZE VARIABLES
+! -------------------
+!
+!Create intermediate variable to store rhodj for scalar variables
+if ( lbu_rth .or. lbu_rtke .or. lbu_rrv .or. lbu_rrc .or. lbu_rrr .or. &
+ lbu_rri .or. lbu_rrs .or. lbu_rrg .or. lbu_rrh .or. lbu_rsv ) then
+ allocate( tburhodj )
+
+ tburhodj%cmnhname = 'RhodJS'
+ tburhodj%cstdname = ''
+ tburhodj%clongname = 'RhodJS'
+ tburhodj%cunits = 'kg'
+ tburhodj%ccomment = 'RhodJ for Scalars variables'
+ tburhodj%ngrid = 1
+ tburhodj%ntype = TYPEREAL
+ tburhodj%ndims = 3
+
+ allocate( tburhodj%xdata(ibudim1, ibudim2, ibudim3) )
+ tburhodj%xdata(:, :, :) = 0.
+end if
+
+
+tzsource%ntype = TYPEREAL
+tzsource%ndims = 3
+
+! Budget of RU
+tbudgets(NBUDGET_U)%lenabled = lbu_ru
+
+if ( lbu_ru ) then
+ allocate( tbudgets(NBUDGET_U)%trhodj )
+
+ tbudgets(NBUDGET_U)%trhodj%cmnhname = 'RhodJX'
+ tbudgets(NBUDGET_U)%trhodj%cstdname = ''
+ tbudgets(NBUDGET_U)%trhodj%clongname = 'RhodJX'
+ tbudgets(NBUDGET_U)%trhodj%cunits = 'kg'
+ tbudgets(NBUDGET_U)%trhodj%ccomment = 'RhodJ for momentum along X axis'
+ tbudgets(NBUDGET_U)%trhodj%ngrid = 2
+ tbudgets(NBUDGET_U)%trhodj%ntype = TYPEREAL
+ tbudgets(NBUDGET_U)%trhodj%ndims = 3
+
+ allocate( tbudgets(NBUDGET_U)%trhodj%xdata(ibudim1, ibudim2, ibudim3) )
+ tbudgets(NBUDGET_U)%trhodj%xdata(:, :, :) = 0.
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_U)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_U)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_U)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_U)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of momentum along X axis'
+ tzsource%ngrid = 2
+
+ tzsource%cunits = 'm s-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 'm s-2'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'NUD'
+ tzsource%clongname = 'nudging'
+ tzsource%lavailable = onudging
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'CURV'
+ tzsource%clongname = 'curvature'
+ tzsource%lavailable = .not.l1d .and. .not.lcartesian
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'COR'
+ tzsource%clongname = 'Coriolis'
+ tzsource%lavailable = lcorio
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifu
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_uvwth .or. ove_relax .or. ove_relax_grd
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'DRAG'
+ tzsource%clongname = 'drag force due to trees'
+ tzsource%lavailable = odragtree
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'DRAGEOL'
+ tzsource%clongname = 'drag force due to wind turbine'
+ tzsource%lavailable = OAERO_EOL
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'DRAGB'
+ tzsource%clongname = 'drag force due to buildings'
+ tzsource%lavailable = ldragbldg
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'MAFL'
+ tzsource%clongname = 'mass flux'
+ tzsource%lavailable = hsconv == 'EDKF'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_uvw
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'PRES'
+ tzsource%clongname = 'pressure'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_U) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_U), cbulist_ru )
+end if
+
+! Budget of RV
+tbudgets(NBUDGET_V)%lenabled = lbu_rv
+
+if ( lbu_rv ) then
+ allocate( tbudgets(NBUDGET_V)%trhodj )
+
+ tbudgets(NBUDGET_V)%trhodj%cmnhname = 'RhodJY'
+ tbudgets(NBUDGET_V)%trhodj%cstdname = ''
+ tbudgets(NBUDGET_V)%trhodj%clongname = 'RhodJY'
+ tbudgets(NBUDGET_V)%trhodj%cunits = 'kg'
+ tbudgets(NBUDGET_V)%trhodj%ccomment = 'RhodJ for momentum along Y axis'
+ tbudgets(NBUDGET_V)%trhodj%ngrid = 3
+ tbudgets(NBUDGET_V)%trhodj%ntype = TYPEREAL
+ tbudgets(NBUDGET_V)%trhodj%ndims = 3
+
+ allocate( tbudgets(NBUDGET_V)%trhodj%xdata(ibudim1, ibudim2, ibudim3) )
+ tbudgets(NBUDGET_V)%trhodj%xdata(:, :, :) = 0.
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_V)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_V)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_V)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_V)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of momentum along Y axis'
+ tzsource%ngrid = 3
+
+ tzsource%cunits = 'm s-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 'm s-2'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'NUD'
+ tzsource%clongname = 'nudging'
+ tzsource%lavailable = onudging
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'CURV'
+ tzsource%clongname = 'curvature'
+ tzsource%lavailable = .not.l1d .and. .not.lcartesian
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'COR'
+ tzsource%clongname = 'Coriolis'
+ tzsource%lavailable = lcorio
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifu
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_uvwth .or. ove_relax .or. ove_relax_grd
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'DRAG'
+ tzsource%clongname = 'drag force due to trees'
+ tzsource%lavailable = odragtree
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'DRAGEOL'
+ tzsource%clongname = 'drag force due to wind turbine'
+ tzsource%lavailable = OAERO_EOL
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'DRAGB'
+ tzsource%clongname = 'drag force due to buildings'
+ tzsource%lavailable = ldragbldg
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'MAFL'
+ tzsource%clongname = 'mass flux'
+ tzsource%lavailable = hsconv == 'EDKF'
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_uvw
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'PRES'
+ tzsource%clongname = 'pressure'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_V) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_V), cbulist_rv )
+end if
+
+! Budget of RW
+tbudgets(NBUDGET_W)%lenabled = lbu_rw
+
+if ( lbu_rw ) then
+ allocate( tbudgets(NBUDGET_W)%trhodj )
+
+ tbudgets(NBUDGET_W)%trhodj%cmnhname = 'RhodJZ'
+ tbudgets(NBUDGET_W)%trhodj%cstdname = ''
+ tbudgets(NBUDGET_W)%trhodj%clongname = 'RhodJZ'
+ tbudgets(NBUDGET_W)%trhodj%cunits = 'kg'
+ tbudgets(NBUDGET_W)%trhodj%ccomment = 'RhodJ for momentum along Z axis'
+ tbudgets(NBUDGET_W)%trhodj%ngrid = 4
+ tbudgets(NBUDGET_W)%trhodj%ntype = TYPEREAL
+ tbudgets(NBUDGET_W)%trhodj%ndims = 3
+
+ allocate( tbudgets(NBUDGET_W)%trhodj%xdata(ibudim1, ibudim2, ibudim3) )
+ tbudgets(NBUDGET_W)%trhodj%xdata(:, :, :) = 0.
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_W)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_W)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_W)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_W)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of momentum along Z axis'
+ tzsource%ngrid = 4
+
+ tzsource%cunits = 'm s-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 'm s-2'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'NUD'
+ tzsource%clongname = 'nudging'
+ tzsource%lavailable = onudging
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'CURV'
+ tzsource%clongname = 'curvature'
+ tzsource%lavailable = .not.l1d .and. .not.lcartesian .and. .not.lthinshell
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'COR'
+ tzsource%clongname = 'Coriolis'
+ tzsource%lavailable = lcorio .and. .not.l1d .and. .not.lthinshell
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifu
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_uvwth .or. ove_relax .or. ove_relax_grd
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_uvw
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'GRAV'
+ tzsource%clongname = 'gravity'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'PRES'
+ tzsource%clongname = 'pressure'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'DRAGEOL'
+ tzsource%clongname = 'drag force due to wind turbine'
+ tzsource%lavailable = OAERO_EOL
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_W) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_W), cbulist_rw )
+end if
+
+! Budget of RTH
+tbudgets(NBUDGET_TH)%lenabled = lbu_rth
+
+if ( lbu_rth ) then
+ tbudgets(NBUDGET_TH)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_TH)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_TH)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_TH)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_TH)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of potential temperature'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'K'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 'K s-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = '2DADV'
+ tzsource%clongname = 'advective forcing'
+ tzsource%lavailable = l2d_adv_frc
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = '2DREL'
+ tzsource%clongname = 'relaxation forcing'
+ tzsource%lavailable = l2d_rel_frc
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NUD'
+ tzsource%clongname = 'nudging'
+ tzsource%lavailable = onudging
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'PREF'
+ tzsource%clongname = 'reference pressure'
+ tzsource%lavailable = krr > 0 .and. .not.l1d
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_uvwth .or. ove_relax .or. ove_relax_grd
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'RAD'
+ tzsource%clongname = 'radiation'
+ tzsource%lavailable = hrad /= 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DCONV'
+ tzsource%clongname = 'KAFR convection'
+ tzsource%lavailable = hdconv == 'KAFR' .OR. hsconv == 'KAFR'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DISSH'
+ tzsource%clongname = 'dissipation'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'MAFL'
+ tzsource%clongname = 'mass flux'
+ tzsource%lavailable = hsconv == 'EDKF'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'SNSUB'
+ tzsource%clongname = 'blowing snow sublimation'
+ tzsource%lavailable = lblowsnow .and. lsnowsubl
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_th
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'OCEAN'
+ tzsource%clongname = 'radiative tendency due to SW penetrating ocean'
+ tzsource%lavailable = locean .and. (.not. lcouples)
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'heat transport by hydrometeors sedimentation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'heterogeneous nucleation'
+ gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt )
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. lwarm_lima .and. lacti_lima .and. nmod_ccn >= 1 &
+ .and. ( .not.lptsplit .or. .not.lsubg_cond ) ) &
+ .or. hcloud(1:3) == 'ICE' &
+ .or. ( hcloud == 'C2R2' .and. ( gtmp .or. .not.lsupsat_c2r2 ) ) &
+ .or. ( hcloud == 'KHKO' .and. ( gtmp .or. .not.lsupsat_c2r2 ) )
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( ( .not. lptsplit .and. lwarm_lima .and. lrain_lima ) .or. lptsplit ) ) &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 ) &
+ .or. hcloud == 'KESS'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lcold_lima .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lcold_lima .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HON'
+ tzsource%clongname = 'homogeneous nucleation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lcold_lima .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HONC'
+ tzsource%clongname = 'droplet homogeneous freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lnucl_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HONR'
+ tzsource%clongname = 'raindrop homogeneous freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lnucl_lima .and. lrain_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'SFR'
+ tzsource%clongname = 'spontaneous freezing'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lsnow_lima ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'BERFI'
+ tzsource%clongname = 'Bergeron-Findeisen'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on aggregates'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit &
+ .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima .and. lrain_lima ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima &
+ .and. lwarm_lima .and. lsnow_lima ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima &
+ .and. lwarm_lima .and. lsnow_lima ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'ADJU'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'deposition on ice'
+ tzsource%lavailable = ( hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE') ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit )
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'COND'
+ tzsource%clongname = 'vapor condensation or cloud water evaporation'
+ tzsource%lavailable = hcloud == 'C2R2' .or. hcloud == 'KHKO' .or. hcloud == 'KESS' .or. hcloud == 'REVE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
+ .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_TH) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_TH), cbulist_rth )
+end if
+
+! Budget of RTKE
+tbudgets(NBUDGET_TKE)%lenabled = lbu_rtke
+
+if ( lbu_rtke ) then
+ tbudgets(NBUDGET_TKE)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_TKE)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_TKE)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_TKE)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_TKE)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of turbulent kinetic energy'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'm2 s-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 'm2 s-3'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_tke
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'DRAG'
+ tzsource%clongname = 'drag force'
+ tzsource%lavailable = odragtree
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'DRAGB'
+ tzsource%clongname = 'drag force due to buildings'
+ tzsource%lavailable = ldragbldg
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'DP'
+ tzsource%clongname = 'dynamic production'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'TP'
+ tzsource%clongname = 'thermal production'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'DISS'
+ tzsource%clongname = 'dissipation of TKE'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'TR'
+ tzsource%clongname = 'turbulent transport'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_TKE) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_TKE), cbulist_rtke )
+end if
+
+! Budget of RRV
+tbudgets(NBUDGET_RV)%lenabled = lbu_rrv .and. krr >= 1
+
+if ( tbudgets(NBUDGET_RV)%lenabled ) then
+ tbudgets(NBUDGET_RV)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RV)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RV)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RV)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RV)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of water vapor mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = '2DADV'
+ tzsource%clongname = 'advective forcing'
+ tzsource%lavailable = l2d_adv_frc
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = '2DREL'
+ tzsource%clongname = 'relaxation forcing'
+ tzsource%lavailable = l2d_rel_frc
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NUD'
+ tzsource%clongname = 'nudging'
+ tzsource%lavailable = onudging
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rv
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DCONV'
+ tzsource%clongname = 'KAFR convection'
+ tzsource%lavailable = hdconv == 'KAFR' .OR. hsconv == 'KAFR'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'MAFL'
+ tzsource%clongname = 'mass flux'
+ tzsource%lavailable = hsconv == 'EDKF'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'SNSUB'
+ tzsource%clongname = 'blowing snow sublimation'
+ tzsource%lavailable = lblowsnow .and. lsnowsubl
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'heterogeneous nucleation'
+ gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt )
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. lwarm_lima .and. lacti_lima .and. nmod_ccn >= 1 &
+ .and. ( .not.lptsplit .or. .not.lsubg_cond ) ) &
+ .or. hcloud(1:3) == 'ICE' &
+ .or. ( hcloud == 'C2R2' .and. ( gtmp .or. .not.lsupsat_c2r2 ) ) &
+ .or. ( hcloud == 'KHKO' .and. ( gtmp .or. .not.lsupsat_c2r2 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( ( .not. lptsplit .and. lwarm_lima .and. lrain_lima ) &
+ .or. lptsplit ) ) &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 ) &
+ .or. hcloud == 'KESS'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lcold_lima .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lcold_lima .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lsnow_lima ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'ADJU'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'COND'
+ tzsource%clongname = 'vapor condensation or cloud water evaporation'
+ tzsource%lavailable = hcloud == 'C2R2' .or. hcloud == 'KHKO' .or. hcloud == 'KESS' .or. hcloud == 'REVE'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'deposition on ice'
+ tzsource%lavailable = ( hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE') ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit )
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
+ .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RV) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RV), cbulist_rrv )
+end if
+
+! Budget of RRC
+tbudgets(NBUDGET_RC)%lenabled = lbu_rrc .and. krr >= 2
+
+if ( tbudgets(NBUDGET_RC)%lenabled ) then
+ if ( hcloud(1:3) == 'ICE' .and. lred .and. lsedic_ice .and. ldeposc_ice ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'lred=T + lsedic=T + ldeposc=T:'// &
+ 'DEPO and SEDI source terms are mixed and stored in SEDI' )
+
+ tbudgets(NBUDGET_RC)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RC)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RC)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RC)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RC)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of cloud water mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rc
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DCONV'
+ tzsource%clongname = 'KAFR convection'
+ tzsource%lavailable = hdconv == 'KAFR' .OR. hsconv == 'KAFR'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DEPOTR'
+ tzsource%clongname = 'tree droplet deposition'
+ tzsource%lavailable = odragtree .and. odepotree
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+! tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. lwarm_lima .and. lrain_lima ) &
+! .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' )
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation of cloud'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. lwarm_lima .and. lsedc_lima ) &
+ .or. ( hcloud(1:3) == 'ICE' .and. lsedic_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lsedc_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lsedc_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DEPO'
+ tzsource%clongname = 'surface droplet deposition'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. lwarm_lima .and. ldepoc_lima ) &
+ .or. ( hcloud == 'C2R2' .and. ldepoc_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. ldepoc_c2r2 ) &
+ .or. ( hcloud(1:3) == 'ICE' .and. ldeposc_ice .and. celec == 'NONE' )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'R2C1'
+ tzsource%clongname = 'rain to cloud change after sedimentation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit .and. lwarm_lima .and. lrain_lima
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt )
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. lwarm_lima .and. lacti_lima .and. nmod_ccn >= 1 &
+ .and. ( .not.lptsplit .or. .not.lsubg_cond ) ) &
+ .or. ( hcloud == 'C2R2' .and. ( gtmp .or. .not.lsupsat_c2r2 ) ) &
+ .or. ( hcloud == 'KHKO' .and. ( gtmp .or. .not.lsupsat_c2r2 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lcold_lima .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'ADJU'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'HON'
+ tzsource%clongname = 'homogeneous nucleation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lwarm_lima .and. lrain_lima ) ) ) &
+ .or. hcloud == 'KESS' &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lwarm_lima .and. lrain_lima ) ) ) &
+ .or. hcloud == 'KESS' &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lwarm_lima .and. lrain_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'HONC'
+ tzsource%clongname = 'droplet homogeneous freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lnucl_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'BERFI'
+ tzsource%clongname = 'Bergeron-Findeisen'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'collection by snow and conversion into rain with T>XTT on ice'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'CVRC'
+ tzsource%clongname = 'rain to cloud change after other microphysical processes'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima &
+ .and. lwarm_lima .and. lsnow_lima ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE' )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'COND'
+ tzsource%clongname = 'vapor condensation or cloud water evaporation'
+ tzsource%lavailable = hcloud == 'C2R2' .or. hcloud == 'KHKO' .or. hcloud == 'KESS' .or. hcloud == 'REVE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
+ .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RC) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RC), cbulist_rrc )
+end if
+
+! Budget of RRR
+tbudgets(NBUDGET_RR)%lenabled = lbu_rrr .and. krr >= 3
+
+if ( tbudgets(NBUDGET_RR)%lenabled ) then
+ tbudgets(NBUDGET_RR)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RR)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RR)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RR)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RR)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of rain water mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rr
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+! tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. lwarm_lima .and. lrain_lima ) &
+! .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' )
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation of rain drops'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. lwarm_lima .and. lrain_lima ) &
+ .or. hcloud == 'KESS' &
+ .or. hcloud(1:3) == 'ICE' &
+ .or. hcloud == 'C2R2' &
+ .or. hcloud == 'KHKO'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'R2C1'
+ tzsource%clongname = 'rain to cloud change after sedimentation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit .and. lwarm_lima .and. lrain_lima
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lwarm_lima .and. lrain_lima ) ) ) &
+ .or. hcloud == 'KESS' &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lwarm_lima .and. lrain_lima ) ) ) &
+ .or. hcloud == 'KESS' &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lwarm_lima .and. lrain_lima ) ) ) &
+ .or. hcloud == 'KESS' &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'HONR'
+ tzsource%clongname = 'rain homogeneous freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lnucl_lima .and. lrain_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on aggregates'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima &
+ .and. lsnow_lima .and. lrain_lima) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'collection of droplets by snow and conversion into rain'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'CVRC'
+ tzsource%clongname = 'rain to cloud change after other microphysical processes'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima &
+ .and. lwarm_lima .and. lsnow_lima ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima &
+ .and. lwarm_lima .and. lsnow_lima ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'SFR'
+ tzsource%clongname = 'spontaneous freezing'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+!PW: a documenter
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
+ .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RR) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RR), cbulist_rrr )
+end if
+
+! Budget of RRI
+tbudgets(NBUDGET_RI)%lenabled = lbu_rri .and. krr >= 4
+
+if ( tbudgets(NBUDGET_RI)%lenabled ) then
+ tbudgets(NBUDGET_RI)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RI)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RI)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RI)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RI)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of cloud ice mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_ri
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'DCONV'
+ tzsource%clongname = 'KAFR convection'
+ tzsource%lavailable = hdconv == 'KAFR' .OR. hsconv == 'KAFR'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA' )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+! tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. lcold_lima .and. lsnow_lima ) &
+! .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' )
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'ADJU'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation of rain drops'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. lcold_lima .and. lsedi_lima ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'heterogeneous nucleation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lcold_lima .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lcold_lima .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HON'
+ tzsource%clongname = 'homogeneous nucleation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lcold_lima .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HONC'
+ tzsource%clongname = 'droplet homogeneous freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lnucl_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CNVI'
+ tzsource%clongname = 'conversion of snow to cloud ice'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lsnow_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CNVS'
+ tzsource%clongname = 'conversion of pristine ice to snow'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lsnow_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'AGGS'
+ tzsource%clongname = 'aggregation of snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lsnow_lima ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'AUTS'
+ tzsource%clongname = 'autoconversion of ice'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'BERFI'
+ tzsource%clongname = 'Bergeron-Findeisen'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HMS'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to snow riming'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CIBU'
+ tzsource%clongname = 'ice multiplication process due to ice collisional breakup'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lcold_lima .and. lwarm_lima .and. lsnow_lima .and. lcibu )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'RDSF'
+ tzsource%clongname = 'ice multiplication process following rain contact freezing'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lcold_lima .and. lwarm_lima .and. lsnow_lima .and. lrdsf )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HMG'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to graupel riming'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima &
+ .and. lwarm_lima .and. lsnow_lima ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = ( hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE') ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RI) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RI), cbulist_rri )
+end if
+
+! Budget of RRS
+tbudgets(NBUDGET_RS)%lenabled = lbu_rrs .and. krr >= 5
+
+if ( tbudgets(NBUDGET_RS)%lenabled ) then
+ tbudgets(NBUDGET_RS)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RS)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RS)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RS)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RS)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of snow/aggregate mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rs
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+! tzsource%cmnhname = 'NETUR'
+! tzsource%clongname = 'negativity correction induced by turbulence'
+! tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+! .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+! call Budget_source_add( tbudgets(NBUDGET_RS), tzsource nneturrs )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+! tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. lcold_lima .and. lsnow_lima ) &
+! .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' )
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. lcold_lima .and. lsnow_lima ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'CNVI'
+ tzsource%clongname = 'conversion of snow to cloud ice'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lsnow_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lsnow_lima ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'CNVS'
+ tzsource%clongname = 'conversion of pristine ice to snow'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lsnow_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'AGGS'
+ tzsource%clongname = 'aggregation of snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lsnow_lima ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'AUTS'
+ tzsource%clongname = 'autoconversion of ice'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'HMS'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to snow riming'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'CIBU'
+ tzsource%clongname = 'ice multiplication process due to ice collisional breakup'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lcold_lima .and. lwarm_lima .and. lsnow_lima .and. lcibu )
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima &
+ .and. lsnow_lima .and. lrain_lima) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'conversion melting'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima &
+ .and. lwarm_lima .and. lsnow_lima ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RS) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RS), cbulist_rrs )
+end if
+
+! Budget of RRG
+tbudgets(NBUDGET_RG)%lenabled = lbu_rrg .and. krr >= 6
+
+if ( tbudgets(NBUDGET_RG)%lenabled ) then
+ tbudgets(NBUDGET_RG)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RG)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RG)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RG)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RG)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of graupel mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rg
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+! tzsource%cmnhname = 'NETUR'
+! tzsource%clongname = 'negativity correction induced by turbulence'
+! tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+! .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+! call Budget_source_add( tbudgets(NBUDGET_RG), tzsource nneturrg )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. lcold_lima .and. lsnow_lima ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'HONR'
+ tzsource%clongname = 'rain homogeneous freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lnucl_lima .and. lrain_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'SFR'
+ tzsource%clongname = 'spontaneous freezing'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima &
+ .and. lsnow_lima .and. lrain_lima) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'conversion melting of snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'RDSF'
+ tzsource%clongname = 'ice multiplication process following rain contact freezing'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lcold_lima .and. lwarm_lima .and. lsnow_lima .and. lrdsf )
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'GHCV'
+ tzsource%clongname = 'graupel to hail conversion'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'HMG'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to graupel riming'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima) ) ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima &
+ .and. lwarm_lima .and. lsnow_lima ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'COHG'
+ tzsource%clongname = 'conversion of hail to graupel'
+ tzsource%lavailable = hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima .and. lwarm_lima .and. lsnow_lima
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'HGCV'
+ tzsource%clongname = 'hail to graupel conversion'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+ .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
+ .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RG) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RG), cbulist_rrg )
+end if
+
+! Budget of RRH
+tbudgets(NBUDGET_RH)%lenabled = lbu_rrh .and. krr >= 7
+
+if ( tbudgets(NBUDGET_RH)%lenabled ) then
+ tbudgets(NBUDGET_RH)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RH)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RH)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RH)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RH)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of hail mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rh
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+! tzsource%cmnhname = 'NETUR'
+! tzsource%clongname = 'negativity correction induced by turbulence'
+! tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
+! .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
+! call Budget_source_add( tbudgets(NBUDGET_RH), tzsource nneturrh )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. lcold_lima .and. lhail_lima ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'GHCV'
+ tzsource%clongname = 'graupel to hail conversion'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. lhail_lima &
+ .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) &
+ .or. ( hcloud == 'ICE4' .and. ( .not. lred .or. celec /= 'NONE' ) )
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima &
+ .and. lwarm_lima .and. lsnow_lima ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'COHG'
+ tzsource%clongname = 'conversion from hail to graupel'
+ tzsource%lavailable = hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima &
+ .and. lwarm_lima .and. lsnow_lima
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'HGCV'
+ tzsource%clongname = 'hail to graupel conversion'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not. lptsplit .and. lhail_lima .and. lcold_lima &
+ .and. lwarm_lima .and. lsnow_lima ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RH) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RH), cbulist_rrh )
+end if
+
+! Budgets of RSV (scalar variables)
+
+if ( ksv > 999 ) call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', 'number of scalar variables > 999' )
+
+SV_BUDGETS: do jsv = 1, ksv
+ ibudget = NBUDGET_SV1 - 1 + jsv
+
+ tbudgets(ibudget)%lenabled = lbu_rsv
+
+ if ( lbu_rsv ) then
+ tbudgets(ibudget)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(ibudget)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(ibudget)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(ibudget)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(ibudget)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of scalar variable ' // csvnames(jsv)
+ tzsource%ngrid = 1
+
+ tzsource%cunits = '1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifsv
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_sv( jsv ) .or. ( celec /= 'NONE' .and. lrelax2fw_ion &
+ .and. (jsv == nsv_elecbeg .or. jsv == nsv_elecend ) )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DCONV'
+ tzsource%clongname = 'KAFR convection'
+ tzsource%lavailable = ( hdconv == 'KAFR' .or. hsconv == 'KAFR' ) .and. ochtrans
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'MAFL'
+ tzsource%clongname = 'mass flux'
+ tzsource%lavailable = hsconv == 'EDKF'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_sv
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEGA2'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ ! Add specific source terms to different scalar variables
+ SV_VAR: if ( jsv <= nsv_user ) then
+ ! nsv_user case
+ ! Nothing to do
+
+ else if ( jsv >= nsv_c2r2beg .and. jsv <= nsv_c2r2end ) then SV_VAR
+ ! C2R2 or KHKO Case
+
+ ! Source terms in common for all C2R2/KHKO budgets
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ ! Source terms specific to each budget
+ SV_C2R2: select case( jsv - nsv_c2r2beg + 1 )
+ case ( 1 ) SV_C2R2
+ ! Concentration of activated nuclei
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt )
+ tzsource%lavailable = gtmp .or. ( .not.gtmp .and. .not.lsupsat_c2r2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEVA'
+ tzsource%clongname = 'evaporation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 2 ) SV_C2R2
+ ! Concentration of cloud droplets
+ tzsource%cmnhname = 'DEPOTR'
+ tzsource%clongname = 'tree droplet deposition'
+ tzsource%lavailable = odragtree .and. odepotree
+ call Budget_source_add( tbudgets(ibudget), tzsource)
+
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt )
+ tzsource%lavailable = gtmp .or. ( .not.gtmp .and. .not.lsupsat_c2r2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SELF'
+ tzsource%clongname = 'self-collection of cloud droplets'
+ tzsource%lavailable = lrain_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = lrain_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = lsedc_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPO'
+ tzsource%clongname = 'surface droplet deposition'
+ tzsource%lavailable = ldepoc_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEVA'
+ tzsource%clongname = 'evaporation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 3 ) SV_C2R2
+ ! Concentration of raindrops
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = lrain_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SCBU'
+ tzsource%clongname = 'self collection - coalescence/break-up'
+ tzsource%lavailable = hcloud /= 'KHKO'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lrain_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'BRKU'
+ tzsource%clongname = 'spontaneous break-up'
+ tzsource%lavailable = lrain_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 4 ) SV_C2R2
+ ! Supersaturation
+ tzsource%cmnhname = 'CEVA'
+ tzsource%clongname = 'evaporation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ end select SV_C2R2
+
+
+ else if ( jsv >= nsv_lima_beg .and. jsv <= nsv_lima_end ) then SV_VAR
+ ! LIMA case
+
+ ! Source terms in common for all LIMA budgets (except supersaturation)
+ if ( jsv /= nsv_lima_spro ) then
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+ end if
+
+
+ ! Source terms specific to each budget
+ SV_LIMA: if ( jsv == nsv_lima_nc ) then
+ ! Cloud droplets concentration
+ tzsource%cmnhname = 'DEPOTR'
+ tzsource%clongname = 'tree droplet deposition'
+ tzsource%lavailable = odragtree .and. odepotree
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+! tzsource%cmnhname = 'CORR'
+! tzsource%clongname = 'correction'
+! tzsource%lavailable = lptsplit .and. lwarm_lima .and. lrain_lima
+! call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = lwarm_lima .and. lsedc_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPO'
+ tzsource%clongname = 'surface droplet deposition'
+ tzsource%lavailable = lwarm_lima .and. ldepoc_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'R2C1'
+ tzsource%clongname = 'rain to cloud change after sedimentation'
+ tzsource%lavailable = lptsplit .and. lwarm_lima .and. lrain_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ tzsource%lavailable = lwarm_lima .and. lacti_lima .and. nmod_ccn >= 1 .and. ( .not.lptsplit .or. .not.lsubg_cond )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = lcold_lima .and. lnucl_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SELF'
+ tzsource%clongname = 'self-collection of cloud droplets'
+ tzsource%lavailable = lptsplit .or. (lwarm_lima .and. lrain_lima)
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = lptsplit .or. ( lwarm_lima .and. lrain_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = lptsplit .or. ( lwarm_lima .and. lrain_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lptsplit .or. ( lwarm_lima .and. lrain_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HONC'
+ tzsource%clongname = 'droplet homogeneous freezing'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lnucl_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CVRC'
+ tzsource%clongname = 'rain to cloud change after other microphysical processes'
+ tzsource%lavailable = lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = .not.lptsplit .and. lhail_lima .and. lcold_lima .and. lwarm_lima .and. lsnow_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = lwarm_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv == nsv_lima_nr ) then SV_LIMA
+ ! Rain drops concentration
+! tzsource%cmnhname = 'CORR'
+! tzsource%clongname = 'correction'
+! tzsource%lavailable = lptsplit .and. lwarm_lima .and. lrain_lima
+! call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = lwarm_lima .and. lrain_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'R2C1'
+ tzsource%clongname = 'rain to cloud change after sedimentation'
+ tzsource%lavailable = lptsplit .and. lwarm_lima .and. lrain_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = lptsplit .or. (lwarm_lima .and. lrain_lima)
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SCBU'
+ tzsource%clongname = 'self collection - coalescence/break-up'
+ tzsource%lavailable = lptsplit .or. (lwarm_lima .and. lrain_lima)
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lptsplit .or. (lwarm_lima .and. lrain_lima)
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'BRKU'
+ tzsource%clongname = 'spontaneous break-up'
+ tzsource%lavailable = lptsplit .or. (lwarm_lima .and. lrain_lima)
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HONR'
+ tzsource%clongname = 'rain homogeneous freezing'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lrain_lima .and. lnucl_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on aggregates'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima .and. lrain_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CVRC'
+ tzsource%clongname = 'rain to cloud change after other microphysical processes'
+ tzsource%lavailable = lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = .not.lptsplit .and. lhail_lima .and. lcold_lima .and. lwarm_lima .and. lsnow_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = .not.lptsplit .and. lhail_lima .and. lcold_lima .and. lwarm_lima .and. lsnow_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_lima_ccn_free .and. jsv <= nsv_lima_ccn_free + nmod_ccn - 1 ) then SV_LIMA
+ ! Free CCN concentration
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ tzsource%lavailable = lwarm_lima .and. lacti_lima .and. nmod_ccn >= 1 .and. ( .not.lptsplit .or. .not.lsubg_cond )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = lcold_lima .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = lwarm_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SCAV'
+ tzsource%clongname = 'scavenging'
+ tzsource%lavailable = lscav_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_lima_ccn_acti .and. jsv <= nsv_lima_ccn_acti + nmod_ccn - 1 ) then SV_LIMA
+ ! Activated CCN concentration
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ tzsource%lavailable = lwarm_lima .and. lacti_lima .and. nmod_ccn >= 1 .and. ( .not.lptsplit .or. .not.lsubg_cond )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = lcold_lima .and. lnucl_lima .and. .not. lmeyers_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = lwarm_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv == nsv_lima_scavmass ) then SV_LIMA
+ ! Scavenged mass variable
+ tzsource%cmnhname = 'SCAV'
+ tzsource%clongname = 'scavenging'
+ tzsource%lavailable = lscav_lima .and. laero_mass_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = lscav_lima .and. laero_mass_lima .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv == nsv_lima_ni ) then SV_LIMA
+ ! Pristine ice crystals concentration
+! tzsource%cmnhname = 'CORR'
+! tzsource%clongname = 'correction'
+! tzsource%lavailable = lptsplit .and. lcold_lima .and. lsnow_lima
+! call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = lcold_lima .and. lsedi_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = lcold_lima .and. lnucl_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = lcold_lima .and. lnucl_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = lcold_lima .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HONC'
+ tzsource%clongname = 'droplet homogeneous freezing'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lnucl_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CNVI'
+ tzsource%clongname = 'conversion of snow to cloud ice'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CNVS'
+ tzsource%clongname = 'conversion of pristine ice to snow'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AGGS'
+ tzsource%clongname = 'aggregation of snow'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMS'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to snow riming'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CIBU'
+ tzsource%clongname = 'ice multiplication process due to ice collisional breakup'
+ tzsource%lavailable = .not.lptsplit .and. lcold_lima .and. lwarm_lima .and. lsnow_lima .and. lcibu
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RDSF'
+ tzsource%clongname = 'ice multiplication process following rain contact freezing'
+ tzsource%lavailable = .not.lptsplit .and. lcold_lima .and. lwarm_lima .and. lsnow_lima .and. lrdsf
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMG'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to graupel riming'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = .not.lptsplit .and. lhail_lima .and. lcold_lima .and. lwarm_lima .and. lsnow_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = lcold_lima .and. .not.lptsplit .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_lima_ifn_free .and. jsv <= nsv_lima_ifn_free + nmod_ifn - 1 ) then SV_LIMA
+ ! Free IFN concentration
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = lcold_lima .and. lnucl_lima .and. .not. lmeyers_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = lcold_lima .and. .not.lptsplit .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SCAV'
+ tzsource%clongname = 'scavenging'
+ tzsource%lavailable = lscav_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_lima_ifn_nucl .and. jsv <= nsv_lima_ifn_nucl + nmod_ifn - 1 ) then SV_LIMA
+ ! Nucleated IFN concentration
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = lcold_lima .and. lnucl_lima &
+ .and. ( ( lmeyers_lima .and. jsv == nsv_lima_ifn_nucl ) .or. .not. lmeyers_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = lcold_lima .and. lnucl_lima .and. lmeyers_lima .and. jsv == nsv_lima_ifn_nucl
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = lcold_lima .and. .not.lptsplit .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_lima_imm_nucl .and. jsv <= nsv_lima_imm_nucl + nmod_imm - 1 ) then SV_LIMA
+ ! Nucleated IMM concentration
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = lcold_lima .and. lnucl_lima .and. .not. lmeyers_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = lcold_lima .and. .not.lptsplit .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv == nsv_lima_hom_haze ) then SV_LIMA
+ ! Homogeneous freezing of CCN
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = lcold_lima .and. lnucl_lima .and. &
+ ( ( lhhoni_lima .and. nmod_ccn >= 1 ) .or. ( .not.lptsplit .and. lwarm_lima ) )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv == nsv_lima_spro ) then SV_LIMA
+ ! Supersaturation
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ end if SV_LIMA
+
+
+ else if ( jsv >= nsv_elecbeg .and. jsv <= nsv_elecend ) then SV_VAR
+ ! Electricity case
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ SV_ELEC: select case( jsv - nsv_elecbeg + 1 )
+ case ( 1 ) SV_ELEC
+ ! volumetric charge of water vapor
+ tzsource%cmnhname = 'DRIFT'
+ tzsource%clongname = 'ion drift motion'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CORAY'
+ tzsource%clongname = 'cosmic ray source'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 2 ) SV_ELEC
+ ! volumetric charge of cloud droplets
+ tzsource%cmnhname = 'HON'
+ tzsource%clongname = 'homogeneous nucleation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'INCG'
+ tzsource%clongname = 'inductive charge transfer between cloud droplets and graupel'
+ tzsource%lavailable = linductive
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'BERFI'
+ tzsource%clongname = 'Bergeron-Findeisen'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = lsedic_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 3 ) SV_ELEC
+ ! volumetric charge of rain drops
+ tzsource%cmnhname = 'SFR'
+ tzsource%clongname = 'spontaneous freezing'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on aggregates'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ case ( 4 ) SV_ELEC
+ ! volumetric charge of ice crystals
+ tzsource%cmnhname = 'HON'
+ tzsource%clongname = 'homogeneous nucleation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AGGS'
+ tzsource%clongname = 'aggregation of snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTS'
+ tzsource%clongname = 'autoconversion of ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'BERFI'
+ tzsource%clongname = 'Bergeron-Findeisen'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NIIS'
+ tzsource%clongname = 'non-inductive charge separation due to ice-snow collisions'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 5 ) SV_ELEC
+ ! volumetric charge of snow
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AGGS'
+ tzsource%clongname = 'aggregation of snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTS'
+ tzsource%clongname = 'autoconversion of ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'conversion melting'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NIIS'
+ tzsource%clongname = 'non-inductive charge separation due to ice-snow collisions'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 6 ) SV_ELEC
+ ! volumetric charge of graupel
+ tzsource%cmnhname = 'SFR'
+ tzsource%clongname = 'spontaneous freezing'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'conversion melting'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'INCG'
+ tzsource%clongname = 'inductive charge transfer between cloud droplets and graupel'
+ tzsource%lavailable = linductive
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 7: ) SV_ELEC
+ if ( ( hcloud == 'ICE4' .and. ( jsv - nsv_elecbeg + 1 ) == 7 ) ) then
+ ! volumetric charge of hail
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ else if ( ( hcloud == 'ICE3' .and. ( jsv - nsv_elecbeg + 1 ) == 7 ) &
+ .or. ( hcloud == 'ICE4' .and. ( jsv - nsv_elecbeg + 1 ) == 8 ) ) then
+ ! Negative ions (NSV_ELECEND case)
+ tzsource%cmnhname = 'DRIFT'
+ tzsource%clongname = 'ion drift motion'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CORAY'
+ tzsource%clongname = 'cosmic ray source'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ else
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', 'unknown electricity budget' )
+ end if
+
+ end select SV_ELEC
+
+
+ else if ( jsv >= nsv_lgbeg .and. jsv <= nsv_lgend ) then SV_VAR
+ !Lagrangian variables
+
+
+ else if ( jsv >= nsv_ppbeg .and. jsv <= nsv_ppend ) then SV_VAR
+ !Passive pollutants
+
+
+#ifdef MNH_FOREFIRE
+ else if ( jsv >= nsv_ffbeg .and. jsv <= nsv_ffend ) then SV_VAR
+ !Forefire
+
+#endif
+ else if ( jsv >= nsv_csbeg .and. jsv <= nsv_csend ) then SV_VAR
+ !Conditional sampling
+
+
+ else if ( jsv >= nsv_chembeg .and. jsv <= nsv_chemend ) then SV_VAR
+ !Chemical case
+ tzsource%cmnhname = 'CHEM'
+ tzsource%clongname = 'chemistry activity'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_chicbeg .and. jsv <= nsv_chicend ) then SV_VAR
+ !Ice phase chemistry
+
+
+ else if ( jsv >= nsv_aerbeg .and. jsv <= nsv_aerend ) then SV_VAR
+ !Chemical aerosol case
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = lorilam
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ else if ( jsv >= nsv_aerdepbeg .and. jsv <= nsv_aerdepend ) then SV_VAR
+ !Aerosol wet deposition
+
+ else if ( jsv >= nsv_dstbeg .and. jsv <= nsv_dstend ) then SV_VAR
+ !Dust
+
+ else if ( jsv >= nsv_dstdepbeg .and. jsv <= nsv_dstdepend ) then SV_VAR
+ !Dust wet deposition
+
+ else if ( jsv >= nsv_sltbeg .and. jsv <= nsv_sltend ) then SV_VAR
+ !Salt
+
+ else if ( jsv >= nsv_sltdepbeg .and. jsv <= nsv_sltdepend ) then SV_VAR
+ !Salt wet deposition
+
+ else if ( jsv >= nsv_snwbeg .and. jsv <= nsv_snwend ) then SV_VAR
+ !Snow
+ tzsource%cmnhname = 'SNSUB'
+ tzsource%clongname = 'blowing snow sublimation'
+ tzsource%lavailable = lblowsnow .and. lsnowsubl
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SNSED'
+ tzsource%clongname = 'blowing snow sedimentation'
+ tzsource%lavailable = lblowsnow
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_lnoxbeg .and. jsv <= nsv_lnoxend ) then SV_VAR
+ !LiNOX passive tracer
+
+ else SV_VAR
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', 'unknown scalar variable' )
+ end if SV_VAR
+
+
+ call Sourcelist_sort_compact( tbudgets(ibudget) )
+
+ call Sourcelist_scan( tbudgets(ibudget), cbulist_rsv )
+ end if
+end do SV_BUDGETS
+
+IF (CBUTYPE=='CART') THEN
+ WRITE(UNIT=KLUOUT, FMT= '(2/,"DESCRIPTION OF THE BUDGET BOX")' )
+ WRITE(UNIT=KLUOUT, FMT= '("BUIL = ",I4.4)' ) NBUIL
+ WRITE(UNIT=KLUOUT, FMT= '("BUIH = ",I4.4)' ) NBUIH
+ WRITE(UNIT=KLUOUT, FMT= '("BUJL = ",I4.4)' ) NBUJL
+ WRITE(UNIT=KLUOUT, FMT= '("BUJH = ",I4.4)' ) NBUJH
+ WRITE(UNIT=KLUOUT, FMT= '("BUKL = ",I4.4)' ) NBUKL
+ WRITE(UNIT=KLUOUT, FMT= '("BUKH = ",I4.4)' ) NBUKH
+ WRITE(UNIT=KLUOUT, FMT= '("BUIMAX = ",I4.4)' ) NBUIMAX
+ WRITE(UNIT=KLUOUT, FMT= '("BUJMAX = ",I4.4)' ) NBUJMAX
+ WRITE(UNIT=KLUOUT, FMT= '("BUKMAX = ",I4.4)' ) NBUKMAX
+END IF
+IF (CBUTYPE=='MASK') THEN
+ WRITE(UNIT=KLUOUT, FMT= '(2/,"DESCRIPTION OF THE BUDGET MASK")' )
+ WRITE(UNIT=KLUOUT, FMT= '("BUIL = ",I4.4)' ) NBUIL
+ WRITE(UNIT=KLUOUT, FMT= '("BUIH = ",I4.4)' ) NBUIH
+ WRITE(UNIT=KLUOUT, FMT= '("BUJL = ",I4.4)' ) NBUJL
+ WRITE(UNIT=KLUOUT, FMT= '("BUJH = ",I4.4)' ) NBUJH
+ WRITE(UNIT=KLUOUT, FMT= '("BUKL = ",I4.4)' ) NBUKL
+ WRITE(UNIT=KLUOUT, FMT= '("BUKH = ",I4.4)' ) NBUKH
+ WRITE(UNIT=KLUOUT, FMT= '("BUKMAX = ",I4.4)' ) NBUKMAX
+ WRITE(UNIT=KLUOUT, FMT= '("BUSUBWRITE = ",I4.4)' ) NBUSUBWRITE
+ WRITE(UNIT=KLUOUT, FMT= '("BUMASK = ",I4.4)' ) NBUMASK
+END IF
+
+call Ini_budget_groups( tbudgets, ibudim1, ibudim2, ibudim3 )
+
+if ( tbudgets(NBUDGET_U) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_U), cbulist_ru )
+if ( tbudgets(NBUDGET_V) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_V), cbulist_rv )
+if ( tbudgets(NBUDGET_W) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_W), cbulist_rw )
+if ( tbudgets(NBUDGET_TH) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_TH), cbulist_rth )
+if ( tbudgets(NBUDGET_TKE)%lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_TKE), cbulist_rtke )
+if ( tbudgets(NBUDGET_RV) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RV), cbulist_rrv )
+if ( tbudgets(NBUDGET_RC) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RC), cbulist_rrc )
+if ( tbudgets(NBUDGET_RR) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RR), cbulist_rrr )
+if ( tbudgets(NBUDGET_RI) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RI), cbulist_rri )
+if ( tbudgets(NBUDGET_RS) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RS), cbulist_rrs )
+if ( tbudgets(NBUDGET_RG) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RG), cbulist_rrg )
+if ( tbudgets(NBUDGET_RH) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RH), cbulist_rrh )
+if ( lbu_rsv ) call Sourcelist_sv_nml_compact( cbulist_rsv )
+end subroutine Ini_budget
+
+
+subroutine Budget_source_add( tpbudget, tpsource, odonotinit, ooverwrite )
+ use modd_budget, only: tbudgetdata, tbusourcedata
+
+ type(tbudgetdata), intent(inout) :: tpbudget
+ type(tbusourcedata), intent(in) :: tpsource ! Metadata basis
+ logical, optional, intent(in) :: odonotinit
+ logical, optional, intent(in) :: ooverwrite
+
+ character(len=4) :: ynum
+ integer :: isourcenumber
+
+ call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_source_add', 'called for ' // Trim( tpbudget%cname ) &
+ // ': ' // Trim( tpsource%cmnhname ) )
+
+ isourcenumber = tpbudget%nsources + 1
+ if ( isourcenumber > tpbudget%nsourcesmax ) then
+ Write( ynum, '( i4 )' ) tpbudget%nsourcesmax
+ cmnhmsg(1) = 'Insufficient max number of source terms (' // Trim(ynum) // ') for budget ' // Trim( tpbudget%cname )
+ cmnhmsg(2) = 'Please increaze value of parameter NSOURCESMAX'
+ call Print_msg( NVERB_FATAL, 'BUD', 'Budget_source_add' )
+ else
+ tpbudget%nsources = tpbudget%nsources + 1
+ end if
+
+ ! Copy metadata from provided tpsource
+ ! Modifications to source term metadata done with the other dummy arguments
+ tpbudget%tsources(isourcenumber) = tpsource
+
+ if ( present( odonotinit ) ) tpbudget%tsources(isourcenumber)%ldonotinit = odonotinit
+
+ if ( present( ooverwrite ) ) tpbudget%tsources(isourcenumber)%loverwrite = ooverwrite
+end subroutine Budget_source_add
+
+
+subroutine Ini_budget_groups( tpbudgets, kbudim1, kbudim2, kbudim3 )
+ use modd_budget, only: tbudgetdata
+ use modd_field, only: TYPEINT, TYPEREAL
+ use modd_parameters, only: NMNHNAMELGTMAX, NSTDNAMELGTMAX
+
+ use mode_tools, only: Quicksort
+
+ type(tbudgetdata), dimension(:), intent(inout) :: tpbudgets
+ integer, intent(in) :: kbudim1
+ integer, intent(in) :: kbudim2
+ integer, intent(in) :: kbudim3
+
+ character(len=NMNHNAMELGTMAX) :: ymnhname
+ character(len=NSTDNAMELGTMAX) :: ystdname
+ character(len=32) :: ylongname
+ character(len=40) :: yunits
+ character(len=100) :: ycomment
+ integer :: ji, jj, jk
+ integer :: isources ! Number of source terms in a budget
+ integer :: inbgroups ! Number of budget groups
+ integer :: ival
+ integer :: icount
+ integer :: ivalmax, ivalmin
+ integer :: igrid
+ integer :: itype
+ integer :: idims
+ integer, dimension(:), allocatable :: igroups ! Temporary array to store sorted group numbers
+ integer, dimension(:), allocatable :: ipos ! Temporary array to store initial position of group numbers
+ real :: zval
+ real :: zvalmax, zvalmin
+
+ call Print_msg( NVERB_DEBUG, 'BUD', 'Ini_budget_groups', 'called' )
+
+ BUDGETS: do ji = 1, size( tpbudgets )
+ ENABLED: if ( tpbudgets(ji)%lenabled ) then
+ isources = size( tpbudgets(ji)%tsources )
+ do jj = 1, isources
+ ! Check if ngroup is an allowed value
+ if ( tpbudgets(ji)%tsources(jj)%ngroup < 0 ) then
+ call Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'negative group value is not allowed' )
+ tpbudgets(ji)%tsources(jj)%ngroup = 0
+ end if
+
+ if ( tpbudgets(ji)%tsources(jj)%ngroup > 0 ) tpbudgets(ji)%tsources(jj)%lenabled = .true.
+ end do
+
+ !Count the number of groups of source terms
+ !ngroup=1 is for individual entries, >1 values are groups
+ allocate( igroups(isources ) )
+ allocate( ipos (isources ) )
+ igroups(:) = tpbudgets(ji)%tsources(:)%ngroup
+ ipos(:) = [ ( jj, jj = 1, isources ) ]
+
+ !Sort the group list number
+ call Quicksort( igroups, 1, isources, ipos )
+
+ !Count the number of different groups
+ !and renumber the entries (from 1 to inbgroups)
+ inbgroups = 0
+ ival = igroups(1)
+ if ( igroups(1) /= 0 ) then
+ inbgroups = 1
+ igroups(1) = inbgroups
+ end if
+ do jj = 2, isources
+ if ( igroups(jj) == 1 ) then
+ inbgroups = inbgroups + 1
+ igroups(jj) = inbgroups
+ else if ( igroups(jj) > 0 ) then
+ if ( igroups(jj) /= ival ) then
+ ival = igroups(jj)
+ inbgroups = inbgroups + 1
+ end if
+ igroups(jj) = inbgroups
+ end if
+ end do
+
+ !Write the igroups values to the budget structure
+ do jj = 1, isources
+ tpbudgets(ji)%tsources(ipos(jj))%ngroup = igroups(jj)
+ end do
+
+ !Allocate the group structure + populate it
+ tpbudgets(ji)%ngroups = inbgroups
+ allocate( tpbudgets(ji)%tgroups(inbgroups) )
+
+ do jj = 1, inbgroups
+ !Search the list of sources for each group
+ !not the most efficient algorithm but do the job
+ icount = 0
+ do jk = 1, isources
+ if ( tpbudgets(ji)%tsources(jk)%ngroup == jj ) then
+ icount = icount + 1
+ ipos(icount) = jk !ipos is reused as a temporary work array
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%nsources = icount
+
+ allocate( tpbudgets(ji)%tgroups(jj)%nsourcelist(icount) )
+ tpbudgets(ji)%tgroups(jj)%nsourcelist(:) = ipos(1 : icount)
+
+ ! Set the name of the field
+ ymnhname = tpbudgets(ji)%tsources(ipos(1))%cmnhname
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ ymnhname = trim( ymnhname ) // '_' // trim( tpbudgets(ji)%tsources(ipos(jk))%cmnhname )
+ end do
+ tpbudgets(ji)%tgroups(jj)%cmnhname = ymnhname
+
+ ! Set the standard name (CF convention)
+ if ( tpbudgets(ji)%tgroups(jj)%nsources == 1 ) then
+ ystdname = tpbudgets(ji)%tsources(ipos(1))%cstdname
+ else
+ ! The CF standard name is probably wrong if combining several source terms => set to ''
+ ystdname = ''
+ end if
+ tpbudgets(ji)%tgroups(jj)%cstdname = ystdname
+
+ ! Set the long name (CF convention)
+ ylongname = tpbudgets(ji)%tsources(ipos(1))%clongname
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ ylongname = trim( ylongname ) // ' + ' // tpbudgets(ji)%tsources(ipos(jk))%clongname
+ end do
+ tpbudgets(ji)%tgroups(jj)%clongname = ylongname
+
+ ! Set the units
+ yunits = tpbudgets(ji)%tsources(ipos(1))%cunits
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( trim( yunits ) /= trim( tpbudgets(ji)%tsources(ipos(jk))%cunits ) ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', &
+ 'incompatible units for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ yunits = 'unknown'
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%cunits = yunits
+
+ ! Set the comment
+ ! It is composed of the source comment followed by the clongnames of the different sources
+ ycomment = trim( tpbudgets(ji)%tsources(ipos(1))%ccomment ) // ': '// trim( tpbudgets(ji)%tsources(ipos(1))%clongname )
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ ycomment = trim( ycomment ) // ', ' // trim( tpbudgets(ji)%tsources(ipos(jk))%clongname )
+ end do
+ ycomment = trim( ycomment ) // ' source term'
+ if ( tpbudgets(ji)%tgroups(jj)%nsources > 1 ) ycomment = trim( ycomment ) // 's'
+ tpbudgets(ji)%tgroups(jj)%ccomment = ycomment
+
+ ! Set the Arakawa grid
+ igrid = tpbudgets(ji)%tsources(ipos(1))%ngrid
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( igrid /= tpbudgets(ji)%tsources(ipos(jk))%ngrid ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', &
+ 'different Arakawa grid positions for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%ngrid = igrid
+
+ ! Set the data type
+ itype = tpbudgets(ji)%tsources(ipos(1))%ntype
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( itype /= tpbudgets(ji)%tsources(ipos(jk))%ntype ) then
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', &
+ 'incompatible data types for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%ntype = itype
+
+ ! Set the number of dimensions
+ idims = tpbudgets(ji)%tsources(ipos(1))%ndims
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( idims /= tpbudgets(ji)%tsources(ipos(jk))%ndims ) then
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', &
+ 'incompatible number of dimensions for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%ndims = idims
+
+ ! Set the fill values
+ if ( tpbudgets(ji)%tgroups(jj)%ntype == TYPEINT ) then
+ ival = tpbudgets(ji)%tsources(ipos(1))%nfillvalue
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( ival /= tpbudgets(ji)%tsources(ipos(jk))%nfillvalue ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', &
+ 'different (integer) fill values for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%nfillvalue = ival
+ end if
+
+ if ( tpbudgets(ji)%tgroups(jj)%ntype == TYPEREAL ) then
+ zval = tpbudgets(ji)%tsources(ipos(1))%xfillvalue
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( zval /= tpbudgets(ji)%tsources(ipos(jk))%xfillvalue ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', &
+ 'different (real) fill values for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%xfillvalue = zval
+ end if
+
+ ! Set the valid min/max values
+ ! Take the min or max of all the sources
+ ! Maybe, it would be better to take the sum? (if same sign, if not already the maximum allowed value for this type)
+ if ( tpbudgets(ji)%tgroups(jj)%ntype == TYPEINT ) then
+ ivalmin = tpbudgets(ji)%tsources(ipos(1))%nvalidmin
+ ivalmax = tpbudgets(ji)%tsources(ipos(1))%nvalidmax
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ ivalmin = min( ivalmin, tpbudgets(ji)%tsources(ipos(jk))%nvalidmin )
+ ivalmax = max( ivalmax, tpbudgets(ji)%tsources(ipos(jk))%nvalidmax )
+ end do
+ tpbudgets(ji)%tgroups(jj)%nvalidmin = ivalmin
+ tpbudgets(ji)%tgroups(jj)%nvalidmax = ivalmax
+ end if
+
+ if ( tpbudgets(ji)%tgroups(jj)%ntype == TYPEREAL ) then
+ zvalmin = tpbudgets(ji)%tsources(ipos(1))%xvalidmin
+ zvalmax = tpbudgets(ji)%tsources(ipos(1))%xvalidmax
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ zvalmin = min( zvalmin, tpbudgets(ji)%tsources(ipos(jk))%xvalidmin )
+ zvalmax = max( zvalmax, tpbudgets(ji)%tsources(ipos(jk))%xvalidmax )
+ end do
+ tpbudgets(ji)%tgroups(jj)%xvalidmin = zvalmin
+ tpbudgets(ji)%tgroups(jj)%xvalidmax = zvalmax
+ end if
+
+ allocate( tpbudgets(ji)%tgroups(jj)%xdata(kbudim1, kbudim2, kbudim3 ) )
+ tpbudgets(ji)%tgroups(jj)%xdata(:, :, :) = 0.
+ end do
+
+ deallocate( igroups )
+ deallocate( ipos )
+
+ !Check that a group does not contain more than 1 source term with ldonotinit=.true.
+ do jj = 1, inbgroups
+ if ( tpbudgets(ji)%tgroups(jj)%nsources > 1 ) then
+ do jk = 1, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( tpbudgets(ji)%tsources(tpbudgets(ji)%tgroups(jj)%nsourcelist(jk) )%ldonotinit ) &
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', &
+ 'a group with more than 1 source term may not contain sources with ldonotinit=true' )
+ if ( tpbudgets(ji)%tsources(tpbudgets(ji)%tgroups(jj)%nsourcelist(jk) )%loverwrite ) &
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', &
+ 'a group with more than 1 source term may not contain sources with loverwrite=true' )
+ end do
+ end if
+ end do
+
+ end if ENABLED
+ end do BUDGETS
+
+end subroutine Ini_budget_groups
+
+
+subroutine Sourcelist_sort_compact( tpbudget )
+ !Sort the list of sources to put the non-available source terms at the end of the list
+ !and compact the list
+ use modd_budget, only: tbudgetdata, tbusourcedata
+
+ type(tbudgetdata), intent(inout) :: tpbudget
+
+ integer :: ji
+ integer :: isrc_avail, isrc_notavail
+ type(tbusourcedata), dimension(:), allocatable :: tzsources_avail
+ type(tbusourcedata), dimension(:), allocatable :: tzsources_notavail
+
+ isrc_avail = 0
+ isrc_notavail = 0
+
+ Allocate( tzsources_avail (tpbudget%nsources) )
+ Allocate( tzsources_notavail(tpbudget%nsources) )
+
+ !Separate source terms available or not during the execution
+ !(based on the criteria provided to Budget_source_add and stored in lavailable field)
+ do ji = 1, tpbudget%nsources
+ if ( tpbudget%tsources(ji)%lavailable ) then
+ isrc_avail = isrc_avail + 1
+ tzsources_avail(isrc_avail) = tpbudget%tsources(ji)
+ else
+ isrc_notavail = isrc_notavail + 1
+ tzsources_notavail(isrc_notavail) = tpbudget%tsources(ji)
+ end if
+ end do
+
+ !Reallocate/compact the source list
+ if ( Allocated( tpbudget%tsources ) ) Deallocate( tpbudget%tsources )
+ Allocate( tpbudget%tsources( tpbudget%nsources ) )
+
+ tpbudget%nsourcesmax = tpbudget%nsources
+ !Limit the number of sources to the available list
+ tpbudget%nsources = isrc_avail
+
+ !Fill the source list beginning with the available sources and finishing with the non-available ones
+ do ji = 1, isrc_avail
+ tpbudget%tsources(ji) = tzsources_avail(ji)
+ end do
+
+ do ji = 1, isrc_notavail
+ tpbudget%tsources(isrc_avail + ji) = tzsources_notavail(ji)
+ end do
+
+end subroutine Sourcelist_sort_compact
+
+
+subroutine Sourcelist_scan( tpbudget, hbulist )
+ use modd_budget, only: tbudgetdata
+
+ type(tbudgetdata), intent(inout) :: tpbudget
+ character(len=*), dimension(:), intent(in) :: hbulist
+
+ character(len=:), allocatable :: yline
+ character(len=:), allocatable :: ysrc
+ character(len=:), dimension(:), allocatable :: ymsg
+ integer :: idx
+ integer :: igroup
+ integer :: igroup_idx
+ integer :: ipos
+ integer :: istart
+ integer :: ji
+
+ istart = 1
+
+ ! Case 'LIST_AVAIL': list all the available source terms
+ if ( Size( hbulist ) > 0 ) then
+ if ( Trim( hbulist(1) ) == 'LIST_AVAIL' ) then
+ Allocate( character(len=65) :: ymsg(tpbudget%nsources + 1) )
+ ymsg(1) = '---------------------------------------------------------------------'
+ ymsg(2) = 'Available source terms for budget ' // Trim( tpbudget%cname )
+ Write( ymsg(3), '( A32, " ", A32 )' ) 'Name', 'Long name'
+ idx = 3
+ do ji = 1, tpbudget%nsources
+ if ( All( tpbudget%tsources(ji)%cmnhname /= [ 'INIF' , 'ENDF', 'AVEF' ] ) ) then
+ idx = idx + 1
+ Write( ymsg(idx), '( A32, " ", A32 )' ) tpbudget%tsources(ji)%cmnhname, tpbudget%tsources(ji)%clongname
+ end if
+ end do
+ ymsg(tpbudget%nsources + 1 ) = '---------------------------------------------------------------------'
+ call Print_msg_multi( NVERB_WARNING, 'BUD', 'Sourcelist_scan', ymsg )
+ !To not read the 1st line again
+ istart = 2
+ end if
+ end if
+
+ ! Case 'LIST_ALL': list all the source terms
+ if ( Size( hbulist ) > 0 ) then
+ if ( Trim( hbulist(1) ) == 'LIST_ALL' ) then
+ Allocate( character(len=65) :: ymsg(tpbudget%nsourcesmax + 1) )
+ ymsg(1) = '---------------------------------------------------------------------'
+ ymsg(2) = 'Source terms for budget ' // Trim( tpbudget%cname )
+ Write( ymsg(3), '( A32, " ", A32 )' ) 'Name', 'Long name'
+ idx = 3
+ do ji = 1, tpbudget%nsourcesmax
+ if ( All( tpbudget%tsources(ji)%cmnhname /= [ 'INIF' , 'ENDF', 'AVEF' ] ) ) then
+ idx = idx + 1
+ Write( ymsg(idx), '( A32, " ", A32 )' ) tpbudget%tsources(ji)%cmnhname, tpbudget%tsources(ji)%clongname
+ end if
+ end do
+ ymsg(tpbudget%nsourcesmax + 1 ) = '---------------------------------------------------------------------'
+ call Print_msg_multi( NVERB_WARNING, 'BUD', 'Sourcelist_scan', ymsg )
+ !To not read the 1st line again
+ istart = 2
+ end if
+ end if
+
+ ! Case 'ALL': enable all available source terms
+ if ( Size( hbulist ) > 0 ) then
+ if ( Trim( hbulist(1) ) == 'ALL' ) then
+ do ji = 1, tpbudget%nsources
+ tpbudget%tsources(ji)%ngroup = 1
+ end do
+ return
+ end if
+ end if
+
+ !Always enable INIF, ENDF and AVEF terms
+ ipos = Source_find( tpbudget, 'INIF' )
+ if ( ipos < 1 ) call Print_msg( NVERB_FATAL, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': INIF not found' )
+ tpbudget%tsources(ipos)%ngroup = 1
+
+ ipos = Source_find( tpbudget, 'ENDF' )
+ if ( ipos < 1 ) call Print_msg( NVERB_FATAL, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': ENDF not found' )
+ tpbudget%tsources(ipos)%ngroup = 1
+
+ ipos = Source_find( tpbudget, 'AVEF' )
+ if ( ipos < 1 ) call Print_msg( NVERB_FATAL, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': AVEF not found' )
+ tpbudget%tsources(ipos)%ngroup = 1
+
+ !igroup_idx start at 2 because 1 is reserved for individually stored source terms
+ igroup_idx = 2
+
+ do ji = istart, Size( hbulist )
+ if ( Len_trim( hbulist(ji) ) > 0 ) then
+ ! Scan the line and separate the different sources (separated by + signs)
+ yline = Trim(hbulist(ji))
+
+ idx = Index( yline, '+' )
+ if ( idx < 1 ) then
+ igroup = 1
+ else
+ igroup = igroup_idx
+ igroup_idx = igroup_idx + 1
+ end if
+
+ do
+ idx = Index( yline, '+' )
+ if ( idx < 1 ) then
+ ysrc = yline
+ else
+ ysrc = yline(1 : idx - 1)
+ yline = yline(idx + 1 :)
+ end if
+
+ !Check if the source is known
+ if ( Len_trim( ysrc ) > 0 ) then
+ ipos = Source_find( tpbudget, ysrc )
+
+ if ( ipos > 0 ) then
+ call Print_msg( NVERB_DEBUG, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': ' // ysrc // ' found' )
+
+ if ( .not. tpbudget%tsources(ipos)%lavailable ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': ' // ysrc // ' not available' )
+ tpbudget%tsources(ipos)%ngroup = 0
+ else
+ tpbudget%tsources(ipos)%ngroup = igroup
+ end if
+ else
+ call Print_msg( NVERB_ERROR, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': ' // ysrc // ' not found' )
+ end if
+ end if
+
+ if ( idx < 1 ) exit
+ end do
+ end if
+ end do
+end subroutine Sourcelist_scan
+
+
+subroutine Sourcelist_nml_compact( tpbudget, hbulist )
+ !This subroutine reduce the size of the hbulist to the minimum
+ !The list is generated from the group list
+ use modd_budget, only: NBULISTMAXLEN, tbudgetdata
+
+ type(tbudgetdata), intent(in) :: tpbudget
+ character(len=NBULISTMAXLEN), dimension(:), allocatable, intent(inout) :: hbulist
+
+ integer :: idx
+ integer :: isource
+ integer :: jg
+ integer :: js
+
+ if ( Allocated( hbulist ) ) Deallocate( hbulist )
+
+ if ( tpbudget%ngroups < 3 ) then
+ call Print_msg( NVERB_ERROR, 'BUD', 'Sourcelist_nml_compact', 'ngroups is too small' )
+ return
+ end if
+
+ Allocate( character(len=NBULISTMAXLEN) :: hbulist(tpbudget%ngroups - 3) )
+ hbulist(:) = ''
+
+ idx = 0
+ do jg = 1, tpbudget%ngroups
+ if ( tpbudget%tgroups(jg)%nsources < 1 ) then
+ call Print_msg( NVERB_ERROR, 'BUD', 'Sourcelist_nml_compact', 'no source for group' )
+ cycle
+ end if
+
+ !Do not put 'INIF', 'ENDF', 'AVEF' in hbulist because their presence is automatic if the corresponding budget is enabled
+ isource = tpbudget%tgroups(jg)%nsourcelist(1)
+ if ( Any( tpbudget%tsources(isource)%cmnhname == [ 'INIF', 'ENDF', 'AVEF' ] ) ) cycle
+
+ idx = idx + 1
+#if 0
+ !Do not do this way because the group cmnhname may be truncated (NMNHNAMELGTMAX is smaller than NBULISTMAXLEN)
+ !and the name separator is different ('_')
+ hbulist(idx) = Trim( tpbudget%tgroups(jg)%cmnhname )
+#else
+ do js = 1, tpbudget%tgroups(jg)%nsources
+ isource = tpbudget%tgroups(jg)%nsourcelist(js)
+ hbulist(idx) = Trim( hbulist(idx) ) // Trim( tpbudget%tsources(isource)%cmnhname )
+ if ( js < tpbudget%tgroups(jg)%nsources ) hbulist(idx) = Trim( hbulist(idx) ) // '+'
+ end do
+#endif
+ end do
+end subroutine Sourcelist_nml_compact
+
+
+subroutine Sourcelist_sv_nml_compact( hbulist )
+ !This subroutine reduce the size of the hbulist
+ !For SV variables the reduction is simpler than for other variables
+ !because it is too complex to do this cleanly (the enabled source terms are different for each scalar variable)
+ use modd_budget, only: NBULISTMAXLEN, tbudgetdata
+
+ character(len=*), dimension(:), allocatable, intent(inout) :: hbulist
+
+ character(len=NBULISTMAXLEN), dimension(:), allocatable :: ybulist_new
+ integer :: ilines
+ integer :: ji
+
+ ilines = 0
+ do ji = 1, Size( hbulist )
+ if ( Len_trim(hbulist(ji)) > 0 ) ilines = ilines + 1
+ end do
+
+ Allocate( ybulist_new(ilines) )
+
+ ilines = 0
+ do ji = 1, Size( hbulist )
+ if ( Len_trim(hbulist(ji)) > 0 ) then
+ ilines = ilines + 1
+ ybulist_new(ilines) = Trim( hbulist(ji) )
+ end if
+ end do
+
+ call Move_alloc( from = ybulist_new, to = hbulist )
+end subroutine Sourcelist_sv_nml_compact
+
+
+pure function Source_find( tpbudget, hsource ) result( ipos )
+ use modd_budget, only: tbudgetdata
+
+ type(tbudgetdata), intent(in) :: tpbudget
+ character(len=*), intent(in) :: hsource
+ integer :: ipos
+
+ integer :: ji
+ logical :: gfound
+
+ ipos = -1
+ gfound = .false.
+ do ji = 1, tpbudget%nsourcesmax
+ if ( Trim( hsource ) == Trim ( tpbudget%tsources(ji)%cmnhname ) ) then
+ gfound = .true.
+ ipos = ji
+ exit
+ end if
+ end do
+
+end function Source_find
+
+end module mode_ini_budget
diff --git a/src/ICCARE_BASE/ini_lima_cold_mixed.f90 b/src/ICCARE_BASE/ini_lima_cold_mixed.f90
new file mode 100644
index 0000000000000000000000000000000000000000..bd43aa295823c10b581ef8be3be4ce60cf820525
--- /dev/null
+++ b/src/ICCARE_BASE/ini_lima_cold_mixed.f90
@@ -0,0 +1,1464 @@
+!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###############################
+ 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
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! C. Barthe 14/03/2022: add CIBU and RDSF
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_LUNIT, ONLY: TLUOUT0
+USE MODD_PARAMETERS
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_LIMA_WARM
+USE MODD_PARAM_LIMA_COLD
+USE MODD_PARAM_LIMA_MIXED
+USE MODD_REF
+!
+use mode_msg
+!
+USE MODI_LIMA_FUNCTIONS
+USE MODI_GAMMA
+USE MODI_GAMMA_INC
+USE MODI_RRCOLSS
+USE MODI_RZCOLX
+USE MODI_RSCOLRG
+USE MODI_LIMA_READ_XKER_RACCS
+USE MODI_LIMA_READ_XKER_SDRYG
+USE MODI_LIMA_READ_XKER_RDRYG
+USE MODI_LIMA_READ_XKER_SWETH
+USE MODI_LIMA_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 :
+!
+character(len=13) :: yval ! String for error message
+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
+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
+!
+REAL :: ZBOUND_CIBU_SMIN ! XDCSLIM*Lbda_s : lower & upper bound used
+REAL :: ZBOUND_CIBU_SMAX ! in the tabulated function
+REAL :: ZBOUND_CIBU_GMIN ! XDCGLIM*Lbda_g : lower & upper bound used
+REAL :: ZBOUND_CIBU_GMAX ! in the tabulated function
+REAL :: ZRATE_S ! Geometrical growth of Lbda_s in the tabulated function
+REAL :: ZRATE_G ! Geometrical growth of Lbda_g in the tabulated function
+!
+REAL :: ZBOUND_RDSF_RMIN ! XDCRLIM*Lbda_r : lower & upper bound used
+REAL :: ZBOUND_RDSF_RMAX ! in the tabulated function
+REAL :: ZRATE_R ! Geometrical growth of Lbda_r in the tabulated function
+REAL :: ZKHI_LWM ! Coefficient of Lawson et al. (2015)
+!
+REAL :: ZRHOIW ! ice density
+!
+!-------------------------------------------------------------------------------
+!
+!
+ILUOUT0 = TLUOUT0%NLU
+!
+!
+!* 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 = 747. ! Plates
+ XDI = 1.0 ! Plates
+ XC1I = 1./XPI ! Plates
+ CASE('COLU')
+ XAI = 2.14E-3 ! Columns
+ XBI = 1.7 ! Columns
+ XC_I = 1.96E5 ! Columns
+ XDI = 1.585 ! Columns
+ XC1I = 0.8 ! Columns
+ CASE('BURO')
+ XAI = 44.0 ! Bullet rosettes
+ XBI = 3.0 ! Bullet rosettes
+ XC_I = 4.E5 ! 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.
+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 = 122. ! 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 = 201.
+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 = 500000
+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)
+!XLBDAG_MAX = ( ZCONC_MAX/XCCG )**(1./XCXG)
+!XLBDAH_MAX = ( ZCONC_MAX/XCCH )**(1./XCXH)
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3. CONSTANTS FOR THE SEDIMENTATION
+! -------------------------------
+!
+!
+!* 3.1 Exponent of the fall-speed air density correction
+!
+IKB = 1 + JPVEXT
+! Correction
+! ZRHO00 = XP00/(XRD*XTHVREFZ(IKB))
+ZRHO00 = 1.2041 ! at P=1013.25hPa and T=20°C
+!
+!* 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
+!
+!
+!
+XLB(4) = XLBI
+XLBEX(4) = XLBEXI
+XD(4) = XDI
+XFSEDR(4) = XFSEDRI
+XFSEDC(4) = XFSEDCI
+!
+XLB(5) = XLBS
+XLBEX(5) = XLBEXS
+XD(5) = XDS
+XFSEDR(5) = XCS*GAMMA_X0D(XNUS+(XDS+XBS)/XALPHAS)/GAMMA_X0D(XNUS+XBS/XALPHAS)* &
+ (ZRHO00)**XCEXVT
+!
+XLB(6) = XLBG
+XLBEX(6) = XLBEXG
+XD(6) = XDG
+XFSEDR(6) = XCG*GAMMA_X0D(XNUG+(XDG+XBG)/XALPHAG)/GAMMA_X0D(XNUG+XBG/XALPHAG)* &
+ (ZRHO00)**XCEXVT
+!
+XLB(7) = XLBH
+XLBEX(7) = XLBEXH
+XD(7) = XDH
+XFSEDR(7) = XCH*GAMMA_X0D(XNUH+(XDH+XBH)/XALPHAH)/GAMMA_X0D(XNUH+XBH/XALPHAH)* &
+ (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
+ call Print_msg( NVERB_FATAL, 'GEN', 'INI_LIMA_COLD_MIXED', 'NPHILLIPS should be equal to 8 or 13' )
+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 ( yval, '( E13.6 )' ) xalphac
+ call Print_msg( NVERB_FATAL, 'GEN', 'INI_LIMA_COLD_MIXED', 'homogeneous nucleation: XALPHAC='//trim(yval)// &
+ '/= 3. No algorithm developed for this case' )
+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)/REAL(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)/REAL(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)/REAL(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)/REAL(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 LIMA_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 LIMA_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
+!
+!
+!* 7.4 Constants for Ice-Ice collision process (CIBU)
+!
+XDCSLIM_CIBU_MIN = 2.0E-4 ! D_cs lim min
+XDCSLIM_CIBU_MAX = 1.0E-3 ! D_cs lim max
+XDCGLIM_CIBU_MIN = 2.0E-3 ! D_cg lim min
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" Ice-ice collision process")')
+ WRITE(UNIT=ILUOUT0,FMT='(" D_cs^lim min-max =",E13.6)') XDCSLIM_CIBU_MIN,XDCSLIM_CIBU_MAX
+ WRITE(UNIT=ILUOUT0,FMT='(" D_cg^lim min =",E13.6)') XDCGLIM_CIBU_MIN
+END IF
+!
+NGAMINC = 80
+!
+!Note : Boundaries are rounded at 5.0 or 1.0 (down for Bound_min and up for Bound_max)
+XGAMINC_BOUND_CIBU_SMIN = 1.0E-5 ! Minimal value of (Lbda_s * D_cs^lim)**alpha) 0.2 mm
+XGAMINC_BOUND_CIBU_SMAX = 5.0E-3 ! Maximal value of (Lbda_s * D_cs^lim)**alpha) 1 mm
+XGAMINC_BOUND_CIBU_SMIN = 1.0E-5 ! Minimal value of (Lbda_s * D_cs^lim)**alpha) 0.2 mm
+XGAMINC_BOUND_CIBU_SMAX = 5.0E+2 ! Maximal value of (Lbda_s * D_cs^lim)**alpha) 1 mm
+ZRATE_S = EXP(LOG(XGAMINC_BOUND_CIBU_SMAX/XGAMINC_BOUND_CIBU_SMIN)/FLOAT(NGAMINC-1))
+!
+XGAMINC_BOUND_CIBU_GMIN = 1.0E-1 ! Minimal value of (Lbda_g * D_cg^lim)**alpha) 2 mm
+XGAMINC_BOUND_CIBU_GMAX = 1.0E0 ! Maximal value of (Lbda_g * D_cg^lim)**alpha) 2 mm
+XGAMINC_BOUND_CIBU_GMIN = 1.0E-1 ! Minimal value of (Lbda_g * D_cg^lim)**alpha) 2 mm
+XGAMINC_BOUND_CIBU_GMAX = 5.0E+1 ! Maximal value of (Lbda_g * D_cg^lim)**alpha) 2 mm
+ZRATE_G = EXP(LOG(XGAMINC_BOUND_CIBU_GMAX/XGAMINC_BOUND_CIBU_GMIN)/FLOAT(NGAMINC-1))
+!
+ALLOCATE( XGAMINC_CIBU_S(4,NGAMINC) )
+ALLOCATE( XGAMINC_CIBU_G(2,NGAMINC) )
+!
+DO J1 = 1, NGAMINC
+ ZBOUND_CIBU_SMIN = XGAMINC_BOUND_CIBU_SMIN * ZRATE_S**(J1-1)
+ ZBOUND_CIBU_GMIN = XGAMINC_BOUND_CIBU_GMIN * ZRATE_G**(J1-1)
+!
+! For ZNI_CIBU
+ XGAMINC_CIBU_S(1,J1) = GAMMA_INC(XNUS,ZBOUND_CIBU_SMIN)
+ XGAMINC_CIBU_S(2,J1) = GAMMA_INC(XNUS+(XDS/XALPHAS),ZBOUND_CIBU_SMIN)
+!
+ XGAMINC_CIBU_G(1,J1) = GAMMA_INC(XNUG+((2.0+XDG)/XALPHAG),ZBOUND_CIBU_GMIN)
+ XGAMINC_CIBU_G(2,J1) = GAMMA_INC(XNUG+(2.0/XALPHAG),ZBOUND_CIBU_GMIN)
+!
+! For ZRI_CIBU
+ XGAMINC_CIBU_S(3,J1) = GAMMA_INC(XNUS+(XBS/XALPHAS),ZBOUND_CIBU_SMIN)
+ XGAMINC_CIBU_S(4,J1) = GAMMA_INC(XNUS+((XBS+XDS)/XALPHAS),ZBOUND_CIBU_SMIN)
+END DO
+!
+XCIBUINTP_S = XALPHAS / LOG(ZRATE_S)
+XCIBUINTP1_S = 1.0 + XCIBUINTP_S * LOG(XDCSLIM_CIBU_MIN/(XGAMINC_BOUND_CIBU_SMIN)**(1.0/XALPHAS))
+XCIBUINTP2_S = 1.0 + XCIBUINTP_S * LOG(XDCSLIM_CIBU_MAX/(XGAMINC_BOUND_CIBU_SMIN)**(1.0/XALPHAS))
+!
+XCIBUINTP_G = XALPHAG / LOG(ZRATE_G)
+XCIBUINTP1_G = 1.0 + XCIBUINTP_G * LOG(XDCGLIM_CIBU_MIN/(XGAMINC_BOUND_CIBU_GMIN)**(1.0/XALPHAG))
+!
+! For ZNI_CIBU
+XFACTOR_CIBU_NI = (XPI / 4.0) * XCCG * XCCS * (ZRHO00**XCEXVT)
+XMOMGG_CIBU_1 = MOMG(XALPHAG,XNUG,2.0+XDG)
+XMOMGG_CIBU_2 = MOMG(XALPHAG,XNUG,2.0)
+XMOMGS_CIBU_1 = MOMG(XALPHAS,XNUS,XDS)
+!
+! For ZRI_CIBU
+XFACTOR_CIBU_RI = XAS * (XPI / 4.0) * XCCG * XCCS * (ZRHO00**XCEXVT)
+XMOMGS_CIBU_2 = MOMG(XALPHAS,XNUS,XBS)
+XMOMGS_CIBU_3 = MOMG(XALPHAS,XNUS,XBS+XDS)
+!
+!
+!* 7.5 Constants for raindrop shattering by freezing process (RDSF)
+!
+XDCRLIM_RDSF_MIN = 0.1E-3 ! D_cr lim min
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" Ice-rain collision process")')
+ WRITE(UNIT=ILUOUT0,FMT='(" D_cr^lim min =",E13.6)') XDCRLIM_RDSF_MIN
+END IF
+!
+NGAMINC = 80
+!
+XGAMINC_BOUND_RDSF_RMIN = 1.0E-5 ! Minimal value of (Lbda_r * D_cr^lim)**alpha) 0.1 mm
+XGAMINC_BOUND_RDSF_RMAX = 5.0E-3 ! Maximal value of (Lbda_r * D_cr^lim)**alpha) 1 mm
+ZRATE_R = EXP(LOG(XGAMINC_BOUND_RDSF_RMAX/XGAMINC_BOUND_RDSF_RMIN)/FLOAT(NGAMINC-1))
+!
+ALLOCATE( XGAMINC_RDSF_R(NGAMINC) )
+!
+DO J1 = 1, NGAMINC
+ ZBOUND_RDSF_RMIN = XGAMINC_BOUND_RDSF_RMIN * ZRATE_R**(J1-1)
+!
+! For ZNI_RDSF
+ XGAMINC_RDSF_R(J1) = GAMMA_INC(XNUR+((6.0+XDR)/XALPHAR),ZBOUND_RDSF_RMIN)
+END DO
+!
+XRDSFINTP_R = XALPHAR / LOG(ZRATE_R)
+XRDSFINTP1_R = 1.0 + XRDSFINTP_R * LOG( XDCRLIM_RDSF_MIN/(XGAMINC_BOUND_RDSF_RMIN)**(1.0/XALPHAR) )
+!
+! For ZNI_RDSF
+ZKHI_LWM = 2.5E13 ! Coeff. in Lawson-Woods-Morrison for the number of splinters
+ ! N_DF = XKHI_LWM * D_R**4
+XFACTOR_RDSF_NI = ZKHI_LWM * (XPI / 4.0) * XCR * (ZRHO00**XCEXVT)
+XMOMGR_RDSF = MOMG(XALPHAR,XNUR,6.0+XDR)
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 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)/REAL(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)/REAL(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)/REAL(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 LIMA_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 LIMA_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 LIMA_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 LIMA_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)/REAL(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)/REAL(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)/REAL(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 LIMA_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 LIMA_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 LIMA_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 LIMA_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/ICCARE_BASE/init_aerosol_properties.f90 b/src/ICCARE_BASE/init_aerosol_properties.f90
deleted file mode 100644
index 9e5e5497484712f1033f376a8c1aca3de1da9f9a..0000000000000000000000000000000000000000
--- a/src/ICCARE_BASE/init_aerosol_properties.f90
+++ /dev/null
@@ -1,434 +0,0 @@
-!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ####################
- MODULE MODI_INIT_AEROSOL_PROPERTIES
-INTERFACE
- SUBROUTINE INIT_AEROSOL_PROPERTIES
- END SUBROUTINE INIT_AEROSOL_PROPERTIES
-END INTERFACE
-END MODULE MODI_INIT_AEROSOL_PROPERTIES
-! ####################
-!
-! #############################################################
- 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
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! Philippe Wautelet: 22/01/2019: bugs correction: incorrect writes + unauthorized goto
-!! C. Barthe 03/2020 change xfrac values to reduce the cost of scavenging
-!! M. Leriche 02/2021 add reading CAMS file
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAM_n, ONLY : CCLOUD
-USE MODD_LUNIT, ONLY : TLUOUT0
-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
-
-!
-!-------------------------------------------------------------------------------
-!
-ILUOUT0 = TLUOUT0%NLU
-!
-!!!!!!!!!!!!!!!!
-! 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 ('MACC_ACC')
- ! sea-salt, sulfate, hydrophilic (GADS data)
- RCCN(:) = (/ 0.2E-6 , 0.5E-6 , 0.4E-6 /)
- LOGSIGCCN(:) = (/ 0.693 , 0.476 , 0.788 /)
- RHOCCN(:) = (/ 2200. , 1700. , 1800. /)
- CASE ('CAMS')
-! sea-salt, sulfate, hydrophilic (GADS data)
- RCCN(:) = (/ 0.2E-6 , 0.05E-6 , 0.02E-6 /)
- LOGSIGCCN(:) = (/ 0.693 , 0.693 , 0.788 /)
- RHOCCN(:) = (/ 2200. , 2700. , 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 ('MOCAGE') ! ordre : sulfates, sels marins, BC+O
- RCCN(:) = (/ 0.01E-6 , 0.05E-6 , 0.008E-6 /)
- LOGSIGCCN(:) = (/ 0.788 , 0.993 , 0.916 /)
- RHOCCN(:) = (/ 1000. , 2200. , 1000. /)
- 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') THEN
- IF (LSCAV) THEN
-! Attention !
- WRITE(UNIT=ILUOUT0,FMT='("You are using a numerical initialization &
- ¬ depending on the aerosol properties, however you need it for &
- &scavenging. &
- &With LSCAV = true, HINI_CCN should be set to AER for consistency")')
- END IF
-! Numerical initialization without dependence on AP physical properties
- 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 == '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 ('MOCAGE')
- 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.05E-6 , 3.E-6 , 0.016E-6 , 0.016E-6 /)
- XSIGMA_IFN = (/ 2.4 , 1.6 , 2.5 , 2.5 /)
- XRHO_IFN = (/ 2650. , 2650. , 1000. , 1000. /)
- 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 ('MACC_ACC')
- ! 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.04E-6, 0.8E-6 /)
- XSIGMA_IFN = (/2.0, 2.15, 2.0, 2.2 /)
- XRHO_IFN = (/2600., 2600., 1000., 2000. /)
- CASE ('CAMS')
-! 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.04E-6, 0.04E-6/)
- XSIGMA_IFN = (/2.0, 2.15, 2.0, 2.2 /)
- XRHO_IFN = (/2600., 2600., 1000., 1800./)
- 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
-!++cb++ 18/03/20 to reduce the computational cost in scavenging
-! XFRAC(3,2)=0.5
-! XFRAC(4,2)=0.5
- XFRAC(3,2)=0.
- XFRAC(4,2)=1.
-!--cb--
- CASE ('MACC_ACC')
- 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.0
- XFRAC(4,2)=1.0
- CASE ('CAMS')
- 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.0
- XFRAC(4,2)=1.0
- CASE ('MOCAGE')
- XFRAC(1,1)=1.
- XFRAC(2,1)=0.
- XFRAC(3,1)=0.
- XFRAC(4,1)=0.
- XFRAC(1,2)=0.
- XFRAC(2,2)=0.
- XFRAC(3,2)=0.7
- XFRAC(4,2)=0.3
- 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/ICCARE_BASE/lima_mixed_fast_processes.f90 b/src/ICCARE_BASE/lima_mixed_fast_processes.f90
new file mode 100644
index 0000000000000000000000000000000000000000..525ea3dfba7257955559379942b9b3413257ef81
--- /dev/null
+++ b/src/ICCARE_BASE/lima_mixed_fast_processes.f90
@@ -0,0 +1,1863 @@
+!MNH_LIC Copyright 2013-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #####################################
+ MODULE MODI_LIMA_MIXED_FAST_PROCESSES
+! #####################################
+!
+INTERFACE
+ SUBROUTINE LIMA_MIXED_FAST_PROCESSES (PRHODREF, PZT, PPRES, PTSTEP, &
+ PLSFACT, PLVFACT, PKA, PDV, PCJ, &
+ PRVT1D, PRCT1D, PRRT1D, PRIT1D, PRST1D, &
+ PRGT1D, PRTH1D, PCCT1D, PCRT1D, PCIT1D, &
+ PRCS1D, PRRS1D, PRIS1D, PRSS1D, PRGS1D, &
+ PRHS1D, PTHS1D, PCCS1D, PCRS1D, PCIS1D, &
+ PLBDAC, PLBDAR, PLBDAS, PLBDAG, PLBDAH, &
+ PRHODJ1D, GMICRO, PRHODJ, KMI, PTHS, &
+ PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, &
+ PCCS, PCRS, PCIS )
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! RHO Dry REFerence
+REAL, DIMENSION(:), INTENT(IN) :: PZT ! Temperature
+REAL, DIMENSION(:), INTENT(IN) :: PPRES ! Pressure
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
+REAL, DIMENSION(:), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
+REAL, DIMENSION(:), INTENT(IN) :: PKA ! Thermal conductivity of the air
+REAL, DIMENSION(:), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
+REAL, DIMENSION(:), INTENT(IN) :: PCJ ! Ventilation coefficient ?
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRVT1D ! Water vapor m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRCT1D ! Cloud water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRRT1D ! Rain water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRIT1D ! Pristine ice m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRST1D ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRGT1D ! Graupel m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRTH1D ! Hail m.r. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCCT1D ! Cloud water conc. at t
+REAL, DIMENSION(:), INTENT(IN) :: PCRT1D ! Rain water conc. at t
+REAL, DIMENSION(:), INTENT(IN) :: PCIT1D ! Pristine ice conc. at t
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: PRCS1D ! Cloud water m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRRS1D ! Rain water m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRIS1D ! Pristine ice m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRSS1D ! Snow/aggregate m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRGS1D ! Graupel/hail m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRHS1D ! Hail m.r. source
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: PTHS1D ! Theta source
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: PCCS1D ! Cloud water conc. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PCRS1D ! Rain water conc. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PCIS1D ! Pristine ice conc. source
+!
+REAL, DIMENSION(:), INTENT(IN) :: PLBDAC ! Slope param of the cloud droplet distr.
+REAL, DIMENSION(:), INTENT(IN) :: PLBDAR ! Slope param of the raindrop distr
+REAL, DIMENSION(:), INTENT(IN) :: PLBDAS ! Slope param of the aggregate distr.
+REAL, DIMENSION(:), INTENT(IN) :: PLBDAG ! Slope param of the graupel distr.
+REAL, DIMENSION(:), INTENT(IN) :: PLBDAH ! Slope param of the hail distr.
+!
+! used for budget storage
+REAL, DIMENSION(:), INTENT(IN) :: PRHODJ1D
+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 (PRHODREF, PZT, PPRES, PTSTEP, &
+ PLSFACT, PLVFACT, PKA, PDV, PCJ, &
+ PRVT1D, PRCT1D, PRRT1D, PRIT1D, PRST1D, &
+ PRGT1D, PRTH1D, PCCT1D, PCRT1D, PCIT1D, &
+ PRCS1D, PRRS1D, PRIS1D, PRSS1D, PRGS1D, &
+ PRHS1D, PTHS1D, PCCS1D, PCRS1D, PCIS1D, &
+ PLBDAC, PLBDAR, PLBDAS, PLBDAG, PLBDAH, &
+ PRHODJ1D, 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
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
+! C. Barthe 14/03/2022: - add CIBU (from T. Hoarau's work) and RDSF (from J.P. Pinty's work)
+! - change the name of some arguments to match the DOCTOR norm
+! - change conditions for HMG to occur
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbu_enable, nbumod, &
+ lbudget_th, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ tbudgets
+USE MODD_CST
+USE MODD_NSV
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_LIMA_COLD
+USE MODD_PARAM_LIMA_MIXED
+USE MODD_PARAM_LIMA_WARM, ONLY : XDR
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! RHO Dry REFerence
+REAL, DIMENSION(:), INTENT(IN) :: PZT ! Temperature
+REAL, DIMENSION(:), INTENT(IN) :: PPRES ! Pressure
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
+REAL, DIMENSION(:), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
+REAL, DIMENSION(:), INTENT(IN) :: PKA ! Thermal conductivity of the air
+REAL, DIMENSION(:), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air
+REAL, DIMENSION(:), INTENT(IN) :: PCJ ! Ventilation coefficient ?
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRVT1D ! Water vapor m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRCT1D ! Cloud water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRRT1D ! Rain water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRIT1D ! Pristine ice m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRST1D ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRGT1D ! Graupel/hail m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRTH1D ! Hail m.r. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCCT1D ! Cloud water conc. at t
+REAL, DIMENSION(:), INTENT(IN) :: PCRT1D ! Rain water conc. at t
+REAL, DIMENSION(:), INTENT(IN) :: PCIT1D ! Pristine ice conc. at t
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: PRCS1D ! Cloud water m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRRS1D ! Rain water m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRIS1D ! Pristine ice m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRSS1D ! Snow/aggregate m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRGS1D ! Graupel/hail m.r. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PRHS1D ! Hail m.r. source
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: PTHS1D ! Theta source
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: PCCS1D ! Cloud water conc. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PCRS1D ! Rain water conc. source
+REAL, DIMENSION(:), INTENT(INOUT) :: PCIS1D ! Pristine ice conc. source
+!
+REAL, DIMENSION(:), INTENT(IN) :: PLBDAC ! Slope param of the cloud droplet distr.
+REAL, DIMENSION(:), INTENT(IN) :: PLBDAR ! Slope param of the raindrop distr
+REAL, DIMENSION(:), INTENT(IN) :: PLBDAS ! Slope param of the aggregate distr.
+REAL, DIMENSION(:), INTENT(IN) :: PLBDAG ! Slope param of the graupel distr.
+REAL, DIMENSION(:), INTENT(IN) :: PLBDAH ! Slope param of the hail distr.
+!
+! used for budget storage
+REAL, DIMENSION(:), INTENT(IN) :: PRHODJ1D
+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(PZT)) :: 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(PZT)) :: ZZW, ZZX
+REAL, DIMENSION(SIZE(PZT)) :: ZRDRYG, ZRWETG
+REAL, DIMENSION(SIZE(PZT),7) :: ZZW1
+REAL :: NHAIL
+REAL :: ZTHRH, ZTHRC
+!
+! Variables for CIBU
+LOGICAL, DIMENSION(SIZE(PZT)) :: GCIBU ! Test where to compute collision process
+LOGICAL, SAVE :: GFIRSTCALL = .TRUE. ! control switch for the first call
+!
+INTEGER :: ICIBU
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC2_S1,IVEC2_S2 ! Snow indice vector
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC2_G ! Graupel indice vector
+INTEGER, PARAMETER :: I_SEED_PARAM = 26032012
+INTEGER, DIMENSION(:), ALLOCATABLE :: I_SEED
+INTEGER :: NI_SEED
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1_S, ZVEC1_S1, ZVEC1_S2, & ! Work vectors
+ ZVEC1_S3, ZVEC1_S4, &
+ ZVEC1_S11, ZVEC1_S12, & ! for snow
+ ZVEC1_S21, ZVEC1_S22, &
+ ZVEC1_S31, ZVEC1_S32, &
+ ZVEC1_S41, ZVEC1_S42, &
+ ZVEC2_S1, ZVEC2_S2
+REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1_G, ZVEC1_G1, ZVEC1_G2, & ! Work vectors
+ ZVEC2_G ! for graupel
+REAL, DIMENSION(:), ALLOCATABLE :: ZINTG_SNOW_1, & ! incomplete gamma function
+ ZINTG_SNOW_2, & ! for snow
+ ZINTG_SNOW_3, &
+ ZINTG_SNOW_4
+REAL, DIMENSION(:), ALLOCATABLE :: ZINTG_GRAUPEL_1, & ! incomplete gamma
+ ZINTG_GRAUPEL_2 ! function for graupel
+REAL, DIMENSION(:), ALLOCATABLE :: ZNI_CIBU, ZRI_CIBU ! CIBU rates
+REAL, DIMENSION(:), ALLOCATABLE :: ZFRAGMENTS, ZHARVEST, ZFRAG_CIBU
+REAL :: ZFACT1_XNDEBRIS, ZFACT2_XNDEBRIS
+!
+LOGICAL, DIMENSION(SIZE(PZT)) :: GRDSF ! Test where to compute collision process
+INTEGER :: IRDSF
+REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1_R ! Work vectors for rain
+REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1_R1 ! Work vectors for rain
+REAL, DIMENSION(:), ALLOCATABLE :: ZVEC2_R ! Work vectors for rain
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC2_R ! Rain indice vector
+REAL, DIMENSION(:), ALLOCATABLE :: ZINTG_RAIN ! incomplete gamma function for rain
+REAL, DIMENSION(:), ALLOCATABLE :: ZNI_RDSF,ZRI_RDSF ! RDSF rates
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZAUX ! used to distribute
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFACT ! the total concentration in each shape
+REAL, DIMENSION(:), ALLOCATABLE :: ZONEOVER_VAR ! for optimization
+!
+!
+!-------------------------------------------------------------------------------
+!
+! #################
+! FAST RS PROCESSES
+! #################
+!
+SNOW: IF (LSNOW) THEN
+!
+!
+!* 1.1 Cloud droplet riming of the aggregates
+! -------------------------------------------
+!
+ZZW1(:,:) = 0.0
+!
+GRIM(:) = (PRCT1D(:)>XRTMIN(2)) .AND. (PRST1D(:)>XRTMIN(5)) .AND. (PRCS1D(:)>XRTMIN(2)/PTSTEP) .AND. (PZT(:)<XTT)
+IGRIM = COUNT( GRIM(:) )
+!
+IF( IGRIM>0 ) THEN
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'RIM', &
+ Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'RIM', &
+ Unpack( prcs1d(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'RIM', &
+ Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'RIM', &
+ Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'RIM', &
+ Unpack( pccs1d(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+!
+! 1.1.0 allocations
+!
+ ALLOCATE(ZVEC1(IGRIM))
+ ALLOCATE(ZVEC2(IGRIM))
+ ALLOCATE(IVEC1(IGRIM))
+ ALLOCATE(IVEC2(IGRIM))
+!
+! 1.1.1 select the PLBDAS
+!
+ ZVEC1(:) = PACK( PLBDAS(:),MASK=GRIM(:) )
+!
+! 1.1.2 find the next lower indice for the PLBDAS in the geometrical
+! set of Lbda_s used to tabulate some moments of the incomplete
+! gamma function
+!
+ ZVEC2(1:IGRIM) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, &
+ XRIMINTP1 * LOG( ZVEC1(1:IGRIM) ) + XRIMINTP2 ) )
+ IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) )
+ ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - REAL( 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( PRCS1D(:), &
+ XCRIMSS * ZZW(:) * PRCT1D(:) & ! RCRIMSS
+ * PLBDAS(:)**XEXCRIMSS &
+ * PRHODREF(:)**(-XCEXVT) )
+ PRCS1D(:) = PRCS1D(:) - ZZW1(:,1)
+ PRSS1D(:) = PRSS1D(:) + ZZW1(:,1)
+ PTHS1D(:) = PTHS1D(:) + ZZW1(:,1) * (PLSFACT(:) - PLVFACT(:)) ! f(L_f*(RCRIMSS))
+!
+ PCCS1D(:) = MAX( PCCS1D(:)-ZZW1(:,1)*(PCCT1D(:)/PRCT1D(:)),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. (PRSS1D(:)>XRTMIN(5)/PTSTEP) )
+ ZZW1(:,2) = MIN( PRCS1D(:), &
+ XCRIMSG * PRCT1D(:) & ! RCRIMSG
+ * PLBDAS(:)**XEXCRIMSG &
+ * PRHODREF(:)**(-XCEXVT) &
+ - ZZW1(:,1) )
+ ZZW1(:,3) = MIN( PRSS1D(:), &
+ XSRIMCG * PLBDAS(:)**XEXSRIMCG & ! RSRIMCG
+ * (1.0 - ZZW(:) )/(PTSTEP*PRHODREF(:)))
+ PRCS1D(:) = PRCS1D(:) - ZZW1(:,2)
+ PRSS1D(:) = PRSS1D(:) - ZZW1(:,3)
+ PRGS1D(:) = PRGS1D(:) + ZZW1(:,2) + ZZW1(:,3)
+ PTHS1D(:) = PTHS1D(:) + ZZW1(:,2) * (PLSFACT(:) - PLVFACT(:)) ! f(L_f*(RCRIMSG))
+ !
+ PCCS1D(:) = MAX( PCCS1D(:)-ZZW1(:,2)*(PCCT1D(:)/PRCT1D(:)),0.0 ) ! Lambda_c**3
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ !
+ ! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'RIM', &
+ Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'RIM', &
+ Unpack( prcs1d(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'RIM', &
+ Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'RIM', &
+ Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'RIM', &
+ Unpack( pccs1d(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+END IF
+!
+!
+!* 1.2 Hallett-Mossop ice multiplication process due to snow riming
+! -----------------------------------------------------------------
+!
+GRIM(:) = (PZT(:)<XHMTMAX) .AND. (PZT(:)>XHMTMIN) &
+ .AND. (PRST1D(:)>XRTMIN(5)) .AND. (PRCT1D(:)>XRTMIN(2))
+IGRIM = COUNT( GRIM(:) )
+IF( IGRIM>0 ) THEN
+ ! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HMS', &
+ Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'HMS', &
+ Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HMS', &
+ Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+
+ ALLOCATE(ZVEC1(IGRIM))
+ ALLOCATE(ZVEC2(IGRIM))
+ ALLOCATE(IVEC2(IGRIM))
+!
+ ZVEC1(:) = PACK( PLBDAC(:),MASK=GRIM(:) )
+ ZVEC2(1:IGRIM) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, &
+ XHMLINTP1 * LOG( ZVEC1(1:IGRIM) ) + XHMLINTP2 ) )
+ IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) )
+ ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - REAL( 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))*(PCCT1D(:)/PRCT1D(:))*(1.0-ZZX(:))* &
+ XHM_FACTS* &
+ MAX( 0.0, MIN( (PZT(:)-XHMTMIN)/3.0,(XHMTMAX-PZT(:))/2.0 ) ) ! CCHMSI
+ PCIS1D(:) = PCIS1D(:) + ZZW1(:,5)
+!
+ ZZW1(:,6) = ZZW1(:,5) * XMNU0 ! RCHMSI
+ PRIS1D(:) = PRIS1D(:) + ZZW1(:,6)
+ PRSS1D(:) = PRSS1D(:) - ZZW1(:,6)
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ !
+ ! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HMS', &
+ Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'HMS', &
+ Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HMS', &
+ Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+END IF
+!
+!
+!* 1.3 Ice multiplication process due to ice-ice collisions
+! ---------------------------------------------------------
+!
+GCIBU(:) = LCIBU .AND. (PRST1D(:)>XRTMIN(5)) .AND. (PRGT1D(:)>XRTMIN(6))
+ICIBU = COUNT( GCIBU(:) )
+!
+IF (ICIBU > 0) THEN
+!
+ ! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CIBU', &
+ Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'CIBU', &
+ Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CIBU', &
+ Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+!
+! 1.3.0 randomization of XNDEBRIS_CIBU values
+!
+ IF (GFIRSTCALL) THEN
+ CALL RANDOM_SEED(SIZE=NI_SEED) ! get size of seed
+ ALLOCATE(I_SEED(NI_SEED))
+ I_SEED(:) = I_SEED_PARAM !
+ CALL RANDOM_SEED(PUT=I_SEED)
+ GFIRSTCALL = .FALSE.
+ END IF
+!
+ ALLOCATE(ZFRAGMENTS(ICIBU))
+!
+ IF (XNDEBRIS_CIBU >= 0.0) THEN
+ ZFRAGMENTS(:) = XNDEBRIS_CIBU
+ ELSE
+!
+! Mantissa gives the mean value (randomization around 10**MANTISSA)
+! First digit after the comma provides the full range around 10**MANTISSA
+!
+ ALLOCATE(ZHARVEST(ICIBU))
+!
+ ZFACT1_XNDEBRIS = AINT(XNDEBRIS_CIBU)
+ ZFACT2_XNDEBRIS = ABS(ANINT(10.0*(XNDEBRIS_CIBU - ZFACT1_XNDEBRIS)))
+!
+ CALL RANDOM_NUMBER(ZHARVEST(:))
+!
+ ZFRAGMENTS(:) = 10.0**(ZFACT2_XNDEBRIS*ZHARVEST(:) + ZFACT1_XNDEBRIS)
+!
+ DEALLOCATE(ZHARVEST)
+!
+! ZFRAGMENTS is a random variable containing the number of fragments per collision
+! For XNDEBRIS_CIBU=-1.2345 => ZFRAGMENTS(:) = 10.0**(2.0*RANDOM_NUMBER(ZHARVEST(:)) - 1.0)
+! and ZFRAGMENTS=[0.1, 10.0] centered around 1.0
+!
+ END IF
+!
+!
+! 1.3.1 To compute the partial integration of snow gamma function
+!
+! 1.3.1.0 allocations
+!
+ ALLOCATE(ZVEC1_S(ICIBU))
+ ALLOCATE(ZVEC1_S1(ICIBU))
+ ALLOCATE(ZVEC1_S2(ICIBU))
+ ALLOCATE(ZVEC1_S3(ICIBU))
+ ALLOCATE(ZVEC1_S4(ICIBU))
+ ALLOCATE(ZVEC1_S11(ICIBU))
+ ALLOCATE(ZVEC1_S12(ICIBU))
+ ALLOCATE(ZVEC1_S21(ICIBU))
+ ALLOCATE(ZVEC1_S22(ICIBU))
+ ALLOCATE(ZVEC1_S31(ICIBU))
+ ALLOCATE(ZVEC1_S32(ICIBU))
+ ALLOCATE(ZVEC1_S41(ICIBU))
+ ALLOCATE(ZVEC1_S42(ICIBU))
+ ALLOCATE(ZVEC2_S1(ICIBU))
+ ALLOCATE(IVEC2_S1(ICIBU))
+ ALLOCATE(ZVEC2_S2(ICIBU))
+ ALLOCATE(IVEC2_S2(ICIBU))
+!
+!
+! 1.3.1.1 select the PLBDAS
+!
+ ZVEC1_S(:) = PACK( PLBDAS(:),MASK=GCIBU(:) )
+!
+!
+! 1.3.1.2 find the next lower indice for the PLBDAS in the
+! geometrical set of Lbda_s used to tabulate some moments of the
+! incomplete gamma function, for boundary 1 (0.2 mm)
+!
+ ZVEC2_S1(1:ICIBU) = MAX( 1.0001, MIN( FLOAT(NGAMINC)-0.0001,XCIBUINTP_S &
+ * LOG( ZVEC1_S(1:ICIBU) ) + XCIBUINTP1_S ) )
+ IVEC2_S1(1:ICIBU) = INT( ZVEC2_S1(1:ICIBU) )
+ ZVEC2_S1(1:ICIBU) = ZVEC2_S1(1:ICIBU) - FLOAT( IVEC2_S1(1:ICIBU) )
+!
+!
+! 1.3.1.3 find the next lower indice for the PLBDAS in the
+! geometrical set of Lbda_s used to tabulate some moments of the
+! incomplete gamma function, for boundary 2 (1 mm)
+!
+ ZVEC2_S2(1:ICIBU) = MAX( 1.0001, MIN( FLOAT(NGAMINC)-0.0001,XCIBUINTP_S &
+ * LOG( ZVEC1_S(1:ICIBU) ) + XCIBUINTP2_S ) )
+ IVEC2_S2(1:ICIBU) = INT( ZVEC2_S2(1:ICIBU) )
+ ZVEC2_S2(1:ICIBU) = ZVEC2_S2(1:ICIBU) - FLOAT( IVEC2_S2(1:ICIBU) )
+!
+!
+! 1.3.1.4 perform the linear interpolation of the
+! normalized "0"-moment of the incomplete gamma function
+!
+! For lower boundary (0.2 mm)
+ ZVEC1_S11(1:ICIBU) = XGAMINC_CIBU_S(1,IVEC2_S1(1:ICIBU)+1) * ZVEC2_S1(1:ICIBU) &
+ - XGAMINC_CIBU_S(1,IVEC2_S1(1:ICIBU)) * (ZVEC2_S1(1:ICIBU)-1.0)
+!
+! For upper boundary (1 mm)
+ ZVEC1_S12(1:ICIBU) = XGAMINC_CIBU_S(1,IVEC2_S2(1:ICIBU)+1) * ZVEC2_S2(1:ICIBU) &
+ - XGAMINC_CIBU_S(1,IVEC2_S2(1:ICIBU)) * (ZVEC2_S2(1:ICIBU)-1.0)
+!
+! Computation of spectrum from 0.2 mm to 1 mm
+ ZVEC1_S1(1:ICIBU) = ZVEC1_S12(1:ICIBU) - ZVEC1_S11(1:ICIBU)
+!
+!
+! 1.3.1.5 perform the linear interpolation of the
+! normalized "XDS"-moment of the incomplete gamma function
+!
+! For lower boundary (0.2 mm)
+ ZVEC1_S21(1:ICIBU) = XGAMINC_CIBU_S(2,IVEC2_S1(1:ICIBU)+1) * ZVEC2_S1(1:ICIBU) &
+ - XGAMINC_CIBU_S(2,IVEC2_S1(1:ICIBU)) * (ZVEC2_S1(1:ICIBU)-1.0)
+!
+! For upper boundary (1 mm)
+ ZVEC1_S22(1:ICIBU) = XGAMINC_CIBU_S(2,IVEC2_S2(1:ICIBU)+1) * ZVEC2_S2(1:ICIBU) &
+ - XGAMINC_CIBU_S(2,IVEC2_S2(1:ICIBU)) * (ZVEC2_S2(1:ICIBU)-1.0)
+!
+! From 0.2 mm to 1 mm we need
+ ZVEC1_S2(1:ICIBU) = XMOMGS_CIBU_1 * (ZVEC1_S22(1:ICIBU) - ZVEC1_S21(1:ICIBU))
+!
+! For lower boundary (0.2 mm)
+ ZVEC1_S31(1:ICIBU) = XGAMINC_CIBU_S(3,IVEC2_S1(1:ICIBU)+1) * ZVEC2_S1(1:ICIBU) &
+ - XGAMINC_CIBU_S(3,IVEC2_S1(1:ICIBU)) * (ZVEC2_S1(1:ICIBU)-1.0)
+!
+! For upper boundary (1 mm)
+ ZVEC1_S32(1:ICIBU) = XGAMINC_CIBU_S(3,IVEC2_S2(1:ICIBU)+1) * ZVEC2_S2(1:ICIBU) &
+ - XGAMINC_CIBU_S(3,IVEC2_S2(1:ICIBU)) * (ZVEC2_S2(1:ICIBU)-1.0)
+!
+! From 0.2 mm to 1 mm we need
+ ZVEC1_S3(1:ICIBU) = XMOMGS_CIBU_2 * (ZVEC1_S32(1:ICIBU) - ZVEC1_S31(1:ICIBU))
+!
+!
+! 1.3.1.6 perform the linear interpolation of the
+! normalized "XBS+XDS"-moment of the incomplete gamma function
+!
+! For lower boundary (0.2 mm)
+ ZVEC1_S41(1:ICIBU) = XGAMINC_CIBU_S(4,IVEC2_S1(1:ICIBU)+1) * ZVEC2_S1(1:ICIBU) &
+ - XGAMINC_CIBU_S(4,IVEC2_S1(1:ICIBU)) * (ZVEC2_S1(1:ICIBU)-1.0)
+!
+! For upper boundary (1 mm)
+ ZVEC1_S42(1:ICIBU) = XGAMINC_CIBU_S(4,IVEC2_S2(1:ICIBU)+1) * ZVEC2_S2(1:ICIBU) &
+ - XGAMINC_CIBU_S(4,IVEC2_S2(1:ICIBU)) * (ZVEC2_S2(1:ICIBU)-1.0)
+!
+! From 0.2 mm to 1 mm we need
+ ZVEC1_S4(1:ICIBU) = XMOMGS_CIBU_3 * (ZVEC1_S42(1:ICIBU) - ZVEC1_S41(1:ICIBU))
+!
+ ALLOCATE(ZINTG_SNOW_1(SIZE(PZT)))
+ ALLOCATE(ZINTG_SNOW_2(SIZE(PZT)))
+ ALLOCATE(ZINTG_SNOW_3(SIZE(PZT)))
+ ALLOCATE(ZINTG_SNOW_4(SIZE(PZT)))
+!
+ ZINTG_SNOW_1(:) = UNPACK ( VECTOR=ZVEC1_S1(:),MASK=GCIBU,FIELD=0.0 )
+ ZINTG_SNOW_2(:) = UNPACK ( VECTOR=ZVEC1_S2(:),MASK=GCIBU,FIELD=0.0 )
+ ZINTG_SNOW_3(:) = UNPACK ( VECTOR=ZVEC1_S3(:),MASK=GCIBU,FIELD=0.0 )
+ ZINTG_SNOW_4(:) = UNPACK ( VECTOR=ZVEC1_S4(:),MASK=GCIBU,FIELD=0.0 )
+!
+!
+! 1.3.2 Compute the partial integration of graupel gamma function
+!
+! 1.3.2.0 allocations
+!
+ ALLOCATE(ZVEC1_G(ICIBU))
+ ALLOCATE(ZVEC1_G1(ICIBU))
+ ALLOCATE(ZVEC1_G2(ICIBU))
+ ALLOCATE(ZVEC2_G(ICIBU))
+ ALLOCATE(IVEC2_G(ICIBU))
+!
+!
+! 1.3.2.1 select the PLBDAG
+!
+ ZVEC1_G(:) = PACK( PLBDAG(:),MASK=GCIBU(:) )
+!
+!
+! 1.3.2.2 find the next lower indice for the PLBDAG in the
+! geometrical set of Lbda_g used to tabulate some moments of the
+! incomplete gamma function, for the "2mm" boundary
+!
+ ZVEC2_G(1:ICIBU) = MAX( 1.0001, MIN( FLOAT(NGAMINC)-0.0001,XCIBUINTP_G &
+ * LOG( ZVEC1_G(1:ICIBU) ) + XCIBUINTP1_G ) )
+ IVEC2_G(1:ICIBU) = INT( ZVEC2_G(1:ICIBU) )
+ ZVEC2_G(1:ICIBU) = ZVEC2_G(1:ICIBU) - FLOAT( IVEC2_G(1:ICIBU) )
+!
+!
+! 1.3.2.3 perform the linear interpolation of the
+! normalized "2+XDG"-moment of the incomplete gamma function
+!
+ ZVEC1_G1(1:ICIBU) = XGAMINC_CIBU_G(1,IVEC2_G(1:ICIBU)+1) * ZVEC2_G(1:ICIBU) &
+ - XGAMINC_CIBU_G(1,IVEC2_G(1:ICIBU)) * (ZVEC2_G(1:ICIBU)-1.0)
+!
+! From 2 mm to infinity we need
+ ZVEC1_G1(1:ICIBU) = XMOMGG_CIBU_1 * (1.0 - ZVEC1_G1(1:ICIBU))
+!
+!
+! 1.3.2.4 perform the linear interpolation of the
+! normalized "2.0"-moment of the incomplete gamma function
+!
+ ZVEC1_G2(1:ICIBU) = XGAMINC_CIBU_G(2,IVEC2_G(1:ICIBU)+1) * ZVEC2_G(1:ICIBU) &
+ - XGAMINC_CIBU_G(2,IVEC2_G(1:ICIBU)) * (ZVEC2_G(1:ICIBU)-1.0)
+!
+! From 2 mm to infinity we need
+ ZVEC1_G2(1:ICIBU) = XMOMGG_CIBU_2 * (1.0 - ZVEC1_G2(1:ICIBU))
+!
+!
+ ALLOCATE(ZINTG_GRAUPEL_1(SIZE(PZT)))
+ ALLOCATE(ZINTG_GRAUPEL_2(SIZE(PZT)))
+!
+ ZINTG_GRAUPEL_1(:) = UNPACK ( VECTOR=ZVEC1_G1(:),MASK=GCIBU,FIELD=0.0 )
+ ZINTG_GRAUPEL_2(:) = UNPACK ( VECTOR=ZVEC1_G2(:),MASK=GCIBU,FIELD=0.0 )
+!
+!
+! 1.3.3 To compute final "CIBU" contributions
+!
+ ALLOCATE(ZNI_CIBU(SIZE(PZT)))
+ ALLOCATE(ZFRAG_CIBU(SIZE(PZT)))
+!
+ ZFRAG_CIBU(:) = UNPACK ( VECTOR=ZFRAGMENTS(:),MASK=GCIBU,FIELD=0.0 )
+ ZNI_CIBU(:) = ZFRAG_CIBU(:) * (XFACTOR_CIBU_NI / (PRHODREF(:)**(XCEXVT-1.0))) * &
+ (XCG * ZINTG_GRAUPEL_1(:) * ZINTG_SNOW_1(:) * &
+ PLBDAS(:)**(XCXS) * PLBDAG(:)**(XCXG-(XDG+2.0)) &
+ - XCS * ZINTG_GRAUPEL_2(:) * ZINTG_SNOW_2(:) * &
+ PLBDAS(:)**(XCXS-XDS) * PLBDAG(:)**(XCXG-2.0) )
+ PCIS1D(:) = PCIS1D(:) + MAX(ZNI_CIBU(:), 0.)
+!
+ DEALLOCATE(ZFRAG_CIBU)
+ DEALLOCATE(ZFRAGMENTS)
+!
+! Max value of rs removed by CIBU
+ ALLOCATE(ZRI_CIBU(SIZE(PZT)))
+ ZRI_CIBU(:) = (XFACTOR_CIBU_RI / (PRHODREF(:)**(XCEXVT+1.0))) * &
+ (XCG * ZINTG_GRAUPEL_1(:) * ZINTG_SNOW_3(:) * &
+ PLBDAS(:)**(XCXS-XBS) * PLBDAG(:)**(XCXG-(XDG+2.0)) &
+ - XCS * ZINTG_GRAUPEL_2(:) * ZINTG_SNOW_4(:) * &
+ PLBDAS(:)**(XCXS-(XBS+XDS)) * PLBDAG(:)**(XCXG-2.0))
+!
+! The value of rs removed by CIBU is determined by the mean mass of pristine ice
+ WHERE( PRIT1D(:)>XRTMIN(4) .AND. PCIT1D(:)>XCTMIN(4) )
+ ZRI_CIBU(:) = MIN( ZRI_CIBU(:), PRSS1D(:), ZNI_CIBU(:)*PRIT1D(:)/PCIT1D(:) )
+ ELSE WHERE
+ ZRI_CIBU(:) = MIN( ZRI_CIBU(:), PRSS1D(:), MAX( ZNI_CIBU(:)*XMNU0,XRTMIN(4) ) )
+ END WHERE
+!
+ PRIS1D(:) = PRIS1D(:) + MAX(ZRI_CIBU(:), 0.) !
+ PRSS1D(:) = PRSS1D(:) - MAX(ZRI_CIBU(:), 0.) !
+!
+ DEALLOCATE(ZVEC1_S)
+ DEALLOCATE(ZVEC1_S1)
+ DEALLOCATE(ZVEC1_S2)
+ DEALLOCATE(ZVEC1_S3)
+ DEALLOCATE(ZVEC1_S4)
+ DEALLOCATE(ZVEC1_S11)
+ DEALLOCATE(ZVEC1_S12)
+ DEALLOCATE(ZVEC1_S21)
+ DEALLOCATE(ZVEC1_S22)
+ DEALLOCATE(ZVEC1_S31)
+ DEALLOCATE(ZVEC1_S32)
+ DEALLOCATE(ZVEC1_S41)
+ DEALLOCATE(ZVEC1_S42)
+ DEALLOCATE(ZVEC2_S1)
+ DEALLOCATE(IVEC2_S1)
+ DEALLOCATE(ZVEC2_S2)
+ DEALLOCATE(IVEC2_S2)
+ DEALLOCATE(ZVEC1_G)
+ DEALLOCATE(ZVEC1_G1)
+ DEALLOCATE(ZVEC1_G2)
+ DEALLOCATE(ZVEC2_G)
+ DEALLOCATE(IVEC2_G)
+ DEALLOCATE(ZINTG_SNOW_1)
+ DEALLOCATE(ZINTG_SNOW_2)
+ DEALLOCATE(ZINTG_SNOW_3)
+ DEALLOCATE(ZINTG_SNOW_4)
+ DEALLOCATE(ZINTG_GRAUPEL_1)
+ DEALLOCATE(ZINTG_GRAUPEL_2)
+ DEALLOCATE(ZNI_CIBU)
+ DEALLOCATE(ZRI_CIBU)
+ !
+ ! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CIBU', &
+ Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'CIBU', &
+ Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CIBU', &
+ Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+END IF
+!
+!
+!* 1.4 Rain accretion onto the aggregates
+! ---------------------------------------
+!
+!
+ZZW1(:,2:3) = 0.0
+GACC(:) = (PRRT1D(:)>XRTMIN(3)) .AND. (PRST1D(:)>XRTMIN(5)) .AND. (PRRS1D(:)>XRTMIN(3)/PTSTEP) .AND. (PZT(:)<XTT)
+IGACC = COUNT( GACC(:) )
+!
+IF( IGACC>0 .AND. LRAIN) THEN
+ ! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'ACC', &
+ Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'ACC', &
+ Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'ACC', &
+ Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'ACC', &
+ Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'ACC', &
+ Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+!
+! 1.4.0 allocations
+!
+ ALLOCATE(ZVEC1(IGACC))
+ ALLOCATE(ZVEC2(IGACC))
+ ALLOCATE(ZVEC3(IGACC))
+ ALLOCATE(IVEC1(IGACC))
+ ALLOCATE(IVEC2(IGACC))
+!
+! 1.4.1 select the (PLBDAS,PLBDAR) couplet
+!
+ ZVEC1(:) = PACK( PLBDAS(:),MASK=GACC(:) )
+ ZVEC2(:) = PACK( PLBDAR(:),MASK=GACC(:) )
+!
+! 1.4.2 find the next lower indice for the PLBDAS and for the PLBDAR
+! in the geometrical set of (Lbda_s,Lbda_r) couplet use to
+! tabulate the RACCSS-kernel
+!
+ ZVEC1(1:IGACC) = MAX( 1.0001, MIN( REAL(NACCLBDAS)-0.0001, &
+ XACCINTP1S * LOG( ZVEC1(1:IGACC) ) + XACCINTP2S ) )
+ IVEC1(1:IGACC) = INT( ZVEC1(1:IGACC) )
+ ZVEC1(1:IGACC) = ZVEC1(1:IGACC) - REAL( IVEC1(1:IGACC) )
+!
+ ZVEC2(1:IGACC) = MAX( 1.0001, MIN( REAL(NACCLBDAR)-0.0001, &
+ XACCINTP1R * LOG( ZVEC2(1:IGACC) ) + XACCINTP2R ) )
+ IVEC2(1:IGACC) = INT( ZVEC2(1:IGACC) )
+ ZVEC2(1:IGACC) = ZVEC2(1:IGACC) - REAL( IVEC2(1:IGACC) )
+!
+! 1.4.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.4.4 raindrop accretion on the small sized aggregates
+!
+ WHERE ( GACC(:) )
+ ZZW1(:,2) = PCRT1D(:) * & !! coef of RRACCS
+ XFRACCSS*( PLBDAS(:)**XCXS )*( PRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBRACCS1/((PLBDAS(:)**2) ) + &
+ XLBRACCS2/( PLBDAS(:) * PLBDAR(:) ) + &
+ XLBRACCS3/( (PLBDAR(:)**2)) )/PLBDAR(:)**3
+ ZZW1(:,4) = MIN( PRRS1D(:),ZZW1(:,2)*ZZW(:) ) ! RRACCSS
+ PRRS1D(:) = PRRS1D(:) - ZZW1(:,4)
+ PRSS1D(:) = PRSS1D(:) + ZZW1(:,4)
+ PTHS1D(:) = PTHS1D(:) + ZZW1(:,4) * (PLSFACT(:) - PLVFACT(:)) ! f(L_f*(RRACCSS))
+!
+ PCRS1D(:) = MAX( PCRS1D(:)-ZZW1(:,4)*(PCRT1D(:)/PRRT1D(:)),0.0 ) ! Lambda_r**3
+ END WHERE
+!
+! 1.4.4b perform the bilinear interpolation of the normalized
+! RACCS-kernel
+!
+ DO JJ = 1,IGACC
+ ZVEC3(JJ) = ( XKER_RACCS(IVEC1(JJ)+1,IVEC2(JJ)+1) * ZVEC2(JJ) &
+ - XKER_RACCS(IVEC1(JJ)+1,IVEC2(JJ) ) * (ZVEC2(JJ) - 1.0) ) &
+ * ZVEC1(JJ) &
+ - ( XKER_RACCS(IVEC1(JJ) ,IVEC2(JJ)+1) * ZVEC2(JJ) &
+ - XKER_RACCS(IVEC1(JJ) ,IVEC2(JJ) ) * (ZVEC2(JJ) - 1.0) ) &
+ * (ZVEC1(JJ) - 1.0)
+ END DO
+ ZZW1(:,2) = ZZW1(:,2)*UNPACK( VECTOR=ZVEC3(:),MASK=GACC(:),FIELD=0.0 ) !! RRACCS
+!
+! 1.4.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.4.6 raindrop accretion-conversion of the large sized aggregates
+! into graupeln
+!
+ WHERE ( GACC(:) .AND. (PRSS1D(:)>XRTMIN(5)/PTSTEP) )
+ ZZW1(:,2) = MAX( MIN( PRRS1D(:),ZZW1(:,2)-ZZW1(:,4) ) , 0. ) ! RRACCSG
+ ZZW1(:,3) = MIN( PRSS1D(:),XFSACCRG*ZZW(:)* & ! RSACCRG
+ ( PLBDAS(:)**(XCXS-XBS) )*( PRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBSACCR1/((PLBDAR(:)**2) ) + &
+ XLBSACCR2/( PLBDAR(:) * PLBDAS(:) ) + &
+ XLBSACCR3/( (PLBDAS(:)**2)) ) )
+ PRRS1D(:) = PRRS1D(:) - ZZW1(:,2)
+ PRSS1D(:) = PRSS1D(:) - ZZW1(:,3)
+ PRGS1D(:) = PRGS1D(:) + ZZW1(:,2) + ZZW1(:,3)
+ PTHS1D(:) = PTHS1D(:) + ZZW1(:,2) * (PLSFACT(:) - PLVFACT(:)) ! f(L_f*(RRACCSG))
+!
+ PCRS1D(:) = MAX( PCRS1D(:)-ZZW1(:,2)*(PCRT1D(:)/PRRT1D(:)),0.0 ) ! Lambda_r**3
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ !
+ ! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'ACC', &
+ Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'ACC', &
+ Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'ACC', &
+ Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'ACC', &
+ Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'ACC', &
+ Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+END IF
+!
+!
+!* 1.5 Conversion-Melting of the aggregates
+! -----------------------------------------
+!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'CMEL', &
+ Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'CMEL', &
+ Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+end if
+!
+ZZW(:) = 0.0
+WHERE( (PRST1D(:)>XRTMIN(5)) .AND. (PRSS1D(:)>XRTMIN(5)/PTSTEP) .AND. (PZT(:)>XTT) )
+ ZZW(:) = PRVT1D(:) * PPRES(:) / ((XMV / XMD) + PRVT1D(:)) ! Vapor pressure
+ ZZW(:) = PKA(:) * (XTT - PZT(:)) + &
+ ( PDV(:) * (XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) &
+ * (XESTT-ZZW(:))/(XRV*PZT(:)) )
+!
+! compute RSMLT
+!
+ ZZW(:) = MIN( PRSS1D(:), XFSCVMG*MAX( 0.0,( -ZZW(:) * &
+ ( X0DEPS* PLBDAS(:)**XEX0DEPS + &
+ X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS ) - &
+ ( ZZW1(:,1)+ZZW1(:,4) ) * &
+ ( PRHODREF(:)*XCL*(XTT-PZT(:))) ) / &
+ ( PRHODREF(:)*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!!!
+!
+ PRSS1D(:) = PRSS1D(:) - ZZW(:)
+ PRGS1D(:) = PRGS1D(:) + ZZW(:)
+END WHERE
+!
+! Budget storage
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'CMEL', &
+ Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'CMEL', &
+ Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+end if
+
+END IF SNOW
+!
+!------------------------------------------------------------------------------
+!
+! #################
+! FAST RG PROCESSES
+! #################
+!
+!
+!* 2.1 Rain contact freezing
+! --------------------------
+!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'CFRZ', &
+ Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'CFRZ', &
+ Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CFRZ', &
+ Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'CFRZ', &
+ Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CFRZ', &
+ Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CFRZ', &
+ Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+end if
+
+ZZW1(:,3:4) = 0.0
+WHERE( (PRIT1D(:)>XRTMIN(4)) .AND. (PRRT1D(:)>XRTMIN(3)) .AND. (PRIS1D(:)>XRTMIN(4)/PTSTEP) .AND. (PRRS1D(:)>XRTMIN(3)/PTSTEP) )
+ ZZW1(:,3) = MIN( PRIS1D(:),XICFRR * PRIT1D(:) * PCRT1D(:) & ! RICFRRG
+ * PLBDAR(:)**XEXICFRR &
+ * PRHODREF(:)**(-XCEXVT-1.0) )
+!
+ ZZW1(:,4) = MIN( PRRS1D(:),XRCFRI * PCIT1D(:) * PCRT1D(:) & ! RRCFRIG
+ * PLBDAR(:)**XEXRCFRI &
+ * PRHODREF(:)**(-XCEXVT-2.0) )
+ PRIS1D(:) = PRIS1D(:) - ZZW1(:,3)
+ PRRS1D(:) = PRRS1D(:) - ZZW1(:,4)
+ PRGS1D(:) = PRGS1D(:) + ZZW1(:,3) + ZZW1(:,4)
+ PTHS1D(:) = PTHS1D(:) + ZZW1(:,4) * (PLSFACT(:) - PLVFACT(:)) ! f(L_f*RRCFRIG)
+!
+ PCIS1D(:) = MAX( PCIS1D(:)-ZZW1(:,3)*(PCIT1D(:)/PRIT1D(:)),0.0 ) ! CICFRRG
+ PCRS1D(:) = MAX( PCRS1D(:)-ZZW1(:,4)*(PCRT1D(:)/PRRT1D(:)),0.0 ) ! CRCFRIG
+END WHERE
+!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'CFRZ', &
+ Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'CFRZ', &
+ Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CFRZ', &
+ Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'CFRZ', &
+ Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CFRZ', &
+ Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CFRZ', &
+ Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+end if
+!
+!
+!* 2.2 Ice multiplication process following rain contact freezing
+! ---------------------------------------------------------------
+!
+GRDSF(:) = LRDSF .AND. (PRIT1D(:)>0.0) .AND. (PRRT1D(:)>0.0) .AND. &
+ (PRIS1D(:)>0.0) .AND. (PRRS1D(:)>0.0)
+IRDSF = COUNT( GRDSF(:) )
+!
+IF (IRDSF > 0) THEN
+!
+ ! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'RDSF', &
+ Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'RDSF', &
+ Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'RDSF', &
+ Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+!
+ ALLOCATE(ZVEC1_R(IRDSF))
+ ALLOCATE(ZVEC1_R1(IRDSF))
+ ALLOCATE(ZVEC2_R(IRDSF))
+ ALLOCATE(IVEC2_R(IRDSF))
+!
+!* 2.2.1 select the ZLBDAR
+!
+ ZVEC1_R(:) = PACK( PLBDAR(:),MASK=GRDSF(:) )
+!
+!* 2.2.2 find the next lower indice for the ZLBDAR in the
+! geometrical set of Lbda_r used to tabulate some moments of the
+! incomplete gamma function, for the lower boundary (0.1 mm)
+!
+ ZVEC2_R(1:IRDSF) = MAX( 1.00001, MIN( FLOAT(NGAMINC)-0.00001,XRDSFINTP_R &
+ * LOG( ZVEC1_R(1:IRDSF) ) + XRDSFINTP1_R ) )
+ IVEC2_R(1:IRDSF) = INT( ZVEC2_R(1:IRDSF) )
+ ZVEC2_R(1:IRDSF) = ZVEC2_R(1:IRDSF) - FLOAT( IVEC2_R(1:IRDSF) )
+!
+!* 2.2.3 perform the linear interpolation of the
+! normalized "2+XDR"-moment of the incomplete gamma function
+!
+ ZVEC1_R1(1:IRDSF) = XGAMINC_RDSF_R(IVEC2_R(1:IRDSF)+1) * ZVEC2_R(1:IRDSF) &
+ - XGAMINC_RDSF_R(IVEC2_R(1:IRDSF)) * (ZVEC2_R(1:IRDSF) - 1.0)
+!
+! From 0.1 mm to infinity we need
+ ZVEC1_R1(1:IRDSF) = XMOMGR_RDSF * (1.0 - ZVEC1_R1(1:IRDSF))
+!
+ ALLOCATE(ZINTG_RAIN(SIZE(PZT)))
+ ZINTG_RAIN(:) = UNPACK ( VECTOR=ZVEC1_R1(:),MASK=GRDSF,FIELD=0.0 )
+!
+!* 2.2.4 To compute final "RDSF" contributions
+!
+ ALLOCATE(ZNI_RDSF(SIZE(PZT)))
+ ZNI_RDSF(:) = (XFACTOR_RDSF_NI / (PRHODREF(:)**(XCEXVT-1.0))) * ( &
+ PCIT1D(:) * PCRT1D(:) * ZINTG_RAIN(:) * PLBDAR(:)**(-(XDR+6.0)) )
+!
+ PCIS1D(:) = PCIS1D(:) + ZNI_RDSF(:)
+!
+! The value of rg removed by RDSF is determined by the mean mass of pristine ice
+ ALLOCATE(ZRI_RDSF(SIZE(PZT)))
+ ZRI_RDSF(:) = MIN( PRGS1D(:), MAX( ZNI_RDSF(:)*XMNU0,XRTMIN(5) ) )
+!
+ PRIS1D(:) = PRIS1D(:) + ZRI_RDSF(:)
+ PRGS1D(:) = PRGS1D(:) - ZRI_RDSF(:)
+!
+ DEALLOCATE(ZINTG_RAIN)
+ DEALLOCATE(ZVEC1_R)
+ DEALLOCATE(ZVEC1_R1)
+ DEALLOCATE(ZVEC2_R)
+ DEALLOCATE(IVEC2_R)
+ DEALLOCATE(ZNI_RDSF)
+ DEALLOCATE(ZRI_RDSF)
+ !
+ ! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'RDSF', &
+ Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RG), 'RDSF', &
+ Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'RDSF', &
+ Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+ENDIF
+!
+!
+!* 2.3 Compute the Dry growth case
+! --------------------------------
+!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETG', &
+ Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETG', &
+ Unpack( prcs1d(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETG', &
+ Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETG', &
+ Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETG', &
+ Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETG', &
+ Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETG', &
+ Unpack( prhs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'WETG', &
+ Unpack( pccs1d(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'WETG', &
+ Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'WETG', &
+ Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+end if
+!
+ZZW1(:,:) = 0.0
+WHERE( ((PRCT1D(:)>XRTMIN(2)) .AND. (PRGT1D(:)>XRTMIN(6)) .AND. (PRCS1D(:)>XRTMIN(2)/PTSTEP)) .OR. &
+ ((PRIT1D(:)>XRTMIN(4)) .AND. (PRGT1D(:)>XRTMIN(6)) .AND. (PRIS1D(:)>XRTMIN(4)/PTSTEP)) )
+ ZZW(:) = PLBDAG(:)**(XCXG-XDG-2.0) * PRHODREF(:)**(-XCEXVT)
+ ZZW1(:,1) = MIN( PRCS1D(:),XFCDRYG * PRCT1D(:) * ZZW(:) ) ! RCDRYG
+ ZZW1(:,2) = MIN( PRIS1D(:),XFIDRYG * EXP( XCOLEXIG*(PZT(:)-XTT) ) &
+ * PRIT1D(:) * ZZW(:) ) ! RIDRYG
+END WHERE
+!
+!* 2.3.1 accretion of aggregates on the graupeln
+! ----------------------------------------------
+!
+GDRY(:) = (PRST1D(:)>XRTMIN(5)) .AND. (PRGT1D(:)>XRTMIN(6)) .AND. (PRSS1D(:)>XRTMIN(5)/PTSTEP)
+IGDRY = COUNT( GDRY(:) )
+!
+IF( IGDRY>0 ) THEN
+!
+!* 2.3.2 allocations
+!
+ ALLOCATE(ZVEC1(IGDRY))
+ ALLOCATE(ZVEC2(IGDRY))
+ ALLOCATE(ZVEC3(IGDRY))
+ ALLOCATE(IVEC1(IGDRY))
+ ALLOCATE(IVEC2(IGDRY))
+!
+!* 2.3.3 select the (PLBDAG,PLBDAS) couplet
+!
+ ZVEC1(:) = PACK( PLBDAG(:),MASK=GDRY(:) )
+ ZVEC2(:) = PACK( PLBDAS(:),MASK=GDRY(:) )
+!
+!* 2.3.4 find the next lower indice for the PLBDAG and for the PLBDAS
+! in the geometrical set of (Lbda_g,Lbda_s) couplet use to
+! tabulate the SDRYG-kernel
+!
+ ZVEC1(1:IGDRY) = MAX( 1.0001, MIN( REAL(NDRYLBDAG)-0.0001, &
+ XDRYINTP1G * LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) )
+ IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) )
+ ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - REAL( IVEC1(1:IGDRY) )
+!
+ ZVEC2(1:IGDRY) = MAX( 1.0001, MIN( REAL(NDRYLBDAS)-0.0001, &
+ XDRYINTP1S * LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2S ) )
+ IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
+ ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) )
+!
+!* 2.3.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( PRSS1D(:),XFSDRYG*ZZW(:) & ! RSDRYG
+ * EXP( XCOLEXSG*(PZT(:)-XTT) ) &
+ *( PLBDAS(:)**(XCXS-XBS) )*( PLBDAG(:)**XCXG ) &
+ *( PRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBSDRYG1/( PLBDAG(:)**2 ) + &
+ XLBSDRYG2/( PLBDAG(:) * PLBDAS(:) ) + &
+ XLBSDRYG3/( PLBDAS(:)**2) ) )
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+END IF
+!
+!* 2.3.6 accretion of raindrops on the graupeln
+! ---------------------------------------------
+!
+GDRY(:) = (PRRT1D(:)>XRTMIN(3)) .AND. (PRGT1D(:)>XRTMIN(6)) .AND. (PRRS1D(:)>XRTMIN(3))
+IGDRY = COUNT( GDRY(:) )
+!
+IF( IGDRY>0 ) THEN
+!
+!* 2.3.7 allocations
+!
+ ALLOCATE(ZVEC1(IGDRY))
+ ALLOCATE(ZVEC2(IGDRY))
+ ALLOCATE(ZVEC3(IGDRY))
+ ALLOCATE(IVEC1(IGDRY))
+ ALLOCATE(IVEC2(IGDRY))
+!
+!* 2.3.8 select the (PLBDAG,PLBDAR) couplet
+!
+ ZVEC1(:) = PACK( PLBDAG(:),MASK=GDRY(:) )
+ ZVEC2(:) = PACK( PLBDAR(:),MASK=GDRY(:) )
+!
+!* 2.3.9 find the next lower indice for the PLBDAG and for the PLBDAR
+! in the geometrical set of (Lbda_g,Lbda_r) couplet use to
+! tabulate the RDRYG-kernel
+!
+ ZVEC1(1:IGDRY) = MAX( 1.0001, MIN( REAL(NDRYLBDAG)-0.0001, &
+ XDRYINTP1G * LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) )
+ IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) )
+ ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - REAL( IVEC1(1:IGDRY) )
+!
+ ZVEC2(1:IGDRY) = MAX( 1.0001, MIN( REAL(NDRYLBDAR)-0.0001, &
+ XDRYINTP1R * LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2R ) )
+ IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
+ ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) )
+!
+!* 2.3.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( PRRS1D(:),XFRDRYG*ZZW(:) * PCRT1D(:) & ! RRDRYG
+ *( PLBDAR(:)**(-3) )*( PLBDAG(:)**XCXG ) &
+ *( PRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBRDRYG1/( PLBDAG(:)**2 ) + &
+ XLBRDRYG2/( PLBDAG(:) * PLBDAR(:) ) + &
+ XLBRDRYG3/( PLBDAR(:)**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.4 Compute the Wet growth case
+! --------------------------------
+!
+ZZW(:) = 0.0
+ZRWETG(:) = 0.0
+WHERE( PRGT1D(:)>XRTMIN(6) )
+ ZZW1(:,5) = MIN( PRIS1D(:), &
+ ZZW1(:,2) / (XCOLIG*EXP(XCOLEXIG*(PZT(:)-XTT)) ) ) ! RIWETG
+ ZZW1(:,6) = MIN( PRSS1D(:), &
+ ZZW1(:,3) / (XCOLSG*EXP(XCOLEXSG*(PZT(:)-XTT)) ) ) ! RSWETG
+!
+ ZZW(:) = PRVT1D(:)*PPRES(:)/((XMV/XMD)+PRVT1D(:)) ! Vapor pressure
+ ZZW(:) = PKA(:)*(XTT-PZT(:)) + &
+ ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) &
+ *(XESTT-ZZW(:))/(XRV*PZT(:)) )
+!
+! compute RWETG
+!
+ ZRWETG(:) = MAX( 0.0, &
+ ( ZZW(:) * ( X0DEPG* PLBDAG(:)**XEX0DEPG + &
+ X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG ) + &
+ ( ZZW1(:,5)+ZZW1(:,6) ) * &
+ ( PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PZT(:))) ) ) / &
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PZT(:))) ) )
+END WHERE
+!
+!
+!* 2.5 Select Wet or Dry case
+! ---------------------------
+!
+! Wet case and partial conversion to hail
+!
+ZZW(:) = 0.0
+NHAIL = 0.
+IF (LHAIL) NHAIL = 1.
+WHERE( PRGT1D(:)>XRTMIN(6) .AND. PZT(:)<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(:),PRRS1D(:)+ZZW1(:,1) ) )
+ ZZX(:) = ZZW1(:,7) / ZZW(:)
+ ZZW1(:,5) = ZZW1(:,5)*ZZX(:)
+ ZZW1(:,6) = ZZW1(:,6)*ZZX(:)
+ ZRWETG(:) = ZZW1(:,7) + ZZW1(:,5) + ZZW1(:,6)
+!
+ PRCS1D(:) = PRCS1D(:) - ZZW1(:,1)
+ PRIS1D(:) = PRIS1D(:) - ZZW1(:,5)
+ PRSS1D(:) = PRSS1D(:) - ZZW1(:,6)
+!
+! assume a linear percent of conversion of graupel into hail
+!
+ PRGS1D(:) = PRGS1D(:) + ZRWETG(:)
+ ZZW(:) = PRGS1D(:)*ZRDRYG(:)*NHAIL/(ZRWETG(:)+ZRDRYG(:))
+ PRGS1D(:) = PRGS1D(:) - ZZW(:)
+ PRHS1D(:) = PRHS1D(:) + ZZW(:)
+ PRRS1D(:) = MAX( 0.0,PRRS1D(:) - ZZW1(:,7) + ZZW1(:,1) )
+ PTHS1D(:) = PTHS1D(:) + ZZW1(:,7) * (PLSFACT(:) - PLVFACT(:))
+ ! f(L_f*(RCWETG+RRWETG))
+!
+ PCCS1D(:) = MAX( PCCS1D(:)-ZZW1(:,1)*(PCCT1D(:)/MAX(PRCT1D(:),XRTMIN(2))),0.0 )
+ PCIS1D(:) = MAX( PCIS1D(:)-ZZW1(:,5)*(PCIT1D(:)/MAX(PRIT1D(:),XRTMIN(4))),0.0 )
+ PCRS1D(:) = MAX( PCRS1D(:)-MAX( ZZW1(:,7)-ZZW1(:,1),0.0 ) &
+ *(PCRT1D(:)/MAX(PRRT1D(:),XRTMIN(3))),0.0 )
+END WHERE
+!
+! Budget storage
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETG', &
+ Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETG', &
+ Unpack( prcs1d(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETG', &
+ Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETG', &
+ Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETG', &
+ Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETG', &
+ Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETG', &
+ Unpack( prhs1d(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'WETG', &
+ Unpack( pccs1d(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'WETG', &
+ Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'WETG', &
+ Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+end if
+!
+! Dry case
+!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'DRYG', &
+ Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DRYG', &
+ Unpack( prcs1d(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'DRYG', &
+ Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'DRYG', &
+ Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'DRYG', &
+ Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'DRYG', &
+ Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DRYG', &
+ Unpack( pccs1d(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'DRYG', &
+ Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'DRYG', &
+ Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+end if
+!
+WHERE( PRGT1D(:)>XRTMIN(6) .AND. PZT(:)<XTT &
+ .AND. ZRDRYG(:)<ZRWETG(:) .AND. ZRDRYG(:)>0.0 ) ! case
+ PRCS1D(:) = PRCS1D(:) - ZZW1(:,1)
+ PRIS1D(:) = PRIS1D(:) - ZZW1(:,2)
+ PRSS1D(:) = PRSS1D(:) - ZZW1(:,3)
+ PRRS1D(:) = PRRS1D(:) - ZZW1(:,4)
+ PRGS1D(:) = PRGS1D(:) + ZRDRYG(:)
+ PTHS1D(:) = PTHS1D(:) + (ZZW1(:,1)+ZZW1(:,4)) * (PLSFACT(:) - PLVFACT(:)) !
+ ! f(L_f*(RCDRYG+RRDRYG))
+!
+ PCCS1D(:) = MAX( PCCS1D(:)-ZZW1(:,1)*(PCCT1D(:)/MAX(PRCT1D(:),XRTMIN(2))),0.0 )
+ PCIS1D(:) = MAX( PCIS1D(:)-ZZW1(:,2)*(PCIT1D(:)/MAX(PRIT1D(:),XRTMIN(4))),0.0 )
+ PCRS1D(:) = MAX( PCRS1D(:)-ZZW1(:,4)*(PCRT1D(:)/MAX(PRRT1D(:),XRTMIN(3))),0.0 )
+ ! Approximate rates
+END WHERE
+!
+! Budget storage
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'DRYG', &
+ Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DRYG', &
+ Unpack( prcs1d(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'DRYG', &
+ Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'DRYG', &
+ Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'DRYG', &
+ Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'DRYG', &
+ Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DRYG', &
+ Unpack( pccs1d(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'DRYG', &
+ Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'DRYG', &
+ Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+end if
+!
+!
+!* 2.6 Hallett-Mossop ice multiplication process due to graupel riming
+! --------------------------------------------------------------------
+!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HMG', &
+ Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'HMG', &
+ Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HMG', &
+ Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+end if
+
+!GDRY(:) = (PZT(:)<XHMTMAX) .AND. (PZT(:)>XHMTMIN) .AND. (ZRDRYG(:)<ZZW(:))&
+! .AND. (PRGT1D(:)>XRTMIN(6)) .AND. (PRCT1D(:)>XRTMIN(2))
+GDRY(:) = (PZT(:)<XHMTMAX) .AND. (PZT(:)>XHMTMIN) .AND. (ZRDRYG(:)<ZRWETG(:))&
+ .AND. (PRGT1D(:)>XRTMIN(6)) .AND. (PRCT1D(:)>XRTMIN(2))
+!
+IGDRY = COUNT( GDRY(:) )
+IF( IGDRY>0 ) THEN
+ ALLOCATE(ZVEC1(IGDRY))
+ ALLOCATE(ZVEC2(IGDRY))
+ ALLOCATE(IVEC2(IGDRY))
+!
+ ZVEC1(:) = PACK( PLBDAC(:),MASK=GDRY(:) )
+ ZVEC2(1:IGDRY) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, &
+ XHMLINTP1 * LOG( ZVEC1(1:IGDRY) ) + XHMLINTP2 ) )
+ IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
+ ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( 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)*(PCCT1D(:)/PRCT1D(:))*(1.0-ZZX(:))*XHM_FACTG* &
+ MAX( 0.0, MIN( (PZT(:)-XHMTMIN)/3.0,(XHMTMAX-PZT(:))/2.0 ) ) ! CCHMGI
+ PCIS1D(:) = PCIS1D(:) + ZZW1(:,5)
+!
+ ZZW1(:,6) = ZZW1(:,5) * XMNU0 ! RCHMGI
+ PRIS1D(:) = PRIS1D(:) + ZZW1(:,6)
+ PRGS1D(:) = PRGS1D(:) - 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_store_end( tbudgets(NBUDGET_RI), 'HMG', &
+ Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'HMG', &
+ Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HMG', &
+ Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+end if
+!
+!* 2.7 Melting of the graupeln
+! ----------------------------
+!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'GMLT', &
+ Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'GMLT', &
+ Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'GMLT', &
+ Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'GMLT', &
+ Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+end if
+
+ZZW(:) = 0.0
+WHERE( (PRGT1D(:)>XRTMIN(6)) .AND. (PRGS1D(:)>XRTMIN(6)/PTSTEP) .AND. (PZT(:)>XTT) )
+ ZZW(:) = PRVT1D(:)*PPRES(:)/((XMV/XMD)+PRVT1D(:)) ! Vapor pressure
+ ZZW(:) = PKA(:)*(XTT-PZT(:)) + &
+ ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) &
+ *(XESTT-ZZW(:))/(XRV*PZT(:)) )
+!
+! compute RGMLTR
+!
+ ZZW(:) = MIN( PRGS1D(:), MAX( 0.0,( -ZZW(:) * &
+ ( X0DEPG* PLBDAG(:)**XEX0DEPG + &
+ X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG ) - &
+ ( ZZW1(:,1)+ZZW1(:,4) ) * &
+ ( PRHODREF(:)*XCL*(XTT-PZT(:))) ) / &
+ ( PRHODREF(:)*XLMTT ) ) )
+ PRRS1D(:) = PRRS1D(:) + ZZW(:)
+ PRGS1D(:) = PRGS1D(:) - ZZW(:)
+ PTHS1D(:) = PTHS1D(:) - ZZW(:) * (PLSFACT(:) - PLVFACT(:)) ! f(L_f*(-RGMLTR))
+!
+! PCRS1D(:) = MAX( PCRS1D(:) + ZZW(:)*(XCCG*PLBDAG(:)**XCXG/PRGT1D(:)),0.0 )
+ PCRS1D(:) = PCRS1D(:) + 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_store_end( tbudgets(NBUDGET_TH), 'GMLT', &
+ Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'GMLT', &
+ Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'GMLT', &
+ Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'GMLT', &
+ Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+end if
+!
+!
+!------------------------------------------------------------------------------
+!
+! #################
+! FAST RH PROCESSES
+! #################
+!
+!
+HAIL: IF (LHAIL) THEN
+!
+GHAIL(:) = PRTH1D(:)>XRTMIN(7)
+IHAIL = COUNT(GHAIL(:))
+!
+IF( IHAIL>0 ) THEN
+!
+!* 3.1 Wet growth of hail
+! ----------------------------
+!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETH', &
+ Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETH', &
+ Unpack( prcs1d(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETH', &
+ Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETH', &
+ Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETH', &
+ Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETH', &
+ Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETH', &
+ Unpack( prhs1d(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'WETH', &
+ Unpack( pccs1d(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'WETH', &
+ Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'WETH', &
+ Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+ end if
+
+ ZZW1(:,:) = 0.0
+ WHERE( GHAIL(:) .AND. ( (PRCT1D(:)>XRTMIN(2) .AND. PRCS1D(:)>XRTMIN(2)/PTSTEP) .OR. &
+ (PRIT1D(:)>XRTMIN(4) .AND. PRIS1D(:)>XRTMIN(4)/PTSTEP) ) )
+ ZZW(:) = PLBDAH(:)**(XCXH-XDH-2.0) * PRHODREF(:)**(-XCEXVT)
+ ZZW1(:,1) = MIN( PRCS1D(:),XFWETH * PRCT1D(:) * ZZW(:) ) ! RCWETH
+ ZZW1(:,2) = MIN( PRIS1D(:),XFWETH * PRIT1D(:) * ZZW(:) ) ! RIWETH
+ END WHERE
+!
+!* 3.1.1 accretion of aggregates on the hailstones
+! ------------------------------------------------
+!
+ GWET(:) = GHAIL(:) .AND. (PRST1D(:)>XRTMIN(5) .AND. PRSS1D(:)>XRTMIN(5)/PTSTEP)
+ 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 (PLBDAH,PLBDAS) couplet
+!
+ ZVEC1(:) = PACK( PLBDAH(:),MASK=GWET(:) )
+ ZVEC2(:) = PACK( PLBDAS(:),MASK=GWET(:) )
+!
+!* 3.1.4 find the next lower indice for the PLBDAG and for the PLBDAS
+! in the geometrical set of (Lbda_h,Lbda_s) couplet use to
+! tabulate the SWETH-kernel
+!
+ ZVEC1(1:IGWET) = MAX( 1.0001, MIN( REAL(NWETLBDAH)-0.0001, &
+ XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
+ IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
+ ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) )
+!
+ ZVEC2(1:IGWET) = MAX( 1.0001, MIN( REAL(NWETLBDAS)-0.0001, &
+ XWETINTP1S * LOG( ZVEC2(1:IGWET) ) + XWETINTP2S ) )
+ IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
+ ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( 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( PRSS1D(:),XFSWETH*ZZW(:) & ! RSWETH
+ *( PLBDAS(:)**(XCXS-XBS) )*( PLBDAH(:)**XCXH ) &
+ *( PRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBSWETH1/( PLBDAH(:)**2 ) + &
+ XLBSWETH2/( PLBDAH(:) * PLBDAS(:) ) + &
+ XLBSWETH3/( PLBDAS(:)**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. (PRGT1D(:)>XRTMIN(6) .AND. PRGS1D(:)>XRTMIN(6)/PTSTEP)
+ 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 (PLBDAH,PLBDAG) couplet
+!
+ ZVEC1(:) = PACK( PLBDAH(:),MASK=GWET(:) )
+ ZVEC2(:) = PACK( PLBDAG(:),MASK=GWET(:) )
+!
+!* 3.1.9 find the next lower indice for the PLBDAH and for the PLBDAG
+! in the geometrical set of (Lbda_h,Lbda_g) couplet use to
+! tabulate the GWETH-kernel
+!
+ ZVEC1(1:IGWET) = MAX( 1.0001, MIN( REAL(NWETLBDAG)-0.0001, &
+ XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
+ IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
+ ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) )
+!
+ ZVEC2(1:IGWET) = MAX( 1.0001, MIN( REAL(NWETLBDAG)-0.0001, &
+ XWETINTP1G * LOG( ZVEC2(1:IGWET) ) + XWETINTP2G ) )
+ IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
+ ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( 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( PRGS1D(:),XFGWETH*ZZW(:) & ! RGWETH
+ *( PLBDAG(:)**(XCXG-XBG) )*( PLBDAH(:)**XCXH ) &
+ *( PRHODREF(:)**(-XCEXVT-1.) ) &
+ *( XLBGWETH1/( PLBDAH(:)**2 ) + &
+ XLBGWETH2/( PLBDAH(:) * PLBDAG(:) ) + &
+ XLBGWETH3/( PLBDAG(:)**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. PZT(:)<XTT )
+ ZZW(:) = PRVT1D(:) * PPRES(:) / ((XMV / XMD) + PRVT1D(:)) ! Vapor pressure
+ ZZW(:) = PKA(:) * (XTT - PZT(:)) + &
+ ( PDV(:) * (XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) &
+ * (XESTT-ZZW(:))/(XRV*PZT(:)) )
+!
+! compute RWETH
+!
+ ZZW(:) = MAX(0., ( ZZW(:) * ( X0DEPH* PLBDAH(:)**XEX0DEPH + &
+ X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH ) + &
+ ( ZZW1(:,2)+ZZW1(:,3)+ZZW1(:,5) ) * &
+ ( PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PZT(:))) ) ) / &
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PZT(:))) ) )
+!
+ ZZW1(:,6) = MAX( ZZW(:) - ZZW1(:,2) - ZZW1(:,3) - ZZW1(:,5),0.) ! RCWETH+RRWETH
+ END WHERE
+ !
+ WHERE ( GHAIL(:) .AND. PZT(:)<XTT .AND. ZZW1(:,6)/=0.)
+!
+! limitation of the available rainwater mixing ratio (RRWETH < RRS !)
+!
+ ZZW1(:,4) = MAX( 0.0,MIN( ZZW1(:,6),PRRS1D(:)+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
+!
+ PRCS1D(:) = PRCS1D(:) - ZZW1(:,1)
+ PRIS1D(:) = PRIS1D(:) - ZZW1(:,2)
+ PRSS1D(:) = PRSS1D(:) - ZZW1(:,3)
+ PRGS1D(:) = PRGS1D(:) - ZZW1(:,5)
+ PRHS1D(:) = PRHS1D(:) + ZZW(:)
+ PRRS1D(:) = MAX( 0.0,PRRS1D(:) - ZZW1(:,4) + ZZW1(:,1) )
+ PTHS1D(:) = PTHS1D(:) + ZZW1(:,4) * (PLSFACT(:) - PLVFACT(:))
+ ! f(L_f*(RCWETH+RRWETH))
+!
+ PCCS1D(:) = MAX( PCCS1D(:)-ZZW1(:,1)*(PCCT1D(:)/MAX(PRCT1D(:),XRTMIN(2))),0.0 )
+ PCIS1D(:) = MAX( PCIS1D(:)-ZZW1(:,2)*(PCIT1D(:)/MAX(PRIT1D(:),XRTMIN(4))),0.0 )
+ PCRS1D(:) = MAX( PCRS1D(:)-MAX( ZZW1(:,4)-ZZW1(:,1),0.0 ) &
+ *(PCRT1D(:)/MAX(PRRT1D(:),XRTMIN(3))),0.0 )
+ END WHERE
+!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETH', &
+ Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETH', &
+ Unpack( prcs1d(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETH', &
+ Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETH', &
+ Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETH', &
+ Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETH', &
+ Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETH', &
+ Unpack( prhs1d(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'WETH', &
+ Unpack( pccs1d(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'WETH', &
+ Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'WETH', &
+ Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+ end if
+END IF ! IHAIL>0
+!
+! Partial reconversion of hail to graupel when rc and rh are small
+!
+!
+!* 3.3 Conversion of the hailstones into graupel
+! -----------------------------------------------
+!
+IF ( IHAIL>0 ) THEN
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'COHG', &
+ Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'COHG', &
+ Unpack( prhs1d(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+!
+ ZTHRH = 0.01E-3
+ ZTHRC = 0.001E-3
+ ZZW(:) = 0.0
+!
+ WHERE( PRTH1D(:)<ZTHRH .AND. PRCT1D(:)<ZTHRC .AND. PZT(:)<XTT )
+ ZZW(:) = MIN( 1.0,MAX( 0.0,1.0-(PRCT1D(:)/ZTHRC) ) )
+!
+! assume a linear percent conversion rate of hail into graupel
+!
+ ZZW(:) = PRHS1D(:) * ZZW(:)
+ PRGS1D(:) = PRGS1D(:) + ZZW(:) ! partial conversion
+ PRHS1D(:) = PRHS1D(:) - ZZW(:) ! of hail into graupel
+ END WHERE
+!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'COHG', &
+ Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'COHG', &
+ Unpack( prhs1d(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+END IF
+!
+!
+!* 3.4 Melting of the hailstones
+!
+IF ( IHAIL>0 ) THEN
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HMLT', &
+ Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'HMLT', &
+ Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'HMLT', &
+ Unpack( prhs1d(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'HMLT', &
+ Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+!
+ ZZW(:) = 0.0
+ WHERE( GHAIL(:) .AND. (PRHS1D(:)>XRTMIN(7)/PTSTEP) .AND. (PRTH1D(:)>XRTMIN(7)) .AND. (PZT(:)>XTT) )
+ ZZW(:) = PRVT1D(:) * PPRES(:) / ((XMV / XMD) + PRVT1D(:)) ! Vapor pressure
+ ZZW(:) = PKA(:) * (XTT - PZT(:)) + &
+ ( PDV(:) * (XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) &
+ * (XESTT - ZZW(:)) / (XRV * PZT(:)) )
+!
+! compute RHMLTR
+!
+ ZZW(:) = MIN( PRHS1D(:), MAX( 0.0,( -ZZW(:) * &
+ ( X0DEPH* PLBDAH(:)**XEX0DEPH + &
+ X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH ) - &
+ ZZW1(:,6)*( PRHODREF(:)*XCL*(XTT-PZT(:))) ) / &
+ ( PRHODREF(:)*XLMTT ) ) )
+ PRRS1D(:) = PRRS1D(:) + ZZW(:)
+ PRHS1D(:) = PRHS1D(:) - ZZW(:)
+ PTHS1D(:) = PTHS1D(:) - ZZW(:) * (PLSFACT(:) - PLVFACT(:)) ! f(L_f*(-RHMLTR))
+!
+ PCRS1D(:) = MAX( PCRS1D(:) + ZZW(:)*(XCCH*PLBDAH(:)**XCXH/PRTH1D(:)),0.0 )
+ END WHERE
+!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HMLT', &
+ Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'HMLT', &
+ Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'HMLT', &
+ Unpack( prhs1d(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'HMLT', &
+ Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+END IF
+!
+END IF HAIL
+!
+!------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_MIXED_FAST_PROCESSES
diff --git a/src/ICCARE_BASE/modd_param_lima.f90 b/src/ICCARE_BASE/modd_param_lima.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8e9c1c428786ca9f4e39039b0e902709dde3b2f0
--- /dev/null
+++ b/src/ICCARE_BASE/modd_param_lima.f90
@@ -0,0 +1,224 @@
+!MNH_LIC Copyright 2013-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
+! ######################
+ MODULE 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
+!! C. Barthe 14/03/2022 add CIBU and RDSF
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODD_PARAMETERS, ONLY : JPLIMACCNMAX, JPLIMAIFNMAX
+!
+IMPLICIT NONE
+!
+LOGICAL, SAVE :: LLIMA_DIAG ! Compute diagnostics for concentration /m3
+!
+LOGICAL, SAVE :: LPTSPLIT ! activate time-splitting technique by S. Riette
+LOGICAL, SAVE :: LFEEDBACKT ! recompute tendencies if T changes sign
+INTEGER, SAVE :: NMAXITER ! maximum number of iterations
+REAL, SAVE :: XMRSTEP ! maximum change in mixing ratio allowed before recomputing tedencies
+REAL, SAVE :: XTSTEP_TS ! maximum time for the sub-time-step
+!
+!* 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
+LOGICAL, SAVE :: LCIBU ! TRUE to use collisional ice breakup
+LOGICAL, SAVE :: LRDSF ! TRUE to use rain drop shattering by freezing
+!
+! 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
+!
+! 1.6 Collisional Ice Break Up parameterization
+!
+REAL,SAVE :: XNDEBRIS_CIBU ! Number of ice crystal debris produced
+ ! by the break up of aggregate particles
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 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
+LOGICAL, SAVE :: LDEPOC ! Deposition of rc at 1st level above ground
+LOGICAL, SAVE :: LACTTKE ! TRUE to take into account TKE in W for activation
+LOGICAL, SAVE :: LADJ ! TRUE for adjustment procedure + Smax (false for diagnostic supersaturation)
+LOGICAL, SAVE :: LSPRO ! TRUE for prognostic supersaturation
+!
+! 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=10),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
+!
+! Cloud droplet deposition
+!
+REAL, SAVE :: XVDEPOC
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 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
+! Correction
+!REAL, SAVE :: XRHO00 = 1.292 !rho on the floor [Kg/m**3]
+REAL, SAVE :: XRHO00 = 1.2041 !rho at P=1013.25 and T=20°C
+!
+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
+!
+!
+! Sedimentation variables
+!
+INTEGER,DIMENSION(7),SAVE :: NSPLITSED
+REAL,DIMENSION(7),SAVE :: XLB
+REAL,DIMENSION(7),SAVE :: XLBEX
+REAL,DIMENSION(7),SAVE :: XD
+REAL,DIMENSION(7),SAVE :: XFSEDR
+REAL,DIMENSION(7),SAVE :: XFSEDC
+!
+END MODULE MODD_PARAM_LIMA
diff --git a/src/ICCARE_BASE/modd_param_lima_cold.f90 b/src/ICCARE_BASE/modd_param_lima_cold.f90
new file mode 100644
index 0000000000000000000000000000000000000000..9db92526b622f15f9722ca4d8eaff834f140e9cb
--- /dev/null
+++ b/src/ICCARE_BASE/modd_param_lima_cold.f90
@@ -0,0 +1,163 @@
+!MNH_LIC Copyright 2013-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###########################
+ MODULE 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
+!! C. Barthe 14/03/2022 add CIBU and RDSF
+!!
+!-------------------------------------------------------------------------------
+USE MODD_PARAMETERS, ONLY: JPSVNAMELGTMAX
+!
+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=JPSVNAMELGTMAX),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=JPSVNAMELGTMAX),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
+!
+!
+! Constants for ice-ice collision : CIBU
+!
+REAL, SAVE :: XDCSLIM_CIBU_MIN, & ! aggregates min diam. : 0.2 mm
+ XDCSLIM_CIBU_MAX, & ! aggregates max diam. : 1.0 mm
+ XDCGLIM_CIBU_MIN, & ! graupel min diam. : 2 mm
+ XGAMINC_BOUND_CIBU_SMIN, & ! Min val. of Lbda_s*dlim
+ XGAMINC_BOUND_CIBU_SMAX, & ! Max val. of Lbda_s*dlim
+ XGAMINC_BOUND_CIBU_GMIN, & ! Min val. of Lbda_g*dlim
+ XGAMINC_BOUND_CIBU_GMAX, & ! Max val. of Lbda_g*dlim
+ XCIBUINTP_S,XCIBUINTP1_S, & !
+ XCIBUINTP2_S, & !
+ XCIBUINTP_G,XCIBUINTP1_G, & !
+ XFACTOR_CIBU_NI,XFACTOR_CIBU_RI, & ! Factor for final CIBU Eq.
+ XMOMGG_CIBU_1,XMOMGG_CIBU_2, & ! Moment computation
+ XMOMGS_CIBU_1,XMOMGS_CIBU_2, &
+ XMOMGS_CIBU_3
+!
+REAL, DIMENSION(:,:), SAVE, ALLOCATABLE &
+ :: XGAMINC_CIBU_S, & ! Tab.incomplete Gamma function
+ XGAMINC_CIBU_G ! Tab.incomplete Gamma function
+!
+! Constants for raindrop shattering : RDSF
+!
+REAL, SAVE :: XDCRLIM_RDSF_MIN, & ! Raindrops min diam. : 0.2 mm
+ XGAMINC_BOUND_RDSF_RMIN, & ! Min val. of Lbda_r*dlim
+ XGAMINC_BOUND_RDSF_RMAX, & ! Max val. of Lbda_r*dlim
+ XRDSFINTP_R,XRDSFINTP1_R, & !
+ XFACTOR_RDSF_NI, & ! Factor for final RDSF Eq.
+ XMOMGR_RDSF
+!
+REAL, DIMENSION(:), SAVE, ALLOCATABLE &
+ :: XGAMINC_RDSF_R ! Tab.incomplete Gamma function
+!
+!-------------------------------------------------------------------------------
+!
+END MODULE MODD_PARAM_LIMA_COLD
diff --git a/src/ICCARE_BASE/modeln.f90 b/src/ICCARE_BASE/modeln.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a7a507828f15b68d1b26aed7ec2df69b86fc039a
--- /dev/null
+++ b/src/ICCARE_BASE/modeln.f90
@@ -0,0 +1,2323 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###################
+ MODULE MODI_MODEL_n
+! ###################
+!
+INTERFACE
+!
+ SUBROUTINE MODEL_n(KTCOUNT,OEXIT)
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! temporal loop index of model KMODEL
+LOGICAL, INTENT(INOUT):: OEXIT ! switch for the end of the temporal loop
+!
+END SUBROUTINE MODEL_n
+!
+END INTERFACE
+!
+END MODULE MODI_MODEL_n
+
+! ###################################
+ SUBROUTINE MODEL_n(KTCOUNT, OEXIT)
+! ###################################
+!
+!!**** *MODEL_n * -monitor of the model version _n
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to build up a typical model version
+! by sequentially calling the specialized routines.
+!
+!!** METHOD
+!! ------
+!! Some preliminary initializations are performed in the first section.
+!! Then, specialized routines are called to update the guess of the future
+!! instant XRxxS of the variable xx by adding the effects of all the
+!! different sources of evolution.
+!!
+!! (guess of xx at t+dt) * Rhod_ref * Jacobian
+!! XRxxS = -------------------------------------------
+!! 2 dt
+!!
+!! At this level, the informations are transferred with a USE association
+!! from the INIT step, where the modules have been previously filled. The
+!! transfer to the subroutines computing each source term is performed by
+!! argument in order to avoid repeated compilations of these subroutines.
+!! This monitor model_n, must therefore be duplicated for each model,
+!! model1 corresponds in this case to the outermost model, model2 is used
+!! for the first level of gridnesting,....
+!! The effect of all parameterizations is computed in PHYS_PARAM_n, which
+!! is itself a monitor. This is due to a possible large number of
+!! parameterizations, which can be activated and therefore, will require a
+!! very large list of arguments. To circumvent this problem, we transfer by
+!! a USE association, the necessary informations in this monitor, which will
+!! dispatch the pertinent information to every parametrization.
+!! Some elaborated diagnostics, LES tools, budget storages are also called
+!! at this level because they require informations about the fields at every
+!! timestep.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! Subroutine IO_File_open: to open a file
+!! Subroutine WRITE_DESFM: to write the descriptive part of a FMfile
+!! Subroutine WRITE_LFIFM: to write the binary part of a FMfile
+!! Subroutine SET_MASK : to compute all the masks selected for budget
+!! computations
+!! Subroutine BOUNDARIES : set the fields at the marginal points in every
+!! directions according the selected boundary conditions
+!! Subroutine INITIAL_GUESS: initializes the guess of the future instant
+!! Subroutine LES_FLX_SPECTRA: computes the resolved fluxes and the
+!! spectra of some quantities when running in LES mode.
+!! Subroutine ADVECTION: computes the advection terms.
+!! Subroutine DYN_SOURCES: computes the curvature, Coriolis, gravity terms.
+!! Subroutine NUM_DIFF: applies the fourth order numerical diffusion.
+!! Subroutine RELAXATION: performs the relaxation to Larger Scale fields
+!! in the upper levels and outermost vertical planes
+!! Subroutine PHYS_PARAM_n : computes the parameterized physical terms
+!! Subroutine RAD_BOUND: prepares the velocity normal components for the bc.
+!! Subroutine RESOLVED_CLOUD : computes the sources terms for water in any
+!! form
+!! Subroutine PRESSURE : computes the pressure gradient term and the
+!! absolute pressure
+!! Subroutine EXCHANGE : updates the halo of each subdomains
+!! Subroutine ENDSTEP : advances in time the fields.
+!! Subroutines UVW_LS_COUPLING and SCALAR_LS_COUPLING:
+!! compute the large scale fields, used to
+!! couple Model_n with outer informations.
+!! Subroutine ENDSTEP_BUDGET: writes the budget informations.
+!! Subroutine IO_File_close: closes a file
+!! Subroutine DATETIME_CORRECTDATE: transform the current time in GMT
+!! Subroutine FORCING : computes forcing terms
+!! Subroutine ADD3DFIELD_ll : add a field to 3D-list
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! MODD_DYN
+!! MODD_CONF
+!! MODD_NESTING
+!! MODD_BUDGET
+!! MODD_PARAMETERS
+!! MODD_CONF_n
+!! MODD_CURVCOR_n
+!! MODD_DYN_n
+!! MODD_DIM_n
+!! MODD_ADV_n
+!! MODD_FIELD_n
+!! MODD_LSFIELD_n
+!! MODD_GRID_n
+!! MODD_METRICS_n
+!! MODD_LBC_n
+!! MODD_PARAM_n
+!! MODD_REF_n
+!! MODD_LUNIT_n
+!! MODD_OUT_n
+!! MODD_TIME_n
+!! MODD_TURB_n
+!! MODD_CLOUDPAR_n
+!! MODD_TIME
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * LA *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/09/94
+!! Modification 20/10/94 (J.Stein) for the outputs and abs_layers routines
+!! Modification 10/11/94 (J.Stein) change ABS_LAYER_FIELDS call
+!! Modification 16/11/94 (J.Stein) add call to the renormalization
+!! Modification 17/11/94 (J.-P. Lafore and J.-P. Pinty) call NUM_DIFF
+!! Modification 08/12/94 (J.Stein) cleaning + remove (RENORM + ABS_LAYER..
+!! ..) + add RELAXATION + LS fiels in the arguments
+!! Modification 19/12/94 (J.Stein) switch for the num diff
+!! Modification 22/12/94 (J.Stein) update tdtcur + change dyn_source call
+!! Modification 05/01/95 (J.Stein) add the parameterization monitor
+!! Modification 09/01/95 (J.Stein) add the 1D switch
+!! Modification 10/01/95 (J.Stein) displace the TDTCUR computation
+!! Modification 03/01/95 (J.-P. Lafore) Absolute pressure diagnosis
+!! Modification Jan 19, 1995 (J. Cuxart) Shunt the DYN_SOURCES in 1D cases.
+!! Modification Jan 24, 1995 (J. Stein) Interchange Boundaries and
+!! Initial_guess to correct a bug in 2D configuration
+!! Modification Feb 02, 1995 (I.Mallet) update BOUNDARIES and RAD_BOUND
+!! calls
+!! Modification Mar 10, 1995 (I.Mallet) add call to SET_COUPLING
+!! March,21, 1995 (J. Stein) remove R from the historical var.
+!! March,26, 1995 (J. Stein) add the EPS variable
+!! April 18, 1995 (J. Cuxart) add the LES call
+!! Sept 20,1995 (Lafore) coupling for the dry mass Md
+!! Nov 2,1995 (Stein) displace the temporal counter increase
+!! Jan 2,1996 (Stein) rm the test on the temporal counter
+!! Modification Feb 5,1996 (J. Vila) implementation new advection
+!! schemes for scalars
+!! Modification Feb 20,1996 (J.Stein) doctor norm
+!! Dec95 - Jul96 (Georgelin, Pinty, Mari, Suhre) FORCING
+!! June 17,1996 (Vincent, Lafore, Jabouille)
+!! statistics of computing time
+!! Aug 8, 1996 (K. Suhre) add chemistry
+!! October 12, 1996 (J. Stein) save the PSRC value
+!! Sept 05,1996 (V.Masson) print of loop index for debugging
+!! purposes
+!! July 22,1996 (Lafore) improve write of computing time statistics
+!! July 29,1996 (Lafore) nesting introduction
+!! Aug. 1,1996 (Lafore) synchronization between models
+!! Sept. 4,1996 (Lafore) modification of call to routine SET_COUPLING
+!! now split in 2 routines
+!! (UVW_LS_COUPLING and SCALAR_LS_COUPLING)
+!! Sept 5,1996 (V.Masson) print of loop index for debugging
+!! purposes
+!! Sept 25,1996 (V.Masson) test for coupling performed here
+!! Oct. 29,1996 (Lafore) one-way nesting implementation
+!! Oct. 12,1996 (J. Stein) save the PSRC value
+!! Dec. 12,1996 (Lafore) change call to RAD_BOUND
+!! Dec. 21,1996 (Lafore) two-way nesting implementation
+!! Mar. 12,1997 (Lafore) introduction of "surfacic" LS fields
+!! Nov 18, 1996 (J.-P. Pinty) FORCING revisited (translation)
+!! Dec 04, 1996 (J.-P. Pinty) include mixed-phase clouds
+!! Dec 20, 1996 (J.-P. Pinty) update the budgets
+!! Dec 23, 1996 (J.-P. Pinty) add the diachronic file control
+!! Jan 11, 1997 (J.-P. Pinty) add the deep convection control
+!! Dec 20,1996 (V.Masson) call boundaries before the writing
+!! Fev 25, 1997 (P.Jabouille) modify the LES tools
+!! April 3,1997 (Lafore) merging of the nesting
+!! developments on MASTER3
+!! Jul. 8,1997 (Lafore) print control for nesting (NVERB>=7)
+!! Jul. 28,1997 (Masson) supress LSTEADY_DMASS
+!! Aug. 19,1997 (Lafore) full Clark's formulation introduction
+!! Sept 26,1997 (Lafore) LS source calculation at restart
+!! (temporarily test to have LS at instant t)
+!! Jan. 28,1998 (Bechtold) add SST forcing
+!! fev. 10,1998 (Lafore) RHODJ computation and storage for budget
+!! Jul. 10,1998 (Stein ) sequentiel loop for nesting
+!! Apr. 07,1999 (Stein ) cleaning of the nesting subroutines
+!! oct. 20,1998 (Jabouille) //
+!! oct. 20,2000 (J.-P. Pinty) add the C2R2 scheme
+!! fev. 01,2001 (D.Gazen) add module MODD_NSV for NSV variables
+!! mar, 4,2002 (V.Ducrocq) call to temporal series
+!! mar, 8, 2001 (V. Masson) advection of perturbation of theta in neutral cases.
+!! Nov, 6, 2002 (V. Masson) time counters for budgets & LES
+!! mars 20,2001 (Pinty) add ICE4 and C3R5 options
+!! jan. 2004 (Masson) surface externalization
+!! sept 2004 (M. Tomasini) Cloud mixing length modification
+!! june 2005 (P. Tulet) add aerosols / dusts
+!! Jul. 2005 (N. Asencio) two_way and phys_param calls:
+!! Add the surface parameters : precipitating
+!! hydrometeors, Short and Long Wave , MASKkids array
+!! Fev. 2006 (M. Leriche) add aqueous phase chemistry
+!! april 2006 (T.Maric) Add halo related to 4th order advection scheme
+!! May 2006 Remove KEPS
+!! Oct 2008 (C.Lac) FIT for variables advected with PPM
+!! July 2009 : Displacement of surface diagnostics call to be
+!! coherent with surface diagnostics obtained with DIAG
+!! 10/11/2009 (P. Aumond) Add mean moments
+!! Nov, 12, 2009 (C. Barthe) add cloud electrification and lightning flashes
+!! July 2010 (M. Leriche) add ice phase chemical species
+!! April 2011 (C.Lac) : Remove instant M
+!! April 2011 (C.Lac, V.Masson) : Time splitting for advection
+!! J.Escobar 21/03/2013: for HALOK comment all NHALO=1 test
+!! P. Tulet Nov 2014 accumulated moles of aqueous species that fall at the surface
+!! Dec 2014 (C.Lac) : For reproducibility START/RESTA
+!! J.Escobar 20/04/2015: missing UPDATE_HALO before UPDATE_HALO2
+!! July, 2015 (O.Nuissier/F.Duffourg) Add microphysics diagnostic for
+!! aircraft, ballon and profiler
+!! C.Lac 11/09/2015: correction of the budget due to FIT temporal scheme
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! Sep 2015 (S. Bielli) : Remove YDADFILE from argument call
+! of write_phys_param
+!! J.Escobar : 19/04/2016 : Pb IOZ/NETCDF , missing OPARALLELIO=.FALSE. for PGD files
+!! M.Mazoyer : 04/2016 DTHRAD used for radiative cooling when LACTIT
+!!! Modification 01/2016 (JP Pinty) Add LIMA
+!! 06/2016 (G.Delautier) phasage surfex 8
+!! M.Leriche : 03/2016 Move computation of accumulated chem. in rain to ch_monitor
+!! 09/2016 Add filter on negative values on AERDEP SV before relaxation
+!! 10/2016 (C.Lac) _ Correction on the flag for Strang splitting
+!! to insure reproducibility between START and RESTA
+!! _ Add OSPLIT_WENO
+!! _ Add droplet deposition
+!! 10/2016 (M.Mazoyer) New KHKO output fields
+!! P.Wautelet : 11/07/2016 : removed MNH_NCWRIT define
+!! 09/2017 Q.Rodier add LTEND_UV_FRC
+!! 10/2017 (C.Lac) Necessity to have chemistry processes as
+!! the las process modifying XRSVS
+!! 01/2018 (G.Delautier) SURFEX 8.1
+!! 03/2018 (P.Wautelet) replace ADD_FORECAST_TO_DATE by DATETIME_CORRECTDATE
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! 07/2017 (V. Vionnet) : Add blowing snow scheme
+!! S. Riette : 11/2016 Add ZPABST to keep pressure constant during timestep
+!! 01/2018 (C.Lac) Add VISCOSITY
+!! Philippe Wautelet: 21/01/2019: add LIO_ALLOW_NO_BACKUP and LIO_NO_WRITE to modd_io_ll
+! to allow to disable writes (for bench purposes)
+! P. Wautelet 07/02/2019: remove OPARALLELIO argument from open and close files subroutines
+! (nsubfiles_ioz is now determined in IO_File_add2list)
+!! 02/2019 C.Lac add rain fraction as an output field
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 28/03/2019: use MNHTIME for time measurement variables
+! P. Wautelet 28/03/2019: use TFILE instead of unit number for set_iluout_timing
+! P. Wautelet 19/04/2019: removed unused dummy arguments and variables
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! J. Escobar 09/07/2019: norme Doctor -> Rename Module Type variable TZ -> T
+! J. Escobar 09/07/2019: for bug in management of XLSZWSM variable, add/use specific 2D TLSFIELD2D_ll pointer
+! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! J. Escobar 27/09/2019: add missing report timing of RESOLVED_ELEC
+! P. Wautelet 02-03/2020: use the new data structures and subroutines for budgets
+! P. Wautelet 12/10/2020: Write_les_n: remove HLES_AVG dummy argument and group all 4 calls
+! F. Auguste 01/02/2021: add IBM
+! T. Nagel 01/02/2021: add turbulence recycling
+! P. Wautelet 19/02/2021: add NEGA2 term for SV budgets
+! J.L. Redelsperger 03/2021: add Call NHOA_COUPLN (coupling O & A LES version)
+! C. Barthe 07/04/2022: deallocation of ZSEA
+!!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_2D_FRC
+USE MODD_ADV_n
+USE MODD_AIRCRAFT_BALLOON
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+USE MODD_BAKOUT
+USE MODD_BIKHARDT_n
+USE MODD_BLANK_n
+USE MODD_BLOWSNOW
+USE MODD_BLOWSNOW_n
+use modd_budget, only: cbutype, lbu_ru, lbu_rv, lbu_rw, lbudget_u, lbudget_v, lbudget_w, lbudget_sv, lbu_enable, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_SV1, nbumod, nbutime, &
+ tbudgets, tburhodj, &
+ xtime_bu, xtime_bu_process
+USE MODD_CH_AERO_n, ONLY: XSOLORG, XMI
+USE MODD_CH_MNHC_n, ONLY: LUSECHEM,LCH_CONV_LINOX,LUSECHAQ,LUSECHIC, &
+ LCH_INIT_FIELD
+USE MODD_CLOUD_MF_n
+USE MODD_CLOUDPAR_n
+USE MODD_CONF
+USE MODD_CONF_n
+USE MODD_CURVCOR_n
+USE MODD_DEEP_CONVECTION_n
+USE MODD_DIM_n
+USE MODD_DRAG_n
+USE MODD_DUST, ONLY: LDUST
+USE MODD_DYN
+USE MODD_DYN_n
+USE MODD_DYNZD
+USE MODD_DYNZD_n
+USE MODD_ELEC_DESCR
+USE MODD_EOL_MAIN
+USE MODD_FIELD_n
+USE MODD_FRC
+USE MODD_FRC_n
+USE MODD_GET_n
+USE MODD_GRID, ONLY: XLONORI,XLATORI
+USE MODD_GRID_n
+USE MODD_IBM_PARAM_n, ONLY: CIBM_ADV, LIBM, LIBM_TROUBLE, XIBM_LS
+USE MODD_ICE_C1R3_DESCR, ONLY: XRTMIN_C1R3=>XRTMIN
+USE MODD_IO, ONLY: LIO_NO_WRITE, TFILEDATA, TFILE_SURFEX, TFILE_DUMMY
+USE MODD_LBC_n
+USE MODD_LES
+USE MODD_LES_BUDGET
+USE MODD_LIMA_PRECIP_SCAVENGING_n
+USE MODD_LSFIELD_n
+USE MODD_LUNIT, ONLY: TOUTDATAFILE
+USE MODD_LUNIT_n, ONLY: TDIAFILE,TINIFILE,TINIFILEPGD,TLUOUT
+USE MODD_MEAN_FIELD
+USE MODD_MEAN_FIELD_n
+USE MODD_METRICS_n
+USE MODD_MNH_SURFEX_n
+USE MODD_NESTING
+USE MODD_NSV
+USE MODD_NUDGING_n
+USE MODD_OUT_n
+USE MODD_PARAM_C1R3, ONLY: NSEDI => LSEDI, NHHONI => LHHONI
+USE MODD_PARAM_C2R2, ONLY: NSEDC => LSEDC, NRAIN => LRAIN, NACTIT => LACTIT,LACTTKE,LDEPOC
+USE MODD_PARAMETERS
+USE MODD_PARAM_ICE, ONLY: LWARM,LSEDIC,LCONVHG,LDEPOSC
+USE MODD_PARAM_LIMA, ONLY: MSEDC => LSEDC, MWARM => LWARM, MRAIN => LRAIN, &
+ MACTIT => LACTIT, LSCAV, LCOLD, &
+ MSEDI => LSEDI, MHHONI => LHHONI, LHAIL, &
+ XRTMIN_LIMA=>XRTMIN, MACTTKE=>LACTTKE
+USE MODD_PARAM_MFSHALL_n
+USE MODD_PARAM_n
+USE MODD_PAST_FIELD_n
+USE MODD_PRECIP_n
+use modd_precision, only: MNHTIME
+USE MODD_PROFILER_n
+USE MODD_RADIATIONS_n, ONLY: XTSRAD,XSCAFLASWD,XDIRFLASWD,XDIRSRFSWD, XAER, XDTHRAD
+USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
+USE MODD_RECYCL_PARAM_n, ONLY: LRECYCL
+USE MODD_REF, ONLY: LCOUPLES
+USE MODD_REF_n
+USE MODD_SALT, ONLY: LSALT
+USE MODD_SERIES, ONLY: LSERIES
+USE MODD_SERIES_n, ONLY: NFREQSERIES
+USE MODD_STATION_n
+USE MODD_SUB_MODEL_n
+USE MODD_TIME
+USE MODD_TIME_n
+USE MODD_TIMEZ
+USE MODD_TURB_CLOUD, ONLY: NMODEL_CLOUD,CTURBLEN_CLOUD,XCEI
+USE MODD_TURB_n
+USE MODD_VISCOSITY
+!
+use mode_budget, only: Budget_store_init, Budget_store_end
+USE MODE_DATETIME
+USE MODE_ELEC_ll
+USE MODE_GRIDCART
+USE MODE_GRIDPROJ
+USE MODE_IO_FIELD_WRITE, only: IO_Field_user_write, IO_Fieldlist_write, IO_Header_write
+USE MODE_IO_FILE, only: IO_File_close, IO_File_open
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
+USE MODE_ll
+#ifdef MNH_IOLFI
+use mode_menu_diachro, only: MENU_DIACHRO
+#endif
+USE MODE_MNH_TIMING
+USE MODE_MODELN_HANDLER
+USE MODE_MPPDB
+USE MODE_MSG
+USE MODE_ONE_WAY_n
+use mode_write_les_n, only: Write_les_n
+use mode_write_lfifmn_fordiachro_n, only: WRITE_LFIFMN_FORDIACHRO_n
+USE MODE_WRITE_PROFILER_n, ONLY: WRITE_PROFILER_n
+!
+USE MODI_ADDFLUCTUATIONS
+USE MODI_ADVECTION_METSV
+USE MODI_ADVECTION_UVW
+USE MODI_ADVECTION_UVW_CEN
+USE MODI_ADV_FORCING_n
+USE MODI_AER_MONITOR_n
+USE MODI_AIRCRAFT_BALLOON
+USE MODI_BLOWSNOW
+USE MODI_BOUNDARIES
+USE MODI_BUDGET_FLAGS
+USE MODI_CART_COMPRESS
+USE MODI_CH_MONITOR_n
+USE MODI_DIAG_SURF_ATM_N
+USE MODI_DYN_SOURCES
+USE MODI_END_DIAG_IN_RUN
+USE MODI_ENDSTEP
+USE MODI_ENDSTEP_BUDGET
+USE MODI_EXCHANGE
+USE MODI_FORCING
+USE MODI_FORC_SQUALL_LINE
+USE MODI_FORC_WIND
+USE MODI_GET_HALO
+USE MODI_GRAVITY_IMPL
+USE MODI_IBM_INIT
+USE MODI_IBM_FORCING
+USE MODI_IBM_FORCING_TR
+USE MODI_IBM_FORCING_ADV
+USE MODI_INI_DIAG_IN_RUN
+USE MODI_INI_LG
+USE MODI_INI_MEAN_FIELD
+USE MODI_INITIAL_GUESS
+USE MODI_LES_INI_TIMESTEP_n
+USE MODI_LES_N
+USE MODI_LIMA_PRECIP_SCAVENGING
+USE MODI_LS_COUPLING
+USE MODI_MASK_COMPRESS
+USE MODI_MEAN_FIELD
+USE MODI_MNHGET_SURF_PARAM_n
+USE MODI_MNHWRITE_ZS_DUMMY_n
+USE MODI_NUDGING
+USE MODI_NUM_DIFF
+USE MODI_PHYS_PARAM_n
+USE MODI_PRESSUREZ
+USE MODI_PROFILER_n
+USE MODI_RAD_BOUND
+USE MODI_RECYCLING
+USE MODI_RELAX2FW_ION
+USE MODI_RELAXATION
+USE MODI_REL_FORCING_n
+USE MODI_RESOLVED_CLOUD
+USE MODI_RESOLVED_ELEC_n
+USE MODI_SERIES_N
+USE MODI_SETLB_LG
+USE MODI_SET_MASK
+USE MODI_SHUMAN
+USE MODI_SPAWN_LS_n
+USE MODI_STATION_n
+USE MODI_TURB_CLOUD_INDEX
+USE MODI_TWO_WAY
+USE MODI_UPDATE_NSV
+USE MODI_VISCOSITY
+USE MODI_WRITE_AIRCRAFT_BALLOON
+USE MODI_WRITE_DESFM_n
+USE MODI_WRITE_DIAG_SURF_ATM_N
+USE MODI_WRITE_LFIFM_n
+USE MODI_WRITE_SERIES_n
+USE MODI_WRITE_STATION_n
+USE MODI_WRITE_SURF_ATM_N
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+!
+!
+INTEGER, INTENT(IN) :: KTCOUNT
+LOGICAL, INTENT(INOUT):: OEXIT
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: ILUOUT ! Logical unit number for the output listing
+INTEGER :: IIU,IJU,IKU ! array size in first, second and third dimensions
+INTEGER :: IIB,IIE,IJB,IJE ! index values for the physical subdomain
+INTEGER :: JSV,JRR ! Loop index for scalar and moist variables
+INTEGER :: INBVAR ! number of HALO2_lls to allocate
+INTEGER :: IINFO_ll ! return code of parallel routine
+INTEGER :: IVERB ! LFI verbosity level
+LOGICAL :: GSTEADY_DMASS ! conditional call to mass computation
+!
+ ! for computing time analysis
+REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME, ZTIME1, ZTIME2, ZEND, ZTOT, ZALL, ZTOT_PT
+REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME_STEP,ZTIME_STEP_PTS
+CHARACTER :: YMI
+INTEGER :: IPOINTS
+CHARACTER(len=16) :: YTCOUNT,YPOINTS
+!
+INTEGER :: ISYNCHRO ! model synchronic index relative to its father
+ ! = 1 for the first time step in phase with DAD
+ ! = 0 for the last time step (out of phase)
+INTEGER :: IMI ! Current model index
+REAL, DIMENSION(:,:),ALLOCATABLE :: ZSEA
+REAL, DIMENSION(:,:),ALLOCATABLE :: ZTOWN
+! Dummy pointers needed to correct an ifort Bug
+REAL, DIMENSION(:), POINTER :: DPTR_XZHAT
+REAL, DIMENSION(:), POINTER :: DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4
+REAL, DIMENSION(:), POINTER :: DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4
+REAL, DIMENSION(:), POINTER :: DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4
+REAL, DIMENSION(:), POINTER :: DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4
+CHARACTER(LEN=4), DIMENSION(:), POINTER :: DPTR_CLBCX,DPTR_CLBCY
+INTEGER, DIMENSION(:,:,:), POINTER :: DPTR_NKLIN_LBXU,DPTR_NKLIN_LBYU,DPTR_NKLIN_LBXV,DPTR_NKLIN_LBYV
+INTEGER, DIMENSION(:,:,:), POINTER :: DPTR_NKLIN_LBXW,DPTR_NKLIN_LBYW,DPTR_NKLIN_LBXM,DPTR_NKLIN_LBYM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXU,DPTR_XCOEFLIN_LBYU
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXV,DPTR_XCOEFLIN_LBYV
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXW,DPTR_XCOEFLIN_LBYW
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXM,DPTR_XCOEFLIN_LBYM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXUM,DPTR_XLBYUM,DPTR_XLBXVM,DPTR_XLBYVM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXWM,DPTR_XLBYWM,DPTR_XLBXTHM,DPTR_XLBYTHM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXTKEM,DPTR_XLBYTKEM
+REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXSVM,DPTR_XLBYSVM
+REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXRM,DPTR_XLBYRM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XZZ
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSTHM,DPTR_XLSRVM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS,DPTR_XLSTHS,DPTR_XLSRVS
+REAL, DIMENSION(:,:), POINTER :: DPTR_XLSZWSM,DPTR_XLSZWSS
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXUS,DPTR_XLBYUS,DPTR_XLBXVS,DPTR_XLBYVS
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXWS,DPTR_XLBYWS,DPTR_XLBXTHS,DPTR_XLBYTHS
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXTKES,DPTR_XLBYTKES
+REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXRS,DPTR_XLBYRS,DPTR_XLBXSVS,DPTR_XLBYSVS
+!
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XRHODJ,DPTR_XUM,DPTR_XVM,DPTR_XWM,DPTR_XTHM
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XTKEM,DPTR_XRUS,DPTR_XRVS,DPTR_XRWS,DPTR_XRTHS
+REAL, DIMENSION(:,:,:), POINTER :: DPTR_XRTKES,DPTR_XDIRFLASWD,DPTR_XSCAFLASWD,DPTR_XDIRSRFSWD
+REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XRM,DPTR_XSVM,DPTR_XRRS,DPTR_XRSVS
+REAL, DIMENSION(:,:), POINTER :: DPTR_XINPRC,DPTR_XINPRR,DPTR_XINPRS,DPTR_XINPRG
+REAL, DIMENSION(:,:), POINTER :: DPTR_XINPRH,DPTR_XPRCONV,DPTR_XPRSCONV
+LOGICAL, DIMENSION(:,:),POINTER :: DPTR_GMASKkids
+!
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDC
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDR
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDS
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDG
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDH
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZINPRC3D
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZINPRS3D
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZINPRG3D
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZINPRH3D
+!
+LOGICAL :: KWARM
+LOGICAL :: KRAIN
+LOGICAL :: KSEDC
+LOGICAL :: KACTIT
+LOGICAL :: KSEDI
+LOGICAL :: KHHONI
+!
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZRUS,ZRVS,ZRWS
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZPABST !To give pressure at t
+ ! (and not t+1) to resolved_cloud
+REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZJ
+!
+TYPE(LIST_ll), POINTER :: TZFIELDC_ll ! list of fields to exchange
+TYPE(HALO2LIST_ll), POINTER :: TZHALO2C_ll ! list of fields to exchange
+LOGICAL :: GCLD ! conditionnal call for dust wet deposition
+LOGICAL :: GCLOUD_ONLY ! conditionnal radiation computations for
+ ! the only cloudy columns
+REAL, DIMENSION(SIZE(XRSVS,1), SIZE(XRSVS,2), SIZE(XRSVS,3), NSV_AER) :: ZWETDEPAER
+
+
+!
+TYPE(TFILEDATA),POINTER :: TZBAKFILE, TZOUTFILE
+! TYPE(TFILEDATA),SAVE :: TZDIACFILE
+!-------------------------------------------------------------------------------
+!
+TZBAKFILE=> NULL()
+TZOUTFILE=> NULL()
+!
+!* 0. MICROPHYSICAL SCHEME
+! -------------------
+SELECT CASE(CCLOUD)
+CASE('C2R2','KHKO','C3R5')
+ KWARM = .TRUE.
+ KRAIN = NRAIN
+ KSEDC = NSEDC
+ KACTIT = NACTIT
+!
+ KSEDI = NSEDI
+ KHHONI = NHHONI
+CASE('LIMA')
+ KWARM = MWARM
+ KRAIN = MRAIN
+ KSEDC = MSEDC
+ KACTIT = MACTIT
+!
+ KSEDI = MSEDI
+ KHHONI = MHHONI
+CASE('ICE3','ICE4') !default values
+ KWARM = LWARM
+ KRAIN = .TRUE.
+ KSEDC = .TRUE.
+ KACTIT = .FALSE.
+!
+ KSEDI = .TRUE.
+ KHHONI = .FALSE.
+END SELECT
+!
+!
+!* 1 PRELIMINARY
+! ------------
+IMI = GET_CURRENT_MODEL_INDEX()
+!
+!* 1.0 update NSV_* variables for current model
+! ----------------------------------------
+!
+CALL UPDATE_NSV(IMI)
+!
+!* 1.1 RECOVER THE LOGICAL UNIT NUMBER FOR THE OUTPUT PRINTS
+!
+ILUOUT = TLUOUT%NLU
+!
+!* 1.2 SET ARRAY SIZE
+!
+CALL GET_DIM_EXT_ll('B',IIU,IJU)
+IKU=NKMAX+2*JPVEXT
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+!
+IF (IMI==1) THEN
+ GSTEADY_DMASS=LSTEADYLS
+ELSE
+ GSTEADY_DMASS=.FALSE.
+END IF
+!
+!* 1.3 OPEN THE DIACHRONIC FILE
+!
+IF (KTCOUNT == 1) THEN
+!
+ NULLIFY(TFIELDS_ll,TLSFIELD_ll,TFIELDT_ll)
+ NULLIFY(TLSFIELD2D_ll)
+ NULLIFY(THALO2T_ll)
+ NULLIFY(TLSHALO2_ll)
+ NULLIFY(TFIELDSC_ll)
+!
+ ALLOCATE(XWT_ACT_NUC(SIZE(XWT,1),SIZE(XWT,2),SIZE(XWT,3)))
+ ALLOCATE(GMASKkids(SIZE(XWT,1),SIZE(XWT,2)))
+!
+ IF ( .NOT. LIO_NO_WRITE ) THEN
+ CALL IO_File_open(TDIAFILE)
+!
+ CALL IO_Header_write(TDIAFILE)
+ CALL WRITE_DESFM_n(IMI,TDIAFILE)
+ CALL WRITE_LFIFMN_FORDIACHRO_n(TDIAFILE)
+ END IF
+!
+!* 1.4 Initialization of the list of fields for the halo updates
+!
+! a) Sources terms
+!
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRUS, 'MODEL_n::XRUS' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRVS, 'MODEL_n::XRVS' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRWS, 'MODEL_n::XRWS' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRTHS, 'MODEL_n::XRTHS' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRUS_PRES, 'MODEL_n::XRUS_PRES' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRVS_PRES, 'MODEL_n::XRVS_PRES' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRWS_PRES, 'MODEL_n::XRWS_PRES' )
+ CALL ADD3DFIELD_ll( TFIELDS_ll, XRTHS_CLD, 'MODEL_n::XRTHS_CLD' )
+ IF (SIZE(XRTKES,1) /= 0) CALL ADD3DFIELD_ll( TFIELDS_ll, XRTKES, 'MODEL_n::XRTKES' )
+ CALL ADD4DFIELD_ll( TFIELDS_ll, XRRS (:,:,:,1:NRR), 'MODEL_n::XRRS' )
+ CALL ADD4DFIELD_ll( TFIELDS_ll, XRRS_CLD (:,:,:,1:NRR), 'MODEL_n::XRRS_CLD' )
+ CALL ADD4DFIELD_ll( TFIELDS_ll, XRSVS (:,:,:,1:NSV), 'MODEL_n::XRSVS')
+ CALL ADD4DFIELD_ll( TFIELDS_ll, XRSVS_CLD(:,:,:,1:NSV), 'MODEL_n::XRSVS_CLD')
+ IF (SIZE(XSRCT,1) /= 0) CALL ADD3DFIELD_ll( TFIELDS_ll, XSRCT, 'MODEL_n::XSRCT' )
+ !
+ IF ((LNUMDIFU .OR. LNUMDIFTH .OR. LNUMDIFSV) ) THEN
+ !
+ ! b) LS fields
+ !
+ CALL ADD3DFIELD_ll( TLSFIELD_ll, XLSUM, 'MODEL_n::XLSUM' )
+ CALL ADD3DFIELD_ll( TLSFIELD_ll, XLSVM, 'MODEL_n::XLSVM' )
+ CALL ADD3DFIELD_ll( TLSFIELD_ll, XLSWM, 'MODEL_n::XLSWM' )
+ CALL ADD3DFIELD_ll( TLSFIELD_ll, XLSTHM, 'MODEL_n::XLSTHM' )
+ CALL ADD2DFIELD_ll( TLSFIELD2D_ll, XLSZWSM, 'MODEL_n::XLSZWSM' )
+ IF (NRR >= 1) THEN
+ CALL ADD3DFIELD_ll( TLSFIELD_ll, XLSRVM, 'MODEL_n::XLSRVM' )
+ ENDIF
+ !
+ ! c) Fields at t
+ !
+ CALL ADD3DFIELD_ll( TFIELDT_ll, XUT, 'MODEL_n::XUT' )
+ CALL ADD3DFIELD_ll( TFIELDT_ll, XVT, 'MODEL_n::XVT' )
+ CALL ADD3DFIELD_ll( TFIELDT_ll, XWT, 'MODEL_n::XWT' )
+ CALL ADD3DFIELD_ll( TFIELDT_ll, XTHT, 'MODEL_n::XTHT' )
+ IF (SIZE(XRTKES,1) /= 0) CALL ADD3DFIELD_ll( TFIELDT_ll, XTKET, 'MODEL_n::XTKET' )
+ CALL ADD4DFIELD_ll(TFIELDT_ll, XRT (:,:,:,1:NRR), 'MODEL_n::XSV' )
+ CALL ADD4DFIELD_ll(TFIELDT_ll, XSVT(:,:,:,1:NSV), 'MODEL_n::XSVT' )
+ !
+ !* 1.5 Initialize the list of fields for the halo updates (2nd layer)
+ !
+ INBVAR = 4+NRR+NSV
+ IF (SIZE(XRTKES,1) /= 0) INBVAR=INBVAR+1
+ CALL INIT_HALO2_ll(THALO2T_ll,INBVAR,IIU,IJU,IKU)
+ CALL INIT_HALO2_ll(TLSHALO2_ll,4+MIN(1,NRR),IIU,IJU,IKU)
+ !
+ !* 1.6 Initialise the 2nd layer of the halo of the LS fields
+ !
+ IF ( LSTEADYLS ) THEN
+ CALL UPDATE_HALO_ll(TLSFIELD_ll, IINFO_ll)
+ CALL UPDATE_HALO_ll(TLSFIELD2D_ll,IINFO_ll)
+ CALL UPDATE_HALO2_ll(TLSFIELD_ll, TLSHALO2_ll, IINFO_ll)
+ END IF
+ END IF
+ !
+!
+ !
+ XT_START = 0.0_MNHTIME
+ !
+ XT_STORE = 0.0_MNHTIME
+ XT_BOUND = 0.0_MNHTIME
+ XT_GUESS = 0.0_MNHTIME
+ XT_FORCING = 0.0_MNHTIME
+ XT_NUDGING = 0.0_MNHTIME
+ XT_ADV = 0.0_MNHTIME
+ XT_ADVUVW = 0.0_MNHTIME
+ XT_GRAV = 0.0_MNHTIME
+ XT_SOURCES = 0.0_MNHTIME
+ !
+ XT_DIFF = 0.0_MNHTIME
+ XT_RELAX = 0.0_MNHTIME
+ XT_PARAM = 0.0_MNHTIME
+ XT_SPECTRA = 0.0_MNHTIME
+ XT_HALO = 0.0_MNHTIME
+ XT_VISC = 0.0_MNHTIME
+ XT_RAD_BOUND = 0.0_MNHTIME
+ XT_PRESS = 0.0_MNHTIME
+ !
+ XT_CLOUD = 0.0_MNHTIME
+ XT_STEP_SWA = 0.0_MNHTIME
+ XT_STEP_MISC = 0.0_MNHTIME
+ XT_COUPL = 0.0_MNHTIME
+ XT_1WAY = 0.0_MNHTIME
+ XT_STEP_BUD = 0.0_MNHTIME
+ !
+ XT_RAD = 0.0_MNHTIME
+ XT_DCONV = 0.0_MNHTIME
+ XT_GROUND = 0.0_MNHTIME
+ XT_TURB = 0.0_MNHTIME
+ XT_MAFL = 0.0_MNHTIME
+ XT_DRAG = 0.0_MNHTIME
+ XT_EOL = 0.0_MNHTIME
+ XT_TRACER = 0.0_MNHTIME
+ XT_SHADOWS = 0.0_MNHTIME
+ XT_ELEC = 0.0_MNHTIME
+ XT_CHEM = 0.0_MNHTIME
+ XT_2WAY = 0.0_MNHTIME
+ !
+ XT_IBM_FORC = 0.0_MNHTIME
+ !
+END IF
+!
+!* 1.7 Allocation of arrays for observation diagnostics
+!
+CALL INI_DIAG_IN_RUN(IIU,IJU,IKU,LFLYER,LSTATION,LPROFILER)
+!
+!
+CALL SECOND_MNH2(ZEND)
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. ONE-WAY NESTING AND LARGE SCALE FIELD REFRESH
+! ---------------------------------------------
+!
+!
+CALL SECOND_MNH2(ZTIME1)
+!
+ISYNCHRO = MODULO (KTCOUNT, NDTRATIO(IMI) ) ! test of synchronisation
+!
+!
+IF (LCOUPLES.AND.LOCEAN) THEN
+ CALL NHOA_COUPL_n(NDAD(IMI),XTSTEP,IMI,KTCOUNT,IKU)
+END IF
+! No Gridnest in coupled OA LES for now
+IF (.NOT. LCOUPLES .AND. IMI/=1 .AND. NDAD(IMI)/=IMI .AND. (ISYNCHRO==1 .OR. NDTRATIO(IMI) == 1) ) THEN
+!
+! Use dummy pointers to correct an ifort BUG
+ DPTR_XBMX1=>XBMX1
+ DPTR_XBMX2=>XBMX2
+ DPTR_XBMX3=>XBMX3
+ DPTR_XBMX4=>XBMX4
+ DPTR_XBMY1=>XBMY1
+ DPTR_XBMY2=>XBMY2
+ DPTR_XBMY3=>XBMY3
+ DPTR_XBMY4=>XBMY4
+ DPTR_XBFX1=>XBFX1
+ DPTR_XBFX2=>XBFX2
+ DPTR_XBFX3=>XBFX3
+ DPTR_XBFX4=>XBFX4
+ DPTR_XBFY1=>XBFY1
+ DPTR_XBFY2=>XBFY2
+ DPTR_XBFY3=>XBFY3
+ DPTR_XBFY4=>XBFY4
+ DPTR_CLBCX=>CLBCX
+ DPTR_CLBCY=>CLBCY
+ !
+ DPTR_XZZ=>XZZ
+ DPTR_XZHAT=>XZHAT
+ DPTR_XCOEFLIN_LBXM=>XCOEFLIN_LBXM
+ DPTR_XLSTHM=>XLSTHM
+ DPTR_XLSRVM=>XLSRVM
+ DPTR_XLSUM=>XLSUM
+ DPTR_XLSVM=>XLSVM
+ DPTR_XLSWM=>XLSWM
+ DPTR_XLSZWSM=>XLSZWSM
+ DPTR_XLSTHS=>XLSTHS
+ DPTR_XLSRVS=>XLSRVS
+ DPTR_XLSUS=>XLSUS
+ DPTR_XLSVS=>XLSVS
+ DPTR_XLSWS=>XLSWS
+ DPTR_XLSZWSS=>XLSZWSS
+ !
+ IF ( LSTEADYLS ) THEN
+ NCPL_CUR=0
+ ELSE
+ IF (NCPL_CUR/=1) THEN
+ IF ( KTCOUNT+1 == NCPL_TIMES(NCPL_CUR-1,IMI) ) THEN
+ !
+ ! LS sources are interpolated from the LS field
+ ! values of model DAD(IMI)
+ CALL SPAWN_LS_n(NDAD(IMI),XTSTEP,IMI, &
+ DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4,DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4, &
+ DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4,DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4, &
+ NDXRATIO_ALL(IMI),NDYRATIO_ALL(IMI), &
+ DPTR_CLBCX,DPTR_CLBCY,DPTR_XZZ,DPTR_XZHAT,LSLEVE,XLEN1,XLEN2,DPTR_XCOEFLIN_LBXM, &
+ DPTR_XLSTHM,DPTR_XLSRVM,DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSZWSM, &
+ DPTR_XLSTHS,DPTR_XLSRVS,DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS, DPTR_XLSZWSS )
+ END IF
+ END IF
+ !
+ END IF
+ !
+ DPTR_NKLIN_LBXU=>NKLIN_LBXU
+ DPTR_XCOEFLIN_LBXU=>XCOEFLIN_LBXU
+ DPTR_NKLIN_LBYU=>NKLIN_LBYU
+ DPTR_XCOEFLIN_LBYU=>XCOEFLIN_LBYU
+ DPTR_NKLIN_LBXV=>NKLIN_LBXV
+ DPTR_XCOEFLIN_LBXV=>XCOEFLIN_LBXV
+ DPTR_NKLIN_LBYV=>NKLIN_LBYV
+ DPTR_XCOEFLIN_LBYV=>XCOEFLIN_LBYV
+ DPTR_NKLIN_LBXW=>NKLIN_LBXW
+ DPTR_XCOEFLIN_LBXW=>XCOEFLIN_LBXW
+ DPTR_NKLIN_LBYW=>NKLIN_LBYW
+ DPTR_XCOEFLIN_LBYW=>XCOEFLIN_LBYW
+ !
+ DPTR_NKLIN_LBXM=>NKLIN_LBXM
+ DPTR_XCOEFLIN_LBXM=>XCOEFLIN_LBXM
+ DPTR_NKLIN_LBYM=>NKLIN_LBYM
+ DPTR_XCOEFLIN_LBYM=>XCOEFLIN_LBYM
+ !
+ DPTR_XLBXUM=>XLBXUM
+ DPTR_XLBYUM=>XLBYUM
+ DPTR_XLBXVM=>XLBXVM
+ DPTR_XLBYVM=>XLBYVM
+ DPTR_XLBXWM=>XLBXWM
+ DPTR_XLBYWM=>XLBYWM
+ DPTR_XLBXTHM=>XLBXTHM
+ DPTR_XLBYTHM=>XLBYTHM
+ DPTR_XLBXTKEM=>XLBXTKEM
+ DPTR_XLBYTKEM=>XLBYTKEM
+ DPTR_XLBXRM=>XLBXRM
+ DPTR_XLBYRM=>XLBYRM
+ DPTR_XLBXSVM=>XLBXSVM
+ DPTR_XLBYSVM=>XLBYSVM
+ !
+ DPTR_XLBXUS=>XLBXUS
+ DPTR_XLBYUS=>XLBYUS
+ DPTR_XLBXVS=>XLBXVS
+ DPTR_XLBYVS=>XLBYVS
+ DPTR_XLBXWS=>XLBXWS
+ DPTR_XLBYWS=>XLBYWS
+ DPTR_XLBXTHS=>XLBXTHS
+ DPTR_XLBYTHS=>XLBYTHS
+ DPTR_XLBXTKES=>XLBXTKES
+ DPTR_XLBYTKES=>XLBYTKES
+ DPTR_XLBXRS=>XLBXRS
+ DPTR_XLBYRS=>XLBYRS
+ DPTR_XLBXSVS=>XLBXSVS
+ DPTR_XLBYSVS=>XLBYSVS
+ !
+ CALL ONE_WAY_n(NDAD(IMI),XTSTEP,IMI,KTCOUNT, &
+ DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4,DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4, &
+ DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4,DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4, &
+ NDXRATIO_ALL(IMI),NDYRATIO_ALL(IMI),NDTRATIO(IMI), &
+ DPTR_CLBCX,DPTR_CLBCY,NRIMX,NRIMY, &
+ DPTR_NKLIN_LBXU,DPTR_XCOEFLIN_LBXU,DPTR_NKLIN_LBYU,DPTR_XCOEFLIN_LBYU, &
+ DPTR_NKLIN_LBXV,DPTR_XCOEFLIN_LBXV,DPTR_NKLIN_LBYV,DPTR_XCOEFLIN_LBYV, &
+ DPTR_NKLIN_LBXW,DPTR_XCOEFLIN_LBXW,DPTR_NKLIN_LBYW,DPTR_XCOEFLIN_LBYW, &
+ DPTR_NKLIN_LBXM,DPTR_XCOEFLIN_LBXM,DPTR_NKLIN_LBYM,DPTR_XCOEFLIN_LBYM, &
+ GSTEADY_DMASS,CCLOUD,LUSECHAQ,LUSECHIC, &
+ DPTR_XLBXUM,DPTR_XLBYUM,DPTR_XLBXVM,DPTR_XLBYVM,DPTR_XLBXWM,DPTR_XLBYWM, &
+ DPTR_XLBXTHM,DPTR_XLBYTHM, &
+ DPTR_XLBXTKEM,DPTR_XLBYTKEM, &
+ DPTR_XLBXRM,DPTR_XLBYRM,DPTR_XLBXSVM,DPTR_XLBYSVM, &
+ XDRYMASST,XDRYMASSS, &
+ DPTR_XLBXUS,DPTR_XLBYUS,DPTR_XLBXVS,DPTR_XLBYVS,DPTR_XLBXWS,DPTR_XLBYWS, &
+ DPTR_XLBXTHS,DPTR_XLBYTHS, &
+ DPTR_XLBXTKES,DPTR_XLBYTKES, &
+ DPTR_XLBXRS,DPTR_XLBYRS,DPTR_XLBXSVS,DPTR_XLBYSVS )
+ !
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+XT_1WAY = XT_1WAY + ZTIME2 - ZTIME1
+!
+!* 2.1 RECYCLING TURBULENCE
+! ----
+IF (CTURB /= 'NONE' .AND. LRECYCL) THEN
+ CALL RECYCLING(XFLUCTUNW,XFLUCTVNN,XFLUCTUTN,XFLUCTVTW,XFLUCTWTW,XFLUCTWTN, &
+ XFLUCTUNE,XFLUCTVNS,XFLUCTUTS,XFLUCTVTE,XFLUCTWTE,XFLUCTWTS, &
+ KTCOUNT)
+ENDIF
+!
+!* 2.2 IBM
+! ----
+!
+IF (LIBM .AND. KTCOUNT==1) THEN
+ !
+ IF (.NOT.LCARTESIAN) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'MODELN', 'IBM can only be used in combination with cartesian coordinates')
+ ENDIF
+ !
+ CALL IBM_INIT(XIBM_LS)
+ !
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. LATERAL BOUNDARY CONDITIONS EXCEPT FOR NORMAL VELOCITY
+! ------------------------------------------------------
+!
+ZTIME1=ZTIME2
+!
+!* 3.1 Set the lagragian variables values at the LB
+!
+IF( LLG .AND. IMI==1 ) CALL SETLB_LG
+!
+IF (CCONF == "START" .OR. (CCONF == "RESTA" .AND. KTCOUNT /= 1 )) THEN
+CALL MPPDB_CHECK3DM("before BOUNDARIES:XUT, XVT, XWT, XTHT, XTKET",PRECISION,&
+ & XUT, XVT, XWT, XTHT, XTKET)
+CALL BOUNDARIES ( &
+ XTSTEP,CLBCX,CLBCY,NRR,NSV,KTCOUNT, &
+ XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, &
+ XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
+ XLBXUS,XLBXVS,XLBXWS,XLBXTHS,XLBXTKES,XLBXRS,XLBXSVS, &
+ XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS, &
+ XRHODJ,XRHODREF, &
+ XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT )
+CALL MPPDB_CHECK3DM("after BOUNDARIES:XUT, XVT, XWT, XTHT, XTKET",PRECISION,&
+ & XUT, XVT, XWT, XTHT, XTKET)
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_BOUND = XT_BOUND + ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!* initializes surface number
+IF (CSURF=='EXTE') CALL GOTO_SURFEX(IMI)
+!-------------------------------------------------------------------------------
+!
+!* 4. STORAGE IN A SYNCHRONOUS FILE
+! -----------------------------
+!
+ZTIME1 = ZTIME2
+!
+IF ( nfile_backup_current < NBAK_NUMB ) THEN
+ IF ( KTCOUNT == TBACKUPN(nfile_backup_current + 1)%NSTEP ) THEN
+ nfile_backup_current = nfile_backup_current + 1
+ !
+ TZBAKFILE => TBACKUPN(nfile_backup_current)%TFILE
+ IVERB = TZBAKFILE%NLFIVERB
+ !
+ CALL IO_File_open(TZBAKFILE)
+ !
+ CALL WRITE_DESFM_n(IMI,TZBAKFILE)
+ CALL IO_Header_write( TBACKUPN(nfile_backup_current)%TFILE )
+ CALL WRITE_LFIFM_n( TBACKUPN(nfile_backup_current)%TFILE, TBACKUPN(nfile_backup_current)%TFILE%TDADFILE%CNAME )
+ TOUTDATAFILE => TZBAKFILE
+ CALL MNHWRITE_ZS_DUMMY_n(TZBAKFILE)
+ IF (CSURF=='EXTE') THEN
+ TFILE_SURFEX => TZBAKFILE
+ CALL GOTO_SURFEX(IMI)
+ CALL WRITE_SURF_ATM_n(YSURF_CUR,'MESONH','ALL',.FALSE.)
+ NULLIFY(TFILE_SURFEX)
+ END IF
+ !
+ ! Reinitialize Lagragian variables at every model backup
+ IF (LLG .AND. LINIT_LG .AND. CINIT_LG=='FMOUT') THEN
+ CALL INI_LG(XXHAT,XYHAT,XZZ,XSVT,XLBXSVM,XLBYSVM)
+ IF (IVERB>=5) THEN
+ WRITE(UNIT=ILUOUT,FMT=*) '************************************'
+ WRITE(UNIT=ILUOUT,FMT=*) '*** Lagrangian variables refreshed after ',TRIM(TZBAKFILE%CNAME),' backup'
+ WRITE(UNIT=ILUOUT,FMT=*) '************************************'
+ END IF
+ END IF
+ ! Reinitialise mean variables
+ IF (LMEAN_FIELD) THEN
+ CALL INI_MEAN_FIELD
+ END IF
+!
+ ELSE
+ !Necessary to have a 'valid' CNAME when calling some subroutines
+ TZBAKFILE => TFILE_DUMMY
+ END IF
+ELSE
+ !Necessary to have a 'valid' CNAME when calling some subroutines
+ TZBAKFILE => TFILE_DUMMY
+END IF
+!
+IF ( nfile_output_current < NOUT_NUMB ) THEN
+ IF ( KTCOUNT == TOUTPUTN(nfile_output_current + 1)%NSTEP ) THEN
+ nfile_output_current = nfile_output_current + 1
+ !
+ TZOUTFILE => TOUTPUTN(nfile_output_current)%TFILE
+ !
+ CALL IO_File_open(TZOUTFILE)
+ !
+ CALL IO_Header_write(TZOUTFILE)
+ CALL IO_Fieldlist_write( TOUTPUTN(nfile_output_current) )
+ CALL IO_Field_user_write( TOUTPUTN(nfile_output_current) )
+ !
+ CALL IO_File_close(TZOUTFILE)
+ !
+ END IF
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_STORE = XT_STORE + ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!* 4.BIS IBM and Fluctuations application
+! -----------------------------
+!
+!* 4.B1 Add fluctuations at the domain boundaries
+!
+IF (LRECYCL) THEN
+ CALL ADDFLUCTUATIONS ( &
+ CLBCX,CLBCY, &
+ XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT, &
+ XFLUCTUTN,XFLUCTVTW,XFLUCTUTS,XFLUCTVTE, &
+ XFLUCTWTW,XFLUCTWTN,XFLUCTWTS,XFLUCTWTE )
+ENDIF
+!
+!* 4.B2 Immersed boundaries
+!
+IF (LIBM) THEN
+ !
+ ZTIME1=ZTIME2
+ !
+ IF (.NOT.LCARTESIAN) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'MODELN', 'IBM can only be used in combination with cartesian coordinates')
+ ENDIF
+ !
+ CALL IBM_FORCING(XUT,XVT,XWT,XTHT,XRT,XSVT,XTKET)
+ !
+ IF (LIBM_TROUBLE) THEN
+ CALL IBM_FORCING_TR(XUT,XVT,XWT,XTHT,XRT,XSVT,XTKET)
+ ENDIF
+ !
+ CALL SECOND_MNH2(ZTIME2)
+ !
+ XT_IBM_FORC = XT_IBM_FORC + ZTIME2 - ZTIME1
+ !
+ENDIF
+!-------------------------------------------------------------------------------
+!
+!* 5. INITIALIZATION OF THE BUDGET VARIABLES
+! --------------------------------------
+!
+IF (NBUMOD==IMI) THEN
+ LBU_ENABLE = CBUTYPE /='NONE'.AND. CBUTYPE /='SKIP'
+ELSE
+ LBU_ENABLE = .FALSE.
+END IF
+!
+IF (NBUMOD==IMI .AND. CBUTYPE=='MASK' ) THEN
+ CALL SET_MASK()
+ if ( lbu_ru ) then
+ tbudgets(NBUDGET_U)%trhodj%xdata(:, nbutime, :) = tbudgets(NBUDGET_U)%trhodj%xdata(:, nbutime, :) &
+ + Mask_compress( Mxm( xrhodj(:, :, :) ) )
+ end if
+ if ( lbu_rv ) then
+ tbudgets(NBUDGET_V)%trhodj%xdata(:, nbutime, :) = tbudgets(NBUDGET_V)%trhodj%xdata(:, nbutime, :) &
+ + Mask_compress( Mym( xrhodj(:, :, :) ) )
+ end if
+ if ( lbu_rw ) then
+ tbudgets(NBUDGET_W)%trhodj%xdata(:, nbutime, :) = tbudgets(NBUDGET_W)%trhodj%xdata(:, nbutime, :) &
+ + Mask_compress( Mzm( xrhodj(:, :, :) ) )
+ end if
+ if ( associated( tburhodj ) ) tburhodj%xdata(:, nbutime, :) = tburhodj%xdata(:, nbutime, :) + Mask_compress( xrhodj(:, :, :) )
+END IF
+!
+IF (NBUMOD==IMI .AND. CBUTYPE=='CART' ) THEN
+ if ( lbu_ru ) then
+ tbudgets(NBUDGET_U)%trhodj%xdata(:, :, :) = tbudgets(NBUDGET_U)%trhodj%xdata(:, :, :) + Cart_compress( Mxm( xrhodj(:, :, :) ) )
+ end if
+ if ( lbu_rv ) then
+ tbudgets(NBUDGET_V)%trhodj%xdata(:, :, :) = tbudgets(NBUDGET_V)%trhodj%xdata(:, :, :) + Cart_compress( Mym( xrhodj(:, :, :) ) )
+ end if
+ if ( lbu_rw ) then
+ tbudgets(NBUDGET_W)%trhodj%xdata(:, :, :) = tbudgets(NBUDGET_W)%trhodj%xdata(:, :, :) &
+ + Cart_compress( Mzm( xrhodj(:, :, :) ) )
+ end if
+ if ( associated( tburhodj ) ) tburhodj%xdata(:, :, :) = tburhodj%xdata(:, :, :) + Cart_compress( xrhodj(:, :, :) )
+END IF
+!
+CALL BUDGET_FLAGS(LUSERV, LUSERC, LUSERR, &
+ LUSERI, LUSERS, LUSERG, LUSERH )
+!
+XTIME_BU = 0.0
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. INITIALIZATION OF THE FIELD TENDENCIES
+! --------------------------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+!
+CALL INITIAL_GUESS ( NRR, NSV, KTCOUNT, XRHODJ,IMI, XTSTEP, &
+ XRUS, XRVS, XRWS, XRTHS, XRRS, XRTKES, XRSVS, &
+ XUT, XVT, XWT, XTHT, XRT, XTKET, XSVT )
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_GUESS = XT_GUESS + ZTIME2 - ZTIME1 - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. INITIALIZATION OF THE LES FOR CURRENT TIME-STEP
+! -----------------------------------------------
+!
+XTIME_LES_BU = 0.0
+XTIME_LES = 0.0
+IF (LLES) CALL LES_INI_TIMESTEP_n(KTCOUNT)
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. TWO-WAY INTERACTIVE GRID-NESTING
+! --------------------------------
+!
+!
+CALL SECOND_MNH2(ZTIME1)
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+GMASKkids(:,:)=.FALSE.
+!
+IF (NMODEL>1) THEN
+ ! correct an ifort bug
+ DPTR_XRHODJ=>XRHODJ
+ DPTR_XUM=>XUT
+ DPTR_XVM=>XVT
+ DPTR_XWM=>XWT
+ DPTR_XTHM=>XTHT
+ DPTR_XRM=>XRT
+ DPTR_XTKEM=>XTKET
+ DPTR_XSVM=>XSVT
+ DPTR_XRUS=>XRUS
+ DPTR_XRVS=>XRVS
+ DPTR_XRWS=>XRWS
+ DPTR_XRTHS=>XRTHS
+ DPTR_XRRS=>XRRS
+ DPTR_XRTKES=>XRTKES
+ DPTR_XRSVS=>XRSVS
+ DPTR_XINPRC=>XINPRC
+ DPTR_XINPRR=>XINPRR
+ DPTR_XINPRS=>XINPRS
+ DPTR_XINPRG=>XINPRG
+ DPTR_XINPRH=>XINPRH
+ DPTR_XPRCONV=>XPRCONV
+ DPTR_XPRSCONV=>XPRSCONV
+ DPTR_XDIRFLASWD=>XDIRFLASWD
+ DPTR_XSCAFLASWD=>XSCAFLASWD
+ DPTR_XDIRSRFSWD=>XDIRSRFSWD
+ DPTR_GMASKkids=>GMASKkids
+ !
+ CALL TWO_WAY( NRR,NSV,KTCOUNT,DPTR_XRHODJ,IMI,XTSTEP, &
+ DPTR_XUM ,DPTR_XVM ,DPTR_XWM , DPTR_XTHM, DPTR_XRM,DPTR_XSVM, &
+ DPTR_XRUS,DPTR_XRVS,DPTR_XRWS,DPTR_XRTHS,DPTR_XRRS,DPTR_XRSVS, &
+ DPTR_XINPRC,DPTR_XINPRR,DPTR_XINPRS,DPTR_XINPRG,DPTR_XINPRH,DPTR_XPRCONV,DPTR_XPRSCONV, &
+ DPTR_XDIRFLASWD,DPTR_XSCAFLASWD,DPTR_XDIRSRFSWD,DPTR_GMASKkids )
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+XT_2WAY = XT_2WAY + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+!
+!* 10. FORCING
+! -------
+!
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+IF (LCARTESIAN) THEN
+ CALL SM_GRIDCART(XXHAT,XYHAT,XZHAT,XZS,LSLEVE,XLEN1,XLEN2,XZSMT,XDXHAT,XDYHAT,XZZ,ZJ)
+ XMAP=1.
+ELSE
+ CALL SM_GRIDPROJ(XXHAT,XYHAT,XZHAT,XZS,LSLEVE,XLEN1,XLEN2,XZSMT,XLATORI,XLONORI, &
+ XMAP,XLAT,XLON,XDXHAT,XDYHAT,XZZ,ZJ)
+END IF
+!
+IF ( LFORCING ) THEN
+ CALL FORCING(XTSTEP,LUSERV,XRHODJ,XCORIOZ,XZHAT,XZZ,TDTCUR,&
+ XUFRC_PAST, XVFRC_PAST,XWTFRC, &
+ XUT,XVT,XWT,XTHT,XTKET,XRT,XSVT, &
+ XRUS,XRVS,XRWS,XRTHS,XRTKES,XRRS,XRSVS,IMI,ZJ)
+END IF
+!
+IF ( L2D_ADV_FRC ) THEN
+ CALL ADV_FORCING_n(XRHODJ,TDTCUR,XTHT,XRT,XZZ,XRTHS,XRRS)
+END IF
+IF ( L2D_REL_FRC ) THEN
+ CALL REL_FORCING_n(XRHODJ,TDTCUR,XTHT,XRT,XZZ,XRTHS,XRRS)
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_FORCING = XT_FORCING + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 11. NUDGING
+! -------
+!
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF ( LNUDGING ) THEN
+ CALL NUDGING(LUSERV,XRHODJ,XTNUDGING, &
+ XUT,XVT,XWT,XTHT,XRT, &
+ XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM, &
+ XRUS,XRVS,XRWS,XRTHS,XRRS)
+
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_NUDGING = XT_NUDGING + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 12. DYNAMICAL SOURCES
+! -----------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF( LTRANS ) THEN
+ XUT(:,:,:) = XUT(:,:,:) + XUTRANS
+ XVT(:,:,:) = XVT(:,:,:) + XVTRANS
+END IF
+!
+CALL DYN_SOURCES( NRR,NRRL, NRRI, &
+ XUT, XVT, XWT, XTHT, XRT, &
+ XCORIOX, XCORIOY, XCORIOZ, XCURVX, XCURVY, &
+ XRHODJ, XZZ, XTHVREF, XEXNREF, &
+ XRUS, XRVS, XRWS, XRTHS )
+!
+IF( LTRANS ) THEN
+ XUT(:,:,:) = XUT(:,:,:) - XUTRANS
+ XVT(:,:,:) = XVT(:,:,:) - XVTRANS
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_SOURCES = XT_SOURCES + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 13. NUMERICAL DIFFUSION
+! -------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF ( LNUMDIFU .OR. LNUMDIFTH .OR. LNUMDIFSV ) THEN
+!
+ CALL UPDATE_HALO_ll(TFIELDT_ll, IINFO_ll)
+ CALL UPDATE_HALO2_ll(TFIELDT_ll, THALO2T_ll, IINFO_ll)
+ IF ( .NOT. LSTEADYLS ) THEN
+ CALL UPDATE_HALO_ll(TLSFIELD_ll, IINFO_ll)
+ CALL UPDATE_HALO_ll(TLSFIELD2D_ll,IINFO_ll)
+ CALL UPDATE_HALO2_ll(TLSFIELD_ll, TLSHALO2_ll, IINFO_ll)
+ END IF
+ CALL NUM_DIFF ( CLBCX, CLBCY, NRR, NSV, &
+ XDK2U, XDK4U, XDK2TH, XDK4TH, XDK2SV, XDK4SV, IMI, &
+ XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, &
+ XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XRHODJ, &
+ XRUS, XRVS, XRWS, XRTHS, XRTKES, XRRS, XRSVS, &
+ LZDIFFU,LNUMDIFU, LNUMDIFTH, LNUMDIFSV, &
+ THALO2T_ll, TLSHALO2_ll,XZDIFFU_HALO2 )
+END IF
+
+if ( lbudget_sv ) then
+ do jsv = 1, nsv
+ call Budget_store_init( tbudgets(jsv + NBUDGET_SV1 - 1), 'NEGA2', xrsvs(:, :, :, jsv) )
+ end do
+end if
+
+DO JSV = NSV_CHEMBEG,NSV_CHEMEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_CHICBEG,NSV_CHICEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_AERBEG,NSV_AEREND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_LNOXBEG,NSV_LNOXEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_DSTBEG,NSV_DSTEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_SLTBEG,NSV_SLTEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_PPBEG,NSV_PPEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+#ifdef MNH_FOREFIRE
+DO JSV = NSV_FFBEG,NSV_FFEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+#endif
+DO JSV = NSV_CSBEG,NSV_CSEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_DSTDEPBEG,NSV_DSTDEPEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_SLTDEPBEG,NSV_SLTDEPEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_AERDEPBEG,NSV_AERDEPEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+DO JSV = NSV_SNWBEG,NSV_SNWEND
+ XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
+END DO
+IF (CELEC .NE. 'NONE') THEN
+ XRSVS(:,:,:,NSV_ELECBEG) = MAX(XRSVS(:,:,:,NSV_ELECBEG),0.)
+ XRSVS(:,:,:,NSV_ELECEND) = MAX(XRSVS(:,:,:,NSV_ELECEND),0.)
+END IF
+
+if ( lbudget_sv ) then
+ do jsv = 1, nsv
+ call Budget_store_end( tbudgets(jsv + NBUDGET_SV1 - 1), 'NEGA2', xrsvs(:, :, :, jsv) )
+ end do
+end if
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_DIFF = XT_DIFF + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 14. UPPER AND LATERAL RELAXATION
+! ----------------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF(LVE_RELAX .OR. LVE_RELAX_GRD .OR. LHORELAX_UVWTH .OR. LHORELAX_RV .OR.&
+ LHORELAX_RC .OR. LHORELAX_RR .OR. LHORELAX_RI .OR. LHORELAX_RS .OR. &
+ LHORELAX_RG .OR. LHORELAX_RH .OR. LHORELAX_TKE .OR. &
+ ANY(LHORELAX_SV)) THEN
+ CALL RELAXATION (LVE_RELAX,LVE_RELAX_GRD,LHORELAX_UVWTH,LHORELAX_RV,LHORELAX_RC, &
+ LHORELAX_RR,LHORELAX_RI,LHORELAX_RS,LHORELAX_RG, &
+ LHORELAX_RH,LHORELAX_TKE,LHORELAX_SV, &
+ LHORELAX_SVC2R2,LHORELAX_SVC1R3, &
+ LHORELAX_SVELEC,LHORELAX_SVLG, &
+ LHORELAX_SVCHEM,LHORELAX_SVCHIC,LHORELAX_SVAER, &
+ LHORELAX_SVDST,LHORELAX_SVSLT,LHORELAX_SVPP, &
+ LHORELAX_SVCS,LHORELAX_SVSNW, &
+#ifdef MNH_FOREFIRE
+ LHORELAX_SVFF, &
+#endif
+ KTCOUNT,NRR,NSV,XTSTEP,XRHODJ, &
+ XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, &
+ XLSUM, XLSVM, XLSWM, XLSTHM, &
+ XLBXUM, XLBXVM, XLBXWM, XLBXTHM, &
+ XLBXRM, XLBXSVM, XLBXTKEM, &
+ XLBYUM, XLBYVM, XLBYWM, XLBYTHM, &
+ XLBYRM, XLBYSVM, XLBYTKEM, &
+ NALBOT, XALK, XALKW, &
+ NALBAS, XALKBAS, XALKWBAS, &
+ LMASK_RELAX,XKURELAX, XKVRELAX, XKWRELAX, &
+ NRIMX,NRIMY, &
+ XRUS, XRVS, XRWS, XRTHS, XRRS, XRSVS, XRTKES )
+END IF
+
+IF (CELEC.NE.'NONE' .AND. LRELAX2FW_ION) THEN
+ CALL RELAX2FW_ION (KTCOUNT, IMI, XTSTEP, XRHODJ, XSVT, NALBOT, &
+ XALK, LMASK_RELAX, XKWRELAX, XRSVS )
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_RELAX = XT_RELAX + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 15. PARAMETRIZATIONS' MONITOR
+! -------------------------
+!
+ZTIME1 = ZTIME2
+!
+CALL PHYS_PARAM_n( KTCOUNT, TZBAKFILE, &
+ XT_RAD, XT_SHADOWS, XT_DCONV, XT_GROUND, &
+ XT_MAFL, XT_DRAG, XT_EOL, XT_TURB, XT_TRACER, &
+ ZTIME, ZWETDEPAER, GMASKkids, GCLOUD_ONLY )
+!
+IF (CDCONV/='NONE') THEN
+ XPACCONV = XPACCONV + XPRCONV * XTSTEP
+ IF (LCH_CONV_LINOX) THEN
+ XIC_TOTAL_NUMBER = XIC_TOTAL_NUMBER + XIC_RATE * XTSTEP
+ XCG_TOTAL_NUMBER = XCG_TOTAL_NUMBER + XCG_RATE * XTSTEP
+ END IF
+END IF
+!
+IF ( nfile_backup_current > 0 .AND. nfile_backup_current <= NBAK_NUMB ) THEN
+ IF ( KTCOUNT == TBACKUPN(nfile_backup_current)%NSTEP ) THEN
+ IF (CSURF=='EXTE') THEN
+ CALL GOTO_SURFEX(IMI)
+ CALL DIAG_SURF_ATM_n(YSURF_CUR,'MESONH')
+ TFILE_SURFEX => TZBAKFILE
+ CALL WRITE_DIAG_SURF_ATM_n(YSURF_CUR,'MESONH','ALL')
+ NULLIFY(TFILE_SURFEX)
+ END IF
+ END IF
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_PARAM = XT_PARAM + ZTIME2 - ZTIME1 - XTIME_LES - ZTIME
+!
+!-------------------------------------------------------------------------------
+!
+!* 16. TEMPORAL SERIES
+! ---------------
+!
+ZTIME1 = ZTIME2
+!
+IF (LSERIES) THEN
+ IF ( MOD (KTCOUNT-1,NFREQSERIES) == 0 ) CALL SERIES_n
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_STEP_MISC = XT_STEP_MISC + ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!* 17. LARGE SCALE FIELD REFRESH
+! -------------------------
+!
+ZTIME1 = ZTIME2
+!
+IF (.NOT. LSTEADYLS) THEN
+ IF ( IMI==1 .AND. &
+ NCPL_CUR < NCPL_NBR ) THEN
+ IF (KTCOUNT+1 == NCPL_TIMES(NCPL_CUR,1) ) THEN
+ ! The next current time reachs a
+ NCPL_CUR=NCPL_CUR+1 ! coupling one, LS sources are refreshed
+ !
+ CALL LS_COUPLING(XTSTEP,GSTEADY_DMASS,CCONF, &
+ CGETTKET, &
+ CGETRVT,CGETRCT,CGETRRT,CGETRIT, &
+ CGETRST,CGETRGT,CGETRHT,CGETSVT,LCH_INIT_FIELD, NSV, &
+ NIMAX_ll,NJMAX_ll, &
+ NSIZELBX_ll,NSIZELBXU_ll,NSIZELBY_ll,NSIZELBYV_ll, &
+ NSIZELBXTKE_ll,NSIZELBYTKE_ll, &
+ NSIZELBXR_ll,NSIZELBYR_ll,NSIZELBXSV_ll,NSIZELBYSV_ll, &
+ XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XLSZWSM,XDRYMASST, &
+ XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, &
+ XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
+ XLSUS,XLSVS,XLSWS,XLSTHS,XLSRVS,XLSZWSS,XDRYMASSS, &
+ XLBXUS,XLBXVS,XLBXWS,XLBXTHS,XLBXTKES,XLBXRS,XLBXSVS, &
+ XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS )
+ !
+ DO JSV=NSV_CHEMBEG,NSV_CHEMEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_LNOXBEG,NSV_LNOXEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_AERBEG,NSV_AEREND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_DSTBEG,NSV_DSTEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_DSTDEPBEG,NSV_DSTDEPEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_SLTBEG,NSV_SLTEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_SLTDEPBEG,NSV_SLTDEPEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_PPBEG,NSV_PPEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+#ifdef MNH_FOREFIRE
+ DO JSV=NSV_FFBEG,NSV_FFEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+#endif
+ DO JSV=NSV_CSBEG,NSV_CSEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ DO JSV=NSV_SNWBEG,NSV_SNWEND
+ XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
+ XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
+ ENDDO
+ !
+ END IF
+ END IF
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_COUPL = XT_COUPL + ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!
+!
+!* 8 Bis . Blowing snow scheme
+! ---------
+!
+IF ( LBLOWSNOW ) THEN
+ CALL BLOWSNOW( XTSTEP, NRR, XPABST, XTHT, XRT, XZZ, XRHODREF, &
+ XRHODJ, XEXNREF, XRRS, XRTHS, XSVT, XRSVS, XSNWSUBL3D )
+ENDIF
+!
+!-----------------------------------------------------------------------
+!
+!* 8 Ter VISCOSITY (no-slip condition inside)
+! ---------
+!
+!
+IF ( LVISC ) THEN
+!
+ZTIME1 = ZTIME2
+!
+ CALL VISCOSITY(CLBCX, CLBCY, NRR, NSV, XMU_V,XPRANDTL, &
+ LVISC_UVW,LVISC_TH,LVISC_SV,LVISC_R, &
+ LDRAG, &
+ XUT, XVT, XWT, XTHT, XRT, XSVT, &
+ XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
+ XRUS, XRVS, XRWS, XRTHS, XRRS, XRSVS,XDRAG )
+!
+ENDIF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_VISC = XT_VISC + ZTIME2 - ZTIME1
+!!
+!-------------------------------------------------------------------------------
+!
+!* 9. ADVECTION
+! ---------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+!
+!
+CALL MPPDB_CHECK3DM("before ADVEC_METSV:XU/V/W/TH/TKE/T,XRHODJ",PRECISION,&
+ & XUT, XVT, XWT, XTHT, XTKET,XRHODJ)
+ CALL ADVECTION_METSV ( TZBAKFILE, CUVW_ADV_SCHEME, &
+ CMET_ADV_SCHEME, CSV_ADV_SCHEME, CCLOUD, NSPLIT, &
+ LSPLIT_CFL, XSPLIT_CFL, LCFL_WRIT, &
+ CLBCX, CLBCY, NRR, NSV, TDTCUR, XTSTEP, &
+ XUT, XVT, XWT, XTHT, XRT, XTKET, XSVT, XPABST, &
+ XTHVREF, XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
+ XRTHS, XRRS, XRTKES, XRSVS, &
+ XRTHS_CLD, XRRS_CLD, XRSVS_CLD, XRTKEMS )
+CALL MPPDB_CHECK3DM("after ADVEC_METSV:XU/V/W/TH/TKE/T,XRHODJ ",PRECISION,&
+ & XUT, XVT, XWT, XTHT, XTKET,XRHODJ)
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_ADV = XT_ADV + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+ZRWS = XRWS
+!
+CALL GRAVITY_IMPL ( CLBCX, CLBCY, NRR, NRRL, NRRI,XTSTEP, &
+ XTHT, XRT, XTHVREF, XRHODJ, XRWS, XRTHS, XRRS, &
+ XRTHS_CLD, XRRS_CLD )
+!
+! At the initial instant the difference with the ref state creates a
+! vertical velocity production that must not be advected as it is
+! compensated by the pressure gradient
+!
+IF (KTCOUNT == 1 .AND. CCONF=='START') XRWS_PRES = - (XRWS - ZRWS)
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_GRAV = XT_GRAV + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+IF ( LIBM .AND. CIBM_ADV=='FORCIN' ) THEN
+ !
+ ZTIME1=ZTIME2
+ !
+ CALL IBM_FORCING_ADV (XRUS,XRVS,XRWS)
+ !
+ CALL SECOND_MNH2(ZTIME2)
+ !
+ XT_IBM_FORC = XT_IBM_FORC + ZTIME2 - ZTIME1
+ !
+ENDIF
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+!MPPDB_CHECK_LB=.TRUE.
+CALL MPPDB_CHECK3DM("before ADVEC_UVW:XU/V/W/TH/TKE/T,XRHODJ,XRU/V/Ws",PRECISION,&
+ & XUT, XVT, XWT, XTHT, XTKET,XRHODJ,XRUS,XRVS,XRWS)
+IF ((CUVW_ADV_SCHEME(1:3)=='CEN') .AND. (CTEMP_SCHEME == 'LEFR')) THEN
+ IF (CUVW_ADV_SCHEME=='CEN4TH') THEN
+ NULLIFY(TZFIELDC_ll)
+ NULLIFY(TZHALO2C_ll)
+ CALL ADD3DFIELD_ll( TZFIELDC_ll, XUT, 'MODEL_n::XUT' )
+ CALL ADD3DFIELD_ll( TZFIELDC_ll, XVT, 'MODEL_n::XVT' )
+ CALL ADD3DFIELD_ll( TZFIELDC_ll, XWT, 'MODEL_n::XWT' )
+ CALL INIT_HALO2_ll(TZHALO2C_ll,3,IIU,IJU,IKU)
+ CALL UPDATE_HALO_ll(TZFIELDC_ll,IINFO_ll)
+ CALL UPDATE_HALO2_ll(TZFIELDC_ll, TZHALO2C_ll, IINFO_ll)
+ END IF
+ CALL ADVECTION_UVW_CEN(CUVW_ADV_SCHEME, &
+ CLBCX, CLBCY, &
+ XTSTEP, KTCOUNT, &
+ XUM, XVM, XWM, XDUM, XDVM, XDWM, &
+ XUT, XVT, XWT, &
+ XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
+ XRUS,XRVS, XRWS, &
+ TZHALO2C_ll )
+ IF (CUVW_ADV_SCHEME=='CEN4TH') THEN
+ CALL CLEANLIST_ll(TZFIELDC_ll)
+ NULLIFY(TZFIELDC_ll)
+ CALL DEL_HALO2_ll(TZHALO2C_ll)
+ NULLIFY(TZHALO2C_ll)
+ END IF
+ELSE
+
+ CALL ADVECTION_UVW(CUVW_ADV_SCHEME, CTEMP_SCHEME, &
+ NWENO_ORDER, LSPLIT_WENO, &
+ CLBCX, CLBCY, XTSTEP, &
+ XUT, XVT, XWT, &
+ XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
+ XRUS, XRVS, XRWS, &
+ XRUS_PRES, XRVS_PRES, XRWS_PRES )
+END IF
+!
+CALL MPPDB_CHECK3DM("after ADVEC_UVW:XU/V/W/TH/TKE/T,XRHODJ,XRU/V/Ws",PRECISION,&
+ & XUT, XVT, XWT, XTHT, XTKET,XRHODJ,XRUS,XRVS,XRWS)
+!MPPDB_CHECK_LB=.FALSE.
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_ADVUVW = XT_ADVUVW + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+IF (NMODEL_CLOUD==IMI .AND. CTURBLEN_CLOUD/='NONE') THEN
+ CALL TURB_CLOUD_INDEX( XTSTEP, TZBAKFILE, &
+ LTURB_DIAG, NRRI, &
+ XRRS, XRT, XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
+ XCEI )
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 18. LATERAL BOUNDARY CONDITION FOR THE NORMAL VELOCITY
+! --------------------------------------------------
+!
+ZTIME1 = ZTIME2
+!
+CALL MPPDB_CHECK3DM("before RAD_BOUND :XRU/V/WS",PRECISION,XRUS,XRVS,XRWS)
+ZRUS=XRUS
+ZRVS=XRVS
+ZRWS=XRWS
+
+if ( .not. l1d ) then
+ if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'PRES', xrus(:, :, :) )
+ if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V), 'PRES', xrvs(:, :, :) )
+ if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W), 'PRES', xrws(:, :, :) )
+end if
+
+CALL RAD_BOUND (CLBCX,CLBCY,CTURB,XCARPKMAX, &
+ XTSTEP, &
+ XDXHAT, XDYHAT, XZHAT, &
+ XUT, XVT, &
+ XLBXUM, XLBYVM, XLBXUS, XLBYVS, &
+ XFLUCTUNW,XFLUCTVNN,XFLUCTUNE,XFLUCTVNS, &
+ XCPHASE, XCPHASE_PBL, XRHODJ, &
+ XTKET,XRUS, XRVS, XRWS )
+ZRUS=XRUS-ZRUS
+ZRVS=XRVS-ZRVS
+ZRWS=XRWS-ZRWS
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_RAD_BOUND = XT_RAD_BOUND + ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!* 19. PRESSURE COMPUTATION
+! --------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+ZPABST = XPABST
+!
+IF(.NOT. L1D) THEN
+!
+CALL MPPDB_CHECK3DM("before pressurez:XRU/V/WS",PRECISION,XRUS,XRVS,XRWS)
+ XRUS_PRES = XRUS
+ XRVS_PRES = XRVS
+ XRWS_PRES = XRWS
+!
+ CALL PRESSUREZ( CLBCX,CLBCY,CPRESOPT,NITR,LITRADJ,KTCOUNT, XRELAX,IMI, &
+ XRHODJ,XDXX,XDYY,XDZZ,XDZX,XDZY,XDXHATM,XDYHATM,XRHOM, &
+ XAF,XBFY,XCF,XTRIGSX,XTRIGSY,NIFAXX,NIFAXY, &
+ NRR,NRRL,NRRI,XDRYMASST,XREFMASS,XMASS_O_PHI0, &
+ XTHT,XRT,XRHODREF,XTHVREF,XRVREF,XEXNREF, XLINMASS, &
+ XRUS, XRVS, XRWS, XPABST, &
+ XBFB,&
+ XBF_SXP2_YP1_Z) !JUAN Z_SPLITING
+!
+ XRUS_PRES = XRUS - XRUS_PRES + ZRUS
+ XRVS_PRES = XRVS - XRVS_PRES + ZRVS
+ XRWS_PRES = XRWS - XRWS_PRES + ZRWS
+!
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_PRESS = XT_PRESS + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 20. CHEMISTRY/AEROSOLS
+! ------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF (LUSECHEM) THEN
+ CALL CH_MONITOR_n(ZWETDEPAER,KTCOUNT,XTSTEP, ILUOUT, NVERB)
+END IF
+!
+! For inert aerosol (dust and sea salt) => aer_monitor_n
+IF ((LDUST).OR.(LSALT)) THEN
+!
+! tests to see if any cloud exists
+!
+ GCLD=.TRUE.
+ IF (GCLD .AND. NRR.LE.3 ) THEN
+ IF( MAXVAL(XCLDFR(:,:,:)).LE. 1.E-10 .AND. GCLOUD_ONLY ) THEN
+ GCLD = .FALSE. ! only the cloudy verticals would be
+ ! refreshed but there is no clouds
+ END IF
+ END IF
+!
+ IF (GCLD .AND. NRR.GE.4 ) THEN
+ IF( CCLOUD(1:3)=='ICE' )THEN
+ IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN(2) .AND. &
+ MAXVAL(XRT(:,:,:,4)).LE.XRTMIN(4) .AND. GCLOUD_ONLY ) THEN
+ GCLD = .FALSE. ! only the cloudy verticals would be
+ ! refreshed but there is no cloudwater and ice
+ END IF
+ END IF
+ IF( CCLOUD=='C3R5' )THEN
+ IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN_C1R3(2) .AND. &
+ MAXVAL(XRT(:,:,:,4)).LE.XRTMIN_C1R3(4) .AND. GCLOUD_ONLY ) THEN
+ GCLD = .FALSE. ! only the cloudy verticals would be
+ ! refreshed but there is no cloudwater and ice
+ END IF
+ END IF
+ IF( CCLOUD=='LIMA' )THEN
+ IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN_LIMA(2) .AND. &
+ MAXVAL(XRT(:,:,:,4)).LE.XRTMIN_LIMA(4) .AND. GCLOUD_ONLY ) THEN
+ GCLD = .FALSE. ! only the cloudy verticals would be
+ ! refreshed but there is no cloudwater and ice
+ END IF
+ END IF
+ END IF
+
+!
+ CALL AER_MONITOR_n(KTCOUNT,XTSTEP, ILUOUT, NVERB, GCLD)
+END IF
+!
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_CHEM = XT_CHEM + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+ZTIME = ZTIME + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
+
+!-------------------------------------------------------------------------------
+!
+!* 20. WATER MICROPHYSICS
+! ------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN
+!
+ IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' .OR. CCLOUD == 'C3R5' &
+ .OR. CCLOUD == "LIMA" ) THEN
+ IF ( LFORCING ) THEN
+ XWT_ACT_NUC(:,:,:) = XWT(:,:,:) + XWTFRC(:,:,:)
+ ELSE
+ XWT_ACT_NUC(:,:,:) = XWT(:,:,:)
+ END IF
+ IF (CTURB /= 'NONE' ) THEN
+ IF ( ((CCLOUD=='C2R2'.OR.CCLOUD=='KHKO').AND.LACTTKE) .OR. (CCLOUD=='LIMA'.AND.MACTTKE) ) THEN
+ XWT_ACT_NUC(:,:,:) = XWT_ACT_NUC(:,:,:) + (2./3. * XTKET(:,:,:))**0.5
+ ELSE
+ XWT_ACT_NUC(:,:,:) = XWT_ACT_NUC(:,:,:)
+ ENDIF
+ ENDIF
+ ELSE
+ XWT_ACT_NUC(:,:,:) = 0.
+ END IF
+!
+ XRTHS_CLD = XRTHS
+ XRRS_CLD = XRRS
+ XRSVS_CLD = XRSVS
+ IF (CSURF=='EXTE') THEN
+ ALLOCATE (ZSEA(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+ ALLOCATE (ZTOWN(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+ ZSEA(:,:) = 0.
+ ZTOWN(:,:)= 0.
+ CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:),PTOWN=ZTOWN(:,:))
+ CALL RESOLVED_CLOUD ( CCLOUD, CACTCCN, CSCONV, CMF_CLOUD, NRR, NSPLITR, &
+ NSPLITG, IMI, KTCOUNT, &
+ CLBCX,CLBCY,TZBAKFILE, CRAD, CTURBDIM, &
+ LSUBG_COND,LSIGMAS,CSUBG_AUCV,XTSTEP, &
+ XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ ZPABST, XTHT,XRT,XSIGS,VSIGQSAT,XMFCONV,XTHM,XRCM, &
+ XPABSM, XWT_ACT_NUC,XDTHRAD, XRTHS, XRRS, &
+ XSVT, XRSVS, &
+ XSRCT, XCLDFR,XCIT, &
+ LSEDIC,KACTIT, KSEDC, KSEDI, KRAIN, KWARM, KHHONI, &
+ LCONVHG, XCF_MF,XRC_MF, XRI_MF, &
+ XINPRC,ZINPRC3D,XINPRR, XINPRR3D, XEVAP3D, &
+ XINPRS,ZINPRS3D, XINPRG,ZINPRG3D, XINPRH,ZINPRH3D, &
+ XSOLORG, XMI,ZSPEEDC, ZSPEEDR, ZSPEEDS, ZSPEEDG, ZSPEEDH, &
+ XINDEP, XSUPSAT, XNACT, XNPRO,XSSPRO, XRAINFR, &
+ XHLC_HRC, XHLC_HCF, XHLI_HRI, XHLI_HCF, &
+ ZSEA, ZTOWN )
+ DEALLOCATE(ZTOWN)
+ ELSE
+ CALL RESOLVED_CLOUD ( CCLOUD, CACTCCN, CSCONV, CMF_CLOUD, NRR, NSPLITR, &
+ NSPLITG, IMI, KTCOUNT, &
+ CLBCX,CLBCY,TZBAKFILE, CRAD, CTURBDIM, &
+ LSUBG_COND,LSIGMAS,CSUBG_AUCV, &
+ XTSTEP,XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ ZPABST, XTHT,XRT,XSIGS,VSIGQSAT,XMFCONV,XTHM,XRCM, &
+ XPABSM, XWT_ACT_NUC,XDTHRAD, XRTHS, XRRS, &
+ XSVT, XRSVS, &
+ XSRCT, XCLDFR,XCIT, &
+ LSEDIC,KACTIT, KSEDC, KSEDI, KRAIN, KWARM, KHHONI, &
+ LCONVHG, XCF_MF,XRC_MF, XRI_MF, &
+ XINPRC,ZINPRC3D,XINPRR, XINPRR3D, XEVAP3D, &
+ XINPRS,ZINPRS3D, XINPRG,ZINPRG3D, XINPRH,ZINPRH3D, &
+ XSOLORG, XMI,ZSPEEDC, ZSPEEDR, ZSPEEDS, ZSPEEDG, ZSPEEDH, &
+ XINDEP, XSUPSAT, XNACT, XNPRO,XSSPRO, XRAINFR, &
+ XHLC_HRC, XHLC_HCF, XHLI_HRI, XHLI_HCF )
+ END IF
+ XRTHS_CLD = XRTHS - XRTHS_CLD
+ XRRS_CLD = XRRS - XRRS_CLD
+ XRSVS_CLD = XRSVS - XRSVS_CLD
+!
+ IF (CCLOUD /= 'REVE' ) THEN
+ XACPRR = XACPRR + XINPRR * XTSTEP
+ IF ( (CCLOUD(1:3) == 'ICE' .AND. LSEDIC ) .OR. &
+ ((CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO' &
+ .OR. CCLOUD == 'LIMA' ) .AND. KSEDC ) ) THEN
+ XACPRC = XACPRC + XINPRC * XTSTEP
+ IF (LDEPOSC .OR. LDEPOC) XACDEP = XACDEP + XINDEP * XTSTEP
+ END IF
+ IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C3R5' .OR. &
+ (CCLOUD == 'LIMA' .AND. LCOLD ) ) THEN
+ XACPRS = XACPRS + XINPRS * XTSTEP
+ XACPRG = XACPRG + XINPRG * XTSTEP
+ IF (CCLOUD == 'ICE4' .OR. (CCLOUD == 'LIMA' .AND. LHAIL)) XACPRH = XACPRH + XINPRH * XTSTEP
+ END IF
+!
+! Lessivage des CCN et IFN nucléables par Slinn
+!
+ IF (LSCAV .AND. (CCLOUD == 'LIMA')) THEN
+ CALL LIMA_PRECIP_SCAVENGING(CCLOUD, ILUOUT, KTCOUNT,XTSTEP,XRT(:,:,:,3), &
+ XRHODREF, XRHODJ, XZZ, XPABST, XTHT, &
+ XSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ XRSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), XINPAP )
+!
+ XACPAP(:,:) = XACPAP(:,:) + XINPAP(:,:) * XTSTEP
+ END IF
+ END IF
+!
+! It is necessary that SV_C2R2 and SV_C1R3 are contiguous in the preceeding CALL
+!
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_CLOUD = XT_CLOUD + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 21. CLOUD ELECTRIFICATION AND LIGHTNING FLASHES
+! -------------------------------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF (CELEC /= 'NONE' .AND. (CCLOUD(1:3) == 'ICE')) THEN
+ XWT_ACT_NUC(:,:,:) = 0.
+!
+ XRTHS_CLD = XRTHS
+ XRRS_CLD = XRRS
+ XRSVS_CLD = XRSVS
+ IF (CSURF=='EXTE') THEN
+ ALLOCATE (ZSEA(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+ ALLOCATE (ZTOWN(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+ ZSEA(:,:) = 0.
+ ZTOWN(:,:)= 0.
+ CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:),PTOWN=ZTOWN(:,:))
+ CALL RESOLVED_ELEC_n (CCLOUD, CSCONV, CMF_CLOUD, &
+ NRR, NSPLITR, IMI, KTCOUNT, OEXIT, &
+ CLBCX, CLBCY, CRAD, CTURBDIM, &
+ LSUBG_COND, LSIGMAS,VSIGQSAT,CSUBG_AUCV, &
+ XTSTEP, XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ ZPABST, XTHT, XRTHS, XWT, XRT, XRRS, &
+ XSVT, XRSVS, XCIT, &
+ XSIGS, XSRCT, XCLDFR, XMFCONV, XCF_MF, XRC_MF, &
+ XRI_MF, LSEDIC, LWARM, &
+ XINPRC, XINPRR, XINPRR3D, XEVAP3D, &
+ XINPRS, XINPRG, XINPRH, &
+ ZSEA, ZTOWN )
+ DEALLOCATE(ZTOWN)
+ ELSE
+ CALL RESOLVED_ELEC_n (CCLOUD, CSCONV, CMF_CLOUD, &
+ NRR, NSPLITR, IMI, KTCOUNT, OEXIT, &
+ CLBCX, CLBCY, CRAD, CTURBDIM, &
+ LSUBG_COND, LSIGMAS,VSIGQSAT, CSUBG_AUCV, &
+ XTSTEP, XZZ, XRHODJ, XRHODREF, XEXNREF, &
+ ZPABST, XTHT, XRTHS, XWT, &
+ XRT, XRRS, XSVT, XRSVS, XCIT, &
+ XSIGS, XSRCT, XCLDFR, XMFCONV, XCF_MF, XRC_MF, &
+ XRI_MF, LSEDIC, LWARM, &
+ XINPRC, XINPRR, XINPRR3D, XEVAP3D, &
+ XINPRS, XINPRG, XINPRH )
+ END IF
+ XRTHS_CLD = XRTHS - XRTHS_CLD
+ XRRS_CLD = XRRS - XRRS_CLD
+ XRSVS_CLD = XRSVS - XRSVS_CLD
+!
+ XACPRR = XACPRR + XINPRR * XTSTEP
+ IF ((CCLOUD(1:3) == 'ICE' .AND. LSEDIC)) &
+ XACPRC = XACPRC + XINPRC * XTSTEP
+ IF (CCLOUD(1:3) == 'ICE') THEN
+ XACPRS = XACPRS + XINPRS * XTSTEP
+ XACPRG = XACPRG + XINPRG * XTSTEP
+ IF (CCLOUD == 'ICE4') XACPRH = XACPRH + XINPRH * XTSTEP
+ END IF
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_ELEC = XT_ELEC + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 21. L.E.S. COMPUTATIONS
+! -------------------
+!
+ZTIME1 = ZTIME2
+!
+CALL LES_n
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_SPECTRA = XT_SPECTRA + ZTIME2 - ZTIME1 + XTIME_LES_BU + XTIME_LES
+!
+!-------------------------------------------------------------------------------
+!
+!* 21. bis MEAN_UM
+! --------------------
+!
+IF (LMEAN_FIELD) THEN
+ CALL MEAN_FIELD(XUT, XVT, XWT, XTHT, XTKET, XPABST, XSVT(:,:,:,1))
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 22. UPDATE HALO OF EACH SUBDOMAINS FOR TIME T+DT
+! --------------------------------------------
+!
+ZTIME1 = ZTIME2
+!
+CALL EXCHANGE (XTSTEP,NRR,NSV,XRHODJ,TFIELDS_ll, &
+ XRUS, XRVS,XRWS,XRTHS,XRRS,XRTKES,XRSVS)
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_HALO = XT_HALO + ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!* 23. TEMPORAL SWAPPING
+! -----------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+!
+CALL ENDSTEP ( XTSTEP,NRR,NSV,KTCOUNT,IMI, &
+ CUVW_ADV_SCHEME,CTEMP_SCHEME,XRHODJ, &
+ XRUS,XRVS,XRWS,XDRYMASSS, &
+ XRTHS,XRRS,XRTKES,XRSVS, &
+ XLSUS,XLSVS,XLSWS, &
+ XLSTHS,XLSRVS,XLSZWSS, &
+ XLBXUS,XLBXVS,XLBXWS, &
+ XLBXTHS,XLBXRS,XLBXTKES,XLBXSVS, &
+ XLBYUS,XLBYVS,XLBYWS, &
+ XLBYTHS,XLBYRS,XLBYTKES,XLBYSVS, &
+ XUM,XVM,XWM,XZWS, &
+ XUT,XVT,XWT,XPABST,XDRYMASST, &
+ XTHT, XRT, XTHM, XRCM, XPABSM,XTKET, XSVT,&
+ XLSUM,XLSVM,XLSWM, &
+ XLSTHM,XLSRVM,XLSZWSM, &
+ XLBXUM,XLBXVM,XLBXWM, &
+ XLBXTHM,XLBXRM,XLBXTKEM,XLBXSVM, &
+ XLBYUM,XLBYVM,XLBYWM, &
+ XLBYTHM,XLBYRM,XLBYTKEM,XLBYSVM )
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_STEP_SWA = XT_STEP_SWA + ZTIME2 - ZTIME1 - XTIME_BU_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+!* 24.1 BALLOON and AIRCRAFT
+! --------------------
+!
+ZTIME1 = ZTIME2
+!
+IF (LFLYER) &
+ CALL AIRCRAFT_BALLOON(XTSTEP, &
+ XXHAT, XYHAT, XZZ, XMAP, XLONORI, XLATORI, &
+ XUT, XVT, XWT, XPABST, XTHT, XRT, XSVT, XTKET, XTSRAD, &
+ XRHODREF,XCIT,PSEA=ZSEA(:,:))
+
+
+!-------------------------------------------------------------------------------
+!
+!* 24.2 STATION (observation diagnostic)
+! --------------------------------
+!
+IF (LSTATION) &
+ CALL STATION_n(XTSTEP, &
+ XXHAT, XYHAT, XZZ, &
+ XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, XTSRAD, XPABST )
+!
+!---------------------------------------------------------
+!
+!* 24.3 PROFILER (observation diagnostic)
+! ---------------------------------
+!
+IF (LPROFILER) &
+ CALL PROFILER_n(XTSTEP, &
+ XXHAT, XYHAT, XZZ,XRHODREF, &
+ XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, XTSRAD, XPABST, &
+ XAER, XCLDFR, XCIT,PSEA=ZSEA(:,:))
+!
+IF (ALLOCATED(ZSEA)) DEALLOCATE (ZSEA)
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_STEP_MISC = XT_STEP_MISC + ZTIME2 - ZTIME1
+!
+!-------------------------------------------------------------------------------
+!
+!* 24.4 deallocation of observation diagnostics
+! ---------------------------------------
+!
+CALL END_DIAG_IN_RUN
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 25. STORAGE OF BUDGET FIELDS
+! ------------------------
+!
+ZTIME1 = ZTIME2
+!
+IF ( .NOT. LIO_NO_WRITE ) THEN
+ IF (NBUMOD==IMI .AND. CBUTYPE/='NONE') THEN
+ CALL ENDSTEP_BUDGET(TDIAFILE,KTCOUNT,TDTCUR,XTSTEP,NSV)
+ END IF
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+XT_STEP_BUD = XT_STEP_BUD + ZTIME2 - ZTIME1 + XTIME_BU
+!
+!-------------------------------------------------------------------------------
+!
+!* 26. FM FILE CLOSURE
+! ---------------
+!
+IF ( tzbakfile%lopened ) THEN
+ CALL IO_File_close(TZBAKFILE)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 27. CURRENT TIME REFRESH
+! --------------------
+!
+TDTCUR%xtime=TDTCUR%xtime + XTSTEP
+CALL DATETIME_CORRECTDATE(TDTCUR)
+!
+!-------------------------------------------------------------------------------
+!
+!* 28. CPU ANALYSIS
+! ------------
+!
+CALL SECOND_MNH2(ZTIME2)
+XT_START=XT_START+ZTIME2-ZEND
+!
+!
+IF ( KTCOUNT == NSTOP .AND. IMI==1) THEN
+ OEXIT=.TRUE.
+END IF
+!
+IF (OEXIT) THEN
+!
+ IF ( .NOT. LIO_NO_WRITE ) THEN
+ IF (LSERIES) CALL WRITE_SERIES_n(TDIAFILE)
+ CALL WRITE_AIRCRAFT_BALLOON(TDIAFILE)
+ CALL WRITE_STATION_n(TDIAFILE)
+ CALL WRITE_PROFILER_n(TDIAFILE)
+ call Write_les_n( tdiafile )
+#ifdef MNH_IOLFI
+ CALL MENU_DIACHRO(TDIAFILE,'END')
+#endif
+ CALL IO_File_close(TDIAFILE)
+ END IF
+ !
+ CALL IO_File_close(TINIFILE)
+ IF (CSURF=="EXTE") CALL IO_File_close(TINIFILEPGD)
+!
+!* 28.1 print statistics!
+!
+ ! Set File Timing OUTPUT
+ !
+ CALL SET_ILUOUT_TIMING(TLUOUT)
+ !
+ ! Compute global time
+ !
+ CALL TIME_STAT_ll(XT_START,ZTOT)
+ !
+ CALL TIME_HEADER_ll(IMI)
+ !
+ CALL TIME_STAT_ll(XT_1WAY,ZTOT, ' ONE WAY','=')
+ CALL TIME_STAT_ll(XT_BOUND,ZTOT, ' BOUNDARIES','=')
+ CALL TIME_STAT_ll(XT_STORE,ZTOT, ' STORE-FIELDS','=')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_SEND,ZTOT, ' W3D_SEND ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_RECV,ZTOT, ' W3D_RECV ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_WRIT,ZTOT, ' W3D_WRIT ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_WAIT,ZTOT, ' W3D_WAIT ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_ALL ,ZTOT, ' W3D_ALL ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT2D_GATH,ZTOT, ' W2D_GATH ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT2D_WRIT,ZTOT, ' W2D_WRIT ','-')
+ CALL TIME_STAT_ll(TIMEZ%T_WRIT2D_ALL ,ZTOT, ' W2D_ALL ','-')
+ CALL TIME_STAT_ll(XT_GUESS,ZTOT, ' INITIAL_GUESS','=')
+ CALL TIME_STAT_ll(XT_2WAY,ZTOT, ' TWO WAY','=')
+ CALL TIME_STAT_ll(XT_ADV,ZTOT, ' ADVECTION MET','=')
+ CALL TIME_STAT_ll(XT_ADVUVW,ZTOT, ' ADVECTION UVW','=')
+ CALL TIME_STAT_ll(XT_GRAV,ZTOT, ' GRAVITY','=')
+ CALL TIME_STAT_ll(XT_FORCING,ZTOT, ' FORCING','=')
+ CALL TIME_STAT_ll(XT_IBM_FORC,ZTOT, ' IBM','=')
+ CALL TIME_STAT_ll(XT_NUDGING,ZTOT, ' NUDGING','=')
+ CALL TIME_STAT_ll(XT_SOURCES,ZTOT, ' DYN_SOURCES','=')
+ CALL TIME_STAT_ll(XT_DIFF,ZTOT, ' NUM_DIFF','=')
+ CALL TIME_STAT_ll(XT_RELAX,ZTOT, ' RELAXATION','=')
+ !
+ CALL TIMING_LEGEND()
+ !
+ CALL TIME_STAT_ll(XT_PARAM,ZTOT, ' PHYS_PARAM','=')
+ CALL TIME_STAT_ll(XT_RAD,ZTOT, ' RAD = '//CRAD ,'-')
+ CALL TIME_STAT_ll(XT_SHADOWS,ZTOT, ' SHADOWS' ,'-')
+ CALL TIME_STAT_ll(XT_DCONV,ZTOT, ' DEEP CONV = '//CDCONV,'-')
+ CALL TIME_STAT_ll(XT_GROUND,ZTOT, ' GROUND' ,'-')
+ CALL TIME_STAT_ll(XT_TURB,ZTOT, ' TURB = '//CTURB ,'-')
+ CALL TIME_STAT_ll(XT_MAFL,ZTOT, ' MAFL = '//CSCONV,'-')
+ CALL TIME_STAT_ll(XT_CHEM,ZTOT, ' CHIMIE' ,'-')
+ CALL TIME_STAT_ll(XT_EOL,ZTOT, ' WIND TURBINE' ,'-')
+ CALL TIMING_LEGEND()
+ CALL TIME_STAT_ll(XT_COUPL,ZTOT, ' SET_COUPLING','=')
+ CALL TIME_STAT_ll(XT_RAD_BOUND,ZTOT, ' RAD_BOUND','=')
+ !
+ CALL TIMING_LEGEND()
+ !
+ CALL TIME_STAT_ll(XT_PRESS,ZTOT, ' PRESSURE ','=','F')
+ !JUAN Z_SPLITTING
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_B_SX_YP2_ZP1,ZTOT, ' REMAP B=>FFTXZ' ,'-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_SX_YP2_ZP1_SXP2_Y_ZP1,ZTOT, ' REMAP FFTXZ=>FFTYZ' ,'-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_SXP2_Y_ZP1_B,ZTOT, ' REMAP FTTYZ=>B' ,'-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_SXP2_Y_ZP1_SXP2_YP1_Z,ZTOT, ' REMAP FFTYZ=>SUBZ' ,'-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_B_SXP2_Y_ZP1,ZTOT, ' REMAP B=>FFTYZ-1','-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_SXP2_YP1_Z_SXP2_Y_ZP1,ZTOT, ' REMAP SUBZ=>FFTYZ-1','-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_SXP2_Y_ZP1_SX_YP2_ZP1,ZTOT, ' REMAP FFTYZ-1=>FFTXZ-1','-','F')
+ CALL TIME_STAT_ll(TIMEZ%T_MAP_SX_YP2_ZP1_B,ZTOT, ' REMAP FFTXZ-1=>B ' ,'-','F')
+ ! JUAN P1/P2
+ CALL TIME_STAT_ll(XT_CLOUD,ZTOT, ' RESOLVED_CLOUD','=')
+ CALL TIME_STAT_ll(XT_ELEC,ZTOT, ' RESOLVED_ELEC','=')
+ CALL TIME_STAT_ll(XT_HALO,ZTOT, ' EXCHANGE_HALO','=')
+ CALL TIME_STAT_ll(XT_STEP_SWA,ZTOT, ' ENDSTEP','=')
+ CALL TIME_STAT_ll(XT_STEP_BUD,ZTOT, ' BUDGETS','=')
+ CALL TIME_STAT_ll(XT_SPECTRA,ZTOT, ' LES','=')
+ CALL TIME_STAT_ll(XT_STEP_MISC,ZTOT, ' MISCELLANEOUS','=')
+ IF (LIBM) CALL TIME_STAT_ll(XT_IBM_FORC,ZTOT,' IBM FORCING','=')
+ !
+ ! sum of call subroutine
+ !
+ ZALL = XT_1WAY + XT_BOUND + XT_STORE + XT_GUESS + XT_2WAY + &
+ XT_ADV + XT_FORCING + XT_NUDGING + XT_SOURCES + XT_DIFF + &
+ XT_ADVUVW + XT_GRAV + XT_IBM_FORC + &
+ XT_RELAX+ XT_PARAM + XT_COUPL + XT_RAD_BOUND+XT_PRESS + &
+ XT_CLOUD+ XT_ELEC + XT_HALO + XT_SPECTRA + XT_STEP_SWA + &
+ XT_STEP_MISC+ XT_STEP_BUD
+ CALL TIME_STAT_ll(ZALL,ZTOT, ' SUM(CALL)','=')
+ CALL TIMING_SEPARATOR('=')
+ !
+ ! Gobale Stat
+ !
+ WRITE(ILUOUT,FMT=*)
+ WRITE(ILUOUT,FMT=*)
+ CALL TIMING_LEGEND()
+ !
+ ! MODELN all included
+ !
+ CALL TIMING_SEPARATOR('+')
+ CALL TIMING_SEPARATOR('+')
+ WRITE(YMI,FMT="(I0)") IMI
+ CALL TIME_STAT_ll(XT_START,ZTOT, ' MODEL'//YMI,'+')
+ CALL TIMING_SEPARATOR('+')
+ CALL TIMING_SEPARATOR('+')
+ CALL TIMING_SEPARATOR('+')
+ !
+ ! Timing/ Steps
+ !
+ ZTIME_STEP = XT_START / REAL(KTCOUNT)
+ WRITE(YTCOUNT,FMT="(I0)") KTCOUNT
+ CALL TIME_STAT_ll(ZTIME_STEP,ZTOT, ' SECOND/STEP='//YTCOUNT,'=')
+ !
+ ! Timing/Step/Points
+ !
+ IPOINTS = NIMAX_ll*NJMAX_ll*NKMAX
+ WRITE(YPOINTS,FMT="(I0)") IPOINTS
+ ZTIME_STEP_PTS = ZTIME_STEP / REAL(IPOINTS) * 1e6
+ CALL TIME_STAT_ll(ZTIME_STEP_PTS,ZTOT_PT)
+ CALL TIME_STAT_ll(ZTIME_STEP_PTS,ZTOT_PT, ' MICROSEC/STP/PT='//YPOINTS,'-')
+ !
+ CALL TIMING_SEPARATOR('=')
+ !
+END IF
+!
+END SUBROUTINE MODEL_n
diff --git a/src/ICCARE_BASE/modn_param_lima.f90 b/src/ICCARE_BASE/modn_param_lima.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c42f00675961d7b8b2c4f8d4ee7890074bfd4042
--- /dev/null
+++ b/src/ICCARE_BASE/modn_param_lima.f90
@@ -0,0 +1,36 @@
+!MNH_LIC Copyright 2001-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
+! ######################
+ MODULE 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, &
+ LCIBU, XNDEBRIS_CIBU, LRDSF, &
+ LWARM, LACTI, LRAIN, LSEDC, LACTIT, LBOUND, LSPRO, &
+ LADJ, &
+ 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, LDEPOC, XVDEPOC, LACTTKE, &
+ LPTSPLIT, LFEEDBACKT, NMAXITER, XMRSTEP, XTSTEP_TS
+!
+END MODULE MODN_PARAM_LIMA
diff --git a/src/ICCARE_BASE/rain_ice_elec.f90 b/src/ICCARE_BASE/rain_ice_elec.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a73a0250c1a30784fa9c5f579a6be6a9946e0073
--- /dev/null
+++ b/src/ICCARE_BASE/rain_ice_elec.f90
@@ -0,0 +1,5850 @@
+!MNH_LIC Copyright 2002-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #########################
+ MODULE MODI_RAIN_ICE_ELEC
+! #########################
+!
+INTERFACE
+ SUBROUTINE RAIN_ICE_ELEC (OSEDIC, HSUBG_AUCV, OWARM, &
+ KSPLITR, PTSTEP, KMI, KRR, &
+ PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
+ PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
+ PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRS, PINPRG, PSIGS, &
+ PQPIT, PQCT, PQRT, PQIT, PQST, PQGT, PQNIT, &
+ PQPIS, PQCS, PQRS, PQIS, PQSS, PQGS, PQNIS, &
+ PSEA, PTOWN, &
+ PRHT, PRHS, PINPRH, PQHT, PQHS )
+!
+!
+LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV
+ ! Kind of Subgrid autoconversion method
+LOGICAL, INTENT(IN) :: OWARM ! .TRUE. allows raindrops to
+ ! form by warm processes
+ ! (Kessler scheme)
+!
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! integration for rain sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KMI ! Model index
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+!
+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 ! absolute pressure at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Cloud fraction
+!
+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 ! Pristine ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s 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) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. 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
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
+!
+! Charge Mixing Ratio (CMR) (C/kg)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQPIT ! Positive ion (Nb/kg) at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQNIT ! Negative ion (Nb/kg) at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQCT ! Cloud water CMR at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQRT ! Rain water CMR at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQIT ! Pristine ice CMR at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQST ! Snow/aggregate CMR at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQGT ! Graupel CMR at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQPIS ! Positive ion source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQNIS ! Negative ion source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQCS ! Cloud water CMR source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQRS ! Rain water CMR source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQIS ! Pristine ice CMR source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQSS ! Snow/aggregate CMR source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQGS ! Graupel CMR source
+!
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PQHT ! Hail CMR at t
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PQHS ! Hail CMR source
+!
+END SUBROUTINE RAIN_ICE_ELEC
+END INTERFACE
+END MODULE MODI_RAIN_ICE_ELEC
+!
+! ######spl
+ SUBROUTINE RAIN_ICE_ELEC (OSEDIC, HSUBG_AUCV, OWARM, &
+ KSPLITR, PTSTEP, KMI, KRR, &
+ PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
+ PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
+ PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRS, PINPRG, PSIGS, &
+ PQPIT, PQCT, PQRT, PQIT, PQST, PQGT, PQNIT, &
+ PQPIS, PQCS, PQRS, PQIS, PQSS, PQGS, PQNIS, &
+ PSEA, PTOWN, &
+ PRHT, PRHS, PINPRH, PQHT, PQHS )
+! ######################################################################
+!
+!!**** * - compute the explicit microphysical sources
+!! and the cloud electrification
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the slow microphysical sources
+!! which can be computed explicitly
+!!
+!!
+!!** METHOD
+!! ------
+!! The autoconversion computation follows Kessler (1969).
+!! The sedimentation rate is computed with a time spliting technique and
+!! an upstream scheme, written as a difference of non-advective fluxes. This
+!! source term is added to the future instant ( split-implicit process ).
+!! The others microphysical processes are evaluated at the central instant
+!! (split-explicit process ): autoconversion, accretion and rain evaporation.
+!! These last 3 terms are bounded in order not to create negative values
+!! for the water species at the future instant.
+!!
+!! 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
+!! Module MODD_CST
+!! XP00 ! Reference pressure
+!! XRD,XRV ! Gaz constant for dry air, vapor
+!! XMD,XMV ! Molecular weight for dry air, vapor
+!! XCPD ! Cpd (dry air)
+!! XCL ! Cl (liquid)
+!! XCI ! Ci (solid)
+!! XTT ! Triple point temperature
+!! XLVTT ! Vaporization heat constant
+!! XALPW,XBETAW,XGAMW ! Constants for saturation vapor pressure
+!! function over liquid water
+!! XALPI,XBETAI,XGAMI ! Constants for saturation vapor pressure
+!! function over solid ice
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!!
+!! AUTHOR
+!! ------
+!! C. Barthe, G. Molinie, J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 2002
+!! Modifications
+!! C. Barthe (LACy) Nov. 2009 : update to V4.8.1
+!! M. Chong 26/01/10 Add Small ions parameters
+!! J-P Pinty 31/03/11 Add hail
+!! C. Lac 2011 : Adaptation to FIT temporal scheme
+!! B. Tsenova June 2012 Add new NI parameterizations
+!! C. Barthe June 2012 Dependance of RAR on the RELATIVE terminal velocity
+!! M. Chong 06/08/13 Add "Beard" effect (ELEC=>MICROPHYSICS)
+!! J-P Pinty 21/08/13 Correction of the process limitation algo.
+!! SIGN(MIN(ABS ...
+!! Correction in elec_update_qd
+!! Correction of hail charge transfer
+!! Add hail growth charging processes
+!! J-P Pinty 26/08/13 Add "Beard" effect control (ELEC=>MICROPHYS)
+!! for sedimentation
+!! J-P Pinty 26/09/13 Add tabulated treatment of SAUN1 and SAUN2
+!! J-P Pinty 30/09/13 Remove call to MOMG function
+!! J-P Pinty 25/10/13 Add "Latham" effect for aggregation process
+!! M. Chong 31/10/13 Add other tabulated treatment and recode
+!! M. Chong 15/11/13 Bug in the computation of RGWETH (wrong sign)
+!! J-P Pinty 25/04/14 Many bugs with ZWQ1(:,...) = 0.0
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! J.Escobar : 10/2017 : for real*4 , limit exp() in RAIN_ICE_ELEC_SLOW with XMNH_HUGE_12_LOG
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
+! P .Wautelet 09/03/2020: add missing budgets for electricity
+! C. Barthe 07/04/2022: correction of budget for CMEL
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbu_enable, &
+ lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, &
+ lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, &
+ NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ tbudgets
+USE MODD_CONF
+USE MODD_CST
+USE MODD_ELEC_DESCR
+USE MODD_ELEC_n
+USE MODD_ELEC_PARAM
+USE MODD_LES
+USE MODE_ll
+USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELECEND ! Scalar variables for budgets
+USE MODD_PARAMETERS
+USE MODD_PARAM_ICE
+USE MODD_RAIN_ICE_DESCR
+USE MODD_RAIN_ICE_PARAM
+USE MODD_REF, ONLY: XTHVREFZ
+
+use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
+#ifdef MNH_PGI
+USE MODE_PACK_PGI
+#endif
+use mode_tools, only: Countjv
+
+USE MODI_MOMG
+
+IMPLICIT NONE
+!
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV
+ ! Kind of Subgrid autoconversion method
+LOGICAL, INTENT(IN) :: OWARM ! .TRUE. allows raindrops to
+ ! form by warm processes
+ ! (Kessler scheme)
+!
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! integration for rain sedimendation
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KMI ! Model index
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+!
+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 ! absolute pressure at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR! Convective Mass Flux Cloud fraction
+!
+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 ! Pristine ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s 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) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. 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
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
+!
+! Charge Mixing Ratio (CMR) (C/kg)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQPIT ! Positive ion (Nb/kg) at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQNIT ! Negative ion (Nb/kg) at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQCT ! Cloud water CMR at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQRT ! Rain water CMR at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQIT ! Pristine ice CMR at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQST ! Snow/aggregate CMR at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQGT ! Graupel CMR at t
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQPIS ! Positive ion source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQNIS ! Negative ion source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQCS ! Cloud water CMR source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQRS ! Rain water CMR source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQIS ! Pristine ice CMR source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQSS ! Snow/aggregate CMR source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQGS ! Graupel CMR source
+!
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PQHT ! Hail CMR at t
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PQHS ! Hail CMR source
+!
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: JK ! Vertical loop index for the rain sedimentation
+INTEGER :: JN ! Temporal loop index for the rain sedimentation
+INTEGER :: JJ ! Loop index for the interpolation
+INTEGER :: JI ! Loop index for the interpolation
+INTEGER :: IIB ! Define the domain where is
+INTEGER :: IIE ! the microphysical sources have to be computed
+INTEGER :: IJB !
+INTEGER :: IJE !
+INTEGER :: IKB !
+INTEGER :: IKE !
+!
+REAL :: ZTSPLITR ! Small time step for rain sedimentation
+!
+!
+INTEGER :: ISEDIMR,ISEDIMC, ISEDIMI, ISEDIMS, ISEDIMG, ISEDIMH, &
+ INEGT, IMICRO ! Case number of sedimentation, T>0 (for HEN)
+ ! and r_x>0 locations
+INTEGER :: IGRIM, IGACC, IGDRY ! Case number of riming, accretion and dry growth
+ ! locations
+INTEGER :: IGWET, IHAIL ! wet growth locations and case number
+!
+LOGICAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: GSEDIMR, GSEDIMC, GSEDIMI, GSEDIMS, GSEDIMG, GSEDIMH ! Test where to compute the SED processes
+LOGICAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: GNEGT ! Test where to compute the HEN process
+LOGICAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: GMICRO ! Test where to compute all processes
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GRIM ! Test where to compute riming
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GACC ! Test where to compute accretion
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GDRY ! Test where to compute dry growth
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GWET ! Test where to compute wet growth
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GHAIL ! Test where to compute hail growth
+!
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1,IVEC2 ! Vectors of indices for
+ ! interpolations
+REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors for
+ ! interpolations
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: ZW ! work array
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: ZPRCS, ZPRRS, ZPRSS, ZPRGS, ZPRHS ! Mixing ratios created during the time step
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: ZWSED ! sedimentation fluxes
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: ZWSEDW1 ! sedimentation speed
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: ZWSEDW2 ! sedimentation speed
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2)) &
+ :: ZCONC_TMP ! Weighted concentration
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: ZT ! Temperature
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: &
+ ZRAY, & ! Cloud Mean radius
+ ZLBC, & ! XLBC weighted by sea fraction
+ ZFSEDC
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: ZPQRS, ZPQSS, ZPQGS, ZPQHS ! Charge Mixing ratios created during the time step
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: ZWSEDQ ! sedimentation fluxes for charge
+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 :: 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 :: ZCRIAUTI ! Snow-to-ice autoconversion thres.
+!
+REAL, DIMENSION(:), ALLOCATABLE &
+ :: ZRHODREF, & ! RHO Dry REFerence
+ ZRHODREFC,& ! RHO Dry REFerence
+ ZRHODREFR,& ! RHO Dry REFerence
+ ZRHODREFI,& ! RHO Dry REFerence
+ ZRHODREFS,& ! RHO Dry REFerence
+ ZRHODREFG,& ! RHO Dry REFerence
+ ZRHODREFH,& ! 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)
+ ZUSW, & ! Undersaturation over water
+ ZSSI, & ! Supersaturation over ice
+ ZLBDAI, & ! Slope parameter of the pristine ice distribution
+ ZLBDAR, & ! Slope parameter of the raindrop distribution
+ ZLBDAS, & ! Slope parameter of the aggregate distribution
+ ZLBDAG, & ! Slope parameter of the graupel distribution
+ ZLBDAH, & ! Slope parameter of the hail distribution
+ ZRDRYG, & ! Dry growth rate of the graupeln
+ ZRWETG, & ! Wet growth rate of the graupeln
+ ZAI, & ! Thermodynamical function
+ ZCJ, & ! Function to compute the ventilation coefficient
+ ZKA, & ! Thermal conductivity of the air
+ ZDV, & ! Diffusivity of water vapor in the air
+ ZSIGMA_RC,& ! Standard deviation of rc at time t
+ ZCF, & ! Cloud fraction
+ ZCC, & ! terminal velocity
+ ZFSEDC1D, & ! For cloud sedimentation
+ ZWLBDC, & ! Slope parameter of the droplet distribution
+ ZCONC, & ! Concentration des aérosols
+ ZRAY1D, & ! Mean radius
+ ZWLBDA ! Libre parcours moyen
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZZW1 ! Work arrays
+REAL :: ZTIMAUTIC
+REAL, DIMENSION(SIZE(XRTMIN)) :: ZRTMIN
+!
+INTEGER , DIMENSION(SIZE(GMICRO)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+!
+LOGICAL, DIMENSION(:,:),ALLOCATABLE :: GELEC ! Logical of work for elec
+REAL, DIMENSION(:), ALLOCATABLE :: ZRSMIN_ELEC ! Limit value of ZRXS where charge is available
+REAL, DIMENSION(:), ALLOCATABLE :: ZVECQ4, & ! Work
+ ZVECQ5, & ! vectors for
+ ZVECQ6, & ! interpolations
+ ZVECQ7 ! (electrification)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZWQ1 ! Work array for electrification
+REAL, DIMENSION(:), ALLOCATABLE :: ZWQ3,ZWQ4 ! Work arrays for electrification
+
+REAL, DIMENSION(:), ALLOCATABLE :: ZQPIT ! Positive ion (kg^-1) at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZQNIT ! Negative ion (kg^-1) at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZQCT ! Cloud water CMR at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZQRT ! Rain water m.r. at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZQIT ! Pristine ice CMR at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZQST ! Snow/aggregate CMR at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZQGT ! Graupel CMR at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZQHT ! Hail CMR at t
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZQPIS ! Positive ion source
+REAL, DIMENSION(:), ALLOCATABLE :: ZQNIS ! Negative ion source
+REAL, DIMENSION(:), ALLOCATABLE :: ZQCS ! Cloud water CMR source
+REAL, DIMENSION(:), ALLOCATABLE :: ZQRS ! Rain water CMR source
+REAL, DIMENSION(:), ALLOCATABLE :: ZQIS ! Pristine ice CMR source
+REAL, DIMENSION(:), ALLOCATABLE :: ZQSS ! Snow/aggregate CMR source
+REAL, DIMENSION(:), ALLOCATABLE :: ZQGS ! Graupel CMR source
+REAL, DIMENSION(:), ALLOCATABLE :: ZQHS ! Hail CMR source
+!
+! Charge diameter relation
+REAL, DIMENSION(:), ALLOCATABLE :: ZECT ! Cloud water at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZERT ! Rain water at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZEIT ! Pristine ice at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZEST ! Snow/aggregate at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZEGT ! Graupel at t
+REAL, DIMENSION(:), ALLOCATABLE :: ZEHT ! Hail at t
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZECS ! Cloud water at t+dt
+REAL, DIMENSION(:), ALLOCATABLE :: ZERS ! Rain water at t+dt
+REAL, DIMENSION(:), ALLOCATABLE :: ZEIS ! Pristine ice at t+dt
+REAL, DIMENSION(:), ALLOCATABLE :: ZESS ! Snow/aggregate at t+dt
+REAL, DIMENSION(:), ALLOCATABLE :: ZEGS ! Graupel at t+dt
+REAL, DIMENSION(:), ALLOCATABLE :: ZEHS ! Hail at t+dt
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZDELTALWC ! Gap between LWC and a critical LWC
+REAL, DIMENSION(:), ALLOCATABLE :: ZLWCC ! Critical LWC in NI charging
+REAL, DIMENSION(:), ALLOCATABLE :: ZFT ! Fct depending on temperature
+!
+! Non-inductive charging process following Saunders et al. (1991) / EW
+REAL, DIMENSION(:), ALLOCATABLE :: ZEW ! Effective liquid water content
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSK ! constant B _______________________
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIM ! d_i exponent ____________________
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIN ! v_g/s-v_i________________________
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSM ! d_s exponent ____________________
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSN ! v_g-v_s _________________________
+REAL, DIMENSION(:), ALLOCATABLE :: ZFQIAGGS, ZFQIDRYGBS
+REAL, DIMENSION(:), ALLOCATABLE :: ZLBQSDRYGB1S, ZLBQSDRYGB2S, ZLBQSDRYGB3S
+!
+! Non-inductive charging process following Saunders and Peck (1998) / RAR
+REAL, DIMENSION(:), ALLOCATABLE :: ZVGMEAN ! Mean velocity of graupel
+REAL, DIMENSION(:), ALLOCATABLE :: ZVSMEAN ! Mean velocity of snow
+REAL, DIMENSION(:), ALLOCATABLE :: ZRHOCOR ! Density correction for fallspeed
+REAL, DIMENSION(:), ALLOCATABLE :: ZRAR ! Rime accretion rate
+REAL, DIMENSION(:), ALLOCATABLE :: ZRAR_CRIT ! Critical RAR
+REAL, DIMENSION(:), ALLOCATABLE :: ZDQRAR_IS ! q= f(RAR,T) in Saunders and Peck's equation
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIM_IS ! d_i exponent ____________________
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIN_IS ! v_g/s-v_i________________________
+REAL, DIMENSION(:), ALLOCATABLE :: ZDQRAR_IG ! q= f(RAR,T) in Saunders and Peck's equation
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIM_IG ! d_i exponent ____________________
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIN_IG ! v_g/s-v_i________________________
+REAL, DIMENSION(:), ALLOCATABLE :: ZDQRAR_SG ! q= f(RAR,T) in Saunders and Peck's equation
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSK_SG ! constant B _______________________
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSM_SG ! d_s exponent ____________________
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSN_SG ! v_g-v_s _________________________
+!
+! Non-inductive charging process following Takahashi (1978)
+INTEGER :: IGTAKA ! Case number of charge separation for Takahashi param.
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GTAKA ! Test where to compute charge
+ ! separation for Takahashi param.
+REAL, DIMENSION(:), ALLOCATABLE :: ZDQTAKA_OPT ! Optimized array of separated charge
+!
+INTEGER :: IGSAUN ! Case number of charge separation for Saunders param.
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GSAUN ! Test where to compute charge
+ ! separation for Saunders param.
+REAL, DIMENSION(:), ALLOCATABLE :: ZDQLWC_OPT ! Optimized array of separated charge
+REAL, DIMENSION(:), ALLOCATABLE :: ZDQLWC ! q=f(LWC,T)
+!
+! Inductive charging process (Ziegler et al., 1991)
+INTEGER :: IIND ! Case number of inductive process
+LOGICAL, DIMENSION(:), ALLOCATABLE :: GIND ! Test where to compute inductive process
+REAL, DIMENSION(:), ALLOCATABLE :: ZRATE_IND ! Charge transfer rate during inductive process
+REAL, DIMENSION(:), ALLOCATABLE :: ZEFIELDW ! Vertical component of the electric field
+!
+! Latham's effect
+REAL, DIMENSION(:), ALLOCATABLE :: ZLATHAMIAGGS ! E Function to simulate
+ ! enhancement of IAGGS
+REAL, DIMENSION(:), ALLOCATABLE :: ZEFIELDU ! Horiz. component of the electric field
+REAL, DIMENSION(:), ALLOCATABLE :: ZEFIELDV ! Horiz. component of the electric field
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZLIMIT, ZAUX, ZAUX1
+REAL, DIMENSION(:), ALLOCATABLE :: ZCOLIS ! Collection efficiency between ice and snow
+REAL, DIMENSION(:), ALLOCATABLE :: ZCOLIG ! Collection efficiency between ice and graupeln
+REAL, DIMENSION(:), ALLOCATABLE :: ZCOLSG ! Collection efficiency between snow and graupeln
+REAL :: ZRHO00, ZCOR00 ! Surface reference air density
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE LOOP BOUNDS
+! -----------------------
+!
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB = 1 + JPVEXT
+IKE = SIZE(PZZ,3) - JPVEXT
+!
+ZRHO00 = XP00 / (XRD * XTHVREFZ(IKB))
+ZCOR00 = ZRHO00**XCEXVT
+!
+!
+!* 2. COMPUTES THE SLOW COLD PROCESS SOURCES
+! --------------------------------------
+!
+!* 2.1 compute the ice nucleation
+!
+CALL RAIN_ICE_ELEC_NUCLEATION
+!
+!
+!* 2.2 allocations
+!
+! optimization by looking for locations where
+! the microphysical fields are larger than a minimal value only !!!
+!
+GMICRO(:,:,:) = .FALSE.
+
+IF ( KRR == 7 ) THEN
+ 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)
+ELSE IF( KRR == 6 ) THEN
+ 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)
+END IF
+
+IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
+!
+IF (IMICRO > 0) THEN
+ ALLOCATE(ZRVT(IMICRO))
+ ALLOCATE(ZRCT(IMICRO))
+ ALLOCATE(ZRRT(IMICRO))
+ ALLOCATE(ZRIT(IMICRO))
+ ALLOCATE(ZRST(IMICRO))
+ ALLOCATE(ZRGT(IMICRO))
+ IF (KRR == 7) ALLOCATE(ZRHT(IMICRO))
+ ALLOCATE(ZCIT(IMICRO))
+ ALLOCATE(ZRVS(IMICRO))
+ ALLOCATE(ZRCS(IMICRO))
+ ALLOCATE(ZRRS(IMICRO))
+ ALLOCATE(ZRIS(IMICRO))
+ ALLOCATE(ZRSS(IMICRO))
+ ALLOCATE(ZRGS(IMICRO))
+ IF (KRR == 7) ALLOCATE(ZRHS(IMICRO))
+ ALLOCATE(ZTHS(IMICRO))
+ ALLOCATE(ZRHODREF(IMICRO))
+ ALLOCATE(ZZT(IMICRO))
+ ALLOCATE(ZPRES(IMICRO))
+ ALLOCATE(ZEXNREF(IMICRO))
+ ALLOCATE(ZSIGMA_RC(IMICRO))
+ ALLOCATE(ZCF(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))
+ IF (KRR == 7) ZRHT(JL) = PRHT(I1(JL),I2(JL),I3(JL))
+ ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
+ IF (HSUBG_AUCV == 'SIGM') THEN
+ ZSIGMA_RC(JL) = PSIGS(I1(JL),I2(JL),I3(JL)) * 2.
+ ELSE IF (HSUBG_AUCV == 'CLFR') THEN
+ ZCF(JL) = PCLDFR(I1(JL),I2(JL),I3(JL))
+ END IF
+!
+ 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))
+ IF (KRR == 7) ZRHS(JL) = PRHS(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) = PPABST(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ ENDDO
+!
+ ALLOCATE(ZRHOCOR(IMICRO))
+ ZRHOCOR(:) = (ZRHO00 / ZRHODREF(:))**XCEXVT
+!
+ ALLOCATE(ZZW(IMICRO))
+ ALLOCATE(ZLSFACT(IMICRO))
+ ALLOCATE(ZLVFACT(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)
+!
+ ALLOCATE(ZUSW(IMICRO))
+ ALLOCATE(ZSSI(IMICRO))
+!
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) )
+ ZSSI(:) = ZRVT(:)*( ZPRES(:)-ZZW(:) ) / ( (XMV/XMD) * ZZW(:) ) - 1.0
+ ! Supersaturation over ice
+!
+ IF (KRR == 7) THEN
+ ALLOCATE(ZRSMIN_ELEC(7))
+ ELSE
+ ALLOCATE(ZRSMIN_ELEC(6))
+ END IF
+ ZRSMIN_ELEC(:) = XRTMIN_ELEC(:) / PTSTEP
+!
+ ALLOCATE(ZLBDAR(IMICRO))
+ ALLOCATE(ZLBDAS(IMICRO))
+ ALLOCATE(ZLBDAG(IMICRO))
+ IF (KRR == 7) ALLOCATE(ZLBDAH(IMICRO))
+ ALLOCATE(ZRDRYG(IMICRO))
+ ALLOCATE(ZRWETG(IMICRO))
+ ALLOCATE(ZAI(IMICRO))
+ ALLOCATE(ZCJ(IMICRO))
+ ALLOCATE(ZKA(IMICRO))
+ ALLOCATE(ZDV(IMICRO))
+!
+ IF (KRR == 7) THEN
+ ALLOCATE(ZZW1(IMICRO,7))
+ ELSE IF(KRR == 6) THEN
+ ALLOCATE(ZZW1(IMICRO,6))
+ ENDIF
+!
+ IF (LBU_ENABLE .OR. LLES_CALL) THEN
+ ALLOCATE(ZRHODJ(IMICRO))
+ DO JL=1,IMICRO
+ ZRHODJ(JL) = PRHODJ(I1(JL),I2(JL),I3(JL))
+ END DO
+ END IF
+!
+ ALLOCATE( ZECT(IMICRO) )
+ ALLOCATE( ZERT(IMICRO) )
+ ALLOCATE( ZEIT(IMICRO) )
+ ALLOCATE( ZEST(IMICRO) )
+ ALLOCATE( ZEGT(IMICRO) )
+ IF ( KRR == 7 ) ALLOCATE(ZEHT(IMICRO))
+ ALLOCATE( ZECS(IMICRO) )
+ ALLOCATE( ZERS(IMICRO) )
+ ALLOCATE( ZEIS(IMICRO) )
+ ALLOCATE( ZESS(IMICRO) )
+ ALLOCATE( ZEGS(IMICRO) )
+ IF ( KRR == 7 ) ALLOCATE(ZEHS(IMICRO))
+ ALLOCATE( ZQPIT(IMICRO) )
+ ALLOCATE( ZQNIT(IMICRO) )
+ ALLOCATE( ZQCT(IMICRO) )
+ ALLOCATE( ZQRT(IMICRO) )
+ ALLOCATE( ZQIT(IMICRO) )
+ ALLOCATE( ZQST(IMICRO) )
+ ALLOCATE( ZQGT(IMICRO) )
+ IF ( KRR == 7 ) ALLOCATE(ZQHT(IMICRO))
+ ALLOCATE( ZQPIS(IMICRO) )
+ ALLOCATE( ZQNIS(IMICRO) )
+ ALLOCATE( ZQCS(IMICRO) )
+ ALLOCATE( ZQRS(IMICRO) )
+ ALLOCATE( ZQIS(IMICRO) )
+ ALLOCATE( ZQSS(IMICRO) )
+ ALLOCATE( ZQGS(IMICRO) )
+ IF ( KRR == 7 ) ALLOCATE(ZQHS(IMICRO))
+!
+ IF (CNI_CHARGING == 'GARDI') THEN
+ ALLOCATE( ZDELTALWC(IMICRO) )
+ ALLOCATE( ZFT(IMICRO) )
+ END IF
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'TAKAH' .OR. &
+ CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2' .OR. &
+ CNI_CHARGING == 'TEEWC' .OR. CNI_CHARGING == 'TERAR') THEN
+ ALLOCATE( ZEW(IMICRO) )
+ END IF
+
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2') THEN
+ ALLOCATE( ZLWCC(IMICRO) )
+ END IF
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'TAKAH' .OR. CNI_CHARGING == 'TEEWC') THEN
+ ALLOCATE( ZDQLWC(IMICRO) )
+ END IF
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'TEEWC' ) THEN
+ ALLOCATE( ZSAUNSK(IMICRO) )
+ ALLOCATE( ZSAUNIM(IMICRO) )
+ ALLOCATE( ZSAUNIN(IMICRO) )
+ ALLOCATE( ZSAUNSM(IMICRO) )
+ ALLOCATE( ZSAUNSN(IMICRO) )
+ END IF
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'SAP98' .OR. &
+ CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2' .OR. &
+ CNI_CHARGING == 'TEEWC' .OR. CNI_CHARGING == 'TERAR') THEN
+ ALLOCATE( ZFQIAGGS(IMICRO) )
+ ALLOCATE( ZFQIDRYGBS(IMICRO) )
+ ALLOCATE( ZLBQSDRYGB1S(IMICRO) )
+ ALLOCATE( ZLBQSDRYGB2S(IMICRO) )
+ ALLOCATE( ZLBQSDRYGB3S(IMICRO) )
+ END IF
+!
+ IF (CNI_CHARGING == 'SAP98' .OR. &
+ CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2') THEN
+ ALLOCATE( ZRAR_CRIT(IMICRO) )
+ END IF
+!
+ IF (CNI_CHARGING == 'SAP98' .OR. CNI_CHARGING == 'TERAR' .OR. &
+ CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2') THEN
+ ALLOCATE( ZVGMEAN(IMICRO) )
+ ALLOCATE( ZVSMEAN(IMICRO) )
+ ALLOCATE( ZRAR(IMICRO) )
+ ALLOCATE( ZDQRAR_IS(IMICRO) )
+ ALLOCATE( ZDQRAR_IG(IMICRO) )
+ ALLOCATE( ZDQRAR_SG(IMICRO) )
+ ALLOCATE( ZSAUNIM_IS(IMICRO) )
+ ALLOCATE( ZSAUNIN_IS(IMICRO) )
+ ALLOCATE( ZSAUNIM_IG(IMICRO) )
+ ALLOCATE( ZSAUNIN_IG(IMICRO) )
+ ALLOCATE( ZSAUNSK_SG(IMICRO) )
+ ALLOCATE( ZSAUNSM_SG(IMICRO) )
+ ALLOCATE( ZSAUNSN_SG(IMICRO) )
+ END IF
+!
+ IF (CNI_CHARGING == 'TAKAH' .OR. CNI_CHARGING == 'SAP98' .OR. &
+ CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'GARDI' .OR. CNI_CHARGING == 'BSMP1' .OR. &
+ CNI_CHARGING == 'BSMP2' .OR. CNI_CHARGING == 'TEEWC' .OR. &
+ CNI_CHARGING == 'TERAR') THEN
+ ALLOCATE( ZAUX1(IMICRO) )
+ ALLOCATE( ZLIMIT(IMICRO) )
+ END IF
+!
+ IF (LINDUCTIVE) THEN
+ ALLOCATE( ZEFIELDW(IMICRO) )
+ ALLOCATE( ZRATE_IND(IMICRO) )
+ ALLOCATE( GIND(IMICRO) )
+ END IF
+!
+ IF (LIAGGS_LATHAM) THEN
+ ALLOCATE( ZEFIELDU(IMICRO) )
+ ALLOCATE( ZEFIELDV(IMICRO) )
+ IF (.NOT.ALLOCATED(ZEFIELDW)) ALLOCATE( ZEFIELDW(IMICRO) )
+ END IF
+ ALLOCATE( ZLATHAMIAGGS(IMICRO) )
+!
+ ALLOCATE( ZWQ1(IMICRO,10) )
+ ALLOCATE( ZWQ3(IMICRO) )
+ ALLOCATE( ZWQ4(IMICRO) )
+ ALLOCATE( ZCOLIS(IMICRO) )
+ ALLOCATE( ZCOLIG(IMICRO) )
+ ALLOCATE( ZCOLSG(IMICRO) )
+ ALLOCATE( GELEC(IMICRO,4) )
+ GELEC(:,:) = .FALSE.
+!
+ DO JL = 1, IMICRO
+ IF (LINDUCTIVE) ZEFIELDW(JL) = XEFIELDW(I1(JL), I2(JL), I3(JL))
+ IF (LIAGGS_LATHAM) THEN
+ ZEFIELDU(JL) = XEFIELDU(I1(JL), I2(JL), I3(JL))
+ ZEFIELDV(JL) = XEFIELDV(I1(JL), I2(JL), I3(JL))
+ IF (.NOT.LINDUCTIVE ) ZEFIELDW(JL) = XEFIELDW(I1(JL), I2(JL), I3(JL))
+ END IF
+!
+ ZQPIT(JL) = PQPIT(I1(JL), I2(JL), I3(JL))
+ ZQNIT(JL) = PQNIT(I1(JL), I2(JL), I3(JL))
+ ZQCT(JL) = PQCT(I1(JL), I2(JL), I3(JL))
+ ZQRT(JL) = PQRT(I1(JL), I2(JL), I3(JL))
+ ZQIT(JL) = PQIT(I1(JL), I2(JL), I3(JL))
+ ZQST(JL) = PQST(I1(JL), I2(JL), I3(JL))
+ ZQGT(JL) = PQGT(I1(JL), I2(JL), I3(JL))
+ IF (KRR == 7) ZQHT(JL) = PQHT(I1(JL), I2(JL), I3(JL))
+!
+ ZQPIS(JL) = PQPIS(I1(JL), I2(JL), I3(JL))
+ ZQNIS(JL) = PQNIS(I1(JL), I2(JL), I3(JL))
+ ZQCS(JL) = PQCS(I1(JL), I2(JL), I3(JL))
+ ZQRS(JL) = PQRS(I1(JL), I2(JL), I3(JL))
+ ZQIS(JL) = PQIS(I1(JL), I2(JL), I3(JL))
+ ZQSS(JL) = PQSS(I1(JL), I2(JL), I3(JL))
+ ZQGS(JL) = PQGS(I1(JL), I2(JL), I3(JL))
+ IF (KRR == 7) ZQHS(JL) = PQHS(I1(JL), I2(JL), I3(JL))
+ ENDDO
+!
+!
+!* 2.3 Update the parameter e in the charge-diameter relation
+!
+ IF (KRR == 7) THEN
+ CALL COMPUTE_LBDA(ZRRT, ZRST, ZRGT, ZRH=ZRHT)
+ ZTSPLITR = 1.
+ CALL ELEC_UPDATE_QD(ZTSPLITR, ZERT, ZEIT, ZEST, ZEGT, ZQRT, ZQIT, ZQST, ZQGT, &
+ ZRRT, ZRIT, ZRST, ZRGT, &
+ ZEH=ZEHT, ZQH=ZQHT, ZRH=ZRHT, ZEC=ZECT, ZQC=ZQCT, ZRC=ZRCT)
+ ZTSPLITR = PTSTEP
+ CALL ELEC_UPDATE_QD(ZTSPLITR, ZERS, ZEIS, ZESS, ZEGS, ZQRS, ZQIS, ZQSS, ZQGS, &
+ ZRRS, ZRIS, ZRSS, ZRGS, &
+ ZEH=ZEHS, ZQH=ZQHS, ZRH=ZRHS, ZEC=ZECS, ZQC=ZQCS, ZRC=ZRCS)
+ ELSE
+ CALL COMPUTE_LBDA(ZRRT, ZRST, ZRGT)
+ ZTSPLITR = 1.
+ CALL ELEC_UPDATE_QD(ZTSPLITR, ZERT, ZEIT, ZEST, ZEGT, ZQRT, ZQIT, ZQST, ZQGT, &
+ ZRRT, ZRIT, ZRST, ZRGT, ZEC=ZECT, ZQC=ZQCT, ZRC=ZRCT)
+ ZTSPLITR = PTSTEP
+ CALL ELEC_UPDATE_QD(ZTSPLITR, ZERS, ZEIS, ZESS, ZEGS, ZQRS, ZQIS, ZQSS, ZQGS, &
+ ZRRS, ZRIS, ZRSS, ZRGS, ZEC=ZECS, ZQC=ZQCS, ZRC=ZRCS)
+ END IF
+!
+!
+!* 2.4 Initialization for the non-inductive charging process
+!
+ CALL ELEC_INI_NI_PROCESS
+!
+!
+!* 2.5 Compute the slow cold process sources
+!
+ CALL RAIN_ICE_ELEC_SLOW
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. COMPUTES THE SLOW WARM PROCESS SOURCES
+! --------------------------------------
+!
+ IF( OWARM ) THEN ! Check if the formation of the raindrops by the slow
+ ! warm processes is allowed
+ PEVAP3D(:,:,:)= 0.
+ CALL RAIN_ICE_ELEC_WARM
+ END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_s
+! ----------------------------------------------
+!
+ CALL RAIN_ICE_ELEC_FAST_RS
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_g
+! ----------------------------------------------
+!
+ CALL RAIN_ICE_ELEC_FAST_RG
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_h
+! ----------------------------------------------
+!
+ IF ( KRR == 7 ) THEN
+ CALL RAIN_ICE_ELEC_FAST_RH
+ END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. COMPUTES SPECIFIC SOURCES OF THE WARM AND COLD CLOUDY SPECIES
+! -------------------------------------------------------------
+!
+ CALL RAIN_ICE_ELEC_FAST_RI
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. UPDATE MIXING 3D RATIOS AND VOLUMETRIC CHARGE CONCENTRATIONS
+! ------------------------------------------------------------
+!
+!* 8.1 Update the mixing ratio
+!
+ DO JL=1,IMICRO
+ PRVS(I1(JL),I2(JL),I3(JL)) = ZRVS(JL)
+ PRCS(I1(JL),I2(JL),I3(JL)) = ZRCS(JL)
+ PRRS(I1(JL),I2(JL),I3(JL)) = ZRRS(JL)
+ PRIS(I1(JL),I2(JL),I3(JL)) = ZRIS(JL)
+ PRSS(I1(JL),I2(JL),I3(JL)) = ZRSS(JL)
+ PRGS(I1(JL),I2(JL),I3(JL)) = ZRGS(JL)
+ PTHS(I1(JL),I2(JL),I3(JL)) = ZTHS(JL)
+ PCIT(I1(JL),I2(JL),I3(JL)) = ZCIT(JL)
+ END DO
+ IF ( KRR == 7 ) THEN
+ DO JL=1,IMICRO
+ PRHS(I1(JL),I2(JL),I3(JL)) = ZRHS(JL)
+ END DO
+ END IF
+!
+!
+!* 8.2 Compute the volumetric charge concentration
+!
+ DO JL=1,IMICRO
+ PQPIS(I1(JL),I2(JL),I3(JL)) = ZQPIS(JL)
+ PQNIS(I1(JL),I2(JL),I3(JL)) = ZQNIS(JL)
+ PQCS (I1(JL),I2(JL),I3(JL)) = ZQCS(JL)
+ PQRS (I1(JL),I2(JL),I3(JL)) = ZQRS(JL)
+ PQIS (I1(JL),I2(JL),I3(JL)) = ZQIS(JL)
+ PQSS (I1(JL),I2(JL),I3(JL)) = ZQSS(JL)
+ PQGS (I1(JL),I2(JL),I3(JL)) = ZQGS(JL)
+ END DO
+ IF ( KRR == 7 ) THEN
+ DO JL=1,IMICRO
+ PQHS(I1(JL),I2(JL),I3(JL)) = ZQHS(JL)
+ END DO
+ END IF
+!
+!
+!* 8.3 Deallocate
+!
+ DEALLOCATE(ZZW1)
+ DEALLOCATE(ZDV)
+ DEALLOCATE(ZCJ)
+ DEALLOCATE(ZRDRYG)
+ DEALLOCATE(ZRWETG)
+ DEALLOCATE(ZLBDAG)
+ IF ( KRR == 7 ) DEALLOCATE(ZLBDAH)
+ DEALLOCATE(ZLBDAS)
+ DEALLOCATE(ZLBDAR)
+ DEALLOCATE(ZSSI)
+ DEALLOCATE(ZUSW)
+ DEALLOCATE(ZLVFACT)
+ DEALLOCATE(ZLSFACT)
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZEXNREF)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZRHOCOR)
+ DEALLOCATE(ZZT)
+ IF(LBU_ENABLE .OR. LLES_CALL) DEALLOCATE(ZRHODJ)
+ DEALLOCATE(ZTHS)
+ IF ( KRR == 7 ) DEALLOCATE(ZRHS)
+ DEALLOCATE(ZRGS)
+ DEALLOCATE(ZRSS)
+ DEALLOCATE(ZRIS)
+ DEALLOCATE(ZRRS)
+ DEALLOCATE(ZRCS)
+ DEALLOCATE(ZRVS)
+ DEALLOCATE(ZCIT)
+ DEALLOCATE(ZRGT)
+ IF ( KRR == 7 ) DEALLOCATE(ZRHT)
+ DEALLOCATE(ZRST)
+ DEALLOCATE(ZRIT)
+ DEALLOCATE(ZRRT)
+ DEALLOCATE(ZAI)
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZKA)
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZSIGMA_RC)
+ DEALLOCATE(ZCF)
+!
+ DEALLOCATE( ZECT )
+ DEALLOCATE( ZERT )
+ DEALLOCATE( ZEIT )
+ DEALLOCATE( ZEST )
+ DEALLOCATE( ZEGT )
+ IF ( KRR == 7 ) DEALLOCATE(ZEHT)
+ DEALLOCATE( ZECS )
+ DEALLOCATE( ZERS )
+ DEALLOCATE( ZEIS )
+ DEALLOCATE( ZESS )
+ DEALLOCATE( ZEGS )
+ IF ( KRR == 7 ) DEALLOCATE(ZEHS)
+ DEALLOCATE( ZQPIT )
+ DEALLOCATE( ZQNIT )
+ DEALLOCATE( ZQCT )
+ DEALLOCATE( ZQRT )
+ DEALLOCATE( ZQIT )
+ DEALLOCATE( ZQST )
+ DEALLOCATE( ZQGT )
+ IF ( KRR == 7 ) DEALLOCATE(ZQHT)
+ DEALLOCATE( ZQPIS )
+ DEALLOCATE( ZQNIS )
+ DEALLOCATE( ZQCS )
+ DEALLOCATE( ZQRS )
+ DEALLOCATE( ZQIS )
+ DEALLOCATE( ZQSS )
+ DEALLOCATE( ZQGS )
+ IF ( KRR == 7 ) DEALLOCATE(ZQHS)
+ DEALLOCATE( ZWQ1 )
+ DEALLOCATE( ZWQ3 )
+ DEALLOCATE( ZWQ4 )
+ DEALLOCATE( ZCOLIS )
+ DEALLOCATE( ZCOLIG )
+ DEALLOCATE( ZCOLSG )
+ DEALLOCATE( ZRSMIN_ELEC)
+ DEALLOCATE( GELEC )
+ IF (ALLOCATED( ZDELTALWC )) DEALLOCATE( ZDELTALWC )
+ IF (ALLOCATED( ZLWCC )) DEALLOCATE( ZLWCC )
+ IF (ALLOCATED( ZFT )) DEALLOCATE( ZFT )
+ IF (ALLOCATED( ZEW )) DEALLOCATE( ZEW )
+ IF (ALLOCATED( ZSAUNSK )) DEALLOCATE( ZSAUNSK )
+ IF (ALLOCATED( ZSAUNIM )) DEALLOCATE( ZSAUNIM )
+ IF (ALLOCATED( ZSAUNIN )) DEALLOCATE( ZSAUNIN )
+ IF (ALLOCATED( ZSAUNSM )) DEALLOCATE( ZSAUNSM )
+ IF (ALLOCATED( ZSAUNSN )) DEALLOCATE( ZSAUNSN )
+ IF (ALLOCATED( ZVGMEAN )) DEALLOCATE( ZVGMEAN )
+ IF (ALLOCATED( ZRAR )) DEALLOCATE( ZRAR )
+ IF (ALLOCATED( ZRAR_CRIT )) DEALLOCATE( ZRAR_CRIT )
+ IF (ALLOCATED( ZSAUNIM_IS )) DEALLOCATE( ZSAUNIM_IS )
+ IF (ALLOCATED( ZSAUNIN_IS )) DEALLOCATE( ZSAUNIN_IS )
+ IF (ALLOCATED( ZFQIAGGS )) DEALLOCATE( ZFQIAGGS )
+ IF (ALLOCATED( ZFQIDRYGBS )) DEALLOCATE( ZFQIDRYGBS )
+ IF (ALLOCATED( ZLBQSDRYGB1S )) DEALLOCATE( ZLBQSDRYGB1S )
+ IF (ALLOCATED( ZLBQSDRYGB2S )) DEALLOCATE( ZLBQSDRYGB2S )
+ IF (ALLOCATED( ZLBQSDRYGB3S )) DEALLOCATE( ZLBQSDRYGB3S )
+ IF (ALLOCATED( ZSAUNIM_IG )) DEALLOCATE( ZSAUNIM_IG )
+ IF (ALLOCATED( ZSAUNIN_IG )) DEALLOCATE( ZSAUNIN_IG )
+ IF (ALLOCATED( ZSAUNSK_SG )) DEALLOCATE( ZSAUNSK_SG )
+ IF (ALLOCATED( ZSAUNSM_SG )) DEALLOCATE( ZSAUNSM_SG )
+ IF (ALLOCATED( ZSAUNSN_SG )) DEALLOCATE( ZSAUNSN_SG )
+ IF (ALLOCATED( ZDQLWC )) DEALLOCATE( ZDQLWC )
+ IF (ALLOCATED( ZDQRAR_IS )) DEALLOCATE( ZDQRAR_IS )
+ IF (ALLOCATED( ZDQRAR_IG )) DEALLOCATE( ZDQRAR_IG )
+ IF (ALLOCATED( ZDQRAR_SG )) DEALLOCATE( ZDQRAR_SG )
+ IF (ALLOCATED( ZAUX1 )) DEALLOCATE( ZAUX1 )
+ IF (ALLOCATED( ZLIMIT )) DEALLOCATE( ZLIMIT )
+ IF (ALLOCATED( ZEFIELDW )) DEALLOCATE( ZEFIELDW )
+ IF (ALLOCATED( ZRATE_IND )) DEALLOCATE( ZRATE_IND )
+ IF (ALLOCATED( GIND )) DEALLOCATE( GIND )
+ IF (ALLOCATED( ZEFIELDU )) DEALLOCATE( ZEFIELDU )
+ IF (ALLOCATED( ZEFIELDV )) DEALLOCATE( ZEFIELDV )
+ DEALLOCATE( ZLATHAMIAGGS )
+!
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. COMPUTE THE SEDIMENTATION (RS) SOURCE
+! -------------------------------------
+!
+!* 8.1 time splitting loop initialization
+!
+ZTSPLITR = PTSTEP / REAL(KSPLITR)
+!
+!
+IF (CSEDIM == 'STAT') THEN
+! not yet developped for electricity !!!
+ CALL RAIN_ICE_SEDIMENTATION_STAT
+ELSE
+ CALL RAIN_ICE_ELEC_SEDIMENTATION_SPLIT
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+CONTAINS
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE RAIN_ICE_ELEC_SEDIMENTATION_SPLIT
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.2 declaration of local variables
+!
+INTEGER , DIMENSION(SIZE(GSEDIMC)) :: IC1,IC2,IC3 ! Used to replace the COUNT
+INTEGER , DIMENSION(SIZE(GSEDIMR)) :: IR1,IR2,IR3 ! Used to replace the COUNT
+INTEGER , DIMENSION(SIZE(GSEDIMI)) :: II1,II2,II3 ! Used to replace the COUNT
+INTEGER , DIMENSION(SIZE(GSEDIMS)) :: IS1,IS2,IS3 ! Used to replace the COUNT
+INTEGER , DIMENSION(SIZE(GSEDIMG)) :: IG1,IG2,IG3 ! Used to replace the COUNT
+INTEGER , DIMENSION(SIZE(GSEDIMH)) :: IH1,IH2,IH3 ! Used to replace the COUNT
+INTEGER :: ILENALLOCC,ILENALLOCR,ILENALLOCI,ILENALLOCS,ILENALLOCG,ILENALLOCH
+INTEGER :: ILISTLENC,ILISTLENR,ILISTLENI,ILISTLENS,ILISTLENG,ILISTLENH
+INTEGER, ALLOCATABLE :: ILISTR(:),ILISTC(:),ILISTI(:),ILISTS(:),ILISTG(:),ILISTH(:)
+! Optimization for NEC
+!INTEGER, SAVE :: IOLDALLOCC = SIZE(PEXNREF,1)*SIZE(PEXNREF,2)*SIZE(PEXNREF,3)/10
+!INTEGER, SAVE :: IOLDALLOCR = SIZE(PEXNREF,1)*SIZE(PEXNREF,2)*SIZE(PEXNREF,3)/10
+!INTEGER, SAVE :: IOLDALLOCI = SIZE(PEXNREF,1)*SIZE(PEXNREF,2)*SIZE(PEXNREF,3)/10
+!INTEGER, SAVE :: IOLDALLOCS = SIZE(PEXNREF,1)*SIZE(PEXNREF,2)*SIZE(PEXNREF,3)/10
+!INTEGER, SAVE :: IOLDALLOCG = SIZE(PEXNREF,1)*SIZE(PEXNREF,2)*SIZE(PEXNREF,3)/10
+!INTEGER, SAVE :: IOLDALLOCH = SIZE(PEXNREF,1)*SIZE(PEXNREF,2)*SIZE(PEXNREF,3)/10
+INTEGER, SAVE :: IOLDALLOCC = 6000
+INTEGER, SAVE :: IOLDALLOCR = 6000
+INTEGER, SAVE :: IOLDALLOCI = 6000
+INTEGER, SAVE :: IOLDALLOCS = 6000
+INTEGER, SAVE :: IOLDALLOCG = 6000
+INTEGER, SAVE :: IOLDALLOCH = 6000
+!
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D ! droplet condensation
+INTEGER, DIMENSION(:), ALLOCATABLE :: ZCIS
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZF0, ZF1, ZCOR
+REAL :: ZBEARDCOEFR, ZBEARDCOEFI, ZBEARDCOEFS, ZBEARDCOEFG
+REAL :: ZVR, ZVI, ZVS, ZVG, ZETA0, ZK, ZRE0
+! For rain, ice, snow and graupel particles, Take into account the
+! effects of altitude and electrical force on terminal fallspeed
+! (from Beard, JAS 1980, 37,1363-1374)
+!
+!-------------------------------------------------------------------------------
+!
+! O. Initialization for sedimentation
+!
+ if ( lbudget_rc .and. osedic ) &
+ call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( osedic ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'SEDI', pqcs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'SEDI', pqrs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'SEDI', pqis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'SEDI', pqss(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'SEDI', pqgs(:, :, :) * prhodj(:, :, :) )
+ if ( krr == 7 ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'SEDI', pqhs(:, :, :) * prhodj(:, :, :) )
+ end if
+
+ IF (OSEDIC) PINPRC (:,:) = 0.
+ PINPRR (:,:) = 0.
+ PINPRR3D (:,:,:) = 0.
+ PINPRS (:,:) = 0.
+ PINPRG (:,:) = 0.
+ IF ( KRR == 7 ) PINPRH (:,:) = 0.
+!
+ ZT (:,:,:) = ZT (:,:,:) - XTT !ZT from RAIN_ICE_ELEC_NUCLEATION
+ ZETA0 = (1.718 + 0.0049*(XTHVREFZ(IKB) -XTT))
+ WHERE (ZT (:,:,:) >= 0.0)
+ ZF0(:,:,:) = ZETA0 / (1.718 + 0.0049*ZT(:,:,:))
+ ELSEWHERE
+ ZF0(:,:,:) = ZETA0 / (1.718 + 0.0049*ZT(:,:,:) - 1.2E-5*ZT(:,:,:)*ZT(:,:,:))
+ END WHERE
+!
+ ZF1(:,:,:) = SQRT(ZRHO00/PRHODREF(:,:,:))
+ ZCOR(:,:,:) = (PRHODREF(:,:,:)/ZRHO00)**XCEXVT ! to eliminate Foote-duToit correction
+!
+ ZVR = (ZRHO00/ZETA0) * XCR * MOMG(XALPHAR,XNUR,XBR+XDR) / MOMG(XALPHAR,XNUR,XBR)
+ ZVI = (ZRHO00/ZETA0) * 2.1E5 * MOMG(XALPHAI,XNUI,3.285) / MOMG(XALPHAI,XNUI,1.7) ! Columns
+ ZVS = (ZRHO00/ZETA0) * XCS * MOMG(XALPHAS,XNUS,XBS+XDS) / MOMG(XALPHAS,XNUS,XBS)
+ ZVG = (ZRHO00/ZETA0) * XCG * MOMG(XALPHAG,XNUG,XBG+XDG) / MOMG(XALPHAG,XNUG,XBG)
+!
+!* 1. Parameters for cloud sedimentation
+!
+ IF (OSEDIC) THEN
+ ZRAY(:,:,:) = 0.
+ ZLBC(:,:,:) = XLBC(1)
+ ZFSEDC(:,:,:) = XFSEDC(1)
+ ZCONC3D(:,:,:) = XCONC_LAND
+ ZCONC_TMP(:,:) = XCONC_LAND
+ IF (PRESENT(PSEA)) THEN
+ ZCONC_TMP(:,:) = PSEA(:,:) * XCONC_SEA + (1. - PSEA(:,:)) * XCONC_LAND
+ DO JK = IKB, IKE
+ ZLBC(:,:,JK) = PSEA(:,:) * XLBC(2) + (1. - PSEA(:,:)) * XLBC(1)
+ ZFSEDC(:,:,JK) = PSEA(:,:) * XFSEDC(2) + (1. - PSEA(:,:)) * XFSEDC(1)
+ ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK))
+ ZCONC3D(:,:,JK) = (1. - PTOWN(:,:)) * ZCONC_TMP(:,:) + PTOWN(:,:) * XCONC_URBAN
+ ZRAY(:,:,JK) = 0.5 * ((1. - PSEA(:,:)) * MOMG(XALPHAC, XNUC, 1.0) + &
+ PSEA(:,:) * MOMG(XALPHAC2, XNUC2, 1.0) )
+ END DO
+ ELSE
+ ZCONC3D(:,:,:) = XCONC_LAND
+ ZRAY(:,:,:) = 0.5 * MOMG(XALPHAC, XNUC, 1.0)
+ END IF
+ ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:))
+ ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:))
+ ENDIF
+!
+!* 2. compute the fluxes
+!
+! optimization by looking for locations where
+! the precipitating fields are larger than a minimal value only !!!
+! For optimization we consider each variable separately
+
+ ZRTMIN(:) = XRTMIN(:) / PTSTEP
+ IF (OSEDIC) GSEDIMC(:,:,:) = .FALSE.
+ GSEDIMR(:,:,:) = .FALSE.
+ GSEDIMI(:,:,:) = .FALSE.
+ GSEDIMS(:,:,:) = .FALSE.
+ GSEDIMG(:,:,:) = .FALSE.
+ IF (KRR == 7) GSEDIMH(:,:,:) = .FALSE.
+!
+ IF (OSEDIC) ILENALLOCC = 0
+ ILENALLOCR = 0
+ ILENALLOCI = 0
+ ILENALLOCS = 0
+ ILENALLOCG = 0
+ IF ( KRR == 7 ) ILENALLOCH = 0
+!
+! ZPiS = Specie i source creating during the current time step
+! PRiS = Source of the previous time step
+!
+ IF (OSEDIC) THEN
+ ZPRCS(:,:,:) = 0.0
+ ZPRCS(:,:,:) = PRCS(:,:,:) - PRCT(:,:,:) / PTSTEP
+ PRCS(:,:,:) = PRCT(:,:,:) / PTSTEP
+ END IF
+ ZPRRS(:,:,:) = 0.0
+ ZPRSS(:,:,:) = 0.0
+ ZPRGS(:,:,:) = 0.0
+ IF (KRR == 7) ZPRHS(:,:,:) = 0.0
+!
+ ZPRRS(:,:,:) = PRRS(:,:,:) - PRRT(:,:,:) / PTSTEP
+ ZPRSS(:,:,:) = PRSS(:,:,:) - PRST(:,:,:) / PTSTEP
+ ZPRGS(:,:,:) = PRGS(:,:,:) - PRGT(:,:,:) / PTSTEP
+ IF (KRR == 7) ZPRHS(:,:,:) = PRHS(:,:,:) - PRHT(:,:,:) / PTSTEP
+ PRRS(:,:,:) = PRRT(:,:,:) / PTSTEP
+ PRSS(:,:,:) = PRST(:,:,:) / PTSTEP
+ PRGS(:,:,:) = PRGT(:,:,:) / PTSTEP
+ IF (KRR == 7) PRHS(:,:,:) = PRHT(:,:,:) / PTSTEP
+ ZPQRS(:,:,:) = 0.0
+ ZPQSS(:,:,:) = 0.0
+ ZPQGS(:,:,:) = 0.0
+ IF (KRR == 7) ZPQHS(:,:,:) = 0.0
+!
+ ZPQRS(:,:,:) = PQRS(:,:,:) - PQRT(:,:,:) / PTSTEP
+ ZPQSS(:,:,:) = PQSS(:,:,:) - PQST(:,:,:) / PTSTEP
+ ZPQGS(:,:,:) = PQGS(:,:,:) - PQGT(:,:,:) / PTSTEP
+ IF (KRR == 7) ZPQHS(:,:,:) = PQHS(:,:,:) - PQHT(:,:,:) / PTSTEP
+ PQRS(:,:,:) = PQRT(:,:,:) / PTSTEP
+ PQSS(:,:,:) = PQST(:,:,:) / PTSTEP
+ PQGS(:,:,:) = PQGT(:,:,:) / PTSTEP
+ IF (KRR == 7) PQHS(:,:,:) = PQHT(:,:,:) / PTSTEP
+!
+! PRiS = Source of the previous time step + source created during the subtime
+! step
+!
+ DO JN = 1, KSPLITR
+ IF(JN == 1) THEN
+ IF (OSEDIC) PRCS(:,:,:) = PRCS(:,:,:) + ZPRCS(:,:,:) / KSPLITR
+ PRRS(:,:,:) = PRRS(:,:,:) + ZPRRS(:,:,:) / KSPLITR
+ PRSS(:,:,:) = PRSS(:,:,:) + ZPRSS(:,:,:) / KSPLITR
+ PRGS(:,:,:) = PRGS(:,:,:) + ZPRGS(:,:,:) / KSPLITR
+ IF (KRR == 7) PRHS(:,:,:) = PRHS(:,:,:) + ZPRHS(:,:,:) / KSPLITR
+ PQRS(:,:,:) = PQRS(:,:,:) + ZPQRS(:,:,:) / KSPLITR
+ PQSS(:,:,:) = PQSS(:,:,:) + ZPQSS(:,:,:) / KSPLITR
+ PQGS(:,:,:) = PQGS(:,:,:) + ZPQGS(:,:,:) / KSPLITR
+ IF (KRR == 7) PQHS(:,:,:) = PQHS(:,:,:) + ZPQHS(:,:,:) / KSPLITR
+ DO JK = IKB, IKE
+ ZW(:,:,JK) = ZTSPLITR / (PRHODREF(:,:,JK) * (PZZ(:,:,JK+1) - PZZ(:,:,JK)))
+ END DO
+ ELSE
+ IF (OSEDIC) PRCS(:,:,:) = PRCS(:,:,:) + ZPRCS(:,:,:) * ZTSPLITR
+ PRRS(:,:,:) = PRRS(:,:,:) + ZPRRS(:,:,:) * ZTSPLITR
+ PRSS(:,:,:) = PRSS(:,:,:) + ZPRSS(:,:,:) * ZTSPLITR
+ PRGS(:,:,:) = PRGS(:,:,:) + ZPRGS(:,:,:) * ZTSPLITR
+ IF (KRR == 7) PRHS(:,:,:) = PRHS(:,:,:) + ZPRHS(:,:,:) * ZTSPLITR
+ PQRS(:,:,:) = PQRS(:,:,:) + ZPQRS(:,:,:) * ZTSPLITR
+ PQSS(:,:,:) = PQSS(:,:,:) + ZPQSS(:,:,:) * ZTSPLITR
+ PQGS(:,:,:) = PQGS(:,:,:) + ZPQGS(:,:,:) * ZTSPLITR
+ IF (KRR == 7) PQHS(:,:,:) = PQHS(:,:,:) + ZPQHS(:,:,:) * ZTSPLITR
+ END IF
+ !
+ IF (OSEDIC) GSEDIMC(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRCS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN(2)
+ GSEDIMR(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRRS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN(3)
+ GSEDIMI(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRIS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN(4)
+ GSEDIMS(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRSS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN(5)
+ GSEDIMG(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRGS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN(6)
+ IF (KRR == 7) GSEDIMH(IIB:IIE,IJB:IJE,IKB:IKE) = &
+ PRHS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN(7)
+!
+ IF (OSEDIC) ISEDIMC = COUNTJV( GSEDIMC(:,:,:),IC1(:),IC2(:),IC3(:))
+ ISEDIMR = COUNTJV( GSEDIMR(:,:,:),IR1(:),IR2(:),IR3(:))
+ ISEDIMI = COUNTJV( GSEDIMI(:,:,:),II1(:),II2(:),II3(:))
+ ISEDIMS = COUNTJV( GSEDIMS(:,:,:),IS1(:),IS2(:),IS3(:))
+ ISEDIMG = COUNTJV( GSEDIMG(:,:,:),IG1(:),IG2(:),IG3(:))
+ IF (KRR == 7) ISEDIMH = COUNTJV( GSEDIMH(:,:,:),IH1(:),IH2(:),IH3(:))
+!
+!* 2.1 for cloud
+!
+ IF (OSEDIC) THEN
+ ZWSED(:,:,:) = 0.
+ IF( JN==1 ) PRCS(:,:,:) = PRCS(:,:,:) * PTSTEP
+ IF(ISEDIMC >= 1) THEN
+ IF (ISEDIMC .GT. ILENALLOCC) THEN
+ IF (ILENALLOCC .GT. 0) THEN
+ DEALLOCATE (ZRCS, ZRHODREFC, ILISTC, ZWLBDC, ZCONC, ZRCT, &
+ ZZT, ZPRES, ZRAY1D, ZFSEDC1D, ZWLBDA, ZCC )
+ END IF
+ ILENALLOCC = MAX (IOLDALLOCC, 2*ISEDIMC )
+ IOLDALLOCC = ILENALLOCC
+ ALLOCATE(ZRCS(ILENALLOCC), ZRHODREFC(ILENALLOCC), ILISTC(ILENALLOCC), &
+ ZWLBDC(ILENALLOCC), ZCONC(ILENALLOCC), ZRCT(ILENALLOCC), ZZT(ILENALLOCC), &
+ ZPRES(ILENALLOCC), ZRAY1D(ILENALLOCC), ZFSEDC1D(ILENALLOCC), &
+ ZWLBDA(ILENALLOCC), ZCC(ILENALLOCC))
+ END IF
+!
+ DO JL = 1, ISEDIMC
+ ZRCS(JL) = PRCS(IC1(JL),IC2(JL),IC3(JL))
+ ZRHODREFC(JL) = PRHODREF(IC1(JL),IC2(JL),IC3(JL))
+ ZWLBDC(JL) = ZLBC(IC1(JL),IC2(JL),IC3(JL))
+ ZCONC(JL) = ZCONC3D(IC1(JL),IC2(JL),IC3(JL))
+ ZRCT(JL) = PRCT(IC1(JL),IC2(JL),IC3(JL))
+ ZZT(JL) = PTHT(IC1(JL),IC2(JL),IC3(JL))
+ ZPRES(JL) = PPABST(IC1(JL),IC2(JL),IC3(JL))
+ ZRAY1D(JL) = ZRAY(IC1(JL),IC2(JL),IC3(JL))
+ ZFSEDC1D(JL) = ZFSEDC(IC1(JL),IC2(JL),IC3(JL))
+ END DO
+!
+ ILISTLENC = 0
+ DO JL = 1, ISEDIMC
+ IF(ZRCS(JL) .GT. ZRTMIN(2)) THEN
+ ILISTLENC = ILISTLENC + 1
+ ILISTC(ILISTLENC) = JL
+ END IF
+ END DO
+ DO JJ = 1, ILISTLENC
+ JL = ILISTC(JJ)
+ IF (ZRCS(JL) .GT. ZRTMIN(2) .AND. ZRCT(JL) .GT. XRTMIN(2)) THEN
+ ZWLBDC(JL) = ZWLBDC(JL) * ZCONC(JL) / (ZRHODREFC(JL) * ZRCT(JL))
+ ZWLBDC(JL) = ZWLBDC(JL)**XLBEXC
+ ZRAY1D(JL) = ZRAY1D(JL) / ZWLBDC(JL) !! ZRAY : mean diameter=M(1)/2
+ ZZT(JL) = ZZT(JL) * (ZPRES(JL) / XP00)**(XRD/XCPD)
+ ZWLBDA(JL) = 6.6E-8 * (101325. / ZPRES(JL)) * (ZZT(JL) / 293.15)
+ ZCC(JL) = XCC * (1. + 1.26 * ZWLBDA(JL) / ZRAY1D(JL)) !! XCC modified for cloud
+ ZWSED (IC1(JL),IC2(JL),IC3(JL)) = ZRHODREFC(JL)**(-XCEXVT +1 ) * &
+ ZWLBDC(JL)**(-XDC) * ZCC(JL) * ZFSEDC1D(JL) * ZRCS(JL)
+ END IF
+ END DO
+ END IF
+ DO JK = IKB, IKE
+ PRCS(:,:,JK) = PRCS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK))
+ END DO
+ PINPRC(:,:) = PINPRC(:,:) + ZWSED(:,:,IKB) / XRHOLW / KSPLITR
+ IF(JN == KSPLITR) THEN
+ PRCS(:,:,:) = PRCS(:,:,:) / PTSTEP
+ END IF
+ END IF
+!
+!* 2.2 for rain
+!
+ IF( JN==1 ) PRRS(:,:,:) = PRRS(:,:,:) * PTSTEP
+ IF (JN == 1) PQRS(:,:,:) = PQRS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDQ(:,:,:) = 0.
+ IF( ISEDIMR >= 1 ) THEN
+ IF ( ISEDIMR .GT. ILENALLOCR ) THEN
+ IF ( ILENALLOCR .GT. 0 ) THEN
+ DEALLOCATE (ZRRS, ZRHODREFR, ILISTR)
+ DEALLOCATE (ZQRS, ZLBDAR, ZERS)
+ END IF
+ ILENALLOCR = MAX (IOLDALLOCR, 2*ISEDIMR )
+ IOLDALLOCR = ILENALLOCR
+ ALLOCATE(ZRRS(ILENALLOCR), ZRHODREFR(ILENALLOCR), ILISTR(ILENALLOCR))
+ ALLOCATE(ZQRS(ILENALLOCR), ZLBDAR(ILENALLOCR), ZERS(ILENALLOCR))
+ END IF
+ ZERS(:) = 0.
+!
+ DO JL = 1, ISEDIMR
+ ZRRS(JL) = PRRS(IR1(JL),IR2(JL),IR3(JL))
+ ZRHODREFR(JL) = PRHODREF(IR1(JL),IR2(JL),IR3(JL))
+ ZQRS(JL) = PQRS(IR1(JL),IR2(JL),IR3(JL))
+! compute lambda_r and e_r
+ IF (ZRRS(JL) > 0.) THEN
+ ZLBDAR(JL) = XLBR * (ZRHODREFR(JL) * MAX(ZRRS(JL), ZRTMIN(3)))**XLBEXR
+ END IF
+ IF (ZRRS(JL) > ZRTMIN(3) .AND. ZLBDAR(JL) > 0.) THEN
+ ZERS(JL) = ZRHODREFR(JL) * ZQRS(JL) / (XFQUPDR * ZLBDAR(JL)**(XCXR - XFR))
+ ZERS(JL) = SIGN( MIN(ABS(ZERS(JL)), XERMAX), ZERS(JL))
+ END IF
+ END DO
+!
+ ILISTLENR = 0
+ DO JL = 1, ISEDIMR
+ IF(ZRRS(JL) .GT. ZRTMIN(3)) THEN
+ ILISTLENR = ILISTLENR + 1
+ ILISTR(ILISTLENR) = JL
+ END IF
+ END DO
+ DO JJ = 1, ILISTLENR
+ JL = ILISTR(JJ)
+ IF (ZRRS(JL) > 0. .AND. LSEDIM_BEARD) THEN
+ ZK = 1. - ZQRS(JL) * XEFIELDW(IR1(JL),IR2(JL),IR3(JL)) / (ZRRS(JL)*XG)
+ IF (ZK <= 0.0) THEN
+ ZBEARDCOEFR = 0.
+ ELSE
+ ZRE0 = ZVR / ZLBDAR(JL)**(1.+XDR)
+ IF (ZRE0 <= 0.2) THEN
+ ZBEARDCOEFR = ZF0(IR1(JL),IR2(JL),IR3(JL)) * ZK
+ ELSE IF (ZRE0 >= 1000.) THEN
+ ZBEARDCOEFR = ZF1(IR1(JL),IR2(JL),IR3(JL)) * SQRT(ZK)
+ ELSE
+ ZBEARDCOEFR = ZF0(IR1(JL),IR2(JL),IR3(JL)) * ZK + &
+ (ZF1(IR1(JL),IR2(JL),IR3(JL)) * &
+ SQRT(ZK)-ZF0(IR1(JL),IR2(JL),IR3(JL))*ZK) * &
+ (1.61+LOG(ZRE0)) / 8.52
+ END IF
+ ZBEARDCOEFR = ZBEARDCOEFR * ZCOR(IR1(JL),IR2(JL),IR3(JL))
+ END IF
+ ELSE
+ ZBEARDCOEFR = 1.0 ! No "Beard" effect
+ END IF
+!
+ ZWSED(IR1(JL),IR2(JL),IR3(JL)) = ZBEARDCOEFR * &
+ XFSEDR * ZRRS(JL)**XEXSEDR * &
+ ZRHODREFR(JL)**(XEXSEDR-XCEXVT)
+!
+ IF (ZRRS(JL) > ZRTMIN(3) .AND. ABS(ZERS(JL)) > XERMIN) THEN
+ ZWSEDQ(IR1(JL),IR2(JL),IR3(JL)) = ZBEARDCOEFR * &
+ XFQSEDR * ZERS(JL) * &
+ ZRRS(JL)**XEXQSEDR * &
+ ZRHODREFR(JL)**(XEXQSEDR-XCEXVT)
+ END IF
+ END DO
+ END IF
+ DO JK = IKB , IKE
+ PRRS(:,:,JK) = PRRS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK))
+ PQRS(:,:,JK) = PQRS(:,:,JK) + ZW(:,:,JK) * (ZWSEDQ(:,:,JK+1) - ZWSEDQ(:,:,JK))
+ END DO
+ PINPRR(:,:) = PINPRR(:,:) + ZWSED(:,:,IKB) / XRHOLW / KSPLITR
+ PINPRR3D(:,:,:) = PINPRR3D(:,:,:) + ZWSED(:,:,:) / XRHOLW / KSPLITR
+ IF (JN == KSPLITR) THEN
+ PRRS(:,:,:) = PRRS(:,:,:) / PTSTEP
+ PQRS(:,:,:) = PQRS(:,:,:) / PTSTEP
+ END IF
+!
+!
+!* 2.3 for pristine ice
+!
+ IF (JN == 1) PRIS(:,:,:) = PRIS(:,:,:) * PTSTEP
+ IF (JN == 1) PQIS(:,:,:) = PQIS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDQ(:,:,:) = 0.
+ IF( ISEDIMI >= 1 ) THEN
+ IF ( ISEDIMI .GT. ILENALLOCI ) THEN
+ IF ( ILENALLOCI .GT. 0 ) THEN
+ DEALLOCATE (ZRIS, ZRHODREFI, ILISTI)
+ DEALLOCATE (ZQIS, ZEIS, ZCIT, ZCIS, ZLBDAI)
+ END IF
+ ILENALLOCI = MAX (IOLDALLOCI, 2*ISEDIMI )
+ IOLDALLOCI = ILENALLOCI
+ ALLOCATE(ZRIS(ILENALLOCI), ZRHODREFI(ILENALLOCI), ILISTI(ILENALLOCI))
+ ALLOCATE(ZQIS(ILENALLOCI), &
+ ZEIS(ILENALLOCI), &
+ ZCIT(ILENALLOCI), &
+ ZCIS(ILENALLOCI), &
+ ZLBDAI(ILENALLOCI))
+ END IF
+!
+ DO JL = 1, ISEDIMI
+ ZRIS(JL) = PRIS(II1(JL),II2(JL),II3(JL))
+ ZRHODREFI(JL) = PRHODREF(II1(JL),II2(JL),II3(JL))
+ ZQIS(JL) = PQIS(II1(JL),II2(JL),II3(JL))
+ ZCIT(JL) = PCIT(II1(JL),II2(JL),II3(JL))
+ ZEIS(JL) = 0.
+! compute e_i
+ IF (ZRIS(JL) > ZRTMIN(4) .AND. ZCIT(JL) > 0.0) THEN
+ ZEIS(JL) = ZRHODREFI(JL) * ZQIS(JL) / ((ZCIT(JL)**(1 - XEXFQUPDI)) * &
+ XFQUPDI * (ZRHODREFI(JL) * ZRIS(JL))**XEXFQUPDI)
+ ZEIS(JL) = SIGN( MIN(ABS(ZEIS(JL)), XEIMAX), ZEIS(JL))
+ ZCIS(JL) = XFCI * ZRHODREFI(JL) * ZRIS(JL) * &
+ MAX(0.05E6, &
+ -0.15319E6 - 0.021454E6 * ALOG(ZRHODREFI(JL) * ZRIS(JL)))**3
+ ZLBDAI(JL) = (2.14E-3 * MOMG(XALPHAI,XNUI,1.7) * &
+ ZCIS(JL) / (ZRHODREFI(JL) * ZRIS(JL)))**0.588235
+ END IF
+ END DO
+!
+ ILISTLENI = 0
+ DO JL = 1, ISEDIMI
+ IF (ZRIS(JL) .GT. MAX(ZRTMIN(4),1.0E-7 )) THEN ! limitation of the McF&H formula
+ ILISTLENI = ILISTLENI + 1
+ ILISTI(ILISTLENI) = JL
+ END IF
+ END DO
+ DO JJ = 1, ILISTLENI
+ JL = ILISTI(JJ)
+ IF (ZRIS(JL) > ZRTMIN(4) .AND. ZCIT(JL) > 0.0 .AND. LSEDIM_BEARD) THEN
+ ZK = 1. - ZQIS(JL) * XEFIELDW(II1(JL),II2(JL),II3(JL)) / (ZRIS(JL)*XG)
+ IF (ZK <= 0.0) THEN
+ ZBEARDCOEFI = 0.
+ ELSE
+ ZRE0 = ZVI / ZLBDAI(JL)**2.585
+ IF (ZRE0 <= 0.2) THEN
+ ZBEARDCOEFI = ZF0(II1(JL),II2(JL),II3(JL)) * ZK
+ ELSE IF (ZRE0 >= 1000.) THEN
+ ZBEARDCOEFI = ZF1(II1(JL),II2(JL),II3(JL)) * SQRT(ZK)
+ ELSE
+ ZBEARDCOEFI = ZF0(II1(JL),II2(JL),II3(JL)) * ZK + &
+ (ZF1(II1(JL),II2(JL),II3(JL)) * &
+ SQRT(ZK) - ZF0(II1(JL),II2(JL),II3(JL)) * ZK) * &
+ (1.61 + LOG(ZRE0)) / 8.52
+ END IF
+ ZBEARDCOEFI = ZBEARDCOEFI * ZCOR(II1(JL),II2(JL),II3(JL))
+ END IF
+ ELSE
+ ZBEARDCOEFI = 1.0 ! No "Beard" effect
+ END IF
+!
+ ZWSED(II1(JL),II2(JL),II3(JL))= ZBEARDCOEFI * &
+ XFSEDI * ZRIS(JL) * &
+ ZRHODREFI(JL)**(1.0-XCEXVT) * & ! McF&H
+ MAX( 0.05E6,-0.15319E6-0.021454E6* &
+ ALOG(ZRHODREFI(JL)*ZRIS(JL)) )**XEXCSEDI
+ IF (ZRIS(JL) .GT. MAX(ZRTMIN(4),1.0E-7) .AND. ABS(ZEIS(JL)) .GT. XEIMIN .AND. &
+ ZCIT(JL) .GT. 0. ) THEN
+ ZWSEDQ(II1(JL),II2(JL),II3(JL)) = ZBEARDCOEFI * &
+ ZCIS(JL)**(1 - XEXQSEDI) * XFQSEDI * &
+ ZRIS(JL)**XEXQSEDI * ZRHODREFI(JL)**(XEXQSEDI - XCEXVT) * &
+ ZEIS(JL) * (ZCIT(JL) / ZCIS(JL))**(1.-XFI/XBI)
+ END IF
+ END DO
+ END IF
+ DO JK = IKB, IKE
+ PRIS(:,:,JK) = PRIS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK))
+ PQIS(:,:,JK) = PQIS(:,:,JK) + ZW(:,:,JK) * (ZWSEDQ(:,:,JK+1) - ZWSEDQ(:,:,JK))
+ END DO
+ IF (JN == KSPLITR) THEN
+ PRIS(:,:,:) = PRIS(:,:,:) / PTSTEP
+ PQIS(:,:,:) = PQIS(:,:,:) / PTSTEP
+ END IF
+!
+!
+!* 2.4 for aggregates/snow
+!
+ IF( JN==1 ) PRSS(:,:,:) = PRSS(:,:,:) * PTSTEP
+ IF (JN == 1) PQSS(:,:,:) = PQSS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDQ(:,:,:) = 0.
+ IF( ISEDIMS >= 1 ) THEN
+ IF ( ISEDIMS .GT. ILENALLOCS ) THEN
+ IF ( ILENALLOCS .GT. 0 ) THEN
+ DEALLOCATE (ZRSS, ZRHODREFS, ILISTS)
+ DEALLOCATE (ZQSS, ZESS, ZLBDAS)
+ END IF
+ ILENALLOCS = MAX(IOLDALLOCS, 2*ISEDIMS )
+ IOLDALLOCS = ILENALLOCS
+ ALLOCATE(ZRSS(ILENALLOCS), ZRHODREFS(ILENALLOCS), ILISTS(ILENALLOCS))
+ ALLOCATE(ZQSS(ILENALLOCS), ZESS(ILENALLOCS), ZLBDAS(ILENALLOCS))
+ END IF
+!
+ DO JL = 1, ISEDIMS
+ ZRSS(JL) = PRSS(IS1(JL),IS2(JL),IS3(JL))
+ ZRHODREFS(JL) = PRHODREF(IS1(JL),IS2(JL),IS3(JL))
+ ZQSS(JL) = PQSS(IS1(JL),IS2(JL),IS3(JL))
+ ZESS(JL) = 0.
+! compute lambda_s and e_s
+ IF (ZRSS(JL) > 0.) THEN
+ ZLBDAS(JL) = MIN(XLBDAS_MAX, &
+ XLBS * (ZRHODREFS(JL) * MAX(ZRSS(JL), ZRTMIN(5)))**XLBEXS)
+ END IF
+ IF (ZRSS(JL) > ZRTMIN(5) .AND. ZLBDAS(JL) > 0.) THEN
+ ZESS(JL) = ZRHODREFS(JL) * ZQSS(JL) / (XFQUPDS * ZLBDAS(JL)**(XCXS - XFS))
+ ZESS(JL) = SIGN( MIN(ABS(ZESS(JL)), XESMAX), ZESS(JL))
+ END IF
+ END DO
+!
+ ILISTLENS = 0
+ DO JL = 1, ISEDIMS
+ IF (ZRSS(JL) .GT. ZRTMIN(5)) THEN
+ ILISTLENS = ILISTLENS + 1
+ ILISTS(ILISTLENS) = JL
+ END IF
+ END DO
+ DO JJ = 1, ILISTLENS
+ JL = ILISTS(JJ)
+ IF (ZRSS(JL) > 0. .AND. LSEDIM_BEARD) THEN
+ ZK = 1. - ZQSS(JL) * XEFIELDW(IS1(JL),IS2(JL),IS3(JL)) / (ZRSS(JL)*XG)
+ IF (ZK <= 0.0) THEN
+ ZBEARDCOEFS = 0.
+ ELSE
+ ZRE0 = ZVS / ZLBDAS(JL)**(1.+XDS)
+ IF (ZRE0 <= 0.2) THEN
+ ZBEARDCOEFS = ZF0(IS1(JL),IS2(JL),IS3(JL)) * ZK
+ ELSE IF (ZRE0 >= 1000.) THEN
+ ZBEARDCOEFS = ZF1(IS1(JL),IS2(JL),IS3(JL)) * SQRT(ZK)
+ ELSE
+ ZBEARDCOEFS = ZF0(IS1(JL),IS2(JL),IS3(JL)) * ZK + &
+ (ZF1(IS1(JL),IS2(JL),IS3(JL)) * &
+ SQRT(ZK) -ZF0(IS1(JL),IS2(JL),IS3(JL)) * ZK) * &
+ (1.61 + LOG(ZRE0)) / 8.52
+ END IF
+ ZBEARDCOEFS = ZBEARDCOEFS * ZCOR(IS1(JL),IS2(JL),IS3(JL))
+ END IF
+ ELSE
+ ZBEARDCOEFS = 1.0 ! No "Beard" effect
+ END IF
+!
+ ZWSED (IS1(JL),IS2(JL),IS3(JL)) = ZBEARDCOEFS * &
+ XFSEDS * ZRSS(JL)**XEXSEDS * &
+ ZRHODREFS(JL)**(XEXSEDS-XCEXVT)
+ IF (ZRSS(JL) .GT. ZRTMIN(5) .AND. ABS(ZESS(JL)) > XESMIN) THEN
+ ZWSEDQ(IS1(JL),IS2(JL),IS3(JL)) = ZBEARDCOEFS * &
+ XFQSEDS * ZESS(JL) * &
+ ZRSS(JL)**XEXQSEDS * &
+ ZRHODREFS(JL)**(XEXQSEDS - XCEXVT)
+ END IF
+ END DO
+ END IF
+ DO JK = IKB, IKE
+ PRSS(:,:,JK) = PRSS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK))
+ PQSS(:,:,JK) = PQSS(:,:,JK) + ZW(:,:,JK) * (ZWSEDQ(:,:,JK+1) - ZWSEDQ(:,:,JK))
+ END DO
+ PINPRS(:,:) = PINPRS(:,:) + ZWSED(:,:,IKB) / XRHOLW / KSPLITR
+ IF (JN == KSPLITR) THEN
+ PRSS(:,:,:) = PRSS(:,:,:) / PTSTEP
+ PQSS(:,:,:) = PQSS(:,:,:) / PTSTEP
+ END IF
+!
+!
+!* 2.5 for graupeln
+!
+ ZWSED(:,:,:) = 0.
+ ZWSEDQ(:,:,:) = 0.
+ IF( JN==1 ) PRGS(:,:,:) = PRGS(:,:,:) * PTSTEP
+ IF (JN == 1) PQGS(:,:,:) = PQGS(:,:,:) * PTSTEP
+ IF( ISEDIMG >= 1 ) THEN
+ IF ( ISEDIMG .GT. ILENALLOCG ) THEN
+ IF ( ILENALLOCG .GT. 0 ) THEN
+ DEALLOCATE (ZRGS, ZRHODREFG, ILISTG)
+ DEALLOCATE (ZQGS, ZEGS, ZLBDAG)
+ END IF
+ ILENALLOCG = MAX (IOLDALLOCG, 2*ISEDIMG )
+ IOLDALLOCG = ILENALLOCG
+ ALLOCATE(ZRGS(ILENALLOCG), ZRHODREFG(ILENALLOCG), ILISTG(ILENALLOCG))
+ ALLOCATE(ZQGS(ILENALLOCG), ZEGS(ILENALLOCG), ZLBDAG(ILENALLOCG))
+ END IF
+!
+ DO JL = 1, ISEDIMG
+ ZRGS(JL) = PRGS(IG1(JL),IG2(JL),IG3(JL))
+ ZRHODREFG(JL) = PRHODREF(IG1(JL),IG2(JL),IG3(JL))
+ ZQGS(JL) = PQGS(IG1(JL),IG2(JL),IG3(JL))
+ ZEGS(JL) = 0.
+! compute lambda_g and e_g
+ IF (ZRGS(JL) > 0.) THEN
+ ZLBDAG(JL) = XLBG * (ZRHODREFG(JL) * MAX(ZRGS(JL), ZRTMIN(6)))**XLBEXG
+ END IF
+ IF (ZRGS(JL) > ZRTMIN(6) .AND. ZLBDAG(JL) > 0.) THEN
+ ZEGS(JL) = ZRHODREFG(JL) * ZQGS(JL) / (XFQUPDG * ZLBDAG(JL)**(XCXG - XFG))
+ ZEGS(JL) = SIGN( MIN(ABS(ZEGS(JL)), XEGMAX), ZEGS(JL))
+ END IF
+ END DO
+!
+ ILISTLENG = 0
+ DO JL = 1, ISEDIMG
+ IF (ZRGS(JL) .GT. ZRTMIN(6)) THEN
+ ILISTLENG = ILISTLENG + 1
+ ILISTG(ILISTLENG) = JL
+ END IF
+ END DO
+ DO JJ = 1, ILISTLENG
+ JL = ILISTG(JJ)
+ IF (ZRGS(JL) > 0. .AND. LSEDIM_BEARD) THEN
+ ZK = 1. - ZQGS(JL) * XEFIELDW(IG1(JL),IG2(JL),IG3(JL)) / (ZRGS(JL)*XG)
+ IF (ZK <= 0.0) THEN
+ ZBEARDCOEFG = 0.
+ ELSE
+ ZRE0 = ZVG / ZLBDAG(JL)**(1.+XDG)
+ IF (ZRE0 <= 0.2) THEN
+ ZBEARDCOEFG = ZF0(IG1(JL),IG2(JL),IG3(JL)) * ZK
+ ELSE IF (ZRE0 >= 1000.) THEN
+ ZBEARDCOEFG = ZF1(IG1(JL),IG2(JL),IG3(JL)) * SQRT(ZK)
+ ELSE
+ ZBEARDCOEFG = ZF0(IG1(JL),IG2(JL),IG3(JL)) * ZK + &
+ (ZF1(IG1(JL),IG2(JL),IG3(JL)) * &
+ SQRT(ZK) - ZF0(IG1(JL),IG2(JL),IG3(JL)) * ZK) * &
+ (1.61 + LOG(ZRE0)) / 8.52
+ END IF
+ ZBEARDCOEFG = ZBEARDCOEFG * ZCOR(IG1(JL),IG2(JL),IG3(JL))
+ END IF
+ ELSE
+ ZBEARDCOEFG = 1.0 ! No "Beard" effect
+ END IF
+!
+ ZWSED (IG1(JL),IG2(JL),IG3(JL))= ZBEARDCOEFG * &
+ XFSEDG * ZRGS(JL)**XEXSEDG * &
+ ZRHODREFG(JL)**(XEXSEDG-XCEXVT)
+ IF (ZRGS(JL) .GT. ZRTMIN(6) .AND. ABS(ZEGS(JL)) > XEGMIN) THEN
+ ZWSEDQ(IG1(JL),IG2(JL),IG3(JL)) = ZBEARDCOEFG * &
+ XFQSEDG * ZEGS(JL) * &
+ ZRGS(JL)**XEXQSEDG * &
+ ZRHODREFG(JL)**(XEXQSEDG - XCEXVT)
+ END IF
+ END DO
+ END IF
+ DO JK = IKB, IKE
+ PRGS(:,:,JK) = PRGS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK))
+ PQGS(:,:,JK) = PQGS(:,:,JK) + ZW(:,:,JK) * (ZWSEDQ(:,:,JK+1) - ZWSEDQ(:,:,JK))
+ END DO
+ PINPRG(:,:) = PINPRG(:,:) + ZWSED(:,:,IKB) / XRHOLW / KSPLITR
+ IF (JN == KSPLITR) THEN
+ PRGS(:,:,:) = PRGS(:,:,:) / PTSTEP
+ PQGS(:,:,:) = PQGS(:,:,:) / PTSTEP
+ END IF
+!
+!
+!* 2.6 for hail
+!
+ IF ( KRR == 7 ) THEN
+ IF( JN==1 ) PRHS(:,:,:) = PRHS(:,:,:) * PTSTEP
+ IF (JN == 1) PQHS(:,:,:) = PQHS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDQ(:,:,:) = 0.
+ IF( ISEDIMH >= 1 ) THEN
+ IF ( ISEDIMH .GT. ILENALLOCH ) THEN
+ IF ( ILENALLOCH .GT. 0 ) THEN
+ DEALLOCATE (ZRHS, ZRHODREFH, ILISTH)
+ DEALLOCATE (ZQHS, ZEHS, ZLBDAH)
+ END IF
+ ILENALLOCH = MAX(IOLDALLOCH, 2*ISEDIMH )
+ IOLDALLOCH = ILENALLOCH
+ ALLOCATE(ZRHS(ILENALLOCH), ZRHODREFH(ILENALLOCH), ILISTH(ILENALLOCH))
+ ALLOCATE(ZQHS(ILENALLOCH), ZLBDAH(ILENALLOCH), ZEHS(ILENALLOCH))
+ END IF
+!
+ DO JL = 1, ISEDIMH
+ ZRHS(JL) = PRHS(IH1(JL),IH2(JL),IH3(JL))
+ ZRHODREFH(JL) = PRHODREF(IH1(JL),IH2(JL),IH3(JL))
+ ZQHS(JL) = PQHS(IH1(JL),IH2(JL),IH3(JL))
+ ZEHS(JL) = 0.
+! compute lambda_h and e_h
+ IF (ZRHS(JL) > 0.) THEN
+ ZLBDAH(JL) = XLBH * (ZRHODREFH(JL) * MAX(ZRHS(JL), ZRTMIN(7)))**XLBEXH
+ END IF
+ IF (ZRHS(JL) > ZRTMIN(7) .AND. ZLBDAH(JL) > 0.) THEN
+ ZEHS(JL) = ZRHODREFH(JL) * ZQHS(JL) / (XFQUPDH * ZLBDAH(JL)**(XCXH - XFH))
+ ZEHS(JL) = SIGN( MIN(ABS(ZEHS(JL)), XEHMAX), ZEHS(JL))
+ END IF
+ END DO
+!
+ ILISTLENH = 0
+ DO JL = 1, ISEDIMH
+ IF (ZRHS(JL) .GT. ZRTMIN(7)) THEN
+ ILISTLENH = ILISTLENH + 1
+ ILISTH(ILISTLENH) = JL
+ END IF
+ END DO
+ DO JJ = 1, ILISTLENH
+ JL = ILISTH(JJ)
+ ZWSED (IH1(JL),IH2(JL),IH3(JL)) = XFSEDH * ZRHS(JL)**XEXSEDH * &
+ ZRHODREFH(JL)**(XEXSEDH-XCEXVT)
+ IF (ZRHS(JL) .GT. ZRTMIN(7) .AND. ABS(ZEHS(JL)) > XEHMIN) THEN
+ ZWSEDQ(IH1(JL),IH2(JL),IH3(JL)) = XFQSEDH * ZEHS(JL) * &
+ ZRHS(JL)**XEXQSEDH * &
+ ZRHODREFH(JL)**(XEXQSEDH - XCEXVT)
+ END IF
+ END DO
+ END IF
+ DO JK = IKB, IKE
+ PRHS(:,:,JK) = PRHS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK))
+ PQHS(:,:,JK) = PQHS(:,:,JK) + ZW(:,:,JK) * (ZWSEDQ(:,:,JK+1) - ZWSEDQ(:,:,JK))
+ END DO
+ PINPRH(:,:) = PINPRH(:,:) + ZWSED(:,:,IKB) / XRHOLW / KSPLITR
+ IF (JN == KSPLITR) THEN
+ PRHS(:,:,:) = PRHS(:,:,:) / PTSTEP
+ PQHS(:,:,:) = PQHS(:,:,:) / PTSTEP
+ END IF
+ END IF
+ END DO
+!
+ IF (OSEDIC) THEN
+ IF (ILENALLOCC .GT. 0) DEALLOCATE (ZRCS, ZRHODREFC, &
+ ILISTC,ZWLBDC,ZCONC,ZRCT, ZZT,ZPRES,ZRAY1D,ZFSEDC1D, ZWLBDA,ZCC)
+ END IF
+ IF (ILENALLOCR .GT. 0 ) DEALLOCATE(ZRHODREFR,ZRRS,ILISTR)
+ IF (ILENALLOCI .GT. 0 ) DEALLOCATE(ZRHODREFI,ZRIS,ILISTI)
+ IF (ILENALLOCS .GT. 0 ) DEALLOCATE(ZRHODREFS,ZRSS,ILISTS)
+ IF (ILENALLOCG .GT. 0 ) DEALLOCATE(ZRHODREFG,ZRGS,ILISTG)
+ IF (KRR == 7 .AND. (ILENALLOCH .GT. 0 )) DEALLOCATE(ZRHODREFH,ZRHS,ILISTH)
+!
+ IF (ILENALLOCR .GT. 0 ) DEALLOCATE(ZERS,ZQRS,ZLBDAR)
+ IF (ILENALLOCI .GT. 0 ) DEALLOCATE(ZEIS,ZQIS,ZCIS,ZCIT,ZLBDAI)
+ IF (ILENALLOCS .GT. 0 ) DEALLOCATE(ZESS,ZQSS,ZLBDAS)
+ IF (ILENALLOCG .GT. 0 ) DEALLOCATE(ZEGS,ZQGS,ZLBDAG)
+ IF (KRR == 7 .AND. (ILENALLOCH .GT. 0 )) DEALLOCATE(ZEHS,ZQHS,ZLBDAH)
+!
+!
+!* 2.3 budget storage
+!
+ if ( lbudget_rc .and. osedic ) &
+ call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( osedic ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'SEDI', pqcs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'SEDI', pqrs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'SEDI', pqis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'SEDI', pqss(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'SEDI', pqgs(:, :, :) * prhodj(:, :, :) )
+ if ( krr == 7 ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'SEDI', pqhs(:, :, :) * prhodj(:, :, :) )
+ end if
+!
+ END SUBROUTINE RAIN_ICE_ELEC_SEDIMENTATION_SPLIT
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE RAIN_ICE_SEDIMENTATION_STAT
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.2 declaration of local variables
+!
+!
+
+REAL :: ZP1,ZP2,ZQP,ZH,ZZWLBDA,ZZWLBDC,ZZCC
+INTEGER :: JI,JJ,JK
+!
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D ! droplet condensation
+!
+!-------------------------------------------------------------------------------
+ if ( lbudget_rc .and. osedic ) &
+ call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( osedic ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'SEDI', pqcs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'SEDI', pqrs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'SEDI', pqis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'SEDI', pqss(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'SEDI', pqgs(:, :, :) * prhodj(:, :, :) )
+ if ( krr == 7 ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'SEDI', pqhs(:, :, :) * prhodj(:, :, :) )
+ end if
+!
+!* 1. Parameters for cloud sedimentation
+!
+ IF (OSEDIC) THEN
+ ZRAY(:,:,:) = 0.
+ ZLBC(:,:,:) = XLBC(1)
+ ZFSEDC(:,:,:) = XFSEDC(1)
+ ZCONC3D(:,:,:) = XCONC_LAND
+ ZCONC_TMP(:,:) = XCONC_LAND
+ IF (PRESENT(PSEA)) THEN
+ ZCONC_TMP(:,:) = PSEA(:,:) * XCONC_SEA + (1. - PSEA(:,:)) * XCONC_LAND
+ DO JK = IKB, IKE
+ ZLBC(:,:,JK) = PSEA(:,:) * XLBC(2) + (1. - PSEA(:,:)) * XLBC(1)
+ ZFSEDC(:,:,JK) = (PSEA(:,:) * XFSEDC(2) + (1. - PSEA(:,:)) * XFSEDC(1))
+ ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK))
+ ZCONC3D(:,:,JK) = (1. - PTOWN(:,:)) * ZCONC_TMP(:,:) + PTOWN(:,:) * XCONC_URBAN
+ ZRAY(:,:,JK) = 0.5 * ((1. - PSEA(:,:)) * MOMG(XALPHAC, XNUC, 1.0) + &
+ PSEA(:,:) * MOMG(XALPHAC2, XNUC2, 1.0) )
+ END DO
+ ELSE
+ ZCONC3D(:,:,:) = XCONC_LAND
+ ZRAY(:,:,:) = 0.5 * MOMG(XALPHAC, XNUC, 1.0)
+ END IF
+ ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:))
+ ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:))
+ ENDIF
+!
+!
+!* 2. compute the fluxes
+!
+ ZRTMIN(:) = XRTMIN(:) / PTSTEP
+!
+ IF (OSEDIC) THEN
+ ZPRCS(:,:,:) = 0.0
+ ZPRCS(:,:,:) = PRCS(:,:,:) - PRCT(:,:,:) / PTSTEP
+ PRCS(:,:,:) = PRCT(:,:,:) / PTSTEP
+ END IF
+ ZPRRS(:,:,:) = 0.0
+ ZPRSS(:,:,:) = 0.0
+ ZPRGS(:,:,:) = 0.0
+ IF (KRR == 7) ZPRHS(:,:,:) = 0.0
+!
+ ZPRRS(:,:,:) = PRRS(:,:,:) - PRRT(:,:,:) / PTSTEP
+ ZPRSS(:,:,:) = PRSS(:,:,:) - PRST(:,:,:) / PTSTEP
+ ZPRGS(:,:,:) = PRGS(:,:,:) - PRGT(:,:,:) / PTSTEP
+ IF (KRR == 7) ZPRHS(:,:,:) = PRHS(:,:,:) - PRHT(:,:,:) / PTSTEP
+ PRRS(:,:,:) = PRRT(:,:,:) / PTSTEP
+ PRSS(:,:,:) = PRST(:,:,:) / PTSTEP
+ PRGS(:,:,:) = PRGT(:,:,:) / PTSTEP
+ IF (KRR == 7) PRHS(:,:,:) = PRHT(:,:,:) / PTSTEP
+!
+ IF (OSEDIC) PRCS(:,:,:) = PRCS(:,:,:) + ZPRCS(:,:,:)
+ PRRS(:,:,:) = PRRS(:,:,:) + ZPRRS(:,:,:)
+ PRSS(:,:,:) = PRSS(:,:,:) + ZPRSS(:,:,:)
+ PRGS(:,:,:) = PRGS(:,:,:) + ZPRGS(:,:,:)
+ IF (KRR == 7) PRHS(:,:,:) = PRHS(:,:,:) + ZPRHS(:,:,:)
+ DO JK = IKB, IKE
+ ZW(:,:,JK) = ZTSPLITR / (PRHODREF(:,:,JK) * (PZZ(:,:,JK+1) - PZZ(:,:,JK)))
+ END DO
+!
+!
+!* 2.1 for cloud
+!
+ IF (OSEDIC) THEN
+ PRCS(:,:,:) = PRCS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDW1(:,:,:) = 0.
+ ZWSEDW2(:,:,:) = 0.
+
+! calculation of P1, P2 and sedimentation flux
+ DO JK = IKE , IKB, -1
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ ! estimation of q' taking into account incomming ZWSED
+ ZQP = ZWSED(JI,JJ,JK+1) * ZW(JI,JJ,JK)
+ ! calculation of w
+ ! mars 2009 : ajout d'un test
+ ! IF ( PRCS(JI,JJ,JK) > ZRTMIN(2) ) THEN
+ IF(PRCS(JI,JJ,JK) > ZRTMIN(2) .AND. PRCT(JI,JJ,JK) > ZRTMIN(2)) THEN
+ ZZWLBDA = 6.6E-8 * (101325. / PPABST(JI,JJ,JK)) * (PTHT(JI,JJ,JK) / 293.15)
+ ZZWLBDC = (ZLBC(JI,JJ,JK) * ZCONC3D(JI,JJ,JK) / &
+ (PRHODREF(JI,JJ,JK) * PRCT(JI,JJ,JK)))**XLBEXC
+ ZZCC = XCC * (1. + 1.26 * ZZWLBDA * ZZWLBDC / ZRAY(JI,JJ,JK)) ! ZCC: Fall speed
+ ZWSEDW1(JI,JJ,JK) = PRHODREF(JI,JJ,JK)**(-XCEXVT ) * &
+ ZZWLBDC**(-XDC) * ZZCC * ZFSEDC(JI,JJ,JK)
+ ENDIF
+ IF (ZQP > ZRTMIN(2)) THEN
+ ZZWLBDA = 6.6E-8 * (101325. / PPABST(JI,JJ,JK)) * (PTHT(JI,JJ,JK) / 293.15)
+ ZZWLBDC = (ZLBC(JI,JJ,JK) * ZCONC3D(JI,JJ,JK) / &
+ (PRHODREF(JI,JJ,JK) * ZQP))**XLBEXC
+ ZZCC = XCC * (1. + 1.26 * ZZWLBDA * ZZWLBDC / ZRAY(JI,JJ,JK)) ! ZCC: Fall speed
+ ZWSEDW2(JI,JJ,JK) = PRHODREF(JI,JJ,JK)**(-XCEXVT ) * &
+ ZZWLBDC**(-XDC) * ZZCC * ZFSEDC(JI,JJ,JK)
+ ENDIF
+ ENDDO
+ DO JI = IIB, IIE
+ ZH = PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK)
+ ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH)
+ ! mars 2009 : correction : ZWSEDW1 => ZWSEDW2
+ !IF (ZWSEDW1(JI,JJ,JK) /= 0.) THEN
+ IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
+ ZP2 = MAX(0., 1. - ZH / (PTSTEP * ZWSEDW2(JI,JJ,JK)) )
+ ELSE
+ ZP2 = 0.
+ ENDIF
+ ZWSED(JI,JJ,JK) = ZP1 * PRHODREF(JI,JJ,JK) * &
+ (PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK)) * PRCS(JI,JJ,JK) / &
+ PTSTEP + ZP2 * ZWSED (JI,JJ,JK+1)
+ ENDDO
+ ENDDO
+ ENDDO
+!
+ DO JK = IKB , IKE
+ PRCS(:,:,JK) = PRCS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK))
+ END DO
+
+ PINPRC(:,:) = ZWSED(:,:,IKB) / XRHOLW ! in m/s
+ PRCS(:,:,:) = PRCS(:,:,:) / PTSTEP
+ ENDIF
+!
+!
+!* 2.2 for rain
+!
+ PRRS(:,:,:) = PRRS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDW1(:,:,:) = 0.
+ ZWSEDW2(:,:,:) = 0.
+!
+! calculation of ZP1, ZP2 and sedimentation flux
+ DO JK = IKE , IKB, -1
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ ! estimation of q' taking into account incomming ZWSED
+ ZQP = ZWSED(JI,JJ,JK+1) * ZW(JI,JJ,JK)
+ ! calculation of w
+ IF (PRRS(JI,JJ,JK) > ZRTMIN(3)) THEN
+ ZWSEDW1 (JI,JJ,JK) = XFSEDR * PRRS(JI,JJ,JK)**(XEXSEDR-1) * &
+ PRHODREF(JI,JJ,JK)**(XEXSEDR-XCEXVT-1)
+ ENDIF
+ IF (ZQP > ZRTMIN(3)) THEN
+ ZWSEDW2(JI,JJ,JK) = XFSEDR * (ZQP)**(XEXSEDR-1) * &
+ PRHODREF(JI,JJ,JK)**(XEXSEDR-XCEXVT-1)
+ ENDIF
+ ENDDO
+ DO JI = IIB, IIE
+ ZH = PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK)
+ ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH )
+ IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
+ ZP2 = MAX(0., 1 - ZH / (PTSTEP * ZWSEDW2(JI,JJ,JK)) )
+ ELSE
+ ZP2 = 0.
+ ENDIF
+ ZWSED(JI,JJ,JK) = ZP1 * PRHODREF(JI,JJ,JK) * &
+ ZH * PRRS(JI,JJ,JK) / &
+ PTSTEP + ZP2 * ZWSED (JI,JJ,JK+1)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ DO JK = IKB , IKE
+ PRRS(:,:,JK) = PRRS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK))
+ ENDDO
+ PINPRR(:,:) = ZWSED(:,:,IKB) / XRHOLW ! in m/s
+ PINPRR3D(:,:,:) = ZWSED(:,:,:) / XRHOLW ! in m/s
+ PRRS(:,:,:) = PRRS(:,:,:) / PTSTEP
+!
+!
+!* 2.3 for pristine ice
+!
+ PRIS(:,:,:) = PRIS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDW1(:,:,:) = 0.
+ ZWSEDW2(:,:,:) = 0.
+! calculation of ZP1, ZP2 and sedimentation flux
+ DO JK = IKE , IKB, -1
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ ! estimation of q' taking into account incomming ZWSED
+ ZQP = ZWSED(JI,JJ,JK+1) * ZW(JI,JJ,JK)
+ ! calculation of w
+ IF (PRIS(JI,JJ,JK) > MAX(ZRTMIN(4),1.0E-7)) THEN
+ ZWSEDW1(JI,JJ,JK) = XFSEDI * &
+ PRHODREF(JI,JJ,JK)**(XCEXVT) * & ! McF&H
+ MAX(0.05E6,-0.15319E6-0.021454E6* &
+ ALOG(PRHODREF(JI,JJ,JK)*PRIS(JI,JJ,JK)))**XEXCSEDI
+ ENDIF
+ IF (ZQP > MAX(ZRTMIN(4),1.0E-7)) THEN
+ ZWSEDW2(JI,JJ,JK)= XFSEDI * &
+ PRHODREF(JI,JJ,JK)**(XCEXVT) * & ! McF&H
+ MAX( 0.05E6,-0.15319E6-0.021454E6* &
+ ALOG(PRHODREF(JI,JJ,JK)*ZQP) )**XEXCSEDI
+ ENDIF
+ ENDDO
+ DO JI = IIB, IIE
+ ZH = PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK)
+ ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH )
+ IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
+ ZP2 = MAX(0.,1 - ZH / (PTSTEP * ZWSEDW2(JI,JJ,JK)))
+ ELSE
+ ZP2 = 0.
+ ENDIF
+ ZWSED(JI,JJ,JK) = ZP1 * PRHODREF(JI,JJ,JK) * &
+ (PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK)) * PRIS(JI,JJ,JK) / &
+ PTSTEP + ZP2 * ZWSED(JI,JJ,JK+1)
+ ENDDO
+ ENDDO
+ ENDDO
+!
+ DO JK = IKB , IKE
+ PRIS(:,:,JK) = PRIS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK))
+ ENDDO
+!
+ PRIS(:,:,:) = PRIS(:,:,:) / PTSTEP
+!
+!
+!* 2.4 for aggregates/snow
+!
+ PRSS(:,:,:) = PRSS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDW1(:,:,:) = 0.
+ ZWSEDW2(:,:,:) = 0.
+
+! calculation of ZP1, ZP2 and sedimentation flux
+ DO JK = IKE , IKB, -1
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ ! estimation of q' taking into account incomming ZWSED
+ ZQP = ZWSED(JI,JJ,JK+1) * ZW(JI,JJ,JK)
+ ! calculation of w
+ IF (PRSS(JI,JJ,JK) > ZRTMIN(5)) THEN
+ ZWSEDW1(JI,JJ,JK) = XFSEDS * (PRSS(JI,JJ,JK))**(XEXSEDS-1) * &
+ PRHODREF(JI,JJ,JK)**(XEXSEDS-XCEXVT-1)
+ ENDIF
+ IF (ZQP > ZRTMIN(5)) THEN
+ ZWSEDW2(JI,JJ,JK) = XFSEDS * (ZQP)**(XEXSEDS-1) * &
+ PRHODREF(JI,JJ,JK)**(XEXSEDS-XCEXVT-1)
+ ENDIF
+ ENDDO
+ DO JI = IIB, IIE
+ ZH = PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK)
+ ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH )
+ IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
+ ZP2 = MAX(0.,1 - ZH / (PTSTEP * ZWSEDW2(JI,JJ,JK)) )
+ ELSE
+ ZP2 = 0.
+ ENDIF
+ ZWSED(JI,JJ,JK) = ZP1 * PRHODREF(JI,JJ,JK) * &
+ ZH * PRSS(JI,JJ,JK) / &
+ PTSTEP + ZP2 * ZWSED(JI,JJ,JK+1)
+ ENDDO
+ ENDDO
+ ENDDO
+!
+ DO JK = IKB , IKE
+ PRSS(:,:,JK) = PRSS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK))
+ ENDDO
+!
+ PINPRS(:,:) = ZWSED(:,:,IKB) / XRHOLW ! in m/s
+ PRSS(:,:,:) = PRSS(:,:,:) / PTSTEP
+!
+!
+!
+!* 2.5 for graupeln
+!
+ PRGS(:,:,:) = PRGS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDW1(:,:,:) = 0.
+ ZWSEDW2(:,:,:) = 0.
+
+! calculation of ZP1, ZP2 and sedimentation flux
+ DO JK = IKE , IKB, -1
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ ! estimation of q' taking into account incomming ZWSED
+ ZQP = ZWSED(JI,JJ,JK+1) * ZW(JI,JJ,JK)
+ ! calculation of w
+ IF (PRGS(JI,JJ,JK) > ZRTMIN(6)) THEN
+ ZWSEDW1(JI,JJ,JK) = XFSEDG * (PRGS(JI,JJ,JK))**(XEXSEDG-1) * &
+ PRHODREF(JI,JJ,JK)**(XEXSEDG-XCEXVT-1)
+ ENDIF
+ IF (ZQP > ZRTMIN(6)) THEN
+ ZWSEDW2(JI,JJ,JK) = XFSEDG * (ZQP)**(XEXSEDG-1) * &
+ PRHODREF(JI,JJ,JK)**(XEXSEDG-XCEXVT-1)
+ ENDIF
+ ENDDO
+ DO JI = IIB, IIE
+ ZH = PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK)
+ ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH )
+ IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
+ ZP2 = MAX(0.,1 - ZH / (PTSTEP * ZWSEDW2(JI,JJ,JK)) )
+ ELSE
+ ZP2 = 0.
+ ENDIF
+ ZWSED(JI,JJ,JK) = ZP1 * PRHODREF(JI,JJ,JK) * &
+ ZH * PRGS(JI,JJ,JK) / &
+ PTSTEP + ZP2 * ZWSED(JI,JJ,JK+1)
+ ENDDO
+ ENDDO
+ ENDDO
+!
+ DO JK = IKB , IKE
+ PRGS(:,:,JK) = PRGS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK))
+ ENDDO
+
+ PINPRG(:,:) = ZWSED(:,:,IKB) / XRHOLW ! in m/s
+ PRGS(:,:,:) = PRGS(:,:,:) / PTSTEP
+!
+!
+!* 2.6 for hail
+!
+ IF (KRR == 7) THEN
+ PRHS(:,:,:) = PRHS(:,:,:) * PTSTEP
+ ZWSED(:,:,:) = 0.
+ ZWSEDW1(:,:,:) = 0.
+ ZWSEDW2(:,:,:) = 0.
+! calculation of ZP1, ZP2 and sedimentation flux
+ DO JK = IKE , IKB, -1
+ DO JJ = IJB, IJE
+ DO JI = IIB, IIE
+ ! estimation of q' taking into account incomming ZWSED
+ ZQP = ZWSED(JI,JJ,JK+1) * ZW(JI,JJ,JK)
+ ! calculation of w
+ IF ((PRHS(JI,JJ,JK)+ZQP) > ZRTMIN(7) ) THEN
+ ZWSEDW1 (JI,JJ,JK) = XFSEDH * (PRHS(JI,JJ,JK))**(XEXSEDH-1) * &
+ PRHODREF(JI,JJ,JK)**(XEXSEDH-XCEXVT-1)
+ ENDIF
+ IF (ZQP > ZRTMIN(7)) THEN
+ ZWSEDW2(JI,JJ,JK) = XFSEDH * ZQP**(XEXSEDH-1) * &
+ PRHODREF(JI,JJ,JK)**(XEXSEDH-XCEXVT-1)
+ ENDIF
+ ENDDO
+ DO JI = IIB, IIE
+ ZH = PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK)
+ ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH)
+ IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN
+ ZP2 = MAX(0.,1 - ZH / (PTSTEP*ZWSEDW2(JI,JJ,JK)))
+ ELSE
+ ZP2 = 0.
+ ENDIF
+ ZWSED(JI,JJ,JK) = ZP1 * PRHODREF(JI,JJ,JK) * &
+ ZH * PRHS(JI,JJ,JK) / &
+ PTSTEP + ZP2 * ZWSED(JI,JJ,JK+1)
+ ENDDO
+ ENDDO
+ ENDDO
+!
+ DO JK = IKB , IKE
+ PRHS(:,:,JK) = PRHS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK))
+ ENDDO
+!
+ PINPRH(:,:) = ZWSED(:,:,IKB) / XRHOLW ! in m/s
+ PRHS(:,:,:) = PRHS(:,:,:) / PTSTEP
+ ENDIF
+!
+!
+!* 2.3 budget storage
+!
+ if ( lbudget_rc .and. osedic ) &
+ call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( osedic ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'SEDI', pqcs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'SEDI', pqrs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'SEDI', pqis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'SEDI', pqss(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'SEDI', pqgs(:, :, :) * prhodj(:, :, :) )
+ if ( krr == 7 ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'SEDI', pqhs(:, :, :) * prhodj(:, :, :) )
+ end if
+!
+ END SUBROUTINE RAIN_ICE_SEDIMENTATION_STAT
+!
+!-------------------------------------------------------------------------------
+!
+!
+ SUBROUTINE RAIN_ICE_ELEC_NUCLEATION
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.2 declaration of local variables
+!
+INTEGER , DIMENSION(SIZE(GNEGT)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+!
+!-------------------------------------------------------------------------------
+!
+! compute the temperature and the pressure
+!
+ZT(:,:,:) = PTHT(:,:,:) * (PPABST(:,:,:) / XP00) ** (XRD / XCPD)
+!
+! 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
+INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
+!
+IF( INEGT >= 1 ) THEN
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HENU', pris(:, :, :) * prhodj(:, :, :) )
+
+ ALLOCATE(ZRVT(INEGT))
+ ALLOCATE(ZCIT(INEGT))
+ ALLOCATE(ZZT(INEGT))
+ ALLOCATE(ZPRES(INEGT))
+ DO JL = 1, INEGT
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ ALLOCATE(ZZW(INEGT))
+ ALLOCATE(ZUSW(INEGT))
+ ALLOCATE(ZSSI(INEGT))
+ ZZW(:) = EXP(XALPI - XBETAI / ZZT(:) - XGAMI * ALOG(ZZT(:))) ! es_i
+ ZZW(:) = MIN(ZPRES(:) / 2., ZZW(:)) ! safety limitation
+ ZSSI(:) = ZRVT(:) * (ZPRES(:) - ZZW(:)) / ((XMV / XMD) * ZZW(:)) - 1.0
+ ! Supersaturation over ice
+ ZUSW(:) = EXP(XALPW - XBETAW / ZZT(:) - XGAMW * ALOG(ZZT(:))) ! es_w
+ ZUSW(:) = MIN(ZPRES(:) / 2., ZUSW(:)) ! safety limitation
+ ZUSW(:) = (ZUSW(:) / ZZW(:)) * ((ZPRES(:) - ZZW(:)) / (ZPRES(:) - ZUSW(:))) - 1.0
+ ! Supersaturation of saturated water vapor over ice
+!
+!* 3.1 compute the heterogeneous nucleation source: RVHENI
+!
+!* 3.1.1 compute the cloud ice concentration
+!
+ ZZW(:) = 0.0
+ ZSSI(:) = MIN( ZSSI(:), ZUSW(:) ) ! limitation of SSi according to SSw=0
+!
+ WHERE ((ZZT(:) < XTT-5.0) .AND. (ZSSI(:) > 0.0))
+ ZZW(:) = XNU20 * EXP(XALPHA2 * ZSSI(:) - XBETA2)
+ END WHERE
+ WHERE ((ZZT(:) <= XTT-2.0) .AND. (ZZT(:) >= XTT-5.0) .AND. (ZSSI(:) > 0.0))
+ ZZW(:) = MAX(XNU20 * EXP(-XBETA2), XNU10 * EXP(-XBETA1 * (ZZT(:) - XTT)) * &
+ (ZSSI(:) / ZUSW(:))**XALPHA1 )
+ END WHERE
+ ZZW(:) = ZZW(:) - ZCIT(:)
+!
+ IF( MAXVAL(ZZW(:)) > 0.0 ) THEN
+!
+!* 3.1.2 update the r_i and r_v mixing ratios
+!
+ ZZW(:) = MIN(ZZW(:), 50.E3) ! limitation provisoire a 50 l^-1
+ ZW(:,:,:) = UNPACK(ZZW(:), MASK=GNEGT(:,:,:), FIELD=0.0)
+ ZW(:,:,:) = MAX(ZW(:,:,:), 0.0) * XMNU0 / (PRHODREF(:,:,:) * PTSTEP)
+ PRIS(:,:,:) = PRIS(:,:,:) + ZW(:,:,:)
+ PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
+ IF (KRR == 7) THEN
+ PTHS(:,:,:) = PTHS(:,:,:) + &
+ ZW(:,:,:) * (XLSTT + (XCPV - XCI) * (ZT(:,:,:) - XTT)) / &
+ ((XCPD + XCPV * PRVT(:,:,:) + XCL * (PRCT(:,:,:) + PRRT(:,:,:)) + &
+ XCI * (PRIT(:,:,:) + PRST(:,:,:) + PRGT(:,:,:) + PRHT(:,:,:))) * &
+ PEXNREF(:,:,:))
+ ELSE IF(KRR == 6) THEN
+ PTHS(:,:,:) = PTHS(:,:,:) + &
+ ZW(:,:,:) * (XLSTT + (XCPV - XCI) * (ZT(:,:,:) - XTT)) / &
+ ((XCPD + XCPV * PRVT(:,:,:) + XCL * (PRCT(:,:,:) + PRRT(:,:,:)) + &
+ XCI * (PRIT(:,:,:) + PRST(:,:,:) + PRGT(:,:,:))) * PEXNREF(:,:,:))
+ END IF
+! f(L_s*(RVHENI))
+ ZZW(:) = MAX( ZZW(:)+ZCIT(:),ZCIT(:) )
+ PCIT(:,:,:) = MAX( UNPACK( ZZW(:),MASK=GNEGT(:,:,:),FIELD=0.0 ) , &
+ PCIT(:,:,:) )
+ END IF
+ DEALLOCATE(ZSSI)
+ DEALLOCATE(ZUSW)
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZCIT)
+ DEALLOCATE(ZRVT)
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HENU', pris(:, :, :) * prhodj(:, :, :) )
+
+END IF
+
+ END SUBROUTINE RAIN_ICE_ELEC_NUCLEATION
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE RAIN_ICE_ELEC_SLOW
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODD_CST, ONLY : XMNH_HUGE_12_LOG
+!
+IMPLICIT NONE
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 3.5.1 compute the homogeneous nucleation source: RCHONI & QCHONI
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'HON', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'HON', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW(:) = 0.0
+ ZWQ1(:,1:7) = 0.0
+!
+ WHERE( ABS(ZECT(:)) <= XECMIN)
+ ZECT(:) = 0.
+ ENDWHERE
+!
+ WHERE( (ZZT(:)<XTT-35.0) .AND. (ZRCT(:)>XRTMIN(2)) .AND. (ZRCS(:)>0.) )
+ ZZW(:) = MIN( ZRCS(:),XHON*ZRHODREF(:)*ZRCT(:) &
+ *EXP( MIN(XMNH_HUGE_12_LOG,XALPHA3*(ZZT(:)-XTT)-XBETA3) ) )
+ ZRIS(:) = ZRIS(:) + ZZW(:)
+ ZRCS(:) = ZRCS(:) - ZZW(:)
+ ZTHS(:) = ZTHS(:) + ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RCHONI))
+ ZWQ1(:,1) = XQHON * ZECT(:) * ZZW(:) ! QCHONI
+ ENDWHERE
+!
+ WHERE (ZZT(:) < (XTT - 35.) .AND. ZRIS(:) > ZRSMIN_ELEC(4) .AND. &
+ ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRCS(:) > ZRSMIN_ELEC(2) .AND. &
+ ABS(ZQCS(:)) > XQTMIN(2) .AND. ABS(ZECT(:)) > XECMIN)
+ ZWQ1(:,1) = SIGN( MIN( ABS(ZQCS(:)),ABS(ZWQ1(:,1)) ),ZQCS(:) )
+ ZQIS(:) = ZQIS(:) + ZWQ1(:,1)
+ ZQCS(:) = ZQCS(:) - ZWQ1(:,1)
+ END WHERE
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HON', Unpack( zzw(:) * ( zlsfact(:) - zlvfact(:) ) &
+ * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HON', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HON', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'HON', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'HON', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+!
+!* 3.5.2 compute the spontaneous freezing source: RRHONG & QRHONG
+!
+ ZZW(:) = 0.0
+!
+ WHERE( (ZZT(:)<XTT-35.0) .AND. (ZRRT(:)>XRTMIN(3)) .AND. (ZRRS(:)>0.) )
+ ZZW(:) = MIN( ZRRS(:),ZRRT(:)/PTSTEP )
+ ZRGS(:) = ZRGS(:) + ZZW(:)
+ ZRRS(:) = ZRRS(:) - ZZW(:)
+ ZTHS(:) = ZTHS(:) + ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RRHONG))
+ ENDWHERE
+!
+ WHERE (ZZT(:) < (XTT - 35.) .AND. &
+ ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRRS(:) > ZRSMIN_ELEC(3) .AND. &
+ ZRGS(:) > ZRSMIN_ELEC(6) .AND. ABS(ZQRT(:)) > XQTMIN(3))
+ ZWQ1(:,2) = SIGN( MIN( ABS(ZQRS(:)),ABS(ZQRT(:)/PTSTEP) ),ZQRS(:) ) ! QRHONG
+ ZQGS(:) = ZQGS(:) + ZWQ1(:,2)
+ ZQRS(:) = ZQRS(:) - ZWQ1(:,2)
+ ENDWHERE
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'SFR', Unpack( zzw(:) * ( zlsfact(:) - zlvfact(:) ) &
+ * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'SFR', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'SFR', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'SFR', &
+ Unpack( -zwq1(:, 2) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'SFR', &
+ Unpack( zwq1(:, 2) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+!
+!* 3.5.3 compute the deposition, aggregation and autoconversion sources
+!
+ ZKA(:) = 2.38E-2 + 0.0071E-2 * ( ZZT(:) - XTT ) ! k_a
+ ZDV(:) = 0.211E-4 * (ZZT(:)/XTT)**1.94 * (XP00/ZPRES(:)) ! D_v
+!
+!* 3.5.3.1 compute the thermodynamical function A_i(T,P)
+!* and the c^prime_j (in the ventilation factor)
+!
+ ZAI(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZAI(:) = ( XLSTT + (XCPV-XCI)*(ZZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZZT(:)**2) &
+ + ( XRV*ZZT(:) ) / (ZDV(:)*ZAI(:))
+ ZCJ(:) = XSCFAC * ZRHODREF(:)**0.3 / SQRT( 1.718E-5+0.0049E-5*(ZZT(:)-XTT) )
+!
+!* 3.5.3.2 compute the riming-conversion of r_c for r_i production: RCAUTI
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPS', &
+ Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPS', &
+ Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'DEPS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW(:) = 0.0
+!
+ WHERE ((ZRST(:) > XRTMIN(5)) .AND. (ZRSS(:) > 0.0))
+ ZZW(:) = ( ZSSI(:)/(ZRHODREF(:)*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(:)
+ ZWQ1(:,5) = XCOEF_RQ_S * ZQST(:) * (-ZZW(:)) / ZRST(:) ! sublimation
+ END WHERE
+!
+ WHERE (ZRST(:) > XRTMIN_ELEC(5) .AND. ZRSS(:) > ZRSMIN_ELEC(5) .AND. &
+ ZRVS(:) > ZRSMIN_ELEC(1) .AND. ABS(ZQST(:)) > XQTMIN(5) .AND. &
+ ZZW(:) < 0. .AND. (-ZZW(:) <= ZRSS(:)))
+ ZWQ1(:,5) = SIGN( MIN( ABS(ZQSS(:)),ABS(ZWQ1(:,5)) ),ZQSS(:) )
+ ZQSS(:) = ZQSS(:) - ZWQ1(:,5)
+ ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ1(:,5)/XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ1(:,5)/XECHARGE )
+ ENDWHERE
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPS', Unpack( zzw(:) * zlsfact(:) &
+ * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPS', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'DEPS', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPS', &
+ Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPS', &
+ Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'DEPS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+!
+!* 3.5.3.4 compute the aggregation on r_s: RIAGGS & QIAGGS
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'AGGS', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'AGGS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW(:) = 0.0
+ ZLATHAMIAGGS(:) = 1.0
+ IF (LIAGGS_LATHAM) THEN
+ ZLATHAMIAGGS(:) = 1.0 + 0.4E-10 * MIN( 2.25E10, &
+ ZEFIELDU(:)**2+ZEFIELDV(:)**2+ZEFIELDW(:)**2 )
+ ENDIF
+!
+ WHERE (ZRIT(:) > XRTMIN(4) .AND. ZRST(:) > XRTMIN(5) .AND. ZRIS(:) > 0.0)
+ ZZW(:) = MIN( ZRIS(:),XFIAGGS * EXP( XCOLEXIS*(ZZT(:)-XTT) ) &
+ * ZLATHAMIAGGS(:) &
+ * ZRIT(:) &
+ * ZLBDAS(:)**XEXIAGGS &
+ * ZRHOCOR(:) / ZCOR00 )
+ ZRSS(:) = ZRSS(:) + ZZW(:)
+ ZRIS(:) = ZRIS(:) - ZZW(:)
+ ZWQ1(:,3) = XCOEF_RQ_I * ZZW(:) * ZQIT(:) / ZRIT(:) ! QIAGGS_coal
+ END WHERE
+!
+ WHERE (ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRIS(:) > ZRSMIN_ELEC(4) .AND. &
+ ZRSS(:) > ZRSMIN_ELEC(5) .AND. ABS(ZQIT(:)) > XQTMIN(4))
+ ZWQ1(:,3) = SIGN( MIN( ABS(ZQIS(:)),ABS(ZWQ1(:,3)) ),ZQIS(:) )
+ ZQSS(:) = ZQSS(:) + ZWQ1(:,3)
+ ZQIS(:) = ZQIS(:) - ZWQ1(:,3)
+ END WHERE
+
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AGGS', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'AGGS', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'AGGS', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'AGGS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'NIIS', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'NIIS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ CALL ELEC_IAGGS_B() ! QIAGGS_boun
+
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'NIIS', &
+ Unpack( zqis(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'NIIS', &
+ Unpack( zqss(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+! Save the NI charging rate for temporal series
+ XNI_IAGGS(:,:,:) = UNPACK(ZWQ1(:,7), MASK=GMICRO, FIELD=0.0)
+ XNI_IAGGS(:,:,:) = XNI_IAGGS(:,:,:) * PRHODREF(:,:,:) ! C/m3/s
+!
+!* 3.5.3.5 compute the autoconversion of r_i for r_s production:
+! RIAUTS & QIAUTS
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'AUTS', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'AUTS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ALLOCATE( ZCRIAUTI(IMICRO ))
+ ZCRIAUTI(:) = MIN(XCRIAUTI,10**(0.06*(ZZT(:)-XTT)-3.5))
+ ZZW(:) = 0.0
+!
+ WHERE ((ZRIT(:) > XRTMIN(4)) .AND. (ZRIS(:) > 0.0))
+ ZZW(:) = MIN( ZRIS(:),XTIMAUTI * EXP( XTEXAUTI*(ZZT(:)-XTT) ) &
+ * MAX( ZRIT(:)-ZCRIAUTI(:),0.0 ) )
+ ZRSS(:) = ZRSS(:) + ZZW(:)
+ ZRIS(:) = ZRIS(:) - ZZW(:)
+ ZWQ1(:,4) = XCOEF_RQ_I * ZQIT(:) * ZZW(:) / ZRIT(:) ! QIAUTS
+ END WHERE
+!
+ WHERE (ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRIS(:) > ZRSMIN_ELEC(4) .AND. &
+ ZRSS(:) > ZRSMIN_ELEC(5) .AND. ABS(ZQIT(:)) > XQTMIN(4))
+ ZWQ1(:,4) = SIGN( MIN( ABS(ZQIS(:)),ABS(ZWQ1(:,4)) ),ZQIS(:) )
+ ZQSS(:) = ZQSS(:) + ZWQ1(:,4)
+ ZQIS(:) = ZQIS(:) - ZWQ1(:,4)
+ END WHERE
+!
+ DEALLOCATE(ZCRIAUTI)
+
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AUTS', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'AUTS', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'AUTS', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'AUTS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+!
+!* 3.5.3.6 compute the deposition on r_g: RVDEPG & QVDEPG
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPG', &
+ Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPG', &
+ Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'DEPG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW(:) = 0.0
+!
+ WHERE ((ZRGT(:) > XRTMIN(6)) .AND. (ZRGS(:) > 0.0))
+ ZZW(:) = (ZSSI(:) / (ZRHODREF(:) * 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(:)
+ ZWQ1(:,6) = XCOEF_RQ_G * ZQGT(:) * (-ZZW(:)) / ZRGT(:) ! sublimation
+ END WHERE
+!
+ WHERE (ZRGT(:) > XRTMIN_ELEC(6) .AND. ZRGS(:) > ZRSMIN_ELEC(6) .AND. &
+ ZRVS(:) > ZRSMIN_ELEC(1) .AND. ABS(ZQGT(:)) > XQTMIN(6) .AND. &
+ ZZW(:) < 0. .AND. (-ZZW(:)) <= ZRGS(:))
+ ZWQ1(:,6) = SIGN( MIN( ABS(ZQGS(:)),ABS(ZWQ1(:,6)) ),ZQGS(:) )
+ ZQGS(:) = ZQGS(:) - ZWQ1(:,6)
+ ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ1(:,6)/XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ1(:,6)/XECHARGE )
+ END WHERE
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPG', Unpack( zzw(:) * zlsfact(:) &
+ * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPG', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'DEPG', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPG', &
+ Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPG', &
+ Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'DEPG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ END SUBROUTINE RAIN_ICE_ELEC_SLOW
+!
+!-------------------------------------------------------------------------------
+!
+!
+ SUBROUTINE RAIN_ICE_ELEC_WARM
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+REAL :: ZCRIAUTC ! Critical cloud mixing ratio
+!
+!-------------------------------------------------------------------------------
+!
+!* 4.1 compute the autoconversion of r_c for r_r production:
+! RCAUTR & QCAUTR
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'AUTO', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'AUTO', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW(:) = 0.0
+ ZWQ1(:,1:3) = 0.0
+!
+ IF ( HSUBG_AUCV == 'CLFR' ) THEN
+ WHERE ((ZRCT(:) > 0.0) .AND. (ZRCS(:) > 0.0) .AND. (ZCF(:) > 0.0))
+ ZZW(:) = XTIMAUTC * MAX( ZRCT(:)/(ZCF(:)) -XCRIAUTC/ZRHODREF(:),0.0)
+ ZZW(:) = MIN( ZRCS(:),(ZCF(:))*ZZW(:))
+ ZRCS(:) = ZRCS(:) - ZZW(:)
+ ZRRS(:) = ZRRS(:) + ZZW(:)
+ ZWQ1(:,1) = XCOEF_RQ_C * ZQCT(:) * ZZW(:) / ZRCT(:) ! QCAUTR
+ END WHERE
+ ELSE IF (HSUBG_AUCV == 'SIGM') THEN
+ DO JL = 1, IMICRO
+ IF (ZRCS(JL) > 0.0) THEN
+ ZCRIAUTC = XCRIAUTC / ZRHODREF(JL)
+ IF (ZRCT(JL) > (ZCRIAUTC + ZSIGMA_RC(JL))) THEN
+ ZZW(JL) = MIN( ZRCS(JL) , XTIMAUTC* ( ZRCT(JL)-ZCRIAUTC ) )
+ ELSEIF (ZRCT(JL) > (ZCRIAUTC - ZSIGMA_RC(JL)) .AND. &
+ ZRCT(JL) <= (ZCRIAUTC + ZSIGMA_RC(JL))) THEN
+ ZZW(JL) = MIN( ZRCS(JL) , XTIMAUTC*( ZRCT(JL)+ZSIGMA_RC(JL)-ZCRIAUTC )**2 &
+ /( 4. * ZSIGMA_RC(JL) ) )
+ ENDIF
+ ZRCS(JL) = ZRCS(JL) - ZZW(JL)
+ ZRRS(JL) = ZRRS(JL) + ZZW(JL)
+ IF (ZRCT(JL) > 0.) THEN
+ ZWQ1(JL,1) = XCOEF_RQ_C * ZQCT(JL) * ZZW(JL) / ZRCT(JL)
+ END IF
+ ENDIF
+ END DO
+ ELSE
+ WHERE ((ZRCT(:) > XRTMIN(2)) .AND. (ZRCS(:) > 0.0))
+ ZZW(:) = MIN( ZRCS(:),XTIMAUTC*MAX( ZRCT(:)-XCRIAUTC/ZRHODREF(:),0.0 ) )
+ ZRCS(:) = ZRCS(:) - ZZW(:)
+ ZRRS(:) = ZRRS(:) + ZZW(:)
+ ZWQ1(:,1) = XCOEF_RQ_C * ZQCT(:) * ZZW(:) / ZRCT(:) ! QCAUTR
+ END WHERE
+ END IF
+!
+ WHERE (ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRCS(:) > ZRSMIN_ELEC(2) .AND. &
+ ZRRS(:) > ZRSMIN_ELEC(3) .AND. ABS(ZQCT(:)) > XQTMIN(2))
+ ZWQ1(:,1) = SIGN( MIN( ABS(ZQCS(:)),ABS(ZWQ1(:,1)) ),ZQCS(:) )
+ ZQCS(:) = ZQCS(:) - ZWQ1(:,1)
+ ZQRS(:) = ZQRS(:) + ZWQ1(:,1)
+ END WHERE
+
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'AUTO', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'AUTO', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'AUTO', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'AUTO', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+!
+!* 4.2 compute the accretion of r_c for r_r production: RCACCR & QCACCR
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'ACCR', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'ACCR', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW(:) = 0.0
+ WHERE ((ZRCT(:) > XRTMIN(2)) .AND. (ZRRT(:) > XRTMIN(3)) .AND. (ZRCS(:) > 0.0))
+ ZZW(:) = MIN( ZRCS(:),XFCACCR * ZRCT(:) &
+ * ZLBDAR(:)**XEXCACCR &
+ * ZRHOCOR(:)/ZCOR00 )
+ ZRCS(:) = ZRCS(:) - ZZW(:)
+ ZRRS(:) = ZRRS(:) + ZZW(:)
+ ZWQ1(:,2) = XCOEF_RQ_C * ZQCT(:) * ZZW(:) / ZRCT(:) ! QCACCR
+ END WHERE
+!
+ WHERE (ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRRS(:) > ZRSMIN_ELEC(3) .AND. &
+ ZRCS(:) > ZRSMIN_ELEC(2) .AND. ABS(ZQCT(:)) > XQTMIN(2))
+ ZWQ1(:,2) = SIGN( MIN( ABS(ZQCS(:)),ABS(ZWQ1(:,2)) ),ZQCS(:) )
+ ZQCS(:) = ZQCS(:) - ZWQ1(:,2)
+ ZQRS(:) = ZQRS(:) + ZWQ1(:,2)
+ ENDWHERE
+
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'ACCR', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'ACCR', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'ACCR', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'ACCR', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 4.3 compute the evaporation of r_r: RREVAV & QREVAV
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'REVA', &
+ Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'REVA', &
+ Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'REVA', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW(:) = 0.0
+ WHERE ((ZRRT(:) > XRTMIN(3)) .AND. (ZRCT(:) <= XRTMIN(2)))
+ ZZW(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
+ ZUSW(:) = 1.0 - ZRVT(:) * (ZPRES(:) - ZZW(:)) / ((XMV / XMD) * ZZW(:))
+ ! Undersaturation over water
+ ZZW(:) = (XLVTT + (XCPV - XCL) * (ZZT(:) - XTT) )**2 / &
+ (ZKA(:) * XRV * ZZT(:)**2) + &
+ (XRV * ZZT(:)) / (ZDV(:) * ZZW(:))
+ ZZW(:) = MIN( ZRRS(:),( MAX( 0.0,ZUSW(:) )/(ZRHODREF(:)*ZZW(:)) ) * &
+ ( X0EVAR*ZLBDAR(:)**XEX0EVAR+X1EVAR*ZCJ(:)*ZLBDAR(:)**XEX1EVAR ) )
+ ZRRS(:) = ZRRS(:) - ZZW(:)
+ ZRVS(:) = ZRVS(:) + ZZW(:)
+ ZTHS(:) = ZTHS(:) - ZZW(:)*ZLVFACT(:)
+ ZWQ1(:,3) = XCOEF_RQ_R * ZQRT(:) * ZZW(:) / ZRRT(:) ! QREVAV
+ END WHERE
+!
+ WHERE (ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRRS(:) > ZRSMIN_ELEC(3) .AND. &
+ ZRVS(:) > ZRSMIN_ELEC(1) .AND. ZRCT(:) <= 0.0 .AND. &
+ ABS(ZQRT(:)) > XQTMIN(3))
+ ZWQ1(:,3) = SIGN( MIN( ABS(ZQRS(:)),ABS(ZWQ1(:,3)) ),ZQRS(:) )
+ ZQRS(:) = ZQRS(:) - ZWQ1(:,3)
+ ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ1(:,3)/XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ1(:,3)/XECHARGE )
+ ENDWHERE
+!
+ PEVAP3D(:,:,:)=UNPACK(ZZW(:),MASK=GMICRO(:,:,:),FIELD=PEVAP3D(:,:,:))
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'REVA', &
+ Unpack( -zzw(:) * zlvfact(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'REVA', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'REVA', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'REVA', &
+ Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'REVA', &
+ Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'REVA', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ END SUBROUTINE RAIN_ICE_ELEC_WARM
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE RAIN_ICE_ELEC_FAST_RS
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!-------------------------------------------------------------------------------
+!
+!* 5.1 cloud droplet riming of the aggregates
+!
+ ZZW1(:,:) = 0.0
+ ZWQ1(:,1:7) = 0.0
+!
+ ALLOCATE( GRIM(IMICRO) )
+ GRIM(:) = (ZRCT(:) > XRTMIN(2)) .AND. (ZRST(:) > XRTMIN(5)) .AND. &
+ (ZRCS(:) > 0.0) .AND. (ZZT(:) < XTT)
+ IGRIM = COUNT( GRIM(:) )
+!
+ IF (IGRIM > 0) THEN
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'RIM', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'RIM', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'RIM', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+!
+! 5.1.0 allocations
+!
+ ALLOCATE( ZVEC1(IGRIM) )
+ ALLOCATE( ZVEC2(IGRIM) )
+ ALLOCATE( IVEC1(IGRIM) )
+ ALLOCATE( IVEC2(IGRIM) )
+!
+!* 5.1.1 select the ZLBDAS
+!
+ ZVEC1(:) = PACK( ZLBDAS(:),MASK=GRIM(:) )
+!
+!* 5.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( REAL(NGAMINC)-0.00001, &
+ XRIMINTP1 * LOG( ZVEC1(1:IGRIM) ) + XRIMINTP2 ) )
+ IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) )
+ ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - REAL( IVEC2(1:IGRIM) )
+!
+!* 5.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 )
+!
+!* 5.1.4 riming of the small sized aggregates
+!
+ WHERE (GRIM(:) .AND. ZRCS(:) > 0.0)
+ ZZW1(:,1) = MIN( ZRCS(:), &
+ XCRIMSS * ZZW(:) * ZRCT(:) * & ! RCRIMSS
+ ZLBDAS(:)**XEXCRIMSS * ZRHOCOR(:)/ZCOR00 )
+ ZRCS(:) = ZRCS(:) - ZZW1(:,1)
+ ZRSS(:) = ZRSS(:) + ZZW1(:,1)
+ ZTHS(:) = ZTHS(:) + ZZW1(:,1) * (ZLSFACT(:) - ZLVFACT(:)) ! f(L_f*(RCRIMSS))
+ ZWQ1(:,1) = XCOEF_RQ_C * ZQCT(:) * ZZW1(:,1) / ZRCT(:) ! QCRIMSS
+ END WHERE
+!
+ WHERE (ZZT(:) < XTT .AND. &
+ ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRSS(:) > ZRSMIN_ELEC(5) .AND. &
+ ABS(ZQCT(:)) > XQTMIN(2) .AND. ZRCS(:) > ZRSMIN_ELEC(2))
+ ZWQ1(:,1) = SIGN( MIN( ABS(ZQCS(:)),ABS(ZWQ1(:,1)) ),ZQCS(:) )
+ ZQCS(:) = ZQCS(:) - ZWQ1(:,1)
+ ZQSS(:) = ZQSS(:) + ZWQ1(:,1)
+ ENDWHERE
+!
+!* 5.1.5 perform the linear interpolation of the normalized
+!* "XBS"-moment of the incomplete gamma function
+!
+ ZVEC1(1:IGRIM) = XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
+ - XGAMINC_RIM2( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
+ ZZW(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GRIM,FIELD=0.0 )
+!
+!
+!* 5.1.6 perform the linear interpolation of the normalized
+!* "XFS"-moment of the incomplete gamma function
+!
+ ZVEC1(1:IGRIM) = XGAMINC_RIM3( IVEC2(1:IGRIM)+1 ) * ZVEC2(1:IGRIM) &
+ - XGAMINC_RIM3( IVEC2(1:IGRIM) ) * (ZVEC2(1:IGRIM) - 1.0)
+ ZWQ1(:,3) = UNPACK( VECTOR=ZVEC1(:), MASK=GRIM, FIELD=0.0 )
+!
+!* 5.1.7 riming-conversion of the large sized aggregates into graupeln:
+!* RSRIMCG & QSRIMCG and RCRIMSG & QCRIMSG
+!
+ WHERE (GRIM(:) .AND. ZRSS(:) > 0.0 .AND. ZRCS(:) > 0.0 .AND. ZZW(:) < 1.)
+ ZZW1(:,2) = MIN( ZRCS(:), &
+ XCRIMSG * ZRCT(:) & ! RCRIMSG
+ * ZLBDAS(:)**XEXCRIMSG &
+ * ZRHOCOR(:)/ZCOR00 - 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))
+ ZWQ1(:,2) = XCOEF_RQ_C * ZQCT(:) * ZZW1(:,2) / ZRCT(:) ! QCRIMSG
+ ZWQ1(:,3) = XQSRIMCG * ZEST(:) * & ! QSRIMCG
+ ZLBDAS(:)**XEXQSRIMCG * (1. - ZWQ1(:,3)) / &
+ (PTSTEP * ZRHODREF(:))
+ END WHERE
+!
+ WHERE (ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZRCS(:) > ZRSMIN_ELEC(2) .AND. &
+ ZZT(:) < XTT .AND. ABS(ZQCT(:)) > XQTMIN(2))
+ ZWQ1(:,2) = SIGN( MIN( ABS(ZQCS(:)),ABS(ZWQ1(:,2)) ),ZQCS(:) )
+ ZQGS(:) = ZQGS(:) + ZWQ1(:,2)
+ ZQCS(:) = ZQCS(:) - ZWQ1(:,2)
+ ENDWHERE
+!
+ WHERE (ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZRCS(:) > ZRSMIN_ELEC(2) .AND. &
+ ZZT(:) < XTT .AND. ABS(ZQCT(:)) > XQTMIN(2) .AND. &
+ ABS(ZEST) > XESMIN)
+ ZWQ1(:,3) = SIGN( MIN( ABS(ZQSS(:)),ABS(ZWQ1(:,3)) ),ZQSS(:) )
+ ZQGS(:) = ZQGS(:) + ZWQ1(:,3)
+ ZQSS(:) = ZQSS(:) - ZWQ1(:,3)
+ ENDWHERE
+!
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'RIM', Unpack( ( zzw1(:,1) + zzw1(:,2) ) &
+ * ( zlsfact(:) - zlvfact(:) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'RIM', &
+ Unpack( ( -zzw1(:,1) - zzw1(:,2) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'RIM', &
+ Unpack( ( zzw1(:,1) - zzw1(:,3) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'RIM', &
+ Unpack( ( zzw1(:,2) + zzw1(:,3) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'RIM', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'RIM', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'RIM', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+ END IF
+!
+ DEALLOCATE(GRIM)
+!
+!
+!* 5.2 rain accretion onto the aggregates
+!
+ ZZW1(:,2:3) = 0.0
+ ZWQ4(:) = 0.0
+!
+ ALLOCATE(GACC(IMICRO))
+ GACC(:) = ZRRT(:)>XRTMIN(3) .AND. ZRST(:)>XRTMIN(5) .AND. &
+ ZRRS(:) > 0.0 .AND. ZZT(:) < XTT
+ IGACC = COUNT( GACC(:) )
+!
+ IF( IGACC>0 ) THEN
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'ACC', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'ACC', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'ACC', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'ACC', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'ACC', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'ACC', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'ACC', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+!
+! 5.2.0 allocations
+!
+ ALLOCATE(ZVEC1(IGACC))
+ ALLOCATE(ZVEC2(IGACC))
+ ALLOCATE(ZVEC3(IGACC))
+ ALLOCATE(IVEC1(IGACC))
+ ALLOCATE(IVEC2(IGACC))
+!
+ ALLOCATE( ZVECQ4(IGACC) )
+ ALLOCATE( ZVECQ5(IGACC) )
+ ALLOCATE( ZVECQ6(IGACC) )
+!
+!
+! 5.2.1 select the (ZLBDAS,ZLBDAR) couplet
+!
+ ZVEC1(:) = PACK( ZLBDAS(:),MASK=GACC(:) )
+ ZVEC2(:) = PACK( ZLBDAR(:),MASK=GACC(:) )
+!
+! 5.2.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( REAL(NACCLBDAS)-0.00001, &
+ XACCINTP1S * LOG( ZVEC1(1:IGACC) ) + XACCINTP2S ) )
+ IVEC1(1:IGACC) = INT( ZVEC1(1:IGACC) )
+ ZVEC1(1:IGACC) = ZVEC1(1:IGACC) - REAL( IVEC1(1:IGACC) )
+!
+ ZVEC2(1:IGACC) = MAX( 1.00001, MIN( REAL(NACCLBDAR)-0.00001, &
+ XACCINTP1R * LOG( ZVEC2(1:IGACC) ) + XACCINTP2R ) )
+ IVEC2(1:IGACC) = INT( ZVEC2(1:IGACC) )
+ ZVEC2(1:IGACC) = ZVEC2(1:IGACC) - REAL( IVEC2(1:IGACC) )
+!
+! 5.2.3 perform the bilinear interpolation of the normalized
+! RACCSS-kernel
+!
+ ZVEC3(:) = BI_LIN_INTP_V(XKER_RACCSS, IVEC1, IVEC2, ZVEC1, ZVEC2, IGACC)
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GACC,FIELD=0.0 )
+!
+ ZVECQ5(:) = BI_LIN_INTP_V(XKER_Q_RACCSS, IVEC1, IVEC2, ZVEC1, ZVEC2, IGACC)
+ ZWQ1(:,5) = UNPACK( VECTOR=ZVECQ5(:), MASK=GACC, FIELD=0.0 )
+!
+! 5.2.4 raindrop accretion on the small sized aggregates:
+! RRACCSS & QRACCSS
+!
+ WHERE ( GACC(:) )
+ ZZW1(:,2) = & !! coef of RRACCS
+ XFRACCSS*( ZLBDAS(:)**XCXS )*ZRHOCOR(:)/(ZCOR00* ZRHODREF(:)) &
+ *( XLBRACCS1/((ZLBDAS(:)**2) ) + &
+ XLBRACCS2/( ZLBDAS(:) * ZLBDAR(:) ) + &
+ XLBRACCS3/( (ZLBDAR(:)**2)) )/ZLBDAR(:)**4
+ 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))
+ ZWQ4(:) = XFQRACCS * ZERT(:) * ZRHOCOR(:)/(ZCOR00* ZRHODREF(:)) * &
+ ZLBDAR(:)**XCXR * ZLBDAS(:)**XCXS * &
+ (XLBQRACCS1 * ZLBDAR(:)**(-2.0 - XFR) + &
+ XLBQRACCS2 * ZLBDAR(:)**(-1.0 - XFR) * ZLBDAS(:)**(-1.0) + &
+ XLBQRACCS3 * ZLBDAR(:)**(-XFR) * ZLBDAS(:)**(-2.0))
+ ZWQ1(:,5) = ZWQ1(:,5) * ZWQ4(:) ! QRACCSS
+ END WHERE
+!
+ WHERE (ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZRRS(:) > ZRSMIN_ELEC(3) .AND. ZZT(:) < XTT .AND. &
+ ABS(ZQRS(:)) > XQTMIN(3) .AND. ABS(ZERT) > XERMIN)
+ ZWQ1(:,5) = SIGN( MIN( ABS(ZQRS(:)),ABS(ZWQ1(:,5)) ),ZQRS(:) )
+ ZQRS(:) = ZQRS(:) - ZWQ1(:,5)
+ ZQSS(:) = ZQSS(:) + ZWQ1(:,5)
+ ENDWHERE
+!
+! 5.2.5 perform the bilinear interpolation of the normalized
+! RACCS-kernel
+!
+ ZVEC3(:) = BI_LIN_INTP_V(XKER_RACCS, IVEC1, IVEC2, ZVEC1, ZVEC2, IGACC)
+ ZZW1(:,2) = ZZW1(:,2)*UNPACK( VECTOR=ZVEC3(:),MASK=GACC(:),FIELD=0.0 )
+ !! RRACCS!
+!
+ ZVECQ4(:) = BI_LIN_INTP_V(XKER_Q_RACCS, IVEC1, IVEC2, ZVEC1, ZVEC2, IGACC)
+ ZWQ1(:,4) = UNPACK( VECTOR=ZVECQ4(:), MASK=GACC, FIELD=0.0 )
+!
+! 5.2.6 perform the bilinear interpolation of the normalized
+! SACCRG-kernel
+!
+ ZVEC3(:) = BI_LIN_INTP_V(XKER_SACCRG, IVEC2, IVEC1, ZVEC2, ZVEC1, IGACC)
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GACC,FIELD=0.0 )
+!
+ ZVECQ6(:) = BI_LIN_INTP_V(XKER_Q_SACCRG, IVEC2,IVEC1, ZVEC2, ZVEC1, IGACC)
+ ZWQ1(:,6) = UNPACK( VECTOR=ZVECQ6(:), MASK=GACC, FIELD=0.0 )
+ ZWQ1(:,4) = ZWQ1(:,4) * ZWQ4(:) ! QRACCS
+!
+! 5.2.7 raindrop accretion-conversion of the large sized aggregates
+! into graupeln: RRACCSG & QRACCSG and RSACCRG & QSACCRG
+!
+ 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) )*ZRHOCOR(:)/(ZCOR00* ZRHODREF(:)) &
+ *( XLBSACCR1/((ZLBDAR(:)**2) ) + &
+ XLBSACCR2/( ZLBDAR(:) * ZLBDAS(:) ) + &
+ XLBSACCR3/( (ZLBDAS(:)**2)) )/ZLBDAR(:) )
+ ZRRS(:) = ZRRS(:) - ZZW1(:,2)
+ ZRSS(:) = ZRSS(:) - ZZW1(:,3)
+ ZRGS(:) = ZRGS(:) + ZZW1(:,2)+ZZW1(:,3)
+ ZTHS(:) = ZTHS(:) + ZZW1(:,2)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RRACCSG))
+ ZWQ1(:,4) = ZWQ1(:,4) - ZWQ1(:,5) ! QRACCSG
+ ZWQ1(:,6) = ZWQ1(:,6) * XFQRACCS * ZEST(:) * &
+ ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) * &
+ ZLBDAR(:)**XCXR * ZLBDAS(:)**XCXS * &
+ (XLBQSACCRG1 * ZLBDAS(:)**(-2.0 - XFS) + &
+ XLBQSACCRG2 * ZLBDAS(:)**(-1.0 - XFS) * ZLBDAR(:)**(-1.0) + &
+ XLBQSACCRG3 * ZLBDAS(:)**(-XFS) * ZLBDAR(:)**(-2.0)) ! QSACCR
+ END WHERE
+!
+ WHERE (ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZRRS(:) > ZRSMIN_ELEC(3) .AND. &
+ ZZT(:) < XTT .AND. ABS(ZQGS(:)) > XQTMIN(6))
+ ZWQ1(:,4) = SIGN( MIN( ABS(ZQRS(:)),ABS(ZWQ1(:,4)) ),ZQRS(:) )
+ ZQRS(:) = ZQRS(:) - ZWQ1(:,4)
+ ZQGS(:) = ZQGS(:) + ZWQ1(:,4)
+ ENDWHERE
+!
+ WHERE (ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZRRS(:) > ZRSMIN_ELEC(3) .AND. &
+ ZZT(:) < XTT .AND. ABS(ZQGS(:)) > XQTMIN(6) .AND. &
+ ABS(ZEST) > XESMIN)
+ ZWQ1(:,6) = SIGN( MIN( ABS(ZQSS(:)),ABS(ZWQ1(:,6)) ),ZQSS(:) )
+ ZQSS(:) = ZQSS(:) - ZWQ1(:,6)
+ ZQGS(:) = ZQGS(:) + ZWQ1(:,6)
+ ENDWHERE
+!
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ DEALLOCATE( ZVECQ4 )
+ DEALLOCATE( ZVECQ5 )
+ DEALLOCATE( ZVECQ6 )
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'ACC', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'ACC', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'ACC', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'ACC', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'ACC', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'ACC', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'ACC', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+ END IF
+
+ DEALLOCATE(GACC)
+!
+!* 5.3 Conversion-Melting of the aggregates: RSMLT & QSMLT
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'CMEL', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'CMEL', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW(:) = 0.0
+ WHERE ((ZRST(:) > XRTMIN(5)) .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(:)
+ ZWQ1(:,7) = XCOEF_RQ_S * ZQST(:) * ZZW(:) / ZRST(:) ! QSMLT
+ END WHERE
+!
+ WHERE (ZRST(:) > XRTMIN_ELEC(5) .AND. ZRSS(:) > ZRSMIN_ELEC(5) .AND. &
+ ZRGT(:) > XRTMIN_ELEC(6) .AND. ABS(ZQST(:)) > XQTMIN(5) .AND. &
+ ZZT(:) > XTT .AND. ZRHODREF(:)*XLMTT > 0.)
+ ZWQ1(:,7) = SIGN( MIN( ABS(ZQSS(:)),ABS(ZWQ1(:,7)) ),ZQSS(:) )
+ ZQGS(:) = ZQGS(:) + ZWQ1(:,7)
+ ZQSS(:) = ZQSS(:) - ZWQ1(:,7)
+ ENDWHERE
+
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'CMEL', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'CMEL', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'CMEL', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'CMEL', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ END SUBROUTINE RAIN_ICE_ELEC_FAST_RS
+!
+!-------------------------------------------------------------------------------
+!
+!
+ SUBROUTINE RAIN_ICE_ELEC_FAST_RG
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!-------------------------------------------------------------------------------
+!
+!* 6.1 rain contact freezing: RICFRRG & QICFRRG and RRCFRIG & QRCFRIG
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'CFRZ', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'CFRZ', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'CFRZ', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW1(:,3:4) = 0.0
+ ZWQ1(:,3:4) = 0.0
+ WHERE ((ZRIT(:) > XRTMIN(4)) .AND. (ZRRT(:) > XRTMIN(3)) .AND. &
+ (ZRIS(:) > 0.0) .AND. (ZRRS(:) > 0.0))
+ ZZW1(:,3) = MIN( ZRIS(:),XICFRR * ZRIT(:) & ! RICFRRG
+ * ZLBDAR(:)**XEXICFRR &
+ * ZRHOCOR(:) / ZCOR00 )
+ ZZW1(:,4) = MIN( ZRRS(:),XRCFRI * ZCIT(:) & ! RRCFRIG
+ * ZLBDAR(:)**XEXRCFRI &
+ * ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) )
+ ZRIS(:) = ZRIS(:) - ZZW1(:,3)
+ ZRRS(:) = ZRRS(:) - ZZW1(:,4)
+ ZRGS(:) = ZRGS(:) + ZZW1(:,3) + ZZW1(:,4)
+ ZTHS(:) = ZTHS(:) + ZZW1(:,4) * (ZLSFACT(:) - ZLVFACT(:)) ! f(L_f*RRCFRIG)
+ ZWQ1(:,4) = XQRCFRIG * ZLBDAR(:)**XEXQRCFRIG * ZCIT(:) * &
+ ZERT(:) * ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) ! QRCFRIG
+ ZWQ1(:,3) = XCOEF_RQ_I * ZQIT(:) * ZZW1(:,3) / ZRIT(:) ! QICFRRG
+ END WHERE
+!
+ WHERE (ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRRT(:) > XRTMIN_ELEC(3) .AND. &
+ ZRIS(:) > ZRSMIN_ELEC(4) .AND. ZRRS(:) > ZRSMIN_ELEC(3) .AND. &
+ ABS(ZERT) > XERMIN .AND. ABS(ZQRT(:)) > XQTMIN(3))
+ ZWQ1(:,4) = SIGN( MIN( ABS(ZQRS(:)),ABS(ZWQ1(:,4)) ),ZQRS(:) )
+ ZQGS(:) = ZQGS(:) + ZWQ1(:,4)
+ ZQRS(:) = ZQRS(:) - ZWQ1(:,4)
+ ENDWHERE
+!
+ WHERE (ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRRT(:) > XRTMIN_ELEC(3) .AND. &
+ ZRIS(:) > ZRSMIN_ELEC(4) .AND. ZRRS(:) > ZRSMIN_ELEC(3) .AND. &
+ ABS(ZQIT(:)) > XQTMIN(4))
+ ZWQ1(:,3) = SIGN( MIN( ABS(ZQIS(:)),ABS(ZWQ1(:,3)) ),ZQIS(:) )
+ ZQGS(:) = ZQGS(:) + ZWQ1(:,3)
+ ZQIS(:) = ZQIS(:) - ZWQ1(:,3)
+ ENDWHERE
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'CFRZ', Unpack( zzw1(:,4) * ( zlsfact(:) - zlvfact(:) ) &
+ * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'CFRZ', &
+ Unpack( -zzw1(:, 4) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'CFRZ', &
+ Unpack( -zzw1(:, 3) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'CFRZ', &
+ Unpack( ( zzw1(:, 3) + zzw1(:, 4) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'CFRZ', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'CFRZ', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'CFRZ', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+!
+!* 6.2 compute the Dry growth case
+!
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETG', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETG', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETG', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETG', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETG', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETG', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETG', &
+ Unpack( zrhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'WETG', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'WETG', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'WETG', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'WETG', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'WETG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( krr == 7 ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'WETG', &
+ Unpack( zqhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW1(:,:) = 0.0
+ ZWQ1(:,1:10) = 0.0
+ ZWQ3(:) = 0.0
+ ZWQ4(:) = 0.0
+!
+!* 6.2.1 compute RCDRYG & QCDRYG
+!
+ WHERE ((ZRGT(:) > XRTMIN(6)) .AND. ((ZRCT(:) > XRTMIN(2) .AND. ZRCS(:) > 0.0)))
+ ZZW(:) = ZLBDAG(:)**(XCXG-XDG-2.0) * ZRHOCOR(:) / ZCOR00
+ ZZW1(:,1) = MIN( ZRCS(:),XFCDRYG * ZRCT(:) * ZZW(:) ) ! RCDRYG
+ ZWQ1(:,1) = XCOEF_RQ_C * ZQCT(:) * ZZW1(:,1) / ZRCT(:) ! QCDRYG
+ END WHERE
+!
+ WHERE (ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ABS(ZQCT(:)) > XQTMIN(2) .AND. ZRCS(:) > ZRSMIN_ELEC(2))
+ ZWQ1(:,1) = SIGN( MIN( ABS(ZQCS(:)),ABS(ZWQ1(:,1)) ),ZQCS(:) )
+ ELSEWHERE
+ ZWQ1(:,1) = 0.
+ ENDWHERE
+!
+!* 6.2.2 compute RIDRYG & QIDRYG
+!
+ WHERE ((ZRGT(:) > XRTMIN(6)) .AND. ((ZRIT(:) > XRTMIN(4) .AND. ZRIS(:) > 0.0)) )
+ ZZW(:) = ZLBDAG(:)**(XCXG-XDG-2.0) * ZRHOCOR(:)/ZCOR00
+ ZZW1(:,2) = MIN( ZRIS(:),XFIDRYG * EXP( XCOLEXIG*(ZZT(:)-XTT) ) &
+ * ZRIT(:) * ZZW(:) ) ! RIDRYG
+ ZWQ1(:,2) = XCOEF_RQ_I * ZQIT(:) * ZZW1(:,2) / ZRIT(:) ! QIDRYG_coal
+ END WHERE
+!
+ WHERE (GELEC(:,2))
+ ZWQ1(:,2) = SIGN( MIN( ABS(ZQIS(:)),ABS(ZWQ1(:,2)) ),ZQIS(:) )
+ ELSEWHERE
+ ZWQ1(:,2) = 0.
+ ENDWHERE
+!
+ CALL ELEC_IDRYG_B() ! QIDRYG_boun
+!
+! Save the NI charging rate for temporal series
+ XNI_IDRYG(:,:,:) = UNPACK(ZWQ1(:,3), MASK=GMICRO, FIELD=0.0)
+ XNI_IDRYG(:,:,:) = XNI_IDRYG(:,:,:) * PRHODREF(:,:,:) ! C/m3/s
+!
+!* 6.2.3 accretion of aggregates on the graupeln
+!
+ ALLOCATE(GDRY(IMICRO))
+ GDRY(:) = (ZRST(:)>XRTMIN(5)) .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRSS(:)>0.0)
+ IGDRY = COUNT( GDRY(:) )
+!
+ IF( IGDRY>0 ) THEN
+!
+! 6.2.3.1 allocations
+!
+ ALLOCATE(ZVEC1(IGDRY))
+ ALLOCATE(ZVEC2(IGDRY))
+ ALLOCATE(ZVEC3(IGDRY))
+ ALLOCATE(IVEC1(IGDRY))
+ ALLOCATE(IVEC2(IGDRY))
+!
+ ALLOCATE( ZVECQ4(IGDRY) )
+ ALLOCATE( ZVECQ5(IGDRY) )
+ ALLOCATE( ZVECQ6(IGDRY) )
+!
+ IF (CNI_CHARGING == 'TAKAH' .OR. CNI_CHARGING == 'SAUN1' .OR. &
+ CNI_CHARGING == 'SAUN2' .OR. CNI_CHARGING == 'SAP98' .OR. &
+ CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2' .OR. &
+ CNI_CHARGING == 'TEEWC' .OR. CNI_CHARGING == 'TERAR' .OR. &
+ CNI_CHARGING == 'GARDI') &
+!
+ ALLOCATE( ZAUX(IGDRY) )
+!
+! 6.2.3.2 select the (ZLBDAG,ZLBDAS) couplet
+!
+ ZVEC1(:) = PACK( ZLBDAG(:),MASK=GDRY(:) )
+ ZVEC2(:) = PACK( ZLBDAS(:),MASK=GDRY(:) )
+!
+! 6.2.3.3 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( REAL(NDRYLBDAG)-0.00001, &
+ XDRYINTP1G * LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) )
+ IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) )
+ ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - REAL( IVEC1(1:IGDRY) )
+!
+ ZVEC2(1:IGDRY) = MAX( 1.00001, MIN( REAL(NDRYLBDAS)-0.00001, &
+ XDRYINTP1S * LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2S ) )
+ IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
+ ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) )
+!
+! 6.2.3.4 perform the bilinear interpolation of the normalized
+! SDRYG-kernel
+!
+! normalized SDRYG-kernel
+ ZVEC3(:) = BI_LIN_INTP_V(XKER_SDRYG, IVEC1, IVEC2, ZVEC1, ZVEC2, IGDRY)
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 )
+!
+! normalized Q-SDRYG-kernel
+ ZVECQ4(:) = BI_LIN_INTP_V(XKER_Q_SDRYG, IVEC1, IVEC2, ZVEC1, ZVEC2, IGDRY)
+ ZWQ1(:,4) = UNPACK( VECTOR=ZVECQ4(:), MASK=GDRY, FIELD=0.0 )
+!
+! normalized Q-???-kernel
+ IF (CNI_CHARGING == 'TAKAH' .OR. CNI_CHARGING == 'SAUN1' .OR. &
+ CNI_CHARGING == 'SAUN2' .OR. CNI_CHARGING == 'SAP98' .OR. &
+ CNI_CHARGING == 'GARDI' .OR. &
+ CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2' .OR. &
+ CNI_CHARGING == 'TEEWC' .OR. CNI_CHARGING == 'TERAR') THEN
+ ZAUX(:) = BI_LIN_INTP_V(XKER_Q_LIMSG, IVEC1, IVEC2, ZVEC1, ZVEC2, IGDRY)
+ ZAUX1(:) = UNPACK( VECTOR=ZAUX(:), MASK=GDRY, FIELD=0.0 )
+ END IF
+!
+! normalized Q-SDRYG-bouncing kernel
+ IF (CNI_CHARGING == 'TAKAH' .OR. CNI_CHARGING == 'HELFA' .OR. &
+ CNI_CHARGING == 'GARDI') THEN
+ ZVECQ5(:) = BI_LIN_INTP_V(XKER_Q_SDRYGB,IVEC1,IVEC2,ZVEC1,ZVEC2,IGDRY)
+ ZWQ1(:,10) = UNPACK( VECTOR=ZVECQ5(:), MASK=GDRY, FIELD=0.0 )
+ ELSE
+ ZVECQ5(:) = BI_LIN_INTP_V(XKER_Q_SDRYGB1,IVEC1,IVEC2,ZVEC1,ZVEC2,IGDRY)
+ ZWQ3(:) = UNPACK( VECTOR=ZVECQ5(:), MASK=GDRY, FIELD=0.0 ) ! Dvqsgmn if charge>0
+ ZVECQ6(:) = BI_LIN_INTP_V(XKER_Q_SDRYGB2,IVEC1,IVEC2,ZVEC1,ZVEC2,IGDRY)
+ ZWQ4(:) = UNPACK( VECTOR=ZVECQ6(:), MASK=GDRY, FIELD=0.0 ) ! Dvqsgmn if charge<0
+ ENDIF
+!
+! 6.2.3.5 compute RSDRYG and QSDRYG = QSDRYG_coal + QSDRYG_boun
+!
+ WHERE( GDRY(:) )
+ ZZW1(:,3) = MIN( ZRSS(:),XFSDRYG*ZZW(:) & ! RSDRYG
+ * EXP( XCOLEXSG*(ZZT(:)-XTT) ) &
+ *( ZLBDAS(:)**(XCXS-XBS) )*( ZLBDAG(:)**XCXG ) &
+ * ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) &
+ *( XLBSDRYG1/( ZLBDAG(:)**2 ) + &
+ XLBSDRYG2/( ZLBDAG(:) * ZLBDAS(:) ) + &
+ XLBSDRYG3/( ZLBDAS(:)**2) ) )
+ ZWQ1(:,4) = ZWQ1(:,4) * XFQSDRYG * &
+ XCOLSG * EXP(XCOLEXSG * (ZZT(:) - XTT)) * &
+ ZEST(:) * ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) * &
+ ZLBDAG(:)**XCXG * ZLBDAS(:)**XCXS * &
+ (XLBQSDRYG1 * ZLBDAS(:)**(-2.0-XFS) + &
+ XLBQSDRYG2 * ZLBDAS(:)**(-1.0-XFS) * ZLBDAG(:)**(-1.0) + &
+ XLBQSDRYG3 * ZLBDAS(:)**(-XFS) * ZLBDAG(:)**(-2.0)) ! QSDRYG_coal
+ END WHERE
+!
+ WHERE (ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZRGS(:) > ZRSMIN_ELEC(6) .AND. ABS(ZQST(:)) > XQTMIN(5) .AND. &
+ ABS(ZEST) > XESMIN)
+ ZWQ1(:,4) = SIGN( MIN( ABS(ZQSS(:)),ABS(ZWQ1(:,4)) ),ZQSS(:) )
+ ELSEWHERE
+ ZWQ1(:,4) = 0.
+ END WHERE
+!
+! QSDRYG_boun
+ CALL ELEC_SDRYG_B()
+!
+! save the NI charging rate for temporal series
+ XNI_SDRYG(:,:,:) = UNPACK(ZWQ1(:,5), MASK=GMICRO, FIELD=0.0)
+ XNI_SDRYG(:,:,:) = XNI_SDRYG(:,:,:) * PRHODREF(:,:,:) ! C/m3/
+!
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+!
+ DEALLOCATE( ZVECQ4 )
+ DEALLOCATE( ZVECQ5 )
+ DEALLOCATE( ZVECQ6 )
+ IF (ALLOCATED(ZAUX)) DEALLOCATE( ZAUX )
+ END IF
+!
+!
+!* 6.2.4 accretion of raindrops on the graupeln
+!
+ GDRY(:) = (ZRRT(:)>XRTMIN(3)) .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRRS(:)>0.0)
+ IGDRY = COUNT( GDRY(:) )
+!
+ IF( IGDRY>0 ) THEN
+!
+! 6.2.4.1 allocations
+!
+ ALLOCATE(ZVEC1(IGDRY))
+ ALLOCATE(ZVEC2(IGDRY))
+ ALLOCATE(ZVEC3(IGDRY))
+ ALLOCATE(IVEC1(IGDRY))
+ ALLOCATE(IVEC2(IGDRY))
+ ALLOCATE(ZVECQ4(IGDRY))
+!
+! 6.2.4.2 select the (ZLBDAG,ZLBDAR) couplet
+!
+ ZVEC1(:) = PACK( ZLBDAG(:),MASK=GDRY(:) )
+ ZVEC2(:) = PACK( ZLBDAR(:),MASK=GDRY(:) )
+!
+! 6.2.4.3 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( REAL(NDRYLBDAG)-0.00001, &
+ XDRYINTP1G * LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) )
+ IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) )
+ ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - REAL( IVEC1(1:IGDRY) )
+!
+ ZVEC2(1:IGDRY) = MAX( 1.00001, MIN( REAL(NDRYLBDAR)-0.00001, &
+ XDRYINTP1R * LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2R ) )
+ IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
+ ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) )
+!
+! 6.2.4.4 perform the bilinear interpolation of the normalized
+! RDRYG-kernel
+!
+ ZVEC3(:) = BI_LIN_INTP_V(XKER_RDRYG, IVEC1, IVEC2, ZVEC1, ZVEC2, IGDRY)
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 )
+!
+ ZVECQ4(:) = BI_LIN_INTP_V(XKER_Q_RDRYG, IVEC1, IVEC2, ZVEC1, ZVEC2, IGDRY)
+ ZWQ1(:,6) = UNPACK( VECTOR=ZVECQ4(:), MASK=GDRY, FIELD=0.0 )
+!
+! 6.2.4.5 compute RRDRYG and QRDRYG
+!
+ WHERE( GDRY(:) )
+ ZZW1(:,4) = MIN( ZRRS(:),XFRDRYG*ZZW(:) & ! RRDRYG
+ *( ZLBDAR(:)**(-4) )*( ZLBDAG(:)**XCXG ) &
+ * ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) &
+ *( XLBRDRYG1/( ZLBDAG(:)**2 ) + &
+ XLBRDRYG2/( ZLBDAG(:) * ZLBDAR(:) ) + &
+ XLBRDRYG3/( ZLBDAR(:)**2) ) )
+ ZWQ1(:,6) = ZWQ1(:,6) * XFQRDRYG * &
+ ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) * &
+ ZERT(:) * ZLBDAG(:)**XCXG * ZLBDAR(:)**XCXR * &
+ (XLBQRDRYG1 * ZLBDAR(:)**(-2.0 - XFR) + &
+ XLBQRDRYG2 * ZLBDAR(:)**(-1.0 - XFR) * ZLBDAG(:)**(-1.0) + &
+ XLBQRDRYG3 * ZLBDAR(:)**(-XFR) * ZLBDAG(:)**(-2.0)) ! QRDRYG
+ END WHERE
+!
+ WHERE (ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZRRS(:) > ZRSMIN_ELEC(3).AND. ABS(ZERT) > XERMIN .AND. &
+ ABS(ZQRT(:)) > XQTMIN(3))
+ ZWQ1(:,6) = SIGN( MIN( ABS(ZQRS(:)),ABS(ZWQ1(:,6)) ),ZQRS(:) )
+ ELSEWHERE
+ ZWQ1(:,6) = 0.
+ ENDWHERE
+!
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ DEALLOCATE(ZVECQ4)
+ END IF
+!
+ ZRDRYG(:) = ZZW1(:,1) + ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,4)
+ DEALLOCATE(GDRY)
+!
+!
+!* 6.3 compute the Wet growth case
+!
+ ZZW(:) = 0.0
+ ZRWETG(:) = 0.0
+ ZWQ1(:,7:9) = 0.0
+!
+ WHERE (ZRGT(:) > XRTMIN(6))
+ 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
+!
+ WHERE (ZRGT(:) > 0.0 .AND. ZRIT(:) > 0. .AND. ZRST(:) > 0.)
+ ZWQ1(:,7) = XCOEF_RQ_I * ZZW1(:,5) * ZQIT(:) / ZRIT(:)
+ ZWQ1(:,8) = XCOEF_RQ_S * ZZW1(:,6) * ZQST(:) / ZRST(:)
+ END WHERE
+!
+ WHERE (ZRGT(:) > XRTMIN_ELEC(6) .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE)
+ ZWQ1(:,7) = SIGN( MIN( ABS(ZQIS(:)),ABS(ZWQ1(:,7)) ),ZQIS(:) )
+ ZWQ1(:,8) = SIGN( MIN( ABS(ZQSS(:)),ABS(ZWQ1(:,8)) ),ZQSS(:) )
+ ELSEWHERE
+ ZWQ1(:,7) = 0.
+ ZWQ1(:,8) = 0.
+ ENDWHERE
+!
+ WHERE (ZRGS(:) > ZRSMIN_ELEC(6) .AND. ABS(ZQRT(:)) > XQTMIN(3) .AND. &
+ ZRRT(:) > XRTMIN_ELEC(3))
+ ZWQ1(:,9) = XCOEF_RQ_R * ZQRT(:) * &
+ (ZRWETG(:) - ZZW1(:,5) - ZZW1(:,6) - ZZW1(:,1)) / ZRRT(:) ! QRWETG
+ ZWQ1(:,9) = SIGN( MIN( ABS(ZQRS(:)),ABS(ZWQ1(:,9)) ),ZQRS(:) )
+ ENDWHERE
+!
+!
+!* 6.4 Select Wet or Dry case
+!
+ ZZW(:) = 0.0
+ IF (KRR == 7) THEN
+ WHERE( ZRGT(:) > XRTMIN(6) .AND. ZZT(:) < XTT .AND. & ! Wet
+ ZRDRYG(:) >= ZRWETG(:) .AND. ZRWETG(:) > 0.0 ) ! case
+ 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) ) )
+ ZUSW(:) = ZZW1(:,7) / ZZW(:)
+ ZZW1(:,5) = ZZW1(:,5) * ZUSW(:)
+ ZZW1(:,6) = ZZW1(:,6) * ZUSW(:)
+ 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(:) ! Wet growth
+ ZZW(:) = ZRGS(:) * ZRDRYG(:) / (ZRWETG(:) + ZRDRYG(:)) ! and
+ ZRGS(:) = ZRGS(:) - ZZW(:) ! partial conversion
+ ZRHS(:) = ZRHS(:) + ZZW(:) ! of the graupel into hail
+!
+ ZRRS(:) = MAX( 0.0,ZRRS(:) - ZZW1(:,7) + ZZW1(:,1) )
+ ZTHS(:) = ZTHS(:) + ZZW1(:,7)*(ZLSFACT(:)-ZLVFACT(:))
+ ! f(L_f*(RCWETG+RRWETG))
+!
+ ZQCS(:) = ZQCS(:) - ZWQ1(:,1) ! QCDRYG .equiv. QCWETG
+ ZQRS(:) = ZQRS(:) - ZWQ1(:,9)
+ ZQIS(:) = ZQIS(:) - ZWQ1(:,7)
+ ZQSS(:) = ZQSS(:) - ZWQ1(:,8)
+ ZQGS(:) = ZQGS(:) + ZWQ1(:,1) + ZWQ1(:,9) + ZWQ1(:,7) + ZWQ1(:,8)
+ ZZW(:) = ZQGS(:) * ZRDRYG(:) / (ZRWETG(:) + ZRDRYG(:)) ! partial graupel
+ ZQGS(:) = ZQGS(:) - ZZW(:) ! charge conversion
+ ZQHS(:) = ZQHS(:) + ZZW(:) ! into hail charge
+ END WHERE
+ ELSE IF( KRR == 6 ) THEN
+ WHERE (ZRGT(:) > XRTMIN(6) .AND. ZZT(:) < XTT .AND. & ! Wet
+ ZRDRYG(:) >= ZRWETG(:) .AND. ZRWETG(:) > 0.0) ! case
+ ZZW(:) = ZRWETG(:)
+ ZRCS(:) = ZRCS(:) - ZZW1(:,1)
+ ZRIS(:) = ZRIS(:) - ZZW1(:,5)
+ ZRSS(:) = ZRSS(:) - ZZW1(:,6)
+ ZRGS(:) = ZRGS(:) + ZZW(:)
+!
+ ZRRS(:) = ZRRS(:) - ZZW(:) + ZZW1(:,5) + ZZW1(:,6) + ZZW1(:,1)
+ ZTHS(:) = ZTHS(:) + (ZZW(:)-ZZW1(:,5)-ZZW1(:,6))*(ZLSFACT(:)-ZLVFACT(:))
+ ! f(L_f*(RCWETG+RRWETG))
+!
+ ZQCS(:) = ZQCS(:) - ZWQ1(:,1) ! QCDRYG .equiv. QCWETG
+ ZQRS(:) = ZQRS(:) - ZWQ1(:,9)
+ ZQIS(:) = ZQIS(:) - ZWQ1(:,7)
+ ZQSS(:) = ZQSS(:) - ZWQ1(:,8)
+ ZQGS(:) = ZQGS(:) + ZWQ1(:,1) + ZWQ1(:,9) + ZWQ1(:,7) + ZWQ1(:,8)
+ END WHERE
+ END IF
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETG', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETG', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETG', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETG', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETG', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETG', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETG', &
+ Unpack( zrhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'WETG', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'WETG', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'WETG', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'WETG', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'WETG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( krr == 7 ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'WETG', &
+ Unpack( zqhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'DRYG', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DRYG', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'DRYG', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'DRYG', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'DRYG', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'DRYG', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'DRYG', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'DRYG', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'DRYG', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'DRYG', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'DRYG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ WHERE (ZRGT(:) > XRTMIN(6) .AND. ZZT(:) < XTT .AND. & ! Dry
+ 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))
+!
+ ZQCS(:) = ZQCS(:) - ZWQ1(:,1)
+ ZQRS(:) = ZQRS(:) - ZWQ1(:,6)
+ ZQIS(:) = ZQIS(:) - ZWQ1(:,2) - ZWQ1(:,3)
+ ZQSS(:) = ZQSS(:) - ZWQ1(:,4) - ZWQ1(:,5)
+ ZQGS(:) = ZQGS(:) + ZWQ1(:,1) + ZWQ1(:,2) + ZWQ1(:,3) + ZWQ1(:,4) &
+ + ZWQ1(:,5) + ZWQ1(:,6)
+ END WHERE
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'DRYG', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DRYG', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'DRYG', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'DRYG', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'DRYG', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'DRYG', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'DRYG', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'DRYG', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'DRYG', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'DRYG', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'DRYG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+!
+! Inductive mecanism
+!
+ IF (LINDUCTIVE) THEN
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1), 'INCG', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'INCG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZRATE_IND(:) = 0.
+ GIND(:) = ZRDRYG(:) > 0. .AND. ZRDRYG(:) < ZRWETG(:) .AND. ZZT(:) < XTT
+ IIND = COUNT(GIND(:))
+!
+ IF (IIND > 0) CALL INDUCTIVE_PROCESS
+!
+ XIND_RATE(:,:,:) = 0.
+ XIND_RATE(:,:,:) = UNPACK(ZRATE_IND(:), MASK=GMICRO, FIELD=0.0)
+ XIND_RATE(:,:,:) = XIND_RATE(:,:,:) * PRHODREF(:,:,:) ! C/m3/s
+
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1), 'INCG', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'INCG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+ END IF
+!
+!* 6.5 Melting of the graupeln
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2), 'GMLT', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'GMLT', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW(:) = 0.0
+ ZWQ1(:,7) = 0.0
+ WHERE ((ZRGT(:) > XRTMIN(6)) .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))
+! compute QGMLTR
+ ZWQ1(:,7) = XCOEF_RQ_G * ZQGT(:) * ZZW(:) / ZRGT(:)
+ END WHERE
+!
+!
+ WHERE (ZRGT(:) > XRTMIN_ELEC(6) .AND. ZRGS(:) > ZRSMIN_ELEC(6) .AND. &
+ ZZT(:) > XTT .AND. ABS(ZQGT(:)) > XQTMIN(6))
+ ZWQ1(:,7) = SIGN( MIN( ABS(ZQGS(:)),ABS(ZWQ1(:,7)) ),ZQGS(:) )
+ ZQRS(:) = ZQRS(:) + ZWQ1(:,7)
+ ZQGS(:) = ZQGS(:) - ZWQ1(:,7)
+ ENDWHERE
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'GMLT', Unpack( -zzw(:) * ( zlsfact(:) - zlvfact(:) ) &
+ * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'GMLT', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'GMLT', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2), 'GMLT', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'GMLT', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ END SUBROUTINE RAIN_ICE_ELEC_FAST_RG
+!
+!-------------------------------------------------------------------------------
+!
+!
+ SUBROUTINE RAIN_ICE_ELEC_FAST_RH
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!-------------------------------------------------------------------------------
+!
+ ALLOCATE( GHAIL(IMICRO) )
+ GHAIL(:) = ZRHT(:) > XRTMIN(7)
+ IHAIL = COUNT(GHAIL(:))
+!
+ IF( IHAIL>0 ) THEN
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETH', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETH', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETH', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETH', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETH', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETH', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETH', &
+ Unpack( zrhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+!
+!* 7.2 compute the Wet growth of hail
+!
+ WHERE (GHAIL(:))
+ ZLBDAH(:) = XLBH * (ZRHODREF(:) * MAX(ZRHT(:), XRTMIN(7)))**XLBEXH
+ END WHERE
+!
+ ZZW1(:,:) = 0.0
+ WHERE (GHAIL(:) .AND. ((ZRCT(:) > XRTMIN(2) .AND. ZRCS(:) > 0.0)))
+ ZZW(:) = ZLBDAH(:)**(XCXH-XDH-2.0) * ZRHOCOR(:) / ZCOR00
+ ZZW1(:,1) = MIN( ZRCS(:),XFWETH * ZRCT(:) * ZZW(:) ) ! RCWETH
+ END WHERE
+ WHERE (GHAIL(:) .AND. ((ZRIT(:) > XRTMIN(4) .AND. ZRIS(:) > 0.0)))
+ ZZW(:) = ZLBDAH(:)**(XCXH-XDH-2.0) * ZRHOCOR(:) / ZCOR00
+ ZZW1(:,2) = MIN( ZRIS(:),XFWETH * ZRIT(:) * ZZW(:) ) ! RIWETH
+ END WHERE
+!
+!* 7.2.1 accretion of aggregates on the hailstones
+!
+ ALLOCATE( GWET(IMICRO) )
+ GWET(:) = GHAIL(:) .AND. (ZRST(:) > XRTMIN(5) .AND. ZRSS(:) > 0.0)
+ IGWET = COUNT( GWET(:) )
+!
+ IF (IGWET > 0) THEN
+!
+!* 7.2.2 allocations
+!
+ ALLOCATE(ZVEC1(IGWET))
+ ALLOCATE(ZVEC2(IGWET))
+ ALLOCATE(ZVEC3(IGWET))
+ ALLOCATE(IVEC1(IGWET))
+ ALLOCATE(IVEC2(IGWET))
+!
+!* 7.2.3 select the (ZLBDAH,ZLBDAS) couplet
+!
+ ZVEC1(:) = PACK( ZLBDAH(:),MASK=GWET(:) )
+ ZVEC2(:) = PACK( ZLBDAS(:),MASK=GWET(:) )
+!
+!* 7.2.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( REAL(NWETLBDAH)-0.00001, &
+ XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
+ IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
+ ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) )
+!
+ ZVEC2(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAS)-0.00001, &
+ XWETINTP1S * LOG( ZVEC2(1:IGWET) ) + XWETINTP2S ) )
+ IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
+ ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) )
+!
+!* 7.2.5 perform the bilinear interpolation of the normalized
+! SWETH-kernel
+!
+ ZVEC3(:) = BI_LIN_INTP_V(XKER_SWETH, IVEC1, IVEC2, ZVEC1, ZVEC2, IGWET)
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GWET,FIELD=0.0 )
+!
+ WHERE( GWET(:) )
+ ZZW1(:,3) = MIN( ZRSS(:), XFSWETH*ZZW(:) & ! RSWETH
+ *( ZLBDAS(:)**(XCXS-XBS) )*( ZLBDAH(:)**XCXH ) &
+ * ZRHOCOR(:)/(ZCOR00*ZRHODREF(:)) &
+ *( XLBSWETH1/( ZLBDAH(:)**2 ) + &
+ XLBSWETH2/( ZLBDAH(:) * ZLBDAS(:) ) + &
+ XLBSWETH3/( ZLBDAS(:)**2) ) )
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ END IF
+!
+!* 7.2.6 accretion of graupeln on the hailstones
+!
+ GWET(:) = GHAIL(:) .AND. (ZRGT(:)>XRTMIN(6) .AND. ZRGS(:)>0.0)
+ IGWET = COUNT( GWET(:) )
+!
+ IF (IGWET > 0) THEN
+!
+!* 7.2.7 allocations
+!
+ ALLOCATE( ZVEC1(IGWET) )
+ ALLOCATE( ZVEC2(IGWET) )
+ ALLOCATE( ZVEC3(IGWET) )
+ ALLOCATE( IVEC1(IGWET) )
+ ALLOCATE( IVEC2(IGWET) )
+!
+!* 7.2.8 select the (ZLBDAH,ZLBDAG) couplet
+!
+ ZVEC1(:) = PACK( ZLBDAH(:),MASK=GWET(:) )
+ ZVEC2(:) = PACK( ZLBDAG(:),MASK=GWET(:) )
+!
+!* 7.2.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( REAL(NWETLBDAG)-0.00001, &
+ XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) )
+ IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) )
+ ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) )
+!
+ ZVEC2(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAG)-0.00001, &
+ XWETINTP1G * LOG( ZVEC2(1:IGWET) ) + XWETINTP2G ) )
+ IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) )
+ ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) )
+!
+!* 7.2.10 perform the bilinear interpolation of the normalized
+! GWETH-kernel
+!
+ ZVEC3(:) = BI_LIN_INTP_V(XKER_GWETH, IVEC1, IVEC2, ZVEC1, ZVEC2, IGWET)
+ ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GWET,FIELD=0.0 )
+!
+ WHERE (GWET(:))
+ ZZW1(:,5) = MIN( ZRGS(:),XFGWETH*ZZW(:) & ! RGWETH
+ *( ZLBDAG(:)**(XCXG-XBG) )*( ZLBDAH(:)**XCXH ) &
+ * ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) &
+ *( XLBGWETH1/( ZLBDAH(:)**2 ) + &
+ XLBGWETH2/( ZLBDAH(:) * ZLBDAG(:) ) + &
+ XLBGWETH3/( ZLBDAG(:)**2) ) )
+ END WHERE
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(ZVEC3)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(ZVEC1)
+ END IF
+ DEALLOCATE(GWET)
+!
+!* 7.3 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
+!
+ ZUSW(:) = 0.
+!
+ WHERE (GHAIL(:) .AND. ZZT(:) < XTT .AND. ZZW1(:,6) /= 0.0)
+!
+! limitation of the available rainwater mixing ratio (RRWETH < RRS !)
+!
+ ZZW1(:,4) = MAX( 0.0,MIN( ZZW1(:,6),ZRRS(:)+ZZW1(:,1) ) )
+ ZUSW(:) = ZZW1(:,4) / ZZW1(:,6)
+ ZZW1(:,2) = ZZW1(:,2)*ZUSW(:)
+ ZZW1(:,3) = ZZW1(:,3)*ZUSW(:)
+ ZZW1(:,5) = ZZW1(:,5)*ZUSW(:)
+ ZZW(:) = ZZW1(:,4) + ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,5)
+!
+!* 7.1.6 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) )
+ ZRRS(:) = ZRRS(:) - ZZW1(:,4)
+ ZTHS(:) = ZTHS(:) + (ZZW1(:,4)+ZZW1(:,1))*(ZLSFACT(:)-ZLVFACT(:))
+ ! f(L_f*(RCWETH+RRWETH))
+ END WHERE
+!
+ ZWQ1(:,:) = 0.0
+ WHERE (GHAIL(:) .AND. ZZT(:) < XTT .AND. ZRCT(:) > XRTMIN_ELEC(2))
+ ZWQ1(:,1) = XCOEF_RQ_C * ZQCT(:) * ZZW1(:,1) / ZRCT(:)
+ ZWQ1(:,1) = SIGN( MIN( ABS(ZQCS(:)),ABS(ZWQ1(:,1)) ),ZQCS(:) )
+ END WHERE
+ WHERE (GHAIL(:) .AND. ZZT(:) < XTT .AND. ZRIT(:) > XRTMIN_ELEC(4))
+ ZWQ1(:,2) = XCOEF_RQ_I * ZQIT(:) * ZZW1(:,2) / ZRIT(:)
+ ZWQ1(:,2) = SIGN( MIN( ABS(ZQIS(:)),ABS(ZWQ1(:,2)) ),ZQIS(:) )
+ END WHERE
+ WHERE (GHAIL(:) .AND. ZZT(:) < XTT .AND. ZRST(:) > XRTMIN_ELEC(5))
+ ZWQ1(:,3) = XCOEF_RQ_S * ZQST(:) * ZZW1(:,3) / ZRST(:)
+ ZWQ1(:,3) = SIGN( MIN( ABS(ZQSS(:)),ABS(ZWQ1(:,3)) ),ZQSS(:) )
+ END WHERE
+ WHERE (GHAIL(:) .AND. ZZT(:) < XTT .AND. ZRGT(:) > XRTMIN_ELEC(6))
+ ZWQ1(:,5) = XCOEF_RQ_G * ZQGT(:) * ZZW1(:,5) / ZRGT(:)
+ ZWQ1(:,5) = SIGN( MIN( ABS(ZQGS(:)),ABS(ZWQ1(:,5)) ),ZQGS(:) )
+ END WHERE
+ WHERE (GHAIL(:) .AND. ZZT(:) < XTT .AND. ZRRT(:) > XRTMIN_ELEC(3))
+ ZWQ1(:,4) = XCOEF_RQ_R * ZQRT(:) * ZZW1(:,4) / ZRRT(:)
+ ZWQ1(:,4) = SIGN( MIN( ABS(ZQRS(:)),ABS(ZWQ1(:,4)) ),ZQRS(:) )
+ END WHERE
+!
+ ZQCS(:) = ZQCS(:) - ZWQ1(:,1)
+ ZQIS(:) = ZQIS(:) - ZWQ1(:,2)
+ ZQSS(:) = ZQSS(:) - ZWQ1(:,3)
+ ZQGS(:) = ZQGS(:) - ZWQ1(:,5)
+ ZQRS(:) = ZQRS(:) - ZWQ1(:,4)
+ ZQHS(:) = ZQHS(:) + ZWQ1(:,1) + ZWQ1(:,2) + ZWQ1(:,3) + ZWQ1(:,4) + ZWQ1(:,5)
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETH', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETH', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETH', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETH', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETH', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETH', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETH', &
+ Unpack( zrhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'WETH', &
+ Unpack( -zwq1(:, 1) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'WETH', &
+ Unpack( -zwq1(:, 4) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'WETH', &
+ Unpack( -zwq1(:, 2) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'WETH', &
+ Unpack( -zwq1(:, 3) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'WETH', &
+ Unpack( -zwq1(:, 5) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'WETH', &
+ Unpack( ( zwq1(:, 1) + zwq1(:, 2) + zwq1(:, 3) + zwq1(:, 4) + zwq1(:, 5) ) &
+ * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+ END IF
+!
+ IF (IHAIL > 0) THEN
+!
+!* 7.5 Melting of the hailstones
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'HMLT', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'HMLT', &
+ Unpack( zqhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW(:) = 0.0
+ ZWQ1(:,7) = 0.
+!
+ WHERE (GHAIL(:) .AND. (ZRHS(:) > 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(:)
+! compute QHMLTR
+ ZWQ1(:,7) = XCOEF_RQ_H * ZQHT(:) * ZZW(:) / ZRHT(:)
+ ZTHS(:) = ZTHS(:) - ZZW(:) * (ZLSFACT(:) - ZLVFACT(:)) ! f(L_f*(-RHMLTR))
+ END WHERE
+!
+ WHERE (ZRHT(:) > XRTMIN_ELEC(7) .AND. ZRHS(:) > ZRSMIN_ELEC(7) .AND. &
+ ZZT(:) > XTT .AND. ABS(ZQHT(:)) > XQTMIN(7))
+ ZWQ1(:,7) = SIGN( MIN( ABS(ZQHS(:)),ABS(ZWQ1(:,7)) ),ZQHS(:) )
+ ZQRS(:) = ZQRS(:) + ZWQ1(:,7)
+ ZQHS(:) = ZQHS(:) - ZWQ1(:,7)
+ END WHERE
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HMLT', &
+ Unpack( -zzw(:) * ( zlsfact(:) - zlvfact(:) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'HMLT', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'HMLT', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'HMLT', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'HMLT', &
+ Unpack( zqhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+ END IF
+!
+ DEALLOCATE(GHAIL)
+!
+ END SUBROUTINE RAIN_ICE_ELEC_FAST_RH
+!
+!-------------------------------------------------------------------------------
+!
+!
+ SUBROUTINE RAIN_ICE_ELEC_FAST_RI
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!-------------------------------------------------------------------------------
+!
+!* 7.1 cloud ice melting
+!
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'IMLT', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'IMLT', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'IMLT', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'IMLT', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'IMLT', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW(:) = 0.0
+ ZWQ1(:,1) = 0.0
+ WHERE ((ZRIS(:) > 0.0) .AND. (ZZT(:) > XTT))
+ ZZW(:) = ZRIS(:)
+ ZRCS(:) = ZRCS(:) + ZRIS(:)
+ ZTHS(:) = ZTHS(:) - ZRIS(:) * (ZLSFACT(:) - ZLVFACT(:)) ! f(L_f*(-RIMLTC))
+ ZRIS(:) = 0.0
+ ZCIT(:) = 0.0
+ ZQCS(:) = ZQCS(:) + ZQIS(:)
+ ZQIS(:) = 0.
+ END WHERE
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'IMLT', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'IMLT', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'IMLT', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'IMLT', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'IMLT', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+!
+!* 7.2 Bergeron-Findeisen effect: RCBERI
+!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'BERFI', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'BERFI', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ ZZW(:) = 0.0
+ ZWQ1(:,1) = 0.0
+ WHERE ((ZRCS(:) > 0.0) .AND. (ZSSI(:) > 0.0) .AND. &
+ (ZRIT(:) > XRTMIN(4)) .AND. (ZCIT(:) > 0.0) .AND. &
+ ZRCT(:) > 0.)
+ ZZW(:) = MIN(1.E8,XLBI*( ZRHODREF(:)*ZRIT(:)/ZCIT(:) )**XLBEXI) ! Lbda_i
+ ZZW(:) = MIN( ZRCS(:),( ZSSI(:) / (ZRHODREF(:)*ZAI(:)) ) * ZCIT(:) * &
+ ( X0DEPI/ZZW(:) + X2DEPI*ZCJ(:)*ZCJ(:)/ZZW(:)**(XDI+2.0) ) )
+ ZRCS(:) = ZRCS(:) - ZZW(:)
+ ZRIS(:) = ZRIS(:) + ZZW(:)
+ ZTHS(:) = ZTHS(:) + ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RCBERI))
+!
+ ZWQ1(:,1) = XCOEF_RQ_C * ZQCT(:) * ZZW(:) / ZRCT(:)
+ END WHERE
+!
+ WHERE (ZRCS(:) > 0.0 .AND. ZSSI(:) > 0.0 .AND. &
+ ZRIT(:) > 0.0 .AND. ZCIT(:) > 0.0 .AND. &
+ ZRCT(:) > XRTMIN_ELEC(2) .AND. ABS(ZQCT(:)) > XQTMIN(2))
+ ZWQ1(:,1) = SIGN( MIN( ABS(ZQCS(:)),ABS(ZWQ1(:,1)) ),ZQCS(:) )
+ ZQIS(:) = ZQIS(:) + ZWQ1(:,1)
+ ZQCS(:) = ZQCS(:) - ZWQ1(:,1)
+ ENDWHERE
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'BERFI', &
+ Unpack( zzw(:) * ( zlsfact(:) - zlvfact(:) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'BERFI', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'BERFI', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'BERFI', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'BERFI', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ END SUBROUTINE RAIN_ICE_ELEC_FAST_RI
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE COMPUTE_LBDA(ZRR, ZRS, ZRG, ZRH)
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZRR, ZRS, ZRG
+REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: ZRH
+!
+!
+!* 1. COMPUTE LAMBDA
+! --------------
+!
+ ZLBDAR(:) = 0.0
+ ZLBDAS(:) = 0.0
+ ZLBDAG(:) = 0.0
+!
+ WHERE( ZRR(:) > 0.0 )
+ ZLBDAR(:) = XLBR * (ZRHODREF(:) * MAX(ZRR(:), XRTMIN(3)))**XLBEXR
+ END WHERE
+!
+ WHERE ( ZRS(:) > 0.0 )
+ ZLBDAS(:) = MIN( XLBDAS_MAX, &
+ XLBS * (ZRHODREF(:) * MAX(ZRS(:), XRTMIN(5)))**XLBEXS )
+ END WHERE
+!
+ WHERE ( ZRG(:) > 0.0 )
+ ZLBDAG(:) = XLBG * (ZRHODREF(:) * MAX( ZRG(:), XRTMIN(6)))**XLBEXG
+ END WHERE
+!
+ IF (PRESENT(ZRH)) THEN
+ ZLBDAH(:) = 0.0
+ WHERE ( ZRH(:) > 0.0 )
+ ZLBDAH(:) = XLBH * (ZRHODREF(:) * MAX( ZRH(:), XRTMIN(7)))**XLBEXH
+ END WHERE
+ END IF
+!
+END SUBROUTINE COMPUTE_LBDA
+!
+!------------------------------------------------------------------------------
+!
+SUBROUTINE ELEC_UPDATE_QD(ZDUM, ZER, ZEI, ZES, ZEG, ZQR, ZQI, ZQS, ZQG, &
+ ZRR, ZRI, ZRS, ZRG, &
+ ZEH, ZQH, ZRH, ZEC, ZQC, ZRC)
+!
+! Purpose : update the parameter e_x in the relation q_x = e_x d**f_x
+! e_x = q_x/(N_x * M(f_x))
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+REAL, INTENT(IN) :: ZDUM ! =1. if mixing ratio
+ ! =timestep if source
+REAL, DIMENSION(:), INTENT(IN) :: ZQR, ZQI, ZQS, ZQG ! V. C.
+REAL, DIMENSION(:), INTENT(IN) :: ZRR, ZRI, ZRS, ZRG ! mixing ratio
+REAL, DIMENSION(:), INTENT(OUT) :: ZER, ZEI, ZES, ZEG ! Coef of the charge diameter relation
+REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: ZQH ! hail
+REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: ZRH ! hail
+REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: ZEH ! hail
+!
+REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: ZQC ! V. C. for droplets
+REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: ZRC ! mixing ration for droplets
+REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: ZEC ! Coef of the charge diameter relation for droplets
+REAL, DIMENSION(SIZE(XRTMIN)) :: ZRTMIN_E
+!
+!
+!* 1. UPDATE E_x
+! ----------
+!
+IF (PRESENT(ZEC)) ZEC(:) = 0.
+ZER(:) = 0.
+ZEI(:) = 0.
+ZES(:) = 0.
+ZEG(:) = 0.
+ZRTMIN_E(:) = XRTMIN(:) / ZDUM
+!
+!* 1.1 for cloud droplets
+!
+IF (PRESENT(ZEC) .AND. PRESENT(ZQC) .AND. PRESENT(ZRC)) THEN
+ WHERE (ZRC(:) > ZRTMIN_E(2))
+ ZEC(:) = ZDUM * ZRHODREF(:) * ZQC(:) / XFQUPDC
+ ZEC(:) = SIGN( MIN(ABS(ZEC(:)), XECMAX), ZEC(:))
+ ENDWHERE
+END IF
+!
+!* 1.2 for raindrops
+!
+WHERE (ZRR(:) > ZRTMIN_E(3) .AND. ZLBDAR(:) > 0.)
+ ZER(:) = ZDUM * ZRHODREF(:) * ZQR(:) / (XFQUPDR * ZLBDAR(:)**(XCXR - XFR))
+ ZER(:) = SIGN( MIN(ABS(ZER(:)), XERMAX), ZER(:))
+ENDWHERE
+!
+!* 1.3 for ice crystals
+!
+WHERE (ZRI(:) > ZRTMIN_E(4) .AND. ZCIT(:) > 0.0)
+ ZEI(:) = ZDUM * ZRHODREF(:) * ZQI(:) / &
+ ((ZCIT**(1 - XEXFQUPDI)) * XFQUPDI * (ZRHODREF(:) * &
+ ZDUM * ZRI(:))**XEXFQUPDI)
+ ZEI(:) = SIGN( MIN(ABS(ZEI(:)), XEIMAX), ZEI(:))
+ENDWHERE
+!
+!* 1.4 for snow
+!
+WHERE (ZRS(:) > ZRTMIN_E(5) .AND. ZLBDAS(:) > 0.)
+ ZES(:) = ZDUM * ZRHODREF(:) * ZQS(:) / (XFQUPDS * ZLBDAS(:)**(XCXS - XFS))
+ ZES(:) = SIGN( MIN(ABS(ZES(:)), XESMAX), ZES(:))
+ENDWHERE
+!
+!* 1.5 for graupel
+!
+WHERE (ZRG(:) > ZRTMIN_E(6).AND. ZLBDAG(:) > 0.)
+ ZEG(:) = ZDUM * ZRHODREF(:) * ZQG(:) / (XFQUPDG * ZLBDAG(:)**(XCXG - XFG))
+ ZEG(:) = SIGN( MIN(ABS(ZEG(:)), XEGMAX), ZEG(:))
+ENDWHERE
+!
+!* 1.6 for hail
+!
+IF (PRESENT(ZEH) .AND. PRESENT(ZQH) .AND. PRESENT(ZRH)) THEN
+ ZEH(:) = 0.
+ WHERE (ZRH(:) > ZRTMIN_E(7).AND. ZLBDAH(:) > 0.)
+ ZEH(:) = ZDUM * ZRHODREF(:) * ZQH(:) / (XFQUPDH * ZLBDAH(:)**(XCXH - XFH))
+ ZEH(:) = SIGN( MIN(ABS(ZEH(:)), XEHMAX), ZEH(:))
+ ENDWHERE
+END IF
+!
+END SUBROUTINE ELEC_UPDATE_QD
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE ELEC_INI_NI_PROCESS
+!
+! Purpose : initialization for the non-inductive charging process
+!
+! GELEC(:,1) : logical variable for Ice-Snow process --> ELEC_IAGGS_B
+! from RAIN_ICE_ELEC_SLOW routine
+! GELEC(:,2) : logical variable for Ice-Graupel process --> ELEC_IDRYG_B
+! from RAIN_ICE_ELEC_FAST_RG
+! GELEC(:,3) : logical variable for Snow-Graupel process --> ELEC_SDRYG_B
+! from RAIN_ICE_ELEC_FAST_RG
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!
+!* 1. Gardiner et al. (1985)
+! ----------------------
+!
+ IF (CNI_CHARGING == 'GARDI') THEN
+ ZDELTALWC(:) = 0.
+ ZFT(:) = 0.
+!
+ GELEC(:,3) = ZZT(:) > (XTT - 40.) .AND. ZZT(:) < XTT
+ GELEC(:,1) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE
+ GELEC(:,2) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+ GELEC(:,3) = GELEC(:,3) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. &
+ ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+ GELEC(:,4) = GELEC(:,1) .OR. GELEC(:,2) .OR. GELEC(:,3)
+!
+ WHERE (GELEC(:,4))
+ ZFT(:) = - 1.7E-5 * ((-21 / (XQTC - XTT)) * (ZZT(:) - XTT))**3 &
+ - 0.003 * ((-21 / (XQTC - XTT)) * (ZZT(:) - XTT))**2 &
+ - 0.05 * ((-21 / (XQTC - XTT)) * (ZZT(:) - XTT)) &
+ + 0.13
+!
+ ZDELTALWC(:) = (ZRCT(:) * ZRHODREF(:) * 1.E3) - XLWCC ! (g m^-3)
+ ENDWHERE
+ ENDIF
+!
+!
+!* 2. Saunders et al. (1991)
+! ----------------------
+!
+!* 2.1 common to SAUN1 and SAUN2
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2') THEN
+ ZDQLWC(:) = 0.
+ ZEW(:) = 0.
+!
+! positive case is the default value
+ ZFQIAGGS(:) = XFQIAGGSP
+ ZFQIDRYGBS(:) = XFQIDRYGBSP
+ ZLBQSDRYGB1S(:) = XLBQSDRYGB1SP
+ ZLBQSDRYGB2S(:) = XLBQSDRYGB2SP
+ ZLBQSDRYGB3S(:) = XLBQSDRYGB3SP
+ ZSAUNIM(:) = XIMP !3.76
+ ZSAUNIN(:) = XINP !2.5
+ ZSAUNSK(:) = XSKP !52.8
+ ZSAUNSM(:) = XSMP !0.44
+ ZSAUNSN(:) = XSNP !2.5
+!
+! LWC_crit
+ ZLWCC(:) = MIN( MAX( -0.49 + 6.64E-2*(XTT-ZZT(:)),0.22 ),1.1 ) ! (g m^-3)
+!
+! Mansell et al. (2005, JGR): droplet collection efficiency of the graupel ~ 0.6-1.0
+ ZEW(:) = 0.8 * ZRCT(:) * ZRHODREF(:) * 1.E3 ! (g m^-3)
+!
+ GELEC(:,3) = ZZT(:) > (XTT - 40.) .AND. ZZT(:) <= XTT .AND. &
+ ZEW(:) >= 0.01 .AND. ZEW(:) <= 10.
+ GELEC(:,1) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE
+ GELEC(:,2) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+ GELEC(:,3) = GELEC(:,3) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. &
+ ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+!
+ ALLOCATE (GSAUN(IMICRO))
+ GSAUN(:) = .FALSE.
+!
+! For temperature lower than -30C and higher than -40C, value of q at -30C
+ GSAUN(:) = GELEC(:,1) .OR. GELEC(:,2) .OR. GELEC(:,3)
+ IGSAUN = COUNT (GSAUN(:))
+!
+ IF (IGSAUN > 0) THEN
+ CALL ELEC_INI_NI_SAUNQ(ZEW, ZDQLWC)
+!
+ WHERE (ZDQLWC(:) < 0.)
+ ZFQIAGGS(:) = XFQIAGGSN
+ ZFQIDRYGBS(:) = XFQIDRYGBSN
+ ZLBQSDRYGB1S(:) = XLBQSDRYGB1SN
+ ZLBQSDRYGB2S(:) = XLBQSDRYGB2SN
+ ZLBQSDRYGB3S(:) = XLBQSDRYGB3SN
+ ZSAUNIM(:) = XIMN !2.54
+ ZSAUNIN(:) = XINN !2.8
+ ZSAUNSK(:) = XSKN !24.
+ ZSAUNSM(:) = XSMN !0.5
+ ZSAUNSN(:) = XSNN !2.8
+ ENDWHERE
+ ENDIF
+!
+ DEALLOCATE( GSAUN )
+ END IF
+!
+!
+!* 3. Saunders and Peck (1998)
+!
+ IF (CNI_CHARGING == 'SAP98') THEN
+ ZRAR_CRIT(:) = 0.
+!
+! compute the critical rime accretion rate
+ WHERE (ZZT(:) <= XTT .AND. ZZT(:) >= (XTT - 23.7)) ! Original from SAP98
+ ZRAR_CRIT(:) = 1.0 + 7.93E-2 * (ZZT(:) - XTT) + &
+ 4.48E-2 * (ZZT(:) - XTT)**2 + &
+ 7.48E-3 * (ZZT(:) - XTT)**3 + &
+ 5.47E-4 * (ZZT(:) - XTT)**4 + &
+ 1.67E-5 * (ZZT(:) - XTT)**5 + &
+ 1.76E-7 * (ZZT(:) - XTT)**6
+ END WHERE
+!
+ WHERE (ZZT(:) < (XTT - 23.7) .AND. ZZT(:) > (XTT - 40.)) ! Added by Mansell
+ ZRAR_CRIT(:) = 3.4 * (1.0 - (ABS(ZZT(:) - XTT + 23.7) / & ! et al. (2005)
+ (-23.7 + 40.))**3.)
+ END WHERE
+!
+ GELEC(:,3) = ZZT(:) >= (XTT - 40.) .AND. ZZT(:) <= XTT
+ GELEC(:,1) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE
+ GELEC(:,2) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+ GELEC(:,3) = GELEC(:,3) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. &
+ ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+!
+!+++++++++ I - G collisions +++++++++
+ ZSAUNIM_IG(:) = 0.
+!
+! positive case is the default value
+ ZSAUNIM_IG(:) = XIMP
+ ZSAUNIN_IG(:) = XINP
+!
+! Compute the Rime Accretion Rate
+ ZRAR(:) = 0.
+ ZVGMEAN(:) = 0.
+ WHERE (ZLBDAG(:) > 0. .AND. ZRCT(:) > 0.)
+ ZVGMEAN(:) = XVGCOEF * ZRHOCOR(:) * ZLBDAG(:)**(-XDG)
+ ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ZVGMEAN(:) * 1.E3
+ END WHERE
+!
+ GELEC(:,2) = GELEC(:,2) .AND. ZRAR(:) > 0.1
+ GELEC(:,4) = GELEC(:,2)
+!
+ IF (COUNT(GELEC(:,4)) .GT. 0) THEN
+!
+! compute the coefficients for I-G collisions
+ CALL ELEC_INI_NI_SAP98 (ZRAR, ZDQRAR_IG)
+!
+ WHERE (ZDQRAR_IG(:) < 0.)
+ ZSAUNIM_IG(:) = XIMN
+ ZSAUNIN_IG(:) = XINN
+ ENDWHERE
+ ENDIF
+!
+!+++++++++ I - S collisions +++++++++
+ ZDQRAR_IS(:) = 0.
+!
+! positive case is the default value
+ ZSAUNIM_IS(:) = XIMP
+ ZSAUNIN_IS(:) = XINP
+!
+! Compute the Rime Accretion Rate
+ ZRAR(:) = 0.
+ ZVSMEAN(:) = 0.
+!
+ WHERE (ZLBDAS(:) > 0. .AND. ZRCT(:) > 0.)
+ ZVSMEAN(:) = XVSCOEF * ZRHOCOR(:) * ZLBDAS(:)**(-XDS)
+ ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ZVSMEAN(:) * 1.E3
+ END WHERE
+!
+ GELEC(:,1) = GELEC(:,1) .AND. ZRAR(:) > 0.1
+ GELEC(:,4) = GELEC(:,1)
+!
+ IF (COUNT(GELEC(:,4)) .GT. 0) THEN
+! compute the coefficients for I-S collisions
+ CALL ELEC_INI_NI_SAP98 (ZRAR, ZDQRAR_IS)
+!
+ WHERE (ZDQRAR_IS(:) < 0.)
+ ZSAUNIM_IS(:) = XIMN
+ ZSAUNIN_IS(:) = XINN
+ ENDWHERE
+ ENDIF
+!
+!+++++++++ S - G collisions +++++++++
+ ZDQRAR_SG(:) = 0.
+!
+! positive case is the default value
+ ZSAUNSK_SG(:) = XSKP
+ ZSAUNSM_SG(:) = XSMP
+ ZSAUNSN_SG(:) = XSNP
+!
+! Compute the Rime Accretion Rate
+ ZRAR(:) = 0.
+!
+ WHERE (ZVSMEAN(:) > 0. .AND. ZVGMEAN(:) > 0.)
+ ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ABS(ZVGMEAN(:) - ZVSMEAN(:)) * 1.E3
+ END WHERE
+!
+ GELEC(:,3) = GELEC(:,3) .AND. ZRAR(:) > 0.1
+ GELEC(:,4) = GELEC(:,3)
+!
+ IF( COUNT(GELEC(:,4)) .GT. 0) THEN
+!
+! compute the coefficients for S-G collisions
+ CALL ELEC_INI_NI_SAP98 (ZRAR, ZDQRAR_SG)
+!
+ WHERE (ZDQRAR_SG(:) < 0.)
+ ZSAUNSK_SG(:) = XSKN
+ ZSAUNSM_SG(:) = XSMN
+ ZSAUNSN_SG(:) = XSNN
+ ENDWHERE
+ ENDIF
+ END IF
+!
+!* 4. Brooks et al. (1997) without / with anomalies
+!
+ IF (CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2') THEN
+
+ ALLOCATE (GSAUN(IMICRO))
+!
+! compute the critical rime accretion rate
+ WHERE (ZZT(:) > (XTT - 10.7))
+ ZRAR_CRIT(:) = 0.66
+ END WHERE
+ WHERE (ZZT(:) <= (XTT - 10.7) .AND. ZZT(:) >= (XTT - 23.7))
+ ZRAR_CRIT(:) = -1.47 - 0.2 * (ZZT(:) - XTT)
+ END WHERE
+ WHERE (ZZT(:) < (XTT - 23.7) .AND. ZZT(:) > (XTT - 40.))
+ ZRAR_CRIT(:) = 3.3
+ END WHERE
+!
+ GELEC(:,3) = ZZT(:) > (XTT - 40.) .AND. ZZT(:) <= XTT .AND. &
+ ZEW(:) >= 0.01 .AND. ZEW(:) <= 10.
+ GELEC(:,1) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE
+ GELEC(:,2) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+ GELEC(:,3) = GELEC(:,3) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. &
+ ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+!
+!+++++++++ I - S collisions +++++++++
+ ZDQRAR_IS(:) = 0.
+!
+! positive case is the default value
+ ZSAUNIM_IS(:) = XIMP
+ ZSAUNIN_IS(:) = XINP
+!
+ GSAUN(:) = .FALSE.
+!
+! Compute the Rime Accretion Rate
+ ZRAR(:) = 0.
+ ZVSMEAN(:) = 0.
+!
+ WHERE (ZLBDAS(:) > 0. .AND. ZRCT(:) > 0.)
+ ZVSMEAN(:) = XVSCOEF * ZRHOCOR(:) * ZLBDAS(:)**(-XDS)
+ ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ZVSMEAN(:) * 1.E3
+ END WHERE
+!
+ GELEC(:,1) = GELEC(:,1) .AND. ZRAR(:) > 0.1
+ GSAUN(:) = GELEC(:,1)
+ IGSAUN = COUNT (GSAUN(:))
+!
+ IF (IGSAUN .GT. 0) THEN
+ ZEW(:) = ZRAR(:) / 3.
+!
+ CALL ELEC_INI_NI_SAUNQ (ZEW, ZDQRAR_IS)
+!
+ WHERE (ZDQRAR_IS(:) < 0.)
+ ZSAUNIM_IS(:) = XIMN
+ ZSAUNIN_IS(:) = XINN
+ ENDWHERE
+ ENDIF
+!
+!+++++++++ I - G collisions +++++++++
+ ZDQRAR_IG(:) = 0.
+!
+! positive case is the default value
+ ZSAUNIM_IG(:) = XIMP
+ ZSAUNIN_IG(:) = XINP
+!
+ GSAUN(:) = .FALSE.
+!
+! Compute the Rime Accretion Rate
+ ZRAR(:) = 0.
+ ZVGMEAN(:) = 0.
+!
+ WHERE (ZLBDAG(:) > 0. .AND. ZRCT(:) > 0.)
+ ZVGMEAN(:) = XVGCOEF * ZRHOCOR(:) * ZLBDAG(:)**(-XDG)
+ ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ZVGMEAN(:) * 1.E3
+ END WHERE
+!
+ GELEC(:,2) = GELEC(:,2) .AND. ZRAR(:) > 0.1
+ GSAUN(:) = GELEC(:,2)
+ IGSAUN = COUNT (GSAUN(:))
+!
+ IF (IGSAUN .GT. 0) THEN
+ ZEW(:) = ZRAR(:) / 3.
+ CALL ELEC_INI_NI_SAUNQ (ZEW, ZDQRAR_IG)
+!
+ WHERE (ZDQRAR_IG(:) < 0.)
+ ZSAUNIM_IG(:) = XIMN
+ ZSAUNIN_IG(:) = XINN
+ ENDWHERE
+ ENDIF
+!
+!+++++++++ S - G collisions +++++++++
+ ZDQRAR_SG(:) = 0.
+!
+! positive case is the default value
+ ZSAUNSK_SG(:) = XSKP
+ ZSAUNSM_SG(:) = XSMP
+ ZSAUNSN_SG(:) = XSNP
+!
+ GSAUN(:) = .FALSE.
+!
+! Compute the Rime Accretion Rate
+ ZRAR(:) = 0.
+!
+ WHERE (ZVSMEAN(:) > 0. .AND. ZVGMEAN(:) > 0.)
+ ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ABS(ZVGMEAN(:) - ZVSMEAN(:)) * 1.E3
+ END WHERE
+!
+ GELEC(:,3) = GELEC(:,3) .AND. ZRAR(:) > 0.1
+ GSAUN(:) = GELEC(:,3)
+ IGSAUN = COUNT (GSAUN(:))
+!
+ IF (IGSAUN .GT. 0) THEN
+ ZEW(:) = ZRAR(:) / 3.
+ CALL ELEC_INI_NI_SAUNQ (ZEW, ZDQRAR_SG)
+!
+ WHERE (ZDQRAR_SG(:) < 0.)
+ ZSAUNSK_SG(:) = XSKN
+ ZSAUNSM_SG(:) = XSMN
+ ZSAUNSN_SG(:) = XSNN
+ ENDWHERE
+ ENDIF
+!
+ DEALLOCATE( GSAUN )
+ END IF
+!
+!
+!* 5. Takahashi (1978)
+!
+ IF (CNI_CHARGING == 'TAKAH') THEN
+ ZDQLWC(:) = 0.
+!
+ ZEW(:) = ZRCT(:) * ZRHODREF(:) * 1.E3 ! (g m^-3)
+!
+ GELEC(:,3) = ZZT(:) > (XTT - 40.) .AND. ZZT(:) <= XTT .AND. &
+ ZEW(:) >= 0.01 .AND. ZEW(:) <= 10.
+ GELEC(:,1) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE
+ GELEC(:,2) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+ GELEC(:,3) = GELEC(:,3) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. &
+ ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+!
+ ALLOCATE (GTAKA(IMICRO))
+ GTAKA(:) = .FALSE.
+!
+! For temperature lower than -30C and higher than -40C, value of q at -30C
+ GTAKA(:) = GELEC(:,1) .OR. GELEC(:,2) .OR. GELEC(:,3)
+ IGTAKA = COUNT (GTAKA(:))
+!
+ IF (IGTAKA > 0) THEN
+ CALL ELEC_INI_NI_TAKAH(ZEW, ZDQLWC, XMANSELL)
+ ENDIF
+!
+ DEALLOCATE( GTAKA )
+ ENDIF
+!
+!
+!* 6. Takahashi with EW (Tsenova and Mitzeva, 2009)
+!
+ IF (CNI_CHARGING == 'TEEWC') THEN
+ ZDQLWC(:) = 0.
+!
+! positive case is the default value
+ ZFQIAGGS(:) = XFQIAGGSP_TAK
+ ZFQIDRYGBS(:) = XFQIDRYGBSP_TAK
+ ZLBQSDRYGB1S(:) = XLBQSDRYGB1SP
+ ZLBQSDRYGB2S(:) = XLBQSDRYGB2SP
+ ZLBQSDRYGB3S(:) = XLBQSDRYGB3SP
+ ZSAUNIM(:) = XIMP !3.76
+ ZSAUNIN(:) = XINP !2.5
+ ZSAUNSK(:) = XSKP_TAK !6.5
+ ZSAUNSM(:) = XSMP !0.44
+ ZSAUNSN(:) = XSNP !2.5
+!
+! Compute the effective water content
+ ZEW(:) = 0.
+!
+ WHERE (ZLBDAG(:) > 0. .AND. ZRCT(:) > 0.)
+ ZEW(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * 1.E3
+ END WHERE
+!
+ GELEC(:,3) = ZZT(:) >= (XTT - 40.) .AND. ZZT(:) <= XTT .AND. &
+ ZEW(:) >= 0.01 .AND. ZEW(:) <= 10.
+ GELEC(:,1) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE
+ GELEC(:,2) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+ GELEC(:,3) = GELEC(:,3) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. &
+ ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+!
+ ALLOCATE (GTAKA(IMICRO))
+ GTAKA(:) = .FALSE.
+!
+! For temperature lower than -30C and higher than -40C, value of q at -30C
+ GTAKA(:) = GELEC(:,1) .OR. GELEC(:,2) .OR. GELEC(:,3)
+ IGTAKA = COUNT (GTAKA(:))
+!
+ IF (IGTAKA > 0) THEN
+ CALL ELEC_INI_NI_TAKAH(ZEW, ZDQLWC, XTAKA_TM)
+!
+ WHERE (ZDQLWC(:) < 0.)
+ ZFQIAGGS(:) = XFQIAGGSN_TAK
+ ZFQIDRYGBS(:) = XFQIDRYGBSN_TAK
+ ZLBQSDRYGB1S(:) = XLBQSDRYGB1SN
+ ZLBQSDRYGB2S(:) = XLBQSDRYGB2SN
+ ZLBQSDRYGB3S(:) = XLBQSDRYGB3SN
+ ZSAUNIM(:) = XIMN !2.54
+ ZSAUNIN(:) = XINN !2.8
+ ZSAUNSK(:) = XSKN_TAK !2.0
+ ZSAUNSM(:) = XSMN !0.5
+ ZSAUNSN(:) = XSNN !2.8
+ ENDWHERE
+ ENDIF
+!
+ DEALLOCATE( GTAKA )
+ ENDIF
+!
+!
+!* 7. Takahashi with RAR (Tsenova and Mitzeva, 2011)
+!
+ IF (CNI_CHARGING == 'TERAR') THEN
+!
+ ALLOCATE (GTAKA(IMICRO))
+!
+ GELEC(:,3) = ZZT(:) >= (XTT - 40.) .AND. ZZT(:) <= XTT
+ GELEC(:,1) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE
+ GELEC(:,2) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+ GELEC(:,3) = GELEC(:,3) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. &
+ ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+!
+!+++++++++ I - S collisions +++++++++
+ ZDQRAR_IS(:) = 0.
+!
+! positive case is the default value
+ ZSAUNIM_IS(:) = XIMP
+ ZSAUNIN_IS(:) = XINP
+!
+ GTAKA(:) = .FALSE.
+!
+! Compute the Rime Accretion Rate
+ ZRAR(:) = 0.
+ ZVSMEAN(:) = 0.
+!
+ WHERE (ZLBDAS(:) > 0. .AND. ZRCT(:) > 0.)
+ ZVSMEAN(:) = XVSCOEF * ZRHOCOR(:) * ZLBDAS(:)**(-XDS)
+ ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ZVSMEAN(:) * 1.E3
+ END WHERE
+!
+ GELEC(:,1) = GELEC(:,1) .AND. ZRAR(:) > 0.01 .AND. ZRAR(:) <= 80.
+ GTAKA(:) = GELEC(:,1)
+!
+ IGTAKA = COUNT (GTAKA(:))
+!
+ IF (IGTAKA > 0) THEN
+ ZEW(:) = ZRAR(:) / 8.
+ CALL ELEC_INI_NI_TAKAH(ZEW, ZDQRAR_IS, XTAKA_TM)
+!
+ WHERE (ZDQRAR_IS(:) < 0.)
+ ZSAUNIM_IS(:) = XIMN
+ ZSAUNIN_IS(:) = XINN
+ ENDWHERE
+ END IF
+!
+!
+!+++++++++ I - G collisions +++++++++
+ ZDQRAR_IG(:) = 0.
+!
+! positive case is the default value
+ ZSAUNIM_IG(:) = XIMP
+ ZSAUNIN_IG(:) = XINP
+!
+ GTAKA(:) = .FALSE.
+!
+! Compute the Rime Accretion Rate
+ ZRAR(:) = 0.
+ ZVGMEAN(:) = 0.
+!
+ WHERE (ZLBDAG(:) > 0. .AND. ZRCT(:) > 0.)
+ ZVGMEAN(:) = XVGCOEF * ZRHOCOR(:) * ZLBDAG(:)**(-XDG)
+ ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ZVGMEAN(:) * 1.E3
+ END WHERE
+!
+ GELEC(:,2) = GELEC(:,2) .AND. ZRAR(:) > 0.01 .AND. ZRAR(:) <= 80.
+ GTAKA(:) = GELEC(:,2)
+!
+ IGTAKA = COUNT (GTAKA(:))
+!
+ IF (IGTAKA > 0) THEN
+ ZEW(:) = ZRAR(:) / 8.
+ CALL ELEC_INI_NI_TAKAH(ZEW, ZDQRAR_IG, XTAKA_TM)
+!
+ WHERE (ZDQRAR_IG(:) < 0.)
+ ZSAUNIM_IG(:) = XIMN
+ ZSAUNIN_IG(:) = XINN
+ ENDWHERE
+ ENDIF
+!
+!+++++++++ S - G collisions +++++++++
+ ZDQRAR_SG(:) = 0.
+!
+! positive case is the default value
+ ZSAUNSK_SG(:) = XSKP_TAK
+ ZSAUNSM_SG(:) = XSMP
+ ZSAUNSN_SG(:) = XSNP
+!
+ GTAKA(:) = .FALSE.
+!
+! Compute the Rime Accretion Rate
+ ZRAR(:) = 0.
+!
+ WHERE (ZVSMEAN(:) > 0. .AND. ZVGMEAN(:) > 0.)
+ ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ABS(ZVGMEAN(:) - ZVSMEAN(:)) * 1.E3
+ END WHERE
+!
+ GELEC(:,3) = GELEC(:,3) .AND. ZRAR(:) > 0.01 .AND. ZRAR(:) <= 80
+ GTAKA(:) = GELEC(:,3)
+ IGTAKA = COUNT (GTAKA(:))
+!
+ IF (IGTAKA > 0) THEN
+ ZEW(:) = ZRAR(:) / 8.
+ CALL ELEC_INI_NI_TAKAH(ZEW, ZDQRAR_SG, XTAKA_TM)
+!
+ WHERE (ZDQRAR_SG(:) < 0.)
+ ZSAUNSK_SG(:) = XSKN_TAK
+ ZSAUNSM_SG(:) = XSMN
+ ZSAUNSN_SG(:) = XSNN
+ ENDWHERE
+ ENDIF
+!
+ DEALLOCATE( GTAKA )
+ END IF
+!
+END SUBROUTINE ELEC_INI_NI_PROCESS
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE ELEC_INI_NI_SAP98(ZRAR, ZDQRAR_AUX)
+!
+IMPLICIT NONE
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZRAR
+REAL, DIMENSION(:), INTENT(INOUT) :: ZDQRAR_AUX ! q= f(RAR,T) in Saunders and
+ ! Peck's equation
+!
+ ZDQRAR_AUX(:) = 0.
+!
+! positive region : Mansell et al., 2005
+ WHERE (GELEC(:,4) .AND. ZRAR(:) > ZRAR_CRIT(:))
+ ZDQRAR_AUX(:) = MAX(0., 6.74 * (ZRAR(:) - ZRAR_CRIT(:)) * 1.E-15)
+ ENDWHERE
+!
+! negative region : Mansell et al. 2005
+ WHERE (GELEC(:,4) .AND. ZRAR(:) < ZRAR_CRIT(:))
+ ZDQRAR_AUX(:) = MIN(0., 3.9 * (ZRAR_CRIT(:) - 0.1) * &
+ (4.0 * ((ZRAR(:) - (ZRAR_CRIT(:) + 0.1) / 2.) / &
+ (ZRAR_CRIT(:) - 0.1))**2 - 1.) * 1.E-15)
+ ENDWHERE
+!
+END SUBROUTINE ELEC_INI_NI_SAP98
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE ELEC_INI_NI_SAUNQ(ZEW, ZDQLWC_AUX)
+!
+IMPLICIT NONE
+!
+REAL, DIMENSION(:), INTENT(IN) :: ZEW
+REAL, DIMENSION(:), INTENT(INOUT) :: ZDQLWC_AUX ! q= f(RAR or EW,T) in Saunders
+ !... equation
+!
+! For temperature lower than -30C and higher than -40C, value of q at -30C
+!
+ ALLOCATE ( IVEC1(IGSAUN) )
+ ALLOCATE ( IVEC2(IGSAUN) )
+ ALLOCATE ( ZVEC1(IGSAUN) )
+ ALLOCATE ( ZVEC2(IGSAUN) )
+ ALLOCATE ( ZDQLWC_OPT(IGSAUN) )
+!
+ ZDQLWC_OPT(:) = 0.
+ IVEC1(:) = 0
+ IVEC2(:) = 0
+!
+ ZVEC1(:) = PACK( ZZT(:), MASK=GSAUN(:))
+ ZVEC2(:) = PACK( ZEW(:), MASK=GSAUN(:))
+ ZDQLWC_OPT(:) = PACK( ZDQLWC_AUX(:), MASK=GSAUN )
+!
+! Temperature index (0C --> -40C)
+ ZVEC1(1:IGSAUN) = MAX( 1.00001, MIN( REAL(NIND_TEMP)-0.00001, &
+ (ZVEC1(1:IGSAUN) - XTT - 1.)/(-1.) ) )
+ IVEC1(1:IGSAUN) = INT( ZVEC1(1:IGSAUN) )
+ ZVEC1(1:IGSAUN) = ZVEC1(1:IGSAUN) - REAL(IVEC1(1:IGSAUN))
+!
+! LWC index (0.01 g.m^-3 --> 10 g.m^-3)
+ WHERE (ZVEC2(:) >= 0.01 .AND. ZVEC2(:) < 0.1)
+ ZVEC2(:) = MAX( 1.00001, MIN( REAL(10)-0.00001, &
+ ZVEC2(:) * 100. ))
+ IVEC2(:) = INT(ZVEC2(:))
+ ZVEC2(:) = ZVEC2(:) - REAL(IVEC2(:))
+ ENDWHERE
+!
+ WHERE (ZVEC2(:) >= 0.1 .AND. ZVEC2(:) < 1. .AND. IVEC2(:) == 0)
+ ZVEC2(:) = MAX( 10.00001, MIN( REAL(19)-0.00001, &
+ ZVEC2(:) * 10. + 9. ) )
+ IVEC2(:) = INT(ZVEC2(:))
+ ZVEC2(:) = ZVEC2(:) - REAL(IVEC2(:))
+ ENDWHERE
+!
+ WHERE ((ZVEC2(:) >= 1.) .AND. ZVEC2(:) <= 10.)
+ ZVEC2(:) = MAX( 19.00001, MIN( REAL(NIND_LWC)-0.00001, &
+ ZVEC2(:) + 18. ) )
+ IVEC2(:) = INT(ZVEC2(:))
+ ZVEC2(:) = ZVEC2(:) - REAL(IVEC2(:))
+ ENDWHERE
+!
+! Interpolate XSAUNDER
+ ZDQLWC_OPT(:) = BI_LIN_INTP_V( XSAUNDER, IVEC2, IVEC1, ZVEC2, ZVEC1, &
+ IGSAUN )
+ ZDQLWC_AUX(:) = UNPACK( ZDQLWC_OPT(:), MASK=GSAUN, FIELD=0.0 )
+!
+ DEALLOCATE( IVEC1 )
+ DEALLOCATE( IVEC2 )
+ DEALLOCATE( ZVEC1 )
+ DEALLOCATE( ZVEC2 )
+ DEALLOCATE( ZDQLWC_OPT )
+!
+END SUBROUTINE ELEC_INI_NI_SAUNQ
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE ELEC_INI_NI_TAKAH(ZEW, ZDQTAKA_AUX, XTAKA_AUX)
+!
+IMPLICIT NONE
+!
+REAL, DIMENSION(IMICRO) :: ZEW
+REAL, DIMENSION(IMICRO) :: ZDQTAKA_AUX
+REAL, DIMENSION(NIND_LWC+1,NIND_TEMP+1) :: XTAKA_AUX !XMANSELL or XTAKA_TM)
+!
+!
+ ALLOCATE ( IVEC1(IGTAKA) )
+ ALLOCATE ( IVEC2(IGTAKA) )
+ ALLOCATE ( ZVEC1(IGTAKA) )
+ ALLOCATE ( ZVEC2(IGTAKA) )
+ ALLOCATE ( ZDQTAKA_OPT(IGTAKA) )
+
+ ZDQTAKA_OPT(:) = 0.
+ IVEC1(:) = 0
+ IVEC2(:) = 0
+!
+ ZVEC1(:) = PACK( ZZT(:), MASK=GTAKA )
+ ZVEC2(:) = PACK( ZEW(:), MASK=GTAKA )
+ ZDQTAKA_OPT(:) = PACK( ZDQTAKA_AUX(:), MASK=GTAKA )
+!
+! Temperature index (0C --> -40C)
+ ZVEC1(1:IGTAKA) = MAX( 1.00001, MIN( REAL(NIND_TEMP)-0.00001, &
+ (ZVEC1(1:IGTAKA) - XTT - 1.)/(-1.) ) )
+ IVEC1(1:IGTAKA) = INT( ZVEC1(1:IGTAKA) )
+ ZVEC1(1:IGTAKA) = ZVEC1(1:IGTAKA) - REAL(IVEC1(1:IGTAKA))
+!
+! LWC index (0.01 g.m^-3 --> 10 g.m^-3)
+ WHERE (ZVEC2(:) >= 0.01 .AND. ZVEC2(:) < 0.1)
+ ZVEC2(:) = MAX( 1.00001, MIN( REAL(10)-0.00001, &
+ ZVEC2(:) * 100. ))
+ IVEC2(:) = INT(ZVEC2(:))
+ ZVEC2(:) = ZVEC2(:) - REAL(IVEC2(:))
+ ENDWHERE
+!
+ WHERE (ZVEC2(:) >= 0.1 .AND. ZVEC2(:) < 1. .AND. IVEC2(:) == 0)
+ ZVEC2(:) = MAX( 10.00001, MIN( REAL(19)-0.00001, &
+ ZVEC2(:) * 10. + 9. ) )
+ IVEC2(:) = INT(ZVEC2(:))
+ ZVEC2(:) = ZVEC2(:) - REAL(IVEC2(:))
+ ENDWHERE
+!
+ WHERE (ZVEC2(:) >= 1. .AND. ZVEC2(:) <= 10.)
+ ZVEC2(:) = MAX( 19.00001, MIN( REAL(NIND_LWC)-0.00001, &
+ ZVEC2(:) + 18. ) )
+ IVEC2(:) = INT(ZVEC2(:))
+ ZVEC2(:) = ZVEC2(:) - REAL(IVEC2(:))
+ ENDWHERE
+!
+! Interpolate XMANSELL or XTAKA_TM
+ ZDQTAKA_OPT(:) = BI_LIN_INTP_V( XTAKA_AUX, IVEC2, IVEC1, ZVEC2, ZVEC1, &
+ IGTAKA )
+ ZDQTAKA_AUX(:) = UNPACK( ZDQTAKA_OPT(:), MASK=GTAKA, FIELD=0.0 )
+!
+ DEALLOCATE( IVEC1 )
+ DEALLOCATE( IVEC2 )
+ DEALLOCATE( ZVEC1 )
+ DEALLOCATE( ZVEC2 )
+ DEALLOCATE( ZDQTAKA_OPT )
+!
+END SUBROUTINE ELEC_INI_NI_TAKAH
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE ELEC_IAGGS_B()
+!
+! Purpose : compute charge separation process during the collision
+! between ice and snow
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 1. Collision efficiency
+!
+ ZCOLIS(:) = XCOLIS * EXP(XCOLEXIS * (ZZT(:) - XTT))
+!
+!* 2. Charging process following Helsdon and Farley (1987)
+!
+ IF (CNI_CHARGING == 'HELFA') THEN
+ ZWQ1(:,7) = 0.
+!
+ WHERE (ZRIS(:) > XRTMIN_ELEC(4) .AND. ZCIT(:) > 0.0 .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5))
+ ZWQ1(:,7) = XFQIAGGSBH * ZZW(:) * ZCIT(:) / ZRIT(:)
+ ZWQ1(:,7) = ZWQ1(:,7) * (1. - ZCOLIS(:)) / ZCOLIS(:)
+!
+! Temperature dependance of the charge transferred
+ ZWQ1(:,7) = ZWQ1(:,7) * (ZZT(:) - XQTC) / ABS(ZZT(:) - XQTC)
+ ZWQ1(:,7) = ZWQ1(:,7) / ZRHODREF(:)
+!
+ ZQSS(:) = ZQSS(:) + ZWQ1(:,7)
+ ZQIS(:) = ZQIS(:) - ZWQ1(:,7)
+ END WHERE
+ END IF
+!
+!* 3. Charging process following Gardiner et al. (1985)
+!
+ IF (CNI_CHARGING == 'GARDI') THEN
+ ZWQ1(:,7) = 0.
+ WHERE (GELEC(:,1) .AND. ZDELTALWC(:) > 0. .AND. &
+ ZRIS(:) > ZRSMIN_ELEC(4) .AND. ZRSS(:) > ZRSMIN_ELEC(5))
+ ZWQ1(:,7) = XFQIAGGSBG * (1 - ZCOLIS(:)) * &
+ ZRHODREF(:)**(-4. * XCEXVT + 4. / XBI) * &
+ ZCIT(:)**(1 - 4. / XBI) * &
+ ZDELTALWC(:) * ZFT(:) * &
+ ZLBDAS(:)**(XCXS - 2. - 4. * XDS) * &
+ (XAI * MOMG(XALPHAI, XNUI, XBI) / &
+ ZRIT(:))**(-4 / XBI)
+!
+! Dq is limited to XLIM_NI_IS
+ ZLIMIT(:) = XLIM_NI_IS * ZZW(:) * ZCIT(:) * &
+ (1 - ZCOLIS(:)) / (ZRIT(:) * ZCOLIS(:))
+ ZWQ1(:,7) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,7)) ), ZWQ1(:,7) )
+ ZWQ1(:,7) = ZWQ1(:,7) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperatures lower than -30C --> linear interpolation
+ WHERE (ZWQ1(:,7) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
+ ZWQ1(:,7) = ZWQ1(:,7) * (ZZT(:) - XTT + 40.) / 10.
+ ENDWHERE
+!
+ ZQSS(:) = ZQSS(:) + ZWQ1(:,7)
+ ZQIS(:) = ZQIS(:) - ZWQ1(:,7)
+ END IF
+!
+!* 4. Charging process based on EW: SAUN1/SAUN2, TEEWC
+!* following Saunders et al. (1991), Takahashi via Tsenova and Mitzeva (2009)
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'TEEWC') THEN
+ ZWQ1(:,7) = 0.
+!
+ WHERE (GELEC(:,1) .AND. ZRIS(:) > ZRSMIN_ELEC(4) .AND. &
+ ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZDQLWC(:) /= 0.)
+ ZWQ1(:,7) = XFQIAGGSBS * (1 - ZCOLIS(:)) * &
+ ZRHOCOR(:)**(1 + ZSAUNIN(:)) * &
+ ZFQIAGGS(:) * ZDQLWC(:) * &
+ ZCIT(:)**(1 - ZSAUNIM(:) / XBI) * &
+ ZLBDAS(:)**(XCXS - 2.- XDS * (1. + ZSAUNIN(:))) * &
+ (ZRHODREF(:) * ZRIT(:) / XAIGAMMABI)**(ZSAUNIM(:) / XBI)
+!
+! Dq is limited to XLIM_NI_IS
+ ZLIMIT(:) = XLIM_NI_IS * ZZW(:) * ZCIT(:) * &
+ (1 - ZCOLIS(:)) / (ZRIT(:) * ZCOLIS(:))
+ ZWQ1(:,7) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,7)) ), ZWQ1(:,7) )
+ ZWQ1(:,7) = ZWQ1(:,7) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperatures lower than -30C --> linear interpolation
+ WHERE (ZWQ1(:,7) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
+ ZWQ1(:,7) = ZWQ1(:,7) * (ZZT(:) - XTT + 40.) / 10.
+ ENDWHERE
+!
+ ZQSS(:) = ZQSS(:) + ZWQ1(:,7)
+ ZQIS(:) = ZQIS(:) - ZWQ1(:,7)
+!
+ END IF
+!
+!* 5. Charging process based on RAR (=EW*V): SAP98, BSMP1/BSMP2, TERAR
+!* following Saunders and Peck (1998) or
+!* Brooks et al., 1997 (with/out anomalies) or
+!* Takahashi via Tsenova and Mitzeva (2011)
+!
+ IF (CNI_CHARGING == 'SAP98' .OR. CNI_CHARGING == 'BSMP1' .OR. &
+ CNI_CHARGING == 'BSMP2' .OR. CNI_CHARGING == 'TERAR') THEN
+!
+ IF (CNI_CHARGING /= 'TERAR') THEN
+ ZFQIAGGS(:) = XFQIAGGSP
+ WHERE (ZDQRAR_IS(:) < 0.)
+ ZFQIAGGS(:) = XFQIAGGSN
+ ENDWHERE
+ ELSE
+ ZFQIAGGS(:) = XFQIAGGSP_TAK
+ WHERE (ZDQRAR_IS(:) <0.)
+ ZFQIAGGS(:) = XFQIAGGSN_TAK
+ ENDWHERE
+ ENDIF
+!
+ ZWQ1(:,7) = 0.
+!
+ WHERE (GELEC(:,1) .AND. ZDQRAR_IS(:) /= 0. .AND. &
+ ZRIS(:) > ZRSMIN_ELEC(4) .AND. ZRSS(:) > ZRSMIN_ELEC(5))
+ ZWQ1(:,7) = XFQIAGGSBS * (1 - ZCOLIS(:)) * &
+ ZRHOCOR(:)**(1 + ZSAUNIN_IS(:)) * &
+ ZFQIAGGS(:) * ZDQRAR_IS(:) * &
+ ZCIT(:)**(1 - ZSAUNIM_IS(:) / XBI) * &
+ ZLBDAS(:)**(XCXS - 2.- XDS * (1. + ZSAUNIN_IS(:))) * &
+ (ZRHODREF(:) * ZRIT(:)/XAIGAMMABI)**(ZSAUNIM_IS(:) / XBI)
+!
+! Dq is limited to XLIM_NI_IS
+ ZLIMIT(:) = XLIM_NI_IS * ZZW(:) * ZCIT(:) * &
+ (1 - ZCOLIS(:)) / (ZRIT(:) * ZCOLIS(:))
+ ZWQ1(:,7) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,7)) ), ZWQ1(:,7) )
+ ZWQ1(:,7) = ZWQ1(:,7) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperatures lower than -30C --> linear interpolation
+ WHERE (ZWQ1(:,7) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
+ ZWQ1(:,7) = ZWQ1(:,7) * (ZZT(:) - XTT + 40.) / 10.
+ ENDWHERE
+!
+ ZQSS(:) = ZQSS(:) + ZWQ1(:,7)
+ ZQIS(:) = ZQIS(:) - ZWQ1(:,7)
+ END IF
+!
+!* 6. Charging process following Takahashi (1978)
+!
+ IF (CNI_CHARGING == 'TAKAH') THEN
+ ZWQ1(:,7) = 0.
+ ZLIMIT(:) = 0.
+!
+ WHERE (GELEC(:,1) .AND. ZRIS(:) > ZRSMIN_ELEC(4) .AND. &
+ ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZDQLWC(:) /= 0.)
+ ZWQ1(:,7) = XFQIAGGSBT1 * (1.0 - ZCOLIS(:)) * ZRHOCOR(:) * &
+ ZCIT(:) * ZLBDAS(:)**XCXS * ZDQLWC(:) * &
+ MIN( XFQIAGGSBT2 / (ZLBDAS(:)**(2. + XDS)) , &
+ XFQIAGGSBT3 * ZRHOCOR(:) * ZRHODREF(:)**(2./XBI) * &
+ ZRIT(:)**(2. / XBI) / &
+ (ZCIT(:)**(2. / XBI) * ZLBDAS(:)**(2. + 2. * XDS)))
+!
+! Dq is limited to XLIM_NI_IS
+ ZLIMIT(:) = XLIM_NI_IS * ZZW(:) * ZCIT(:) * &
+ (1 - ZCOLIS(:)) / (ZRIT(:) * ZCOLIS(:))
+ ZWQ1(:,7) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,7)) ), ZWQ1(:,7) )
+ ZWQ1(:,7) = ZWQ1(:,7) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperatures lower than -30C --> linear interpolation
+ WHERE (ZWQ1(:,7) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
+ ZWQ1(:,7) = ZWQ1(:,7) * (ZZT(:) - XTT + 40.) / 10.
+ ENDWHERE
+!
+ ZQSS(:) = ZQSS(:) + ZWQ1(:,7)
+ ZQIS(:) = ZQIS(:) - ZWQ1(:,7)
+ END IF
+!
+!
+END SUBROUTINE ELEC_IAGGS_B
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE ELEC_IDRYG_B()
+!
+! Purpose : compute charge separation process during the dry collision
+! between ice and graupeln
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!
+!* 1. COMPUTE THE COLLECTION EFFICIENCY
+! ---------------------------------
+!
+ ZCOLIG(:) = XCOLIG * EXP(XCOLEXIG * (ZZT(:) - XTT))
+!
+!* 2. COMPUTE THE CHARGE SEPARATION DURING IDRYG_BOUN
+! -----------------------------------------------
+!
+!* 2.1 Helsdon and Farley (1987)
+!
+ IF (CNI_CHARGING == 'HELFA') THEN
+ ZWQ1(:,3) = 0.
+ WHERE (ZRIS(:) > ZRSMIN_ELEC(4) .AND. ZCIT(:) > 0.0 .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZRGS(:) > ZRSMIN_ELEC(6))
+ ZWQ1(:,3) = XHIDRYG * ZZW1(:,2) * ZCIT(:) / ZRIT(:)
+ ZWQ1(:,3) = ZWQ1(:,3) * (1. - ZCOLIG(:)) / ZCOLIG(:) ! QIDRYG_boun
+!
+! Temperature dependance of the charge transfered
+ ZWQ1(:,3) = ZWQ1(:,3) * (ZZT(:) - XQTC) / ABS(ZZT(:) - XQTC)
+ ZWQ1(:,3) = ZWQ1(:,3) / ZRHODREF(:)
+ END WHERE
+ END IF
+!
+!
+!* 2.2 Gardiner et al. (1985)
+!
+ IF (CNI_CHARGING == 'GARDI') THEN
+ ZWQ1(:,3) = 0.
+!
+ WHERE (GELEC(:,2) .AND. ZRIS(:) > ZRSMIN_ELEC(4) .AND. &
+ ZRGS(:) > ZRSMIN_ELEC(6) .AND. ZDELTALWC(:) > 0.)
+ ZWQ1(:,3) = XFQIDRYGBG * XLBQIDRYGBG * (1 - ZCOLIG) * &
+ ZRHODREF(:)**(-4. * XCEXVT + 4. / XBI) * &
+ ZCIT(:)**(1 - 4. / XBI) * &
+ ZDELTALWC(:) * ZFT(:) * &
+ ZLBDAG(:)**(XCXG - 2. - 4. * XDG) * &
+ (XAI * MOMG(XALPHAI, XNUI, XBI) / &
+ ZRIT(:))**(-4 / XBI)
+!
+! Dq limited to XLIM_NI_IG
+ ZLIMIT(:) = XLIM_NI_IG * ZZW1(:,2) * ZCIT(:) * (1 - ZCOLIG(:)) / &
+ (ZRIT(:) * ZCOLIG(:))
+ ZWQ1(:,3) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,3)) ), ZWQ1(:,3) )
+ ZWQ1(:,3) = ZWQ1(:,3) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperatures lower than -30C --> linear interpolation
+!
+ WHERE (ZWQ1(:,3) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
+ ZWQ1(:,3) = ZWQ1(:,3) * (ZZT(:) - XTT + 40.) / 10.
+ ENDWHERE
+!
+ END IF
+!
+!
+!* 2.3 Charging process based on EW: SAUN1/SAUN2, TEEWC
+!* following Saunders et al. (1991), Takahashi via Tsenova and Mitzeva(2009)
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'TEEWC') THEN
+ ZWQ1(:,3) = 0.
+!
+ WHERE (GELEC(:,2) .AND. ZRIS(:) > ZRSMIN_ELEC(4) .AND. &
+ ZRGS(:) > ZRSMIN_ELEC(6) .AND. ZDQLWC(:) /= 0.)
+ ZWQ1(:,3) = XFQIDRYGBS * (1. - ZCOLIG(:)) * &
+ ZRHOCOR(:)**(1. + ZSAUNIN(:)) * &
+ ZFQIDRYGBS(:) * ZDQLWC(:) * &
+ ZCIT(:)**(1. - ZSAUNIM(:) / XBI) * &
+ ZLBDAG(:)**(XCXG - 2. - XDG * (1. + ZSAUNIN(:))) * &
+ (ZRHODREF(:) * ZRIT(:)/XAIGAMMABI)**(ZSAUNIM(:) / XBI)
+!
+! Dq is limited to XLIM_NI_IG
+ ZLIMIT(:) = XLIM_NI_IG * ZZW1(:,2) * ZCIT(:) * (1 - ZCOLIG(:)) / &
+ (ZRIT(:) * ZCOLIG(:))
+ ZWQ1(:,3) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,3)) ), ZWQ1(:,3) )
+ ZWQ1(:,3) = ZWQ1(:,3) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperatures lower than -30C --> linear interpolation
+ WHERE (ZWQ1(:,3) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
+ ZWQ1(:,3) = ZWQ1(:,3) * (ZZT(:) - XTT + 40.) / 10.
+ ENDWHERE
+!
+ END IF
+!
+!
+!* 2.4 Charging process based on RAR (=EW*V): SAP98, BSMP1/BSMP2, TERAR
+!* following Saunders and Peck (1998) or
+!* Brooks et al., 1997 (with/out anomalies) or
+!* Takahashi via Tsenova and Mitzeva (2011)
+!
+ IF (CNI_CHARGING == 'SAP98' .OR. CNI_CHARGING == 'BSMP1' .OR. &
+ CNI_CHARGING == 'BSMP2' .OR. CNI_CHARGING == 'TERAR') THEN
+!
+ IF (CNI_CHARGING /= 'TERAR') THEN
+ ZFQIDRYGBS(:) = XFQIDRYGBSP
+ WHERE (ZDQRAR_IG(:) < 0.)
+ ZFQIDRYGBS(:) = XFQIDRYGBSN
+ ENDWHERE
+ ELSE
+ ZFQIDRYGBS(:) = XFQIDRYGBSP_TAK
+ WHERE (ZDQRAR_IG(:) <0.)
+ ZFQIDRYGBS(:) = XFQIDRYGBSN_TAK
+ ENDWHERE
+ END IF
+!
+ ZWQ1(:,3) = 0.
+!
+ WHERE (GELEC(:,2) .AND. ZDQRAR_IG(:) /= 0. .AND. &
+ ZRIS(:) > ZRSMIN_ELEC(4) .AND. ZRGS(:) > ZRSMIN_ELEC(6))
+ ZWQ1(:,3) = XFQIDRYGBS * (1. - ZCOLIG(:)) * &
+ ZRHOCOR(:)**(1 + ZSAUNIN_IG(:)) * &
+ ZFQIDRYGBS(:) * ZDQRAR_IG(:) * &
+ ZCIT(:)**(1 - ZSAUNIM_IG(:) / XBI) * &
+ ZLBDAG(:)**(XCXG - 2. - XDG * (1. + ZSAUNIN_IG(:))) * &
+ (ZRHODREF(:) * ZRIT(:)/XAIGAMMABI)**(ZSAUNIM_IG(:) / XBI)
+!
+! Dq is limited to XLIM_NI_IG
+ ZLIMIT(:) = XLIM_NI_IG * ZZW1(:,2) * ZCIT(:) * (1 - ZCOLIG(:)) / &
+ (ZRIT(:) * ZCOLIG(:))
+ ZWQ1(:,3) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,3)) ), ZWQ1(:,3) )
+ ZWQ1(:,3) = ZWQ1(:,3) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperatures lower than -30C --> linear interpolation
+ WHERE (ZWQ1(:,3) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
+ ZWQ1(:,3) = ZWQ1(:,3) * (ZZT(:) - XTT + 40.) / 10.
+ ENDWHERE
+ END IF
+!
+!
+!* 2.5 Takahashi (1978)
+!
+ IF (CNI_CHARGING == 'TAKAH') THEN
+ ZWQ1(:,3) = 0.
+ ZLIMIT(:) = 0.
+!
+ WHERE (GELEC(:,2) .AND. ZRIS(:) > ZRSMIN_ELEC(4) .AND. &
+ ZRGS(:) > ZRSMIN_ELEC(6) .AND. ZDQLWC(:) /= 0.)
+ ZWQ1(:,3) = XFQIDRYGBT1 * (1. - ZCOLIG(:)) * ZRHOCOR(:) * &
+ ZCIT(:) * ZLBDAG(:)**XCXG * ZDQLWC(:) * &
+ MIN( XFQIDRYGBT2 / (ZLBDAG(:)**(2. + XDG)), &
+ XFQIDRYGBT3 * ZRHOCOR(:) * ZRHODREF(:)**(2./XBI) * &
+ ZRIT(:)**(2. / XBI) / (ZCIT(:)**(2. / XBI) * &
+ ZLBDAG(:)**(2. + 2. * XDG)) )
+!
+! Dq is limited to XLIM_NI_IG
+ ZLIMIT(:) = XLIM_NI_IG * ZZW1(:,2) * ZCIT(:) * (1 - ZCOLIG(:)) / &
+ (ZRIT(:) * ZCOLIG(:))
+ ZWQ1(:,3) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,3)) ), ZWQ1(:,3) )
+ ZWQ1(:,3) = ZWQ1(:,3) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperatures lower than -30C --> linear interpolation
+ WHERE (ZWQ1(:,3) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
+ ZWQ1(:,3) = ZWQ1(:,3) * (ZZT(:) - XTT + 40.) / 10.
+ ENDWHERE
+ END IF
+!
+!
+END SUBROUTINE ELEC_IDRYG_B
+!
+!-------------------------------------------------------------------------------
+!
+ SUBROUTINE ELEC_SDRYG_B()
+!
+! Purpose : compute the charge separation during the dry collision
+! between snow and graupeln
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!
+!* 1. COMPUTE THE COLLECTION EFFICIENCY
+! ---------------------------------
+!
+ ZCOLSG(:) = XCOLSG * EXP (XCOLEXSG * (ZZT(:) - XTT))
+!
+!* 2. COMPUTE THE CHARGE SEPARATION DURING SDRYG_BOUN
+! -----------------------------------------------
+!
+!* 2.1 Helsdon and Farley (1987)
+!
+ IF (CNI_CHARGING == 'HELFA') THEN
+ ZWQ1(:,5) = 0.
+!
+ WHERE (ZRGT(:) > XRTMIN_ELEC(6) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZRGS(:) > ZRSMIN_ELEC(6) .AND. ZRSS(:) > ZRSMIN_ELEC(5) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAG(:) > 0.)
+ ZWQ1(:,5) = ZWQ1(:,10) * XFQSDRYGBH * ZRHODREF(:)**(-XCEXVT) * &
+ (1. - ZCOLSG(:)) * &
+ ZLBDAS(:)**(XCXS) * ZLBDAG(:)**(XCXG) * &
+ (XLBQSDRYGB4H * ZLBDAS(:)**(-2.) + &
+ XLBQSDRYGB5H * ZLBDAS(:)**(-1.) * ZLBDAG(:)**(-1.) + &
+ XLBQSDRYGB6H * ZLBDAG(:)**(-2.))
+!
+! Temperature dependance of the charge transfered
+ ZWQ1(:,5) = ZWQ1(:,5) * (ZZT(:) - XQTC) / ABS(ZZT(:) - XQTC)
+ ZWQ1(:,5) = ZWQ1(:,5) / ZRHODREF(:)
+ ENDWHERE
+ ENDIF
+!
+!
+!* 2.2 Gardiner et al. (1985)
+!
+ IF (CNI_CHARGING == 'GARDI') THEN
+ ZWQ1(:,5) = 0.
+ ZLIMIT(:) = 0.
+!
+ WHERE (GELEC(:,3) .AND. ZRGS(:) > ZRSMIN_ELEC(6) .AND. &
+ ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZDELTALWC(:) > 0.)
+ ZWQ1(:,5) = XFQSDRYGBG * (1. - ZCOLSG(:)) * &
+ ZRHODREF(:)**(-4. * XCEXVT) * &
+ ZFT(:) * ZDELTALWC(:) * &
+ ZLBDAG(:)**XCXG * ZLBDAS(:)**XCXS * &
+ (XLBQSDRYGB4G * ZLBDAS(:)**(-4.) * ZLBDAG(:)**(-2.) + &
+ XLBQSDRYGB5G * ZLBDAS(:)**(-5.) * ZLBDAG(:)**(-1.) + &
+ XLBQSDRYGB6G * ZLBDAS(:)**(-6.)) * &
+ ZWQ1(:,10)
+!
+! Dq is limited to XLIM_NI_SG
+ ZLIMIT(:) = XLIM_NI_SG * ZAUX1(:) * XAUX_LIM * &
+ ZRHOCOR(:) * (1. - ZCOLSG(:)) * &
+ ZLBDAS(:)**(XCXS) * ZLBDAG(:)**(XCXG) * &
+ (XAUX_LIM1 * ZLBDAS(:)**(-2.) + &
+ XAUX_LIM2 * ZLBDAS(:)**(-1.) * ZLBDAG(:)**(-1.) + &
+ XAUX_LIM3 * ZLBDAG(:)**(-2.))
+ ZWQ1(:,5) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,5)) ), ZWQ1(:,5))
+ ZWQ1(:,5) = ZWQ1(:,5) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperatures lower than -30C --> linear interpolation
+ WHERE (ZWQ1(:,5) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
+ ZWQ1(:,5) = ZWQ1(:,5) * (ZZT(:) - XTT + 40.) / 10.
+ ENDWHERE
+ END IF
+!
+!* 2.3 Charging process based on EW: SAUN1/SAUN2, TEEWC
+!* following Saunders et al. (1991), Takahashi via Tsenova and Mitzeva(2009)
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'TEEWC') THEN
+!
+ ZWQ1(:,5) = 0.
+ ZLIMIT(:) = 0.
+!
+ WHERE (GELEC(:,3) .AND. ZRGS(:) > ZRSMIN_ELEC(6) .AND. &
+ ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZDQLWC(:) /= 0.)
+!
+! ZWQ1(:,5) = ZWQ3(:) If graupel gains positive charge ZDQLWC(:) > 0.
+! ZWQ1(:,5) = ZWQ4(:) If graupel gains negative charge ZDQLWC(:) < 0.
+ ZWQ1(:,5) = ZWQ3(:) * (0.5 + SIGN(0.5,ZDQLWC(:))) + &
+ ZWQ4(:) * (0.5 - SIGN(0.5,ZDQLWC(:)))
+!
+ ZWQ1(:,5) = ZWQ1(:,5) * XFQSDRYGBS * (1. - ZCOLSG(:)) * &
+ ZRHOCOR(:)**(1. + ZSAUNSN(:)) * &
+ ZSAUNSK(:) * ZDQLWC(:) * &
+ ZLBDAG(:)**XCXG * ZLBDAS(:)**XCXS * &
+ ( ZLBQSDRYGB1S(:) / (ZLBDAS(:)**ZSAUNSM(:) *ZLBDAG(:)**2) + &
+ ZLBQSDRYGB2S(:) / (ZLBDAS(:)**( 1.+ZSAUNSM(:))*ZLBDAG(:)) + &
+ ZLBQSDRYGB3S(:) / ZLBDAS(:)**(2.+ZSAUNSM(:)) )
+!
+! Dq is limited to XLIM_NI_SG
+ ZLIMIT(:) = XLIM_NI_SG * ZAUX1(:) * XAUX_LIM * &
+ ZRHOCOR(:) * (1. - ZCOLSG(:)) * &
+ ZLBDAS(:)**(XCXS) * ZLBDAG(:)**(XCXG) * &
+ ( XAUX_LIM1 / ZLBDAS(:)**2 + &
+ XAUX_LIM2 /(ZLBDAS(:) * ZLBDAG(:)) + &
+ XAUX_LIM3 / ZLBDAG(:)**2 )
+ ZWQ1(:,5) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,5)) ), ZWQ1(:,5))
+ ZWQ1(:,5) = ZWQ1(:,5) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperatures lower than -30C --> linear interpolation
+ WHERE (ZWQ1(:,5) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
+ ZWQ1(:,5) = ZWQ1(:,5) * (ZZT(:) - XTT + 40.) / 10.
+ ENDWHERE
+!
+ END IF
+!
+!
+!* 2.4 Charging process based on RAR (=EW*V): SAP98, BSMP1/BSMP2, TERAR
+!* following Saunders and Peck (1998) or
+!* Brooks et al., 1997 (with/out anomalies) or
+!* Takahashi via Tsenova and Mitzeva (2011)
+!
+ IF (CNI_CHARGING == 'SAP98' .OR. CNI_CHARGING == 'BSMP1' .OR. &
+ CNI_CHARGING == 'BSMP2' .OR. CNI_CHARGING == 'TERAR') THEN
+!
+ ZLBQSDRYGB1S(:) = XLBQSDRYGB1SP
+ ZLBQSDRYGB2S(:) = XLBQSDRYGB2SP
+ ZLBQSDRYGB3S(:) = XLBQSDRYGB3SP
+ WHERE (ZDQRAR_SG(:) < 0.)
+ ZLBQSDRYGB1S(:) = XLBQSDRYGB1SN
+ ZLBQSDRYGB2S(:) = XLBQSDRYGB2SN
+ ZLBQSDRYGB3S(:) = XLBQSDRYGB3SN
+ ENDWHERE
+!
+ ZWQ1(:,5) = 0.
+ ZLIMIT(:) = 0.
+!
+ WHERE (GELEC(:,3) .AND. ZDQRAR_SG(:) /= 0. .AND. &
+ ZRGS(:) > ZRSMIN_ELEC(6) .AND. ZRSS(:) > ZRSMIN_ELEC(5))
+ ZWQ1(:,5) = ZWQ3(:) * (0.5+SIGN(0.5,ZDQRAR_SG(:))) + &
+ ZWQ4(:) * (0.5-SIGN(0.5,ZDQRAR_SG(:)))
+!
+ ZWQ1(:,5) = ZWQ1(:,5) * XFQSDRYGBS * (1. - ZCOLSG(:)) * &
+ ZRHOCOR(:)**(1. + ZSAUNSN_SG(:)) * &
+ ZSAUNSK_SG(:) * ZDQRAR_SG(:) * &
+ ZLBDAG(:)**XCXG * ZLBDAS(:)**XCXS * &
+ (ZLBQSDRYGB1S(:)/(ZLBDAS(:)**ZSAUNSM_SG(:) * ZLBDAG(:)**2) + &
+ ZLBQSDRYGB2S(:)/(ZLBDAS(:)**(1.+ZSAUNSM_SG(:))*ZLBDAG(:)) + &
+ ZLBQSDRYGB3S(:)/ ZLBDAS(:)**(2.+ZSAUNSM_SG(:)) )
+!
+!
+! Dq is limited to XLIM_NI_SG
+ ZLIMIT(:) = XLIM_NI_SG * ZAUX1(:) * XAUX_LIM * &
+ ZRHOCOR(:) * (1. - ZCOLSG(:)) * &
+ ZLBDAS(:)**(XCXS) * ZLBDAG(:)**(XCXG) * &
+ ( XAUX_LIM1 / ZLBDAS(:)**2 + &
+ XAUX_LIM2 /(ZLBDAS(:) * ZLBDAG(:)) + &
+ XAUX_LIM3 / ZLBDAG(:)**2 )
+ ZWQ1(:,5) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,5)) ), ZWQ1(:,5))
+ ZWQ1(:,5) = ZWQ1(:,5) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperature lower than -30C --> linear interpolation
+ WHERE (ZWQ1(:,5) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
+ ZWQ1(:,5) = ZWQ1(:,5) * (ZZT(:) - XTT + 40.) / 10.
+ ENDWHERE
+ END IF
+!
+!
+!* 2.5 Takahashi (1978)
+!
+ IF (CNI_CHARGING == 'TAKAH') THEN
+ ZWQ1(:,5) = 0.
+ ZLIMIT(:) = 0.
+!
+ WHERE (GELEC(:,3) .AND. ZRGS(:) > ZRSMIN_ELEC(6) .AND. &
+ ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZDQLWC(:) /= 0.)
+ ZWQ1(:,5) = XFQSDRYGBT1 * (1. - ZCOLSG(:)) * ZRHOCOR(:) * &
+ ZLBDAG(:)**XCXG * ZLBDAS(:)**XCXS * ZDQLWC(:) * &
+ MIN(10. * ( &
+ ABS(XFQSDRYGBT2 / (ZLBDAG(:)**XDG * ZLBDAS(:)**2.) - &
+ XFQSDRYGBT3 / (ZLBDAS(:)**(2. + XDS))) + &
+ ABS(XFQSDRYGBT4 / (ZLBDAG(:)**(2.+XDG)) - &
+ XFQSDRYGBT5 / (ZLBDAS(:)**XDS * ZLBDAG(:)**2.)) + &
+ ABS(XFQSDRYGBT6 / (ZLBDAG(:)**(1. + XDG) * ZLBDAS(:)) - &
+ XFQSDRYGBT7 / (ZLBDAS(:)**(1. + XDS) * ZLBDAG(:)))), &
+ XFQSDRYGBT8 * ZRHOCOR(:) * ZWQ1(:,10) * &
+ (XFQSDRYGBT9 / (ZLBDAS(:)**2. * ZLBDAG(:)**2.) + &
+ XFQSDRYGBT10 / (ZLBDAS(:)**4.) + &
+ XFQSDRYGBT11 / (ZLBDAS(:)**3. * ZLBDAG(:))))
+!
+! Dq is limited to XLIM_NI_SG
+ ZLIMIT(:) = XLIM_NI_SG * ZAUX1(:) * XAUX_LIM * &
+ ZRHOCOR(:) * (1. - ZCOLSG(:)) * &
+ ZLBDAS(:)**(XCXS) * ZLBDAG(:)**(XCXG) * &
+ ( XAUX_LIM1 / ZLBDAS(:)**2 + &
+ XAUX_LIM2 /(ZLBDAS(:) * ZLBDAG(:)) + &
+ XAUX_LIM3 / ZLBDAG(:)**2 )
+ ZWQ1(:,5) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,5)) ), ZWQ1(:,5))
+ ZWQ1(:,5) = ZWQ1(:,5) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperature lower than -30C --> linear interpolation
+ WHERE (ZWQ1(:,5) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.))
+ ZWQ1(:,5) = ZWQ1(:,5) * (ZZT(:) - XTT + 40.) / 10.
+ ENDWHERE
+ END IF
+!
+!
+END SUBROUTINE ELEC_SDRYG_B
+!
+!------------------------------------------------------------------------------
+!
+ SUBROUTINE INDUCTIVE_PROCESS
+!
+! Computation of the charge transfer rate during inductive mechanism
+! Only the bouncing droplet-graupel collision when the graupel is in the dry
+! growth mode is considered
+! The electric field is limited to 100 kV/m
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!
+!* 1. COMPUTE THE CHARGING RATE
+! -------------------------
+!
+ ZRATE_IND(:) = 0.
+!
+ WHERE (GIND(:) .AND. &
+ ZEFIELDW(:) /= 0. .AND. ABS(ZEGS(:)) > XEGMIN .AND. &
+ ZLBDAG(:) > 0. .AND. &
+ ZRGT(:) > XRTMIN_ELEC(6) .AND. ZRGS(:) > ZRSMIN_ELEC(6) .AND. &
+ ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRCS(:) > ZRSMIN_ELEC(2))
+ ZRATE_IND(:) = XIND1 * ZLBDAG(:)**XCXG * ZRHOCOR(:) * &
+ (XIND2 * SIGN(MIN(100.E3, ABS(ZEFIELDW(:))), ZEFIELDW(:)) * &
+ ZLBDAG(:) **(-2.-XDG) - &
+ XIND3 * ZEGS(:) * ZLBDAG(:)**(-XFG-XDG))
+ ZRATE_IND(:) = ZRATE_IND(:) / ZRHODREF(:)
+ ZQGS(:) = ZQGS(:) + ZRATE_IND(:)
+ ZQCS(:) = ZQCS(:) - ZRATE_IND(:)
+ END WHERE
+!
+END SUBROUTINE INDUCTIVE_PROCESS
+!
+!------------------------------------------------------------------------------
+!
+!
+ FUNCTION BI_LIN_INTP_V(ZT, KI, KJ, PDX, PDY, KN) RESULT(Y)
+!
+! | |
+! ZT(KI(1),KJ(2))-|-------------------|-ZT(KI(2),KJ(2))
+! | |
+! | |
+! x2-|-------|y(x1,x2) |
+! | | |
+! PDY| | |
+! | | |
+! | | |
+!ZT( KI(1),KJ(1))-|-------------------|-ZT(KI(2),KJ(1))
+! | PDX |x1 |
+! | |
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.2 Declaration of local variables
+!
+INTEGER :: KN ! Size of the result vector
+INTEGER, DIMENSION(KN) :: KI ! Tabulated coordinate
+INTEGER, DIMENSION(KN) :: KJ ! Tabulated coordinate
+REAL, INTENT(IN), DIMENSION(:,:) :: ZT ! Tabulated data
+REAL, INTENT(IN), DIMENSION(KN) :: PDX, PDY !
+REAL, DIMENSION(KN) :: Y ! Interpolated value
+!
+INTEGER :: JJ ! Loop index
+!
+!* 1. INTERPOLATION
+! -------------
+!
+DO JJ = 1, KN
+ Y(JJ) = (1.0 - PDX(JJ)) * (1.0 - PDY(JJ)) * ZT(KI(JJ), KJ(JJ)) + &
+ PDX(JJ) * (1.0 - PDY(JJ)) * ZT(KI(JJ)+1,KJ(JJ)) + &
+ PDX(JJ) * PDY(JJ) * ZT(KI(JJ)+1,KJ(JJ)+1) + &
+ (1.0 - PDX(JJ)) * PDY(JJ) * ZT(KI(JJ) ,KJ(JJ)+1)
+ENDDO
+!
+END FUNCTION BI_LIN_INTP_V
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE RAIN_ICE_ELEC
diff --git a/src/ICCARE_BASE/set_mask.f90 b/src/ICCARE_BASE/set_mask.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b4077f482973eae9d4a477d9cb2d91f89aef9411
--- /dev/null
+++ b/src/ICCARE_BASE/set_mask.f90
@@ -0,0 +1,181 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/set_mask.f90,v $ $Revision: 1.2.2.1.2.1.18.2 $
+! MASDEV4_7 budget 2006/09/08 10:35:15
+!-----------------------------------------------------------------
+! ###################
+ SUBROUTINE SET_MASK
+! ###################
+!
+!!****SET_MASK** -routine to define the mask
+!!
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to test the occurence or not of the
+! different criteria, used to compute the budgets. It also updates the
+! number of occurence of the different criteria.
+!
+!!** METHOD
+!! ------
+!! According to each criterion associated to one zone, the mask is
+!! set to TRUE at each point where the criterion is confirmed, at each
+!! time step of the model. Finally, The number of occurence of this criteria is
+!! increased by 1 and stored in the array XBUSURF.
+!! Caution : The mask is defined on the inner domain.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_BUDGET
+!! LBU_MASK : logical array mask defining the zones
+!! NBUTIME : number of the budget step
+!! XBUSURF : mask tracer array (surface array)
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of MESO-NH documentation (routine BUDGET)
+!!
+!!
+!! AUTHOR
+!! ------
+!! J. Nicolau * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 27/02/95
+!! Modification 10/11/97 (P.Jabouille) : computation made only in the inner domain
+!! Modification 18/06/99 (N.Asencio) : // , computation are performed on the extended
+!! domain but logical array mask is initialized
+!! to FALSE outside the physical domain
+!! 02/02/2017 (J.Escobar & JPP ) bug for 1 model only <-> remove unneeded FIELD_MODEL%
+!---------------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_BUDGET
+USE MODE_ll
+USE MODD_FIELD_n, ONLY : XWT, XRT
+!
+USE MODD_PRECIP_n, ONLY : XINPRR
+USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
+USE MODD_REF_n, ONLY : XRHODREF
+USE MODD_GRID_n, ONLY : XZZ
+USE MODD_CST, ONLY : XRHOLW
+!
+IMPLICIT NONE
+!
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIB,IJB ! Lower bounds of the physical
+ ! sub-domain in x and y directions
+INTEGER :: IIE,IJE ! Upper bounds of the physical
+ ! sub-domain in x and y directions
+!
+INTEGER :: IKB, IKE
+INTEGER :: IIU, IJU ! Array sizes in i,j directions
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTHIC, ZTHRW, ZTHCW, ZTHSN, ZTHGR
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTH_LIQ, ZTH_ICE
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDUM
+INTEGER :: JK ! loop index
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTES THE PHYSICAL SUBDOMAIN BOUNDS
+! ---------------------------------------
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+!
+!* 2. DEFINITION OF THE MASK
+! ----------------------
+! initialization to FALSE on the extended subdomain
+LBU_MASK(:,:,:)=.FALSE.
+!
+! computing on the physical subdomain
+!==============================================================================
+! Change the following lines to set the criterion for each of the NBUMASK masks
+!
+IKB = 1 + JPVEXT
+IKE = SIZE(XRHODREF,3) - JPVEXT
+IIU = IIE + JPHEXT
+IJU = IJE + JPHEXT
+!
+ALLOCATE(ZTHIC(IIU,IJU)) ; ZTHIC(:,:) = 0.0
+ALLOCATE(ZTHRW(IIU,IJU)) ; ZTHRW(:,:) = 0.0
+ALLOCATE(ZTHCW(IIU,IJU)) ; ZTHCW(:,:) = 0.0
+ALLOCATE(ZTHSN(IIU,IJU)) ; ZTHSN(:,:) = 0.0
+ALLOCATE(ZTHGR(IIU,IJU)) ; ZTHGR(:,:) = 0.0
+ALLOCATE(ZDUM(IIU,IJU)) ; ZDUM(:,:) = 0.0
+!
+DO JK = IKB, IKE
+ ZDUM(:,:) = XRHODREF(:,:,JK) * (XZZ(:,:,JK+1) - XZZ(:,:,JK)) / XRHOLW
+ ZTHIC(:,:) = ZTHIC(:,:) + XRT(:,:,JK,4) * ZDUM(:,:)
+ ZTHRW(:,:) = ZTHRW(:,:) + XRT(:,:,JK,3) * ZDUM(:,:)
+ ZTHCW(:,:) = ZTHCW(:,:) + XRT(:,:,JK,2) * ZDUM(:,:)
+ ZTHSN(:,:) = ZTHSN(:,:) + XRT(:,:,JK,5) * ZDUM(:,:)
+ ZTHGR(:,:) = ZTHGR(:,:) + XRT(:,:,JK,6) * ZDUM(:,:)
+END DO
+!
+! m --> mm
+ZTHIC(:,:) = ZTHIC(:,:) * 1000.
+ZTHRW(:,:) = ZTHRW(:,:) * 1000.
+ZTHCW(:,:) = ZTHCW(:,:) * 1000.
+ZTHSN(:,:) = ZTHSN(:,:) * 1000.
+ZTHGR(:,:) = ZTHGR(:,:) * 1000.
+!
+ALLOCATE(ZTH_LIQ(IIU,IJU)) ; ZTH_LIQ(:,:) = 0.0
+ALLOCATE(ZTH_ICE(IIU,IJU)) ; ZTH_ICE(:,:) = 0.0
+!
+ZTH_LIQ(:,:) = ZTHCW(:,:) + ZTHRW(:,:)
+ZTH_ICE(:,:) = ZTHIC(:,:) + ZTHSN(:,:) + ZTHGR(:,:)
+!print*, nbutime, ' - min-max inprr = ', minval(xinprr*3600.), maxval(xinprr*3600.)
+!print*, nbutime, ' - min-max zth_liq = ', minval(zth_liq), maxval(zth_liq)
+!print*, nbutime, ' - min-max zth_ice = ', minval(zth_ice), maxval(zth_ice)
+!
+LBU_MASK(IIB:IIE,IJB:IJE,1) = (XINPRR(IIB:IIE,IJB:IJE)*3.6E6) >= 5.
+!LBU_MASK(IIB:IIE,IJB:IJE,2) = .NOT.(LBU_MASK(IIB:IIE,IJB:IJE,1)) .AND. &
+! (XINPRR(IIB:IIE,IJB:IJE)*3.6E6) >= 0.5 .AND. &
+! ZTH_LIQ(IIB:IIE,IJB:IJE) >= 0.01 .AND. &
+! ZTH_ICE(IIB:IIE,IJB:IJE) >= 0.1
+LBU_MASK(IIB:IIE,IJB:IJE,2) = .NOT.(LBU_MASK(IIB:IIE,IJB:IJE,1)) .AND. &
+ ((XINPRR(IIB:IIE,IJB:IJE)*3.6E6) >= 0.5 .OR. &
+ ZTH_LIQ(IIB:IIE,IJB:IJE) >= 0.01 .AND. &
+ ZTH_ICE(IIB:IIE,IJB:IJE) >= 0.1)
+LBU_MASK(IIB:IIE,IJB:IJE,3) = .NOT.(LBU_MASK(IIB:IIE,IJB:IJE,1)) .AND. &
+ .NOT.(LBU_MASK(IIB:IIE,IJB:IJE,2)) .AND. &
+ ZTH_LIQ(IIB:IIE,IJB:IJE) < 0.01 .AND. &
+ ZTH_ICE(IIB:IIE,IJB:IJE) >= 0.01
+!
+DEALLOCATE(ZTHIC)
+DEALLOCATE(ZTHRW)
+DEALLOCATE(ZTHCW)
+DEALLOCATE(ZTHSN)
+DEALLOCATE(ZTHGR)
+DEALLOCATE(ZTH_LIQ)
+DEALLOCATE(ZTH_ICE)
+DEALLOCATE(ZDUM)
+!
+!==============================================================================
+!
+!* 3. INCREASE IN SURFACE ARRAY
+! -------------------------
+!
+WHERE (LBU_MASK(:,:,:))
+ NBUSURF(:,:,:,NBUTIME)=NBUSURF(:,:,:,NBUTIME)+1
+END WHERE
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE SET_MASK