From 3bc627de44eac940ca305c05b9bcf1369d2ba5f1 Mon Sep 17 00:00:00 2001
From: Quentin Rodier <quentin.rodier@meteo.fr>
Date: Thu, 23 Feb 2023 18:11:41 +0100
Subject: [PATCH] Quentin 23/02/2023: clean mesonh ext (integrated for MNH 5.6)
---
src/mesonh/ext/boundaries.f90 | 1281 -----
src/mesonh/ext/default_desfmn.f90 | 1491 -----
src/mesonh/ext/drag_veg.f90 | 362 --
src/mesonh/ext/ini_budget.f90 | 4886 -----------------
src/mesonh/ext/ini_nsv.f90 | 1315 -----
src/mesonh/ext/init_aerosol_concentration.f90 | 157 -
src/mesonh/ext/modeln.f90 | 2414 --------
src/mesonh/ext/radiations.f90 | 3504 ------------
src/mesonh/ext/read_exsegn.f90 | 3075 -----------
src/mesonh/ext/resolved_cloud.f90 | 1108 ----
10 files changed, 19593 deletions(-)
delete mode 100644 src/mesonh/ext/boundaries.f90
delete mode 100644 src/mesonh/ext/default_desfmn.f90
delete mode 100644 src/mesonh/ext/drag_veg.f90
delete mode 100644 src/mesonh/ext/ini_budget.f90
delete mode 100644 src/mesonh/ext/ini_nsv.f90
delete mode 100644 src/mesonh/ext/init_aerosol_concentration.f90
delete mode 100644 src/mesonh/ext/modeln.f90
delete mode 100644 src/mesonh/ext/radiations.f90
delete mode 100644 src/mesonh/ext/read_exsegn.f90
delete mode 100644 src/mesonh/ext/resolved_cloud.f90
diff --git a/src/mesonh/ext/boundaries.f90 b/src/mesonh/ext/boundaries.f90
deleted file mode 100644
index 111dbc701..000000000
--- a/src/mesonh/ext/boundaries.f90
+++ /dev/null
@@ -1,1281 +0,0 @@
-!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_BOUNDARIES
-!#####################
-!
-INTERFACE
-!
- SUBROUTINE BOUNDARIES ( &
- PTSTEP,HLBCX,HLBCY,KRR,KSV,KTCOUNT, &
- PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
- PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
- PLBXUS,PLBXVS,PLBXWS,PLBXTHS,PLBXTKES,PLBXRS,PLBXSVS, &
- PLBYUS,PLBYVS,PLBYWS,PLBYTHS,PLBYTKES,PLBYRS,PLBYSVS, &
- PRHODJ,PRHODREF, &
- PUT,PVT,PWT,PTHT,PTKET,PRT,PSVT,PSRCT )
-!
-REAL, INTENT(IN) :: PTSTEP ! time step dt
-CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
-INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop COUNTer
- ! (=1 at the segment beginning)
-!
-! Lateral Boundary fields at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUM,PLBXVM,PLBXWM ! Wind
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTHM ! Mass
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYUM,PLBYVM,PLBYWM ! Wind
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTHM ! Mass
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTKEM ! TKE
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTKEM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBXRM ,PLBXSVM ! Moisture and SV
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRM ,PLBYSVM ! in x and y-dir.
-! temporal derivative of the Lateral Boundary fields
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUS,PLBXVS,PLBXWS ! Wind
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTHS ! Mass
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYUS,PLBYVS,PLBYWS ! Wind
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTHS ! Mass
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTKES ! TKE
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTKES
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBXRS ,PLBXSVS ! Moisture and SV
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRS ,PLBYSVS ! in x and y-dir.
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Jacobian * dry density of
- ! the reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PTHT,PTKET,PSRCT
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT,PSVT
- ! Variables at t
-!
-END SUBROUTINE BOUNDARIES
-!
-END INTERFACE
-!
-
-END MODULE MODI_BOUNDARIES
-!
-!
-! ####################################################################
- SUBROUTINE BOUNDARIES ( &
- PTSTEP,HLBCX,HLBCY,KRR,KSV,KTCOUNT, &
- PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
- PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
- PLBXUS,PLBXVS,PLBXWS,PLBXTHS,PLBXTKES,PLBXRS,PLBXSVS, &
- PLBYUS,PLBYVS,PLBYWS,PLBYTHS,PLBYTKES,PLBYRS,PLBYSVS, &
- PRHODJ,PRHODREF, &
- PUT,PVT,PWT,PTHT,PTKET,PRT,PSVT,PSRCT )
-! ####################################################################
-!
-!!**** *BOUNDARIES* - routine to prepare the Lateral Boundary Conditions for
-!! all variables at a scalar localization relative to the
-!! considered boundary.
-!!
-!! PURPOSE
-!! -------
-! Fill up the left and right lateral EXTernal zones, for all prognostic
-! variables, at time t and t-dt, to avoid particular cases close to
-! the Lateral Boundaries in routines computing the evolution terms, in
-! particular in the advection routines.
-!
-!!** METHOD
-!! ------
-!! 3 different options are proposed: 'WALL' 'CYCL' 'OPEN'
-!! to define the Boundary Condition type,
-!! though the variables HLBCX and HLBCY (for the X and Y-directions
-!! respectively).
-!! For the 'OPEN' type of LBC, the treatment depends
-!! on the flow configuration: i.e. INFLOW or OUTFLOW conditions.
-!!
-!! EXTERNAL
-!! --------
-!! GET_INDICE_ll : get physical sub-domain bounds
-!! LWEAST_ll,LEAST_ll,LNORTH_ll,LSOUTH_ll : position functions
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_PARAMETERS :
-!! JPHEXT ,JPVEXT
-!!
-!! Module MODD_CONF :
-!! CCONF
-!!
-!! Module MODE_UPDATE_NSV :
-!! NSV_CHEM, NSV_CHEMBEG, NSV_CHEMEND
-!!
-!! Module MODD_CTURB :
-!! XTKEMIN
-!!
-!! REFERENCE
-!! ---------
-!! Book1 and book2 of documentation (routine BOUNDARIES)
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Lafore J. Stein * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 17/10/94
-!! Modification 02/11/94 (J.Stein) copy for t-dt at the external points
-!! + change the copy formulation
-!! Modification 18/11/94 (J.Stein) bug correction in the normal velocity
-!! prescription in the WALL cases
-!! Modification 13/02/95 (Lafore) to account for the OPEN case and
-!! for the LS fields introduction
-!! Modification 03/03/95 (Mallet) corrections in variables names in
-!! the Y-OPEN case
-!! 16/03/95 (J.Stein) remove R from the historical variables
-!! Modification 31/05/95 (Lafore) MASTER_DEV2.1 preparation after the
-!! LBC tests performed by I. Mallet
-!! Modification 15/03/96 (Richard) bug correction for OPEN CASE: (TOP Y-LBC)
-!! Rv case
-!! Modification 15/03/96 (Shure) bug correction for SV variable in
-!! open x right case
-!! Modification 24/10/96 (Masson) initialization of outer points in
-!! wall cases for spawning interpolations
-!! Modification 13/03/97 (Lafore) "surfacic" LS-fields introduction
-!! Modification 10/04/97 (Lafore) proper treatment of minima for TKE and EPS
-!! Modification 01/09/97 (Masson) minimum value for water and passive
-!! scalars set to zero at instants M,T
-!! Modification 20/10/97 (Lafore) introduction of DAVI type of lbc
-!! suppression of NEST type
-!! Modification 12/11/97 ( Stein ) use the lB fields
-!! Modification 02/06/98 (Lafore) declaration of local variables (PLBXUM
-!! and PLBXWM do'nt have the same size)
-!! Modification 24/08/98 (Jabouille) parallelize the code
-!! Modification 20/04/99 ( Stein ) use the same conditions for times t
-!! and t-dt
-!! Modification 11/04/00 (Mari) special conditions for chemical variables
-!! Modification 10/01/01 (Tulet) update for MOCAGE boundary conditions
-!! Modification 22/01/01 (Gazen) use NSV_CHEM,NSV_CHEMBEG,NSV_CHEMEND variables
-!! Modification 22/06/01(Jabouille) use XSVMIN
-!! Modification 20/11/01(Gazen & Escobar) rewrite GCHBOUNDARY for portability
-!! Modification 14/03/05 (Tulet) bug : in case of CYCL do not call ch_boundaries
-!! Modification 14/05/05 (Tulet) add aerosols / dust
-!! Modification 05/06 Suppression of DAVI type of lbc
-!! Modification 05/06 Remove EPS
-!! Modification 12/2010 (Chong) Add boundary condition for ions
-!! (fair weather profiles)
-!! Modification 07/2013 (Bosseur & Filippi) adds Forefire
-!! Modification 04/2013 (C.Lac) Remove instant M
-!! Modification 01/2015 (JL Redelsperger) Introduction of ponderation
-!! for non normal velocity and potential temp
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! Redelsperger & Pianezze : 08/2015 : add XPOND coefficient
-!! Modification 01/2016 (JP Pinty) Add LIMA that is LBC for CCN and IFN
-!! Modification 18/07/17 (Vionnet) Add blowing snow variables
-!! Modification 01/2018 (JL Redelsperger) Correction for TKE treatment
-!! Modification 03/02/2020 (B. Vié) Correction for SV with LIMA
-! P. Wautelet 04/06/2020: correct call to Set_conc_lima
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-!
-USE MODD_BLOWSNOW, ONLY : LBLOWSNOW,NBLOWSNOW_2D
-USE MODD_BLOWSNOW_n
-USE MODD_CH_AEROSOL , ONLY : LORILAM
-USE MODD_CH_MNHC_n, ONLY : LUSECHEM, LUSECHIC
-USE MODD_CONDSAMP, ONLY : LCONDSAMP
-USE MODD_CONF
-USE MODD_CTURB
-USE MODD_DUST
-USE MODD_GRID_n, ONLY : XZZ
-USE MODD_ELEC_DESCR
-USE MODD_ELEC_n
-#ifdef MNH_FOREFIRE
-USE MODD_FOREFIRE, ONLY : LFOREFIRE
-#endif
-USE MODD_LBC_n, ONLY : XPOND
-USE MODE_ll
-USE MODD_NESTING, ONLY : NDAD
-USE MODD_NSV
-USE MODD_PARAMETERS
-USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, NMOD_IFN, LBOUND
-USE MODD_PARAM_n, ONLY : CELEC,CCLOUD
-USE MODD_PASPOL, ONLY : LPASPOL
-USE MODD_PRECISION, ONLY: MNHREAL32
-USE MODD_REF_n
-USE MODD_SALT, ONLY : LSALT
-
-USE MODE_MODELN_HANDLER
-USE MODE_SET_CONC_LIMA
-
-USE MODI_CH_BOUNDARIES
-USE MODI_INIT_AEROSOL_CONCENTRATION
-USE MODI_ION_BOUNDARIES
-
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-!
-REAL, INTENT(IN) :: PTSTEP ! time step dt
-CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
-INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop COUNTer
- ! (=1 at the segment beginning)
-!
-! Lateral Boundary fields at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUM,PLBXVM,PLBXWM ! Wind
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTHM ! Mass
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYUM,PLBYVM,PLBYWM ! Wind
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTHM ! Mass
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTKEM ! TKE
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTKEM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBXRM ,PLBXSVM ! Moisture and SV
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRM ,PLBYSVM ! in x and y-dir.
-! temporal derivative of the Lateral Boundary fields
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUS,PLBXVS,PLBXWS ! Wind
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTHS ! Mass
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYUS,PLBYVS,PLBYWS ! Wind
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTHS ! Mass
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXTKES ! TKE
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYTKES
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBXRS ,PLBXSVS ! Moisture and SV
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRS ,PLBYSVS ! in x and y-dir.
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Jacobian * dry density of
- ! the reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PTHT,PTKET,PSRCT
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT,PSVT
- ! Variables at t
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: IIB ! indice I Beginning in x direction
-INTEGER :: IJB ! indice J Beginning in y direction
-INTEGER :: IKB ! indice K Beginning in z direction
-INTEGER :: IIE ! indice I End in x direction
-INTEGER :: IJE ! indice J End in y direction
-INTEGER :: IKE ! indice K End in z direction
-INTEGER :: JEXT ! Loop index for EXTernal points
-INTEGER :: JRR ! Loop index for RR variables (water)
-INTEGER :: JSV ! Loop index for Scalar Variables
-INTEGER :: IMI ! Model Index
-REAL :: ZTSTEP ! effective time step
-REAL :: ZPOND ! Coeff PONDERATION LS
-INTEGER :: ILBX,ILBY ! size of LB fields' arrays
-LOGICAL, SAVE, DIMENSION(:), ALLOCATABLE :: GCHBOUNDARY, GAERBOUNDARY,&
- GDSTBOUNDARY, GSLTBOUNDARY, GPPBOUNDARY, &
- GCSBOUNDARY, GICBOUNDARY, GLIMABOUNDARY,GSNWBOUNDARY
-LOGICAL, SAVE :: GFIRSTCALL1 = .TRUE.
-LOGICAL, SAVE :: GFIRSTCALL2 = .TRUE.
-LOGICAL, SAVE :: GFIRSTCALL3 = .TRUE.
-LOGICAL, SAVE :: GFIRSTCALL5 = .TRUE.
-LOGICAL, SAVE :: GFIRSTCALLPP = .TRUE.
-LOGICAL, SAVE :: GFIRSTCALLCS = .TRUE.
-LOGICAL, SAVE :: GFIRSTCALLIC = .TRUE.
-LOGICAL, SAVE :: GFIRSTCALLLIMA = .TRUE.
-!
-REAL, DIMENSION(SIZE(PLBXWM,1),SIZE(PLBXWM,2),SIZE(PLBXWM,3)) :: &
- ZLBXVT,ZLBXWT,ZLBXTHT
-REAL, DIMENSION(SIZE(PLBYWM,1),SIZE(PLBYWM,2),SIZE(PLBYWM,3)) :: &
- ZLBYUT,ZLBYWT,ZLBYTHT
-REAL, DIMENSION(SIZE(PLBXTKEM,1),SIZE(PLBXTKEM,2),SIZE(PLBXTKEM,3)) :: &
- ZLBXTKET
-REAL, DIMENSION(SIZE(PLBYTKEM,1),SIZE(PLBYTKEM,2),SIZE(PLBYTKEM,3)) :: &
- ZLBYTKET
-REAL, DIMENSION(SIZE(PLBXRM,1),SIZE(PLBXRM,2),SIZE(PLBXRM,3),SIZE(PLBXRM,4)) :: &
- ZLBXRT
-REAL, DIMENSION(SIZE(PLBYRM,1),SIZE(PLBYRM,2),SIZE(PLBYRM,3),SIZE(PLBYRM,4)) :: &
- ZLBYRT
-REAL, DIMENSION(SIZE(PLBXSVM,1),SIZE(PLBXSVM,2),SIZE(PLBXSVM,3),SIZE(PLBXSVM,4)) :: &
- ZLBXSVT
-REAL, DIMENSION(SIZE(PLBYSVM,1),SIZE(PLBYSVM,2),SIZE(PLBYSVM,3),SIZE(PLBYSVM,4)) :: &
- ZLBYSVT
-LOGICAL :: GCHTMP
-LOGICAL :: GPPTMP
-LOGICAL :: GCSTMP
-!
-LOGICAL, SAVE :: GFIRSTCALL4 = .TRUE.
-!
-#ifdef MNH_FOREFIRE
-LOGICAL, SAVE, DIMENSION(:), ALLOCATABLE :: GFFBOUNDARY
-LOGICAL, SAVE :: GFIRSTCALLFF = .TRUE.
-LOGICAL :: GFFTMP
-#endif
-!
-INTEGER :: JI,JJ
-!
-REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),SIZE(PSVT,4)) :: ZSVT
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),SIZE(PRT,4)) :: ZRT
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES:
-! ----------------------------------------------
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IKB = 1 + JPVEXT
-IKE = SIZE(PUT,3) - JPVEXT
-IMI = GET_CURRENT_MODEL_INDEX()
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. UPPER AND LOWER BC FILLING:
-! ---------------------------
-!
-!* 2.1 COMPUTE THE FIELD EXTRAPOLATIONS AT THE GROUND
-!
-
-!
-! at the instant t
-!
-IF(SIZE(PUT) /= 0) PUT (:,:,IKB-1) = PUT (:,:,IKB)
-IF(SIZE(PVT) /= 0) PVT (:,:,IKB-1) = PVT (:,:,IKB)
-IF(SIZE(PWT) /= 0) PWT (:,:,IKB-1) = PWT (:,:,IKB)
-IF(SIZE(PTHT) /= 0) PTHT (:,:,IKB-1) = PTHT (:,:,IKB)
-IF(SIZE(PTKET) /= 0) PTKET(:,:,IKB-1) = PTKET(:,:,IKB)
-IF(SIZE(PRT) /= 0) PRT (:,:,IKB-1,:)= PRT (:,:,IKB,:)
-IF(SIZE(PSVT)/= 0) PSVT (:,:,IKB-1,:)= PSVT (:,:,IKB,:)
-IF(SIZE(PSRCT) /= 0) PSRCT(:,:,IKB-1) = PSRCT(:,:,IKB)
-!
-!
-!* 2.2 COMPUTE THE FIELD EXTRAPOLATIONS AT THE TOP
-!
-! at the instant t
-!
-IF(SIZE(PWT) /= 0) PWT (:,:,IKE+1) = 0.
-IF(SIZE(PUT) /= 0) PUT (:,:,IKE+1) = PUT (:,:,IKE)
-IF(SIZE(PVT) /= 0) PVT (:,:,IKE+1) = PVT (:,:,IKE)
-IF(SIZE(PTHT) /= 0) PTHT (:,:,IKE+1) = PTHT (:,:,IKE)
-IF(SIZE(PTKET) /= 0) PTKET(:,:,IKE+1) = PTKET(:,:,IKE)
-IF(SIZE(PRT) /= 0) PRT (:,:,IKE+1,:) = PRT (:,:,IKE,:)
-IF(SIZE(PSVT)/= 0) PSVT (:,:,IKE+1,:) = PSVT (:,:,IKE,:)
-IF(SIZE(PSRCT) /= 0) PSRCT(:,:,IKE+1) = PSRCT(:,:,IKE)
-
-! specific for positive and negative ions mixing ratios (1/kg)
-
-IF (NSV_ELEC .NE. 0) THEN
-!
- IF (SIZE(PWT) /= 0) THEN
- WHERE ( PWT(:,:,IKE+1) .GE. 0.) ! Outflow
- PSVT (:,:,IKE+1,NSV_ELECBEG) = 2.*PSVT (:,:,IKE,NSV_ELECBEG) - &
- PSVT (:,:,IKE-1,NSV_ELECBEG)
- PSVT (:,:,IKE+1,NSV_ELECEND) = 2.*PSVT (:,:,IKE,NSV_ELECEND) - &
- PSVT (:,:,IKE-1,NSV_ELECEND)
- ELSE WHERE ! Inflow from the top
- PSVT (:,:,IKE+1,NSV_ELECBEG) = XCION_POS_FW(:,:,IKE+1)
- PSVT (:,:,IKE+1,NSV_ELECEND) = XCION_NEG_FW(:,:,IKE+1)
- END WHERE
- ENDIF
-!
-END IF
-
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. COMPUTE LB FIELDS AT TIME T
-! ---------------------------
-!
-!
-IF ( KTCOUNT == 1) THEN
- ZTSTEP = 0.
-ELSE
- ZTSTEP = PTSTEP
-END IF
-!
-!
-IF ( SIZE(PLBXTHS,1) /= 0 .AND. &
- ( HLBCX(1)=='OPEN' .OR. HLBCX(2)=='OPEN') ) THEN
- ZLBXVT(:,:,:) = PLBXVM(:,:,:) + ZTSTEP * PLBXVS(:,:,:)
- ZLBXWT(:,:,:) = PLBXWM(:,:,:) + ZTSTEP * PLBXWS(:,:,:)
- ZLBXTHT(:,:,:) = PLBXTHM(:,:,:) + ZTSTEP * PLBXTHS(:,:,:)
- IF ( SIZE(PTKET,1) /= 0 ) THEN
- ZLBXTKET(:,:,:) = PLBXTKEM(:,:,:) + ZTSTEP * PLBXTKES(:,:,:)
- END IF
- IF ( KRR > 0) THEN
- ZLBXRT(:,:,:,:) = PLBXRM(:,:,:,:) + ZTSTEP * PLBXRS(:,:,:,:)
- END IF
- IF ( KSV > 0) THEN
- ZLBXSVT(:,:,:,:) = PLBXSVM(:,:,:,:) + ZTSTEP * PLBXSVS(:,:,:,:)
- END IF
-!
-ELSE
-!
- ZLBXVT(:,:,:) = PLBXVM(:,:,:)
- ZLBXWT(:,:,:) = PLBXWM(:,:,:)
- ZLBXTHT(:,:,:) = PLBXTHM(:,:,:)
- IF ( SIZE(PTKET,1) /= 0 ) THEN
- ZLBXTKET(:,:,:) = PLBXTKEM(:,:,:)
- END IF
- IF ( KRR > 0) THEN
- ZLBXRT(:,:,:,:) = PLBXRM(:,:,:,:)
- END IF
- IF ( KSV > 0) THEN
- ZLBXSVT(:,:,:,:) = PLBXSVM(:,:,:,:)
- END IF
-!
-END IF
-!
-! ============================================================
-!
-! Reproductibility for RSTART -> truncate ZLB to real(knd=4) to have reproductible result
-!
-ZLBXVT(:,:,:) = real(ZLBXVT(:,:,:),kind=MNHREAL32)
-ZLBXWT(:,:,:) = real(ZLBXWT(:,:,:),kind=MNHREAL32)
-ZLBXTHT(:,:,:) = real(ZLBXTHT(:,:,:),kind=MNHREAL32)
-IF ( SIZE(PTKET,1) /= 0 ) THEN
- ZLBXTKET(:,:,:) = real(ZLBXTKET(:,:,:),kind=MNHREAL32)
-END IF
-IF ( KRR > 0) THEN
- ZLBXRT(:,:,:,:) = real(ZLBXRT(:,:,:,:),kind=MNHREAL32)
-END IF
-IF ( KSV > 0) THEN
- ZLBXSVT(:,:,:,:) = real(ZLBXSVT(:,:,:,:),kind=MNHREAL32)
-END IF
-! ============================================================
-!
-IF ( SIZE(PLBYTHS,1) /= 0 .AND. &
- ( HLBCY(1)=='OPEN' .OR. HLBCY(2)=='OPEN' )) THEN
- ZLBYUT(:,:,:) = PLBYUM(:,:,:) + ZTSTEP * PLBYUS(:,:,:)
- ZLBYWT(:,:,:) = PLBYWM(:,:,:) + ZTSTEP * PLBYWS(:,:,:)
- ZLBYTHT(:,:,:) = PLBYTHM(:,:,:) + ZTSTEP * PLBYTHS(:,:,:)
- IF ( SIZE(PTKET,1) /= 0 ) THEN
- ZLBYTKET(:,:,:) = PLBYTKEM(:,:,:) + ZTSTEP * PLBYTKES(:,:,:)
- END IF
- IF ( KRR > 0) THEN
- ZLBYRT(:,:,:,:) = PLBYRM(:,:,:,:) + ZTSTEP * PLBYRS(:,:,:,:)
- END IF
- IF ( KSV > 0) THEN
- ZLBYSVT(:,:,:,:) = PLBYSVM(:,:,:,:) + ZTSTEP * PLBYSVS(:,:,:,:)
- END IF
-!
-ELSE
-!
- ZLBYUT(:,:,:) = PLBYUM(:,:,:)
- ZLBYWT(:,:,:) = PLBYWM(:,:,:)
- ZLBYTHT(:,:,:) = PLBYTHM(:,:,:)
- IF ( SIZE(PTKET,1) /= 0 ) THEN
- ZLBYTKET(:,:,:) = PLBYTKEM(:,:,:)
- END IF
- IF ( KRR > 0) THEN
- ZLBYRT(:,:,:,:) = PLBYRM(:,:,:,:)
- END IF
- IF ( KSV > 0) THEN
- ZLBYSVT(:,:,:,:) = PLBYSVM(:,:,:,:)
- END IF
-!
-END IF
-!
-!
-! ============================================================
-!
-! Reproductibility for RSTART -> truncate ZLB to real(knd=4) to have reproductible result
-!
-ZLBYUT(:,:,:) = real(ZLBYUT(:,:,:),kind=MNHREAL32)
-ZLBYWT(:,:,:) = real(ZLBYWT(:,:,:),kind=MNHREAL32)
-ZLBYTHT(:,:,:) = real(ZLBYTHT(:,:,:),kind=MNHREAL32)
-IF ( SIZE(PTKET,1) /= 0 ) THEN
- ZLBYTKET(:,:,:) = real(ZLBYTKET(:,:,:),kind=MNHREAL32)
-END IF
-IF ( KRR > 0) THEN
- ZLBYRT(:,:,:,:) = real(ZLBYRT(:,:,:,:),kind=MNHREAL32)
-END IF
-IF ( KSV > 0) THEN
- ZLBYSVT(:,:,:,:) = real(ZLBYSVT(:,:,:,:),kind=MNHREAL32)
-END IF
-! ============================================================
-!
-!-------------------------------------------------------------------------------
-! PONDERATION COEFF for Non-Normal velocities and pot temperature
-!
-ZPOND = XPOND
-!
-!* 4. LBC FILLING IN THE X DIRECTION (LEFT WEST SIDE):
-! ------------------------------------------------
-IF (LWEST_ll( )) THEN
-!
-!
-SELECT CASE ( HLBCX(1) )
-!
-!* 4.1 WALL CASE:
-! =========
-!
- CASE ('WALL')
-!
- DO JEXT=1,JPHEXT
- IF(SIZE(PUT) /= 0) PUT (IIB-JEXT,:,:) = PUT (IIB ,:,:) ! never used during run
- IF(SIZE(PVT) /= 0) PVT (IIB-JEXT,:,:) = PVT (IIB-1+JEXT,:,:)
- IF(SIZE(PWT) /= 0) PWT (IIB-JEXT,:,:) = PWT (IIB-1+JEXT,:,:)
- IF(SIZE(PTHT) /= 0) PTHT(IIB-JEXT,:,:) = PTHT (IIB-1+JEXT,:,:)
- IF(SIZE(PTKET)/= 0) PTKET(IIB-JEXT,:,:) = PTKET(IIB-1+JEXT,:,:)
- IF(SIZE(PRT) /= 0) PRT (IIB-JEXT,:,:,:) = PRT (IIB-1+JEXT,:,:,:)
- IF(SIZE(PSVT) /= 0) PSVT(IIB-JEXT,:,:,:) = PSVT (IIB-1+JEXT,:,:,:)
- IF(SIZE(PSRCT) /= 0) PSRCT (IIB-JEXT,:,:) = PSRCT (IIB-1+JEXT,:,:)
- IF(LBLOWSNOW) XSNWCANO(IIB-JEXT,:,:) = XSNWCANO(IIB-1+JEXT,:,:)
-!
- END DO
-!
- IF(SIZE(PUT) /= 0) PUT(IIB ,:,:) = 0. ! set the normal velocity
-!
-!
-!* 4.2 OPEN CASE:
-! =========
-!
- CASE ('OPEN')
-!
- IF(SIZE(PUT) /= 0) THEN
- DO JI=JPHEXT,1,-1
- PUT(JI,:,:)=0.
- WHERE ( PUT(IIB,:,:) <= 0. ) ! OUTFLOW condition
- PVT (JI,:,:) = 2.*PVT (JI+1,:,:) -PVT (JI+2,:,:)
- PWT (JI,:,:) = 2.*PWT (JI+1,:,:) -PWT (JI+2,:,:)
- PTHT (JI,:,:) = 2.*PTHT (JI+1,:,:) -PTHT (JI+2,:,:)
- !
- ELSEWHERE ! INFLOW condition
- PVT (JI,:,:) = ZPOND*ZLBXVT (JI,:,:) + (1.-ZPOND)* PVT(JI+1,:,:) ! 1
- PWT (JI,:,:) = ZPOND*ZLBXWT (JI,:,:) + (1.-ZPOND)* PWT(JI+1,:,:) ! 1
- PTHT (JI,:,:) = ZPOND*ZLBXTHT (JI,:,:) + (1.-ZPOND)* PTHT(JI+1,:,:)! 1
- ENDWHERE
- ENDDO
- ENDIF
-!
-!
- IF(SIZE(PTKET) /= 0) THEN
- DO JI=JPHEXT,1,-1
- WHERE ( PUT(IIB,:,:) <= 0. ) ! OUTFLOW condition
- PTKET(JI,:,:) = MAX(XTKEMIN, 2.*PTKET(JI+1,:,:)-PTKET(JI+2,:,:))
- ELSEWHERE ! INFLOW condition
- PTKET(JI,:,:) = MAX(XTKEMIN, ZPOND*ZLBXTKET(JI,:,:) + (1.-ZPOND)*PTKET(JI+1,:,:))
- ENDWHERE
- ENDDO
- END IF
- !
-! Case with KRR moist variables
-!
-!
-!
- DO JRR =1 ,KRR
- IF(SIZE(PUT) /= 0) THEN
- DO JI=JPHEXT,1,-1
- WHERE ( PUT(IIB,:,:) <= 0. ) ! OUTFLOW condition
- PRT(JI,:,:,JRR) = MAX(0.,2.*PRT(JI+1,:,:,JRR) -PRT(JI+2,:,:,JRR))
- ELSEWHERE ! INFLOW condition
- PRT(JI,:,:,JRR) = MAX(0.,ZLBXRT(JI,:,:,JRR)) ! 1
- END WHERE
- END DO
- END IF
- !
- END DO
-!
- IF(SIZE(PSRCT) /= 0) THEN
- DO JI=JPHEXT,1,-1
- PSRCT (JI,:,:) = PSRCT (JI+1,:,:)
- END DO
- END IF
-!
-! Case with KSV scalar variables
- DO JSV=1 ,KSV
- IF(SIZE(PUT) /= 0) THEN
- DO JI=JPHEXT,1,-1
- WHERE ( PUT(IIB,:,:) <= 0. ) ! OUTFLOW condition
- PSVT(JI,:,:,JSV) = MAX(XSVMIN(JSV),2.*PSVT(JI+1,:,:,JSV) - &
- PSVT(JI+2,:,:,JSV))
- ELSEWHERE ! INFLOW condition
- PSVT(JI,:,:,JSV) = MAX(XSVMIN(JSV),ZLBXSVT(JI,:,:,JSV)) ! 1
- END WHERE
- END DO
- END IF
- !
- END DO
- !
- IF(LBLOWSNOW) THEN
- DO JSV=1 ,NBLOWSNOW_2D
- WHERE ( PUT(IIB,:,IKB) <= 0. ) ! OUTFLOW condition
- XSNWCANO(IIB-1,:,JSV) = MAX(0.,2.*XSNWCANO(IIB,:,JSV) - &
- XSNWCANO(IIB+1,:,JSV))
- ELSEWHERE ! INFLOW condition
- XSNWCANO(IIB-1,:,JSV) = 0. ! Assume no snow enter throug
- ! boundaries
- END WHERE
- END DO
- DO JSV=NSV_SNWBEG ,NSV_SNWEND
- IF(SIZE(PUT) /= 0) THEN
- WHERE ( PUT(IIB,:,:) <= 0. ) ! OUTFLOW condition
- PSVT(IIB-1,:,:,JSV) = MAX(0.,2.*PSVT(IIB,:,:,JSV) - &
- PSVT(IIB+1,:,:,JSV))
- ELSEWHERE ! INFLOW condition
- PSVT(IIB-1,:,:,JSV) = 0. ! Assume no snow enter throug
- ! boundaries
- END WHERE
- END IF
- !
- END DO
- ENDIF
-!
-!
-END SELECT
-!
-END IF
-!-------------------------------------------------------------------------------
-!
-!* 5 LBC FILLING IN THE X DIRECTION (RIGHT EAST SIDE):
-! ===============--------------------------------
-!
-IF (LEAST_ll( )) THEN
-!
-SELECT CASE ( HLBCX(2) )
-!
-!* 5.1 WALL CASE:
-! =========
-!
- CASE ('WALL')
-!
- DO JEXT=1,JPHEXT
- IF(SIZE(PUT) /= 0) PUT (IIE+JEXT,:,:) = PUT (IIE ,:,:) ! never used during run
- IF(SIZE(PVT) /= 0) PVT (IIE+JEXT,:,:) = PVT (IIE+1-JEXT,:,:)
- IF(SIZE(PWT) /= 0) PWT (IIE+JEXT,:,:) = PWT (IIE+1-JEXT,:,:)
- IF(SIZE(PTHT) /= 0) PTHT (IIE+JEXT,:,:) = PTHT (IIE+1-JEXT,:,:)
- IF(SIZE(PTKET) /= 0) PTKET(IIE+JEXT,:,:) = PTKET(IIE+1-JEXT,:,:)
- IF(SIZE(PRT) /= 0) PRT (IIE+JEXT,:,:,:) = PRT (IIE+1-JEXT,:,:,:)
- IF(SIZE(PSVT) /= 0) PSVT(IIE+JEXT,:,:,:) = PSVT (IIE+1-JEXT,:,:,:)
- IF(SIZE(PSRCT) /= 0) PSRCT (IIE+JEXT,:,:)= PSRCT (IIE+1-JEXT,:,:)
- IF(LBLOWSNOW) XSNWCANO(IIE+JEXT,:,:) = XSNWCANO(IIE+1-JEXT,:,:)
-!
- END DO
-!
- IF(SIZE(PUT) /= 0) PUT(IIE+1 ,:,:) = 0. ! set the normal velocity
-!
-!* 5.2 OPEN CASE:
-! =========
-!
- CASE ('OPEN')
-!
- ILBX = SIZE(PLBXVM,1)
- IF(SIZE(PUT) /= 0) THEN
- DO JI=1,JPHEXT
- WHERE ( PUT(IIE+1,:,:) >= 0. ) ! OUTFLOW condition
- PVT (IIE+JI,:,:) = 2.*PVT (IIE+JI-1,:,:) -PVT (IIE+JI-2,:,:)
- PWT (IIE+JI,:,:) = 2.*PWT (IIE+JI-1,:,:) -PWT (IIE+JI-2,:,:)
- PTHT (IIE+JI,:,:) = 2.*PTHT (IIE+JI-1,:,:) -PTHT (IIE+JI-2,:,:)
- !
- ELSEWHERE ! INFLOW condition
- PVT (IIE+JI,:,:) = ZPOND*ZLBXVT (ILBX-JPHEXT+JI,:,:) + (1.-ZPOND)* PVT(IIE+JI-1,:,:)
- PWT (IIE+JI,:,:) = ZPOND*ZLBXWT (ILBX-JPHEXT+JI,:,:) + (1.-ZPOND)* PWT(IIE+JI-1,:,:)
- PTHT (IIE+JI,:,:) = ZPOND*ZLBXTHT (ILBX-JPHEXT+JI,:,:) + (1.-ZPOND)* PTHT(IIE+JI-1,:,:)
- ENDWHERE
- END DO
- ENDIF
- !
- IF(SIZE(PTKET) /= 0) THEN
- ILBX = SIZE(PLBXTKEM,1)
- DO JI=1,JPHEXT
- WHERE ( PUT(IIE+1,:,:) >= 0. ) ! OUTFLOW condition
- PTKET(IIE+JI,:,:) = MAX(XTKEMIN, 2.*PTKET(IIE+JI-1,:,:)-PTKET(IIE+JI-2,:,:))
- ELSEWHERE ! INFLOW condition
- PTKET(IIE+JI,:,:) = MAX(XTKEMIN, ZPOND*ZLBXTKET(ILBX-JPHEXT+JI,:,:) + &
- (1.-ZPOND)*PTKET(IIE+JI-1,:,:))
- ENDWHERE
- END DO
- END IF
- !
-!
-! Case with KRR moist variables
-!
-!
- DO JRR =1 ,KRR
- ILBX=SIZE(PLBXRM,1)
- !
- IF(SIZE(PUT) /= 0) THEN
- DO JI=1,JPHEXT
- WHERE ( PUT(IIE+1,:,:) >= 0. ) ! OUTFLOW condition
- PRT(IIE+JI,:,:,JRR) = MAX(0.,2.*PRT(IIE+JI-1,:,:,JRR) -PRT(IIE+JI-2,:,:,JRR))
- ELSEWHERE ! INFLOW condition
- PRT(IIE+JI,:,:,JRR) = MAX(0.,ZLBXRT(ILBX-JPHEXT+JI,:,:,JRR))
- END WHERE
- END DO
- END IF
- !
- END DO
-!
- IF(SIZE(PSRCT) /= 0) THEN
- DO JI=1,JPHEXT
- PSRCT (IIE+JI,:,:) = PSRCT (IIE+JI-1,:,:)
- END DO
- END IF
-! Case with KSV scalar variables
- DO JSV=1 ,KSV
- ILBX=SIZE(PLBXSVM,1)
- IF(SIZE(PUT) /= 0) THEN
- DO JI=1,JPHEXT
- WHERE ( PUT(IIE+1,:,:) >= 0. ) ! OUTFLOW condition
- PSVT(IIE+JI,:,:,JSV) = MAX(XSVMIN(JSV),2.*PSVT(IIE+JI-1,:,:,JSV) - &
- PSVT(IIE+JI-2,:,:,JSV))
- ELSEWHERE ! INFLOW condition
- PSVT(IIE+JI,:,:,JSV) = MAX(XSVMIN(JSV),ZLBXSVT(ILBX-JPHEXT+JI,:,:,JSV))
- END WHERE
- END DO
- END IF
- !
- END DO
-!
- IF(LBLOWSNOW) THEN
- DO JSV=1 ,3
- WHERE ( PUT(IIE+1,:,IKB) >= 0. ) ! OUTFLOW condition
- XSNWCANO(IIE+1,:,JSV) = MAX(0.,2.*XSNWCANO(IIE,:,JSV) - &
- XSNWCANO(IIE-1,:,JSV))
- ELSEWHERE ! INFLOW condition
- XSNWCANO(IIE+1,:,JSV) = 0. ! Assume no snow enter throug
- ! boundaries
- END WHERE
- END DO
- DO JSV=NSV_SNWBEG ,NSV_SNWEND
- IF(SIZE(PUT) /= 0) THEN
- WHERE ( PUT(IIE+1,:,:) >= 0. ) ! OUTFLOW condition
- PSVT(IIE+1,:,:,JSV) = MAX(0.,2.*PSVT(IIE,:,:,JSV) - &
- PSVT(IIE-1,:,:,JSV))
- ELSEWHERE ! INFLOW condition
- PSVT(IIE+1,:,:,JSV) = 0. ! Assume no snow enter throug
- ! boundaries
- END WHERE
- END IF
- !
- END DO
- END IF
-!
-END SELECT
-!
-END IF
-!-------------------------------------------------------------------------------
-!
-!* 6. LBC FILLING IN THE Y DIRECTION (BOTTOM SOUTH SIDE):
-! ------------------------------
-IF (LSOUTH_ll( )) THEN
-!
-SELECT CASE ( HLBCY(1) )
-!
-!* 6.1 WALL CASE:
-! =========
-!
- CASE ('WALL')
-!
- DO JEXT=1,JPHEXT
- IF(SIZE(PUT) /= 0) PUT (:,IJB-JEXT,:) = PUT (:,IJB-1+JEXT,:)
- IF(SIZE(PVT) /= 0) PVT (:,IJB-JEXT,:) = PVT (:,IJB ,:) ! never used during run
- IF(SIZE(PWT) /= 0) PWT (:,IJB-JEXT,:) = PWT (:,IJB-1+JEXT,:)
- IF(SIZE(PTHT) /= 0) PTHT (:,IJB-JEXT,:) = PTHT (:,IJB-1+JEXT,:)
- IF(SIZE(PTKET) /= 0) PTKET(:,IJB-JEXT,:) = PTKET(:,IJB-1+JEXT,:)
- IF(SIZE(PRT) /= 0) PRT (:,IJB-JEXT,:,:) = PRT (:,IJB-1+JEXT,:,:)
- IF(SIZE(PSVT) /= 0) PSVT (:,IJB-JEXT,:,:)= PSVT (:,IJB-1+JEXT,:,:)
- IF(SIZE(PSRCT) /= 0) PSRCT(:,IJB-JEXT,:) = PSRCT(:,IJB-1+JEXT,:)
- IF(LBLOWSNOW) XSNWCANO(:,IJB-JEXT,:) = XSNWCANO(:,IJB-1+JEXT,:)
-!
- END DO
-!
- IF(SIZE(PVT) /= 0) PVT(:,IJB ,:) = 0. ! set the normal velocity
-!
-!* 6.2 OPEN CASE:
-! =========
-!
- CASE ('OPEN')
-!
- IF(SIZE(PVT) /= 0) THEN
- DO JJ=JPHEXT,1,-1
- PVT(:,JJ,:)=0.
- WHERE ( PVT(:,IJB,:) <= 0. ) ! OUTFLOW condition
- PUT (:,JJ,:) = 2.*PUT (:,JJ+1,:) -PUT (:,JJ+2,:)
- PWT (:,JJ,:) = 2.*PWT (:,JJ+1,:) -PWT (:,JJ+2,:)
- PTHT (:,JJ,:) = 2.*PTHT (:,JJ+1,:) -PTHT (:,JJ+2,:)
- ELSEWHERE ! INFLOW condition
- PUT (:,JJ,:) = ZPOND*ZLBYUT (:,JJ,:) + (1.-ZPOND)* PUT(:,JJ+1,:)
- PWT (:,JJ,:) = ZPOND*ZLBYWT (:,JJ,:) + (1.-ZPOND)* PWT(:,JJ+1,:)
- PTHT (:,JJ,:) = ZPOND*ZLBYTHT (:,JJ,:) + (1.-ZPOND)* PTHT(:,JJ+1,:)
- ENDWHERE
- END DO
- ENDIF
-!
- IF(SIZE(PTKET) /= 0) THEN
- DO JJ=JPHEXT,1,-1
- WHERE ( PVT(:,IJB,:) <= 0. ) ! OUTFLOW condition
- PTKET(:,JJ,:) = MAX(XTKEMIN, 2.*PTKET(:,JJ+1,:)-PTKET(:,JJ+2,:))
- ELSEWHERE ! INFLOW condition
- PTKET(:,JJ,:) = MAX(XTKEMIN,ZPOND*ZLBYTKET(:,JJ,:) + &
- (1.-ZPOND)*PTKET(:,JJ+1,:))
- ENDWHERE
- END DO
- END IF
- !
-!
-! Case with KRR moist variables
-!
-!
- DO JRR =1 ,KRR
- IF(SIZE(PVT) /= 0) THEN
- DO JJ=JPHEXT,1,-1
- WHERE ( PVT(:,IJB,:) <= 0. ) ! OUTFLOW condition
- PRT(:,JJ,:,JRR) = MAX(0.,2.*PRT(:,JJ+1,:,JRR) -PRT(:,JJ+2,:,JRR))
- ELSEWHERE ! INFLOW condition
- PRT(:,JJ,:,JRR) = MAX(0.,ZLBYRT(:,JJ,:,JRR))
- END WHERE
- END DO
- END IF
- !
- END DO
-!
- IF(SIZE(PSRCT) /= 0) THEN
- DO JJ=JPHEXT,1,-1
- PSRCT(:,JJ,:) = PSRCT(:,JJ+1,:)
- END DO
- END IF
-!
-! Case with KSV scalar variables
-!
- DO JSV=1 ,KSV
- IF(SIZE(PVT) /= 0) THEN
- DO JJ=JPHEXT,1,-1
- WHERE ( PVT(:,IJB,:) <= 0. ) ! OUTFLOW condition
- PSVT(:,JJ,:,JSV) = MAX(XSVMIN(JSV),2.*PSVT(:,JJ+1,:,JSV) - &
- PSVT(:,JJ+2,:,JSV))
- ELSEWHERE ! INFLOW condition
- PSVT(:,JJ,:,JSV) = MAX(XSVMIN(JSV),ZLBYSVT(:,JJ,:,JSV))
- END WHERE
- END DO
- END IF
- !
- END DO
-!
- IF(LBLOWSNOW) THEN
- DO JSV=1 ,3
- WHERE ( PVT(:,IJB,IKB) <= 0. ) ! OUTFLOW condition
- XSNWCANO(:,IJB-1,JSV) = MAX(0.,2.*XSNWCANO(:,IJB,JSV) - &
- XSNWCANO(:,IJB+1,JSV))
- ELSEWHERE ! INFLOW condition
- XSNWCANO(:,IJB-1,JSV) = 0. ! Assume no snow enter throug
- ! boundaries
- END WHERE
- END DO
- DO JSV=NSV_SNWBEG ,NSV_SNWEND
- IF(SIZE(PVT) /= 0) THEN
- WHERE ( PVT(:,IJB,:) <= 0. ) ! OUTFLOW condition
- PSVT(:,IJB-1,:,JSV) = MAX(0.,2.*PSVT(:,IJB,:,JSV) - &
- PSVT(:,IJB+1,:,JSV))
- ELSEWHERE ! INFLOW condition
- PSVT(:,IJB-1,:,JSV) = 0. ! Assume no snow enter throug
- ! boundaries
- END WHERE
- END IF
- !
- END DO
- END IF
-!
-!
-END SELECT
-!
-END IF
-!-------------------------------------------------------------------------------
-!
-!* 7. LBC FILLING IN THE Y DIRECTION (TOP NORTH SIDE):
-! ===============
-!
-IF (LNORTH_ll( )) THEN
-!
-SELECT CASE ( HLBCY(2) )
-!
-!* 4.3.1 WALL CASE:
-! =========
-!
- CASE ('WALL')
-!
- DO JEXT=1,JPHEXT
- IF(SIZE(PUT) /= 0) PUT (:,IJE+JEXT,:) = PUT (:,IJE+1-JEXT,:)
- IF(SIZE(PVT) /= 0) PVT (:,IJE+JEXT,:) = PVT (:,IJE ,:) ! never used during run
- IF(SIZE(PWT) /= 0) PWT (:,IJE+JEXT,:) = PWT (:,IJE+1-JEXT,:)
- IF(SIZE(PTHT) /= 0) PTHT (:,IJE+JEXT,:) = PTHT (:,IJE+1-JEXT,:)
- IF(SIZE(PTKET) /= 0) PTKET(:,IJE+JEXT,:) = PTKET(:,IJE+1-JEXT,:)
- IF(SIZE(PRT) /= 0) PRT (:,IJE+JEXT,:,:) = PRT (:,IJE+1-JEXT,:,:)
- IF(SIZE(PSVT) /= 0) PSVT (:,IJE+JEXT,:,:)= PSVT (:,IJE+1-JEXT,:,:)
- IF(SIZE(PSRCT) /= 0) PSRCT(:,IJE+JEXT,:) = PSRCT(:,IJE+1-JEXT,:)
- IF(LBLOWSNOW) XSNWCANO(:,IJE+JEXT,:) = XSNWCANO(:,IJE+1-JEXT,:)
-!
- END DO
-!
- IF(SIZE(PVT) /= 0) PVT(:,IJE+1 ,:) = 0. ! set the normal velocity
-!
-!* 4.3.2 OPEN CASE:
-! =========
-!
- CASE ('OPEN')
-!
-!
- ILBY=SIZE(PLBYUM,2)
- IF(SIZE(PVT) /= 0) THEN
- DO JJ=1,JPHEXT
- WHERE ( PVT(:,IJE+1,:) >= 0. ) ! OUTFLOW condition
- PUT (:,IJE+JJ,:) = 2.*PUT (:,IJE+JJ-1,:) -PUT (:,IJE+JJ-2,:)
- PWT (:,IJE+JJ,:) = 2.*PWT (:,IJE+JJ-1,:) -PWT (:,IJE+JJ-2,:)
- PTHT (:,IJE+JJ,:) = 2.*PTHT (:,IJE+JJ-1,:) -PTHT (:,IJE+JJ-2,:)
- ELSEWHERE ! INFLOW condition
- PUT (:,IJE+JJ,:) = ZPOND*ZLBYUT (:,ILBY-JPHEXT+JJ,:) + (1.-ZPOND)* PUT(:,IJE+JJ-1,:)
- PWT (:,IJE+JJ,:) = ZPOND*ZLBYWT (:,ILBY-JPHEXT+JJ,:) + (1.-ZPOND)* PWT(:,IJE+JJ-1,:)
- PTHT (:,IJE+JJ,:) = ZPOND*ZLBYTHT (:,ILBY-JPHEXT+JJ,:) + (1.-ZPOND)* PTHT(:,IJE+JJ-1,:)
- ENDWHERE
- END DO
- ENDIF
-!
- IF(SIZE(PTKET) /= 0) THEN
- ILBY=SIZE(PLBYTKEM,2)
- DO JJ=1,JPHEXT
- WHERE ( PVT(:,IJE+1,:) >= 0. ) ! OUTFLOW condition
- PTKET(:,IJE+JJ,:) = MAX(XTKEMIN, 2.*PTKET(:,IJE+JJ-1,:)-PTKET(:,IJE+JJ-2,:))
- ELSEWHERE ! INFLOW condition
- PTKET(:,IJE+JJ,:) = MAX(XTKEMIN,ZPOND*ZLBYTKET(:,ILBY-JPHEXT+JJ,:) + &
- (1.-ZPOND)*PTKET(:,IJE+JJ-1,:))
- ENDWHERE
- END DO
- ENDIF
- !
-! Case with KRR moist variables
-!
-!
- DO JRR =1 ,KRR
- ILBY=SIZE(PLBYRM,2)
- !
- IF(SIZE(PVT) /= 0) THEN
- DO JJ=1,JPHEXT
- WHERE ( PVT(:,IJE+1,:) >= 0. ) ! OUTFLOW condition
- PRT(:,IJE+JJ,:,JRR) = MAX(0.,2.*PRT(:,IJE+JJ-1,:,JRR) -PRT(:,IJE+JJ-2,:,JRR))
- ELSEWHERE ! INFLOW condition
- PRT(:,IJE+JJ,:,JRR) = MAX(0.,ZLBYRT(:,ILBY-JPHEXT+JJ,:,JRR))
- END WHERE
- END DO
- END IF
- !
- END DO
-!
- IF(SIZE(PSRCT) /= 0) THEN
- DO JJ=1,JPHEXT
- PSRCT(:,IJE+JJ,:) = PSRCT(:,IJE+JJ-1,:)
- END DO
- END IF
-!
-! Case with KSV scalar variables
- DO JSV=1 ,KSV
- ILBY=SIZE(PLBYSVM,2)
- !
- IF(SIZE(PVT) /= 0) THEN
- DO JJ=1,JPHEXT
- WHERE ( PVT(:,IJE+1,:) >= 0. ) ! OUTFLOW condition
- PSVT(:,IJE+JJ,:,JSV) = MAX(XSVMIN(JSV),2.*PSVT(:,IJE+JJ-1,:,JSV) - &
- PSVT(:,IJE+JJ-2,:,JSV))
- ELSEWHERE ! INFLOW condition
- PSVT(:,IJE+JJ,:,JSV) = MAX(XSVMIN(JSV),ZLBYSVT(:,ILBY-JPHEXT+JJ,:,JSV))
- END WHERE
- END DO
- END IF
- !
- END DO
-!
- IF(LBLOWSNOW) THEN
- DO JSV=1 ,3
- WHERE ( PVT(:,IJE+1,IKB) >= 0. ) ! OUTFLOW condition
- XSNWCANO(:,IJE+1,JSV) = MAX(0.,2.*XSNWCANO(:,IJE,JSV) - &
- XSNWCANO(:,IJE-1,JSV))
- ELSEWHERE ! INFLOW condition
- XSNWCANO(:,IJE+1,JSV) = 0. ! Assume no snow enter throug
- ! boundaries
- END WHERE
- END DO
- DO JSV=NSV_SNWBEG ,NSV_SNWEND
- !
- IF(SIZE(PVT) /= 0) THEN
- WHERE ( PVT(:,IJE+1,:) >= 0. ) ! OUTFLOW condition
- PSVT(:,IJE+1,:,JSV) = MAX(0.,2.*PSVT(:,IJE,:,JSV) - &
- PSVT(:,IJE-1,:,JSV))
- ELSEWHERE ! INFLOW condition
- PSVT(:,IJE+1,:,JSV) = 0. ! Assume no snow enter throug
- ! boundaries
- END WHERE
- END IF
- !
- END DO
- ENDIF
-!
-END SELECT
-END IF
-!
-!
-IF (CCLOUD == 'LIMA' .AND. IMI == 1 .AND. CPROGRAM=='MESONH') THEN
-
- ZSVT=PSVT
- ZRT=PRT
-
- IF (GFIRSTCALLLIMA) THEN
- ALLOCATE(GLIMABOUNDARY(NSV_LIMA))
- GFIRSTCALLLIMA = .FALSE.
- DO JSV=NSV_LIMA_BEG,NSV_LIMA_END
- GCHTMP = .FALSE.
- IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
- IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
- IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
- IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
- GLIMABOUNDARY(JSV-NSV_LIMA_BEG+1) = GCHTMP
- ENDDO
- ENDIF
- CALL INIT_AEROSOL_CONCENTRATION(PRHODREF,ZSVT,XZZ)
- DO JSV=NSV_LIMA_CCN_FREE,NSV_LIMA_CCN_FREE+NMOD_CCN-1 ! LBC for CCN
- IF (GLIMABOUNDARY(JSV-NSV_LIMA_BEG+1)) THEN
- PSVT(IIB-1,:,:,JSV)=ZSVT(IIB-1,:,:,JSV)
- PSVT(IIE+1,:,:,JSV)=ZSVT(IIE+1,:,:,JSV)
- PSVT(:,IJB-1,:,JSV)=ZSVT(:,IJB-1,:,JSV)
- PSVT(:,IJE+1,:,JSV)=ZSVT(:,IJE+1,:,JSV)
- ENDIF
- END DO
- DO JSV=NSV_LIMA_IFN_FREE,NSV_LIMA_IFN_FREE+NMOD_IFN-1 ! LBC for IFN
- IF (GLIMABOUNDARY(JSV-NSV_LIMA_BEG+1)) THEN
- PSVT(IIB-1,:,:,JSV)=ZSVT(IIB-1,:,:,JSV)
- PSVT(IIE+1,:,:,JSV)=ZSVT(IIE+1,:,:,JSV)
- PSVT(:,IJB-1,:,JSV)=ZSVT(:,IJB-1,:,JSV)
- PSVT(:,IJE+1,:,JSV)=ZSVT(:,IJE+1,:,JSV)
- ENDIF
- END DO
-
- CALL SET_CONC_LIMA( IMI, 'NONE', PRHODREF, ZRT(:, :, :, :), ZSVT(:, :, :, NSV_LIMA_BEG:NSV_LIMA_END) )
- IF (NSV_LIMA_NC.GE.1) THEN
- IF (GLIMABOUNDARY(NSV_LIMA_NC-NSV_LIMA_BEG+1)) THEN
- PSVT(IIB-1,:,:,NSV_LIMA_NC)=ZSVT(IIB-1,:,:,NSV_LIMA_NC) ! cloud
- PSVT(IIE+1,:,:,NSV_LIMA_NC)=ZSVT(IIE+1,:,:,NSV_LIMA_NC)
- PSVT(:,IJB-1,:,NSV_LIMA_NC)=ZSVT(:,IJB-1,:,NSV_LIMA_NC)
- PSVT(:,IJE+1,:,NSV_LIMA_NC)=ZSVT(:,IJE+1,:,NSV_LIMA_NC)
- ENDIF
- ENDIF
- IF (NSV_LIMA_NR.GE.1) THEN
- IF (GLIMABOUNDARY(NSV_LIMA_NR-NSV_LIMA_BEG+1)) THEN
- PSVT(IIB-1,:,:,NSV_LIMA_NR)=ZSVT(IIB-1,:,:,NSV_LIMA_NR) ! rain
- PSVT(IIE+1,:,:,NSV_LIMA_NR)=ZSVT(IIE+1,:,:,NSV_LIMA_NR)
- PSVT(:,IJB-1,:,NSV_LIMA_NR)=ZSVT(:,IJB-1,:,NSV_LIMA_NR)
- PSVT(:,IJE+1,:,NSV_LIMA_NR)=ZSVT(:,IJE+1,:,NSV_LIMA_NR)
- ENDIF
- ENDIF
- IF (NSV_LIMA_NI.GE.1) THEN
- IF (GLIMABOUNDARY(NSV_LIMA_NI-NSV_LIMA_BEG+1)) THEN
- PSVT(IIB-1,:,:,NSV_LIMA_NI)=ZSVT(IIB-1,:,:,NSV_LIMA_NI) ! ice
- PSVT(IIE+1,:,:,NSV_LIMA_NI)=ZSVT(IIE+1,:,:,NSV_LIMA_NI)
- PSVT(:,IJB-1,:,NSV_LIMA_NI)=ZSVT(:,IJB-1,:,NSV_LIMA_NI)
- PSVT(:,IJE+1,:,NSV_LIMA_NI)=ZSVT(:,IJE+1,:,NSV_LIMA_NI)
- ENDIF
- END IF
-END IF
-!
-!
-IF (LUSECHEM .AND. IMI == 1) THEN
- IF (GFIRSTCALL1) THEN
- ALLOCATE(GCHBOUNDARY(NSV_CHEM))
- GFIRSTCALL1 = .FALSE.
- DO JSV=NSV_CHEMBEG,NSV_CHEMEND
- GCHTMP = .FALSE.
- IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
- IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
- IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
- IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
- GCHBOUNDARY(JSV-NSV_CHEMBEG+1) = GCHTMP
- ENDDO
- ENDIF
-
- DO JSV=NSV_CHEMBEG,NSV_CHEMEND
- IF (GCHBOUNDARY(JSV-NSV_CHEMBEG+1)) THEN
- IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
- ENDIF
- ENDIF
- ENDDO
-ENDIF
-!
-IF (LUSECHIC .AND. IMI == 1) THEN
- IF (GFIRSTCALLIC) THEN
- ALLOCATE(GICBOUNDARY(NSV_CHIC))
- GFIRSTCALLIC = .FALSE.
- DO JSV=NSV_CHICBEG,NSV_CHICEND
- GCHTMP = .FALSE.
- IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
- IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
- IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
- IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
- GICBOUNDARY(JSV-NSV_CHICBEG+1) = GCHTMP
- ENDDO
- ENDIF
-
- DO JSV=NSV_CHICBEG,NSV_CHICEND
- IF (GICBOUNDARY(JSV-NSV_CHICBEG+1)) THEN
- IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
- ENDIF
- ENDIF
- ENDDO
-ENDIF
-IF (LORILAM .AND. IMI == 1) THEN
- IF (GFIRSTCALL2) THEN
- ALLOCATE(GAERBOUNDARY(NSV_AER))
- GFIRSTCALL2 = .FALSE.
- DO JSV=NSV_AERBEG,NSV_AEREND
- GCHTMP = .FALSE.
- IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
- IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
- IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
- IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
- GAERBOUNDARY(JSV-NSV_AERBEG+1) = GCHTMP
- ENDDO
- ENDIF
-
- DO JSV=NSV_AERBEG,NSV_AEREND
- IF (GAERBOUNDARY(JSV-NSV_AERBEG+1)) THEN
- IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
- ENDIF
- ENDIF
- ENDDO
-ENDIF
-!
-IF (LDUST .AND. IMI == 1) THEN
- IF (GFIRSTCALL3) THEN
- ALLOCATE(GDSTBOUNDARY(NSV_DST))
- GFIRSTCALL3 = .FALSE.
- DO JSV=NSV_DSTBEG,NSV_DSTEND
- GCHTMP = .FALSE.
- IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
- IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
- IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
- IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
- GDSTBOUNDARY(JSV-NSV_DSTBEG+1) = GCHTMP
- ENDDO
- ENDIF
-
- DO JSV=NSV_DSTBEG,NSV_DSTEND
- IF (GDSTBOUNDARY(JSV-NSV_DSTBEG+1)) THEN
- IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
- ENDIF
- ENDIF
- ENDDO
-ENDIF
-!
-IF (LSALT .AND. IMI == 1) THEN
- IF (GFIRSTCALL5) THEN
- ALLOCATE(GSLTBOUNDARY(NSV_SLT))
- GFIRSTCALL5 = .FALSE.
- DO JSV=NSV_SLTBEG,NSV_SLTEND
- GCHTMP = .FALSE.
- IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
- IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
- IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
- IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
- GSLTBOUNDARY(JSV-NSV_SLTBEG+1) = GCHTMP
- ENDDO
- ENDIF
-
- DO JSV=NSV_SLTBEG,NSV_SLTEND
- IF (GSLTBOUNDARY(JSV-NSV_SLTBEG+1)) THEN
- IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
- ENDIF
- ENDIF
- ENDDO
-ENDIF
-!
-IF ( LPASPOL .AND. IMI == 1) THEN
- IF (GFIRSTCALLPP) THEN
- ALLOCATE(GPPBOUNDARY(NSV_PP))
- GFIRSTCALLPP = .FALSE.
- DO JSV=NSV_PPBEG,NSV_PPEND
- GPPTMP = .FALSE.
- IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GPPTMP = GPPTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
- IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GPPTMP = GPPTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
- IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GPPTMP = GPPTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
- IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GPPTMP = GPPTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
- GPPBOUNDARY(JSV-NSV_PPBEG+1) = GPPTMP
- ENDDO
- ENDIF
-
- DO JSV=NSV_PPBEG,NSV_PPEND
- IF (GPPBOUNDARY(JSV-NSV_PPBEG+1)) THEN
- IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
- ENDIF
- ENDIF
- ENDDO
-ENDIF
-!
-IF ( LCONDSAMP .AND. IMI == 1) THEN
- IF (GFIRSTCALLCS) THEN
- ALLOCATE(GCSBOUNDARY(NSV_CS))
- GFIRSTCALLCS = .FALSE.
- DO JSV=NSV_CSBEG,NSV_CSEND
- GCSTMP = .FALSE.
- IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCSTMP = GCSTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
- IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCSTMP = GCSTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
- IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCSTMP = GCSTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
- IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCSTMP = GCSTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
- GCSBOUNDARY(JSV-NSV_CSBEG+1) = GCSTMP
- ENDDO
- ENDIF
-
- DO JSV=NSV_CSBEG,NSV_CSEND
- IF (GCSBOUNDARY(JSV-NSV_CSBEG+1)) THEN
- IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
- ENDIF
- ENDIF
- ENDDO
-ENDIF
-
-IF (LBLOWSNOW .AND. IMI == 1) THEN
- IF (GFIRSTCALL3) THEN
- ALLOCATE(GSNWBOUNDARY(NSV_SNW))
- GFIRSTCALL3 = .FALSE.
- DO JSV=NSV_SNWBEG,NSV_SNWEND
- GCHTMP = .FALSE.
- IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(1,:,:,JSV)==0)
- IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBXSVM(ILBX,:,:,JSV)==0)
- IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,1,:,JSV)==0)
- IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY,:,JSV)==0)
- GSNWBOUNDARY(JSV-NSV_SNWBEG+1) = GCHTMP
- ENDDO
- ENDIF
-ENDIF
-
-#ifdef MNH_FOREFIRE
-!ForeFire
-IF ( LFOREFIRE .AND. IMI == 1) THEN
- IF (GFIRSTCALLFF) THEN
- ALLOCATE(GFFBOUNDARY(NSV_FF))
- GFIRSTCALLFF = .FALSE.
- DO JSV=NSV_FFBEG,NSV_FFEND
- GFFTMP = .FALSE.
- IF (LWEST_ll().AND.HLBCX(1)=='OPEN') GFFTMP = GFFTMP .OR. ALL(PLBXSVM(JPHEXT,:,:,JSV)==0)
- IF (LEAST_ll().AND.HLBCX(2)=='OPEN') GFFTMP = GFFTMP .OR. ALL(PLBXSVM(ILBX-JPHEXT+1,:,:,JSV)==0)
- IF (LSOUTH_ll().AND.HLBCY(1)=='OPEN') GFFTMP = GFFTMP .OR. ALL(PLBYSVM(:,JPHEXT,:,JSV)==0)
- IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GFFTMP = GFFTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
- GFFBOUNDARY(JSV-NSV_FFBEG+1) = GFFTMP
- ENDDO
- ENDIF
-
- DO JSV=NSV_FFBEG,NSV_FFEND
- IF (GFFBOUNDARY(JSV-NSV_FFBEG+1)) THEN
- IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
- ENDIF
- ENDIF
- ENDDO
-ENDIF
-#endif
-!
-IF ( CELEC /= 'NONE' .AND. (NSV_ELEC_A(NDAD(IMI)) == 0 .OR. IMI == 1)) THEN
- CALL ION_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT)
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE BOUNDARIES
diff --git a/src/mesonh/ext/default_desfmn.f90 b/src/mesonh/ext/default_desfmn.f90
deleted file mode 100644
index 6957954a7..000000000
--- a/src/mesonh/ext/default_desfmn.f90
+++ /dev/null
@@ -1,1491 +0,0 @@
-!MNH_LIC Copyright 1994-2023 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
-! A. Costes 12/2021: Blaze fire model
-! C. Barthe 03/2022: add CIBU and RDSF options in LIMA
-! Delbeke/Vie 03/2022: KHKO option in LIMA
-! P. Wautelet 27/04/2022: add namelist for profilers
-!-------------------------------------------------------------------------------
-!
-!* 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_ALLPROFILER_n
-USE MODD_ALLSTATION_n
-!
-!
-USE MODD_PARAM_LIMA, ONLY : LNUCL, LSEDI, LHHONI, LMEYERS, &
- NMOM_I, NMOM_S, NMOM_G, NMOM_H, &
- NMOD_IFN, XIFN_CONC, LIFN_HOM, CIFN_SPECIES, &
- CINT_MIXING, NMOD_IMM, NIND_SPECIE, LMURAKAMI, &
- YSNOW_T=>LSNOW_T, CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA, &
- XFACTNUC_DEP, XFACTNUC_CON, &
- LACTI, OSEDC=>LSEDC, &
- OACTIT=>LACTIT, LBOUND, LSPRO, LADJ, LKHKO, NMOM_C, NMOM_R, &
- NMOD_CCN, XCCN_CONC, LKESSLERAC, &
- 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
-USE MODD_FIRE_n
-!
-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.
-LHORELAX_SVFIRE = .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'
-LLEONARD =.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_ALLPROFILER_n :
-! ----------------------------------
-!
-NNUMB_PROF = 0
-XSTEP_PROF = 60.0
-XX_PROF(:) = XUNDEF
-XY_PROF(:) = XUNDEF
-XZ_PROF(:) = XUNDEF
-XLAT_PROF(:) = XUNDEF
-XLON_PROF(:) = XUNDEF
-CNAME_PROF(:) = ''
-CFILE_PROF = 'NO_INPUT_CSV'
-! LDIAG_SURFRAD = .TRUE.
-!------------------------------------------------------------------------------
-!* 10.f 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(:) = ''
-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
- LSNOW_T=.FALSE.
- LPACK_INTERP=.TRUE.
- LPACK_MICRO=.TRUE. ! Meso-NH does not work with LPACK_MICRO=.FALSE.
-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 :
-! ----------------------------------------
-!
-IF (KMI == 1) THEN
- LPTSPLIT = .TRUE.
- L_LFEEDBACKT = .TRUE.
- L_NMAXITER = 1
- L_XMRSTEP = 0.
- L_XTSTEP_TS = 0.
-!
- YNUC = 1.0
- YALPHAC = 3.0
- YNUR = 2.0
- YALPHAR = 1.0
-!
- LACTI = .TRUE.
- OSEDC = .TRUE.
- OACTIT = .FALSE.
- LADJ = .TRUE.
- LSPRO = .FALSE.
- LKHKO = .FALSE.
- ODEPOC = .TRUE.
- LBOUND = .FALSE.
- OACTTKE = .TRUE.
- LKESSLERAC = .FALSE.
-!
- NMOM_C = 2
- NMOM_R = 2
-!
- 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.
-!
- LHHONI = .FALSE.
- LNUCL = .TRUE.
- LSEDI = .TRUE.
- YSNOW_T = .FALSE.
- LMURAKAMI = .TRUE.
- CPRISTINE_ICE_LIMA = 'PLAT'
- CHEVRIMED_ICE_LIMA = 'GRAU'
- XFACTNUC_DEP = 1.0
- XFACTNUC_CON = 1.0
- NMOM_I = 2
- NMOM_S = 1
- NMOM_G = 1
- NMOM_H = 1
- 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.
- LCOV_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.
- NTMOY = 0
- NTMOYCOUNT = 0
- NNUMBELT = 28
- XRCOEFF = 0.2
- XTBVTOP = 500.
- XTBVBOT = 300.
-!
-!-------------------------------------------------------------------------------
-!
-!* 33. SET DEFAULT VALUES FOR MODD_FIRE_n
-! ----------------------------------
-!
-! Blaze fire model namelist
-!
-LBLAZE = .FALSE. ! Flag for Fire model use, default FALSE
-!
-CPROPAG_MODEL = 'SANTONI2011' ! Fire propagation model (default SANTONI2011)
-!
-CHEAT_FLUX_MODEL = 'EXS' ! Sensible heat flux injection model (default EXS)
-CLATENT_FLUX_MODEL = 'EXP' ! latent heat flux injection model (default EXP)
-XFERR = 0.8 ! Energy released in flamming stage (only for EXP)
-!
-CFIRE_CPL_MODE = '2WAYCPL' ! Coupling mode (default 2way coupled)
-CBMAPFILE = CINIFILE ! File name of BMAP for FIR2ATM mode
-LINTERPWIND = .TRUE. ! Horizontal interpolation of wind
-LSGBAWEIGHT = .FALSE. ! Flag for use of weighted average method for SubGrid Burning Area computation
-!
-NFIRE_WENO_ORDER = 3 ! Weno order (1,3,5)
-NFIRE_RK_ORDER = 3 ! Runge Kutta order (1,2,3,4)
-!
-NREFINX = 1 ! Refinement ratio X
-NREFINY = 1 ! Refinement ratio Y
-!
-XCFLMAXFIRE = 0.8 ! Max CFL on fire mesh
-XLSDIFFUSION = 0.1 ! Numerical diffusion of LevelSet
-XROSDIFFUSION = 0.05 ! Numerical diffusion of ROS
-!
-XFLUXZEXT = 3. ! Flux distribution on vertical caracteristic length
-XFLUXZMAX = 4. * XFLUXZEXT ! Flux distribution on vertical max injetion height
-!
-XFLXCOEFTMP = 1. ! Flux multiplicator. For testing
-!
-LWINDFILTER = .FALSE. ! Fire wind filtering flag
-CWINDFILTER = 'EWAM' ! Wind filter method (EWAM or WLIM)
-XEWAMTAU = 20. ! Time averaging constant for EWAM method (s)
-XWLIMUTH = 8. ! Thresehold wind value for WLIM method (m/s)
-XWLIMUTMAX = 9. ! Maximum wind value for WLIM method (m/s) (needs to be >= XWLIMUTH )
-!
-NNBSMOKETRACER = 1 ! Nb of smoke tracers
-!
-NWINDSLOPECPLMODE = 0 ! Flag for use of wind/slope in ROS (0 = wind + slope, 1 = wind only, 2 = slope only (U0=0))
-!
-!
-!
-!! DO NOT CHANGE BELOW PARAMETERS
-XFIREMESHSIZE(:) = 0. ! Fire mesh size (dxf,dyf)
-LRESTA_ASE = .FALSE. ! Flag for using ASE in RESTA file
-LRESTA_AWC = .FALSE. ! Flag for using AWC in RESTA file
-LRESTA_EWAM = .FALSE. ! Flag for using EWAM in RESTA file
-LRESTA_WLIM = .FALSE. ! Flag for using WLIM in RESTA file
-
-!-------------------------------------------------------------------------------
-END SUBROUTINE DEFAULT_DESFM_n
diff --git a/src/mesonh/ext/drag_veg.f90 b/src/mesonh/ext/drag_veg.f90
deleted file mode 100644
index de7fba893..000000000
--- a/src/mesonh/ext/drag_veg.f90
+++ /dev/null
@@ -1,362 +0,0 @@
-!MNH_LIC Copyright 2009-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_DRAG_VEG
-! #######################
-!
-INTERFACE
-
-SUBROUTINE DRAG_VEG(PTSTEP,PUT,PVT,PTKET,ODEPOTREE, PVDEPOTREE, &
- HCLOUD,PPABST,PTHT,PRT,PSVT, &
- PRHODJ,PZZ,PRUS, PRVS, PRTKES, &
- PRRS,PSVS)
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT ! variables
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKET ! at t
-LOGICAL, INTENT(IN) :: ODEPOTREE ! Droplet deposition on tree
-REAL, INTENT(IN) :: PVDEPOTREE! Velocity deposition on tree
-CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry Density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS ! Sources of Momentum
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTKES ! Sources of Tke
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS
-!
-END SUBROUTINE DRAG_VEG
-
-END INTERFACE
-
-END MODULE MODI_DRAG_VEG
-!
-! ###################################################################
-SUBROUTINE DRAG_VEG(PTSTEP,PUT,PVT,PTKET,ODEPOTREE, PVDEPOTREE, &
- HCLOUD,PPABST,PTHT,PRT,PSVT, &
- PRHODJ,PZZ,PRUS, PRVS, PRTKES, &
- PRRS,PSVS)
-! ###################################################################
-!
-!!**** *DRAG_VEG_n * -
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! P. Aumond
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 07/2009
-!! C.Lac 07/2011 : Add budgets
-!! S. Donier 06/2015 : bug surface aerosols
-!! C.Lac 07/2016 : Add droplet deposition
-!! C.Lac 10/2017 : Correction on deposition
-! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
-! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
-! C. Lac 02/2020: correction missing condition for budget on RC and SV
-! P. Wautelet 04/02/2021: budgets: bugfixes for LDRAGTREE if LIMA + small optimisations and verifications
-! R. Schoetter 04/2022: bug add update halo for vegetation drag variables
-!!---------------------------------------------------------------
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_ARGSLIST_ll, ONLY: LIST_ll
-use modd_budget, only: lbudget_u, lbudget_v, lbudget_rc, lbudget_sv, lbudget_tke, &
- NBUDGET_U, NBUDGET_V, NBUDGET_RC, NBUDGET_SV1, NBUDGET_TKE, &
- tbudgets
-USE MODD_CONF
-USE MODD_CST
-USE MODD_DYN
-USE MODD_DYN_n
-USE MODD_GROUND_PAR
-USE MODD_NSV
-USE MODD_PARAM_C2R2
-USE MODD_PARAM_LIMA, ONLY: NMOM_C
-USE MODD_PARAM_n, only: CSURF, CTURB
-USE MODD_PGDFIELDS
-USE MODD_VEG_n
-
-use mode_budget, only: Budget_store_init, Budget_store_end
-use mode_msg
-USE MODE_ll
-
-USE MODI_MNHGET_SURF_PARAM_n
-USE MODI_SHUMAN
-
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT ! variables
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKET ! at t
-LOGICAL, INTENT(IN) :: ODEPOTREE ! Droplet deposition on tree
-REAL, INTENT(IN) :: PVDEPOTREE! Velocity deposition on tree
-CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry Density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS ! Sources of Momentum
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTKES ! Sources of Tke
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: IIU,IJU,IKU,IKV ! array size along the k direction
-INTEGER :: JI, JJ, JK ! loop index
-INTEGER :: IINFO_ll
-TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
-!
-!
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: &
- ZWORK1, ZWORK2, ZWORK3, ZUT_SCAL, ZVT_SCAL, &
- ZUS, ZVS, ZTKES, ZTKET
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: &
- ZCDRAG, ZDENSITY
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2)) :: &
- ZH,ZLAI ! LAI, Vegetation height
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZT,ZEXN,ZLV,ZCPH
-LOGICAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) &
- :: GDEP
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZWDEPR,ZWDEPS
-
-IF ( CSURF /= 'EXTE' ) CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'DRAG_VEG', 'CSURF/=EXTE not allowed' )
-
-!Condition necessary because PTKET is used (and must be allocated)
-IF ( CTURB /= 'TKEL' ) CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'DRAG_VEG', 'CTURB/=TKEL not allowed' )
-!
-if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'DRAG', prus (:, :, :) )
-if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'DRAG', prvs (:, :, :) )
-if ( lbudget_tke ) call Budget_store_init( tbudgets(NBUDGET_TKE), 'DRAG', prtkes(:, :, :) )
-
-if ( odepotree ) then
- if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPOTR', prrs(:, :, :, 2) )
- if ( lbudget_sv .and. ( hcloud=='C2R2' .or. hcloud=='KHKO' ) ) &
- call Budget_store_init( tbudgets(NBUDGET_SV1-1+(NSV_C2R2BEG+1)), 'DEPOTR', psvs(:, :, :, NSV_C2R2BEG+1) )
- if ( lbudget_sv .and. hcloud=='LIMA' ) &
- call Budget_store_init( tbudgets(NBUDGET_SV1-1+NSV_LIMA_NC), 'DEPOTR', psvs(:, :, :, NSV_LIMA_NC) )
-end if
-
-IIU = SIZE(PUT,1)
-IJU = SIZE(PUT,2)
-IKU = SIZE(PUT,3)
-!
-ZUS (:,:,:) = 0.0
-ZVS (:,:,:) = 0.0
-ZTKES (:,:,:) = 0.0
-!
-ZH (:,:) = XUNDEF
-ZLAI(:,:) = XUNDEF
-!
-ZCDRAG (:,:,:) = 0.
-ZDENSITY (:,:,:) = 0.
-!
-CALL MNHGET_SURF_PARAM_n( PH_TREE = ZH, PLAI_TREE = ZLAI )
-!
-WHERE ( ZH (:,:) > (XUNDEF-1.) ) ZH (:,:) = 0.0
-WHERE ( ZLAI (:,:) > (XUNDEF-1.) ) ZLAI (:,:) = 0.0
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. COMPUTES THE TRUE VELOCITY COMPONENTS
-! -------------------------------------
-!
-ZUT_SCAL(:,:,:) = MXF(PUT(:,:,:))
-ZVT_SCAL(:,:,:) = MYF(PVT(:,:,:))
-ZTKET(:,:,:) = PTKET(:,:,:)
-!
-! Update halo
-!
-NULLIFY(TZFIELDS_ll)
-CALL ADD3DFIELD_ll( TZFIELDS_ll, ZUT_SCAL, 'DRAG_VEG::ZUT_SCAL')
-CALL ADD3DFIELD_ll( TZFIELDS_ll, ZVT_SCAL, 'DRAG_VEG::ZVT_SCAL')
-CALL ADD3DFIELD_ll( TZFIELDS_ll, ZTKET , 'DRAG_VEG::ZTKET' )
-CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
-CALL CLEANLIST_ll(TZFIELDS_ll)
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. Computations of wind tendency due to canopy drag
-! ------------------------------------------------
-!
-!
-!
-! Ext = - Cdrag * u- * u- * Sv tree canopy drag
-! - u'w'(ground) * Sh horizontal surfaces (ground)
-!
-!* 1.1 Drag coefficient by vegetation (Patton et al 2001)
-! ------------------------------
-!
-GDEP(:,:,:) = .FALSE.
-!
-DO JJ=2,(IJU-1)
- DO JI=2,(IIU-1)
- !
- ! Set density and drag coefficient for vegetation
- !
- IF (ZH(JI,JJ) /= 0) THEN
- !
- DO JK=2,(IKU-1)
- !
- IF ( (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) .LT. ZH(JI,JJ) ) THEN
- !
- IF ((HCLOUD=='C2R2') .OR. (HCLOUD=='KHKO')) THEN
- IF ((PRRS(JI,JJ,JK,2) >0.) .AND. (PSVS(JI,JJ,JK,NSV_C2R2BEG+1) >0.)) &
- GDEP(JI,JJ,JK) = .TRUE.
- ELSE IF (HCLOUD /= 'NONE' .AND. HCLOUD /= 'REVE') THEN
- IF (PRRS(JI,JJ,JK,2) >0.) GDEP(JI,JJ,JK) = .TRUE.
- ENDIF
- !
- ZCDRAG(JI,JJ,JK) = 0.2 !0.075
- ZDENSITY(JI,JJ,JK) = MAX((4 * (ZLAI(JI,JJ) *&
- (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
- (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
- (ZH(JI,JJ)-(PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)))/&
- ZH(JI,JJ)**3)-&
- (0.30*((ZLAI(JI,JJ) *&
- (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
- (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
- (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) /&
- (ZH(JI,JJ)**3))-ZLAI(JI,JJ))))/&
- ZH(JI,JJ), 0.)
- !
- ENDIF
- !
- ENDDO
- ENDIF
- !
- ENDDO
-ENDDO
-!
-! To exclude the first vertical level already dealt in rain_ice or rain_c2r2_khko
-GDEP(:,:,2) = .FALSE.
-!
-! Update halo
-!
-NULLIFY(TZFIELDS_ll)
-CALL ADD3DFIELD_ll( TZFIELDS_ll, ZCDRAG , 'DRAG_VEG::ZCDRAG')
-CALL ADD3DFIELD_ll( TZFIELDS_ll, ZDENSITY, 'DRAG_VEG::ZDENSITY')
-CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
-CALL CLEANLIST_ll(TZFIELDS_ll)
-!
-!
-!* 1.2 Drag force by wall surfaces
-! ---------------------------
-!
-!* drag force by vertical surfaces
-!
-ZUS(:,:,:) = PUT(:,:,:)/( 1.0 + MXM ( ZCDRAG(:,:,:) * ZDENSITY(:,:,:) &
- * PTSTEP * SQRT(ZUT_SCAL(:,:,:)**2+ZVT_SCAL(:,:,:)**2) ) )
-!
-ZVS(:,:,:) = PVT(:,:,:)/( 1.0 + MYM ( ZCDRAG(:,:,:) * ZDENSITY(:,:,:) &
- * PTSTEP * SQRT(ZUT_SCAL(:,:,:)**2+ZVT_SCAL(:,:,:)**2) ) )
-!
-PRUS(:,:,:) = PRUS(:,:,:) + (ZUS(:,:,:)-PUT(:,:,:)) * MXM(PRHODJ(:,:,:)) / PTSTEP
-!
-PRVS(:,:,:) = PRVS(:,:,:) + (ZVS(:,:,:)-PVT(:,:,:)) * MYM(PRHODJ(:,:,:)) / PTSTEP
-!
-IF (ODEPOTREE) THEN
- IF ( HCLOUD == 'NONE' ) CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'DRAG_VEG', 'LDEPOTREE=T not allowed if CCLOUD=NONE' )
- IF ( HCLOUD == 'LIMA' .AND. NMOM_C.EQ.0 ) &
- CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'DRAG_VEG', 'LDEPOTREE=T not allowed if CCLOUD=LIMA and NMOM_C=0' )
-
- ZEXN(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
- ZT(:,:,:)= PTHT(:,:,:)*ZEXN(:,:,:)
- ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZT(:,:,:)-XTT)
- ZCPH(:,:,:)=XCPD +XCPV*PRT(:,:,:,1)
- ZWDEPR(:,:,:)= 0.
- ZWDEPS(:,:,:)= 0.
- WHERE (GDEP)
- ZWDEPR(:,:,:)= PVDEPOTREE * PRT(:,:,:,2) * PRHODJ(:,:,:)
- END WHERE
- IF ( HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO' ) THEN
- WHERE (GDEP)
- ZWDEPS(:,:,:)= PVDEPOTREE * PSVT(:,:,:,NSV_C2R2BEG+1) * PRHODJ(:,:,:)
- END WHERE
- ELSE IF ( HCLOUD == 'LIMA' ) THEN
- WHERE (GDEP)
- ZWDEPS(:,:,:)= PVDEPOTREE * PSVT(:,:,:,NSV_LIMA_NC) * PRHODJ(:,:,:)
- END WHERE
- END IF
- DO JJ=2,(IJU-1)
- DO JI=2,(IIU-1)
- DO JK=2,(IKU-2)
- IF (GDEP(JI,JJ,JK)) THEN
- PRRS(JI,JJ,JK,2) = PRRS(JI,JJ,JK,2) + (ZWDEPR(JI,JJ,JK+1)-ZWDEPR(JI,JJ,JK))/ &
- (PZZ(JI,JJ,JK+1)-PZZ(JI,JJ,JK))
- IF ( HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO' ) THEN
- PSVS(JI,JJ,JK,NSV_C2R2BEG+1) = PSVS(JI,JJ,JK,NSV_C2R2BEG+1) + &
- (ZWDEPS(JI,JJ,JK+1)-ZWDEPS(JI,JJ,JK))/(PZZ(JI,JJ,JK+1)-PZZ(JI,JJ,JK))
- ELSE IF ( HCLOUD == 'LIMA' ) THEN
- PSVS(JI,JJ,JK,NSV_LIMA_NC) = PSVS(JI,JJ,JK,NSV_LIMA_NC) + &
- (ZWDEPS(JI,JJ,JK+1)-ZWDEPS(JI,JJ,JK))/(PZZ(JI,JJ,JK+1)-PZZ(JI,JJ,JK))
- END IF
- END IF
- END DO
- END DO
- END DO
-!
-!
-END IF
-!
-!* 3. Computations of TKE tendency due to canopy drag
-! ------------------------------------------------
-
-!* 3.1 Creation of TKE by wake
-! -----------------------
-!
-! from Kanda and Hino (1994)
-!
-! Ext = + Cd * u+^3 * Sv/Vair vertical surfaces or trees
-! Ext = - Cd * e * u * Sv trees Destruction of TKE due to
-! small-scale motions forced by leaves from Kanda and Hino (1994)
-!
-! with Vair = Vair/Vtot * Vtot = (Vair/Vtot) * Stot * Dz
-! and Sv/Vair = (Sv/Stot) * Stot/Vair = (Sv/Stot) / (Vair/Vtot) / Dz
-!
-ZTKES(:,:,:)= ( ZTKET(:,:,:) + PTSTEP * ZCDRAG(:,:,:) * ZDENSITY(:,:,:) &
- * (SQRT( ZUT_SCAL(:,:,:)**2 + ZVT_SCAL(:,:,:)**2 ))**3 ) / &
- ( 1. + PTSTEP * ZCDRAG(:,:,:) * ZDENSITY(:,:,:) * SQRT(ZUT_SCAL(:,:,:)**2+ZVT_SCAL(:,:,:)**2))
-!
-PRTKES(:,:,:) = PRTKES(:,:,:) + (ZTKES(:,:,:)-ZTKET(:,:,:))*PRHODJ(:,:,:)/PTSTEP
-
-if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'DRAG', prus (:, :, :) )
-if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'DRAG', prvs (:, :, :) )
-if ( lbudget_tke ) call Budget_store_end( tbudgets(NBUDGET_TKE), 'DRAG', prtkes(:, :, :) )
-
-if ( odepotree ) then
- if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPOTR', prrs(:, :, :, 2) )
- if ( lbudget_sv .and. ( hcloud=='C2R2' .or. hcloud=='KHKO' ) ) &
- call Budget_store_end( tbudgets(NBUDGET_SV1-1+(NSV_C2R2BEG+1)), 'DEPOTR', psvs(:, :, :, NSV_C2R2BEG+1) )
- if ( lbudget_sv .and. hcloud=='LIMA' ) &
- call Budget_store_end( tbudgets(NBUDGET_SV1-1+NSV_LIMA_NC), 'DEPOTR', psvs(:, :, :, NSV_LIMA_NC) )
-end if
-
-END SUBROUTINE DRAG_VEG
diff --git a/src/mesonh/ext/ini_budget.f90 b/src/mesonh/ext/ini_budget.f90
deleted file mode 100644
index ebcaec1c7..000000000
--- a/src/mesonh/ext/ini_budget.f90
+++ /dev/null
@@ -1,4886 +0,0 @@
-!MNH_LIC Copyright 1995-2023 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: nsv, tsvlist
-
-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( tsvlist(jsv)%cmnhname )
- tbudgets(ibudget)%ccomment = 'Budget for scalar variable ' // Trim( tsvlist(jsv)%cmnhname )
- 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
-! M. Taufour 01/07/2022: budgets: add concentration for snow, graupel, hail
-!-------------------------------------------------------------------------------
-!
-!* 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_fire_n, only: lblaze
-use modd_nsv, only: 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_ns, nsv_lima_ng, nsv_lima_nh, &
- 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, tsvlist
-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, ldepoc_lima => ldepoc, &
- lhhoni_lima => lhhoni, lmeyers_lima => lmeyers, lnucl_lima => lnucl, &
- lptsplit, &
- lscav_lima => lscav, lsedc_lima => lsedc, lsedi_lima => lsedi, &
- lspro_lima => lspro, lcibu, lrdsf, &
- nmom_c, nmom_r, nmom_i, nmom_s, nmom_g, nmom_h, 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 = 'BLAZE'
- tzsource%clongname = 'blaze fire model contribution'
- tzsource%lavailable = lblaze
- 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. nmom_c.ge.1 .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_TH), tzsource )
-
- tzsource%cmnhname = 'REVA'
- tzsource%clongname = 'rain evaporation'
- tzsource%lavailable = ( hcloud == 'LIMA' .and. ( ( .not. lptsplit .and. nmom_r.ge.1 ) .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 = 'HIN'
- tzsource%clongname = 'heterogeneous ice nucleation'
- tzsource%lavailable = hcloud(1:3) == 'ICE' .or. (hcloud == 'LIMA' .and. nmom_i == 1)
- call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
-
- tzsource%cmnhname = 'HIND'
- tzsource%clongname = 'heterogeneous nucleation by deposition'
- tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .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. nmom_i.ge.1 .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. nmom_i.ge.1 .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 .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. ( nmom_i.ge.1 .and. lnucl_lima .and. nmom_r.ge.1 ) )
- 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. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) ) ) .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
- .or. hcloud(1:3) == 'ICE'
- call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
-
- tzsource%cmnhname = 'DEPH'
- tzsource%clongname = 'deposition on hail'
- tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. nmom_h.ge.1 ) ) &
- .or. hcloud == 'ICE4'
- call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
-
- tzsource%cmnhname = 'IMLT'
- tzsource%clongname = 'melting of ice'
- tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 ) ) ) .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 ) ) ) .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
- .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. ( nmom_s.ge.1 .and. nmom_r.ge.1 ) ) ) &
- .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
- .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
- .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
- .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
- .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. nmom_h.ge.1 .and. nmom_i.ge.1 &
- .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
- .or. ( hcloud == 'LIMA' .and. lptsplit ) &
- .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. nmom_h.ge.1 .and. nmom_i.ge.1 &
- .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
- .or. ( hcloud == 'LIMA' .and. lptsplit ) &
- .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 = 'BLAZE'
- tzsource%clongname = 'blaze fire model contribution'
- tzsource%lavailable = lblaze
- 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. nmom_c.ge.1 .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_RV), tzsource )
-
- tzsource%cmnhname = 'REVA'
- tzsource%clongname = 'rain evaporation'
- tzsource%lavailable = ( hcloud == 'LIMA' .and. ( ( .not. lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1 ) &
- .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 = 'HIN'
- tzsource%clongname = 'heterogeneous ice nucleation'
- tzsource%lavailable = hcloud(1:3) == 'ICE' .or. ( hcloud == 'LIMA' .and. nmom_i == 1 )
- call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
-
- tzsource%cmnhname = 'HIND'
- tzsource%clongname = 'heterogeneous nucleation by deposition'
- tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .and. lnucl_lima
- call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
-
- tzsource%cmnhname = 'HONH'
- tzsource%clongname = 'haze homogeneous nucleation'
- tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .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. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) ) ) .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
- .or. hcloud(1:3) == 'ICE'
- call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
-
- tzsource%cmnhname = 'DEPH'
- tzsource%clongname = 'deposition on HAIL'
- tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. nmom_h.ge.1 ) &
- .or. hcloud == 'ICE4' )
- 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. nmom_c.ge.1 .and. nmom_r.ge.1 ) &
-! .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. nmom_c.ge.1 .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. nmom_c.ge.1 .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. nmom_c.ge.1 .and. nmom_r.ge.1
- 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. nmom_c.ge.1 .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. nmom_i.ge.1 .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. ( nmom_c.ge.1 .and. nmom_r.ge.1 ) ) ) &
- .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. ( nmom_c.ge.1 .and. nmom_r.ge.1 ) ) ) &
- .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. ( nmom_c.ge.1 .and. nmom_r.ge.1 ) )
- call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
-
- tzsource%cmnhname = 'HONC'
- tzsource%clongname = 'droplet homogeneous freezing'
- tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 ) ) ) .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. (nmom_i.ge.1 .and. nmom_c.ge.1) ) ) .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
- .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. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
- .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. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
- .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. nmom_h.ge.1 .and. nmom_i.ge.1 &
- .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
- .or. ( hcloud == 'LIMA' .and. lptsplit ) &
- .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. nmom_c.ge.1 .and. nmom_r.ge.1 ) &
-! .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. nmom_c.ge.1 .and. nmom_r.ge.1 ) &
- .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. nmom_c.ge.1 .and. nmom_r.ge.1
- call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
-
- tzsource%cmnhname = 'AUTO'
- tzsource%clongname = 'autoconversion into rain'
- tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 ) ) ) &
- .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. ( nmom_c.ge.1 .and. nmom_r.ge.1 ) ) ) &
- .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. ( nmom_c.ge.1 .and. nmom_r.ge.1 ) ) ) &
- .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. ( nmom_i.ge.1 .and. lnucl_lima .and. nmom_r.ge.1 ) )
- 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. ( nmom_i.ge.1 .and. nmom_c.ge.1 &
- .and. nmom_s.ge.1 .and. nmom_r.ge.1) ) ) &
- .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. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
- .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. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
- .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. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
- .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. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
- .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. nmom_h.ge.1 .and. nmom_i.ge.1 &
- .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
- .or. ( hcloud == 'LIMA' .and. lptsplit ) &
- .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. nmom_h.ge.1 .and. nmom_i.ge.1 &
- .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
- .or. ( hcloud == 'LIMA' .and. lptsplit ) &
- .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. nmom_i.ge.1 .and. nmom_s.ge.1 ) &
-! .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. nmom_i.ge.1 .and. lsedi_lima ) &
- .or. hcloud(1:3) == 'ICE'
- call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
-
- tzsource%cmnhname = 'HIN'
- tzsource%clongname = 'heterogeneous ice nucleation'
- tzsource%lavailable = hcloud(1:3) == 'ICE' .or. ( hcloud == 'LIMA' .and. nmom_i == 1)
- call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
-
- tzsource%cmnhname = 'HIND'
- tzsource%clongname = 'heterogeneous nucleation by deposition'
- tzsource%lavailable = hcloud == 'LIMA' .and. nmom_i.ge.1 .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. nmom_i.ge.1 .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. nmom_i.ge.1 .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 .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. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) )
- 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. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) )
- call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
-
- tzsource%cmnhname = 'AGGS'
- tzsource%clongname = 'aggregation of snow'
- tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) ) ) .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 ) ) ) .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 ) ) ) .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) )
- 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. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
- .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. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
- .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
- .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) )
- 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. nmom_h.ge.1 .and. nmom_i.ge.1 &
- .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
- .or. ( hcloud == 'LIMA' .and. lptsplit ) &
- .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. nmom_i.ge.1 .and. nmom_s.ge.1 ) &
-! .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. nmom_i.ge.1 .and. nmom_s.ge.1 ) &
- .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. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) )
- call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
-
- tzsource%cmnhname = 'DEPS'
- tzsource%clongname = 'deposition on snow'
- tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) ) ) .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. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) )
- call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
-
- tzsource%cmnhname = 'AGGS'
- tzsource%clongname = 'aggregation of snow'
- tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 ) ) ) .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
- .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. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) )
- 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. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 &
- .and. nmom_s.ge.1 .and. nmom_r.ge.1) ) ) &
- .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
- .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
- .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
- .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. nmom_h.ge.1 .and. nmom_i.ge.1 &
- .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
- .or. ( hcloud == 'LIMA' .and. lptsplit ) &
- .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. nmom_i.ge.1 .and. nmom_s.ge.1 ) &
- .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. ( nmom_i.ge.1 .and. lnucl_lima .and. nmom_r.ge.1 ) )
- 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. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
- .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
- .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 &
- .and. nmom_s.ge.1 .and. nmom_r.ge.1) ) ) &
- .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. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
- .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. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
- .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. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .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. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
- .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. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
- .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. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) )
- call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
-
- tzsource%cmnhname = 'GMLT'
- tzsource%clongname = 'graupel melting'
- tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) ) ) &
- .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. nmom_h.ge.1 .and. nmom_i.ge.1 &
- .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
- .or. ( hcloud == 'LIMA' .and. lptsplit ) &
- .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. (lptsplit .or. (nmom_h.ge.1 .and. nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1) )
- 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. nmom_i.ge.1 .and. nmom_h.ge.1 ) &
- .or. hcloud == 'ICE4'
- call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
-
- tzsource%cmnhname = 'DEPH'
- tzsource%clongname = 'deposition on hail'
- tzsource%lavailable = ( hcloud == 'LIMA' .and. nmom_h.ge.1 )
- 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. nmom_h.ge.1 &
- .and. ( lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) ) ) &
- .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. nmom_h.ge.1 .and. nmom_i.ge.1 &
- .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
- .or. ( hcloud == 'LIMA' .and. lptsplit ) &
- .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. ( lptsplit .or. (nmom_h.ge.1 .and. nmom_i.ge.1 &
- .and. nmom_c.ge.1 .and. nmom_s.ge.1) )
- 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. nmom_h.ge.1 .and. nmom_i.ge.1 &
- .and. nmom_c.ge.1 .and. nmom_s.ge.1 ) &
- .or. ( hcloud == 'LIMA' .and. lptsplit ) &
- .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 ' // tsvlist(jsv)%cmnhname
- 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. nmom_c.ge.1 .and. nmom_r.ge.1
-! call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'SEDI'
- tzsource%clongname = 'sedimentation'
- tzsource%lavailable = nmom_c.ge.1 .and. lsedc_lima
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'DEPO'
- tzsource%clongname = 'surface droplet deposition'
- tzsource%lavailable = nmom_c.ge.1 .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. nmom_c.ge.1 .and. nmom_r.ge.1
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'HENU'
- tzsource%clongname = 'CCN activation'
- tzsource%lavailable = nmom_c.ge.1 .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 = nmom_i.ge.1 .and. lnucl_lima
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'SELF'
- tzsource%clongname = 'self-collection of cloud droplets'
- tzsource%lavailable = lptsplit .or. (nmom_c.ge.1 .and. nmom_r.ge.1)
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'AUTO'
- tzsource%clongname = 'autoconversion into rain'
- tzsource%lavailable = lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'ACCR'
- tzsource%clongname = 'accretion of cloud droplets'
- tzsource%lavailable = lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'REVA'
- tzsource%clongname = 'rain evaporation'
- tzsource%lavailable = lptsplit .or. ( nmom_c.ge.1 .and. nmom_r.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'HONC'
- tzsource%clongname = 'droplet homogeneous freezing'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. lnucl_lima )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'IMLT'
- tzsource%clongname = 'melting of ice'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'RIM'
- tzsource%clongname = 'riming of cloud water'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'WETG'
- tzsource%clongname = 'wet growth of graupel'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'DRYG'
- tzsource%clongname = 'dry growth of graupel'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
- 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 = lptsplit .or. nmom_h.ge.1
- 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 = nmom_c.ge.1
- 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. nmom_c.ge.1 .and. nmom_r.ge.1
-! call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'SEDI'
- tzsource%clongname = 'sedimentation'
- tzsource%lavailable = nmom_c.ge.1 .and. nmom_r.ge.1
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'R2C1'
- tzsource%clongname = 'rain to cloud change after sedimentation'
- tzsource%lavailable = lptsplit .and. nmom_c.ge.1 .and. nmom_r.ge.1
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'AUTO'
- tzsource%clongname = 'autoconversion into rain'
- tzsource%lavailable = lptsplit .or. (nmom_c.ge.1 .and. nmom_r.ge.1)
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'SCBU'
- tzsource%clongname = 'self collection - coalescence/break-up'
- tzsource%lavailable = lptsplit .or. (nmom_c.ge.1 .and. nmom_r.ge.1)
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'REVA'
- tzsource%clongname = 'rain evaporation'
- tzsource%lavailable = lptsplit .or. (nmom_c.ge.1 .and. nmom_r.ge.1)
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'BRKU'
- tzsource%clongname = 'spontaneous break-up'
- tzsource%lavailable = lptsplit .or. (nmom_c.ge.1 .and. nmom_r.ge.1)
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'HONR'
- tzsource%clongname = 'rain homogeneous freezing'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_r.ge.1 .and. lnucl_lima )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'ACC'
- tzsource%clongname = 'accretion of rain on aggregates'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .and. nmom_r.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'CFRZ'
- tzsource%clongname = 'conversion freezing of rain'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'WETG'
- tzsource%clongname = 'wet growth of graupel'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'DRYG'
- tzsource%clongname = 'dry growth of graupel'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'GMLT'
- tzsource%clongname = 'graupel melting'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
- 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 = lptsplit .or. nmom_h.ge.1
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'HMLT'
- tzsource%clongname = 'melting of hail'
- tzsource%lavailable = lptsplit .or. nmom_h.ge.1
- 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 = nmom_c.ge.1 .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 = nmom_i.ge.1 .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 = nmom_c.ge.1
- 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 = nmom_c.ge.1 .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 = nmom_i.ge.1 .and. lnucl_lima .and. .not. lmeyers_lima
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'CEDS'
- tzsource%clongname = 'adjustment to saturation'
- tzsource%lavailable = nmom_c.ge.1
- 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. nmom_i.ge.1 .and. nmom_s.ge.1
-! call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'SEDI'
- tzsource%clongname = 'sedimentation'
- tzsource%lavailable = nmom_i.ge.1 .and. lsedi_lima
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'HIND'
- tzsource%clongname = 'heterogeneous nucleation by deposition'
- tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'HINC'
- tzsource%clongname = 'heterogeneous nucleation by contact'
- tzsource%lavailable = nmom_i.ge.1 .and. lnucl_lima
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'HONH'
- tzsource%clongname = 'haze homogeneous nucleation'
- tzsource%lavailable = nmom_i.ge.1 .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 .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. ( nmom_i.ge.1 .and. nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'CNVS'
- tzsource%clongname = 'conversion of pristine ice to snow'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'AGGS'
- tzsource%clongname = 'aggregation of snow'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'IMLT'
- tzsource%clongname = 'melting of ice'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 )
- 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. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'CIBU'
- tzsource%clongname = 'ice multiplication process due to ice collisional breakup'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .and. lcibu )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'CFRZ'
- tzsource%clongname = 'conversion freezing of rain'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'RDSF'
- tzsource%clongname = 'ice multiplication process following rain contact freezing'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 .and. lrdsf )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'WETG'
- tzsource%clongname = 'wet growth of graupel'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'DRYG'
- tzsource%clongname = 'dry growth of graupel'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
- 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. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'WETH'
- tzsource%clongname = 'wet growth of hail'
- tzsource%lavailable = lptsplit .or. nmom_h.ge.1
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'CEDS'
- tzsource%clongname = 'adjustment to saturation'
- tzsource%lavailable = nmom_i.ge.1 .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_ns ) then SV_LIMA
-
- tzsource%cmnhname = 'SEDI'
- tzsource%clongname = 'sedimentation'
- tzsource%lavailable = lptsplit .or. ( nmom_s.ge.2 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'CNVI'
- tzsource%clongname = 'conversion of snow to cloud ice'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'CNVS'
- tzsource%clongname = 'conversion of pristine ice to snow'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'BRKU'
- tzsource%clongname = 'break up of snow'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'RIM'
- tzsource%clongname = 'heavy riming of cloud droplet on snow'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'ACC'
- tzsource%clongname = 'accretion of rain on snow'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'CMEL'
- tzsource%clongname = 'conversion melting of snow'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'WETG'
- tzsource%clongname = 'wet growth of graupel'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'DRYG'
- tzsource%clongname = 'dry growth of graupel'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'WETH'
- tzsource%clongname = 'wet growth of hail'
- tzsource%lavailable = lptsplit .or. nmom_h.ge.1
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'SSC'
- tzsource%clongname = 'snow self collection'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'CEDS'
- tzsource%clongname = 'adjustment to saturation'
- tzsource%lavailable = nmom_i.ge.1 .and. .not.lptsplit .and. .not.lspro_lima
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- else if ( jsv == nsv_lima_ng ) then SV_LIMA
-
- tzsource%cmnhname = 'SEDI'
- tzsource%clongname = 'sedimentation'
- tzsource%lavailable = nmom_i.ge.1 .or. ( nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'RIM'
- tzsource%clongname = 'heavy riming of cloud droplet on snow'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'ACC'
- tzsource%clongname = 'accretion of rain on snow'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'CMEL'
- tzsource%clongname = 'conversion melting of snow'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'CFRZ'
- tzsource%clongname = 'conversion freezing of raindrop'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'WETG'
- tzsource%clongname = 'wet growth of graupel'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'GMLT'
- tzsource%clongname = 'graupel melting'
- tzsource%lavailable = lptsplit .or. ( nmom_i.ge.1 .and. nmom_c.ge.1 .and. nmom_s.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'WETH'
- tzsource%clongname = 'wet growth of hail'
- tzsource%lavailable = lptsplit .or. nmom_h.ge.1
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'COHG'
- tzsource%clongname = 'conversion hail graupel'
- tzsource%lavailable = lptsplit .or. nmom_h.ge.1
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'CEDS'
- tzsource%clongname = 'adjustment to saturation'
- tzsource%lavailable = nmom_i.ge.1 .and. .not.lptsplit .and. .not.lspro_lima
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- else if ( jsv == nsv_lima_nh .and. nmom_h.ge.1) then SV_LIMA
-
- tzsource%cmnhname = 'SEDI'
- tzsource%clongname = 'sedimentation'
- tzsource%lavailable = nmom_i.ge.1 .or. ( nmom_i.ge.1 .and. nmom_s.ge.1 .and. nmom_h.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'WETG'
- tzsource%clongname = 'wet growth of graupel'
- tzsource%lavailable = lptsplit .or. nmom_h.ge.1
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'COHG'
- tzsource%clongname = 'conversion hail graupel'
- tzsource%lavailable = lptsplit .or. nmom_h.ge.1
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'HMLT'
- tzsource%clongname = 'hail melting'
- tzsource%lavailable = lptsplit .or. nmom_h.ge.1
- 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 = nmom_i.ge.1 .and. lnucl_lima .and. .not. lmeyers_lima
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'CEDS'
- tzsource%clongname = 'adjustment to saturation'
- tzsource%lavailable = nmom_i.ge.1 .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 = nmom_i.ge.1 .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 = nmom_i.ge.1 .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. ( nmom_i.ge.1 .and. nmom_c.ge.1 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'CEDS'
- tzsource%clongname = 'adjustment to saturation'
- tzsource%lavailable = nmom_i.ge.1 .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 = nmom_i.ge.1 .and. lnucl_lima .and. .not. lmeyers_lima
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'CEDS'
- tzsource%clongname = 'adjustment to saturation'
- tzsource%lavailable = nmom_i.ge.1 .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 = nmom_i.ge.1 .and. lnucl_lima .and. &
- ( ( lhhoni_lima .and. nmod_ccn >= 1 ) .or. ( .not.lptsplit .and. nmom_c.ge.1 ) )
- 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
-
-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, NLONGNAMELGTMAX, NUNITLGTMAX, NCOMMENTLGTMAX
-
- 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=NLONGNAMELGTMAX) :: ylongname
- character(len=NUNITLGTMAX) :: yunits
- character(len=NCOMMENTLGTMAX) :: 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/mesonh/ext/ini_nsv.f90 b/src/mesonh/ext/ini_nsv.f90
deleted file mode 100644
index 99bb84876..000000000
--- a/src/mesonh/ext/ini_nsv.f90
+++ /dev/null
@@ -1,1315 +0,0 @@
-!MNH_LIC Copyright 2001-2023 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_NSV
-! ###################
-INTERFACE
-!
- SUBROUTINE INI_NSV(KMI)
- INTEGER, INTENT(IN) :: KMI ! model index
- END SUBROUTINE INI_NSV
-!
-END INTERFACE
-!
-END MODULE MODI_INI_NSV
-!
-!
-! ###########################
- SUBROUTINE INI_NSV(KMI)
-! ###########################
-!
-!!**** *INI_NSV* - compute NSV_* values and indices for model KMI
-!!
-!! PURPOSE
-!! -------
-!
-!
-!
-!!** METHOD
-!! ------
-!!
-!! This routine is called from any routine which stores values in
-!! the first model module (for example READ_EXSEG).
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_NSV : contains NSV_A array variable
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! D. Gazen * LA *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/02/01
-!! Modification 29/11/02 (Pinty) add SV for C3R5 and ELEC
-!! Modification 01/2004 (Masson) add scalar names
-!! Modification 03/2006 (O.Geoffroy) add KHKO scheme
-!! Modification 04/2007 (Leriche) add SV for aqueous chemistry
-!! M. Chong 26/01/10 Add Small ions
-!! Modification 07/2010 (Leriche) add SV for ice chemistry
-!! X.Pialat & J.Escobar 11/2012 remove deprecated line NSV_A(KMI) = ISV
-!! Modification 15/02/12 (Pialat/Tulet) Add SV for ForeFire scalars
-!! 03/2013 (C.Lac) add supersaturation as
-!! the 4th C2R2 scalar variable
-!! J.escobar 04/08/2015 suit Pb with writ_lfin JSA increment , modif in ini_nsv to have good order initialization
-!! Modification 01/2016 (JP Pinty) Add LIMA and LUSECHEM condition
-!! Modification 07/2017 (V. Vionnet) Add blowing snow condition
-! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
-! P. Wautelet 10/03/2021: move scalar variable name initializations to ini_nsv
-! P. Wautelet 30/03/2021: move NINDICE_CCN_IMM and NIMM initializations from init_aerosol_properties to ini_nsv
-! B. Vie 06/2021: add prognostic supersaturation for LIMA
-! P. Wautelet 26/11/2021: initialize TSVLIST_A
-! A. Costes 12/2021: smoke tracer for fire model
-! P. Wautelet 14/01/2022: add CSV_CHEM_LIST(_A) to store the list of all chemical variables
-! + NSV_CHEM_LIST(_A) the size of the list
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_BLOWSNOW, ONLY: CSNOWNAMES, LBLOWSNOW, NBLOWSNOW3D, YPSNOW_INI
-USE MODD_CH_AEROSOL
-! USE MODD_CH_AEROSOL, ONLY: CAERONAMES, CDEAERNAMES, JPMODE, LAERINIT, LDEPOS_AER, LORILAM, &
-! LVARSIGI, LVARSIGJ, NCARB, NM6_AER, NSOA, NSP
-USE MODD_CH_M9_n, ONLY: CICNAMES, CNAMES, NEQ, NEQAQ
-USE MODD_CH_MNHC_n, ONLY: LCH_PH, LUSECHEM, LUSECHAQ, LUSECHIC, CCH_SCHEME, LCH_CONV_LINOX
-USE MODD_CONDSAMP, ONLY: LCONDSAMP, NCONDSAMP
-USE MODD_CONF, ONLY: LLG, CPROGRAM, NVERB
-USE MODD_CST, ONLY: XMNH_TINY
-USE MODD_DIAG_FLAG, ONLY: LCHEMDIAG, LCHAQDIAG
-USE MODD_DUST, ONLY: CDEDSTNAMES, CDUSTNAMES, JPDUSTORDER, LDEPOS_DST, LDSTINIT, LDSTPRES, LDUST, &
- LRGFIX_DST, LVARSIG, NMODE_DST, YPDEDST_INI, YPDUST_INI
-USE MODD_DYN_n, ONLY: LHORELAX_SV,LHORELAX_SVC2R2,LHORELAX_SVC1R3, &
- LHORELAX_SVFIRE, LHORELAX_SVLIMA, &
- LHORELAX_SVELEC,LHORELAX_SVCHEM,LHORELAX_SVLG, &
- LHORELAX_SVDST,LHORELAX_SVAER, LHORELAX_SVSLT, &
- LHORELAX_SVPP,LHORELAX_SVCS, LHORELAX_SVCHIC, &
- LHORELAX_SVSNW
-#ifdef MNH_FOREFIRE
-USE MODD_DYN_n, ONLY: LHORELAX_SVFF
-#endif
-USE MODD_ELEC_DESCR, ONLY: LLNOX_EXPLICIT
-USE MODD_ELEC_DESCR, ONLY: CELECNAMES
-USE MODD_FIELD, ONLY: TFIELDMETADATA, TYPEREAL
-USE MODD_FIRE_n
-#ifdef MNH_FOREFIRE
-USE MODD_FOREFIRE
-#endif
-USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES
-USE MODD_LG, ONLY: CLGNAMES, XLG1MIN, XLG2MIN, XLG3MIN
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_NSV
-USE MODD_PARAM_C2R2, ONLY: LSUPSAT
-USE MODD_PARAMETERS, ONLY: NCOMMENTLGTMAX, NLONGNAMELGTMAX, NUNITLGTMAX
-USE MODD_PARAM_LIMA, ONLY: NINDICE_CCN_IMM, NIMM, NMOD_CCN, LSCAV, LAERO_MASS, &
- NMOD_IFN, NMOD_IMM, LHHONI, &
- LSPRO, &
- NMOM_C, NMOM_R, NMOM_I, NMOM_S, NMOM_G, NMOM_H
-USE MODD_PARAM_LIMA_COLD, ONLY: CLIMA_COLD_NAMES
-USE MODD_PARAM_LIMA_WARM, ONLY: CAERO_MASS, CLIMA_WARM_NAMES
-USE MODD_PARAM_n, ONLY: CCLOUD, CELEC
-USE MODD_PASPOL, ONLY: LPASPOL, NRELEASE
-USE MODD_PREP_REAL, ONLY: XT_LS
-USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES
-USE MODD_SALT, ONLY: CSALTNAMES, CDESLTNAMES, JPSALTORDER, &
- LRGFIX_SLT, LSALT, LSLTINIT, LSLTPRES, LDEPOS_SLT, LVARSIG_SLT, NMODE_SLT, YPDESLT_INI, YPSALT_INI
-
-USE MODE_MSG
-
-USE MODI_CH_AER_INIT_SOA, ONLY: CH_AER_INIT_SOA
-USE MODI_CH_INIT_SCHEME_n, ONLY: CH_INIT_SCHEME_n
-USE MODI_UPDATE_NSV, ONLY: UPDATE_NSV
-!
-IMPLICIT NONE
-!
-!-------------------------------------------------------------------------------
-!
-!* 0.1 Declarations of arguments
-!
-INTEGER, INTENT(IN) :: KMI ! model index
-!
-!* 0.2 Declarations of local variables
-!
-CHARACTER(LEN=2) :: YNUM2
-CHARACTER(LEN=3) :: YNUM3
-CHARACTER(LEN=NCOMMENTLGTMAX) :: YCOMMENT
-CHARACTER(LEN=NUNITLGTMAX) :: YUNITS
-CHARACTER(LEN=NLONGNAMELGTMAX), DIMENSION(:), ALLOCATABLE :: YAEROLONGNAMES
-CHARACTER(LEN=NLONGNAMELGTMAX), DIMENSION(:), ALLOCATABLE :: YDUSTLONGNAMES
-CHARACTER(LEN=NLONGNAMELGTMAX), DIMENSION(:), ALLOCATABLE :: YSALTLONGNAMES
-INTEGER :: ILUOUT
-INTEGER :: ICHIDX ! Index for position in CSV_CHEM_LIST_A array
-INTEGER :: ISV ! total number of scalar variables
-INTEGER :: IMODEIDX
-INTEGER :: JAER
-INTEGER :: JI, JJ, JSV
-INTEGER :: JMODE, JMOM, JSV_NAME
-INTEGER :: INMOMENTS_DST, INMOMENTS_SLT !Number of moments for dust or salt
-!
-!-------------------------------------------------------------------------------
-!
-LINI_NSV(KMI) = .TRUE.
-
-ILUOUT = TLUOUT%NLU
-
-ICHIDX = 0
-NSV_CHEM_LIST_A(KMI) = 0
-!
-! Users scalar variables are first considered
-!
-NSV_USER_A(KMI) = NSV_USER
-ISV = NSV_USER
-!
-! scalar variables used in microphysical schemes C2R2,KHKO and C3R5
-!
-IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO' ) THEN
- IF ((CCLOUD == 'C2R2' .AND. LSUPSAT) .OR. (CCLOUD == 'KHKO'.AND. LSUPSAT)) THEN
- ! 4th scalar field = supersaturation
- NSV_C2R2_A(KMI) = 4
- ELSE
- NSV_C2R2_A(KMI) = 3
- END IF
- NSV_C2R2BEG_A(KMI) = ISV+1
- NSV_C2R2END_A(KMI) = ISV+NSV_C2R2_A(KMI)
- ISV = NSV_C2R2END_A(KMI)
- IF (CCLOUD == 'C3R5') THEN ! the SVs for C2R2 and C1R3 must be contiguous
- NSV_C1R3_A(KMI) = 2
- NSV_C1R3BEG_A(KMI) = ISV+1
- NSV_C1R3END_A(KMI) = ISV+NSV_C1R3_A(KMI)
- ISV = NSV_C1R3END_A(KMI)
- ELSE
- NSV_C1R3_A(KMI) = 0
- ! force First index to be superior to last index
- ! in order to create a null section
- NSV_C1R3BEG_A(KMI) = 1
- NSV_C1R3END_A(KMI) = 0
- END IF
-ELSE
- NSV_C2R2_A(KMI) = 0
- NSV_C1R3_A(KMI) = 0
-! force First index to be superior to last index
-! in order to create a null section
- NSV_C2R2BEG_A(KMI) = 1
- NSV_C2R2END_A(KMI) = 0
- NSV_C1R3BEG_A(KMI) = 1
- NSV_C1R3END_A(KMI) = 0
-END IF
-!
-! scalar variables used in the LIMA microphysical scheme
-!
-IF (CCLOUD == 'LIMA' ) THEN
- ISV = ISV+1
- NSV_LIMA_BEG_A(KMI) = ISV
- IF (NMOM_C.GE.2) THEN
-! Nc
- NSV_LIMA_NC_A(KMI) = ISV
- ISV = ISV+1
- END IF
-! Nr
- IF (NMOM_R.GE.2) THEN
- NSV_LIMA_NR_A(KMI) = ISV
- ISV = ISV+1
- END IF
-! CCN
- IF (NMOD_CCN .GT. 0) THEN
- NSV_LIMA_CCN_FREE_A(KMI) = ISV
- ISV = ISV + NMOD_CCN
- NSV_LIMA_CCN_ACTI_A(KMI) = ISV
- ISV = ISV + NMOD_CCN
- END IF
-! Scavenging
- IF (LSCAV .AND. LAERO_MASS) THEN
- NSV_LIMA_SCAVMASS_A(KMI) = ISV
- ISV = ISV+1
- END IF
-! Ni
- IF (NMOM_I.GE.2) THEN
- NSV_LIMA_NI_A(KMI) = ISV
- ISV = ISV+1
- END IF
-! Ns
- IF (NMOM_S.GE.2) THEN
- NSV_LIMA_NS_A(KMI) = ISV
- ISV = ISV+1
- END IF
-! Ng
- IF (NMOM_G.GE.2) THEN
- NSV_LIMA_NG_A(KMI) = ISV
- ISV = ISV+1
- END IF
-! Nh
- IF (NMOM_H.GE.2) THEN
- NSV_LIMA_NH_A(KMI) = ISV
- ISV = ISV+1
- END IF
-! IFN
- IF (NMOD_IFN .GT. 0) THEN
- NSV_LIMA_IFN_FREE_A(KMI) = ISV
- ISV = ISV + NMOD_IFN
- NSV_LIMA_IFN_NUCL_A(KMI) = ISV
- ISV = ISV + NMOD_IFN
- END IF
-! IMM
- IF (NMOD_IMM .GT. 0) THEN
- NSV_LIMA_IMM_NUCL_A(KMI) = ISV
- ISV = ISV + MAX(1,NMOD_IMM)
- END IF
-
- IF ( NMOD_IFN > 0 ) THEN
- 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 > 0 ) THEN
- DO JI = 0, NMOD_IMM - 1
- NIMM(NMOD_CCN - JI) = 1
- NINDICE_CCN_IMM(NMOD_IMM - JI) = NMOD_CCN - JI
- END DO
-! ELSE IF (NMOD_IMM == 0) THEN ! PNIS exists but is 0 for the call to resolved_cloud
-! NMOD_IMM = 1
-! NINDICE_CCN_IMM(1) = 0
- END IF
- END IF
-
-! Homogeneous freezing of CCN
- IF (LHHONI) THEN
- NSV_LIMA_HOM_HAZE_A(KMI) = ISV
- ISV = ISV + 1
- END IF
-! Supersaturation
- IF (LSPRO) THEN
- NSV_LIMA_SPRO_A(KMI) = ISV
- ISV = ISV + 1
- END IF
-!
-! End and total variables
-!
- ISV = ISV - 1
- NSV_LIMA_END_A(KMI) = ISV
- NSV_LIMA_A(KMI) = NSV_LIMA_END_A(KMI) - NSV_LIMA_BEG_A(KMI) + 1
-ELSE
- NSV_LIMA_A(KMI) = 0
-!
-! force First index to be superior to last index
-! in order to create a null section
-!
- NSV_LIMA_BEG_A(KMI) = 1
- NSV_LIMA_END_A(KMI) = 0
-END IF ! CCLOUD = LIMA
-!
-!
-! Add one scalar for negative ion
-! First variable: positive ion (NSV_ELECBEG_A index number)
-! Last --------: negative ion (NSV_ELECEND_A index number)
-! Correspondence for ICE3:
-! Relative index 1 2 3 4 5 6 7
-! Charge for ion+ cloud rain ice snow graupel ion-
-!
-! Correspondence for ICE4:
-! Relative index 1 2 3 4 5 6 7 8
-! Charge for ion+ cloud rain ice snow graupel hail ion-
-!
-IF (CELEC /= 'NONE') THEN
- IF (CCLOUD == 'ICE3') THEN
- NSV_ELEC_A(KMI) = 7
- NSV_ELECBEG_A(KMI)= ISV+1
- NSV_ELECEND_A(KMI)= ISV+NSV_ELEC_A(KMI)
- ISV = NSV_ELECEND_A(KMI)
- CELECNAMES(7) = CELECNAMES(8)
- ELSE IF (CCLOUD == 'ICE4') THEN
- NSV_ELEC_A(KMI) = 8
- NSV_ELECBEG_A(KMI)= ISV+1
- NSV_ELECEND_A(KMI)= ISV+NSV_ELEC_A(KMI)
- ISV = NSV_ELECEND_A(KMI)
- END IF
-ELSE
- NSV_ELEC_A(KMI) = 0
-! force First index to be superior to last index
-! in order to create a null section
- NSV_ELECBEG_A(KMI) = 1
- NSV_ELECEND_A(KMI) = 0
-END IF
-!
-! scalar variables used as lagragian variables
-!
-IF (LLG) THEN
- NSV_LG_A(KMI) = 3
- NSV_LGBEG_A(KMI) = ISV+1
- NSV_LGEND_A(KMI) = ISV+NSV_LG_A(KMI)
- ISV = NSV_LGEND_A(KMI)
-ELSE
- NSV_LG_A(KMI) = 0
-! force First index to be superior to last index
-! in order to create a null section
- NSV_LGBEG_A(KMI) = 1
- NSV_LGEND_A(KMI) = 0
-END IF
-!
-! scalar variables used as LiNOX passive tracer
-!
-! In case without chemistry
-IF (LPASPOL) THEN
- NSV_PP_A(KMI) = NRELEASE
- NSV_PPBEG_A(KMI)= ISV+1
- NSV_PPEND_A(KMI)= ISV+NSV_PP_A(KMI)
- ISV = NSV_PPEND_A(KMI)
-ELSE
- NSV_PP_A(KMI) = 0
-! force First index to be superior to last index
-! in order to create a null section
- NSV_PPBEG_A(KMI)= 1
- NSV_PPEND_A(KMI)= 0
-END IF
-!
-#ifdef MNH_FOREFIRE
-! ForeFire tracers
-IF (LFOREFIRE .AND. NFFSCALARS .GT. 0) THEN
- NSV_FF_A(KMI) = NFFSCALARS
- NSV_FFBEG_A(KMI) = ISV+1
- NSV_FFEND_A(KMI) = ISV+NSV_FF_A(KMI)
- ISV = NSV_FFEND_A(KMI)
-ELSE
- NSV_FF_A(KMI) = 0
-! force First index to be superior to last index
-! in order to create a null section
- NSV_FFBEG_A(KMI)= 1
- NSV_FFEND_A(KMI)= 0
-END IF
-#endif
-! Blaze tracers
-IF (LBLAZE .AND. NNBSMOKETRACER .GT. 0) THEN
- NSV_FIRE_A(KMI) = NNBSMOKETRACER
- NSV_FIREBEG_A(KMI) = ISV+1
- NSV_FIREEND_A(KMI) = ISV+NSV_FIRE_A(KMI)
- ISV = NSV_FIREEND_A(KMI)
-ELSE
- NSV_FIRE_A(KMI) = 0
-! force First index to be superior to last index
-! in order to create a null section
- NSV_FIREBEG_A(KMI)= 1
- NSV_FIREEND_A(KMI)= 0
-END IF
-!
-! Conditional sampling variables
-IF (LCONDSAMP) THEN
- NSV_CS_A(KMI) = NCONDSAMP
- NSV_CSBEG_A(KMI)= ISV+1
- NSV_CSEND_A(KMI)= ISV+NSV_CS_A(KMI)
- ISV = NSV_CSEND_A(KMI)
-ELSE
- NSV_CS_A(KMI) = 0
-! force First index to be superior to last index
-! in order to create a null section
- NSV_CSBEG_A(KMI)= 1
- NSV_CSEND_A(KMI)= 0
-END IF
-!
-! scalar variables used in chemical core system
-!
-IF (LUSECHEM) THEN
- CALL CH_INIT_SCHEME_n(KMI,LUSECHAQ,LUSECHIC,LCH_PH,ILUOUT,NVERB)
- IF (LORILAM) CALL CH_AER_INIT_SOA(ILUOUT, NVERB)
-END IF
-
-IF (LUSECHEM .AND.(NEQ .GT. 0)) THEN
- NSV_CHEM_A(KMI) = NEQ
- NSV_CHEMBEG_A(KMI)= ISV+1
- NSV_CHEMEND_A(KMI)= ISV+NSV_CHEM_A(KMI)
- ISV = NSV_CHEMEND_A(KMI)
- NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_CHEM_A(KMI)
-ELSE
- NSV_CHEM_A(KMI) = 0
-! force First index to be superior to last index
-! in order to create a null section
- NSV_CHEMBEG_A(KMI)= 1
- NSV_CHEMEND_A(KMI)= 0
-END IF
-!
-! aqueous chemistry (part of the "chem" variables)
-!
-IF ((LUSECHAQ .OR. LCHAQDIAG).AND.(NEQ .GT. 0)) THEN
- NSV_CHGS_A(KMI) = NEQ-NEQAQ
- NSV_CHGSBEG_A(KMI)= NSV_CHEMBEG_A(KMI)
- NSV_CHGSEND_A(KMI)= NSV_CHEMBEG_A(KMI)+(NEQ-NEQAQ)-1
- NSV_CHAC_A(KMI) = NEQAQ
- NSV_CHACBEG_A(KMI)= NSV_CHGSEND_A(KMI)+1
- NSV_CHACEND_A(KMI)= NSV_CHEMEND_A(KMI)
-! ice phase chemistry
- IF (LUSECHIC) THEN
- NSV_CHIC_A(KMI) = NEQAQ/2. -1.
- NSV_CHICBEG_A(KMI)= ISV+1
- NSV_CHICEND_A(KMI)= ISV+NSV_CHIC_A(KMI)
- ISV = NSV_CHICEND_A(KMI)
- NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_CHIC_A(KMI)
- ELSE
- NSV_CHIC_A(KMI) = 0
- NSV_CHICBEG_A(KMI)= 1
- NSV_CHICEND_A(KMI)= 0
- ENDIF
-ELSE
- IF (NEQ .GT. 0) THEN
- NSV_CHGS_A(KMI) = NEQ-NEQAQ
- NSV_CHGSBEG_A(KMI)= NSV_CHEMBEG_A(KMI)
- NSV_CHGSEND_A(KMI)= NSV_CHEMBEG_A(KMI)+(NEQ-NEQAQ)-1
- NSV_CHAC_A(KMI) = 0
- NSV_CHACBEG_A(KMI)= 1
- NSV_CHACEND_A(KMI)= 0
- NSV_CHIC_A(KMI) = 0
- NSV_CHICBEG_A(KMI)= 1
- NSV_CHICEND_A(KMI)= 0
- ELSE
- NSV_CHGS_A(KMI) = 0
- NSV_CHGSBEG_A(KMI)= 1
- NSV_CHGSEND_A(KMI)= 0
- NSV_CHAC_A(KMI) = 0
- NSV_CHACBEG_A(KMI)= 1
- NSV_CHACEND_A(KMI)= 0
- NSV_CHIC_A(KMI) = 0
- NSV_CHICBEG_A(KMI)= 1
- NSV_CHICEND_A(KMI)= 0
- ENDIF
-END IF
-! aerosol variables
-IF (LORILAM.AND.(NEQ .GT. 0)) THEN
- NM6_AER = 0
- IF (LVARSIGI) NM6_AER = 1
- IF (LVARSIGJ) NM6_AER = NM6_AER + 1
- NSV_AER_A(KMI) = (NSP+NCARB+NSOA+1)*JPMODE + NM6_AER
- NSV_AERBEG_A(KMI)= ISV+1
- NSV_AEREND_A(KMI)= ISV+NSV_AER_A(KMI)
- ISV = NSV_AEREND_A(KMI)
- NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_AER_A(KMI)
-
- ALLOCATE( YAEROLONGNAMES(NSV_AER_A(KMI)) )
-ELSE
- NSV_AER_A(KMI) = 0
-! force First index to be superior to last index
-! in order to create a null section
- NSV_AERBEG_A(KMI)= 1
- NSV_AEREND_A(KMI)= 0
-END IF
-IF (LORILAM .AND. LDEPOS_AER(KMI)) THEN
- NSV_AERDEP_A(KMI) = JPMODE*2
- NSV_AERDEPBEG_A(KMI)= ISV+1
- NSV_AERDEPEND_A(KMI)= ISV+NSV_AERDEP_A(KMI)
- ISV = NSV_AERDEPEND_A(KMI)
- NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_AERDEP_A(KMI)
-ELSE
- NSV_AERDEP_A(KMI) = 0
-! force First index to be superior to last index
-! in order to create a null section
- NSV_AERDEPBEG_A(KMI)= 1
- NSV_AERDEPEND_A(KMI)= 0
-! force First index to be superior to last index
-! in order to create a null section
-END IF
-!
-! scalar variables used in dust model
-!
-IF (LDUST) THEN
- IF (ALLOCATED(XT_LS).AND. .NOT.(LDSTPRES)) LDSTINIT=.TRUE.
- IF (CPROGRAM == 'IDEAL ') LVARSIG = .TRUE.
- IF ((CPROGRAM == 'REAL ').AND.LDSTINIT) LVARSIG = .TRUE.
- !Determine number of moments
- IF ( LRGFIX_DST ) THEN
- INMOMENTS_DST = 1
- IF ( LVARSIG ) CALL Print_msg( NVERB_WARNING, 'GEN', 'INI_NSV', 'LVARSIG forced to FALSE because LRGFIX_DST is TRUE' )
- LVARSIG = .FALSE.
- ELSE IF ( LVARSIG ) THEN
- INMOMENTS_DST = 3
- ELSE
- INMOMENTS_DST = 2
- END IF
- !Number of entries = number of moments multiplied by number of modes
- NSV_DST_A(KMI) = NMODE_DST * INMOMENTS_DST
- NSV_DSTBEG_A(KMI)= ISV+1
- NSV_DSTEND_A(KMI)= ISV+NSV_DST_A(KMI)
- ISV = NSV_DSTEND_A(KMI)
- NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_DST_A(KMI)
-ELSE
- NSV_DST_A(KMI) = 0
-! force First index to be superior to last index
-! in order to create a null section
- NSV_DSTBEG_A(KMI)= 1
- NSV_DSTEND_A(KMI)= 0
-END IF
-IF ( LDUST .AND. LDEPOS_DST(KMI) ) THEN
- NSV_DSTDEP_A(KMI) = NMODE_DST*2
- NSV_DSTDEPBEG_A(KMI)= ISV+1
- NSV_DSTDEPEND_A(KMI)= ISV+NSV_DSTDEP_A(KMI)
- ISV = NSV_DSTDEPEND_A(KMI)
- NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_DSTDEP_A(KMI)
-ELSE
- NSV_DSTDEP_A(KMI) = 0
-! force First index to be superior to last index
-! in order to create a null section
- NSV_DSTDEPBEG_A(KMI)= 1
- NSV_DSTDEPEND_A(KMI)= 0
-! force First index to be superior to last index
-! in order to create a null section
-
- END IF
-! scalar variables used in sea salt model
-!
-IF (LSALT) THEN
- IF (ALLOCATED(XT_LS).AND. .NOT.(LSLTPRES)) LSLTINIT=.TRUE.
- IF (CPROGRAM == 'IDEAL ') LVARSIG_SLT = .TRUE.
- IF ((CPROGRAM == 'REAL ').AND. LSLTINIT ) LVARSIG_SLT = .TRUE.
- !Determine number of moments
- IF ( LRGFIX_SLT ) THEN
- INMOMENTS_SLT = 1
- IF ( LVARSIG_SLT ) CALL Print_msg( NVERB_WARNING, 'GEN', 'INI_NSV', 'LVARSIG_SLT forced to FALSE because LRGFIX_SLT is TRUE' )
- LVARSIG_SLT = .FALSE.
- ELSE IF ( LVARSIG_SLT ) THEN
- INMOMENTS_SLT = 3
- ELSE
- INMOMENTS_SLT = 2
- END IF
- !Number of entries = number of moments multiplied by number of modes
- NSV_SLT_A(KMI) = NMODE_SLT * INMOMENTS_SLT
- NSV_SLTBEG_A(KMI)= ISV+1
- NSV_SLTEND_A(KMI)= ISV+NSV_SLT_A(KMI)
- ISV = NSV_SLTEND_A(KMI)
- NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_SLT_A(KMI)
-ELSE
- NSV_SLT_A(KMI) = 0
-! force First index to be superior to last index
-! in order to create a null section
- NSV_SLTBEG_A(KMI)= 1
- NSV_SLTEND_A(KMI)= 0
-END IF
-IF ( LSALT .AND. LDEPOS_SLT(KMI) ) THEN
- NSV_SLTDEP_A(KMI) = NMODE_SLT*2
- NSV_SLTDEPBEG_A(KMI)= ISV+1
- NSV_SLTDEPEND_A(KMI)= ISV+NSV_SLTDEP_A(KMI)
- ISV = NSV_SLTDEPEND_A(KMI)
- NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_SLTDEP_A(KMI)
-ELSE
- NSV_SLTDEP_A(KMI) = 0
-! force First index to be superior to last index
-! in order to create a null section
- NSV_SLTDEPBEG_A(KMI)= 1
- NSV_SLTDEPEND_A(KMI)= 0
-! force First index to be superior to last index
-! in order to create a null section
-END IF
-!
-! scalar variables used in blowing snow model
-!
-IF (LBLOWSNOW) THEN
- NSV_SNW_A(KMI) = NBLOWSNOW3D
- NSV_SNWBEG_A(KMI)= ISV+1
- NSV_SNWEND_A(KMI)= ISV+NSV_SNW_A(KMI)
- ISV = NSV_SNWEND_A(KMI)
-ELSE
- NSV_SNW_A(KMI) = 0
-! force First index to be superior to last index
-! in order to create a null section
- NSV_SNWBEG_A(KMI)= 1
- NSV_SNWEND_A(KMI)= 0
-END IF
-!
-! scalar variables used as LiNOX passive tracer
-!
-! In case without chemistry
-IF (.NOT.(LUSECHEM.OR.LCHEMDIAG) .AND. (LCH_CONV_LINOX.OR.LLNOX_EXPLICIT)) THEN
- NSV_LNOX_A(KMI) = 1
- NSV_LNOXBEG_A(KMI)= ISV+1
- NSV_LNOXEND_A(KMI)= ISV+NSV_LNOX_A(KMI)
- ISV = NSV_LNOXEND_A(KMI)
- NSV_CHEM_LIST_A(KMI) = NSV_CHEM_LIST_A(KMI) + NSV_LNOX_A(KMI)
-ELSE
- NSV_LNOX_A(KMI) = 0
-! force First index to be superior to last index
-! in order to create a null section
- NSV_LNOXBEG_A(KMI)= 1
- NSV_LNOXEND_A(KMI)= 0
-END IF
-!
-! Final number of NSV variables
-!
-NSV_A(KMI) = ISV
-!
-!
-!* Update LHORELAX_SV,CGETSVM,CGETSVT for NON USER SV
-!
-! C2R2 or KHKO SV case
-!*BUG*JPC*MAR2006
-! IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' ) &
-IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO' ) &
-!*BUG*JPC*MAR2006
-LHORELAX_SV(NSV_C2R2BEG_A(KMI):NSV_C2R2END_A(KMI))=LHORELAX_SVC2R2
-! C3R5 SV case
-IF (CCLOUD == 'C3R5') &
-LHORELAX_SV(NSV_C1R3BEG_A(KMI):NSV_C1R3END_A(KMI))=LHORELAX_SVC1R3
-! LIMA SV case
-IF (CCLOUD == 'LIMA') &
-LHORELAX_SV(NSV_LIMA_BEG_A(KMI):NSV_LIMA_END_A(KMI))=LHORELAX_SVLIMA
-! Electrical SV case
-IF (CELEC /= 'NONE') &
-LHORELAX_SV(NSV_ELECBEG_A(KMI):NSV_ELECEND_A(KMI))=LHORELAX_SVELEC
-! Chemical SV case
-IF (LUSECHEM .OR. LCHEMDIAG) &
-LHORELAX_SV(NSV_CHEMBEG_A(KMI):NSV_CHEMEND_A(KMI))=LHORELAX_SVCHEM
-! Ice phase Chemical SV case
-IF (LUSECHIC) &
-LHORELAX_SV(NSV_CHICBEG_A(KMI):NSV_CHICEND_A(KMI))=LHORELAX_SVCHIC
-! LINOX SV case
-IF (.NOT.(LUSECHEM .OR. LCHEMDIAG) .AND. LCH_CONV_LINOX) &
-LHORELAX_SV(NSV_LNOXBEG_A(KMI):NSV_LNOXEND_A(KMI))=LHORELAX_SVCHEM
-! Dust SV case
-IF (LDUST) &
-LHORELAX_SV(NSV_DSTBEG_A(KMI):NSV_DSTEND_A(KMI))=LHORELAX_SVDST
-! Sea Salt SV case
-IF (LSALT) &
-LHORELAX_SV(NSV_SLTBEG_A(KMI):NSV_SLTEND_A(KMI))=LHORELAX_SVSLT
-! Aerosols SV case
-IF (LORILAM) &
-LHORELAX_SV(NSV_AERBEG_A(KMI):NSV_AEREND_A(KMI))=LHORELAX_SVAER
-! Lagrangian variables
-IF (LLG) &
-LHORELAX_SV(NSV_LGBEG_A(KMI):NSV_LGEND_A(KMI))=LHORELAX_SVLG
-! Passive pollutants
-IF (LPASPOL) &
-LHORELAX_SV(NSV_PPBEG_A(KMI):NSV_PPEND_A(KMI))=LHORELAX_SVPP
-#ifdef MNH_FOREFIRE
-! Fire pollutants
-IF (LFOREFIRE) &
-LHORELAX_SV(NSV_FFBEG_A(KMI):NSV_FFEND_A(KMI))=LHORELAX_SVFF
-#endif
-! Blaze Fire pollutants
-IF (LBLAZE) &
-LHORELAX_SV(NSV_FIREBEG_A(KMI):NSV_FIREEND_A(KMI))=LHORELAX_SVFIRE
-! Conditional sampling
-IF (LCONDSAMP) &
-LHORELAX_SV(NSV_CSBEG_A(KMI):NSV_CSEND_A(KMI))=LHORELAX_SVCS
-! Blowing snow case
-IF (LBLOWSNOW) &
-LHORELAX_SV(NSV_SNWBEG_A(KMI):NSV_SNWEND_A(KMI))=LHORELAX_SVSNW
-! Update NSV* variables for model KMI
-CALL UPDATE_NSV(KMI)
-!
-! SET MINIMUN VALUE FOR DIFFERENT SV GROUPS
-!
-XSVMIN(1:NSV_USER_A(KMI))=0.
-IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO' ) &
-XSVMIN(NSV_C2R2BEG_A(KMI):NSV_C2R2END_A(KMI))=0.
-IF (CCLOUD == 'C3R5') &
-XSVMIN(NSV_C1R3BEG_A(KMI):NSV_C1R3END_A(KMI))=0.
-IF (CCLOUD == 'LIMA') &
-XSVMIN(NSV_LIMA_BEG_A(KMI):NSV_LIMA_END_A(KMI))=0.
-IF (CELEC /= 'NONE') &
-XSVMIN(NSV_ELECBEG_A(KMI):NSV_ELECEND_A(KMI))=0.
-IF (LUSECHEM .OR. LCHEMDIAG) &
-XSVMIN(NSV_CHEMBEG_A(KMI):NSV_CHEMEND_A(KMI))=0.
-IF (LUSECHIC) &
-XSVMIN(NSV_CHICBEG_A(KMI):NSV_CHICEND_A(KMI))=0.
-IF (.NOT.(LUSECHEM .OR. LCHEMDIAG) .AND. LCH_CONV_LINOX) &
-XSVMIN(NSV_LNOXBEG_A(KMI):NSV_LNOXEND_A(KMI))=0.
-IF (LORILAM .OR. LCHEMDIAG) &
-XSVMIN(NSV_AERBEG_A(KMI):NSV_AEREND_A(KMI))=0.
-IF (LDUST) XSVMIN(NSV_DSTBEG_A(KMI):NSV_DSTEND_A(KMI))=XMNH_TINY
-IF ((LDUST).AND.(LDEPOS_DST(KMI))) &
-XSVMIN(NSV_DSTDEPBEG_A(KMI):NSV_DSTDEPEND_A(KMI))=XMNH_TINY
-IF (LSALT) XSVMIN(NSV_SLTBEG_A(KMI):NSV_SLTEND_A(KMI))=XMNH_TINY
-IF (LLG) THEN
- XSVMIN(NSV_LGBEG_A(KMI)) =XLG1MIN
- XSVMIN(NSV_LGBEG_A(KMI)+1)=XLG2MIN
- XSVMIN(NSV_LGEND_A(KMI)) =XLG3MIN
-ENDIF
-IF ((LSALT).AND.(LDEPOS_SLT(KMI))) &
-XSVMIN(NSV_SLTDEPBEG_A(KMI):NSV_SLTDEPEND_A(KMI))=XMNH_TINY
-IF ((LORILAM).AND.(LDEPOS_AER(KMI))) &
-XSVMIN(NSV_AERDEPBEG_A(KMI):NSV_AERDEPEND_A(KMI))=XMNH_TINY
-IF (LPASPOL) XSVMIN(NSV_PPBEG_A(KMI):NSV_PPEND_A(KMI))=0.
-#ifdef MNH_FOREFIRE
-IF (LFOREFIRE) XSVMIN(NSV_FFBEG_A(KMI):NSV_FFEND_A(KMI))=0.
-#endif
-! Blaze smoke
-IF (LBLAZE) XSVMIN(NSV_FIREBEG_A(KMI):NSV_FIREEND_A(KMI))=0.
-!
-IF (LCONDSAMP) XSVMIN(NSV_CSBEG_A(KMI):NSV_CSEND_A(KMI))=0.
-IF (LBLOWSNOW) XSVMIN(NSV_SNWBEG_A(KMI):NSV_SNWEND_A(KMI))=XMNH_TINY
-!
-! NAME OF THE SCALAR VARIABLES IN THE DIFFERENT SV GROUPS
-!
-CSV_A(:, KMI) = ' '
-IF (LLG) THEN
- CSV_A(NSV_LGBEG_A(KMI), KMI) = 'X0 '
- CSV_A(NSV_LGBEG_A(KMI)+1, KMI) = 'Y0 '
- CSV_A(NSV_LGEND_A(KMI), KMI) = 'Z0 '
-ENDIF
-
-! Initialize scalar variable names for dust
-IF ( LDUST ) THEN
- IF ( NMODE_DST < 1 .OR. NMODE_DST > 3 ) CALL Print_msg( NVERB_FATAL, 'GEN', 'INI_NSV', 'NMODE_DST must in the 1 to 3 interval' )
-
- ! Initialization of dust names
- ! Was allocated for previous KMI
- ! We assume that if LDUST=T on a model, NSV_DST_A(KMI) is the same for all
- IF( .NOT. ALLOCATED( CDUSTNAMES ) ) THEN
- ALLOCATE( CDUSTNAMES(NSV_DST_A(KMI)) )
- ELSE IF ( SIZE( CDUSTNAMES ) /= NSV_DST_A(KMI) ) THEN
- CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_NSV', 'NSV_DST not the same for different model (if LDUST=T)' )
- DEALLOCATE( CDUSTNAMES )
- ALLOCATE( CDUSTNAMES(NSV_DST_A(KMI)) )
- END IF
- ALLOCATE( YDUSTLONGNAMES(NSV_DST_A(KMI)) )
- !Loop on all dust modes
- IF ( INMOMENTS_DST == 1 ) THEN
- DO JMODE = 1, NMODE_DST
- IMODEIDX = JPDUSTORDER(JMODE)
- JSV_NAME = ( IMODEIDX - 1 ) * 3 + 2
- CDUSTNAMES(JMODE) = YPDUST_INI(JSV_NAME)
- !Add meaning of the ppv unit (here for moment 3)
- YDUSTLONGNAMES(JMODE) = TRIM( YPDUST_INI(JSV_NAME) ) // ' [molec_{aer}/molec_{air}]'
- END DO
- ELSE
- DO JMODE = 1,NMODE_DST
- !Find which mode we are dealing with
- IMODEIDX = JPDUSTORDER(JMODE)
- DO JMOM = 1, INMOMENTS_DST
- !Find which number this is of the list of scalars
- JSV = ( JMODE - 1 ) * INMOMENTS_DST + JMOM
- !Find what name this corresponds to, always 3 moments assumed in YPDUST_INI
- JSV_NAME = ( IMODEIDX - 1) * 3 + JMOM
- !Get the right CDUSTNAMES which should follow the list of scalars transported in XSVM/XSVT
- CDUSTNAMES(JSV) = YPDUST_INI(JSV_NAME)
- !Add meaning of the ppv unit
- IF ( JMOM == 1 ) THEN !Corresponds to moment 0
- YDUSTLONGNAMES(JSV) = TRIM( YPDUST_INI(JSV_NAME) ) // ' [nb_aerosols/molec_{air}]'
- ELSE IF ( JMOM == 2 ) THEN !Corresponds to moment 3
- YDUSTLONGNAMES(JSV) = TRIM( YPDUST_INI(JSV_NAME) ) // ' [molec_{aer}/molec_{air}]'
- ELSE IF ( JMOM == 3 ) THEN !Corresponds to moment 6
- YDUSTLONGNAMES(JSV) = TRIM( YPDUST_INI(JSV_NAME) ) // ' [um6/molec_{air}*(cm3/m3)]'
- ELSE
- CALL Print_msg( NVERB_WARNING, 'GEN', 'INI_NSV', 'unknown moment for DUST' )
- YDUSTLONGNAMES(JMODE) = TRIM( YPDUST_INI(JSV_NAME) )
- END IF
- ENDDO ! Loop on moments
- ENDDO ! Loop on dust modes
- END IF
-
- ! Initialization of deposition scheme names
- IF ( LDEPOS_DST(KMI) ) THEN
- IF( .NOT. ALLOCATED( CDEDSTNAMES ) ) THEN
- ALLOCATE( CDEDSTNAMES(NMODE_DST * 2) )
- DO JMODE = 1, NMODE_DST
- IMODEIDX = JPDUSTORDER(JMODE)
- CDEDSTNAMES(JMODE) = YPDEDST_INI(IMODEIDX)
- CDEDSTNAMES(NMODE_DST + JMODE) = YPDEDST_INI(NMODE_DST + IMODEIDX)
- ENDDO
- END IF
- END IF
-END IF
-
-! Initialize scalar variable names for salt
-IF ( LSALT ) THEN
- IF ( NMODE_SLT < 1 .OR. NMODE_SLT > 8 ) CALL Print_msg( NVERB_FATAL, 'GEN', 'INI_NSV', 'NMODE_SLT must in the 1 to 8 interval' )
-
- ! Was allocated for previous KMI
- ! We assume that if LSALT=T on a model, NSV_SLT_A(KMI) is the same for all
- IF( .NOT. ALLOCATED( CSALTNAMES ) ) THEN
- ALLOCATE( CSALTNAMES(NSV_SLT_A(KMI)) )
- ELSE IF ( SIZE( CSALTNAMES ) /= NSV_SLT_A(KMI) ) THEN
- CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_NSV', 'NSV_SLT not the same for different model (if LSALT=T)' )
- DEALLOCATE( CSALTNAMES )
- ALLOCATE( CSALTNAMES(NSV_SLT_A(KMI)) )
- END IF
- ALLOCATE( YSALTLONGNAMES(NSV_SLT_A(KMI)) )
- !Loop on all dust modes
- IF ( INMOMENTS_SLT == 1 ) THEN
- DO JMODE = 1, NMODE_SLT
- IMODEIDX = JPSALTORDER(JMODE)
- JSV_NAME = ( IMODEIDX - 1 ) * 3 + 2
- CSALTNAMES(JMODE) = YPSALT_INI(JSV_NAME)
- !Add meaning of the ppv unit (here for moment 3)
- YSALTLONGNAMES(JMODE) = TRIM( YPSALT_INI(JSV_NAME) ) // ' [molec_{aer}/molec_{air}]'
- END DO
- ELSE
- DO JMODE = 1, NMODE_SLT
- !Find which mode we are dealing with
- IMODEIDX = JPSALTORDER(JMODE)
- DO JMOM = 1, INMOMENTS_SLT
- !Find which number this is of the list of scalars
- JSV = ( JMODE - 1 ) * INMOMENTS_SLT + JMOM
- !Find what name this corresponds to, always 3 moments assumed in YPSALT_INI
- JSV_NAME = ( IMODEIDX - 1 ) * 3 + JMOM
- !Get the right CSALTNAMES which should follow the list of scalars transported in XSVM/XSVT
- CSALTNAMES(JSV) = YPSALT_INI(JSV_NAME)
- !Add meaning of the ppv unit
- IF ( JMOM == 1 ) THEN !Corresponds to moment 0
- YSALTLONGNAMES(JSV) = TRIM( YPSALT_INI(JSV_NAME) ) // ' [nb_aerosols/molec_{air}]'
- ELSE IF ( JMOM == 2 ) THEN !Corresponds to moment 3
- YSALTLONGNAMES(JSV) = TRIM( YPSALT_INI(JSV_NAME) ) // ' [molec_{aer}/molec_{air}]'
- ELSE IF ( JMOM == 3 ) THEN !Corresponds to moment 6
- YSALTLONGNAMES(JSV) = TRIM( YPSALT_INI(JSV_NAME) ) // ' [um6/molec_{air}*(cm3/m3)]'
- ELSE
- CALL Print_msg( NVERB_WARNING, 'GEN', 'INI_NSV', 'unknown moment for SALT' )
- YSALTLONGNAMES(JMODE) = TRIM( YPSALT_INI(JSV_NAME) )
- END IF
- ENDDO ! Loop on moments
- ENDDO ! Loop on dust modes
- END IF
-
- ! Initialization of deposition scheme
- IF ( LDEPOS_SLT(KMI) ) THEN
- IF( .NOT. ALLOCATED( CDESLTNAMES ) ) THEN
- ALLOCATE( CDESLTNAMES(NMODE_SLT * 2) )
- DO JMODE = 1, NMODE_SLT
- IMODEIDX = JPSALTORDER(JMODE)
- CDESLTNAMES(JMODE) = YPDESLT_INI(IMODEIDX)
- CDESLTNAMES(NMODE_SLT + JMODE) = YPDESLT_INI(NMODE_SLT + IMODEIDX)
- ENDDO
- ENDIF
- ENDIF
-END IF
-
-! Initialize scalar variable names for snow
-IF ( LBLOWSNOW ) THEN
- IF( .NOT. ALLOCATED( CSNOWNAMES ) ) THEN
- ALLOCATE( CSNOWNAMES(NSV_SNW_A(KMI)) )
- DO JMOM = 1, NSV_SNW_A(KMI)
- CSNOWNAMES(JMOM) = YPSNOW_INI(JMOM)
- END DO
- END IF
-END IF
-
-!Fill metadata for model KMI
-DO JSV = 1, NSV_USER_A(KMI)
- WRITE( YNUM3, '( I3.3 )' ) JSV
-
- TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
- CMNHNAME = 'SVUSER' // YNUM3, &
- CSTDNAME = '', &
- CLONGNAME = 'SVUSER' // YNUM3, &
- CUNITS = 'kg kg-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_' // 'SVUSER' // YNUM3, &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
-END DO
-
-DO JSV = NSV_C2R2BEG_A(KMI), NSV_C2R2END_A(KMI)
- WRITE( YNUM3, '( I3.3 )' ) JSV
-
- TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
- CMNHNAME = TRIM( C2R2NAMES(JSV-NSV_C2R2BEG_A(KMI)+1) ), &
- CSTDNAME = '', &
- CLONGNAME = TRIM( C2R2NAMES(JSV-NSV_C2R2BEG_A(KMI)+1) ), &
- CUNITS = 'm-3', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
-END DO
-
-DO JSV = NSV_C1R3BEG_A(KMI), NSV_C1R3END_A(KMI)
- WRITE( YNUM3, '( I3.3 )' ) JSV
-
- TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
- CMNHNAME = TRIM( C1R3NAMES(JSV-NSV_C2R2BEG_A(KMI)+1) ), &
- CSTDNAME = '', &
- CLONGNAME = TRIM( C1R3NAMES(JSV-NSV_C2R2BEG_A(KMI)+1) ), &
- CUNITS = 'm-3', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
-END DO
-
-DO JSV = NSV_LIMA_BEG_A(KMI), NSV_LIMA_END_A(KMI)
- WRITE( YNUM3, '( I3.3 )' ) JSV
-
- TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
- CMNHNAME = 'SV LIMA ' // YNUM3, &
- CSTDNAME = '', &
- CLONGNAME = '', &
- CUNITS = 'kg-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
-
- IF ( JSV == NSV_LIMA_NC_A(KMI) ) THEN
- TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_WARM_NAMES(1) )
- ELSE IF ( JSV == NSV_LIMA_NR_A(KMI) ) THEN
- TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_WARM_NAMES(2) )
- ELSE IF ( JSV >= NSV_LIMA_CCN_FREE_A(KMI) .AND. JSV < NSV_LIMA_CCN_ACTI_A(KMI) ) THEN
- WRITE( YNUM2, '( I2.2 )' ) JSV - NSV_LIMA_CCN_FREE_A(KMI) + 1
- TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_WARM_NAMES(3) ) // YNUM2
- ELSE IF (JSV >= NSV_LIMA_CCN_ACTI_A(KMI) .AND. JSV < ( NSV_LIMA_CCN_ACTI_A(KMI) + NMOD_CCN ) ) THEN
- WRITE( YNUM2, '( I2.2 )' ) JSV - NSV_LIMA_CCN_ACTI_A(KMI) + 1
- TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_WARM_NAMES(4) ) // YNUM2
- ELSE IF ( JSV == NSV_LIMA_SCAVMASS_A(KMI) ) THEN
- TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CAERO_MASS(1) )
- TSVLIST_A(JSV, KMI)%CUNITS = 'kg kg-1'
- ELSE IF ( JSV == NSV_LIMA_NI_A(KMI) ) THEN
- TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(1) )
- ELSE IF ( JSV == NSV_LIMA_NS_A(KMI) ) THEN
- TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(2) )
- ELSE IF ( JSV == NSV_LIMA_NG_A(KMI) ) THEN
- TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(3) )
- ELSE IF ( JSV == NSV_LIMA_NH_A(KMI) ) THEN
- TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(4) )
- ELSE IF ( JSV >= NSV_LIMA_IFN_FREE_A(KMI) .AND. JSV < NSV_LIMA_IFN_NUCL_A(KMI) ) THEN
- WRITE( YNUM2, '( I2.2 )' ) JSV - NSV_LIMA_IFN_FREE_A(KMI) + 1
- TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(5) ) // YNUM2
- ELSE IF ( JSV >= NSV_LIMA_IFN_NUCL_A(KMI) .AND. JSV < ( NSV_LIMA_IFN_NUCL_A(KMI) + NMOD_IFN ) ) THEN
- WRITE( YNUM2, '( I2.2 )' ) JSV - NSV_LIMA_IFN_NUCL_A(KMI) + 1
- TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(6) ) // YNUM2
- ELSE IF ( JSV >= NSV_LIMA_IMM_NUCL_A(KMI) .AND. JSV < ( NSV_LIMA_IMM_NUCL_A(KMI) + NMOD_IMM ) ) THEN
- WRITE( YNUM2, '( I2.2 )' ) NINDICE_CCN_IMM(JSV-NSV_LIMA_IMM_NUCL_A(KMI)+1)
- TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(7) ) // YNUM2
- ELSE IF ( JSV == NSV_LIMA_HOM_HAZE_A(KMI) ) THEN
- TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_COLD_NAMES(8) )
- ELSE IF ( JSV == NSV_LIMA_SPRO_A(KMI) ) THEN
- TSVLIST_A(JSV, KMI)%CUNITS = '1'
- TSVLIST_A(JSV, KMI)%CMNHNAME = TRIM( CLIMA_WARM_NAMES(5) )
- ELSE
- CALL Print_msg( NVERB_FATAL, 'GEN', 'INI_NSV', 'invalid index for LIMA' )
- END IF
-
- TSVLIST_A(JSV, KMI)%CLONGNAME = TRIM( TSVLIST_A(JSV, KMI)%CMNHNAME )
-END DO
-
-DO JSV = NSV_ELECBEG_A(KMI), NSV_ELECEND_A(KMI)
- IF ( JSV > NSV_ELECBEG .AND. JSV < NSV_ELECEND ) THEN
- YUNITS = 'C kg-1'
- WRITE( YCOMMENT, '( A6, A3, I3.3 )' ) 'X_Y_Z_', 'SVT', JSV
- ELSE
- YUNITS = 'kg-1'
- WRITE( YCOMMENT, '( A6, A3, I3.3, A8 )' ) 'X_Y_Z_', 'SVT', JSV, ' (nb ions/kg)'
- END IF
-
- TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
- CMNHNAME = TRIM( CELECNAMES(JSV-NSV_ELECBEG_A(KMI)+1) ), &
- CSTDNAME = '', &
- CLONGNAME = TRIM( CELECNAMES(JSV-NSV_ELECBEG_A(KMI)+1) ), &
- CUNITS = TRIM( YUNITS ), &
- CDIR = 'XY', &
- CCOMMENT = TRIM( YCOMMENT ), &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
-END DO
-
-DO JSV = NSV_LGBEG_A(KMI), NSV_LGEND_A(KMI)
- WRITE( YNUM3, '( I3.3 )' ) JSV
-
- TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
- CMNHNAME = TRIM( CLGNAMES(JSV-NSV_LGBEG_A(KMI)+1) ), &
- CSTDNAME = '', &
- CLONGNAME = TRIM( CLGNAMES(JSV-NSV_LGBEG_A(KMI)+1) ), &
- CUNITS = 'm', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
-END DO
-
-DO JSV = NSV_PPBEG_A(KMI), NSV_PPEND_A(KMI)
- WRITE( YNUM3, '( I3.3 )' ) JSV-NSV_PPBEG_A(KMI)+1
-
- TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
- CMNHNAME = 'SVPP' // YNUM3, &
- CSTDNAME = '', &
- CLONGNAME = 'SVPP' // YNUM3, &
- CUNITS = 'kg kg-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
-END DO
-
-#ifdef MNH_FOREFIRE
-DO JSV = NSV_FFBEG_A(KMI), NSV_FFEND_A(KMI)
- WRITE( YNUM3, '( I3.3 )' ) JSV-NSV_FFBEG_A(KMI)+1
-
- TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
- CMNHNAME = 'SVFF' // YNUM3, &
- CSTDNAME = '', &
- CLONGNAME = 'SVFF' // YNUM3, &
- CUNITS = 'kg kg-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
-END DO
-#endif
-
-DO JSV = NSV_FIREBEG_A(KMI), NSV_FIREEND_A(KMI)
- WRITE( YNUM3, '( I3.3 )' ) JSV-NSV_FIREBEG_A(KMI)+1
-
- TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
- CMNHNAME = 'SVFIRE' // YNUM3, &
- CSTDNAME = '', &
- CLONGNAME = 'SVFIRE' // YNUM3, &
- CUNITS = 'kg kg-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
-END DO
-
-DO JSV = NSV_CSBEG_A(KMI), NSV_CSEND_A(KMI)
- WRITE( YNUM3, '( I3.3 )' ) JSV-NSV_CSBEG_A(KMI)
-
- TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
- CMNHNAME = 'SVCS' // YNUM3, &
- CSTDNAME = '', &
- CLONGNAME = 'SVCS' // YNUM3, &
- CUNITS = 'kg kg-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
-END DO
-
-DO JSV = NSV_CHEMBEG_A(KMI), NSV_CHEMEND_A(KMI)
- ICHIDX = ICHIDX + 1
- CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CNAMES(JSV-NSV_CHEMBEG_A(KMI)+1) )
-
- WRITE( YNUM3, '( I3.3 )' ) JSV
-
- TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
- CMNHNAME = TRIM( CNAMES(JSV-NSV_CHEMBEG_A(KMI)+1) ), &
- CSTDNAME = '', &
- CLONGNAME = TRIM( CNAMES(JSV-NSV_CHEMBEG_A(KMI)+1) ), &
- CUNITS = 'ppv', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
-END DO
-
-DO JSV = NSV_CHICBEG_A(KMI), NSV_CHICEND_A(KMI)
- ICHIDX = ICHIDX + 1
- CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CICNAMES(JSV-NSV_CHICBEG_A(KMI)+1) )
-
- WRITE( YNUM3, '( I3.3 )' ) JSV
-
- TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
- CMNHNAME = TRIM( CICNAMES(JSV-NSV_CHICBEG_A(KMI)+1) ), &
- CSTDNAME = '', &
- CLONGNAME = TRIM( CICNAMES(JSV-NSV_CHICBEG_A(KMI)+1) ), &
- CUNITS = 'ppv', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
-END DO
-
-DO JSV = NSV_AERBEG_A(KMI), NSV_AEREND_A(KMI)
- ICHIDX = ICHIDX + 1
- CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CAERONAMES(JSV-NSV_AERBEG_A(KMI)+1) )
-
- WRITE( YNUM3, '( I3.3 )' ) JSV
-
- !Determine moment to add meaning of the ppv unit
- JAER = JSV - NSV_AERBEG_A(KMI) + 1
- IF ( ANY( JAER == [JP_CH_M0i, JP_CH_M0j] ) ) THEN
- !Moment 0
- YAEROLONGNAMES = TRIM( CAERONAMES(JAER) ) // ' [nb_aerosols/molec_{air}]'
- ELSE IF ( ANY( JAER == [ JP_CH_SO4i, JP_CH_SO4j, JP_CH_NO3i, JP_CH_NO3j, JP_CH_H2Oi, JP_CH_H2Oj, JP_CH_NH3i, JP_CH_NH3j, &
- JP_CH_OCi, JP_CH_OCj, JP_CH_BCi, JP_CH_BCj, JP_CH_DSTi, JP_CH_DSTj ] ) &
- .OR. ( NSOA == 10 .AND. &
- ANY( JAER == [ JP_CH_SOA1i, JP_CH_SOA1j, JP_CH_SOA2i, JP_CH_SOA2j, JP_CH_SOA3i, JP_CH_SOA3j, JP_CH_SOA4i, &
- JP_CH_SOA4j, JP_CH_SOA5i, JP_CH_SOA5j, JP_CH_SOA6i, JP_CH_SOA6j, JP_CH_SOA7i, JP_CH_SOA7j, &
- JP_CH_SOA8i, JP_CH_SOA8j, JP_CH_SOA9i, JP_CH_SOA9j, JP_CH_SOA10i, JP_CH_SOA10j ] ) ) ) THEN
- !Moment 3
- YAEROLONGNAMES = TRIM( CAERONAMES(JAER) ) // ' [molec_{aer}/molec_{air}]'
- ELSE IF ( ( LVARSIGI .AND. JAER == JP_CH_M6i ) .OR. ( LVARSIGJ .AND. JAER == JP_CH_M6j ) ) THEN
- !Moment 6
- YAEROLONGNAMES = TRIM( CAERONAMES(JAER) ) // ' [um6/molec_{air}*(cm3/m3)]'
- ELSE
- CALL Print_msg( NVERB_WARNING, 'GEN', 'INI_NSV', 'unknown moment for AER' )
- YAEROLONGNAMES = TRIM( CAERONAMES(JAER) )
- END IF
-
- TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
- CMNHNAME = TRIM( CAERONAMES(JSV-NSV_AERBEG_A(KMI)+1) ), &
- CSTDNAME = '', &
- CLONGNAME = TRIM( YAEROLONGNAMES(JSV-NSV_AERBEG_A(KMI)+1) ), &
- CUNITS = 'ppv', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
-END DO
-
-DO JSV = NSV_AERDEPBEG_A(KMI), NSV_AERDEPEND_A(KMI)
- ICHIDX = ICHIDX + 1
- CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CDEAERNAMES(JSV-NSV_AERDEPBEG_A(KMI)+1) )
-
- WRITE( YNUM3, '( I3.3 )' ) JSV
-
- TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
- CMNHNAME = TRIM( CDEAERNAMES(JSV-NSV_AERDEPBEG_A(KMI)+1) ), &
- CSTDNAME = '', &
- CLONGNAME = TRIM( CDEAERNAMES(JSV-NSV_AERDEPBEG_A(KMI)+1) ), &
- CUNITS = 'ppv', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
-END DO
-
-DO JSV = NSV_DSTBEG_A(KMI), NSV_DSTEND_A(KMI)
- ICHIDX = ICHIDX + 1
- CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CDUSTNAMES(JSV-NSV_DSTBEG_A(KMI)+1) )
-
- WRITE( YNUM3, '( I3.3 )' ) JSV
-
- TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
- CMNHNAME = TRIM( CDUSTNAMES(JSV-NSV_DSTBEG_A(KMI)+1) ), &
- CSTDNAME = '', &
- CLONGNAME = TRIM( YDUSTLONGNAMES(JSV-NSV_DSTBEG_A(KMI)+1) ), &
- CUNITS = 'ppv', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
-END DO
-
-DO JSV = NSV_DSTDEPBEG_A(KMI), NSV_DSTDEPEND_A(KMI)
- ICHIDX = ICHIDX + 1
- CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CDEDSTNAMES(JSV-NSV_DSTDEPBEG_A(KMI)+1) )
-
- WRITE( YNUM3, '( I3.3 )' ) JSV
-
- TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
- CMNHNAME = TRIM( CDEDSTNAMES(JSV-NSV_DSTDEPBEG_A(KMI)+1) ), &
- CSTDNAME = '', &
- CLONGNAME = TRIM( CDEDSTNAMES(JSV-NSV_DSTDEPBEG_A(KMI)+1) ), &
- CUNITS = 'ppv', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
-END DO
-
-DO JSV = NSV_SLTBEG_A(KMI), NSV_SLTEND_A(KMI)
- ICHIDX = ICHIDX + 1
- CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CSALTNAMES(JSV-NSV_SLTBEG_A(KMI)+1) )
-
- WRITE( YNUM3, '( I3.3 )' ) JSV
-
- TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
- CMNHNAME = TRIM( CSALTNAMES(JSV-NSV_SLTBEG_A(KMI)+1) ), &
- CSTDNAME = '', &
- CLONGNAME = TRIM( YSALTLONGNAMES(JSV-NSV_SLTBEG_A(KMI)+1) ), &
- CUNITS = 'ppv', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
-END DO
-
-DO JSV = NSV_SLTDEPBEG_A(KMI), NSV_SLTDEPEND_A(KMI)
- ICHIDX = ICHIDX + 1
- CSV_CHEM_LIST_A(ICHIDX, KMI) = TRIM( CDESLTNAMES(JSV-NSV_SLTDEPBEG_A(KMI)+1) )
-
- WRITE( YNUM3, '( I3.3 )' ) JSV
-
- TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
- CMNHNAME = TRIM( CDESLTNAMES(JSV-NSV_SLTDEPBEG_A(KMI)+1) ), &
- CSTDNAME = '', &
- CLONGNAME = TRIM( CDESLTNAMES(JSV-NSV_SLTDEPBEG_A(KMI)+1) ), &
- CUNITS = 'ppv', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
-END DO
-
-DO JSV = NSV_SNWBEG_A(KMI), NSV_SNWEND_A(KMI)
- WRITE( YNUM3, '( I3.3 )' ) JSV
-
- TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
- CMNHNAME = TRIM( CSNOWNAMES(JSV-NSV_SNWBEG_A(KMI)+1) ), &
- CSTDNAME = '', &
- CLONGNAME = TRIM( CSNOWNAMES(JSV-NSV_SNWBEG_A(KMI)+1) ), &
- CUNITS = 'kg kg-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
-END DO
-
-!Check if there is at most 1 LINOX scalar variable
-!if not, the name must be modified and different for all of them
-IF ( NSV_LNOX_A(KMI) > 1 ) &
- CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_NSV', 'NSV_LNOX_A>1: problem with the names of the corresponding scalar variables' )
-
-DO JSV = NSV_LNOXBEG_A(KMI), NSV_LNOXEND_A(KMI)
- ICHIDX = ICHIDX + 1
- CSV_CHEM_LIST_A(ICHIDX, KMI) = 'LINOX'
-
- WRITE( YNUM3, '( I3.3 )' ) JSV
-
- TSVLIST_A(JSV, KMI) = TFIELDMETADATA( &
- CMNHNAME = 'LINOX', &
- CSTDNAME = '', &
- CLONGNAME = 'LINOX', &
- CUNITS = 'ppv', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_' // 'SVT' // YNUM3, &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
-END DO
-
-IF ( ICHIDX /= NSV_CHEM_LIST_A(KMI) ) &
- CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_NSV', 'ICHIDX /= NSV_CHEM_LIST_A(KMI)' )
-
-END SUBROUTINE INI_NSV
diff --git a/src/mesonh/ext/init_aerosol_concentration.f90 b/src/mesonh/ext/init_aerosol_concentration.f90
deleted file mode 100644
index fc4becd44..000000000
--- a/src/mesonh/ext/init_aerosol_concentration.f90
+++ /dev/null
@@ -1,157 +0,0 @@
-!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 MODI_INIT_AEROSOL_CONCENTRATION
-!######################################
-!
-INTERFACE INIT_AEROSOL_CONCENTRATION
- SUBROUTINE INIT_AEROSOL_CONCENTRATION(PRHODREF, PSVT, PZZ)
-!
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF !Air Density [kg/m**3]
- REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT !Particles Concentration [/m**3]
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-!
- END SUBROUTINE INIT_AEROSOL_CONCENTRATION
-END INTERFACE INIT_AEROSOL_CONCENTRATION
-!
-END MODULE MODI_INIT_AEROSOL_CONCENTRATION
-!
-! ##########################################################
- SUBROUTINE INIT_AEROSOL_CONCENTRATION(PRHODREF, PSVT, PZZ)
-! ##########################################################
-!!
-!! PURPOSE
-!! -------
-!! Define the aerosol distributions
-!!
-!!
-!! MODD_BLANKn :
-!! CDUMMY2 : CCN ou IFN pour le panache
-!! NDUMMY1 : hauteur base du panache
-!! NDUMMY2 : hauteur sommet du panache
-!! XDUMMY8 : Concentration du panache (N/cm3 pour des CCN, N/L pour des IFN)
-!!
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! S. Berthet * Laboratoire d'Aerologie*
-!! B. Vié * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original ??/??/13
-!! Modification 01/2016 (JP Pinty) Add LIMA
-!!
-!!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_NSV
-USE MODD_PARAM_n, ONLY : CCLOUD
-USE MODD_PARAM_LIMA, ONLY : NMOM_C, LACTI, NMOD_CCN, LSCAV, LAERO_MASS, &
- XCCN_CONC, LCCN_HOM, &
- NMOM_I, LNUCL, NMOD_IFN, LMEYERS, &
- XIFN_CONC, LIFN_HOM
-USE MODD_PARAMETERS, ONLY : JPVEXT
-USE MODD_BLANK_n, ONLY : CDUMMY2, NDUMMY1, NDUMMY2, XDUMMY8
-!
-IMPLICIT NONE
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF !Air Density [kg/m**3]
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT !Particles Concentration
- ![particles/kg of dry air]
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-!
-! Local variables
-INTEGER :: JMOD_IFN
-INTEGER :: JSV, JINIT
-INTEGER :: IKB, IKE
-!
-!-------------------------------------------------------------------------------
-!
-!
-!*initialization of N_FREE_CCN/N_ACTIVATED_CCN et N_FREE_IN/N_ACTIVATED_IN
-!
-!
-IF ( NMOM_C.GE.2 .AND. LACTI ) THEN
- DO JSV = NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI+NMOD_CCN-1
- PSVT(:,:,:,JSV) = 0.0
- ENDDO
- IKB = 1+JPVEXT
- IKE = SIZE(PSVT,3)-JPVEXT
-!
-! Initialisation des concentrations en CCN
-!
-!
- IF (LCCN_HOM) THEN
-! concentration homogène (en nombre par m3) sur la verticale
- DO JSV = 1, NMOD_CCN
- PSVT(:,:,IKB:IKE,NSV_LIMA_CCN_FREE+JSV-1) = &
- XCCN_CONC(JSV)*1.0E6 / PRHODREF(:,:,IKB:IKE)
- END DO
- ELSE
-! concentration décroissante selon z
- DO JSV = 1, NMOD_CCN
- WHERE (PZZ(:,:,:) .LE. 1000.)
- PSVT(:,:,:,NSV_LIMA_CCN_FREE+JSV-1) = XCCN_CONC(JSV)*1.0E6 / PRHODREF(:,:,:)
- ELSEWHERE (PZZ(:,:,:) .LE. 10000.)
- PSVT(:,:,:,NSV_LIMA_CCN_FREE+JSV-1) = XCCN_CONC(JSV)*1.0E6 &
- / PRHODREF(:,:,:) * EXP(-LOG(XCCN_CONC(JSV)/0.01)*PZZ(:,:,:)/10000.)
- ELSEWHERE
- PSVT(:,:,:,NSV_LIMA_CCN_FREE+JSV-1) = 0.01*1.0E6 / PRHODREF(:,:,:)
- ENDWHERE
- END DO
- ENDIF
-END IF ! LWARM AND LACTI
-!
-! Initialisation des concentrations en IFN
-!
-IF ( NMOM_I.GE.2 .AND. LNUCL .AND. (.NOT. LMEYERS) ) THEN
- DO JSV = NSV_LIMA_IFN_FREE, NSV_LIMA_IFN_NUCL+NMOD_IFN-1
- PSVT(:,:,:,JSV) = 0.0
- ENDDO
- IKB = 1+JPVEXT
- IKE = SIZE(PSVT,3)-JPVEXT
-!
- IF (LIFN_HOM) THEN
-! concentration homogène (en nombre par m3) sur la verticale
- DO JSV = 1, NMOD_IFN
- PSVT(:,:,IKB:IKE,NSV_LIMA_IFN_FREE+JSV-1) = &
- XIFN_CONC(JSV)*1.0E3 / PRHODREF(:,:,IKB:IKE)
- END DO
- ELSE
-! concentration décroissante selon z
- DO JSV = 1, NMOD_IFN
- WHERE (PZZ(:,:,:) .LE. 1000.)
- PSVT(:,:,:,NSV_LIMA_IFN_FREE+JSV-1) = XIFN_CONC(JSV)*1.0E3 / PRHODREF(:,:,:)
- ELSEWHERE (PZZ(:,:,:) .LE. 10000.)
- PSVT(:,:,:,NSV_LIMA_IFN_FREE+JSV-1) = XIFN_CONC(JSV)*1.0E3 &
- / PRHODREF(:,:,:) * EXP(-LOG(XIFN_CONC(JSV)/1.)*PZZ(:,:,:)/10000.)
- ELSEWHERE
- PSVT(:,:,:,NSV_LIMA_IFN_FREE+JSV-1) = 1*1.0E3 / PRHODREF(:,:,:)
- ENDWHERE
- END DO
- ENDIF
-END IF ! LCOLD AND LNUCL AND NOT LMEYERS
-!
-!
-! Cas d'un panache de "pollution", concentration homogène dans le panache :
-!
-SELECT CASE (CDUMMY2)
- CASE ('CCN')
- PSVT(:,:,:,NSV_LIMA_CCN_FREE+NMOD_CCN-1)=0.
- WHERE ( (PZZ(:,:,:) .GE. NDUMMY1) .AND. (PZZ(:,:,:) .LE. NDUMMY2) ) &
- PSVT(:,:,:,NSV_LIMA_CCN_FREE+NMOD_CCN-1)=XDUMMY8*1.0E6 / PRHODREF(:,:,:)
- CASE ('IFN')
- PSVT(:,:,:,NSV_LIMA_IFN_FREE+NMOD_IFN-1)=0.
- WHERE ( (PZZ(:,:,:) .GE. NDUMMY1) .AND. (PZZ(:,:,:) .LE. NDUMMY2) ) &
- PSVT(:,:,:,NSV_LIMA_IFN_FREE+NMOD_IFN-1)=XDUMMY8*1.0E3 / PRHODREF(:,:,:)
-END SELECT
-!
-!
-END SUBROUTINE INIT_AEROSOL_CONCENTRATION
diff --git a/src/mesonh/ext/modeln.f90 b/src/mesonh/ext/modeln.f90
deleted file mode 100644
index b5ab33489..000000000
--- a/src/mesonh/ext/modeln.f90
+++ /dev/null
@@ -1,2414 +0,0 @@
-!MNH_LIC Copyright 1994-2023 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, TPBAKFILE, TPDTMODELN, OEXIT )
-!
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_TYPE_DATE, ONLY: DATE_TIME
-!
-INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop index of model KMODEL
-TYPE(TFILEDATA), POINTER, INTENT(OUT) :: TPBAKFILE ! Pointer for backup file
-TYPE(DATE_TIME), INTENT(OUT) :: TPDTMODELN ! Time of current model computation
-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, TPBAKFILE, TPDTMODELN, 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)
-! A. Costes 12/2021: add Blaze fire model
-! C. Barthe 07/04/2022: deallocation of ZSEA
-! P. Wautelet 08/12/2022: bugfix if no TDADFILE
-! P. Wautelet 13/01/2023: manage close of backup files outside of MODEL_n
-! (useful to close them in reverse model order (child before parent, needed by WRITE_BALLOON_n)
-!!-------------------------------------------------------------------------------
-!
-!* 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, tbuconf, 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_CST, ONLY: CST
-USE MODD_CURVCOR_n
-USE MODD_DEEP_CONVECTION_n
-USE MODD_DIM_n
-USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
-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, NMOM_C, NMOM_R, &
- MACTIT => LACTIT, LSCAV, NMOM_I, &
- MSEDI => LSEDI, MHHONI => LHHONI, NMOM_H, &
- 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_TYPE_DATE, ONLY: DATE_TIME
-USE MODD_VISCOSITY
-!
-USE MODE_AIRCRAFT_BALLOON
-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_AIRCRAFT_BALLOON
-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 MODE_WRITE_STATION_n, ONLY: WRITE_STATION_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_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_DESFM_n
-USE MODI_WRITE_DIAG_SURF_ATM_N
-USE MODI_WRITE_LFIFM_n
-USE MODI_WRITE_SERIES_n
-USE MODI_WRITE_SURF_ATM_N
-!
-USE MODD_FIRE_n
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop index of model KMODEL
-TYPE(TFILEDATA), POINTER, INTENT(OUT) :: TPBAKFILE ! Pointer for backup file
-TYPE(DATE_TIME), INTENT(OUT) :: TPDTMODELN ! Time of current model computation
-LOGICAL, INTENT(INOUT) :: OEXIT ! Switch for the end of the temporal loop
-!
-!* 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, ZBLAZETOT
-REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME_STEP,ZTIME_STEP_PTS
-CHARACTER :: YMI
-INTEGER :: IPOINTS
-CHARACTER(len=16) :: YTCOUNT,YPOINTS
-CHARACTER(LEN=:), ALLOCATABLE :: YDADNAME
-!
-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 :: TZOUTFILE
-! TYPE(TFILEDATA),SAVE :: TZDIACFILE
-TYPE(DIMPHYEX_t) :: YLDIMPHYEX
-!-------------------------------------------------------------------------------
-!
-TPBAKFILE=> NULL()
-TZOUTFILE=> NULL()
-!
-TPDTMODELN = TDTCUR
-!
-!* 0. MICROPHYSICAL SCHEME
-! -------------------
-SELECT CASE(CCLOUD)
-CASE('C2R2','KHKO','C3R5')
- KWARM = .TRUE.
- KRAIN = NRAIN
- KSEDC = NSEDC
- KACTIT = NACTIT
-!
- KSEDI = NSEDI
- KHHONI = NHHONI
-CASE('LIMA')
- KRAIN = NMOM_R.GE.1
- KWARM = NMOM_C.GE.1
- 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' )
- ! Fire model parallel setup
- IF (LBLAZE) THEN
- CALL ADD3DFIELD_ll( TFIELDS_ll, XLSPHI, 'MODEL_n::XLSPHI')
- CALL ADD3DFIELD_ll( TFIELDS_ll, XBMAP, 'MODEL_n::XBMAP')
- CALL ADD3DFIELD_ll( TFIELDS_ll, XFMRFA, 'MODEL_n::XFMRFA')
- CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWF0, 'MODEL_n::XFMWF0')
- CALL ADD3DFIELD_ll( TFIELDS_ll, XFMR0, 'MODEL_n::XFMR0')
- CALL ADD3DFIELD_ll( TFIELDS_ll, XFMR00, 'MODEL_n::XFMR00')
- CALL ADD3DFIELD_ll( TFIELDS_ll, XFMIGNITION, 'MODEL_n::XFMIGNITION')
- CALL ADD3DFIELD_ll( TFIELDS_ll, XFMFUELTYPE, 'MODEL_n::XFMFUELTYPE')
- CALL ADD3DFIELD_ll( TFIELDS_ll, XFIRETAU, 'MODEL_n::XFIRETAU')
- CALL ADD4DFIELD_ll( TFIELDS_ll, XFLUXPARAMH(:,:,:,1:SIZE(XFLUXPARAMH,4)), 'MODEL_n::XFLUXPARAMH')
- CALL ADD4DFIELD_ll( TFIELDS_ll, XFLUXPARAMW(:,:,:,1:SIZE(XFLUXPARAMW,4)), 'MODEL_n::XFLUXPARAMW')
- CALL ADD3DFIELD_ll( TFIELDS_ll, XFIRERW, 'MODEL_n::XFIRERW')
- CALL ADD3DFIELD_ll( TFIELDS_ll, XFMASE, 'MODEL_n::XFMASE')
- CALL ADD3DFIELD_ll( TFIELDS_ll, XFMAWC, 'MODEL_n::XFMAWC')
- CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWALKIG, 'MODEL_n::XFMWALKIG')
- CALL ADD3DFIELD_ll( TFIELDS_ll, XFMFLUXHDH, 'MODEL_n::XFMFLUXHDH')
- CALL ADD3DFIELD_ll( TFIELDS_ll, XFMFLUXHDW, 'MODEL_n::XFMFLUXHDW')
- CALL ADD3DFIELD_ll( TFIELDS_ll, XFMHWS, 'MODEL_n::XFMHWS')
- CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWINDU, 'MODEL_n::XFMWINDU')
- CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWINDV, 'MODEL_n::XFMWINDV')
- CALL ADD3DFIELD_ll( TFIELDS_ll, XFMWINDW, 'MODEL_n::XFMWINDW')
- CALL ADD3DFIELD_ll( TFIELDS_ll, XFMGRADOROX, 'MODEL_n::XFMGRADOROX')
- CALL ADD3DFIELD_ll( TFIELDS_ll, XFMGRADOROY, 'MODEL_n::XFMGRADOROY')
- END IF
- !
- 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
- ! Blaze fire model
- XFIREPERF = 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
-!
-!
-! For START/RESTART MPPDB_CHECK use
-!IF ( (IMI==1) .AND. (CCONF == "START") .AND. (KTCOUNT == 2) ) THEN
-! CALL MPPDB_START_DEBUG()
-!ENDIF
-!IF ( (IMI==1) .AND. (CCONF == "RESTA") .AND. (KTCOUNT == 1) ) THEN
-! CALL MPPDB_START_DEBUG()
-!ENDIF
-!-------------------------------------------------------------------------------
-!* 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
- !
- TPBAKFILE => TBACKUPN(nfile_backup_current)%TFILE
- IVERB = TPBAKFILE%NLFIVERB
- !
- CALL IO_File_open(TPBAKFILE)
- !
- CALL WRITE_DESFM_n(IMI,TPBAKFILE)
- CALL IO_Header_write( TBACKUPN(nfile_backup_current)%TFILE )
- IF ( ASSOCIATED( TBACKUPN(nfile_backup_current)%TFILE%TDADFILE ) ) THEN
- YDADNAME = TBACKUPN(nfile_backup_current)%TFILE%TDADFILE%CNAME
- ELSE
- ! Set a dummy name for the dad file. Its non-zero size will allow the writing of some data in the backup file
- YDADNAME = 'DUMMY'
- END IF
- CALL WRITE_LFIFM_n( TBACKUPN(nfile_backup_current)%TFILE, TRIM( YDADNAME ) )
- TOUTDATAFILE => TPBAKFILE
- CALL MNHWRITE_ZS_DUMMY_n(TPBAKFILE)
- IF (CSURF=='EXTE') THEN
- TFILE_SURFEX => TPBAKFILE
- CALL GOTO_SURFEX(IMI)
- CALL WRITE_SURF_ATM_n(YSURF_CUR,'MESONH','ALL',.FALSE.)
- IF ( KTCOUNT > 1) THEN
- CALL DIAG_SURF_ATM_n(YSURF_CUR,'MESONH')
- CALL WRITE_DIAG_SURF_ATM_n(YSURF_CUR,'MESONH','ALL')
- END IF
- 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( XXHATM, XYHATM, XZZ, XSVT, XLBXSVM, XLBYSVM )
- IF (IVERB>=5) THEN
- WRITE(UNIT=ILUOUT,FMT=*) '************************************'
- WRITE(UNIT=ILUOUT,FMT=*) '*** Lagrangian variables refreshed after ',TRIM(TPBAKFILE%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
- TPBAKFILE => TFILE_DUMMY
- END IF
-ELSE
- !Necessary to have a 'valid' CNAME when calling some subroutines
- TPBAKFILE => 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, XXHATM, XYHATM, 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
-! Blaze smoke
-DO JSV = NSV_FIREBEG,NSV_FIREEND
- XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
-END DO
-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,LHORELAX_SVFIRE, &
-#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, TPBAKFILE, &
- 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
-!
-!
-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_FIREBEG,NSV_FIREEND
- XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.)
- XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.)
- ENDDO
- !
- 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 ( TPBAKFILE, 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, TPBAKFILE, &
- 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 MPPDB_CHECK3DM("before RAD_BOUND : other var",PRECISION,XUT,XVT,XRHODJ,XTKET)
-CALL MPPDB_CHECKLB(XLBXUM,"modeln XLBXUM",PRECISION,'LBXU',NRIMX)
-CALL MPPDB_CHECKLB(XLBYVM,"modeln XLBYVM",PRECISION,'LBYV',NRIMY)
-CALL MPPDB_CHECKLB(XLBXUS,"modeln XLBXUS",PRECISION,'LBXU',NRIMX)
-CALL MPPDB_CHECKLB(XLBYVS,"modeln XLBYVS",PRECISION,'LBYV',NRIMY)
-!
- 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
- CALL MPPDB_CHECK3DM("after pressurez:XRU/V/WS",PRECISION,XRUS,XRVS,XRWS)
-!
-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( MAX(MAXVAL(XCLDFR(:,:,:)),MAXVAL(XICEFR(:,:,:))).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,TPBAKFILE, CRAD, CTURBDIM, &
- LSUBG_COND,LSIGMAS,CSUBG_AUCV,XTSTEP, &
- XZZ, XRHODJ, XRHODREF, XEXNREF, &
- ZPABST, XTHT,XRT,XSIGS,VSIGQSAT,XMFCONV,XTHM,XRCM, &
- XPABST, XWT_ACT_NUC,XDTHRAD, XRTHS, XRRS, &
- XSVT, XRSVS, &
- XSRCT, XCLDFR,XICEFR, 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)
- DEALLOCATE(ZSEA)
- ELSE
- CALL RESOLVED_CLOUD ( CCLOUD, CACTCCN, CSCONV, CMF_CLOUD, NRR, NSPLITR, &
- NSPLITG, IMI, KTCOUNT, &
- CLBCX,CLBCY,TPBAKFILE, CRAD, CTURBDIM, &
- LSUBG_COND,LSIGMAS,CSUBG_AUCV, &
- XTSTEP,XZZ, XRHODJ, XRHODREF, XEXNREF, &
- ZPABST, XTHT,XRT,XSIGS,VSIGQSAT,XMFCONV,XTHM,XRCM, &
- XPABST, XWT_ACT_NUC,XDTHRAD, XRTHS, XRRS, &
- XSVT, XRSVS, &
- XSRCT, XCLDFR, XICEFR, 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. NMOM_I.GE.1 ) ) THEN
- XACPRS = XACPRS + XINPRS * XTSTEP
- XACPRG = XACPRG + XINPRG * XTSTEP
- IF (CCLOUD == 'ICE4' .OR. (CCLOUD == 'LIMA' .AND. NMOM_H.GE.1)) 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( YLDIMPHYEX,CST,TBUCONF,TBUDGETS,SIZE(TBUDGETS), &
- 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)
- DEALLOCATE(ZSEA)
- 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) THEN
- IF (CSURF=='EXTE') THEN
- ALLOCATE(ZSEA(IIU,IJU))
- ZSEA(:,:) = 0.
- CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:))
- CALL AIRCRAFT_BALLOON( XTSTEP, XZZ, XMAP, XLONORI, XLATORI, &
- XUT, XVT, XWT, XPABST, XTHT, XRT, XSVT, XTKET, XTSRAD, &
- XRHODREF, XCIT, PSEA = ZSEA(:,:) )
- DEALLOCATE(ZSEA)
- ELSE
- CALL AIRCRAFT_BALLOON( XTSTEP, XZZ, XMAP, XLONORI, XLATORI, &
- XUT, XVT, XWT, XPABST, XTHT, XRT, XSVT, XTKET, XTSRAD, &
- XRHODREF, XCIT )
- END IF
-END IF
-
-!-------------------------------------------------------------------------------
-!
-!* 24.2 STATION (observation diagnostic)
-! --------------------------------
-!
-IF ( LSTATION ) &
- CALL STATION_n( XZZ, XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, XTSRAD, XPABST )
-!
-!---------------------------------------------------------
-!
-!* 24.3 PROFILER (observation diagnostic)
-! ---------------------------------
-!
-IF (LPROFILER) THEN
- IF (CSURF=='EXTE') THEN
- ALLOCATE(ZSEA(IIU,IJU))
- ZSEA(:,:) = 0.
- CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:))
- CALL PROFILER_n( XZZ, XRHODREF, &
- XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, &
- XTSRAD, XPABST, XAER, XCIT, PSEA=ZSEA(:,:) )
- DEALLOCATE(ZSEA)
- ELSE
- CALL PROFILER_n( XZZ, XRHODREF, &
- XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, &
- XTSRAD, XPABST, XAER, XCIT )
- END IF
-END IF
-!
-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
-!
-!-------------------------------------------------------------------------------
-!
-!* 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)
- ! Free memory of flyer that is not present on the master process of the file (was allocated in WRITE_AIRCRAFT_BALLOON)
- CALL AIRCRAFT_BALLOON_FREE_NONLOCAL( 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' ,'-')
- ! Blaze perf
- IF (LBLAZE) THEN
- CALL TIME_STAT_ll(XFIREPERF,ZBLAZETOT)
- CALL TIME_STAT_ll(XFIREPERF,ZTOT, ' BLAZE' ,'~')
- CALL TIME_STAT_ll(XGRADPERF,ZBLAZETOT, ' GRAD(PHI)' ,' ')
- CALL TIME_STAT_ll(XROSWINDPERF,ZBLAZETOT, ' ROS & WIND' ,' ')
- CALL TIME_STAT_ll(XPROPAGPERF,ZBLAZETOT, ' PROPAGATION' ,' ')
- CALL TIME_STAT_ll(XFLUXPERF,ZBLAZETOT, ' HEAT FLUXES' ,' ')
- END IF
- 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/mesonh/ext/radiations.f90 b/src/mesonh/ext/radiations.f90
deleted file mode 100644
index 2ce3ff7dd..000000000
--- a/src/mesonh/ext/radiations.f90
+++ /dev/null
@@ -1,3504 +0,0 @@
-!MNH_LIC Copyright 1995-2022 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_RADIATIONS
-! ########################
-!
-CONTAINS
-!
-! ############################################################################
- SUBROUTINE RADIATIONS (TPFILE,OCLEAR_SKY,OCLOUD_ONLY, &
- KCLEARCOL_TM1,HEFRADL,HEFRADI,HOPWSW,HOPISW,HOPWLW,HOPILW, &
- PFUDG, KDLON, KFLEV, KRAD_DIAG, KFLUX, KRAD, KAER, KSWB_OLD, &
- KSWB_MNH,KLWB_MNH, KSTATM,KRAD_COLNBR,PCOSZEN,PSEA, PCORSOL, &
- PDIR_ALB, PSCA_ALB,PEMIS, PCLDFR, PCCO2, PTSRAD, PSTATM, &
- PTHT, PRT, PPABST, POZON, PAER, PDST_WL, PAER_CLIM, PSVT, &
- PDTHRAD, PSRFLWD, PSRFSWD_DIR,PSRFSWD_DIF, PRHODREF, PZZ, &
- PRADEFF, PSWU, PSWD, PLWU,PLWD, PDTHRADSW, PDTHRADLW )
-! ############################################################################
-!
-!!**** *RADIATIONS * - routine to call the SW and LW radiation calculations
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to prepare the temperature, water vapor
-!! liquid water, cloud fraction, ozone profiles for the ECMWF radiation
-!! calculations. There is a great number of available radiative fluxes in
-!! the output, but only the potential temperature radiative tendency and the
-!! SW and LW surface fluxes are provided in the output of the routine.
-!! Two simplified computations are available (switches OCLEAR_SKY and
-!! OCLOUD_ONLY). When OCLOUD_ONLY is .TRUE. the computations are performed
-!! for the cloudy columns only. Furthermore with OCLEAR_SKY being .TRUE.
-!! the clear sky columns are averaged and the computations are made for
-!! the cloudy columns plus a single ensemble-mean clear sky column.
-!!
-!!** METHOD
-!! ------
-!! First the temperature, water vapor, liquid water, cloud fraction
-!! and profile arrays are built using the current model fields and
-!! the standard atmosphere for the upper layer filling.
-!! The standard atmosphere is used between the levels IKUP and
-!! KFLEV where KFLEV is the number of vertical levels for the radiation
-!! computations.
-!! The aerosols optical thickness and the ozone fields come directly
-!! from ini_radiation step (climatlogies used) and are already defined for KFLEV.
-!! Surface parameter ( albedo, emiss ) are also defined from current surface fields.
-!! In the case of clear-sky or cloud-only approximations, the cloudy
-!! columns are selected by testing the vertically integrated cloud fraction
-!! and the radiation computations are performed for these columns plus the
-!! mean clear-sky one. In addition, columns where cloud have disapeared are determined
-!! by saving cloud trace between radiation step and they are also recalculated
-!! in cloud only step. In all case, the sun position correponds to the centered
-!! time between 2 full radiation steps (determined in physparam).
-!! Then the ECMWF radiation package is called and the radiative
-!! heating/cooling tendancies are reformatted in case of partial
-!! computations. In case of "cloud-only approximation" the only cloudy
-!! column radiative fields are updated.
-!!
-!! EXTERNAL
-!! --------
-!! Subroutine ECMWF_RADIATION_VERS2 : ECMWF interface calling radiation routines
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CST : constants
-!! XP00 : reference pressure
-!! XCPD : calorific capacity of dry air at constant pressure
-!! XRD : gas constant for dry air
-!! Module MODD_PARAMETERS : parameters
-!! JPHEXT : Extra columns on the horizontal boundaries
-!! JPVEXT : Extra levels on the vertical boundaries
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of documentation ( routine RADIATIONS )
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 26/02/95
-!! J.Stein 20/12/95 add the array splitting in order to save memory
-!! J.-P. Pinty 19/11/96 change the split arrays, specific humidity
-!! and add the ice phase
-!! J.Stein 22/06/97 use of the absolute pressure
-!! P.Jabouille 31/07/97 impose a zero humidity for dry simulation
-!! V.Masson 22/09/97 case of clear-sky approx. with no clear-sky column
-!! V.Masson 07/11/97 half level pressure defined from averaged Exner
-!! function
-!! V.Masson 07/11/97 modification of junction between standard atm
-!! and model for half level variables (top model
-!! pressure and temperatures are used preferentially
-!! to atm standard profile for the first point).
-!! P.Jabouille 24/08/98 impose positivity for ZQLAVE
-!! J.-P. Pinty 29/01/98 add storage for diagnostics
-!! J. Stein 18/07/99 add the ORAD_DIAG switch and keep inside the
-!! subroutine the partial tendencies
-!!
-!! F.Solmon 04/03/01 MAJOR MODIFICATIONS, updated version of ECMWF radiation scheme
-!! P.Jabouille 05/05/03 bug in humidity conversion
-!! Y.Seity 25/08/03 KSWB=6 for SW direct and scattered surface
-!! downward fluxes used in surface scheme.
-!! P. Tulet 01/20/05 climatologic SSA
-!! A. Grini 05/20/05 dust direct effect (optical properties)
-!! V.Masson, C.Lac 08/10 Correction of inversion of Diffuse and direct albedo
-!! B.Aouizerats 2010 Explicit aerosol optical properties
-!! C.Lac 11/2015 Correction on aerosols
-!! B.Vie /13 LIMA
-!! J.Escobar 30/03/2017 : Management of compilation of ECMWF_RAD in REAL*8 with MNH_REAL=R4
-!! J.Escobar 29/06/2017 : Check if Pressure Decreasing with height <-> elsif PB & STOP
-!! Q.LIBOIS 06/2017 : correction on CLOUD_ONLY
-!! Q.Libois 02/2018 : ECRAD
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! J.Escobar 28/06/2018 : Reproductible parallelisation of CLOUD_ONLY case
-!! J.Escobar 20/07/2018 : for real*4 compilation, convert with REAL(X) argument to SUM_DD...
-!! P.Wautelet 22/01/2019: use standard FLUSH statement instead of non standard intrinsics
-!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-! P. Wautelet 06/09/2022: small fix: GSURF_CLOUD was not set outside of physical domain
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE PARKIND1, ONLY: JPRB
-USE OYOESW , ONLY : RTAUA ,RPIZA ,RCGA
-!
-USE MODD_CH_AEROSOL, ONLY: LORILAM
-USE MODD_CONF, ONLY: LCARTESIAN
-USE MODD_CST
-USE MODD_DUST, ONLY: LDUST
-use modd_field, only: tfieldmetadata, TYPEREAL
-USE MODD_GRID , ONLY: XLAT0, XLON0
-USE MODD_GRID_n , ONLY: XLAT, XLON
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_NSV, ONLY: NSV_C2R2,NSV_C2R2BEG,NSV_C2R2END, &
- NSV_C1R3,NSV_C1R3BEG,NSV_C1R3END, &
- NSV_DSTBEG, NSV_DSTEND, &
- NSV_AERBEG, NSV_AEREND, &
- NSV_SLTBEG, NSV_SLTEND, &
- NSV_LIMA,NSV_LIMA_BEG,NSV_LIMA_END, &
- NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_NI
-USE MODD_PARAMETERS
-USE MODD_PARAM_LIMA
-USE MODD_PARAM_n, ONLY: CCLOUD, CRAD
-USE MODD_PARAM_RAD_n, ONLY: CAOP
-USE MODD_RAIN_ICE_DESCR
-USE MODD_SALT, ONLY: LSALT
-USE MODD_TIME
-!
-USE MODE_DUSTOPT
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODE_ll
-use mode_msg
-USE MODE_REPRO_SUM, ONLY : SUM_DD_R2_R1_ll,SUM_DD_R1_ll
-!
-#ifdef MNH_PGI
-USE MODE_PACK_PGI
-#endif
-USE MODE_SALTOPT
-USE MODE_SUM_ll, ONLY: MIN_ll
-USE MODE_SUM2_ll, ONLY: GMINLOC_ll
-USE MODE_THERMO
-!
-USE MODI_AEROOPT_GET
-USE MODI_ECMWF_RADIATION_VERS2
-USE MODI_ECRAD_INTERFACE
-USE MODD_VAR_ll, ONLY: IP
-!
-IMPLICIT NONE
-!
-!* 0.1 DECLARATIONS OF DUMMY ARGUMENTS :
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-LOGICAL, INTENT(IN) :: OCLOUD_ONLY! flag for the cloud column
- ! computations only
-LOGICAL, INTENT(IN) :: OCLEAR_SKY !
-INTEGER, INTENT(IN) :: KDLON ! number of columns where the
- ! radiation calculations are
- ! performed
-INTEGER, INTENT(IN) :: KFLEV ! number of vertical levels
- ! where the radiation
- ! calculations are performed
-INTEGER, INTENT(IN) :: KRAD_DIAG ! index for the number of
- ! fields in the output
-INTEGER, INTENT(IN) :: KFLUX ! number of top and ground
- ! fluxes for the ZFLUX array
-INTEGER, INTENT(IN) :: KRAD ! number of satellite radiances
- ! for the ZRAD and ZRADCS arrays
-INTEGER, INTENT(IN) :: KAER ! number of AERosol classes
-
-INTEGER, INTENT(IN) :: KSWB_OLD ! number of SW band ECMWF
-INTEGER, INTENT(IN) :: KSWB_MNH ! number of SW band ECRAD
-INTEGER, INTENT(IN) :: KLWB_MNH ! number of LW band ECRAD
-INTEGER, INTENT(IN) :: KSTATM ! index of the standard
- ! atmosphere level just above
- ! the model top
-INTEGER, INTENT(IN) :: KRAD_COLNBR ! factor by which the memory
- ! is split
- !
- !Choice of :
-CHARACTER (LEN=*), INTENT (IN) :: HEFRADL !
-CHARACTER (LEN=*), INTENT (IN) :: HEFRADI !
-CHARACTER (LEN=*), INTENT (IN) :: HOPWSW !cloud water SW optical properties
-CHARACTER (LEN=*), INTENT (IN) :: HOPISW !ice water SW optical properties
-CHARACTER (LEN=*), INTENT (IN) :: HOPWLW !cloud water LW optical properties
-CHARACTER (LEN=*), INTENT (IN) :: HOPILW !ice water LW optical properties
-REAL, INTENT(IN) :: PFUDG ! subgrid cloud inhomogenity factor
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOSZEN ! COS(zenithal solar angle)
-REAL, INTENT(IN) :: PCORSOL ! SOLar constant CORrection
-REAL, DIMENSION(:,:), INTENT(IN) :: PSEA ! Land-sea mask
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDIR_ALB! Surface direct ALBedo
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSCA_ALB! Surface diffuse ALBedo
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMIS ! Surface IR EMISsivity
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! CLouD FRaction
-REAL, INTENT(IN) :: PCCO2 ! CO2 content
-REAL, DIMENSION(:,:), INTENT(IN) :: PTSRAD ! RADiative Surface Temperature
-REAL, DIMENSION(:,:), INTENT(IN) :: PSTATM ! selected standard atmosphere
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! THeta at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! moist variables at t (humidity, cloud water, rain water, ice water)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! pressure at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! scalar variable ( C2R2 and C1R3 particle)
-!
-REAL, DIMENSION(:,:,:), POINTER :: POZON ! OZONE field from clim.
-REAL, DIMENSION(:,:,:,:), POINTER :: PAER ! AERosols optical thickness from clim.
-REAL, DIMENSION(:,:,:,:), POINTER :: PDST_WL ! AERosols Extinction by wavelength .
-REAL, DIMENSION(:,:,:,:), POINTER :: PAER_CLIM ! AERosols optical thickness from clim.
- ! note : the vertical dimension of
- ! these fields include the "radiation levels"
- ! above domain top
- !
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ![kg/m3] air density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ![m] height of layers
-
-INTEGER, DIMENSION(:,:), INTENT(INOUT) :: KCLEARCOL_TM1 ! trace of cloud/clear col
- ! at the previous radiation step
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDTHRAD ! THeta RADiative Tendancy
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSRFLWD ! Downward SuRFace LW Flux
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRFSWD_DIR ! Downward SuRFace SW Flux DIRect
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRFSWD_DIF ! Downward SuRFace SW Flux DIFfuse
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSWU ! upward SW Flux
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSWD ! downward SW Flux
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLWU ! upward LW Flux
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLWD ! downward LW Flux
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDTHRADSW ! dthrad sw
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDTHRADLW ! dthradsw
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRADEFF ! effective radius
-!
-!
-!* 0.2 DECLARATIONS OF LOCAL VARIABLES
-!
-LOGICAL :: GNOCL ! .TRUE. when no cloud is present
- ! with OCLEAR_SKY .TRUE.
-LOGICAL :: GAOP ! .TRUE. when CAOP='EXPL'
-LOGICAL, DIMENSION(KDLON,KFLEV) :: GCLOUD ! .TRUE. for the cloudy columns
-LOGICAL, DIMENSION(KFLEV,KDLON) :: GCLOUDT ! transpose of the GCLOUD array
-LOGICAL, DIMENSION(KDLON) :: GCLEAR_2D ! .TRUE. for the clear-sky columns
-LOGICAL, DIMENSION(KDLON,KFLEV) :: GCLEAR ! .TRUE. for all the levels of the
- ! clear-sky columns
-LOGICAL, DIMENSION(KDLON,KSWB_MNH) :: GCLEAR_SWB! .TRUE. for all the bands of the
- ! clear-sky columns
-INTEGER, DIMENSION(:), ALLOCATABLE :: ICLEAR_2D_TM1 !
-!
-INTEGER :: JI,JJ,JK,JK1,JK2,JKRAD,JALBS! loop indices
-!
-INTEGER :: IIB ! I index value of the first inner mass point
-INTEGER :: IJB ! J index value of the first inner mass point
-INTEGER :: IKB ! K index value of the first inner mass point
-INTEGER :: IIE ! I index value of the last inner mass point
-INTEGER :: IJE ! J index value of the last inner mass point
-INTEGER :: IKE ! K index value of the last inner mass point
-INTEGER :: IKU ! array size for the third index
-INTEGER :: IIJ ! reformatted array index
-INTEGER :: IKSTAE ! level number of the STAndard atmosphere array
-INTEGER :: IKUP ! vertical level above which STAndard atmosphere data
- ! are filled in
-!
-INTEGER :: ICLEAR_COL ! number of clear-sky columns
-INTEGER :: ICLOUD_COL ! number of cloudy columns
-INTEGER :: ICLOUD ! number of levels corresponding of the cloudy columns
-INTEGER :: IDIM ! effective number of columns for which the radiation
- ! code is run
-INTEGER :: INIR ! index corresponding to NIR fisrt band (in SW)
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZTAVE ! mean-layer temperature
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZTAVE_RAD ! mean-layer temperature
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZPAVE ! mean-layer pressure
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZPAVE_RAD ! mean-layer pressure
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQSAVE ! saturation specific humidity
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQVAVE ! mean-layer specific humidity
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQLAVE ! Liquid water KG/KG
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQRAVE ! Rain water KG/KG
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQIAVE ! Ice water Kg/KG
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQLWC ! liquid water content kg/m3
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQRWC ! Rain water content kg/m3
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQIWC ! ice water content kg/m3
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCFAVE ! mean-layer cloud fraction
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZO3AVE ! mean-layer ozone content
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZPRES_HL ! half-level pressure
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZT_HL ! half-level temperature
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZDPRES ! layer pressure thickness
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCCT_C2R2! Cloud water Concentarion (C2R2)
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCRT_C2R2! Rain water Concentarion (C2R2)
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCIT_C1R3! Ice water Concentarion (C2R2)
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCCT_LIMA! Cloud water Concentration(LIMA)
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCRT_LIMA! Rain water Concentration(LIMA)
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCIT_LIMA! Ice water Concentration(LIMA)
-REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZAER ! aerosol optical thickness
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZALBP ! spectral surface albedo for direct radiations
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZALBD ! spectral surface albedo for diffuse radiations
-REAL(KIND=JPRB), DIMENSION (:,:), ALLOCATABLE :: ZEMIS ! surface LW emissivity
-REAL(KIND=JPRB), DIMENSION (:,:), ALLOCATABLE :: ZEMIW ! surface LW WINDOW emissivity
-REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZTS ! reformatted surface PTSRAD array
-REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZLSM ! reformatted land sea mask
-REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZRMU0 ! Reformatted ZMU0 array
-REAL(KIND=JPRB) :: ZRII0 ! corrected solar constant
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTLW ! LW temperature tendency
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTSW ! SW temperature tendency
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFLW_CS ! CLEAR-SKY LW NET FLUXES
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFLW ! TOTAL LW NET FLUXES
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFSW_CS ! CLEAR-SKY SW NET FLUXES
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFSW ! TOTAL SW NET FLUXES
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_TOP_GND_IRVISNIR ! Top and
- ! Ground radiative FLUXes
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_DOWN ! DowNward SW Flux profiles
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_UP ! UPward SW Flux profiles
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFLUX_LW ! LW Flux profiles
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTLW_CS ! LW Clear-Sky temp. tendency
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTSW_CS ! SW Clear-Sky temp. tendency
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_TOP_GND_IRVISNIR_CS ! Top and
- ! Ground Clear-Sky radiative FLUXes
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFSWDIR !surface SW direct flux
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFSWDIF !surface SW diffuse flux
-
-REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_ALB_VIS, ZPLAN_ALB_NIR
- ! PLANetary ALBedo in VISible, Near-InfraRed regions
-REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_TRA_VIS, ZPLAN_TRA_NIR
- ! PLANetary TRANsmission in VISible, Near-InfraRed regions
-REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_ABS_VIS, ZPLAN_ABS_NIR
- ! PLANetary ABSorption in VISible, Near-InfraRed regions
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZEFCL_LWD, ZEFCL_LWU
- ! EFective DOWNward and UPward LW nebulosity (equivalent emissivities)
- ! undefined if RRTM is used for LW
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLWP, ZFIWP
- ! Liquid and Ice Water Path
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZRADLP, ZRADIP
- ! Cloud liquid water and ice effective radius
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZEFCL_RRTM, ZCLSW_TOTAL
- ! effective LW nebulosity ( RRTM case)
- ! and SW CLoud fraction for mixed phase clouds
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTAU_TOTAL, ZOMEGA_TOTAL, ZCG_TOTAL
- ! effective optical thickness, single scattering albedo
- ! and asymetry factor for mixed phase clouds
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_DOWN_CS, ZFLUX_SW_UP_CS
- ! Clear-Sky DowNward and UPward SW Flux profiles
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFLUX_LW_CS
- ! Thicknes of the mesh
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZDZ
-!
-REAL, DIMENSION(KDLON,KFLEV) :: ZZDTSW ! SW diabatic heating
-REAL, DIMENSION(KDLON,KFLEV) :: ZZDTLW ! LW diabatic heating
-REAL, DIMENSION(KDLON) :: ZZTGVIS! SW surface flux in the VIS band
-REAL, DIMENSION(KDLON) :: ZZTGNIR! SW surface flux in the NIR band
-REAL, DIMENSION(KDLON) :: ZZTGIR ! LW surface flux in the IR bands
-REAL, DIMENSION(KDLON,SIZE(PSRFSWD_DIR,3)) :: ZZSFSWDIR
-! ! SW direct surface flux
-REAL, DIMENSION(KDLON,SIZE(PSRFSWD_DIR,3)) :: ZZSFSWDIF
-! ! SW diffuse surface flux
-!
-REAL, DIMENSION(KDLON) :: ZCLOUD ! vertically summed cloud fraction
-!
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZEXNT ! Exner function
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2)) :: ZLWD ! surface Downward LW flux
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PSRFSWD_DIR,3)) :: ZSWDDIR ! surface
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PSRFSWD_DIR,3)) :: ZSWDDIF ! surface Downward SW diffuse flux
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3),KSWB_OLD) :: ZPIZAZ ! Aerosols SSA
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3),KSWB_OLD) :: ZTAUAZ ! Aerosols Optical Detph
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3),KSWB_OLD) :: ZCGAZ ! Aerosols Asymetric factor
-REAL :: ZZTGVISC ! downward surface SW flux (VIS band) for clear_sky
-REAL :: ZZTGNIRC ! downward surface SW flux (NIR band) for clear_sky
-REAL :: ZZTGIRC ! downward surface LW flux for clear_sky
-REAL, DIMENSION(SIZE(PSRFSWD_DIR,3)) :: ZZSFSWDIRC
-! ! downward surface SW direct flux for clear sky
-REAL, DIMENSION(SIZE(PSRFSWD_DIR,3)) :: ZZSFSWDIFC
-! ! downward surface SW diffuse flux for clear sky
-REAL, DIMENSION(KFLEV) :: ZT_CLEAR ! ensemble mean clear-sky temperature
-REAL, DIMENSION(KFLEV) :: ZP_CLEAR ! ensemble mean clear-sky temperature
-REAL, DIMENSION(KFLEV) :: ZQV_CLEAR ! ensemble mean clear-sky specific humidity
-REAL, DIMENSION(KFLEV) :: ZOZ_CLEAR ! ensemble mean clear-sky ozone
-REAL, DIMENSION(KFLEV) :: ZHP_CLEAR ! ensemble mean clear-sky half-lev. pression
-REAL, DIMENSION(KFLEV) :: ZHT_CLEAR ! ensemble mean clear-sky half-lev. temp.
-REAL, DIMENSION(KFLEV) :: ZDP_CLEAR ! ensemble mean clear-sky pressure thickness
-REAL, DIMENSION(KFLEV,KAER) :: ZAER_CLEAR ! ensemble mean clear-sky aerosols optical thickness
-REAL, DIMENSION(KSWB_MNH) :: ZALBP_CLEAR ! ensemble mean clear-sky surface albedo (parallel)
-REAL, DIMENSION(KSWB_MNH) :: ZALBD_CLEAR ! ensemble mean clear-sky surface albedo (diffuse)
-REAL :: ZEMIS_CLEAR ! ensemble mean clear-sky surface emissivity
-REAL :: ZEMIW_CLEAR ! ensemble mean clear-sky LW window
-REAL :: ZRMU0_CLEAR ! ensemble mean clear-sky MU0
-REAL :: ZTS_CLEAR ! ensemble mean clear-sky surface temperature.
-REAL :: ZLSM_CLEAR ! ensemble mean clear-sky land sea-mask
-REAL :: ZLAT_CLEAR,ZLON_CLEAR
-!
-!work arrays
-REAL, DIMENSION(:), ALLOCATABLE :: ZWORK1, ZWORK2, ZWORK3, ZWORK
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK4, ZWORK1AER, ZWORK2AER, ZWORK_GRID
-LOGICAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2)) :: ZWORKL
-!
-! split arrays used to split the memory required by the ECMWF_radiation
-! subroutine, the fields have the same meaning as their complete counterpart
-!
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZALBP_SPLIT, ZALBD_SPLIT
-REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZEMIS_SPLIT, ZEMIW_SPLIT
-REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZRMU0_SPLIT
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCFAVE_SPLIT
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZO3AVE_SPLIT
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZT_HL_SPLIT
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZPRES_HL_SPLIT
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZTAVE_SPLIT
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZPAVE_SPLIT
-REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZAER_SPLIT
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZDPRES_SPLIT
-REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZLSM_SPLIT
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQVAVE_SPLIT
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQSAVE_SPLIT
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQLAVE_SPLIT
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQIAVE_SPLIT
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQRAVE_SPLIT
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQRWC_SPLIT
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQLWC_SPLIT
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZQIWC_SPLIT
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZDZ_SPLIT
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCCT_C2R2_SPLIT
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCRT_C2R2_SPLIT
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCIT_C1R3_SPLIT
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCCT_LIMA_SPLIT
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCRT_LIMA_SPLIT
-REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZCIT_LIMA_SPLIT
-REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZTS_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFSWDIR_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFSWDIF_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFLW_CS_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFLW_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFSW_CS_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFSW_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTLW_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTSW_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_TOP_GND_IRVISNIR_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_DOWN_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_UP_SPLIT
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFLUX_LW_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTLW_CS_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTSW_CS_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT
-REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_ALB_VIS_SPLIT
-REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_ALB_NIR_SPLIT
-REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_TRA_VIS_SPLIT
-REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_TRA_NIR_SPLIT
-REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_ABS_VIS_SPLIT
-REAL, DIMENSION(:), ALLOCATABLE :: ZPLAN_ABS_NIR_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZEFCL_LWD_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZEFCL_LWU_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLWP_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZFIWP_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZRADLP_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZRADIP_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZEFCL_RRTM_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZCLSW_TOTAL_SPLIT
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTAU_TOTAL_SPLIT
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZOMEGA_TOTAL_SPLIT
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCG_TOTAL_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_DOWN_CS_SPLIT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_SW_UP_CS_SPLIT
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFLUX_LW_CS_SPLIT
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZPIZA_EQ_TMP !Single scattering albedo of aerosols (lon,lat,lev,wvl)
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZIR !Real part of the aerosol refractive index(lon,lat,lev,wvl)
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZII !Imaginary part of the aerosol refractive index (lon,lat,lev,wvl)
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCGA_EQ_TMP !Assymetry factor aerosols (lon,lat,lev,wvl)
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTAUREL_EQ_TMP !tau/tau_{550} aerosols (lon,lat,lev,wvl)
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZPIZA_DST_TMP !Single scattering albedo of dust (lon,lat,lev,wvl)
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCGA_DST_TMP !Assymetry factor dust (lon,lat,lev,wvl)
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTAUREL_DST_TMP !tau/tau_{550} dust (lon,lat,lev,wvl)
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZPIZA_AER_TMP !Single scattering albedo of aerosol from ORILAM (lon,lat,lev,wvl)
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCGA_AER_TMP !Assymetry factor aerosol from ORILAM (lon,lat,lev,wvl)
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTAUREL_AER_TMP !tau/tau_{550} aerosol from ORILAM (lon,lat,lev,wvl)
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZPIZA_SLT_TMP !Single scattering albedo of sea salt (lon,lat,lev,wvl)
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCGA_SLT_TMP !Assymetry factor of sea salt (lon,lat,lev,wvl)
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTAUREL_SLT_TMP !tau/tau_{550} of sea salt (lon,lat,lev,wvl)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: PAER_AER !tau/tau_{550} aerosol from ORILAM (lon,lat,lev,wvl)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: PAER_SLT !tau/tau_{550} sea salt (lon,lat,lev,wvl)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: PAER_DST !tau/tau_{550} dust (lon,lat,lev,wvl)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTAU550_EQ_TMP !tau/tau_{550} aerosols (lon,lat,lev,wvl)
-REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZPIZA_EQ !Single scattering albedo of aerosols (points,lev,wvl)
-REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZCGA_EQ !Assymetry factor aerosols (points,lev,wvl)
-REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZTAUREL_EQ !tau/tau_{550} aerosols (points,lev,wvl)
-REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZPIZA_EQ_SPLIT !Single scattering albedo of aerosols (points,lev,wvl)
-REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZCGA_EQ_SPLIT !Assymetry factor aerosols (points,lev,wvl)
-REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE :: ZTAUREL_EQ_SPLIT !tau/tau_{550} aerosols (points,lev,wvl)
-REAL, DIMENSION(KFLEV,KSWB_OLD) :: ZPIZA_EQ_CLEAR !Single scattering albedo of aerosols (lev,wvl)
-REAL, DIMENSION(KFLEV,KSWB_OLD) :: ZCGA_EQ_CLEAR !Assymetry factor aerosols (lev,wvl)
-REAL, DIMENSION(KFLEV,KSWB_OLD) :: ZTAUREL_EQ_CLEAR !tau/tau_{550} aerosols (lev,wvl)
-INTEGER :: WVL_IDX !Counter for wavelength
-
-!
-INTEGER :: JI_SPLIT ! loop on the split array
-INTEGER :: INUM_CALL ! number of CALL of the radiation scheme
-INTEGER :: IDIM_EFF ! effective number of air-columns to compute
-INTEGER :: IDIM_RESIDUE ! number of remaining air-columns to compute
-INTEGER :: IBEG, IEND ! auxiliary indices
-!
-!
-REAL, DIMENSION(SIZE(PDTHRAD,1),SIZE(PDTHRAD,2),SIZE(PDTHRAD,3)) &
- :: ZDTRAD_LW! LW temperature tendency
-REAL, DIMENSION(SIZE(PDTHRAD,1),SIZE(PDTHRAD,2),SIZE(PDTHRAD,3)) &
- :: ZDTRAD_SW! SW temperature tendency
-INTEGER :: ILUOUT ! Logical unit number for output-listing
-INTEGER :: IRESP ! Return code of FM routines
-REAL, DIMENSION(SIZE(PDTHRAD,1),SIZE(PDTHRAD,2),SIZE(PDTHRAD,3)) &
- :: ZSTORE_3D, ZSTORE_3D2! 3D work array for storage
-REAL, DIMENSION(SIZE(PDTHRAD,1),SIZE(PDTHRAD,2)) &
- :: ZSTORE_2D ! 2D work array for storage!
-INTEGER :: JBAND ! Solar band index
-CHARACTER (LEN=4), DIMENSION(KSWB_OLD) :: YBAND_NAME ! Solar band name
-CHARACTER (LEN=2) :: YDIR ! Type of the data field
-!
-INTEGER :: ISWB ! number of SW spectral bands (between radiations and surface schemes)
-INTEGER :: JSWB ! loop on SW spectral bands
-INTEGER :: JAE ! loop on aerosol class
-TYPE(TFIELDMeTaDATA) :: TZFIELD2D, TZFIELD3D
-!
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZDZPABST
-REAL :: ZMINVAL
-INTEGER, DIMENSION(3) :: IMINLOC
-INTEGER :: IINFO_ll
-LOGICAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2)) :: GCLOUD_SURF
-!
-REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZLON,ZLAT
-REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE :: ZLON_SPLIT,ZLAT_SPLIT
-!
-INTEGER :: ICLEAR_COL_ll
-INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX_ICLEAR_COL
-REAL, DIMENSION(KFLEV) :: ZT_CLEAR_DD ! ensemble mean clear-sky temperature
-REAL :: ZCLEAR_COL_ll , ZDLON_ll
-!-------------------------------------------------------------------------
-!-------------------------------------------------------------------------
-!-------------------------------------------------------------------------
-!
-!* 1. COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES
-! ----------------------------------------------
-!
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE) ! this definition must be coherent with
- ! the one used in ini_radiations routine
-IKU = SIZE(PTHT,3)
-IKB = 1 + JPVEXT
-IKE = IKU - JPVEXT
-!
-IKSTAE = SIZE(PSTATM,1)
-IKUP = IKE-JPVEXT+1
-!
-ISWB = SIZE(PSRFSWD_DIR,3)
-!
-!-------------------------------------------------------------------------------
-!* 1.1 CHECK PRESSURE DECREASING
-! -------------------------
-ZDZPABST(:,:,1:IKU-1) = PPABST(:,:,1:IKU-1) - PPABST(:,:,2:IKU)
-ZDZPABST(:,:,IKU) = ZDZPABST(:,:,IKU-1)
-!
-ZMINVAL=MIN_ll(ZDZPABST,IINFO_ll)
-!
-IF ( ZMINVAL <= 0.0 ) THEN
- ILUOUT = TLUOUT%NLU
- IMINLOC=GMINLOC_ll( ZDZPABST )
- WRITE(ILUOUT,*) ' radiation.f90 STOP :: SOMETHING WRONG WITH PRESSURE , ZDZPABST <= 0.0 '
- WRITE(ILUOUT,*) ' radiation :: ZDZPABST ', ZMINVAL,' located at ', IMINLOC
- FLUSH(unit=ILUOUT)
- call Print_msg( NVERB_FATAL, 'GEN', 'RADIATIONS', 'something wrong with pressure: ZDZPABST <= 0.0' )
-
-ENDIF
-!------------------------------------------------------------------------------
-ALLOCATE(ZLAT(KDLON))
-ALLOCATE(ZLON(KDLON))
-IF(LCARTESIAN) THEN
- ZLAT(:) = XLAT0*(XPI/180.)
- ZLON(:) = XLON0*(XPI/180.)
-ELSE
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZLAT(IIJ) = XLAT(JI,JJ)*(XPI/180.)
- ZLON(IIJ) = XLON(JI,JJ)*(XPI/180.)
- END DO
- END DO
-END IF
-!-------------------------------------------------------------------------------
-!
-!* 2. INITIALIZES THE MEAN-LAYER VARIABLES
-! ------------------------------------
-!
-ZEXNT(:,:,:)= ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
-!
-! Columns where radiation is computed are put on a single line
-ALLOCATE(ZTAVE(KDLON,KFLEV))
-ALLOCATE(ZQVAVE(KDLON,KFLEV))
-ALLOCATE(ZQLAVE(KDLON,KFLEV))
-ALLOCATE(ZQIAVE(KDLON,KFLEV))
-ALLOCATE(ZCFAVE(KDLON,KFLEV))
-ALLOCATE(ZQRAVE(KDLON,KFLEV))
-ALLOCATE(ZQLWC(KDLON,KFLEV))
-ALLOCATE(ZQIWC(KDLON,KFLEV))
-ALLOCATE(ZQRWC(KDLON,KFLEV))
-ALLOCATE(ZDZ(KDLON,KFLEV))
-!
-ZQVAVE(:,:) = 0.0
-ZQLAVE(:,:) = 0.0
-ZQIAVE(:,:) = 0.0
-ZQRAVE(:,:) = 0.0
-ZCFAVE(:,:) = 0.0
-ZQLWC(:,:) = 0.0
-ZQIWC(:,:) = 0.0
-ZQRWC(:,:) = 0.0
-ZDZ(:,:)=0.0
-!
-!COMPUTE THE MESH SIZE
-DO JK=IKB,IKE
- JKRAD = JK-JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZDZ(IIJ,JKRAD) = PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK)
- ZTAVE(IIJ,JKRAD) = PTHT(JI,JJ,JK)*ZEXNT(JI,JJ,JK) ! Conversion potential temperature -> actual temperature
- END DO
- END DO
-END DO
-!
-! Check if the humidity mixing ratio is available
-!
-IF( SIZE(PRT(:,:,:,:),4) >= 1 ) THEN
- DO JK=IKB,IKE
- JKRAD = JK-JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZQVAVE(IIJ,JKRAD) =MAX(0., PRT(JI,JJ,JK,1))
- END DO
- END DO
- END DO
-END IF
-!
-! Check if the cloudwater mixing ratio is available
-!
-IF( SIZE(PRT(:,:,:,:),4) >= 2 ) THEN
- DO JK=IKB,IKE
- JKRAD = JK-JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZQLAVE(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,2))
- ZQLWC(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,2)*PRHODREF(JI,JJ,JK))
- ZCFAVE(IIJ,JKRAD) = PCLDFR(JI,JJ,JK)
- END DO
- END DO
- END DO
-END IF
-!
-! Check if the rainwater mixing ratio is available
-!
-IF( SIZE(PRT(:,:,:,:),4) >= 3 ) THEN
- DO JK=IKB,IKE
- JKRAD = JK-JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZQRWC(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,3)*PRHODREF(JI,JJ,JK))
- ZQRAVE(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,3))
- END DO
- END DO
- END DO
-END IF
-!
-! Check if the cloudice mixing ratio is available
-!
-IF( SIZE(PRT(:,:,:,:),4) >= 4 ) THEN
- DO JK=IKB,IKE
- JKRAD = JK-JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZQIWC(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,4)*PRHODREF(JI,JJ,JK))
-! ZQIAVE(IIJ,JKRAD) = MAX( PRT(JI,JJ,JK,4)-XRTMIN(4),0.0 )
- ZQIAVE(IIJ,JKRAD) = MAX( PRT(JI,JJ,JK,4),0.0 )
- END DO
- END DO
- END DO
-END IF
-!
-! Standard atmosphere extension
-!
-DO JK=IKUP,KFLEV
- JK1 = (KSTATM-1)+(JK-IKUP)
- JK2 = JK1+1
- ZTAVE(:,JK) = 0.5*( PSTATM(JK1,3)+PSTATM(JK2,3) )
- ZQVAVE(:,JK) = 0.5*( PSTATM(JK1,5)/PSTATM(JK1,4)+ &
- PSTATM(JK2,5)/PSTATM(JK2,4) )
-END DO
-!
-! 2.1 pronostic water concentation fields (C2R2 coupling)
-!
-IF( NSV_C2R2 /= 0 ) THEN
- ALLOCATE (ZCCT_C2R2(KDLON, KFLEV))
- ALLOCATE (ZCRT_C2R2(KDLON, KFLEV))
- ZCCT_C2R2(:, :) = 0.
- ZCRT_C2R2 (:,:) = 0.
- DO JK=IKB,IKE
- JKRAD = JK-JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZCCT_C2R2 (IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_C2R2BEG+1))
- ZCRT_C2R2 (IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_C2R2BEG+2))
- END DO
- END DO
- END DO
-ELSE
- ALLOCATE (ZCCT_C2R2(0,0))
- ALLOCATE (ZCRT_C2R2(0,0))
-END IF
-!
-IF( NSV_C1R3 /= 0 ) THEN
- ALLOCATE (ZCIT_C1R3(KDLON, KFLEV))
- ZCIT_C1R3 (:,:) = 0.
- DO JK=IKB,IKE
- JKRAD = JK-JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZCIT_C1R3 (IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_C1R3BEG))
- END DO
- END DO
- END DO
-ELSE
- ALLOCATE (ZCIT_C1R3(0,0))
-END IF
-!
-!
-! 2.1*bis pronostic water concentation fields (LIMA coupling)
-!
-IF( CCLOUD == 'LIMA' ) THEN
- ALLOCATE (ZCCT_LIMA(KDLON, KFLEV))
- ALLOCATE (ZCRT_LIMA(KDLON, KFLEV))
- ALLOCATE (ZCIT_LIMA(KDLON, KFLEV))
- ZCCT_LIMA(:, :) = 0.
- ZCRT_LIMA (:,:) = 0.
- ZCIT_LIMA (:,:) = 0.
- DO JK=IKB,IKE
- JKRAD = JK-JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- IF (NMOM_C.GE.2) ZCCT_LIMA(IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_LIMA_NC))
- IF (NMOM_R.GE.2) ZCRT_LIMA(IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_LIMA_NR))
- IF (NMOM_I.GE.2) ZCIT_LIMA(IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_LIMA_NI))
- END DO
- END DO
- END DO
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. INITIALIZES THE HALF-LEVEL VARIABLES
-! ------------------------------------
-!
-ALLOCATE(ZPRES_HL(KDLON,KFLEV+1))
-ALLOCATE(ZT_HL(KDLON,KFLEV+1))
-!
-DO JK=IKB,IKE+1
- JKRAD = JK-JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZPRES_HL(IIJ,JKRAD) = XP00 * (0.5*(ZEXNT(JI,JJ,JK)+ZEXNT(JI,JJ,JK-1)))**(XCPD/XRD)
- END DO
- END DO
-END DO
-
-! Standard atmosphere extension - pressure
-!* begining at ikup+1 level allows to use a model domain higher than 50km
-!
-DO JK=IKUP+1,KFLEV+1
- JK1 = (KSTATM-1)+(JK-IKUP)
- ZPRES_HL(:,JK) = PSTATM(JK1,2)*100.0 ! mb -> Pa
-END DO
-!
-! Surface temperature at the first level
-! and surface radiative temperature
-ALLOCATE(ZTS(KDLON))
-!
-DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZT_HL(IIJ,1) = PTSRAD(JI,JJ)
- ZTS(IIJ) = PTSRAD(JI,JJ)
- END DO
-END DO
-!
-! Temperature at half levels
-!
-ZT_HL(:,2:IKE-JPVEXT) = 0.5*(ZTAVE(:,1:IKE-JPVEXT-1)+ZTAVE(:,2:IKE-JPVEXT))
-!
-DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZT_HL(IIJ,IKE-JPVEXT+1) = 0.5*PTHT(JI,JJ,IKE )*ZEXNT(JI,JJ,IKE ) &
- + 0.5*PTHT(JI,JJ,IKE+1)*ZEXNT(JI,JJ,IKE+1)
- END DO
-END DO
-!
-! Standard atmosphere extension - temperature
-!* begining at ikup+1 level allows to use a model domain higher than 50km
-!
-DO JK=IKUP+1,KFLEV+1
- JK1 = (KSTATM-1)+(JK-IKUP)
- ZT_HL(:,JK) = PSTATM(JK1,3)
-END DO
-!
-!mean layer pressure and layer differential pressure (from half level variables)
-!
-ALLOCATE(ZPAVE(KDLON,KFLEV))
-ALLOCATE(ZDPRES(KDLON,KFLEV))
-DO JKRAD=1,KFLEV
- ZPAVE(:,JKRAD)=0.5*(ZPRES_HL(:,JKRAD)+ZPRES_HL(:,JKRAD+1))
- ZDPRES(:,JKRAD)=ZPRES_HL(:,JKRAD)-ZPRES_HL(:,JKRAD+1)
-END DO
-!-----------------------------------------------------------------------
-!* 4. INITIALIZES THE AEROSOLS and OZONE PROFILES from climatology
-! -------------------------------------------
-!
-! 4.1 AEROSOL optical thickness
-! EXPL -> defined online, otherwise climatology
-IF (CAOP=='EXPL') THEN
- GAOP = .TRUE.
-ELSE
- GAOP = .FALSE.
-ENDIF
-!
-IF (CAOP=='EXPL') THEN
- ALLOCATE(ZPIZA_EQ_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
- ALLOCATE(ZCGA_EQ_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
- ALLOCATE(ZTAUREL_EQ_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
-
- ALLOCATE(ZPIZA_DST_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
- ALLOCATE(ZCGA_DST_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
- ALLOCATE(ZTAUREL_DST_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
- ALLOCATE(PAER_DST(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3)))
-
- ALLOCATE(ZPIZA_AER_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
- ALLOCATE(ZCGA_AER_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
- ALLOCATE(ZTAUREL_AER_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
- ALLOCATE(PAER_AER(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3)))
-
- ALLOCATE(ZPIZA_SLT_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
- ALLOCATE(ZCGA_SLT_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
- ALLOCATE(ZTAUREL_SLT_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB_OLD))
- ALLOCATE(PAER_SLT(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3)))
-
-
- ALLOCATE(ZII(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),KSWB_OLD))
- ALLOCATE(ZIR(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),KSWB_OLD))
-
- ZPIZA_EQ_TMP = 0.
- ZCGA_EQ_TMP = 0.
- ZTAUREL_EQ_TMP = 0.
-
- ZPIZA_DST_TMP = 0.
- ZCGA_DST_TMP = 0.
- ZTAUREL_DST_TMP = 0
-
- ZPIZA_SLT_TMP = 0.
- ZCGA_SLT_TMP = 0.
- ZTAUREL_SLT_TMP = 0
-
- ZPIZA_AER_TMP = 0.
- ZCGA_AER_TMP = 0.
- ZTAUREL_AER_TMP = 0
-
- PAER_DST=0.
- PAER_SLT=0.
- PAER_AER=0.
-
- IF (LORILAM) THEN
- CALL AEROOPT_GET( &
- PSVT(IIB:IIE,IJB:IJE,:,NSV_AERBEG:NSV_AEREND) & !I [ppv] aerosols concentration
- ,PZZ(IIB:IIE,IJB:IJE,:) & !I [m] height of layers
- ,PRHODREF(IIB:IIE,IJB:IJE,:) & !I [kg/m3] density of air
- ,ZPIZA_AER_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] single scattering albedo of aerosols
- ,ZCGA_AER_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] assymetry factor for aerosols
- ,ZTAUREL_AER_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
- ,PAER_AER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT) & !O [-] optical depth of aerosols at wvl=550nm
- ,KSWB_OLD & !I |nbr] number of shortwave bands
- ,ZIR(IIB:IIE,IJB:IJE,:,:) & !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
- ,ZII(IIB:IIE,IJB:IJE,:,:) & !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
- )
- ENDIF
- IF(LDUST) THEN
- CALL DUSTOPT_GET( &
- PSVT(IIB:IIE,IJB:IJE,:,NSV_DSTBEG:NSV_DSTEND) & !I [ppv] Dust scalar concentration
- ,PZZ(IIB:IIE,IJB:IJE,:) & !I [m] height of layers
- ,PRHODREF(IIB:IIE,IJB:IJE,:) & !I [kg/m3] density of air
- ,ZPIZA_DST_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] single scattering albedo of dust
- ,ZCGA_DST_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] assymetry factor for dust
- ,ZTAUREL_DST_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
- ,PAER_DST(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT) & !O [-] optical depth of dust at wvl=550nm
- ,KSWB_OLD & !I |nbr] number of shortwave bands
- )
- DO WVL_IDX=1,KSWB_OLD
- PDST_WL(:,:,:,WVL_IDX) = ZTAUREL_DST_TMP(:,:,:,WVL_IDX)* PAER(:,:,:,3)
- ENDDO
- ENDIF
- IF(LSALT) THEN
- CALL SALTOPT_GET( &
- PSVT(IIB:IIE,IJB:IJE,:,NSV_SLTBEG:NSV_SLTEND) & !I [ppv] sea salt scalar concentration
- ,PZZ(IIB:IIE,IJB:IJE,:) & !I [m] height of layers
- ,PRHODREF(IIB:IIE,IJB:IJE,:) & !I [kg/m3] density of air
- ,PTHT(IIB:IIE,IJB:IJE,:) & !I [K] potential temperature
- ,PPABST(IIB:IIE,IJB:IJE,:) & !I [hPa] pressure
- ,PRT(IIB:IIE,IJB:IJE,:,:) & !I [kg/kg] water mixing ratio
- ,ZPIZA_SLT_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] single scattering albedo of sea salt
- ,ZCGA_SLT_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] assymetry factor for sea salt
- ,ZTAUREL_SLT_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) & !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
- ,PAER_SLT(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT) & !O [-] optical depth of sea salt at wvl=550nm
- ,KSWB_OLD & !I |nbr] number of shortwave bands
- )
- ENDIF
-
- ZTAUREL_EQ_TMP(:,:,:,:)=ZTAUREL_DST_TMP(:,:,:,:)+ZTAUREL_AER_TMP(:,:,:,:)+ZTAUREL_SLT_TMP(:,:,:,:)
-
- PAER(:,:,:,2)=PAER_SLT(:,:,:)
- PAER(:,:,:,3)=PAER_DST(:,:,:)
- PAER(:,:,:,4)=PAER_AER(:,:,:)
-
-
- WHERE (ZTAUREL_EQ_TMP(:,:,:,:).GT.0.0)
- ZPIZA_EQ_TMP(:,:,:,:)=(ZPIZA_DST_TMP(:,:,:,:)*ZTAUREL_DST_TMP(:,:,:,:)+&
- ZPIZA_AER_TMP(:,:,:,:)*ZTAUREL_AER_TMP(:,:,:,:)+&
- ZPIZA_SLT_TMP(:,:,:,:)*ZTAUREL_SLT_TMP(:,:,:,:))/&
- ZTAUREL_EQ_TMP(:,:,:,:)
- END WHERE
- WHERE ((ZTAUREL_EQ_TMP(:,:,:,:).GT.0.0).AND.(ZPIZA_EQ_TMP(:,:,:,:).GT.0.0))
- ZCGA_EQ_TMP(:,:,:,:)=(ZPIZA_DST_TMP(:,:,:,:)*ZTAUREL_DST_TMP(:,:,:,:)*ZCGA_DST_TMP(:,:,:,:)+&
- ZPIZA_AER_TMP(:,:,:,:)*ZTAUREL_AER_TMP(:,:,:,:)*ZCGA_AER_TMP(:,:,:,:)+&
- ZPIZA_SLT_TMP(:,:,:,:)*ZTAUREL_SLT_TMP(:,:,:,:)*ZCGA_SLT_TMP(:,:,:,:))/&
- (ZTAUREL_EQ_TMP(:,:,:,:)*ZPIZA_EQ_TMP(:,:,:,:))
- END WHERE
-
- ZTAUREL_EQ_TMP(:,:,:,:)=max(1.E-8,ZTAUREL_EQ_TMP(:,:,:,:))
- ZCGA_EQ_TMP(:,:,:,:)=max(1.E-8,ZCGA_EQ_TMP(:,:,:,:))
- ZPIZA_EQ_TMP(:,:,:,:)=max(1.E-8,ZPIZA_EQ_TMP(:,:,:,:))
- PAER(:,:,:,3)=max(1.E-8,PAER(:,:,:,3))
- ZPIZA_EQ_TMP(:,:,:,:)=min(0.99,ZPIZA_EQ_TMP(:,:,:,:))
-
-
-ENDIF
-!
-! Computes SSA, optical depth and assymetry factor for clear sky (aerosols)
-ZTAUAZ(:,:,:,:) = 0.
-ZPIZAZ(:,:,:,:) = 0.
-ZCGAZ(:,:,:,:) = 0.
-DO WVL_IDX=1,KSWB_OLD
- DO JAE=1,KAER
- !Special optical properties for dust
- IF (CAOP=='EXPL'.AND.(JAE==3)) THEN
- !Ponderation of aerosol optical in case of explicit optical factor
- !ti
- ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)= ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) + &
- PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) * &
- ZTAUREL_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX)
- !wi*ti
- ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)= ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) + &
- PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) * &
- ZTAUREL_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX) * &
- ZPIZA_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX)
- !wi*ti*gi
- ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) = ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) + &
- PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) * &
- ZTAUREL_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX) * &
- ZPIZA_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX) * &
- ZCGA_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX)
- ELSE
-
- !Ponderation of aerosol optical properties
- !ti
- ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)=ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)+&
- PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) * RTAUA(WVL_IDX,JAE)
- !wi*ti
- ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)=ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)+&
- PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) *&
- RTAUA(WVL_IDX,JAE)*RPIZA(WVL_IDX,JAE)
- !wi*ti*gi
- ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) = ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) +&
- PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) *&
- RTAUA(WVL_IDX,JAE)*RPIZA(WVL_IDX,JAE)*RCGA(WVL_IDX,JAE)
- ENDIF
- ENDDO
-! assymetry factor:
-
-ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) = ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) / &
- ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)
-! SSA:
-ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) = ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) / &
- ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)
-ENDDO
-!
-
-!
-ALLOCATE(ZAER(KDLON,KFLEV,KAER))
-! Aerosol classes
-! 1=Continental 2=Maritime 3=Desert 4=Urban 5=Volcanic 6=Stratos.Bckgnd
-! Loaded from climatology
-DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZAER (IIJ,:,:) = PAER_CLIM (JI,JJ,:,:)
- END DO
-END DO
-IF ((CAOP=='EXPL') .AND. LDUST ) THEN
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZAER (IIJ,:,3) = PAER (JI,JJ,:,3)
- END DO
- END DO
-END IF
-IF ((CAOP=='EXPL') .AND. LSALT ) THEN
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZAER (IIJ,:,2) = PAER (JI,JJ,:,2)
- END DO
- END DO
-END IF
-IF ((CAOP=='EXPL') .AND. LORILAM ) THEN
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZAER (IIJ,:,4) = PAER (JI,JJ,:,4)
- END DO
- END DO
-END IF
-!
-ALLOCATE(ZPIZA_EQ(KDLON,KFLEV,KSWB_OLD))
-ALLOCATE(ZCGA_EQ(KDLON,KFLEV,KSWB_OLD))
-ALLOCATE(ZTAUREL_EQ(KDLON,KFLEV,KSWB_OLD))
-IF(CAOP=='EXPL')THEN
- !Transform from vector of type #lon #lat #lev #wvl
- !to vectors of type #points, #levs, #wavelengths
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZPIZA_EQ(IIJ,:,:) = ZPIZA_EQ_TMP(JI,JJ,:,:)
- ZCGA_EQ(IIJ,:,:)= ZCGA_EQ_TMP(JI,JJ,:,:)
- ZTAUREL_EQ(IIJ,:,:)=ZTAUREL_EQ_TMP(JI,JJ,:,:)
- END DO
- END DO
- DEALLOCATE(ZPIZA_EQ_TMP)
- DEALLOCATE(ZCGA_EQ_TMP)
- DEALLOCATE(ZTAUREL_EQ_TMP)
- DEALLOCATE(ZPIZA_DST_TMP)
- DEALLOCATE(ZCGA_DST_TMP)
- DEALLOCATE(ZTAUREL_DST_TMP)
- DEALLOCATE(ZPIZA_AER_TMP)
- DEALLOCATE(ZCGA_AER_TMP)
- DEALLOCATE(ZTAUREL_AER_TMP)
- DEALLOCATE(ZPIZA_SLT_TMP)
- DEALLOCATE(ZCGA_SLT_TMP)
- DEALLOCATE(ZTAUREL_SLT_TMP)
- DEALLOCATE(PAER_DST)
- DEALLOCATE(PAER_AER)
- DEALLOCATE(PAER_SLT)
- DEALLOCATE(ZIR)
- DEALLOCATE(ZII)
-END IF
-
-
-!
-! 4.2 OZONE content
-!
-ALLOCATE(ZO3AVE(KDLON,KFLEV))
-!
-DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZO3AVE(IIJ,:) = POZON (JI,JJ,:)
- END DO
-END DO
-#ifdef MNH_ECRAD
-#if ( VER_ECRAD == 140 )
-POZON = POZON
-#endif
-#endif
-!
-!-------------------------------------------------------------------------------
-!
-!* 5. CALLS THE E.C.M.W.F. RADIATION CODE
-! -----------------------------------
-!
-!
-!* 5.1 INITIALIZES 2D AND SURFACE FIELDS
-!
-ALLOCATE(ZRMU0(KDLON))
-ALLOCATE(ZLSM(KDLON))
-!
-ALLOCATE(ZALBP(KDLON,KSWB_MNH))
-ALLOCATE(ZALBD(KDLON,KSWB_MNH))
-!
-ALLOCATE(ZEMIS(KDLON,KLWB_MNH))
-ALLOCATE(ZEMIW(KDLON,KLWB_MNH))
-!
-DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZEMIS(IIJ,:) = PEMIS(JI,JJ,:)
- ZRMU0(IIJ) = PCOSZEN(JI,JJ)
- ZLSM(IIJ) = 1.0 - PSEA(JI,JJ)
- END DO
-END DO
-!
-! spectral albedo
-!
-IF ( SIZE(PDIR_ALB,3)==1 ) THEN
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ! sw direct and diffuse albedos
- ZALBP(IIJ,:) = PDIR_ALB(JI,JJ,1)
- ZALBD(IIJ,:) = PSCA_ALB(JI,JJ,1)
- !
- END DO
- END DO
-ELSE
- DO JK=1, SIZE(PDIR_ALB,3)
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ! sw direct and diffuse albedos
- ZALBP(IIJ,JK) = PDIR_ALB(JI,JJ,JK)
- ZALBD(IIJ,JK) = PSCA_ALB(JI,JJ,JK)
- ENDDO
- END DO
- ENDDO
-END IF
-!
-!
-! LW emissivity
-ZEMIW(:,:)= ZEMIS(:,:)
-!
-!solar constant
-ZRII0= PCORSOL*XI0 ! solar constant multiplied by seasonal variations due to Earth-Sun distance
-!
-!
-!* 5.2 ACCOUNTS FOR THE CLEAR-SKY APPROXIMATION
-!
-! Performs the horizontal average of the fields when no cloud
-!
-ZCLOUD(:) = SUM( ZCFAVE(:,:),DIM=2 ) ! one where no cloud on the vertical
-!
-! MODIF option CLLY
-ALLOCATE ( ICLEAR_2D_TM1(KDLON) )
-!
-DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ICLEAR_2D_TM1(IIJ) = KCLEARCOL_TM1(JI,JJ)
- END DO
-END DO
-!
-IF(OCLOUD_ONLY .OR. OCLEAR_SKY) THEN
- !
- GCLEAR_2D(:) = .TRUE.
- WHERE( (ZCLOUD(:) > 0.0) .OR. (ICLEAR_2D_TM1(:)==0) ) ! FALSE on cloudy columns
- GCLEAR_2D(:) = .FALSE.
- END WHERE
- !
- ICLEAR_COL = COUNT( GCLEAR_2D(:) ) ! number of clear sky columns
- !
- ALLOCATE(INDEX_ICLEAR_COL(ICLEAR_COL))
- IIJ = 0
- DO JI=1,KDLON
- IF ( GCLEAR_2D(JI) ) THEN
- IIJ = IIJ + 1
- INDEX_ICLEAR_COL(IIJ) = JI
- END IF
- END DO
-
- IF( ICLEAR_COL == KDLON ) THEN ! No cloud case so only the mean clear-sky
-!!$ GCLEAR_2D(1) = .FALSE. ! column is selected
-!!$ ICLEAR_COL = KDLON-1
- GNOCL = .TRUE. ! TRUE if no cloud at all
- ELSE
- GNOCL = .FALSE.
- END IF
-
- GCLEAR(:,:) = SPREAD( GCLEAR_2D(:),DIM=2,NCOPIES=KFLEV ) ! vertical extension of clear columns 2D map
- ICLOUD_COL = KDLON - ICLEAR_COL ! number of cloudy columns
-!
- ZCLEAR_COL_ll = REAL(ICLEAR_COL)
- CALL REDUCESUM_ll(ZCLEAR_COL_ll,IINFO_ll)
- !ZDLON_ll = KDLON
- !CALL REDUCESUM_ll(ZDLON_ll,IINFO_ll)
-
- !IF (IP == 1 )
- !print*,",RADIATIOn COULD_ONLY=OCLOUD_ONLY,OCLEAR_SKY,ZCLEAR_COL_ll,ICLEAR_COL,ICLOUD_COL,KDON,ZDLON_ll,GNOCL=", &
- ! OCLOUD_ONLY,OCLEAR_SKY,ZCLEAR_COL_ll,ICLEAR_COL,ICLOUD_COL,KDLON,ZDLON_ll,GNOCL
-!
-!!$ IF( ICLEAR_COL /=0 ) THEN ! at least one clear-sky column exists -> average profiles on clear columns
- IF( ZCLEAR_COL_ll /= 0.0 ) THEN ! at least one clear-sky column exists -> average profiles on clear columns
- ZT_CLEAR(:) = SUM_DD_R2_R1_ll(ZTAVE(INDEX_ICLEAR_COL(:),:)) / ZCLEAR_COL_ll
- ZP_CLEAR(:) = SUM_DD_R2_R1_ll(ZPAVE(INDEX_ICLEAR_COL(:),:)) / ZCLEAR_COL_ll
- ZQV_CLEAR(:) = SUM_DD_R2_R1_ll(REAL(ZQVAVE(INDEX_ICLEAR_COL(:),:))) / ZCLEAR_COL_ll
- ZOZ_CLEAR(:) = SUM_DD_R2_R1_ll(REAL(ZO3AVE(INDEX_ICLEAR_COL(:),:))) / ZCLEAR_COL_ll
- ZDP_CLEAR(:) = SUM_DD_R2_R1_ll(REAL(ZDPRES(INDEX_ICLEAR_COL(:),:))) / ZCLEAR_COL_ll
-
- DO JK1=1,KAER
- ZAER_CLEAR(:,JK1) = SUM_DD_R2_R1_ll(REAL(ZAER(INDEX_ICLEAR_COL(:),:,JK1))) / ZCLEAR_COL_ll
- END DO
- !Get an average value for the clear column
- IF(CAOP=='EXPL')THEN
- DO WVL_IDX=1,KSWB_OLD
- ZPIZA_EQ_CLEAR(:,WVL_IDX) = SUM_DD_R2_R1_ll(REAL(ZPIZA_EQ( INDEX_ICLEAR_COL(:),:,WVL_IDX))) / ZCLEAR_COL_ll
- ZCGA_EQ_CLEAR(:,WVL_IDX) = SUM_DD_R2_R1_ll(REAL(ZCGA_EQ( INDEX_ICLEAR_COL(:),:,WVL_IDX))) / ZCLEAR_COL_ll
- ZTAUREL_EQ_CLEAR(:,WVL_IDX) = SUM_DD_R2_R1_ll(REAL(ZTAUREL_EQ(INDEX_ICLEAR_COL(:),:,WVL_IDX))) / ZCLEAR_COL_ll
- ENDDO
- ENDIF
- !
- ZHP_CLEAR(1:KFLEV) = SUM_DD_R2_R1_ll(REAL(ZPRES_HL(INDEX_ICLEAR_COL(:),1:KFLEV))) / ZCLEAR_COL_ll
- ZHT_CLEAR(1:KFLEV) = SUM_DD_R2_R1_ll(REAL(ZT_HL (INDEX_ICLEAR_COL(:),1:KFLEV))) / ZCLEAR_COL_ll
- !
- ZALBP_CLEAR(:) = SUM_DD_R2_R1_ll(REAL(ZALBP(INDEX_ICLEAR_COL(:),:))) / ZCLEAR_COL_ll
- ZALBD_CLEAR(:) = SUM_DD_R2_R1_ll(REAL(ZALBD(INDEX_ICLEAR_COL(:),:))) / ZCLEAR_COL_ll
- !
- ZEMIS_CLEAR = SUM_DD_R1_ll(REAL(ZEMIS(INDEX_ICLEAR_COL(:),1))) / ZCLEAR_COL_ll
- ZEMIW_CLEAR = SUM_DD_R1_ll(REAL(ZEMIW(INDEX_ICLEAR_COL(:),1))) / ZCLEAR_COL_ll
- ZRMU0_CLEAR = SUM_DD_R1_ll(REAL(ZRMU0(INDEX_ICLEAR_COL(:)))) / ZCLEAR_COL_ll
- ZTS_CLEAR = SUM_DD_R1_ll(REAL(ZTS(INDEX_ICLEAR_COL(:)))) / ZCLEAR_COL_ll
- ZLSM_CLEAR = SUM_DD_R1_ll(REAL(ZLSM(INDEX_ICLEAR_COL(:)))) / ZCLEAR_COL_ll
- ZLAT_CLEAR = SUM_DD_R1_ll(REAL(ZLAT(INDEX_ICLEAR_COL(:)))) / ZCLEAR_COL_ll
- ZLON_CLEAR = SUM_DD_R1_ll(REAL(ZLON(INDEX_ICLEAR_COL(:)))) / ZCLEAR_COL_ll
-!
- ELSE ! no clear columns -> the first column is chosen, without physical meaning: it will not be
- ! unpacked after the call to the radiation ecmwf routine
- ZT_CLEAR(:) = ZTAVE(1,:)
- ZP_CLEAR(:) = ZPAVE(1,:)
- ZQV_CLEAR(:) = ZQVAVE(1,:)
- ZOZ_CLEAR(:) = ZO3AVE(1,:)
- ZDP_CLEAR(:) = ZDPRES(1,:)
- ZAER_CLEAR(:,:) = ZAER(1,:,:)
- IF(CAOP=='EXPL')THEN
- ZPIZA_EQ_CLEAR(:,:)=ZPIZA_EQ(1,:,:)
- ZCGA_EQ_CLEAR(:,:)=ZCGA_EQ(1,:,:)
- ZTAUREL_EQ_CLEAR(:,:)=ZTAUREL_EQ(1,:,:)
- ENDIF
-!
- ZHP_CLEAR(1:KFLEV) = ZPRES_HL(1,1:KFLEV)
- ZHT_CLEAR(1:KFLEV) = ZT_HL(1,1:KFLEV)
- ZALBP_CLEAR(:) = ZALBP(1,:)
- ZALBD_CLEAR(:) = ZALBD(1,:)
-!
- ZEMIS_CLEAR = ZEMIS(1,1)
- ZEMIW_CLEAR = ZEMIW(1,1)
- ZRMU0_CLEAR = ZRMU0(1)
- ZTS_CLEAR = ZTS(1)
- ZLSM_CLEAR = ZLSM(1)
- ZLAT_CLEAR = ZLAT(1)
- ZLON_CLEAR = ZLON(1)
- END IF
- !
- GCLOUD(:,:) = .NOT.GCLEAR(:,:) ! .true. where the column is cloudy
- GCLOUDT(:,:)=TRANSPOSE(GCLOUD(:,:))
- ICLOUD = ICLOUD_COL*KFLEV ! total number of voxels in cloudy columns
- ALLOCATE(ZWORK1(ICLOUD))
- ALLOCATE(ZWORK2(ICLOUD+KFLEV)) ! allocation for the KFLEV levels of
- ! the ICLOUD cloudy columns
- ! and of the KFLEV levels of the clear sky one
- !
- ! temperature profiles
- !
- ZWORK1(:) = PACK( TRANSPOSE(ZTAVE(:,:)),MASK=GCLOUDT(:,:) )
- ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
- ZWORK2(ICLOUD+1:)= ZT_CLEAR(1:) ! and the single clear_sky one
- DEALLOCATE(ZTAVE)
- ALLOCATE(ZTAVE(ICLOUD_COL+1,KFLEV))
- ZTAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
- !
- ! vapor mixing ratio profiles
- !
- ZWORK1(:) = PACK( TRANSPOSE(ZQVAVE(:,:)),MASK=GCLOUDT(:,:) )
- ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
- ZWORK2(ICLOUD+1:)= ZQV_CLEAR(1:) ! and the single clear_sky one
- DEALLOCATE(ZQVAVE)
- ALLOCATE(ZQVAVE(ICLOUD_COL+1,KFLEV))
- ZQVAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
- !
- ! mesh size
- !
- ZWORK1(:) = PACK( TRANSPOSE(ZDZ(:,:)),MASK=GCLOUDT(:,:) )
- ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
- ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
- DEALLOCATE(ZDZ)
- ALLOCATE(ZDZ(ICLOUD_COL+1,KFLEV))
- ZDZ(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
- !
- !
- ! liquid water mixing ratio profiles
- !
- ZWORK1(:) = PACK( TRANSPOSE(ZQLAVE(:,:)),MASK=GCLOUDT(:,:) )
- ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
- ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
- DEALLOCATE(ZQLAVE)
- ALLOCATE(ZQLAVE(ICLOUD_COL+1,KFLEV))
- ZQLAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
- !
- !rain
- !
- ZWORK1(:) = PACK( TRANSPOSE(ZQRAVE(:,:)),MASK=GCLOUDT(:,:) )
- ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
- ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
- DEALLOCATE(ZQRAVE)
- ALLOCATE(ZQRAVE(ICLOUD_COL+1,KFLEV))
- ZQRAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
- !
- ! ice water mixing ratio profiles
- !
- ZWORK1(:) = PACK( TRANSPOSE(ZQIAVE(:,:)),MASK=GCLOUDT(:,:) )
- ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
- ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
- DEALLOCATE(ZQIAVE)
- ALLOCATE(ZQIAVE(ICLOUD_COL+1,KFLEV))
- ZQIAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
- !
- !
- ! liquid water mixing ratio profiles
- !
- ZWORK1(:) = PACK( TRANSPOSE(ZQLWC(:,:)),MASK=GCLOUDT(:,:) )
- ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
- ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
- DEALLOCATE(ZQLWC)
- ALLOCATE(ZQLWC(ICLOUD_COL+1,KFLEV))
- ZQLWC(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
- !
- !rain
- !
- ZWORK1(:) = PACK( TRANSPOSE(ZQRWC(:,:)),MASK=GCLOUDT(:,:) )
- ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
- ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
- DEALLOCATE(ZQRWC)
- ALLOCATE(ZQRWC(ICLOUD_COL+1,KFLEV))
- ZQRWC(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
- !
- ! ice water mixing ratio profiles
- !
- ZWORK1(:) = PACK( TRANSPOSE(ZQIWC(:,:)),MASK=GCLOUDT(:,:) )
- ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
- ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
- DEALLOCATE(ZQIWC)
- ALLOCATE(ZQIWC(ICLOUD_COL+1,KFLEV))
- ZQIWC(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
- !
- !
- ! cloud fraction profiles
- !
- ZWORK1(:) = PACK( TRANSPOSE(ZCFAVE(:,:)),MASK=GCLOUDT(:,:) )
- ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
- ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
- DEALLOCATE(ZCFAVE)
- ALLOCATE(ZCFAVE(ICLOUD_COL+1,KFLEV))
- ZCFAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
- !
- ! C2R2 water particle concentration
- !
- IF ( SIZE(ZCCT_C2R2) > 0 ) THEN
- ZWORK1(:) = PACK( TRANSPOSE(ZCCT_C2R2(:,:)),MASK=GCLOUDT(:,:) )
- ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
- ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
- DEALLOCATE(ZCCT_C2R2)
- ALLOCATE(ZCCT_C2R2(ICLOUD_COL+1,KFLEV))
- ZCCT_C2R2 (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
- ENDIF
- IF ( SIZE (ZCRT_C2R2) > 0 ) THEN
- ZWORK1(:) = PACK( TRANSPOSE(ZCRT_C2R2(:,:)),MASK=GCLOUDT(:,:) )
- ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
- ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
- DEALLOCATE(ZCRT_C2R2)
- ALLOCATE(ZCRT_C2R2(ICLOUD_COL+1,KFLEV))
- ZCRT_C2R2 (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
- ENDIF
- IF ( SIZE (ZCIT_C1R3) > 0) THEN
- ZWORK1(:) = PACK( TRANSPOSE(ZCIT_C1R3(:,:)),MASK=GCLOUDT(:,:) )
- ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
- ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
- DEALLOCATE(ZCIT_C1R3)
- ALLOCATE(ZCIT_C1R3(ICLOUD_COL+1,KFLEV))
- ZCIT_C1R3 (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
- ENDIF
- !
- ! LIMA water particle concentration
- !
- IF( CCLOUD == 'LIMA' ) THEN
- ZWORK1(:) = PACK( TRANSPOSE(ZCCT_LIMA(:,:)),MASK=GCLOUDT(:,:) )
- ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
- ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
- DEALLOCATE(ZCCT_LIMA)
- ALLOCATE(ZCCT_LIMA(ICLOUD_COL+1,KFLEV))
- ZCCT_LIMA (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
-!
- ZWORK1(:) = PACK( TRANSPOSE(ZCRT_LIMA(:,:)),MASK=GCLOUDT(:,:) )
- ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
- ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
- DEALLOCATE(ZCRT_LIMA)
- ALLOCATE(ZCRT_LIMA(ICLOUD_COL+1,KFLEV))
- ZCRT_LIMA (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
-!
- ZWORK1(:) = PACK( TRANSPOSE(ZCIT_LIMA(:,:)),MASK=GCLOUDT(:,:) )
- ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
- ZWORK2(ICLOUD+1:)= 0.0 ! and the single clear_sky one
- DEALLOCATE(ZCIT_LIMA)
- ALLOCATE(ZCIT_LIMA(ICLOUD_COL+1,KFLEV))
- ZCIT_LIMA (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
- ENDIF
- !
- ! ozone content profiles
- !
- ZWORK1(:) = PACK( TRANSPOSE(ZO3AVE(:,:)),MASK=GCLOUDT(:,:) )
- ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
- ZWORK2(ICLOUD+1:)= ZOZ_CLEAR(1:) ! and the single clear_sky one
- DEALLOCATE(ZO3AVE)
- ALLOCATE(ZO3AVE(ICLOUD_COL+1,KFLEV))
- ZO3AVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
- !
- ZWORK1(:) = PACK( TRANSPOSE(ZPAVE(:,:)),MASK=GCLOUDT(:,:) )
- ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
- ZWORK2(ICLOUD+1:)= ZP_CLEAR(1:) ! and the single clear_sky one
- DEALLOCATE(ZPAVE)
- ALLOCATE(ZPAVE(ICLOUD_COL+1,KFLEV))
- ZPAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
- !
- !pressure thickness
- !
- ZWORK1(:) = PACK( TRANSPOSE(ZDPRES(:,:)),MASK=GCLOUDT(:,:) )
- ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
- ZWORK2(ICLOUD+1:)= ZDP_CLEAR(1:) ! and the single clear_sky one
- DEALLOCATE(ZDPRES)
- ALLOCATE(ZDPRES(ICLOUD_COL+1,KFLEV))
- ZDPRES(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
- !
- !aerosols
- !
- ALLOCATE(ZWORK1AER(ICLOUD,KAER))
- ALLOCATE(ZWORK2AER(ICLOUD+KFLEV,KAER))
- DO JK=1,KAER
- ZWORK1AER(:,JK) = PACK( TRANSPOSE(ZAER(:,:,JK)),MASK=GCLOUDT(:,:) )
- ZWORK2AER(1:ICLOUD,JK)=ZWORK1AER(:,JK)
- ZWORK2AER(ICLOUD+1:,JK)=ZAER_CLEAR(:,JK)
- END DO
- DEALLOCATE(ZAER)
- ALLOCATE(ZAER(ICLOUD_COL+1,KFLEV,KAER))
- DO JK=1,KAER
- ZAER(:,:,JK) = TRANSPOSE( RESHAPE( ZWORK2AER(:,JK),(/KFLEV,ICLOUD_COL+1/) ) )
- END DO
- DEALLOCATE (ZWORK1AER)
- DEALLOCATE (ZWORK2AER)
- !
- IF(CAOP=='EXPL')THEN
- ALLOCATE(ZWORK1AER(ICLOUD,KSWB_OLD)) !New vector with value for all cld. points
- ALLOCATE(ZWORK2AER(ICLOUD+KFLEV,KSWB_OLD)) !New vector with value for all cld.points + 1 clr column
- !Single scattering albedo
- DO WVL_IDX=1,KSWB_OLD
- ZWORK1AER(:,WVL_IDX) = PACK( TRANSPOSE(ZPIZA_EQ(:,:,WVL_IDX)),MASK=GCLOUDT(:,:) )
- ZWORK2AER(1:ICLOUD,WVL_IDX) = ZWORK1AER(:,WVL_IDX)
- ZWORK2AER(ICLOUD+1:,WVL_IDX) = ZPIZA_EQ_CLEAR(:,WVL_IDX)
- ENDDO
- DEALLOCATE(ZPIZA_EQ)
- ALLOCATE(ZPIZA_EQ(ICLOUD_COL+1,KFLEV,KSWB_OLD))
- DO WVL_IDX=1,KSWB_OLD
- ZPIZA_EQ(:,:,WVL_IDX) = TRANSPOSE( RESHAPE( ZWORK2AER(:,WVL_IDX),(/KFLEV,ICLOUD_COL+1/) ) )
- ENDDO
- !Assymetry factor
- DO WVL_IDX=1,KSWB_OLD
- ZWORK1AER(:,WVL_IDX) = PACK(TRANSPOSE(ZCGA_EQ(:,:,WVL_IDX)), MASK=GCLOUDT(:,:))
- ZWORK2AER(1:ICLOUD,WVL_IDX) = ZWORK1AER(:,WVL_IDX)
- ZWORK2AER(ICLOUD+1:,WVL_IDX) = ZCGA_EQ_CLEAR(:,WVL_IDX)
- ENDDO
- DEALLOCATE(ZCGA_EQ)
- ALLOCATE(ZCGA_EQ(ICLOUD_COL+1,KFLEV,KSWB_OLD))
- DO WVL_IDX=1,KSWB_OLD
- ZCGA_EQ(:,:,WVL_IDX) = TRANSPOSE(RESHAPE(ZWORK2AER(:,WVL_IDX),(/KFLEV,ICLOUD_COL+1/)))
- ENDDO
- !Relative wavelength-distributed optical depth
- DO WVL_IDX=1,KSWB_OLD
- ZWORK1AER(:,WVL_IDX) = PACK(TRANSPOSE(ZTAUREL_EQ(:,:,WVL_IDX)), MASK=GCLOUDT(:,:))
- ZWORK2AER(1:ICLOUD,WVL_IDX) = ZWORK1AER(:,WVL_IDX)
- ZWORK2AER(ICLOUD+1:,WVL_IDX) = ZTAUREL_EQ_CLEAR(:,WVL_IDX)
- ENDDO
- DEALLOCATE(ZTAUREL_EQ)
- ALLOCATE(ZTAUREL_EQ(ICLOUD_COL+1,KFLEV,KSWB_OLD))
- DO WVL_IDX=1,KSWB_OLD
- ZTAUREL_EQ(:,:,WVL_IDX) = TRANSPOSE(RESHAPE(ZWORK2AER(:,WVL_IDX),(/KFLEV,ICLOUD_COL+1/)))
- ENDDO
- DEALLOCATE(ZWORK1AER)
- DEALLOCATE(ZWORK2AER)
- ELSE
- DEALLOCATE(ZPIZA_EQ)
- ALLOCATE(ZPIZA_EQ(ICLOUD_COL+1,KFLEV,KSWB_OLD))
- DEALLOCATE(ZCGA_EQ)
- ALLOCATE(ZCGA_EQ(ICLOUD_COL+1,KFLEV,KSWB_OLD))
- DEALLOCATE(ZTAUREL_EQ)
- ALLOCATE(ZTAUREL_EQ(ICLOUD_COL+1,KFLEV,KSWB_OLD))
- ENDIF !Check on LDUST
-
- ! half-level variables
- !
- ZWORK1(:) = PACK( TRANSPOSE(ZPRES_HL(:,1:KFLEV)),MASK=GCLOUDT(:,:) )
- ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
- ZWORK2(ICLOUD+1:)= ZHP_CLEAR(1:) ! and the single clear_sky one
- DEALLOCATE(ZPRES_HL)
- ALLOCATE(ZPRES_HL(ICLOUD_COL+1,KFLEV+1))
- ZPRES_HL(:,1:KFLEV) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
- ZPRES_HL(:,KFLEV+1) = PSTATM(IKSTAE,2)*100.0
- !
- ZWORK1(:) = PACK( TRANSPOSE(ZT_HL(:,1:KFLEV)),MASK=GCLOUDT(:,:) )
- ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
- ZWORK2(ICLOUD+1:)= ZHT_CLEAR(1:) ! and the single clear_sky one
- DEALLOCATE(ZT_HL)
- ALLOCATE(ZT_HL(ICLOUD_COL+1,KFLEV+1))
- ZT_HL(:,1:KFLEV) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
- ZT_HL(:,KFLEV+1) = PSTATM(IKSTAE,3)
- !
- ! surface fields
- !
- ALLOCATE(ZWORK3(ICLOUD_COL))
- ALLOCATE(ZWORK4(ICLOUD_COL,KSWB_MNH))
- ALLOCATE(ZWORK(KDLON))
- DO JALBS=1,KSWB_MNH
- ZWORK(:) = ZALBP(:,JALBS)
- ZWORK3(:) = PACK( ZWORK(:),MASK=.NOT.GCLEAR_2D(:) )
- ZWORK4(:,JALBS) = ZWORK3(:)
- END DO
- DEALLOCATE(ZALBP)
- ALLOCATE(ZALBP(ICLOUD_COL+1,KSWB_MNH))
- ZALBP(1:ICLOUD_COL,:) = ZWORK4(1:ICLOUD_COL,:)
- ZALBP(ICLOUD_COL+1,:) = ZALBP_CLEAR(:)
- !
- DO JALBS=1,KSWB_MNH
- ZWORK(:) = ZALBD(:,JALBS)
- ZWORK3(:) = PACK( ZWORK(:),MASK=.NOT.GCLEAR_2D(:) )
- ZWORK4(:,JALBS) = ZWORK3(:)
- END DO
- DEALLOCATE(ZALBD)
- ALLOCATE(ZALBD(ICLOUD_COL+1,KSWB_MNH))
- ZALBD(1:ICLOUD_COL,:) = ZWORK4(1:ICLOUD_COL,:)
- ZALBD(ICLOUD_COL+1,:) = ZALBD_CLEAR(:)
- !
- DEALLOCATE(ZWORK4)
- !
- ZWORK3(:) = PACK( ZEMIS(:,1),MASK=.NOT.GCLEAR_2D(:) )
- DEALLOCATE(ZEMIS)
- ALLOCATE(ZEMIS(ICLOUD_COL+1,1))
- ZEMIS(1:ICLOUD_COL,1) = ZWORK3(1:ICLOUD_COL)
- ZEMIS(ICLOUD_COL+1,1) = ZEMIS_CLEAR
- !
- !
- ZWORK3(:) = PACK( ZEMIW(:,1),MASK=.NOT.GCLEAR_2D(:) )
- DEALLOCATE(ZEMIW)
- ALLOCATE(ZEMIW(ICLOUD_COL+1,1))
- ZEMIW(1:ICLOUD_COL,1) = ZWORK3(1:ICLOUD_COL)
- ZEMIW(ICLOUD_COL+1,1) = ZEMIW_CLEAR
- !
- !
- ZWORK3(:) = PACK( ZRMU0(:),MASK=.NOT.GCLEAR_2D(:) )
- DEALLOCATE(ZRMU0)
- ALLOCATE(ZRMU0(ICLOUD_COL+1))
- ZRMU0(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
- ZRMU0(ICLOUD_COL+1) = ZRMU0_CLEAR
- !
- ZWORK3(:) = PACK( ZLSM(:),MASK=.NOT.GCLEAR_2D(:) )
- DEALLOCATE(ZLSM)
- ALLOCATE(ZLSM(ICLOUD_COL+1))
- ZLSM(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
- ZLSM (ICLOUD_COL+1)= ZLSM_CLEAR
- !
- ZWORK3(:) = PACK( ZLAT(:),MASK=.NOT.GCLEAR_2D(:) )
- DEALLOCATE(ZLAT)
- ALLOCATE(ZLAT(ICLOUD_COL+1))
- ZLAT(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
- ZLAT (ICLOUD_COL+1)= ZLAT_CLEAR
- !
- ZWORK3(:) = PACK( ZLON(:),MASK=.NOT.GCLEAR_2D(:) )
- DEALLOCATE(ZLON)
- ALLOCATE(ZLON(ICLOUD_COL+1))
- ZLON(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
- ZLON (ICLOUD_COL+1)= ZLON_CLEAR
- !
- ZWORK3(:) = PACK( ZTS(:),MASK=.NOT.GCLEAR_2D(:) )
- DEALLOCATE(ZTS)
- ALLOCATE(ZTS(ICLOUD_COL+1))
- ZTS(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
- ZTS(ICLOUD_COL+1) = ZTS_CLEAR
- !
- DEALLOCATE(ZWORK1)
- DEALLOCATE(ZWORK2)
- DEALLOCATE(ZWORK3)
- DEALLOCATE(ZWORK)
- !
- IDIM = ICLOUD_COL +1 ! Number of columns where RT is computed
-!
-ELSE
- !
- !* 5.3 RADIATION COMPUTATIONS FOR THE FULL COLUMN NUMBER (KDLON)
- !
- IDIM = KDLON
-END IF
-!
-! initialisation of cloud trace for the next radiation time step
-! (if unchanged columns are not recomputed)
-WHERE ( ZCLOUD(:) <= 0.0 )
- ICLEAR_2D_TM1(:) = 1
-ELSEWHERE
- ICLEAR_2D_TM1(:) = 0
-END WHERE
-!
-DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- KCLEARCOL_TM1(JI,JJ) = ICLEAR_2D_TM1(IIJ) ! output to be saved for next time step
- END DO
-END DO
-!
-!
-!* 5.4 VERTICAL grid modification(up-down) for compatibility with ECMWF
-! radiation vertical grid. ALLOCATION of the outputs.
-!
-!
-ALLOCATE (ZWORK_GRID(SIZE(ZPRES_HL,1),KFLEV+1))
-!
-!half level pressure
-ZWORK_GRID(:,:)=ZPRES_HL(:,:)
-DO JKRAD=1, KFLEV+1
- JK1=(KFLEV+1)+1-JKRAD
- ZPRES_HL(:,JKRAD) = ZWORK_GRID(:,JK1)
-END DO
-!
-!half level temperature
-ZWORK_GRID(:,:)=ZT_HL(:,:)
-DO JKRAD=1, KFLEV+1
- JK1=(KFLEV+1)+1-JKRAD
- ZT_HL(:,JKRAD)=ZWORK_GRID(:,JK1)
-END DO
-!
-DEALLOCATE(ZWORK_GRID)
-!
-!mean layer variables
-!-------------------------------------
-ALLOCATE(ZWORK_GRID(SIZE(ZTAVE,1),KFLEV))
-!
-!mean layer temperature
-ZWORK_GRID(:,:)=ZTAVE(:,:)
-DO JKRAD=1, KFLEV
- JK1=KFLEV+1-JKRAD
- ZTAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
-END DO
-!
-!mean layer pressure
-ZWORK_GRID(:,:)=ZPAVE(:,:)
-DO JKRAD=1, KFLEV
- JK1=KFLEV+1-JKRAD
- ZPAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
-END DO
-!
-!mean layer pressure thickness
-ZWORK_GRID(:,:)=ZDPRES(:,:)
-DO JKRAD=1, KFLEV
- JK1=KFLEV+1-JKRAD
- ZDPRES(:,JKRAD)=ZWORK_GRID(:,JK1)
-END DO
-!
-!mesh size
-ZWORK_GRID(:,:)=ZDZ(:,:)
-DO JKRAD=1, KFLEV
- JK1=KFLEV+1-JKRAD
- ZDZ(:,JKRAD)=ZWORK_GRID(:,JK1)
-END DO
-
-!mean layer cloud fraction
-ZWORK_GRID(:,:)=ZCFAVE(:,:)
-DO JKRAD=1, KFLEV
- JK1=KFLEV+1-JKRAD
- ZCFAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
-END DO
-!
-!mean layer water vapor mixing ratio
-ZWORK_GRID(:,:)=ZQVAVE(:,:)
-DO JKRAD=1, KFLEV
- JK1=KFLEV+1-JKRAD
- ZQVAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
-END DO
-!
-!ice
-ZWORK_GRID(:,:)=ZQIAVE(:,:)
-DO JKRAD=1, KFLEV
- JK1=KFLEV+1-JKRAD
- ZQIAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
-END DO
-!
-!liquid water
-ZWORK_GRID(:,:)=ZQLAVE(:,:)
-DO JKRAD=1, KFLEV
- JK1=KFLEV+1-JKRAD
- ZQLAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
-END DO
-
-
-!rain water
-ZWORK_GRID(:,:)=ZQRAVE(:,:)
-DO JKRAD=1, KFLEV
- JK1=KFLEV+1-JKRAD
- ZQRAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
-END DO
-!
-!ice water content
-ZWORK_GRID(:,:)=ZQIWC(:,:)
-DO JKRAD=1, KFLEV
- JK1=KFLEV+1-JKRAD
- ZQIWC(:,JKRAD)=ZWORK_GRID(:,JK1)
-END DO
-!
-!liquid water content
-ZWORK_GRID(:,:)=ZQLWC(:,:)
-DO JKRAD=1, KFLEV
- JK1=KFLEV+1-JKRAD
- ZQLWC(:,JKRAD)=ZWORK_GRID(:,JK1)
-END DO
-
-
-!rain water content
-ZWORK_GRID(:,:)=ZQRWC(:,:)
-DO JKRAD=1, KFLEV
- JK1=KFLEV+1-JKRAD
- ZQRWC(:,JKRAD)=ZWORK_GRID(:,JK1)
-END DO
-
-
-!C2R2 water particle concentration
-!
-IF (SIZE(ZCCT_C2R2) > 0) THEN
- ZWORK_GRID(:,:)=ZCCT_C2R2(:,:)
- DO JKRAD=1, KFLEV
- JK1=KFLEV+1-JKRAD
- ZCCT_C2R2(:,JKRAD)=ZWORK_GRID(:,JK1)
- END DO
-END IF
-IF (SIZE(ZCRT_C2R2) > 0) THEN
- ZWORK_GRID(:,:)=ZCRT_C2R2(:,:)
- DO JKRAD=1, KFLEV
- JK1=KFLEV+1-JKRAD
- ZCRT_C2R2(:,JKRAD)=ZWORK_GRID(:,JK1)
- END DO
-END IF
-IF (SIZE(ZCIT_C1R3) > 0) THEN
- ZWORK_GRID(:,:)=ZCIT_C1R3(:,:)
- DO JKRAD=1, KFLEV
- JK1=KFLEV+1-JKRAD
- ZCIT_C1R3(:,JKRAD)=ZWORK_GRID(:,JK1)
- END DO
-END IF
-!
-!LIMA water particle concentration
-!
-IF( CCLOUD == 'LIMA' ) THEN
- ZWORK_GRID(:,:)=ZCCT_LIMA(:,:)
- DO JKRAD=1, KFLEV
- JK1=KFLEV+1-JKRAD
- ZCCT_LIMA(:,JKRAD)=ZWORK_GRID(:,JK1)
- END DO
-!
- ZWORK_GRID(:,:)=ZCRT_LIMA(:,:)
- DO JKRAD=1, KFLEV
- JK1=KFLEV+1-JKRAD
- ZCRT_LIMA(:,JKRAD)=ZWORK_GRID(:,JK1)
- END DO
-!
- ZWORK_GRID(:,:)=ZCIT_LIMA(:,:)
- DO JKRAD=1, KFLEV
- JK1=KFLEV+1-JKRAD
- ZCIT_LIMA(:,JKRAD)=ZWORK_GRID(:,JK1)
- END DO
-END IF
-!
-!ozone content
-ZWORK_GRID(:,:)=ZO3AVE(:,:)
-DO JKRAD=1, KFLEV
- JK1=KFLEV+1-JKRAD
- ZO3AVE(:,JKRAD)=ZWORK_GRID(:,JK1)
-END DO
-!
-!aerosol optical depth
-DO JI=1,KAER
- ZWORK_GRID(:,:)=ZAER(:,:,JI)
- DO JKRAD=1, KFLEV
- JK1=KFLEV+1-JKRAD
- ZAER(:,JKRAD,JI)=ZWORK_GRID(:,JK1)
- END DO
-END DO
-IF (CAOP=='EXPL') THEN
-!TURN MORE FIELDS UPSIDE DOWN...
-!Dust single scattering albedo
-DO JI=1,KSWB_OLD
- ZWORK_GRID(:,:)=ZPIZA_EQ(:,:,JI)
- DO JKRAD=1,KFLEV
- JK1=KFLEV+1-JKRAD
- ZPIZA_EQ(:,JKRAD,JI)=ZWORK_GRID(:,JK1)
- ENDDO
-ENDDO
-!Dust asymmetry factor
-DO JI=1,KSWB_OLD
- ZWORK_GRID(:,:)=ZCGA_EQ(:,:,JI)
- DO JKRAD=1,KFLEV
- JK1=KFLEV+1-JKRAD
- ZCGA_EQ(:,JKRAD,JI)=ZWORK_GRID(:,JK1)
- ENDDO
-ENDDO
-DO JI=1,KSWB_OLD
- ZWORK_GRID(:,:)=ZTAUREL_EQ(:,:,JI)
- DO JKRAD=1,KFLEV
- JK1=KFLEV+1-JKRAD
- ZTAUREL_EQ(:,JKRAD,JI)=ZWORK_GRID(:,JK1)
- ENDDO
-ENDDO
-
-END IF
-
-!
-DEALLOCATE(ZWORK_GRID)
-!
-!mean layer saturation specific humidity
-!
-ALLOCATE(ZQSAVE(SIZE(ZTAVE,1),SIZE(ZTAVE,2)))
-!
-WHERE (ZTAVE(:,:) > XTT)
- ZQSAVE(:,:) = QSAT(ZTAVE, ZPAVE)
-ELSEWHERE
- ZQSAVE(:,:) = QSATI(ZTAVE, ZPAVE)
-END WHERE
-!
-! allocations for the radiation code outputs
-!
-ALLOCATE(ZDTLW(IDIM,KFLEV))
-ALLOCATE(ZDTSW(IDIM,KFLEV))
-ALLOCATE(ZFLUX_TOP_GND_IRVISNIR(IDIM,KFLUX))
-ALLOCATE(ZSFSWDIR(IDIM,ISWB))
-ALLOCATE(ZSFSWDIF(IDIM,ISWB))
-ALLOCATE(ZDTLW_CS(IDIM,KFLEV))
-ALLOCATE(ZDTSW_CS(IDIM,KFLEV))
-ALLOCATE(ZFLUX_TOP_GND_IRVISNIR_CS(IDIM,KFLUX))
-!
-!
-ALLOCATE(ZFLUX_LW(IDIM,2,KFLEV+1))
-ALLOCATE(ZFLUX_SW_DOWN(IDIM,KFLEV+1))
-ALLOCATE(ZFLUX_SW_UP(IDIM,KFLEV+1))
-ALLOCATE(ZRADLP(IDIM,KFLEV))
-IF( KRAD_DIAG >= 1) THEN
- ALLOCATE(ZNFLW(IDIM,KFLEV+1))
- ALLOCATE(ZNFSW(IDIM,KFLEV+1))
-ELSE
- ALLOCATE(ZNFLW(0,0))
- ALLOCATE(ZNFSW(0,0))
-END IF
-!
-IF( KRAD_DIAG >= 2) THEN
- ALLOCATE(ZFLUX_SW_DOWN_CS(IDIM,KFLEV+1))
- ALLOCATE(ZFLUX_SW_UP_CS(IDIM,KFLEV+1))
- ALLOCATE(ZFLUX_LW_CS(IDIM,2,KFLEV+1))
- ALLOCATE(ZNFLW_CS(IDIM,KFLEV+1))
- ALLOCATE(ZNFSW_CS(IDIM,KFLEV+1))
-ELSE
- ALLOCATE(ZFLUX_SW_DOWN_CS(0,0))
- ALLOCATE(ZFLUX_SW_UP_CS(0,0))
- ALLOCATE(ZFLUX_LW_CS(0,0,0))
- ALLOCATE(ZNFSW_CS(0,0))
- ALLOCATE(ZNFLW_CS(0,0))
-END IF
-!
-IF( KRAD_DIAG >= 3) THEN
- ALLOCATE(ZPLAN_ALB_VIS(IDIM))
- ALLOCATE(ZPLAN_ALB_NIR(IDIM))
- ALLOCATE(ZPLAN_TRA_VIS(IDIM))
- ALLOCATE(ZPLAN_TRA_NIR(IDIM))
- ALLOCATE(ZPLAN_ABS_VIS(IDIM))
- ALLOCATE(ZPLAN_ABS_NIR(IDIM))
-ELSE
- ALLOCATE(ZPLAN_ALB_VIS(0))
- ALLOCATE(ZPLAN_ALB_NIR(0))
- ALLOCATE(ZPLAN_TRA_VIS(0))
- ALLOCATE(ZPLAN_TRA_NIR(0))
- ALLOCATE(ZPLAN_ABS_VIS(0))
- ALLOCATE(ZPLAN_ABS_NIR(0))
-END IF
-!
-IF( KRAD_DIAG >= 4) THEN
- ALLOCATE(ZEFCL_RRTM(IDIM,KFLEV))
- ALLOCATE(ZCLSW_TOTAL(IDIM,KFLEV))
- ALLOCATE(ZTAU_TOTAL(IDIM,KSWB_OLD,KFLEV))
- ALLOCATE(ZOMEGA_TOTAL(IDIM,KSWB_OLD,KFLEV))
- ALLOCATE(ZCG_TOTAL(IDIM,KSWB_OLD,KFLEV))
- ALLOCATE(ZEFCL_LWD(IDIM,KFLEV))
- ALLOCATE(ZEFCL_LWU(IDIM,KFLEV))
- ALLOCATE(ZFLWP(IDIM,KFLEV))
- ALLOCATE(ZFIWP(IDIM,KFLEV))
- ALLOCATE(ZRADIP(IDIM,KFLEV))
-ELSE
- ALLOCATE(ZEFCL_RRTM(0,0))
- ALLOCATE(ZCLSW_TOTAL(0,0))
- ALLOCATE(ZTAU_TOTAL(0,0,0))
- ALLOCATE(ZOMEGA_TOTAL(0,0,0))
- ALLOCATE(ZCG_TOTAL(0,0,0))
- ALLOCATE(ZEFCL_LWD(0,0))
- ALLOCATE(ZEFCL_LWU(0,0))
- ALLOCATE(ZFLWP(0,0))
- ALLOCATE(ZFIWP(0,0))
- ALLOCATE(ZRADIP(0,0))
-END IF
-!
-!* 5.6 CALLS THE ECMWF_RADIATION ROUTINES
-!
-! mixing ratio -> specific humidity conversion (for ECMWF routine)
-! mixing ratio = mv/md ; specific humidity = mv/(mv+md)
-
-ZQVAVE(:,:) = ZQVAVE(:,:) / (1.+ZQVAVE(:,:)) ! Because
-! ZAER = 1e-5*ZAER
-! ZO3AVE = 1e-5*ZO3AVE!
-IF( IDIM <= KRAD_COLNBR ) THEN
-!
-! there is less than KRAD_COLNBR columns to be considered therefore
-! no split of the arrays is performed
-! Note that radiation scheme only takes scalar emissivities so only fist value of the spectral emissivity is taken
- ALLOCATE(ZTAVE_RAD(SIZE(ZTAVE,1),SIZE(ZTAVE,2)))
- ALLOCATE(ZPAVE_RAD(SIZE(ZPAVE,1),SIZE(ZPAVE,2)))
- ZTAVE_RAD = ZTAVE
- ZPAVE_RAD = ZPAVE
- IF (CCLOUD == 'LIMA') THEN
- IF (CRAD == "ECMW") THEN
- CALL ECMWF_RADIATION_VERS2 ( IDIM ,KFLEV, KRAD_DIAG, KAER, &
- ZDZ,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
- ZRII0, ZAER , ZALBD, ZALBP, ZPRES_HL, ZPAVE_RAD, &
- PCCO2, ZCFAVE, ZDPRES, ZEMIS(:,1), ZEMIW(:,1), ZLSM, ZRMU0, &
- ZO3AVE , ZQVAVE, ZQIAVE ,ZQIWC,ZQLAVE,ZQLWC, ZQSAVE, ZQRAVE, ZQRWC, &
- ZT_HL,ZTAVE_RAD, ZTS, ZCCT_LIMA, ZCRT_LIMA, ZCIT_LIMA, &
- ZNFLW_CS, ZNFLW, ZNFSW_CS,ZNFSW, &
- ZDTLW, ZDTSW, ZFLUX_TOP_GND_IRVISNIR, &
- ZSFSWDIR, ZSFSWDIF, &
- ZFLUX_SW_DOWN, ZFLUX_SW_UP, ZFLUX_LW , &
- ZDTLW_CS, ZDTSW_CS, ZFLUX_TOP_GND_IRVISNIR_CS, &
- ZFLUX_SW_DOWN_CS, ZFLUX_SW_UP_CS, ZFLUX_LW_CS, &
- ZPLAN_ALB_VIS,ZPLAN_ALB_NIR, ZPLAN_TRA_VIS, ZPLAN_TRA_NIR, &
- ZPLAN_ABS_VIS, ZPLAN_ABS_NIR,ZEFCL_LWD, ZEFCL_LWU, &
- ZFLWP, ZFIWP,ZRADLP, ZRADIP,ZEFCL_RRTM, ZCLSW_TOTAL, ZTAU_TOTAL, &
- ZOMEGA_TOTAL,ZCG_TOTAL, &
- GAOP, ZPIZA_EQ,ZCGA_EQ,ZTAUREL_EQ )
-
-
- ELSE IF (CRAD == "ECRA") THEN
- CALL ECRAD_INTERFACE ( IDIM ,KFLEV, KRAD_DIAG, KAER, &
- ZDZ,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
- ZRII0, ZAER , ZALBD, ZALBP, ZPRES_HL, ZPAVE_RAD, &
- PCCO2, ZCFAVE, ZDPRES, ZEMIS(:,1), ZEMIW(:,1), ZLSM, ZRMU0, &
- ZO3AVE , ZQVAVE, ZQIAVE ,ZQIWC,ZQLAVE,ZQLWC, ZQSAVE, ZQRAVE, ZQRWC, &
- ZT_HL,ZTAVE_RAD, ZTS, ZCCT_LIMA, ZCRT_LIMA, ZCIT_LIMA, &
- ZNFLW, ZNFSW, ZNFLW_CS, ZNFSW_CS, &
- ZDTLW, ZDTSW, ZFLUX_TOP_GND_IRVISNIR, &
- ZSFSWDIR, ZSFSWDIF, &
- ZFLUX_SW_DOWN, ZFLUX_SW_UP, ZFLUX_LW , &
- ZDTLW_CS, ZDTSW_CS, ZFLUX_TOP_GND_IRVISNIR_CS, &
- ZFLUX_SW_DOWN_CS, ZFLUX_SW_UP_CS, ZFLUX_LW_CS, &
- ZPLAN_ALB_VIS,ZPLAN_ALB_NIR, ZPLAN_TRA_VIS, ZPLAN_TRA_NIR, &
- ZPLAN_ABS_VIS, ZPLAN_ABS_NIR,ZEFCL_LWD, ZEFCL_LWU, &
- ZFLWP, ZFIWP,ZRADLP, ZRADIP,ZEFCL_RRTM, ZCLSW_TOTAL, ZTAU_TOTAL, &
- ZOMEGA_TOTAL,ZCG_TOTAL, &
- GAOP, ZPIZA_EQ,ZCGA_EQ,ZTAUREL_EQ,ZLAT,ZLON )
- ENDIF
-
- ELSE
- IF (CRAD == "ECMW") THEN
- CALL ECMWF_RADIATION_VERS2 ( IDIM ,KFLEV, KRAD_DIAG, KAER, &
- ZDZ,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
- ZRII0, ZAER , ZALBD, ZALBP, ZPRES_HL, ZPAVE_RAD, &
- PCCO2, ZCFAVE, ZDPRES, ZEMIS(:,1), ZEMIW(:,1), ZLSM, ZRMU0, &
- ZO3AVE , ZQVAVE, ZQIAVE ,ZQIWC,ZQLAVE,ZQLWC, ZQSAVE, ZQRAVE, ZQRWC, &
- ZT_HL,ZTAVE_RAD, ZTS, ZCCT_C2R2, ZCRT_C2R2, ZCIT_C1R3, &
- ZNFLW_CS, ZNFLW, ZNFSW_CS,ZNFSW, &
- ZDTLW, ZDTSW, ZFLUX_TOP_GND_IRVISNIR, &
- ZSFSWDIR, ZSFSWDIF, &
- ZFLUX_SW_DOWN, ZFLUX_SW_UP, ZFLUX_LW , &
- ZDTLW_CS, ZDTSW_CS, ZFLUX_TOP_GND_IRVISNIR_CS, &
- ZFLUX_SW_DOWN_CS, ZFLUX_SW_UP_CS, ZFLUX_LW_CS, &
- ZPLAN_ALB_VIS,ZPLAN_ALB_NIR, ZPLAN_TRA_VIS, ZPLAN_TRA_NIR, &
- ZPLAN_ABS_VIS, ZPLAN_ABS_NIR,ZEFCL_LWD, ZEFCL_LWU, &
- ZFLWP, ZFIWP,ZRADLP, ZRADIP,ZEFCL_RRTM, ZCLSW_TOTAL, ZTAU_TOTAL, &
- ZOMEGA_TOTAL,ZCG_TOTAL, &
- GAOP, ZPIZA_EQ,ZCGA_EQ,ZTAUREL_EQ )
-
- ELSE IF (CRAD == "ECRA") THEN
- CALL ECRAD_INTERFACE ( IDIM ,KFLEV, KRAD_DIAG, KAER, &
- ZDZ,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
- ZRII0, ZAER , ZALBD, ZALBP, ZPRES_HL, ZPAVE_RAD, &
- PCCO2, ZCFAVE, ZDPRES, ZEMIS(:,1), ZEMIW(:,1), ZLSM, ZRMU0, &
- ZO3AVE , ZQVAVE, ZQIAVE ,ZQIWC,ZQLAVE,ZQLWC, ZQSAVE, ZQRAVE, ZQRWC, &
- ZT_HL,ZTAVE_RAD, ZTS, ZCCT_C2R2, ZCRT_C2R2, ZCIT_C1R3, &
- ZNFLW, ZNFSW, ZNFLW_CS, ZNFSW_CS, &
- ZDTLW, ZDTSW, ZFLUX_TOP_GND_IRVISNIR, &
- ZSFSWDIR, ZSFSWDIF, &
- ZFLUX_SW_DOWN, ZFLUX_SW_UP, ZFLUX_LW , &
- ZDTLW_CS, ZDTSW_CS, ZFLUX_TOP_GND_IRVISNIR_CS, &
- ZFLUX_SW_DOWN_CS, ZFLUX_SW_UP_CS, ZFLUX_LW_CS, &
- ZPLAN_ALB_VIS,ZPLAN_ALB_NIR, ZPLAN_TRA_VIS, ZPLAN_TRA_NIR, &
- ZPLAN_ABS_VIS, ZPLAN_ABS_NIR,ZEFCL_LWD, ZEFCL_LWU, &
- ZFLWP, ZFIWP,ZRADLP, ZRADIP,ZEFCL_RRTM, ZCLSW_TOTAL, ZTAU_TOTAL, &
- ZOMEGA_TOTAL,ZCG_TOTAL, &
- GAOP, ZPIZA_EQ,ZCGA_EQ,ZTAUREL_EQ ,ZLAT,ZLON )
- END IF
-
-
- END IF
- DEALLOCATE(ZTAVE_RAD,ZPAVE_RAD)
-!
-ELSE
-!
-! the splitting of the arrays will be performed
-!
- INUM_CALL = CEILING( REAL( IDIM ) / REAL( KRAD_COLNBR ) )
- IDIM_RESIDUE = IDIM
-!
- DO JI_SPLIT = 1 , INUM_CALL
- IDIM_EFF = MIN( IDIM_RESIDUE,KRAD_COLNBR )
- !
- IF( JI_SPLIT == 1 .OR. JI_SPLIT == INUM_CALL ) THEN
- ALLOCATE( ZALBP_SPLIT(IDIM_EFF,KSWB_MNH))
- ALLOCATE( ZALBD_SPLIT(IDIM_EFF,KSWB_MNH))
- ALLOCATE( ZEMIS_SPLIT(IDIM_EFF))
- ALLOCATE( ZEMIW_SPLIT(IDIM_EFF))
- ALLOCATE( ZRMU0_SPLIT(IDIM_EFF))
- ALLOCATE( ZLAT_SPLIT(IDIM_EFF))
- ALLOCATE( ZLON_SPLIT(IDIM_EFF))
- ALLOCATE( ZCFAVE_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZO3AVE_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZT_HL_SPLIT(IDIM_EFF,KFLEV+1))
- ALLOCATE( ZPRES_HL_SPLIT(IDIM_EFF,KFLEV+1))
- ALLOCATE( ZDZ_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZQLAVE_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZQIAVE_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZQRAVE_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZQLWC_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZQIWC_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZQRWC_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZQVAVE_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZTAVE_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZPAVE_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZAER_SPLIT( IDIM_EFF,KFLEV,KAER))
- ALLOCATE( ZPIZA_EQ_SPLIT(IDIM_EFF,KFLEV,KSWB_OLD))
- ALLOCATE( ZCGA_EQ_SPLIT(IDIM_EFF,KFLEV,KSWB_OLD))
- ALLOCATE( ZTAUREL_EQ_SPLIT(IDIM_EFF,KFLEV,KSWB_OLD))
- ALLOCATE( ZDPRES_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZLSM_SPLIT(IDIM_EFF))
- ALLOCATE( ZQSAVE_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZTS_SPLIT(IDIM_EFF))
- ! output pronostic
- ALLOCATE( ZDTLW_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZDTSW_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZFLUX_TOP_GND_IRVISNIR_SPLIT(IDIM_EFF,KFLUX))
- ALLOCATE( ZSFSWDIR_SPLIT(IDIM_EFF,ISWB))
- ALLOCATE( ZSFSWDIF_SPLIT(IDIM_EFF,ISWB))
- ALLOCATE( ZDTLW_CS_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZDTSW_CS_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT(IDIM_EFF,KFLUX))
-!
- ALLOCATE( ZFLUX_LW_SPLIT(IDIM_EFF,2,KFLEV+1))
- ALLOCATE( ZFLUX_SW_DOWN_SPLIT(IDIM_EFF,KFLEV+1))
- ALLOCATE( ZFLUX_SW_UP_SPLIT(IDIM_EFF,KFLEV+1))
- ALLOCATE( ZRADLP_SPLIT(IDIM_EFF,KFLEV))
- IF(KRAD_DIAG >=1) THEN
- ALLOCATE( ZNFSW_SPLIT(IDIM_EFF,KFLEV+1))
- ALLOCATE( ZNFLW_SPLIT(IDIM_EFF,KFLEV+1))
- ELSE
- ALLOCATE( ZNFSW_SPLIT(0,0))
- ALLOCATE( ZNFLW_SPLIT(0,0))
- END IF
-!
- IF( KRAD_DIAG >= 2) THEN
- ALLOCATE( ZFLUX_SW_DOWN_CS_SPLIT(IDIM_EFF,KFLEV+1))
- ALLOCATE( ZFLUX_SW_UP_CS_SPLIT(IDIM_EFF,KFLEV+1))
- ALLOCATE( ZFLUX_LW_CS_SPLIT(IDIM_EFF,2,KFLEV+1))
- ALLOCATE( ZNFSW_CS_SPLIT(IDIM_EFF,KFLEV+1))
- ALLOCATE( ZNFLW_CS_SPLIT(IDIM_EFF,KFLEV+1))
- ELSE
- ALLOCATE( ZFLUX_SW_DOWN_CS_SPLIT(0,0))
- ALLOCATE( ZFLUX_SW_UP_CS_SPLIT(0,0))
- ALLOCATE( ZFLUX_LW_CS_SPLIT(0,0,0))
- ALLOCATE( ZNFSW_CS_SPLIT(0,0))
- ALLOCATE( ZNFLW_CS_SPLIT(0,0))
- END IF
-!
- IF( KRAD_DIAG >= 3) THEN
- ALLOCATE( ZPLAN_ALB_VIS_SPLIT(IDIM_EFF))
- ALLOCATE( ZPLAN_ALB_NIR_SPLIT(IDIM_EFF))
- ALLOCATE( ZPLAN_TRA_VIS_SPLIT(IDIM_EFF))
- ALLOCATE( ZPLAN_TRA_NIR_SPLIT(IDIM_EFF))
- ALLOCATE( ZPLAN_ABS_VIS_SPLIT(IDIM_EFF))
- ALLOCATE( ZPLAN_ABS_NIR_SPLIT(IDIM_EFF))
- ELSE
- ALLOCATE( ZPLAN_ALB_VIS_SPLIT(0))
- ALLOCATE( ZPLAN_ALB_NIR_SPLIT(0))
- ALLOCATE( ZPLAN_TRA_VIS_SPLIT(0))
- ALLOCATE( ZPLAN_TRA_NIR_SPLIT(0))
- ALLOCATE( ZPLAN_ABS_VIS_SPLIT(0))
- ALLOCATE( ZPLAN_ABS_NIR_SPLIT(0))
- END IF
-!
- IF( KRAD_DIAG >= 4) THEN
- ALLOCATE( ZEFCL_RRTM_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZCLSW_TOTAL_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZTAU_TOTAL_SPLIT(IDIM_EFF,KSWB_OLD,KFLEV))
- ALLOCATE( ZOMEGA_TOTAL_SPLIT(IDIM_EFF,KSWB_OLD,KFLEV))
- ALLOCATE( ZCG_TOTAL_SPLIT(IDIM_EFF,KSWB_OLD,KFLEV))
- ALLOCATE( ZEFCL_LWD_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZEFCL_LWU_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZFLWP_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZFIWP_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE( ZRADIP_SPLIT(IDIM_EFF,KFLEV))
- ELSE
- ALLOCATE( ZEFCL_RRTM_SPLIT(0,0))
- ALLOCATE( ZCLSW_TOTAL_SPLIT(0,0))
- ALLOCATE( ZTAU_TOTAL_SPLIT(0,0,0))
- ALLOCATE( ZOMEGA_TOTAL_SPLIT(0,0,0))
- ALLOCATE( ZCG_TOTAL_SPLIT(0,0,0))
- ALLOCATE( ZEFCL_LWD_SPLIT(0,0))
- ALLOCATE( ZEFCL_LWU_SPLIT(0,0))
- ALLOCATE( ZFLWP_SPLIT(0,0))
- ALLOCATE( ZFIWP_SPLIT(0,0))
- ALLOCATE( ZRADIP_SPLIT(0,0))
- END IF
-!
-! C2R2 coupling
-!
- IF (SIZE (ZCCT_C2R2) > 0) THEN
- ALLOCATE (ZCCT_C2R2_SPLIT(IDIM_EFF,KFLEV))
- ELSE
- ALLOCATE (ZCCT_C2R2_SPLIT(0,0))
- END IF
-!
- IF (SIZE (ZCRT_C2R2) > 0) THEN
- ALLOCATE (ZCRT_C2R2_SPLIT(IDIM_EFF,KFLEV))
- ELSE
- ALLOCATE (ZCRT_C2R2_SPLIT(0,0))
- END IF
-!
- IF (SIZE (ZCIT_C1R3) > 0) THEN
- ALLOCATE (ZCIT_C1R3_SPLIT(IDIM_EFF,KFLEV))
- ELSE
- ALLOCATE (ZCIT_C1R3_SPLIT(0,0))
- END IF
-!
-! LIMA coupling
-!
- IF( CCLOUD == 'LIMA' ) THEN
- ALLOCATE (ZCCT_LIMA_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE (ZCRT_LIMA_SPLIT(IDIM_EFF,KFLEV))
- ALLOCATE (ZCIT_LIMA_SPLIT(IDIM_EFF,KFLEV))
- END IF
- END IF
-!
-! fill the split arrays with their values taken from the full arrays
-!
- IBEG = IDIM-IDIM_RESIDUE+1
- IEND = IBEG+IDIM_EFF-1
-!
- ZALBP_SPLIT(:,:) = ZALBP( IBEG:IEND ,:)
- ZALBD_SPLIT(:,:) = ZALBD( IBEG:IEND ,:)
- ZEMIS_SPLIT(:) = ZEMIS ( IBEG:IEND,1 )
- ZEMIW_SPLIT(:) = ZEMIW ( IBEG:IEND,1 )
- ZRMU0_SPLIT(:) = ZRMU0 ( IBEG:IEND )
- ZLAT_SPLIT(:) = ZLAT ( IBEG:IEND )
- ZLON_SPLIT(:) = ZLON ( IBEG:IEND )
- ZCFAVE_SPLIT(:,:) = ZCFAVE( IBEG:IEND ,:)
- ZO3AVE_SPLIT(:,:) = ZO3AVE( IBEG:IEND ,:)
- ZT_HL_SPLIT(:,:) = ZT_HL( IBEG:IEND ,:)
- ZPRES_HL_SPLIT(:,:) = ZPRES_HL( IBEG:IEND ,:)
- ZQLAVE_SPLIT(:,:) = ZQLAVE( IBEG:IEND , :)
- ZDZ_SPLIT(:,:) = ZDZ( IBEG:IEND , :)
- ZQIAVE_SPLIT(:,:) = ZQIAVE( IBEG:IEND ,:)
- ZQRAVE_SPLIT (:,:) = ZQRAVE (IBEG:IEND ,:)
- ZQLWC_SPLIT(:,:) = ZQLWC( IBEG:IEND , :)
- ZQIWC_SPLIT(:,:) = ZQIWC( IBEG:IEND ,:)
- ZQRWC_SPLIT(:,:) = ZQRWC (IBEG:IEND ,:)
- ZQVAVE_SPLIT(:,:) = ZQVAVE( IBEG:IEND ,:)
- ZTAVE_SPLIT(:,:) = ZTAVE ( IBEG:IEND ,:)
- ZPAVE_SPLIT(:,:) = ZPAVE ( IBEG:IEND ,:)
- ZAER_SPLIT (:,:,:) = ZAER ( IBEG:IEND ,:,:)
- IF(CAOP=='EXPL')THEN
- ZPIZA_EQ_SPLIT(:,:,:)=ZPIZA_EQ(IBEG:IEND,:,:)
- ZCGA_EQ_SPLIT(:,:,:)=ZCGA_EQ(IBEG:IEND,:,:)
- ZTAUREL_EQ_SPLIT(:,:,:)=ZTAUREL_EQ(IBEG:IEND,:,:)
- ENDIF
- ZDPRES_SPLIT(:,:) = ZDPRES (IBEG:IEND ,:)
- ZLSM_SPLIT (:) = ZLSM (IBEG:IEND)
- ZQSAVE_SPLIT (:,:) = ZQSAVE (IBEG:IEND ,:)
- ZTS_SPLIT (:) = ZTS (IBEG:IEND)
-!
-! CALL the ECMWF radiation with the split array
-!
- IF (CCLOUD == 'LIMA') THEN
-! LIMA concentrations
- ZCCT_LIMA_SPLIT(:,:) = ZCCT_LIMA (IBEG:IEND ,:)
- ZCRT_LIMA_SPLIT(:,:) = ZCRT_LIMA (IBEG:IEND ,:)
- ZCIT_LIMA_SPLIT(:,:) = ZCIT_LIMA (IBEG:IEND ,:)
-
- IF (CRAD == "ECMW") THEN
-!
- CALL ECMWF_RADIATION_VERS2 ( IDIM_EFF , KFLEV, KRAD_DIAG, KAER, &
- ZDZ_SPLIT,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
- ZRII0, ZAER_SPLIT , ZALBD_SPLIT, ZALBP_SPLIT, ZPRES_HL_SPLIT, &
- ZPAVE_SPLIT,PCCO2, ZCFAVE_SPLIT, ZDPRES_SPLIT, ZEMIS_SPLIT, ZEMIW_SPLIT, &
- ZLSM_SPLIT, ZRMU0_SPLIT,ZO3AVE_SPLIT , ZQVAVE_SPLIT, ZQIAVE_SPLIT ,ZQIWC_SPLIT, &
- ZQLAVE_SPLIT,ZQLWC_SPLIT,ZQSAVE_SPLIT, ZQRAVE_SPLIT,ZQRWC_SPLIT, ZT_HL_SPLIT, &
- ZTAVE_SPLIT, ZTS_SPLIT, ZCCT_LIMA_SPLIT,ZCRT_LIMA_SPLIT,ZCIT_LIMA_SPLIT, &
- ZNFLW_CS_SPLIT, ZNFLW_SPLIT, ZNFSW_CS_SPLIT,ZNFSW_SPLIT, &
- ZDTLW_SPLIT, ZDTSW_SPLIT, ZFLUX_TOP_GND_IRVISNIR_SPLIT, &
- ZSFSWDIR_SPLIT, ZSFSWDIF_SPLIT, &
- ZFLUX_SW_DOWN_SPLIT, ZFLUX_SW_UP_SPLIT, ZFLUX_LW_SPLIT , &
- ZDTLW_CS_SPLIT, ZDTSW_CS_SPLIT, ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT, &
- ZFLUX_SW_DOWN_CS_SPLIT, ZFLUX_SW_UP_CS_SPLIT, ZFLUX_LW_CS_SPLIT, &
- ZPLAN_ALB_VIS_SPLIT,ZPLAN_ALB_NIR_SPLIT, ZPLAN_TRA_VIS_SPLIT, &
- ZPLAN_TRA_NIR_SPLIT, ZPLAN_ABS_VIS_SPLIT, ZPLAN_ABS_NIR_SPLIT, &
- ZEFCL_LWD_SPLIT, ZEFCL_LWU_SPLIT, ZFLWP_SPLIT,ZFIWP_SPLIT, &
- ZRADLP_SPLIT,ZRADIP_SPLIT,ZEFCL_RRTM_SPLIT, ZCLSW_TOTAL_SPLIT, &
- ZTAU_TOTAL_SPLIT,ZOMEGA_TOTAL_SPLIT, ZCG_TOTAL_SPLIT, &
- GAOP,ZPIZA_EQ_SPLIT,ZCGA_EQ_SPLIT,ZTAUREL_EQ_SPLIT )
-
- ELSE IF (CRAD == "ECRA") THEN
- CALL ECRAD_INTERFACE ( IDIM_EFF ,KFLEV, KRAD_DIAG, KAER, &
- ZDZ,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
- ZRII0, ZAER_SPLIT , ZALBD_SPLIT, ZALBP_SPLIT, ZPRES_HL_SPLIT, ZPAVE_SPLIT, &
- PCCO2, ZCFAVE_SPLIT, ZDPRES_SPLIT, ZEMIS_SPLIT, ZEMIW_SPLIT, ZLSM_SPLIT, ZRMU0_SPLIT, &
- ZO3AVE_SPLIT , ZQVAVE_SPLIT, ZQIAVE_SPLIT ,ZQIWC_SPLIT,ZQLAVE_SPLIT,ZQLWC_SPLIT, &
- ZQSAVE_SPLIT, ZQRAVE_SPLIT, ZQRWC_SPLIT, &
- ZT_HL_SPLIT,ZTAVE_SPLIT, ZTS_SPLIT, ZCCT_LIMA_SPLIT, &
- ZCRT_LIMA_SPLIT, ZCIT_LIMA_SPLIT, &
- ZNFLW_SPLIT, ZNFSW_SPLIT, ZNFLW_CS_SPLIT, ZNFSW_CS_SPLIT, &
- ZDTLW_SPLIT, ZDTSW_SPLIT, ZFLUX_TOP_GND_IRVISNIR_SPLIT, &
- ZSFSWDIR_SPLIT, ZSFSWDIF_SPLIT, &
- ZFLUX_SW_DOWN_SPLIT, ZFLUX_SW_UP_SPLIT, ZFLUX_LW_SPLIT , &
- ZDTLW_CS_SPLIT, ZDTSW_CS_SPLIT, ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT, &
- ZFLUX_SW_DOWN_CS_SPLIT, ZFLUX_SW_UP_CS_SPLIT, ZFLUX_LW_CS_SPLIT, &
- ZPLAN_ALB_VIS_SPLIT,ZPLAN_ALB_NIR_SPLIT, ZPLAN_TRA_VIS_SPLIT, ZPLAN_TRA_NIR_SPLIT, &
- ZPLAN_ABS_VIS_SPLIT, ZPLAN_ABS_NIR_SPLIT,ZEFCL_LWD_SPLIT, ZEFCL_LWU_SPLIT, &
- ZFLWP_SPLIT, ZFIWP_SPLIT,ZRADLP_SPLIT, ZRADIP_SPLIT, &
- ZEFCL_RRTM_SPLIT, ZCLSW_TOTAL_SPLIT, ZTAU_TOTAL_SPLIT, &
- ZOMEGA_TOTAL_SPLIT,ZCG_TOTAL_SPLIT, &
- GAOP, ZPIZA_EQ_SPLIT,ZCGA_EQ_SPLIT,ZTAUREL_EQ_SPLIT,ZLAT_SPLIT,ZLON_SPLIT )
- END IF
- ELSE
-! C2R2 concentrations
- IF (SIZE (ZCCT_C2R2) > 0) ZCCT_C2R2_SPLIT(:,:) = ZCCT_C2R2 (IBEG:IEND ,:)
- IF (SIZE (ZCRT_C2R2) > 0) ZCRT_C2R2_SPLIT(:,:) = ZCRT_C2R2 (IBEG:IEND ,:)
- IF (SIZE (ZCIT_C1R3) > 0) ZCIT_C1R3_SPLIT(:,:) = ZCIT_C1R3 (IBEG:IEND ,:)
- IF (CRAD == "ECMW") THEN
- CALL ECMWF_RADIATION_VERS2 ( IDIM_EFF , KFLEV, KRAD_DIAG, KAER, &
- ZDZ_SPLIT,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
- ZRII0, ZAER_SPLIT , ZALBD_SPLIT, ZALBP_SPLIT, ZPRES_HL_SPLIT, &
- ZPAVE_SPLIT,PCCO2, ZCFAVE_SPLIT, ZDPRES_SPLIT, ZEMIS_SPLIT, ZEMIW_SPLIT, &
- ZLSM_SPLIT, ZRMU0_SPLIT,ZO3AVE_SPLIT , ZQVAVE_SPLIT, ZQIAVE_SPLIT ,ZQIWC_SPLIT, &
- ZQLAVE_SPLIT,ZQLWC_SPLIT,ZQSAVE_SPLIT, ZQRAVE_SPLIT,ZQRWC_SPLIT, ZT_HL_SPLIT, &
- ZTAVE_SPLIT, ZTS_SPLIT, ZCCT_C2R2_SPLIT,ZCRT_C2R2_SPLIT,ZCIT_C1R3_SPLIT, &
- ZNFLW_CS_SPLIT, ZNFLW_SPLIT, ZNFSW_CS_SPLIT,ZNFSW_SPLIT, &
- ZDTLW_SPLIT, ZDTSW_SPLIT, ZFLUX_TOP_GND_IRVISNIR_SPLIT, &
- ZSFSWDIR_SPLIT, ZSFSWDIF_SPLIT, &
- ZFLUX_SW_DOWN_SPLIT, ZFLUX_SW_UP_SPLIT, ZFLUX_LW_SPLIT , &
- ZDTLW_CS_SPLIT, ZDTSW_CS_SPLIT, ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT, &
- ZFLUX_SW_DOWN_CS_SPLIT, ZFLUX_SW_UP_CS_SPLIT, ZFLUX_LW_CS_SPLIT, &
- ZPLAN_ALB_VIS_SPLIT,ZPLAN_ALB_NIR_SPLIT, ZPLAN_TRA_VIS_SPLIT, &
- ZPLAN_TRA_NIR_SPLIT, ZPLAN_ABS_VIS_SPLIT, ZPLAN_ABS_NIR_SPLIT, &
- ZEFCL_LWD_SPLIT, ZEFCL_LWU_SPLIT, ZFLWP_SPLIT,ZFIWP_SPLIT, &
- ZRADLP_SPLIT,ZRADIP_SPLIT,ZEFCL_RRTM_SPLIT, ZCLSW_TOTAL_SPLIT, &
- ZTAU_TOTAL_SPLIT,ZOMEGA_TOTAL_SPLIT, ZCG_TOTAL_SPLIT, &
- GAOP,ZPIZA_EQ_SPLIT,ZCGA_EQ_SPLIT,ZTAUREL_EQ_SPLIT )
-
- ELSE IF (CRAD == "ECRA") THEN
- CALL ECRAD_INTERFACE ( IDIM_EFF ,KFLEV, KRAD_DIAG, KAER, &
- ZDZ_SPLIT,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG, &
- ZRII0, ZAER_SPLIT , ZALBD_SPLIT, ZALBP_SPLIT, ZPRES_HL_SPLIT, ZPAVE_SPLIT, &
- PCCO2, ZCFAVE_SPLIT, ZDPRES_SPLIT, ZEMIS_SPLIT, ZEMIW_SPLIT, ZLSM_SPLIT, ZRMU0_SPLIT, &
- ZO3AVE_SPLIT , ZQVAVE_SPLIT, ZQIAVE_SPLIT ,ZQIWC_SPLIT,ZQLAVE_SPLIT,ZQLWC_SPLIT, &
- ZQSAVE_SPLIT, ZQRAVE_SPLIT, ZQRWC_SPLIT, &
- ZT_HL_SPLIT,ZTAVE_SPLIT, ZTS_SPLIT, ZCCT_C2R2_SPLIT, &
- ZCRT_C2R2_SPLIT, ZCIT_C1R3_SPLIT, &
- ZNFLW_SPLIT, ZNFSW_SPLIT, ZNFLW_CS_SPLIT, ZNFSW_CS_SPLIT, &
- ZDTLW_SPLIT, ZDTSW_SPLIT, ZFLUX_TOP_GND_IRVISNIR_SPLIT, &
- ZSFSWDIR_SPLIT, ZSFSWDIF_SPLIT, &
- ZFLUX_SW_DOWN_SPLIT, ZFLUX_SW_UP_SPLIT, ZFLUX_LW_SPLIT , &
- ZDTLW_CS_SPLIT, ZDTSW_CS_SPLIT, ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT, &
- ZFLUX_SW_DOWN_CS_SPLIT, ZFLUX_SW_UP_CS_SPLIT, ZFLUX_LW_CS_SPLIT, &
- ZPLAN_ALB_VIS_SPLIT,ZPLAN_ALB_NIR_SPLIT, ZPLAN_TRA_VIS_SPLIT, ZPLAN_TRA_NIR_SPLIT, &
- ZPLAN_ABS_VIS_SPLIT, ZPLAN_ABS_NIR_SPLIT,ZEFCL_LWD_SPLIT, ZEFCL_LWU_SPLIT, &
- ZFLWP_SPLIT, ZFIWP_SPLIT,ZRADLP_SPLIT, ZRADIP_SPLIT, &
- ZEFCL_RRTM_SPLIT, ZCLSW_TOTAL_SPLIT, ZTAU_TOTAL_SPLIT, &
- ZOMEGA_TOTAL_SPLIT,ZCG_TOTAL_SPLIT, &
- GAOP, ZPIZA_EQ_SPLIT,ZCGA_EQ_SPLIT,ZTAUREL_EQ_SPLIT,ZLAT_SPLIT,ZLON_SPLIT )
- END IF
- END IF
-!
-! fill the full output arrays with the split arrays
-!
- ZDTLW( IBEG:IEND ,:) = ZDTLW_SPLIT(:,:)
- ZDTSW( IBEG:IEND ,:) = ZDTSW_SPLIT(:,:)
- ZFLUX_TOP_GND_IRVISNIR( IBEG:IEND ,:)= ZFLUX_TOP_GND_IRVISNIR_SPLIT(:,:)
- ZSFSWDIR (IBEG:IEND,:) = ZSFSWDIR_SPLIT(:,:)
- ZSFSWDIF (IBEG:IEND,:) = ZSFSWDIF_SPLIT(:,:)
-!
- ZDTLW_CS( IBEG:IEND ,:) = ZDTLW_CS_SPLIT(:,:)
- ZDTSW_CS( IBEG:IEND ,:) = ZDTSW_CS_SPLIT(:,:)
- ZFLUX_TOP_GND_IRVISNIR_CS( IBEG:IEND ,:) = &
- ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT(:,:)
- ZFLUX_LW( IBEG:IEND ,:,:) = ZFLUX_LW_SPLIT(:,:,:)
- ZFLUX_SW_DOWN( IBEG:IEND ,:) = ZFLUX_SW_DOWN_SPLIT(:,:)
- ZFLUX_SW_UP( IBEG:IEND ,:) = ZFLUX_SW_UP_SPLIT(:,:)
- ZRADLP( IBEG:IEND ,:) = ZRADLP_SPLIT(:,:)
- IF ( tpfile%lopened ) THEN
- IF( KRAD_DIAG >= 1) THEN
- ZNFLW(IBEG:IEND ,:)= ZNFLW_SPLIT(:,:)
- ZNFSW(IBEG:IEND ,:)= ZNFSW_SPLIT(:,:)
- IF( KRAD_DIAG >= 2) THEN
- ZFLUX_SW_DOWN_CS( IBEG:IEND ,:) = ZFLUX_SW_DOWN_CS_SPLIT(:,:)
- ZFLUX_SW_UP_CS( IBEG:IEND ,:) = ZFLUX_SW_UP_CS_SPLIT(:,:)
- ZFLUX_LW_CS( IBEG:IEND ,:,:) = ZFLUX_LW_CS_SPLIT(:,:,:)
- ZNFLW_CS(IBEG:IEND ,:)= ZNFLW_CS_SPLIT(:,:)
- ZNFSW_CS(IBEG:IEND ,:)= ZNFSW_CS_SPLIT(:,:)
- IF( KRAD_DIAG >= 3) THEN
- ZPLAN_ALB_VIS( IBEG:IEND ) = ZPLAN_ALB_VIS_SPLIT(:)
- ZPLAN_ALB_NIR( IBEG:IEND ) = ZPLAN_ALB_NIR_SPLIT(:)
- ZPLAN_TRA_VIS( IBEG:IEND ) = ZPLAN_TRA_VIS_SPLIT(:)
- ZPLAN_TRA_NIR( IBEG:IEND ) = ZPLAN_TRA_NIR_SPLIT(:)
- ZPLAN_ABS_VIS( IBEG:IEND ) = ZPLAN_ABS_VIS_SPLIT(:)
- ZPLAN_ABS_NIR( IBEG:IEND ) = ZPLAN_ABS_NIR_SPLIT(:)
- IF( KRAD_DIAG >= 4) THEN
- ZEFCL_LWD( IBEG:IEND ,:) = ZEFCL_LWD_SPLIT(:,:)
- ZEFCL_LWU( IBEG:IEND ,:) = ZEFCL_LWU_SPLIT(:,:)
- ZFLWP( IBEG:IEND ,:) = ZFLWP_SPLIT(:,:)
- ZFIWP( IBEG:IEND ,:) = ZFIWP_SPLIT(:,:)
- ZRADIP( IBEG:IEND ,:) = ZRADIP_SPLIT(:,:)
- ZEFCL_RRTM( IBEG:IEND ,:) = ZEFCL_RRTM_SPLIT(:,:)
- ZCLSW_TOTAL( IBEG:IEND ,:) = ZCLSW_TOTAL_SPLIT(:,:)
- ZTAU_TOTAL( IBEG:IEND ,:,:) = ZTAU_TOTAL_SPLIT(:,:,:)
- ZOMEGA_TOTAL( IBEG:IEND ,:,:)= ZOMEGA_TOTAL_SPLIT(:,:,:)
- ZCG_TOTAL( IBEG:IEND ,:,:) = ZCG_TOTAL_SPLIT(:,:,:)
- END IF
- END IF
- END IF
- END IF
- END IF
-!
- IDIM_RESIDUE = IDIM_RESIDUE - IDIM_EFF
-!
-! desallocation of the split arrays
-!
- IF( JI_SPLIT >= INUM_CALL-1 ) THEN
- DEALLOCATE( ZALBP_SPLIT )
- DEALLOCATE( ZALBD_SPLIT )
- DEALLOCATE( ZEMIS_SPLIT )
- DEALLOCATE( ZEMIW_SPLIT )
- DEALLOCATE( ZLAT_SPLIT )
- DEALLOCATE( ZLON_SPLIT )
- DEALLOCATE( ZRMU0_SPLIT )
- DEALLOCATE( ZCFAVE_SPLIT )
- DEALLOCATE( ZO3AVE_SPLIT )
- DEALLOCATE( ZT_HL_SPLIT )
- DEALLOCATE( ZPRES_HL_SPLIT )
- DEALLOCATE( ZDZ_SPLIT )
- DEALLOCATE( ZQLAVE_SPLIT )
- DEALLOCATE( ZQIAVE_SPLIT )
- DEALLOCATE( ZQVAVE_SPLIT )
- DEALLOCATE( ZTAVE_SPLIT )
- DEALLOCATE( ZPAVE_SPLIT )
- DEALLOCATE( ZAER_SPLIT )
- DEALLOCATE( ZDPRES_SPLIT )
- DEALLOCATE( ZLSM_SPLIT )
- DEALLOCATE( ZQSAVE_SPLIT )
- DEALLOCATE( ZQRAVE_SPLIT )
- DEALLOCATE( ZQLWC_SPLIT )
- DEALLOCATE( ZQRWC_SPLIT )
- DEALLOCATE( ZQIWC_SPLIT )
- IF ( ALLOCATED( ZCCT_C2R2_SPLIT ) ) DEALLOCATE( ZCCT_C2R2_SPLIT )
- IF ( ALLOCATED( ZCRT_C2R2_SPLIT ) ) DEALLOCATE( ZCRT_C2R2_SPLIT )
- IF ( ALLOCATED( ZCIT_C1R3_SPLIT ) ) DEALLOCATE( ZCIT_C1R3_SPLIT )
- IF ( ALLOCATED( ZCCT_LIMA_SPLIT ) ) DEALLOCATE( ZCCT_LIMA_SPLIT )
- IF ( ALLOCATED( ZCRT_LIMA_SPLIT ) ) DEALLOCATE( ZCRT_LIMA_SPLIT )
- IF ( ALLOCATED( ZCIT_LIMA_SPLIT ) ) DEALLOCATE( ZCIT_LIMA_SPLIT )
- DEALLOCATE( ZTS_SPLIT )
- DEALLOCATE( ZNFLW_CS_SPLIT)
- DEALLOCATE( ZNFLW_SPLIT)
- DEALLOCATE( ZNFSW_CS_SPLIT)
- DEALLOCATE( ZNFSW_SPLIT)
- DEALLOCATE(ZDTLW_SPLIT)
- DEALLOCATE(ZDTSW_SPLIT)
- DEALLOCATE(ZFLUX_TOP_GND_IRVISNIR_SPLIT)
- DEALLOCATE(ZSFSWDIR_SPLIT)
- DEALLOCATE(ZSFSWDIF_SPLIT)
- DEALLOCATE(ZFLUX_SW_DOWN_SPLIT)
- DEALLOCATE(ZFLUX_SW_UP_SPLIT)
- DEALLOCATE(ZFLUX_LW_SPLIT)
- DEALLOCATE(ZDTLW_CS_SPLIT)
- DEALLOCATE(ZDTSW_CS_SPLIT)
- DEALLOCATE(ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT)
- DEALLOCATE(ZPLAN_ALB_VIS_SPLIT)
- DEALLOCATE(ZPLAN_ALB_NIR_SPLIT)
- DEALLOCATE(ZPLAN_TRA_VIS_SPLIT)
- DEALLOCATE(ZPLAN_TRA_NIR_SPLIT)
- DEALLOCATE(ZPLAN_ABS_VIS_SPLIT)
- DEALLOCATE(ZPLAN_ABS_NIR_SPLIT)
- DEALLOCATE(ZEFCL_LWD_SPLIT)
- DEALLOCATE(ZEFCL_LWU_SPLIT)
- DEALLOCATE(ZFLWP_SPLIT)
- DEALLOCATE(ZRADLP_SPLIT)
- DEALLOCATE(ZRADIP_SPLIT)
- DEALLOCATE(ZFIWP_SPLIT)
- DEALLOCATE(ZEFCL_RRTM_SPLIT)
- DEALLOCATE(ZCLSW_TOTAL_SPLIT)
- DEALLOCATE(ZTAU_TOTAL_SPLIT)
- DEALLOCATE(ZOMEGA_TOTAL_SPLIT)
- DEALLOCATE(ZCG_TOTAL_SPLIT)
- DEALLOCATE(ZFLUX_SW_DOWN_CS_SPLIT)
- DEALLOCATE(ZFLUX_SW_UP_CS_SPLIT)
- DEALLOCATE(ZFLUX_LW_CS_SPLIT)
- DEALLOCATE(ZPIZA_EQ_SPLIT)
- DEALLOCATE(ZCGA_EQ_SPLIT)
- DEALLOCATE(ZTAUREL_EQ_SPLIT)
- END IF
- END DO
-END IF
-
-!
-DEALLOCATE(ZTAVE)
-DEALLOCATE(ZPAVE)
-DEALLOCATE(ZQVAVE)
-DEALLOCATE(ZQLAVE)
-DEALLOCATE(ZDZ)
-DEALLOCATE(ZQIAVE)
-DEALLOCATE(ZCFAVE)
-DEALLOCATE(ZPRES_HL)
-DEALLOCATE(ZT_HL)
-DEALLOCATE(ZRMU0)
-DEALLOCATE(ZLSM)
-DEALLOCATE(ZQSAVE)
-DEALLOCATE(ZAER)
-DEALLOCATE(ZPIZA_EQ)
-DEALLOCATE(ZCGA_EQ)
-DEALLOCATE(ZTAUREL_EQ)
-DEALLOCATE(ZDPRES)
-DEALLOCATE(ZCCT_C2R2)
-DEALLOCATE(ZCRT_C2R2)
-DEALLOCATE(ZCIT_C1R3)
-DEALLOCATE(ZLAT)
-DEALLOCATE(ZLON)
-IF (CCLOUD == 'LIMA') THEN
- DEALLOCATE(ZCCT_LIMA)
- DEALLOCATE(ZCRT_LIMA)
- DEALLOCATE(ZCIT_LIMA)
-END IF
-!
-DEALLOCATE(ZTS)
-DEALLOCATE(ZALBP)
-DEALLOCATE(ZALBD)
-DEALLOCATE(ZEMIS)
-DEALLOCATE(ZEMIW)
-DEALLOCATE(ZQRAVE)
-DEALLOCATE(ZQLWC)
-DEALLOCATE(ZQIWC)
-DEALLOCATE(ZQRWC)
-DEALLOCATE(ICLEAR_2D_TM1)
-!
-!* 5.6 UNCOMPRESSES THE OUTPUT FIELD IN CASE OF
-! CLEAR-SKY APPROXIMATION
-!
-IF(OCLEAR_SKY .OR. OCLOUD_ONLY) THEN
- ALLOCATE(ZWORK1(ICLOUD))
- ALLOCATE(ZWORK2(ICLOUD+KFLEV)) ! allocation for the KFLEV levels of
- ALLOCATE(ZWORK4(KFLEV,KDLON))
- ZWORK2(:) = PACK( TRANSPOSE(ZDTLW(:,:)),MASK=.TRUE. )
-!
- DO JK=1,KFLEV
- ZWORK4(JK,:) = ZWORK2(ICLOUD+JK)
- END DO
- ZWORK1(1:ICLOUD) = ZWORK2(1:ICLOUD)
- ZZDTLW(:,:) = TRANSPOSE( UNPACK( ZWORK1(:),MASK=GCLOUDT(:,:) &
- ,FIELD=ZWORK4(:,:) ) )
- !
- ZWORK2(:) = PACK( TRANSPOSE(ZDTSW(:,:)),MASK=.TRUE. )
- DO JK=1,KFLEV
- ZWORK4(JK,:) = ZWORK2(ICLOUD+JK)
- END DO
- ZWORK1(1:ICLOUD) = ZWORK2(1:ICLOUD)
- ZZDTSW(:,:) = TRANSPOSE( UNPACK( ZWORK1(:),MASK=GCLOUDT(:,:) &
- ,FIELD=ZWORK4(:,:) ) )
- !
- DEALLOCATE(ZWORK1)
- DEALLOCATE(ZWORK2)
- DEALLOCATE(ZWORK4)
- !
- ZZTGVISC = ZFLUX_TOP_GND_IRVISNIR(ICLOUD_COL+1,5)
- !
- ZZTGVIS(:) = UNPACK( ZFLUX_TOP_GND_IRVISNIR(:,5),MASK=.NOT.GCLEAR_2D(:), &
- FIELD=ZZTGVISC )
- ZZTGNIRC = ZFLUX_TOP_GND_IRVISNIR(ICLOUD_COL+1,6)
- !
- ZZTGNIR(:) = UNPACK( ZFLUX_TOP_GND_IRVISNIR(:,6),MASK=.NOT.GCLEAR_2D(:), &
- FIELD=ZZTGNIRC )
- ZZTGIRC = ZFLUX_TOP_GND_IRVISNIR(ICLOUD_COL+1,4)
- !
- ZZTGIR (:) = UNPACK( ZFLUX_TOP_GND_IRVISNIR(:,4),MASK=.NOT.GCLEAR_2D(:), &
- FIELD=ZZTGIRC )
- !
- DO JSWB=1,ISWB
- ZZSFSWDIRC(JSWB) = ZSFSWDIR (ICLOUD_COL+1,JSWB)
- !
- ZZSFSWDIR(:,JSWB) = UNPACK(ZSFSWDIR (:,JSWB),MASK=.NOT.GCLEAR_2D(:), &
- FIELD= ZZSFSWDIRC(JSWB) )
- !
- ZZSFSWDIFC(JSWB) = ZSFSWDIF (ICLOUD_COL+1,JSWB)
- !
- ZZSFSWDIF(:,JSWB) = UNPACK(ZSFSWDIF (:,JSWB),MASK=.NOT.GCLEAR_2D(:), &
- FIELD= ZZSFSWDIFC(JSWB) )
- END DO
-!
-! No cloud case
-!
- IF( GNOCL ) THEN
- IF (SIZE(ZZDTLW,1)>1) THEN
- ZZDTLW(1,:)= ZZDTLW(2,:)
- ENDIF
- IF (SIZE(ZZDTSW,1)>1) THEN
- ZZDTSW(1,:)= ZZDTSW(2,:)
- ENDIF
- ZZTGVIS(1) = ZZTGVISC
- ZZTGNIR(1) = ZZTGNIRC
- ZZTGIR(1) = ZZTGIRC
- ZZSFSWDIR(1,:) = ZZSFSWDIRC(:)
- ZZSFSWDIF(1,:) = ZZSFSWDIFC(:)
- END IF
-ELSE
- ZZDTLW(:,:) = ZDTLW(:,:)
- ZZDTSW(:,:) = ZDTSW(:,:)
- ZZTGVIS(:) = ZFLUX_TOP_GND_IRVISNIR(:,5)
- ZZTGNIR(:) = ZFLUX_TOP_GND_IRVISNIR(:,6)
- ZZTGIR(:) = ZFLUX_TOP_GND_IRVISNIR(:,4)
- ZZSFSWDIR(:,:) = ZSFSWDIR(:,:)
- ZZSFSWDIF(:,:) = ZSFSWDIF(:,:)
-END IF
-!
-DEALLOCATE(ZDTLW)
-DEALLOCATE(ZDTSW)
-DEALLOCATE(ZSFSWDIR)
-DEALLOCATE(ZSFSWDIF)
-!
-!--------------------------------------------------------------------------------------------
-!
-!* 6. COMPUTES THE RADIATIVE SOURCES AND THE DOWNWARD SURFACE FLUXES in 2D horizontal
-! ------------------------------------------------------------------------------
-!
-! Computes the SW and LW radiative tendencies
-! note : tendencies in K/s for MNH (from K/day)
-!
-ZDTRAD_LW(:,:,:)=0.0
-ZDTRAD_SW(:,:,:)=0.0
-DO JK=IKB,IKE
- JKRAD= JK-JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZDTRAD_LW(JI,JJ,JK) = ZZDTLW(IIJ,JKRAD)/XDAY ! XDAY from modd_cst (day duration in s)
- ZDTRAD_SW(JI,JJ,JK) = ZZDTSW(IIJ,JKRAD)/XDAY
- END DO
- END DO
-END DO
-!
-! Computes the downward SW and LW surface fluxes + diffuse and direct contribution
-!
-ZLWD(:,:)=0.
-ZSWDDIR(:,:,:)=0.
-ZSWDDIF(:,:,:)=0.
-!
-DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZLWD(JI,JJ) = ZZTGIR(IIJ)
- ZSWDDIR(JI,JJ,:) = ZZSFSWDIR (IIJ,:)
- ZSWDDIF(JI,JJ,:) = ZZSFSWDIF (IIJ,:)
- END DO
-END DO
-!
-!final THETA_radiative tendency and surface fluxes
-!
-IF(OCLOUD_ONLY) THEN
-
- GCLOUD_SURF(:,:) = .FALSE.
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- GCLOUD_SURF(JI,JJ) = GCLOUD(IIJ,1)
- END DO
- END DO
-
- ZWORKL(:,:) = GCLOUD_SURF(:,:)
-
- DO JK = IKB,IKE
- WHERE( ZWORKL(:,:) )
- PDTHRAD(:,:,JK) = (ZDTRAD_LW(:,:,JK)+ZDTRAD_SW(:,:,JK))/ZEXNT(:,:,JK)
- ENDWHERE
- END DO
- !
- WHERE( ZWORKL(:,:) )
- PSRFLWD(:,:) = ZLWD(:,:)
- ENDWHERE
- DO JSWB=1,ISWB
- WHERE( ZWORKL(:,:) )
- PSRFSWD_DIR (:,:,JSWB) = ZSWDDIR(:,:,JSWB)
- PSRFSWD_DIF (:,:,JSWB) = ZSWDDIF(:,:,JSWB)
- END WHERE
- END DO
-ELSE
- PDTHRAD(:,:,:) = (ZDTRAD_LW(:,:,:)+ZDTRAD_SW(:,:,:))/ZEXNT(:,:,:) ! tendency in potential temperature
- PDTHRADSW(:,:,:) = ZDTRAD_SW(:,:,:)/ZEXNT(:,:,:)
- PDTHRADLW(:,:,:) = ZDTRAD_LW(:,:,:)/ZEXNT(:,:,:)
- PSRFLWD(:,:) = ZLWD(:,:)
- DO JSWB=1,ISWB
- PSRFSWD_DIR (:,:,JSWB) = ZSWDDIR(:,:,JSWB)
- PSRFSWD_DIF (:,:,JSWB) = ZSWDDIF(:,:,JSWB)
- END DO
-!
-!sw and lw fluxes
-!
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- PSWU(JI,JJ,JK) = ZFLUX_SW_UP(IIJ,JKRAD)
- PSWD(JI,JJ,JK) = ZFLUX_SW_DOWN(IIJ,JKRAD)
- PLWU(JI,JJ,JK) = ZFLUX_LW(IIJ,1,JKRAD)
- PLWD(JI,JJ,JK) = -ZFLUX_LW(IIJ,2,JKRAD) ! in ECMWF all fluxes are upward
- END DO
- END DO
- END DO
-!!!effective radius
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- PRADEFF(JI,JJ,JK) = ZRADLP(IIJ,JKRAD)
- END DO
- END DO
- END DO
-END IF
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 7. STORE SOME ADDITIONNAL RADIATIVE FIELDS
-! ---------------------------------------
-!
-IF( tpfile%lopened .AND. (KRAD_DIAG >= 1) ) THEN
- ZSTORE_3D(:,:,:) = 0.0
- ZSTORE_3D2(:,:,:) = 0.0
- ZSTORE_2D(:,:) = 0.0
- !
- TZFIELD2D = TFIELDMETADATA( &
- CMNHNAME = 'generic 2D for radiations', & !Temporary name to ease identification
- CSTDNAME = '', &
- CDIR = 'XY', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
-
- TZFIELD3D = TFIELDMETADATA( &
- CMNHNAME = 'generic 3D for radiations', & !Temporary name to ease identification
- CSTDNAME = '', &
- CDIR = 'XY', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
-
- IF( KRAD_DIAG >= 1) THEN
- !
- ILUOUT = TLUOUT%NLU
- WRITE(UNIT=ILUOUT,FMT='(/," STORE ADDITIONNAL RADIATIVE FIELDS:", &
- & " KRAD_DIAG=",I1,/)') KRAD_DIAG
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_3D(JI,JJ,JK) = ZFLUX_SW_DOWN(IIJ,JKRAD)
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'SWF_DOWN'
- TZFIELD3D%CLONGNAME = 'SWF_DOWN'
- TZFIELD3D%CUNITS = 'W m-2'
- TZFIELD3D%CCOMMENT = 'X_Y_Z_SWF_DOWN'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
-!
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_3D(JI,JJ,JK) = ZFLUX_SW_UP(IIJ,JKRAD)
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'SWF_UP'
- TZFIELD3D%CLONGNAME = 'SWF_UP'
- TZFIELD3D%CUNITS = 'W m-2'
- TZFIELD3D%CCOMMENT = 'X_Y_Z_SWF_UP'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
-!
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_3D(JI,JJ,JK) = -ZFLUX_LW(IIJ,2,JKRAD)
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'LWF_DOWN'
- TZFIELD3D%CLONGNAME = 'LWF_DOWN'
- TZFIELD3D%CUNITS = 'W m-2'
- TZFIELD3D%CCOMMENT = 'X_Y_Z_LWF_DOWN'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
-!
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_3D(JI,JJ,JK) = ZFLUX_LW(IIJ,1,JKRAD)
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'LWF_UP'
- TZFIELD3D%CLONGNAME = 'LWF_UP'
- TZFIELD3D%CUNITS = 'W m-2'
- TZFIELD3D%CCOMMENT = 'X_Y_Z_LWF_UP'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
-!
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_3D(JI,JJ,JK) = ZNFLW(IIJ,JKRAD)
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'LWF_NET'
- TZFIELD3D%CLONGNAME = 'LWF_NET'
- TZFIELD3D%CUNITS = 'W m-2'
- TZFIELD3D%CCOMMENT = 'X_Y_Z_LWF_NET'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
-!
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_3D(JI,JJ,JK) = ZNFSW(IIJ,JKRAD)
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'SWF_NET'
- TZFIELD3D%CLONGNAME = 'SWF_NET'
- TZFIELD3D%CUNITS = 'W m-2'
- TZFIELD3D%CCOMMENT = 'X_Y_Z_SWF_NET'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
-!
- DO JK=IKB,IKE
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- ZSTORE_3D(JI,JJ,JK) = ZDTRAD_LW (JI,JJ,JK)*XDAY
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'DTRAD_LW'
- TZFIELD3D%CLONGNAME = 'DTRAD_LW'
- TZFIELD3D%CUNITS = 'K day-1'
- TZFIELD3D%CCOMMENT = 'X_Y_Z_DTRAD_LW'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
-!
- DO JK=IKB,IKE
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- ZSTORE_3D(JI,JJ,JK) = ZDTRAD_SW (JI,JJ,JK)*XDAY
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'DTRAD_SW'
- TZFIELD3D%CLONGNAME = 'DTRAD_SW'
- TZFIELD3D%CUNITS = 'K day-1'
- TZFIELD3D%CCOMMENT = 'X_Y_Z_DTRAD_SW'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
-!
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR(IIJ,5)
- END DO
- END DO
- TZFIELD2D%CMNHNAME = 'RADSWD_VIS'
- TZFIELD2D%CLONGNAME = 'RADSWD_VIS'
- TZFIELD2D%CUNITS = ''
- TZFIELD2D%CCOMMENT = 'X_Y_RADSWD_VIS'
- CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
-!
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR(IIJ,6)
- END DO
- END DO
- TZFIELD2D%CMNHNAME = 'RADSWD_NIR'
- TZFIELD2D%CLONGNAME = 'RADSWD_NIR'
- TZFIELD2D%CUNITS = ''
- TZFIELD2D%CCOMMENT = 'X_Y_RADSWD_NIR'
- CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
- !
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR(IIJ,4)
- END DO
- END DO
- TZFIELD2D%CMNHNAME = 'RADLWD'
- TZFIELD2D%CLONGNAME = 'RADLWD'
- TZFIELD2D%CUNITS = ''
- TZFIELD2D%CCOMMENT = 'X_Y_RADLWD'
- CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
- END IF
- !
- !
- IF( KRAD_DIAG >= 2) THEN
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_3D(JI,JJ,JK) = ZFLUX_SW_DOWN_CS(IIJ,JKRAD)
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'SWF_DOWN_CS'
- TZFIELD3D%CLONGNAME = 'SWF_DOWN_CS'
- TZFIELD3D%CUNITS = 'W m-2'
- TZFIELD3D%CCOMMENT = 'X_Y_Z_SWF_DOWN_CS'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
- !
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_3D(JI,JJ,JK) = ZFLUX_SW_UP_CS(IIJ,JKRAD)
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'SWF_UP_CS'
- TZFIELD3D%CLONGNAME = 'SWF_UP_CS'
- TZFIELD3D%CUNITS = 'W m-2'
- TZFIELD3D%CCOMMENT = 'X_Y_Z_SWF_UP_CS'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
- !
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_3D(JI,JJ,JK) = -ZFLUX_LW_CS(IIJ,2,JKRAD)
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'LWF_DOWN_CS'
- TZFIELD3D%CLONGNAME = 'LWF_DOWN_CS'
- TZFIELD3D%CUNITS = 'W m-2'
- TZFIELD3D%CCOMMENT = 'X_Y_Z_LWF_DOWN_CS'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
- !
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_3D(JI,JJ,JK) = ZFLUX_LW_CS(IIJ,1,JKRAD)
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'LWF_UP_CS'
- TZFIELD3D%CLONGNAME = 'LWF_UP_CS'
- TZFIELD3D%CUNITS = 'W m-2'
- TZFIELD3D%CCOMMENT = 'X_Y_Z_LWF_UP_CS'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
- !
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_3D(JI,JJ,JK) = ZNFLW_CS(IIJ,JKRAD)
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'LWF_NET_CS'
- TZFIELD3D%CLONGNAME = 'LWF_NET_CS'
- TZFIELD3D%CUNITS = 'W m-2'
- TZFIELD3D%CCOMMENT = 'X_Y_Z_LWF_NET_CS'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
- !
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_3D(JI,JJ,JK) = ZNFSW_CS(IIJ,JKRAD)
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'SWF_NET_CS'
- TZFIELD3D%CLONGNAME = 'SWF_NET_CS'
- TZFIELD3D%CUNITS = 'W m-2'
- TZFIELD3D%CCOMMENT = 'X_Y_Z_SWF_NET_CS'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
- !
- DO JK=IKB,IKE
- JKRAD = JK-JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_3D(JI,JJ,JK) = ZDTSW_CS(IIJ,JKRAD)
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'DTRAD_SW_CS'
- TZFIELD3D%CLONGNAME = 'DTRAD_SW_CS'
- TZFIELD3D%CUNITS = 'K day-1'
- TZFIELD3D%CCOMMENT = 'X_Y_Z_DTRAD_SW_CS'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
- !
- DO JK=IKB,IKE
- JKRAD = JK-JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_3D(JI,JJ,JK) = ZDTLW_CS(IIJ,JKRAD)
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'DTRAD_LW_CS'
- TZFIELD3D%CLONGNAME = 'DTRAD_LW_CS'
- TZFIELD3D%CUNITS = 'K day-1'
- TZFIELD3D%CCOMMENT = 'X_Y_Z_DTRAD_LW_CS'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
- !
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR_CS(IIJ,5)
- END DO
- END DO
- TZFIELD2D%CMNHNAME = 'RADSWD_VIS_CS'
- TZFIELD2D%CLONGNAME = 'RADSWD_VIS_CS'
- TZFIELD2D%CUNITS = ''
- TZFIELD2D%CCOMMENT = 'X_Y_RADSWD_VIS_CS'
- CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
- !
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR_CS(IIJ,6)
- END DO
- END DO
- TZFIELD2D%CMNHNAME = 'RADSWD_NIR_CS'
- TZFIELD2D%CLONGNAME = 'RADSWD_NIR_CS'
- TZFIELD2D%CUNITS = ''
- TZFIELD2D%CCOMMENT = 'X_Y_RADSWD_NIR_CS'
- CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
- !
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR_CS(IIJ,4)
- END DO
- END DO
- TZFIELD2D%CMNHNAME = 'RADLWD_CS'
- TZFIELD2D%CLONGNAME = 'RADLWD_CS'
- TZFIELD2D%CUNITS = ''
- TZFIELD2D%CCOMMENT = 'X_Y_RADLWD_CS'
- CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
- END IF
- !
- !
- IF( KRAD_DIAG >= 3) THEN
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_2D(JI,JJ) = ZPLAN_ALB_VIS(IIJ)
- END DO
- END DO
- TZFIELD2D%CMNHNAME = 'PLAN_ALB_VIS'
- TZFIELD2D%CLONGNAME = 'PLAN_ALB_VIS'
- TZFIELD2D%CUNITS = ''
- TZFIELD2D%CCOMMENT = 'X_Y_PLAN_ALB_VIS'
- CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
- !
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_2D(JI,JJ) = ZPLAN_ALB_NIR(IIJ)
- END DO
- END DO
- TZFIELD2D%CMNHNAME = 'PLAN_ALB_NIR'
- TZFIELD2D%CLONGNAME = 'PLAN_ALB_NIR'
- TZFIELD2D%CUNITS = ''
- TZFIELD2D%CCOMMENT = 'X_Y_PLAN_ALB_NIR'
- CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
- !
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_2D(JI,JJ) = ZPLAN_TRA_VIS(IIJ)
- END DO
- END DO
- TZFIELD2D%CMNHNAME = 'PLAN_TRA_VIS'
- TZFIELD2D%CLONGNAME = 'PLAN_TRA_VIS'
- TZFIELD2D%CUNITS = ''
- TZFIELD2D%CCOMMENT = 'X_Y_PLAN_TRA_VIS'
- CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
- !
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_2D(JI,JJ) = ZPLAN_TRA_NIR(IIJ)
- END DO
- END DO
- TZFIELD2D%CMNHNAME = 'PLAN_TRA_NIR'
- TZFIELD2D%CLONGNAME = 'PLAN_TRA_NIR'
- TZFIELD2D%CUNITS = ''
- TZFIELD2D%CCOMMENT = 'X_Y_PLAN_TRA_NIR'
- CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
- !
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_2D(JI,JJ) = ZPLAN_ABS_VIS(IIJ)
- END DO
- END DO
- TZFIELD2D%CMNHNAME = 'PLAN_ABS_VIS'
- TZFIELD2D%CLONGNAME = 'PLAN_ABS_VIS'
- TZFIELD2D%CUNITS = ''
- TZFIELD2D%CCOMMENT = 'X_Y_PLAN_ABS_VIS'
- CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
- !
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_2D(JI,JJ) = ZPLAN_ABS_NIR(IIJ)
- END DO
- END DO
- TZFIELD2D%CMNHNAME = 'PLAN_ABS_NIR'
- TZFIELD2D%CLONGNAME = 'PLAN_ABS_NIR'
- TZFIELD2D%CUNITS = ''
- TZFIELD2D%CCOMMENT = 'X_Y_PLAN_ABS_NIR'
- CALL IO_Field_write(TPFILE,TZFIELD2D,ZSTORE_2D)
- !
- !
- END IF
-!
-!
- IF( KRAD_DIAG >= 4) THEN
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_3D(JI,JJ,JK) = ZEFCL_LWD(IIJ,JKRAD)
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'EFNEB_DOWN'
- TZFIELD3D%CLONGNAME = 'EFNEB_DOWN'
- TZFIELD3D%CUNITS = ''
- TZFIELD3D%CCOMMENT = 'X_Y_Z_EFNEB_DOWN'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
- !
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_3D(JI,JJ,JK) = ZEFCL_LWU(IIJ,JKRAD)
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'EFNEB_UP'
- TZFIELD3D%CLONGNAME = 'EFNEB_UP'
- TZFIELD3D%CUNITS = ''
- TZFIELD3D%CCOMMENT = 'X_Y_Z_EFNEB_UP'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
- !
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_3D(JI,JJ,JK) = ZFLWP(IIJ,JKRAD)
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'FLWP'
- TZFIELD3D%CLONGNAME = 'FLWP'
- TZFIELD3D%CUNITS = ''
- TZFIELD3D%CCOMMENT = 'X_Y_Z_FLWP'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
- !
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_3D(JI,JJ,JK) = ZFIWP(IIJ,JKRAD)
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'FIWP'
- TZFIELD3D%CLONGNAME = 'FIWP'
- TZFIELD3D%CUNITS = ''
- TZFIELD3D%CCOMMENT = 'X_Y_Z_FIWP'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
- !
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_3D(JI,JJ,JK) = ZRADLP(IIJ,JKRAD)
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'EFRADL'
- TZFIELD3D%CLONGNAME = 'EFRADL'
- TZFIELD3D%CUNITS = ''
- TZFIELD3D%CCOMMENT = 'X_Y_Z_RAD_microm'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
- !
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_3D(JI,JJ,JK) = ZRADIP(IIJ,JKRAD)
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'EFRADI'
- TZFIELD3D%CLONGNAME = 'EFRADI'
- TZFIELD3D%CUNITS = ''
- TZFIELD3D%CCOMMENT = 'X_Y_Z_RAD_microm'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
- !
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_3D(JI,JJ,JK) = ZCLSW_TOTAL(IIJ,JKRAD)
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'SW_NEB'
- TZFIELD3D%CLONGNAME = 'SW_NEB'
- TZFIELD3D%CUNITS = ''
- TZFIELD3D%CCOMMENT = 'X_Y_Z_SW_NEB'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
- !
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_3D(JI,JJ,JK) = ZEFCL_RRTM(IIJ,JKRAD)
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'RRTM_LW_NEB'
- TZFIELD3D%CLONGNAME = 'RRTM_LW_NEB'
- TZFIELD3D%CUNITS = ''
- TZFIELD3D%CCOMMENT = 'X_Y_Z_LW_NEB'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
- !
- ! spectral bands
- IF (KSWB_OLD==6) THEN
- INIR = 4
- ELSE
- INIR = 2
- END IF
-
- DO JBAND=1,INIR-1
- WRITE(YBAND_NAME(JBAND),'(A3,I1)') 'VIS', JBAND
- END DO
- DO JBAND= INIR, KSWB_OLD
- WRITE(YBAND_NAME(JBAND),'(A3,I1)') 'NIR', JBAND
- END DO
-!
- DO JBAND=1,KSWB_OLD
- TZFIELD3D%CMNHNAME = 'ODAER_'//YBAND_NAME(JBAND)
- TZFIELD3D%CLONGNAME = 'ODAER_'//YBAND_NAME(JBAND)
- TZFIELD3D%CUNITS = ''
- TZFIELD3D%CCOMMENT = 'X_Y_Z_OD_'//YBAND_NAME(JBAND)
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZTAUAZ(:,:,:,JBAND))
- !
- TZFIELD3D%CMNHNAME = 'SSAAER_'//YBAND_NAME(JBAND)
- TZFIELD3D%CLONGNAME = 'SSAAER_'//YBAND_NAME(JBAND)
- TZFIELD3D%CUNITS = ''
- TZFIELD3D%CCOMMENT = 'X_Y_Z_SSA_'//YBAND_NAME(JBAND)
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZPIZAZ(:,:,:,JBAND))
- !
- TZFIELD3D%CMNHNAME = 'GAER_'//YBAND_NAME(JBAND)
- TZFIELD3D%CLONGNAME = 'GAER_'//YBAND_NAME(JBAND)
- TZFIELD3D%CUNITS = ''
- TZFIELD3D%CCOMMENT = 'X_Y_Z_G_'//YBAND_NAME(JBAND)
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZCGAZ(:,:,:,JBAND))
- ENDDO
-
- DO JBAND=1,KSWB_OLD
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_3D(JI,JJ,JK) = ZTAU_TOTAL(IIJ,JBAND,JKRAD)
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'OTH_'//YBAND_NAME(JBAND)
- TZFIELD3D%CLONGNAME = 'OTH_'//YBAND_NAME(JBAND)
- TZFIELD3D%CUNITS = ''
- TZFIELD3D%CCOMMENT = 'X_Y_Z_OTH_'//YBAND_NAME(JBAND)
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
- !
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_3D(JI,JJ,JK) = ZOMEGA_TOTAL(IIJ,JBAND,JKRAD)
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'SSA_'//YBAND_NAME(JBAND)
- TZFIELD3D%CLONGNAME = 'SSA_'//YBAND_NAME(JBAND)
- TZFIELD3D%CUNITS = ''
- TZFIELD3D%CCOMMENT = 'X_Y_Z_SSA_'//YBAND_NAME(JBAND)
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
- !
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_3D(JI,JJ,JK) = ZCG_TOTAL(IIJ,JBAND,JKRAD)
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'ASF_'//YBAND_NAME(JBAND)
- TZFIELD3D%CLONGNAME = 'ASF_'//YBAND_NAME(JBAND)
- TZFIELD3D%CUNITS = ''
- TZFIELD3D%CCOMMENT = 'X_Y_Z_ASF_'//YBAND_NAME(JBAND)
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
- END DO
- END IF
- !
- !
- IF (KRAD_DIAG >= 5) THEN
-!
-! OZONE and AER optical thickness climato entering the ecmwf_radiation_vers2
-! note the vertical grid is re-inversed for graphic !
- DO JK=IKB,IKE
- JKRAD = KFLEV+1 - JK + JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
- ZSTORE_3D(JI,JJ,JK) = ZO3AVE(IIJ, JKRAD)
- END DO
- END DO
- END DO
- TZFIELD3D%CMNHNAME = 'O3CLIM'
- TZFIELD3D%CLONGNAME = 'O3CLIM'
- TZFIELD3D%CUNITS = 'Pa Pa-1'
- TZFIELD3D%CCOMMENT = 'X_Y_Z_O3'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D)
-!
-!cumulated optical thickness of aerosols
-!cumul begin from the top of the domain, not from the TOA !
-!
-!land
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,1)
- END DO
- END DO
- END DO
-!
- ZSTORE_2D (:,:) = 0.
- DO JK=IKB,IKE
- JK1=IKE-JK+IKB
- ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
- ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)
- END DO
- TZFIELD3D%CMNHNAME = 'CUM_AER_LAND'
- TZFIELD3D%CLONGNAME = 'CUM_AER_LAND'
- TZFIELD3D%CUNITS = ''
- TZFIELD3D%CCOMMENT = 'X_Y_Z_CUM_AER_OPT'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D2)
-!
-! sea
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,2)
- END DO
- END DO
- END DO
-!sum
- ZSTORE_2D (:,:) = 0.
- DO JK=IKB,IKE
- JK1=IKE-JK+IKB
- ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
- ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)
- END DO
-!
- TZFIELD3D%CMNHNAME = 'CUM_AER_SEA'
- TZFIELD3D%CLONGNAME = 'CUM_AER_SEA'
- TZFIELD3D%CUNITS = ''
- TZFIELD3D%CCOMMENT = 'X_Y_Z_CUM_AER_OPT'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D2)
-!
-! desert
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,3)
- END DO
- END DO
- END DO
-!sum
- ZSTORE_2D (:,:) = 0.
- DO JK=IKB,IKE
- JK1=IKE-JK+IKB
- ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
- ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)
- END DO
-!
- TZFIELD3D%CMNHNAME = 'CUM_AER_DES'
- TZFIELD3D%CLONGNAME = 'CUM_AER_DES'
- TZFIELD3D%CUNITS = ''
- TZFIELD3D%CCOMMENT = 'X_Y_Z_CUM_AER_OPT'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D2)
-!
-! urban
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,4)
- END DO
- END DO
- END DO
-!sum
- ZSTORE_2D (:,:) = 0.
- DO JK=IKB,IKE
- JK1=IKE-JK+IKB
- ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
- ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)
- END DO
-!
- TZFIELD3D%CMNHNAME = 'CUM_AER_URB'
- TZFIELD3D%CLONGNAME = 'CUM_AER_URB'
- TZFIELD3D%CUNITS = ''
- TZFIELD3D%CCOMMENT = 'X_Y_Z_CUM_AER_OPT'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D2)
-!
-! Volcanoes
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,5)
- END DO
- END DO
- END DO
-!sum
- ZSTORE_2D (:,:) = 0.
- DO JK=IKB,IKE
- JK1=IKE-JK+IKB
- ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
- ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)
- END DO
-!
- TZFIELD3D%CMNHNAME = 'CUM_AER_VOL'
- TZFIELD3D%CLONGNAME = 'CUM_AER_VOL'
- TZFIELD3D%CUNITS = ''
- TZFIELD3D%CCOMMENT = 'X_Y_Z_CUM_AER_OPT'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D2)
-!
-! stratospheric background
- DO JK=IKB,IKE
- JKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,6)
- END DO
- END DO
- END DO
-!sum
- ZSTORE_2D (:,:) = 0.
- DO JK=IKB,IKE
- JK1=IKE-JK+IKB
- ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
- ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)
- END DO
-!
- TZFIELD3D%CMNHNAME = 'CUM_AER_STRB'
- TZFIELD3D%CLONGNAME = 'CUM_AER_STRB'
- TZFIELD3D%CUNITS = ''
- TZFIELD3D%CCOMMENT = 'X_Y_Z_CUM_AER_OPT'
- CALL IO_Field_write(TPFILE,TZFIELD3D,ZSTORE_3D2)
- ENDIF
-END IF
-!
-DEALLOCATE(ZNFLW_CS)
-DEALLOCATE(ZNFLW)
-DEALLOCATE(ZNFSW_CS)
-DEALLOCATE(ZNFSW)
-DEALLOCATE(ZFLUX_TOP_GND_IRVISNIR)
-DEALLOCATE(ZFLUX_SW_DOWN)
-DEALLOCATE(ZFLUX_SW_UP)
-DEALLOCATE(ZFLUX_LW)
-DEALLOCATE(ZDTLW_CS)
-DEALLOCATE(ZDTSW_CS)
-DEALLOCATE(ZFLUX_TOP_GND_IRVISNIR_CS)
-DEALLOCATE(ZPLAN_ALB_VIS)
-DEALLOCATE(ZPLAN_ALB_NIR)
-DEALLOCATE(ZPLAN_TRA_VIS)
-DEALLOCATE(ZPLAN_TRA_NIR)
-DEALLOCATE(ZPLAN_ABS_VIS)
-DEALLOCATE(ZPLAN_ABS_NIR)
-DEALLOCATE(ZEFCL_LWD)
-DEALLOCATE(ZEFCL_LWU)
-DEALLOCATE(ZFLWP)
-DEALLOCATE(ZFIWP)
-DEALLOCATE(ZRADLP)
-DEALLOCATE(ZRADIP)
-DEALLOCATE(ZEFCL_RRTM)
-DEALLOCATE(ZCLSW_TOTAL)
-DEALLOCATE(ZTAU_TOTAL)
-DEALLOCATE(ZOMEGA_TOTAL)
-DEALLOCATE(ZCG_TOTAL)
-DEALLOCATE(ZFLUX_SW_DOWN_CS)
-DEALLOCATE(ZFLUX_SW_UP_CS)
-DEALLOCATE(ZFLUX_LW_CS)
-DEALLOCATE(ZO3AVE)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE RADIATIONS
-!
-END MODULE MODI_RADIATIONS
diff --git a/src/mesonh/ext/read_exsegn.f90 b/src/mesonh/ext/read_exsegn.f90
deleted file mode 100644
index 70d8d7e98..000000000
--- a/src/mesonh/ext/read_exsegn.f90
+++ /dev/null
@@ -1,3075 +0,0 @@
-!MNH_LIC Copyright 1994-2023 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_READ_EXSEG_n
-! ######################
-!
-INTERFACE
-!
- SUBROUTINE READ_EXSEG_n(KMI,TPEXSEGFILE,HCONF,OFLAT,OUSERV, &
- OUSERC,OUSERR,OUSERI,OUSECI,OUSERS,OUSERG,OUSERH, &
- OUSECHEM,OUSECHAQ,OUSECHIC,OCH_PH,OCH_CONV_LINOX,OSALT, &
- ODEPOS_SLT, ODUST,ODEPOS_DST, OCHTRANS, &
- OORILAM,ODEPOS_AER, OLG,OPASPOL, OFIRE, &
-#ifdef MNH_FOREFIRE
- OFOREFIRE, &
-#endif
- OLNOX_EXPLICIT, &
- OCONDSAMP,OBLOWSNOW, &
- KRIMX,KRIMY, KSV_USER, &
- HTURB,HTOM,ORMC01,HRAD,HDCONV,HSCONV,HCLOUD,HELEC, &
- HEQNSYS,PTSTEP_ALL,HINIFILEPGD )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KMI ! Model index
-TYPE(TFILEDATA), INTENT(IN) :: TPEXSEGFILE ! EXSEG file
-! The following variables are read by READ_DESFM in DESFM descriptor :
-CHARACTER (LEN=*), INTENT(IN) :: HCONF ! configuration var. linked to FMfile
-LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero orography
-LOGICAL, INTENT(IN) :: OUSERV,OUSERC,OUSERR,OUSERI,OUSERS, &
- OUSERG,OUSERH ! kind of moist variables in
- ! FMfile
-LOGICAL, INTENT(IN) :: OUSECI ! ice concentration in
- ! FMfile
-LOGICAL, INTENT(IN) :: OUSECHEM ! Chemical FLAG in FMFILE
-LOGICAL, INTENT(IN) :: OUSECHAQ ! Aqueous chemical FLAG in FMFILE
-LOGICAL, INTENT(IN) :: OUSECHIC ! Ice chemical FLAG in FMFILE
-LOGICAL, INTENT(IN) :: OCH_PH ! pH FLAG in FMFILE
-LOGICAL, INTENT(IN) :: OCH_CONV_LINOX ! LiNOx FLAG in FMFILE
-LOGICAL, INTENT(IN) :: ODUST ! Dust FLAG in FMFILE
-LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_DST ! Dust wet deposition FLAG in FMFILE
-LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_SLT ! Sea Salt wet deposition FLAG in FMFILE
-LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_AER ! Orilam wet deposition FLAG in FMFILE
-LOGICAL, INTENT(IN) :: OSALT ! Sea Salt FLAG in FMFILE
-LOGICAL, INTENT(IN) :: OORILAM ! Orilam FLAG in FMFILE
-LOGICAL, INTENT(IN) :: OPASPOL ! Passive pollutant FLAG in FMFILE
-LOGICAL, INTENT(IN) :: OFIRE ! Blaze FLAG in FMFILE
-#ifdef MNH_FOREFIRE
-LOGICAL, INTENT(IN) :: OFOREFIRE ! ForeFire FLAG in FMFILE
-#endif
-LOGICAL, INTENT(IN) :: OLNOX_EXPLICIT ! explicit LNOx FLAG in FMFILE
-LOGICAL, INTENT(IN) :: OCONDSAMP ! Conditional sampling FLAG in FMFILE
-LOGICAL, INTENT(IN) :: OBLOWSNOW ! Blowing snow FLAG in FMFILE
-LOGICAL, INTENT(IN) :: OCHTRANS ! LCHTRANS FLAG in FMFILE
-
-LOGICAL, INTENT(IN) :: OLG ! lagrangian FLAG in FMFILE
-INTEGER, INTENT(IN) :: KRIMX, KRIMY ! number of points for the
- ! horizontal relaxation for the outermost verticals
-INTEGER, INTENT(IN) :: KSV_USER ! number of additional scalar
- ! variables in FMfile
-CHARACTER (LEN=*), INTENT(IN) :: HTURB ! Kind of turbulence parameterization
- ! used to produce FMFILE
-CHARACTER (LEN=*), INTENT(IN) :: HTOM ! Kind of third order moment
-LOGICAL, INTENT(IN) :: ORMC01 ! flag for RMC01 SBL computations
-CHARACTER (LEN=*), INTENT(IN) :: HRAD ! Kind of radiation scheme
-CHARACTER (LEN=4), INTENT(IN) :: HDCONV ! Kind of deep convection scheme
-CHARACTER (LEN=4), INTENT(IN) :: HSCONV ! Kind of shallow convection scheme
-CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
-CHARACTER (LEN=4), INTENT(IN) :: HELEC ! Kind of electrical scheme
-CHARACTER (LEN=*), INTENT(IN) :: HEQNSYS! type of equations' system
-REAL,DIMENSION(:), INTENT(INOUT):: PTSTEP_ALL ! Time STEP of ALL models
-CHARACTER (LEN=*), INTENT(IN) :: HINIFILEPGD ! name of PGD file
-!
-END SUBROUTINE READ_EXSEG_n
-!
-END INTERFACE
-!
-END MODULE MODI_READ_EXSEG_n
-!
-!
-! #########################################################################
- SUBROUTINE READ_EXSEG_n(KMI,TPEXSEGFILE,HCONF,OFLAT,OUSERV, &
- OUSERC,OUSERR,OUSERI,OUSECI,OUSERS,OUSERG,OUSERH, &
- OUSECHEM,OUSECHAQ,OUSECHIC,OCH_PH,OCH_CONV_LINOX,OSALT, &
- ODEPOS_SLT, ODUST,ODEPOS_DST, OCHTRANS, &
- OORILAM,ODEPOS_AER, OLG,OPASPOL, OFIRE, &
-#ifdef MNH_FOREFIRE
- OFOREFIRE, &
-#endif
- OLNOX_EXPLICIT, &
- OCONDSAMP, OBLOWSNOW, &
- KRIMX,KRIMY, KSV_USER, &
- HTURB,HTOM,ORMC01,HRAD,HDCONV,HSCONV,HCLOUD,HELEC, &
- HEQNSYS,PTSTEP_ALL,HINIFILEPGD )
-! #########################################################################
-!
-!!**** *READ_EXSEG_n * - routine to read the descriptor file EXSEG
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to read the descriptor file called
-! EXSEG and to control the coherence with FMfile data .
-!
-!!
-!!** METHOD
-!! ------
-!! The descriptor file is read. Namelists (NAMXXXn) which contain
-!! variables linked to one nested model are at the beginning of the file.
-!! Namelists (NAMXXX) which contain variables common to all models
-!! are at the end of the file. When the model index is different from 1,
-!! the end of the file (namelists NAMXXX) is not read.
-!!
-!! Coherence between the initial file (description read in DESFM file)
-!! and the segment to perform (description read in EXSEG file)
-!! is checked for segment achievement configurations
-!! or postprocessing configuration. The get indicators are set according
-!! to the following check :
-!!
-!! - segment achievement and preinit configurations :
-!!
-!! * if there is no turbulence kinetic energy in initial
-!! file (HTURB='NONE'), and the segment to perform requires a turbulence
-!! parameterization (CTURB /= 'NONE'), the get indicators for turbulence
-!! kinetic energy variables are set to 'INIT'; i.e. these variables will be
-!! set equal to zero by READ_FIELD according to the get indicators.
-!! * The same procedure is applied to the dissipation of TKE.
-!! * if there is no moist variables RRn in initial file (OUSERn=.FALSE.)
-!! and the segment to perform requires moist variables RRn
-!! (LUSERn=.TRUE.), the get indicators for moist variables RRn are set
-!! equal to 'INIT'; i.e. these variables will be set equal to zero by
-!! READ_FIELD according to the get indicators.
-!! * if there are KSV_USER additional scalar variables in initial file and the
-!! segment to perform needs more than KSV_USER additional variables, the get
-!! indicators for these (NSV_USER-KSV_USER) additional scalar variables are set
-!! equal to 'INIT'; i.e. these variables will be set equal to zero by
-!! READ_FIELD according to the get indicators. If the segment to perform
-!! needs less additional scalar variables than there are in initial file,
-!! the get indicators for these (KSV_USER - NSV_USER) additional scalar variables are
-!! set equal to 'SKIP'.
-!! * warning messages are printed if the fields in initial file are the
-!! same at time t and t-dt (HCONF='START') and a leap-frog advance
-!! at first time step will be used for the segment to perform
-!! (CCONF='RESTA'); It is likewise when HCONF='RESTA' and CCONF='START'.
-!! * A warning message is printed if the orography in initial file is zero
-!! (OFLAT=.TRUE.) and the segment to perform considers no-zero orography
-!! (LFLAT=.FALSE.). It is likewise for LFLAT=.TRUE. and OFLAT=.FALSE..
-!! If the segment to perform requires zero orography (LFLAT=.TRUE.), the
-!! orography (XZS) will not read in initial file but set equal to zero
-!! by SET_GRID.
-!! * check of the depths of the Lateral Damping Layer in x and y
-!! direction is performed
-!! * If some coupling files are specified, LSTEADYLS is set to T
-!! * If no coupling files are specified, LSTEADYLS is set to F
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODN_CONF : CCONF,LTHINSHELL,LFLAT,NMODEL,NVERB
-!!
-!! Module MODN_DYN : LCORIO, LZDIFFU
-!!
-!! Module MODN_NESTING : NDAD(m),NDTRATIO(m),XWAY(m)
-!!
-!! Module MODN_BUDGET : CBUTYPE,XBULEN
-!!
-!! Module MODN_CONF1 : LUSERV,LUSERC,LUSERR,LUSERI,LUSERS,LUSERG,LUSERH,CSEG
-!!
-!! Module MODN_DYN1 : XTSTEP,CPRESOPT,NITR,XRELAX
-!!
-!! Module MODD_ADV1 : CMET_ADV_SCHEME,CSV_ADV_SCHEME,CUVW_ADV_SCHEME,NLITER
-!!
-!! Module MODN_PARAM1 : CTURB,CRAD,CDCONV,CSCONV
-!!
-!! Module MODN_LUNIT1 :
-!! Module MODN_LBC1 : CLBCX,CLBCY,NLBLX,NLBLY,XCPHASE,XPOND
-!!
-!! Module MODN_TURB_n : CTURBLEN,CTURBDIM
-!!
-!! Module MODD_GET1:
-!! CGETTKEM,CGETTKET,
-!! CGETRVM,CGETRCM,CGETRRM,CGETRIM,CGETRSM,CGETRGM,CGETRHM
-!! CGETRVT,CGETRCT,CGETRRT,CGETRIT,CGETRST,CGETRGT,CGETRHT,CGETSVM
-!! CGETSVT,CGETSIGS,CGETSRCM,CGETSRCT
-!! NCPL_NBR,NCPL_TIMES,NCPL_CUR
-!! Module MODN_LES : contains declaration of the control parameters
-!! for Large Eddy Simulations' storages
-!! for the forcing
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of the documentation (routine READ_EXSEG_n)
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Ducrocq * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 07/06/94
-!! Modification 26/10/94 (Stein) remove NAM_GET from the Namelists
-!! present in DESFM + change the namelist names
-!! Modification 22/11/94 (Stein) add GET indicator for phi
-!! Modification 21/12/94 (Stein) add GET indicator for LS fields
-!! Modification 06/01/95 (Stein) bug in the test for Scalar Var.
-!! Modifications 09/01/95 (Stein) add the turbulence scheme
-!! Modifications 09/01/95 (Stein) add the 1D switch
-!! Modifications 10/03/95 (Mallet) add coherence in coupling case
-!! Modifications 16/03/95 (Stein) remove R from the historical variables
-!! Modifications 01/03/95 (Hereil) add the budget namelists
-!! Modifications 16/06/95 (Stein) coherence control for the
-!! microphysical scheme + remove the wrong messge for RESTA conf
-!! Modifications 30/06/95 (Stein) conditionnal reading of the fields
-!! used by the moist turbulence scheme
-!! Modifications 12/09/95 (Pinty) add the radiation scheme
-!! Modification 06/02/96 (J.Vila) implement scalar advection schemes
-!! Modifications 24/02/96 (Stein) change the default value for CCPLFILE
-!! Modifications 02/05/96 (Stein Jabouille) change the Z0SEA activation
-!! Modifications 24/05/96 (Stein) change the SRC SIGS control
-!! Modifications 08/09/96 (Masson) the coupling file names are reset to
-!! default value " " before reading in EXSEG1.nam
-!! to avoid extra non-existant coupling files
-!!
-!! Modifications 25/04/95 (K.Suhre)add namelist NAM_BLANK
-!! add read for LFORCING
-!! 25/04/95 (K.Suhre)add namelist NAM_FRC
-!! and switch checking
-!! 06/08/96 (K.Suhre)add namelist NAM_CH_MNHCn
-!! and NAM_CH_SOLVER
-!! Modifications 10/10/96 (Stein) change SRC into SRCM and SRCT
-!! Modifications 11/04/96 (Pinty) add the rain-ice microphysical scheme
-!! Modifications 11/01/97 (Pinty) add the deep convection scheme
-!! Modifications 22/05/97 (Lafore) gridnesting implementation
-!! Modifications 22/06/97 (Stein) add the absolute pressure + cleaning
-!! Modifications 25/08/97 (Masson) add tests on surface schemes
-!! 22/10/97 (Stein) remove the RIMX /= 0 control
-!! + new namelist + cleaning
-!! Modifications 17/04/98 (Masson) add tests on character variables
-!! Modification 15/03/99 (Masson) add tests on PROGRAM
-!! Modification 04/01/00 (Masson) removes TSZ0 case
-!! Modification 04/06/00 (Pinty) add C2R2 scheme
-!! 11/12/00 (Tomasini) add CSEA_FLUX to MODD_PARAMn
-!! delete the test on SST_FRC only in 1D
-!! Modification 22/01/01 (Gazen) change NSV,KSV to NSV_USER,KSV_USER and add
-!! NSV_* variables initialization
-!! Modification 15/10/01 (Mallet) allow namelists in different orders
-!! Modification 18/03/02 (Solmon) new radiation scheme test
-!! Modification 29/11/02 (JP Pinty) add C3R5, ICE2, ICE4, ELEC
-!! Modification 06/11/02 (Masson) new LES BL height diagnostic
-!! Modification 06/11/02 (Jabouille) remove LTHINSHELL LFORCING test
-!! Modification 01/12/03 (Gazen) change Chemical scheme interface
-!! Modification 01/2004 (Masson) removes surface (externalization)
-!! Modification 01/2005 (Masson) removes 1D and 2D switches
-!! Modification 04/2005 (Tulet) add dust, orilam
-!! Modification 03/2006 (O.Geoffroy) Add KHKO scheme
-!! Modification 04/2006 (Maric) include 4th order advection scheme
-!! Modification 05/2006 (Masson) add nudging
-!! Modification 05/2006 Remove KEPS
-!! Modification 04/2006 (Maric) include PPM advection scheme
-!! Modification 04/2006 (J.Escobar) Bug dollarn add CALL UPDATE_NAM_CONFN
-!! Modifications 01/2007 (Malardel,Pergaud) add the MF shallow
-!! convection scheme MODN_PARAM_MFSHALL_n
-!! Modification 09/2009 (J.Escobar) add more info on relaxation problems
-!! Modification 09/2011 (J.Escobar) re-add 'ZRESI' choose
-!! Modification 12/2011 (C.Lac) Adaptation to FIT temporal scheme
-!! Modification 12/2012 (S.Bielli) add NAM_NCOUT for netcdf output (removed 08/07/2016)
-!! Modification 02/2012 (Pialat/Tulet) add ForeFire
-!! Modification 02/2012 (T.Lunet) add of new Runge-Kutta methods
-!! Modification 01/2015 (C. Barthe) add explicit LNOx
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! M.Leriche 18/12/2015 : bug chimie glace dans prep_real_case
-!! Modification 01/2016 (JP Pinty) Add LIMA
-!! Modification 02/2016 (M.Leriche) treat gas and aq. chemicals separately
-!! P.Wautelet 08/07/2016 : removed MNH_NCWRIT define
-!! Modification 10/2016 (C.LAC) Add OSPLIT_WENO + Add droplet
-!! deposition + Add max values
-!! Modification 11/2016 (Ph. Wautelet) Allocate/initialise some output/backup structures
-!! Modification 03/2017 (JP Chaboureau) Fix the initialization of
-!! LUSERx-type variables for LIMA
-!! M.Leriche 06/2017 for spawn and prep_real avoid abort if wet dep for
-!! aerosol and no cloud scheme defined
-!! Q.Libois 02/2018 ECRAD
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! Modification 07/2017 (V. Vionnet) add blowing snow scheme
-!! Modification 01/2019 (Q. Rodier) define XCEDIS depending on BL89 or RM17 mixing length
-!! Modification 01/2019 (P. Wautelet) bugs correction: incorrect writes
-!! Modification 01/2019 (R. Honnert) remove SURF in CMF_UPDRAFT
-!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
-! Q. Rodier 03/2020: add abort if use of any LHORELAX and cyclic conditions
-! F.Auguste 02/2021: add IBM
-! T.Nagel 02/2021: add turbulence recycling
-! E.Jezequel 02/2021: add stations read from CSV file
-! P. Wautelet 09/03/2021: simplify allocation of scalar variable names
-! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
-! P. Wautelet 10/03/2021: move scalar variable name initializations to ini_nsv
-! R. Honnert 23/04/2021: add HM21 mixing length and delete HRIO and BOUT from CMF_UPDRAFT
-! S. Riette 11/05/2021 HighLow cloud
-! A. Costes 12/2021: add Blaze fire model
-! P. Wautelet 27/04/2022: add namelist for profilers
-! P. Wautelet 24/06/2022: remove check on CSTORAGE_TYPE for restart of ForeFire variables
-! P. Wautelet 13/07/2022: add namelist for flyers and balloons
-! P. Wautelet 19/08/2022: add namelist for aircrafts
-!------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-USE MODD_AIRCRAFT_BALLOON, ONLY: NAIRCRAFTS, NBALLOONS
-USE MODD_BLOWSNOW
-USE MODD_BUDGET
-USE MODD_CH_AEROSOL
-USE MODD_CH_M9_n, ONLY : NEQ
-USE MODD_CONDSAMP
-USE MODD_CONF
-USE MODD_CONFZ
-! USE MODD_DRAG_n
-USE MODD_DUST
-USE MODD_DYN
-USE MODD_DYN_n, ONLY : LHORELAX_SVLIMA, LHORELAX_SVFIRE
-#ifdef MNH_FOREFIRE
-USE MODD_FOREFIRE
-#endif
-USE MODD_GET_n
-USE MODD_GR_FIELD_n
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_NSV,NSV_USER_n=>NSV_USER
-USE MODD_PARAMETERS
-USE MODD_PASPOL
-USE MODD_SALT
-USE MODD_VAR_ll, ONLY: NPROC
-USE MODD_VISCOSITY
-
-USE MODE_MSG
-USE MODE_POS
-
-USE MODI_INI_NSV
-USE MODI_TEST_NAM_VAR
-
-USE MODN_2D_FRC
-USE MODN_ADV_n ! The final filling of these modules for the model n is
-USE MODN_AIRCRAFTS, ONLY: AIRCRAFTS_NML_ALLOCATE, NAM_AIRCRAFTS
-USE MODN_BACKUP
-USE MODN_BALLOONS, ONLY: BALLOONS_NML_ALLOCATE, NAM_BALLOONS
-USE MODN_BLANK_n
-USE MODN_BLOWSNOW
-USE MODN_BLOWSNOW_n
-USE MODN_BUDGET
-USE MODN_CH_MNHC_n
-USE MODN_CH_ORILAM
-USE MODN_CH_SOLVER_n
-USE MODN_CONDSAMP
-USE MODN_CONF
-USE MODN_CONF_n
-USE MODN_CONFZ
-USE MODN_DRAGBLDG_n
-USE MODN_DRAG_n
-USE MODN_DRAGTREE_n
-USE MODN_DUST
-USE MODN_DYN
-USE MODN_DYN_n ! to avoid the duplication of this routine for each model.
-USE MODN_ELEC
-USE MODN_EOL
-USE MODN_EOL_ADNR
-USE MODN_EOL_ALM
-USE MODN_FIRE_n
-USE MODN_FLYERS
-#ifdef MNH_FOREFIRE
-USE MODN_FOREFIRE
-#endif
-USE MODN_FRC
-USE MODN_IBM_PARAM_n
-USE MODN_LATZ_EDFLX
-USE MODN_LBC_n ! routine is used for each nested model. This has been done
-USE MODN_LES
-USE MODN_LUNIT_n
-USE MODN_MEAN
-USE MODN_NESTING
-USE MODN_NUDGING_n
-USE MODN_OUTPUT
-USE MODN_PARAM_C1R3, ONLY : NAM_PARAM_C1R3, CPRISTINE_ICE_C1R3, &
- CHEVRIMED_ICE_C1R3
-USE MODN_PARAM_C2R2, ONLY : EPARAM_CCN=>HPARAM_CCN, EINI_CCN=>HINI_CCN, &
- WNUC=>XNUC, WALPHAC=>XALPHAC, NAM_PARAM_C2R2
-USE MODN_PARAM_ECRAD_n
-USE MODN_PARAM_ICE
-USE MODN_PARAM_KAFR_n
-USE MODN_PARAM_LIMA, ONLY : FINI_CCN=>HINI_CCN,NAM_PARAM_LIMA,NMOD_CCN,LSCAV, &
- CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA, NMOD_IFN, NMOD_IMM, &
- LACTI, LNUCL, XALPHAC, XNUC, LMEYERS, &
- LPTSPLIT, LSPRO, LADJ, LKHKO, &
- NMOM_C, NMOM_R, NMOM_I, NMOM_S, NMOM_G, NMOM_H
-USE MODN_PARAM_MFSHALL_n
-USE MODN_PARAM_n ! realized in subroutine ini_model n
-USE MODN_PARAM_RAD_n
-USE MODN_PASPOL
-USE MODN_PROFILER_n
-USE MODN_RECYCL_PARAM_n
-USE MODN_SALT
-USE MODN_SERIES
-USE MODN_SERIES_n
-USE MODN_STATION_n
-USE MODN_TURB
-USE MODN_TURB_CLOUD
-USE MODN_TURB_n
-USE MODN_VISCOSITY
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-INTEGER, INTENT(IN) :: KMI ! Model index
-TYPE(TFILEDATA), INTENT(IN) :: TPEXSEGFILE ! EXSEG file
-! The following variables are read by READ_DESFM in DESFM descriptor :
-CHARACTER (LEN=*), INTENT(IN) :: HCONF ! configuration var. linked to FMfile
-LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero orography
-LOGICAL, INTENT(IN) :: OUSERV,OUSERC,OUSERR,OUSERI,OUSERS, &
- OUSERG,OUSERH ! kind of moist variables in
- ! FMfile
-LOGICAL, INTENT(IN) :: OUSECI ! ice concentration in
- ! FMfile
-LOGICAL, INTENT(IN) :: OUSECHEM ! Chemical FLAG in FMFILE
-LOGICAL, INTENT(IN) :: OUSECHAQ ! Aqueous chemical FLAG in FMFILE
-LOGICAL, INTENT(IN) :: OUSECHIC ! Ice chemical FLAG in FMFILE
-LOGICAL, INTENT(IN) :: OCH_PH ! pH FLAG in FMFILE
-LOGICAL, INTENT(IN) :: OCH_CONV_LINOX ! LiNOx FLAG in FMFILE
-LOGICAL, INTENT(IN) :: ODUST ! Dust FLAG in FMFILE
-LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_DST ! Dust Deposition FLAG in FMFILE
-LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_SLT ! Sea Salt wet deposition FLAG in FMFILE
-LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_AER ! Orilam wet deposition FLAG in FMFILE
-LOGICAL, INTENT(IN) :: OSALT ! Sea Salt FLAG in FMFILE
-LOGICAL, INTENT(IN) :: OORILAM ! Orilam FLAG in FMFILE
-LOGICAL, INTENT(IN) :: OPASPOL ! Passive pollutant FLAG in FMFILE
-LOGICAL, INTENT(IN) :: OFIRE ! Blaze FLAG in FMFILE
-#ifdef MNH_FOREFIRE
-LOGICAL, INTENT(IN) :: OFOREFIRE ! ForeFire FLAG in FMFILE
-#endif
-LOGICAL, INTENT(IN) :: OLNOX_EXPLICIT ! explicit LNOx FLAG in FMFILE
-LOGICAL, INTENT(IN) :: OCONDSAMP ! Conditional sampling FLAG in FMFILE
-LOGICAL, INTENT(IN) :: OCHTRANS ! LCHTRANS FLAG in FMFILE
-LOGICAL, INTENT(IN) :: OBLOWSNOW ! Blowing snow FLAG in FMFILE
-
-LOGICAL, INTENT(IN) :: OLG ! lagrangian FLAG in FMFILE
-INTEGER, INTENT(IN) :: KRIMX, KRIMY ! number of points for the
- ! horizontal relaxation for the outermost verticals
-INTEGER, INTENT(IN) :: KSV_USER ! number of additional scalar
- ! variables in FMfile
-CHARACTER (LEN=*), INTENT(IN) :: HTURB ! Kind of turbulence parameterization
- ! used to produce FMFILE
-CHARACTER (LEN=*), INTENT(IN) :: HTOM ! Kind of third order moment
-LOGICAL, INTENT(IN) :: ORMC01 ! flag for RMC01 SBL computations
-CHARACTER (LEN=*), INTENT(IN) :: HRAD ! Kind of radiation scheme
-CHARACTER (LEN=4), INTENT(IN) :: HDCONV ! Kind of deep convection scheme
-CHARACTER (LEN=4), INTENT(IN) :: HSCONV ! Kind of shallow convection scheme
-CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
-CHARACTER (LEN=4), INTENT(IN) :: HELEC ! Kind of electrical scheme
-CHARACTER (LEN=*), INTENT(IN) :: HEQNSYS! type of equations' system
-REAL,DIMENSION(:), INTENT(INOUT):: PTSTEP_ALL ! Time STEP of ALL models
-CHARACTER (LEN=*), INTENT(IN) :: HINIFILEPGD ! name of PGD file
-!
-!* 0.2 declarations of local variables
-!
-CHARACTER(LEN=3) :: YMODEL
-INTEGER :: ILUSEG,ILUOUT ! logical unit numbers of EXSEG file and outputlisting
-INTEGER :: JS,JCI,JI,JSV ! Loop indexes
-LOGICAL :: GRELAX
-LOGICAL :: GFOUND ! Return code when searching namelist
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. READ EXSEG FILE
-! ---------------
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','READ_EXSEG_n','called for '//TRIM(TPEXSEGFILE%CNAME))
-!
-ILUSEG = TPEXSEGFILE%NLU
-ILUOUT = TLUOUT%NLU
-!
-CALL INIT_NAM_LUNITN
-CCPLFILE(:)=" "
-CALL INIT_NAM_CONFN
-CALL INIT_NAM_DYNN
-CALL INIT_NAM_ADVN
-CALL INIT_NAM_DRAGTREEN
-CALL INIT_NAM_DRAGBLDGN
-CALL INIT_NAM_PARAMN
-CALL INIT_NAM_PARAM_RADN
-#ifdef MNH_ECRAD
-CALL INIT_NAM_PARAM_ECRADN
-#endif
-CALL INIT_NAM_PARAM_KAFRN
-CALL INIT_NAM_PARAM_MFSHALLN
-CALL INIT_NAM_LBCN
-CALL INIT_NAM_NUDGINGN
-CALL INIT_NAM_TURBN
-CALL INIT_NAM_BLANKN
-CALL INIT_NAM_DRAGN
-CALL INIT_NAM_IBM_PARAMN
-CALL INIT_NAM_RECYCL_PARAMN
-CALL INIT_NAM_CH_MNHCN
-CALL INIT_NAM_CH_SOLVERN
-CALL INIT_NAM_SERIESN
-CALL INIT_NAM_BLOWSNOWN
-CALL INIT_NAM_PROFILERn
-CALL INIT_NAM_STATIONn
-CALL INIT_NAM_FIREn
-!
-WRITE(UNIT=ILUOUT,FMT="(/,'READING THE EXSEG.NAM FILE')")
-CALL POSNAM(ILUSEG,'NAM_LUNITN',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LUNITn)
-CALL POSNAM(ILUSEG,'NAM_CONFN',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONFn)
-CALL POSNAM(ILUSEG,'NAM_DYNN',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DYNn)
-CALL POSNAM(ILUSEG,'NAM_ADVN',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_ADVn)
-CALL POSNAM(ILUSEG,'NAM_PARAMN',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAMn)
-CALL POSNAM(ILUSEG,'NAM_PARAM_RADN',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_RADn)
-#ifdef MNH_ECRAD
-CALL POSNAM(ILUSEG,'NAM_PARAM_ECRADN',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_ECRADn)
-#endif
-CALL POSNAM(ILUSEG,'NAM_PARAM_KAFRN',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_KAFRn)
-CALL POSNAM(ILUSEG,'NAM_PARAM_MFSHALLN',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_MFSHALLn)
-CALL POSNAM(ILUSEG,'NAM_LBCN',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LBCn)
-CALL POSNAM(ILUSEG,'NAM_NUDGINGN',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_NUDGINGn)
-CALL POSNAM(ILUSEG,'NAM_TURBN',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_TURBn)
-CALL POSNAM(ILUSEG,'NAM_DRAGN',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGn)
-CALL POSNAM(ILUSEG,'NAM_IBM_PARAMN',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_IBM_PARAMn)
-CALL POSNAM(ILUSEG,'NAM_RECYCL_PARAMN',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_RECYCL_PARAMn)
-CALL POSNAM(ILUSEG,'NAM_CH_MNHCN',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CH_MNHCn)
-CALL POSNAM(ILUSEG,'NAM_CH_SOLVERN',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CH_SOLVERn)
-CALL POSNAM(ILUSEG,'NAM_SERIESN',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_SERIESn)
-CALL POSNAM(ILUSEG,'NAM_BLANKN',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BLANKn)
-CALL POSNAM(ILUSEG,'NAM_BLOWSNOWN',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BLOWSNOWn)
-CALL POSNAM(ILUSEG,'NAM_DRAGTREEN',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGTREEn)
-CALL POSNAM(ILUSEG,'NAM_DRAGBLDGN',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGBLDGn)
-CALL POSNAM(ILUSEG,'NAM_EOL',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL)
-CALL POSNAM(ILUSEG,'NAM_EOL_ADNR',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL_ADNR)
-CALL POSNAM(ILUSEG,'NAM_EOL_ALM',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL_ALM)
-CALL POSNAM(ILUSEG,'NAM_PROFILERN',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PROFILERn)
-CALL POSNAM(ILUSEG,'NAM_STATIONN',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_STATIONn)
-CALL POSNAM(ILUSEG,'NAM_FIREN',GFOUND,ILUOUT)
-IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FIREn)
-!
-IF (KMI == 1) THEN
- WRITE(UNIT=ILUOUT,FMT="(' namelists common to all the models ')")
- CALL POSNAM(ILUSEG,'NAM_CONF',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONF)
- CALL POSNAM(ILUSEG,'NAM_CONFZ',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONFZ)
- CALL POSNAM(ILUSEG,'NAM_DYN',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DYN)
- CALL POSNAM(ILUSEG,'NAM_NESTING',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_NESTING)
- CALL POSNAM(ILUSEG,'NAM_BACKUP',GFOUND,ILUOUT)
- IF (GFOUND) THEN
- !Should have been allocated before in READ_DESFM_n
- IF (.NOT.ALLOCATED(XBAK_TIME)) THEN
- ALLOCATE(XBAK_TIME(NMODEL,JPOUTMAX))
- XBAK_TIME(:,:) = XNEGUNDEF
- END IF
- IF (.NOT.ALLOCATED(XOUT_TIME)) THEN
- ALLOCATE(XOUT_TIME(NMODEL,JPOUTMAX)) !Allocate *OUT* variables to prevent
- XOUT_TIME(:,:) = XNEGUNDEF
- END IF
- IF (.NOT.ALLOCATED(NBAK_STEP)) THEN
- ALLOCATE(NBAK_STEP(NMODEL,JPOUTMAX))
- NBAK_STEP(:,:) = NNEGUNDEF
- END IF
- IF (.NOT.ALLOCATED(NOUT_STEP)) THEN
- ALLOCATE(NOUT_STEP(NMODEL,JPOUTMAX)) !problems if NAM_OUTPUT does not exist
- NOUT_STEP(:,:) = NNEGUNDEF
- END IF
- IF (.NOT.ALLOCATED(COUT_VAR)) THEN
- ALLOCATE(COUT_VAR (NMODEL,JPOUTVARMAX))
- COUT_VAR(:,:) = ''
- END IF
- READ(UNIT=ILUSEG,NML=NAM_BACKUP)
- ELSE
- CALL POSNAM(ILUSEG,'NAM_FMOUT',GFOUND)
- IF (GFOUND) THEN
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_EXSEG_n','use namelist NAM_BACKUP instead of namelist NAM_FMOUT')
- ELSE
- IF (CPROGRAM=='MESONH') CALL PRINT_MSG(NVERB_ERROR,'IO','READ_EXSEG_n','namelist NAM_BACKUP not found')
- END IF
- END IF
- CALL POSNAM(ILUSEG,'NAM_OUTPUT',GFOUND,ILUOUT)
- IF (GFOUND) THEN
- !Should have been allocated before in READ_DESFM_n
- IF (.NOT.ALLOCATED(XBAK_TIME)) THEN
- ALLOCATE(XBAK_TIME(NMODEL,JPOUTMAX)) !Allocate *BAK* variables to prevent
- XBAK_TIME(:,:) = XNEGUNDEF
- END IF
- IF (.NOT.ALLOCATED(XOUT_TIME)) THEN
- ALLOCATE(XOUT_TIME(NMODEL,JPOUTMAX))
- XOUT_TIME(:,:) = XNEGUNDEF
- END IF
- IF (.NOT.ALLOCATED(NBAK_STEP)) THEN
- ALLOCATE(NBAK_STEP(NMODEL,JPOUTMAX)) !problems if NAM_BACKUP does not exist
- NBAK_STEP(:,:) = NNEGUNDEF
- END IF
- IF (.NOT.ALLOCATED(NOUT_STEP)) THEN
- ALLOCATE(NOUT_STEP(NMODEL,JPOUTMAX))
- NOUT_STEP(:,:) = NNEGUNDEF
- END IF
- IF (.NOT.ALLOCATED(COUT_VAR)) THEN
- ALLOCATE(COUT_VAR (NMODEL,JPOUTVARMAX))
- COUT_VAR(:,:) = ''
- END IF
- READ(UNIT=ILUSEG,NML=NAM_OUTPUT)
- END IF
- CALL POSNAM(ILUSEG,'NAM_BUDGET',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BUDGET)
-
- CALL POSNAM(ILUSEG,'NAM_BU_RU',GFOUND,ILUOUT)
- IF (GFOUND) THEN
- IF ( ALLOCATED( CBULIST_RU ) ) THEN
- CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RU was already allocated' )
- DEALLOCATE( CBULIST_RU )
- END IF
- ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RU(NBULISTMAXLINES) )
- CBULIST_RU(:) = ''
- READ(UNIT=ILUSEG,NML=NAM_BU_RU)
- ELSE
- ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RU(0) )
- END IF
-
- CALL POSNAM(ILUSEG,'NAM_BU_RV',GFOUND,ILUOUT)
- IF (GFOUND) THEN
- IF ( ALLOCATED( CBULIST_RV ) ) THEN
- CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RV was already allocated' )
- DEALLOCATE( CBULIST_RV )
- END IF
- ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RV(NBULISTMAXLINES) )
- CBULIST_RV(:) = ''
- READ(UNIT=ILUSEG,NML=NAM_BU_RV)
- ELSE
- ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RV(0) )
- END IF
-
- CALL POSNAM(ILUSEG,'NAM_BU_RW',GFOUND,ILUOUT)
- IF (GFOUND) THEN
- IF ( ALLOCATED( CBULIST_RW ) ) THEN
- CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RW was already allocated' )
- DEALLOCATE( CBULIST_RW )
- END IF
- ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RW(NBULISTMAXLINES) )
- CBULIST_RW(:) = ''
- READ(UNIT=ILUSEG,NML=NAM_BU_RW)
- ELSE
- ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RW(0) )
- END IF
-
- CALL POSNAM(ILUSEG,'NAM_BU_RTH',GFOUND,ILUOUT)
- IF (GFOUND) THEN
- IF ( ALLOCATED( CBULIST_RTH ) ) THEN
- CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RTH was already allocated' )
- DEALLOCATE( CBULIST_RTH )
- END IF
- ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTH(NBULISTMAXLINES) )
- CBULIST_RTH(:) = ''
- READ(UNIT=ILUSEG,NML=NAM_BU_RTH)
- ELSE
- ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTH(0) )
- END IF
-
- CALL POSNAM(ILUSEG,'NAM_BU_RTKE',GFOUND,ILUOUT)
- IF (GFOUND) THEN
- IF ( ALLOCATED( CBULIST_RTKE ) ) THEN
- CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RTKE was already allocated' )
- DEALLOCATE( CBULIST_RTKE )
- END IF
- ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTKE(NBULISTMAXLINES) )
- CBULIST_RTKE(:) = ''
- READ(UNIT=ILUSEG,NML=NAM_BU_RTKE)
- ELSE
- ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTKE(0) )
- END IF
-
- CALL POSNAM(ILUSEG,'NAM_BU_RRV',GFOUND,ILUOUT)
- IF (GFOUND) THEN
- IF ( ALLOCATED( CBULIST_RRV ) ) THEN
- CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRV was already allocated' )
- DEALLOCATE( CBULIST_RRV )
- END IF
- ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRV(NBULISTMAXLINES) )
- CBULIST_RRV(:) = ''
- READ(UNIT=ILUSEG,NML=NAM_BU_RRV)
- ELSE
- ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRV(0) )
- END IF
-
- CALL POSNAM(ILUSEG,'NAM_BU_RRC',GFOUND,ILUOUT)
- IF (GFOUND) THEN
- IF ( ALLOCATED( CBULIST_RRC ) ) THEN
- CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRC was already allocated' )
- DEALLOCATE( CBULIST_RRC )
- END IF
- ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRC(NBULISTMAXLINES) )
- CBULIST_RRC(:) = ''
- READ(UNIT=ILUSEG,NML=NAM_BU_RRC)
- ELSE
- ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRC(0) )
- END IF
-
- CALL POSNAM(ILUSEG,'NAM_BU_RRR',GFOUND,ILUOUT)
- IF (GFOUND) THEN
- IF ( ALLOCATED( CBULIST_RRR ) ) THEN
- CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRR was already allocated' )
- DEALLOCATE( CBULIST_RRR )
- END IF
- ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRR(NBULISTMAXLINES) )
- CBULIST_RRR(:) = ''
- READ(UNIT=ILUSEG,NML=NAM_BU_RRR)
- ELSE
- ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRR(0) )
- END IF
-
- CALL POSNAM(ILUSEG,'NAM_BU_RRI',GFOUND,ILUOUT)
- IF (GFOUND) THEN
- IF ( ALLOCATED( CBULIST_RRI ) ) THEN
- CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRI was already allocated' )
- DEALLOCATE( CBULIST_RRI )
- END IF
- ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRI(NBULISTMAXLINES) )
- CBULIST_RRI(:) = ''
- READ(UNIT=ILUSEG,NML=NAM_BU_RRI)
- ELSE
- ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRI(0) )
- END IF
-
- CALL POSNAM(ILUSEG,'NAM_BU_RRS',GFOUND,ILUOUT)
- IF (GFOUND) THEN
- IF ( ALLOCATED( CBULIST_RRS ) ) THEN
- CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRS was already allocated' )
- DEALLOCATE( CBULIST_RRS )
- END IF
- ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRS(NBULISTMAXLINES) )
- CBULIST_RRS(:) = ''
- READ(UNIT=ILUSEG,NML=NAM_BU_RRS)
- ELSE
- ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRS(0) )
- END IF
-
- CALL POSNAM(ILUSEG,'NAM_BU_RRG',GFOUND,ILUOUT)
- IF (GFOUND) THEN
- IF ( ALLOCATED( CBULIST_RRG ) ) THEN
- CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRG was already allocated' )
- DEALLOCATE( CBULIST_RRG )
- END IF
- ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRG(NBULISTMAXLINES) )
- CBULIST_RRG(:) = ''
- READ(UNIT=ILUSEG,NML=NAM_BU_RRG)
- ELSE
- ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRG(0) )
- END IF
-
- CALL POSNAM(ILUSEG,'NAM_BU_RRH',GFOUND,ILUOUT)
- IF (GFOUND) THEN
- IF ( ALLOCATED( CBULIST_RRH ) ) THEN
- CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRH was already allocated' )
- DEALLOCATE( CBULIST_RRH )
- END IF
- ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRH(NBULISTMAXLINES) )
- CBULIST_RRH(:) = ''
- READ(UNIT=ILUSEG,NML=NAM_BU_RRH)
- ELSE
- ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRH(0) )
- END IF
-
- CALL POSNAM(ILUSEG,'NAM_BU_RSV',GFOUND,ILUOUT)
- IF (GFOUND) THEN
- IF ( ALLOCATED( CBULIST_RSV ) ) THEN
- CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RSV was already allocated' )
- DEALLOCATE( CBULIST_RSV )
- END IF
- ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RSV(NBULISTMAXLINES) )
- CBULIST_RSV(:) = ''
- READ(UNIT=ILUSEG,NML=NAM_BU_RSV)
- ELSE
- ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RSV(0) )
- END IF
-
- CALL POSNAM(ILUSEG,'NAM_LES',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LES)
- CALL POSNAM(ILUSEG,'NAM_MEAN',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_MEAN)
- CALL POSNAM(ILUSEG,'NAM_PDF',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PDF)
- CALL POSNAM(ILUSEG,'NAM_FRC',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FRC)
- CALL POSNAM(ILUSEG,'NAM_PARAM_ICE',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_ICE)
- CALL POSNAM(ILUSEG,'NAM_PARAM_C2R2',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_C2R2)
- CALL POSNAM(ILUSEG,'NAM_PARAM_C1R3',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_C1R3)
- CALL POSNAM(ILUSEG,'NAM_PARAM_LIMA',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_LIMA)
- CALL POSNAM(ILUSEG,'NAM_ELEC',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_ELEC)
- CALL POSNAM(ILUSEG,'NAM_SERIES',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_SERIES)
- CALL POSNAM(ILUSEG,'NAM_TURB_CLOUD',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_TURB_CLOUD)
- CALL POSNAM(ILUSEG,'NAM_TURB',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_TURB)
- CALL POSNAM(ILUSEG,'NAM_CH_ORILAM',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CH_ORILAM)
- CALL POSNAM(ILUSEG,'NAM_DUST',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DUST)
- CALL POSNAM(ILUSEG,'NAM_SALT',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_SALT)
- CALL POSNAM(ILUSEG,'NAM_PASPOL',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PASPOL)
-#ifdef MNH_FOREFIRE
- CALL POSNAM(ILUSEG,'NAM_FOREFIRE',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FOREFIRE)
-#endif
- CALL POSNAM(ILUSEG,'NAM_CONDSAMP',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONDSAMP)
- CALL POSNAM(ILUSEG,'NAM_2D_FRC',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_2D_FRC)
- CALL POSNAM(ILUSEG,'NAM_LATZ_EDFLX',GFOUND)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LATZ_EDFLX)
- CALL POSNAM(ILUSEG,'NAM_BLOWSNOW',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BLOWSNOW)
- CALL POSNAM(ILUSEG,'NAM_VISC',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_VISC)
-
- CALL POSNAM(ILUSEG,'NAM_FLYERS',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FLYERS)
-
- IF ( NAIRCRAFTS > 0 ) THEN
- CALL AIRCRAFTS_NML_ALLOCATE( NAIRCRAFTS )
- CALL POSNAM(ILUSEG,'NAM_AIRCRAFTS',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_AIRCRAFTS)
- END IF
-
- IF ( NBALLOONS > 0 ) THEN
- CALL BALLOONS_NML_ALLOCATE( NBALLOONS )
- CALL POSNAM(ILUSEG,'NAM_BALLOONS',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BALLOONS)
- END IF
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-CALL TEST_NAM_VAR(ILUOUT,'CPRESOPT',CPRESOPT,'RICHA','CGRAD','CRESI','ZRESI')
-!
-CALL TEST_NAM_VAR(ILUOUT,'CUVW_ADV_SCHEME',CUVW_ADV_SCHEME, &
- 'CEN4TH','CEN2ND','WENO_K' )
-CALL TEST_NAM_VAR(ILUOUT,'CMET_ADV_SCHEME',CMET_ADV_SCHEME, &
- &'PPM_00','PPM_01','PPM_02')
-CALL TEST_NAM_VAR(ILUOUT,'CSV_ADV_SCHEME',CSV_ADV_SCHEME, &
- &'PPM_00','PPM_01','PPM_02')
-CALL TEST_NAM_VAR(ILUOUT,'CTEMP_SCHEME',CTEMP_SCHEME, &
- &'RK11','RK21','RK33','RKC4','RK53','RK4B','RK62','RK65','NP32','SP32','LEFR')
-!
-CALL TEST_NAM_VAR(ILUOUT,'CTURB',CTURB,'NONE','TKEL')
-CALL TEST_NAM_VAR(ILUOUT,'CRAD',CRAD,'NONE','FIXE','ECMW',&
-#ifdef MNH_ECRAD
- 'ECRA',&
-#endif
- 'TOPA')
-CALL TEST_NAM_VAR(ILUOUT,'CCLOUD',CCLOUD,'NONE','REVE','KESS', &
- & 'ICE3','ICE4','C2R2','C3R5','KHKO','LIMA')
-CALL TEST_NAM_VAR(ILUOUT,'CDCONV',CDCONV,'NONE','KAFR')
-CALL TEST_NAM_VAR(ILUOUT,'CSCONV',CSCONV,'NONE','KAFR','EDKF')
-CALL TEST_NAM_VAR(ILUOUT,'CELEC',CELEC,'NONE','ELE3','ELE4')
-!
-CALL TEST_NAM_VAR(ILUOUT,'CAER',CAER,'TANR','TEGE','SURF','NONE')
-CALL TEST_NAM_VAR(ILUOUT,'CAOP',CAOP,'CLIM','EXPL')
-CALL TEST_NAM_VAR(ILUOUT,'CLW',CLW,'RRTM','MORC')
-CALL TEST_NAM_VAR(ILUOUT,'CEFRADL',CEFRADL,'PRES','OCLN','MART','C2R2','LIMA')
-CALL TEST_NAM_VAR(ILUOUT,'CEFRADI',CEFRADI,'FX40','LIOU','SURI','C3R5','LIMA')
-CALL TEST_NAM_VAR(ILUOUT,'COPWLW',COPWLW,'SAVI','SMSH','LILI','MALA')
-CALL TEST_NAM_VAR(ILUOUT,'COPILW',COPILW,'FULI','EBCU','SMSH','FU98')
-CALL TEST_NAM_VAR(ILUOUT,'COPWSW',COPWSW,'SLIN','FOUQ','MALA')
-CALL TEST_NAM_VAR(ILUOUT,'COPISW',COPISW,'FULI','EBCU','FU96')
-!
-CALL TEST_NAM_VAR(ILUOUT,'CLBCX(1)',CLBCX(1),'CYCL','WALL','OPEN')
-CALL TEST_NAM_VAR(ILUOUT,'CLBCX(2)',CLBCX(2),'CYCL','WALL','OPEN')
-CALL TEST_NAM_VAR(ILUOUT,'CLBCY(1)',CLBCY(1),'CYCL','WALL','OPEN')
-CALL TEST_NAM_VAR(ILUOUT,'CLBCY(2)',CLBCY(2),'CYCL','WALL','OPEN')
-!
-CALL TEST_NAM_VAR(ILUOUT,'CTURBDIM',CTURBDIM,'1DIM','3DIM')
-CALL TEST_NAM_VAR(ILUOUT,'CTURBLEN',CTURBLEN,'DELT','BL89','RM17','DEAR','BLKR','HM21')
-CALL TEST_NAM_VAR(ILUOUT,'CTOM',CTOM,'NONE','TM06')
-CALL TEST_NAM_VAR(ILUOUT,'CSUBG_AUCV',CSUBG_AUCV,'NONE','CLFR','SIGM','PDF','ADJU')
-CALL TEST_NAM_VAR(ILUOUT,'CSUBG_AUCV_RI',CSUBG_AUCV_RI,'NONE','CLFR','ADJU')
-CALL TEST_NAM_VAR(ILUOUT,'CCONDENS',CCONDENS,'CB02','GAUS')
-CALL TEST_NAM_VAR(ILUOUT,'CLAMBDA3',CLAMBDA3,'CB','NONE')
-CALL TEST_NAM_VAR(ILUOUT,'CSUBG_MF_PDF',CSUBG_MF_PDF,'NONE','TRIANGLE')
-!
-CALL TEST_NAM_VAR(ILUOUT,'CCH_TDISCRETIZATION',CCH_TDISCRETIZATION, &
- 'SPLIT ','CENTER ','LAGGED ')
-!
-CALL TEST_NAM_VAR(ILUOUT,'CCONF',CCONF,'START','RESTA')
-CALL TEST_NAM_VAR(ILUOUT,'CEQNSYS',CEQNSYS,'LHE','DUR','MAE')
-CALL TEST_NAM_VAR(ILUOUT,'CSPLIT',CSPLIT,'BSPLITTING','XSPLITTING','YSPLITTING')
-!
-CALL TEST_NAM_VAR(ILUOUT,'CBUTYPE',CBUTYPE,'NONE','CART','MASK')
-!
-CALL TEST_NAM_VAR(ILUOUT,'CRELAX_HEIGHT_TYPE',CRELAX_HEIGHT_TYPE,'FIXE','THGR')
-!
-CALL TEST_NAM_VAR(ILUOUT,'CLES_NORM_TYPE',CLES_NORM_TYPE,'NONE','CONV','EKMA','MOBU')
-CALL TEST_NAM_VAR(ILUOUT,'CBL_HEIGHT_DEF',CBL_HEIGHT_DEF,'TKE','KE','WTV','FRI','DTH')
-CALL TEST_NAM_VAR(ILUOUT,'CTURBLEN_CLOUD',CTURBLEN_CLOUD,'NONE','DEAR','DELT','BL89')
-!
-! The test on the mass flux scheme for shallow convection
-!
-CALL TEST_NAM_VAR(ILUOUT,'CMF_UPDRAFT',CMF_UPDRAFT,'NONE','EDKF','RHCJ')
-CALL TEST_NAM_VAR(ILUOUT,'CMF_CLOUD',CMF_CLOUD,'NONE','STAT','DIRE')
-!
-! The test on the CSOLVER name is made elsewhere
-!
-CALL TEST_NAM_VAR(ILUOUT,'CPRISTINE_ICE',CPRISTINE_ICE,'PLAT','COLU','BURO')
-CALL TEST_NAM_VAR(ILUOUT,'CSEDIM',CSEDIM,'SPLI','STAT','NONE')
-IF( CCLOUD == 'C3R5' ) THEN
- CALL TEST_NAM_VAR(ILUOUT,'CPRISTINE_ICE_C1R3',CPRISTINE_ICE_C1R3, &
- 'PLAT','COLU','BURO')
- CALL TEST_NAM_VAR(ILUOUT,'CHEVRIMED_ICE_C1R3',CHEVRIMED_ICE_C1R3, &
- 'GRAU','HAIL')
-END IF
-!
-IF( CCLOUD == 'LIMA' ) THEN
- CALL TEST_NAM_VAR(ILUOUT,'CPRISTINE_ICE_LIMA',CPRISTINE_ICE_LIMA, &
- 'PLAT','COLU','BURO')
- CALL TEST_NAM_VAR(ILUOUT,'CHEVRIMED_ICE_LIMA',CHEVRIMED_ICE_LIMA, &
- 'GRAU','HAIL')
-END IF
-! Blaze
-CALL UPDATE_NAM_FIREn
-IF (LBLAZE) THEN
- ! Blaze is only allowed on finer model(s)
- DO JI = 1, NMODEL
- IF ( JI /= KMI .AND. NDAD(JI) == KMI ) THEN
- WRITE( YMODEL, '( I3 )' ) JI
- CMNHMSG(1) = 'Blaze fire model only allowed on finer model'
- CMNHMSG(2) = '=> disabled on model ' // YMODEL
- CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'READ_EXSEG_n' )
- LBLAZE = .FALSE.
- END IF
- END DO
- CALL TEST_NAM_VAR(ILUOUT,'CPROPAG_MODEL',CPROPAG_MODEL,'SANTONI2011')
- CALL TEST_NAM_VAR(ILUOUT,'CHEAT_FLUX_MODEL',CHEAT_FLUX_MODEL,'CST','EXP','EXS')
- CALL TEST_NAM_VAR(ILUOUT,'CLATENT_FLUX_MODEL',CLATENT_FLUX_MODEL,'CST','EXP')
- CALL TEST_NAM_VAR(ILUOUT,'CFIRE_CPL_MODE',CFIRE_CPL_MODE,'2WAYCPL','FIR2ATM','ATM2FIR')
- CALL TEST_NAM_VAR(ILUOUT,'CWINDFILTER',CWINDFILTER,'EWAM','WLIM')
-END IF
-!
-IF(LBLOWSNOW) THEN
- CALL TEST_NAM_VAR(ILUOUT,'CSNOWSEDIM',CSNOWSEDIM,'NONE','MITC','CARR','TABC')
- IF (XALPHA_SNOW .NE. 3 .AND. CSNOWSEDIM=='TABC') THEN
- WRITE(ILUOUT,*) '*****************************************'
- WRITE(ILUOUT,*) '* XALPHA_SNW must be set to 3 when '
- WRITE(ILUOUT,*) '* CSNOWSEDIM = TABC '
- WRITE(ILUOUT,*) '* Update the look-up table in BLOWSNOW_SEDIM_LKT1D '
- WRITE(ILUOUT,*) '* to use TABC with a different value of XEMIALPHA_SNW'
- WRITE(ILUOUT,*) '*****************************************'
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
- ENDIF
-END IF
-!
-!-------------------------------------------------------------------------------!
-!* 2. FIRST INITIALIZATIONS
-! ---------------------
-!
-!* 2.1 Time step in gridnesting case
-!
-IF (KMI /= 1 .AND. NDAD(KMI) /= KMI) THEN
- XTSTEP = PTSTEP_ALL(NDAD(KMI)) / NDTRATIO(KMI)
-END IF
-PTSTEP_ALL(KMI) = XTSTEP
-!
-!* 2.2 Fill the global configuration module
-!
-! Check coherence between the microphysical scheme and water species and
-!initialize the logicals LUSERn
-!
-SELECT CASE ( CCLOUD )
- CASE ( 'NONE' )
- IF (.NOT. ( (.NOT. LUSERC) .AND. (.NOT. LUSERR) .AND. (.NOT. LUSERI) .AND. &
- (.NOT. LUSERS) .AND. (.NOT. LUSERG) .AND. (.NOT. LUSERH) &
- ) .AND. CPROGRAM=='MESONH' ) THEN
-!
- LUSERC=.FALSE.
- LUSERR=.FALSE.; LUSERI=.FALSE.
- LUSERS=.FALSE.; LUSERG=.FALSE.
- LUSERH=.FALSE.
-!
- END IF
-!
- IF (CSUBG_AUCV == 'SIGM') THEN
-!
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE THE SUBGRID AUTOCONVERSION SCHEME '
- WRITE(UNIT=ILUOUT,FMT=*) ' WITHOUT MICROPHYSICS'
- WRITE(UNIT=ILUOUT,FMT=*) ' CSUBG_AUCV IS PUT TO "NONE"'
-!
- CSUBG_AUCV = 'NONE'
-!
- END IF
-!
- CASE ( 'REVE' )
- IF (.NOT. ( LUSERV .AND. LUSERC .AND. (.NOT. LUSERR) .AND. (.NOT. LUSERI) &
- .AND. (.NOT. LUSERS) .AND. (.NOT. LUSERG) .AND. (.NOT. LUSERH) &
- ) ) THEN
-!
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A REVERSIBLE MICROPHYSICAL " ,&
- &" SCHEME. YOU WILL ONLY HAVE VAPOR AND CLOUD WATER ",/, &
- &" LUSERV AND LUSERC ARE TO TRUE AND THE OTHERS TO FALSE ")')
-!
- LUSERV=.TRUE. ; LUSERC=.TRUE.
- LUSERR=.FALSE.; LUSERI=.FALSE.
- LUSERS=.FALSE.; LUSERG=.FALSE.
- LUSERH=.FALSE.
- END IF
-!
- IF (CSUBG_AUCV == 'SIGM') THEN
-!
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH A REVERSIBLE MICROPHYSICAL SCHEME '
- WRITE(UNIT=ILUOUT,FMT=*) ' AND THE SUBGRID AUTOCONVERSION SCHEME '
- WRITE(UNIT=ILUOUT,FMT=*) 'BUT YOU DO NOT HAVE RAIN in the "REVE" SCHEME'
- WRITE(UNIT=ILUOUT,FMT=*) ' CSUBG_AUCV IS PUT TO "NONE"'
-!
- CSUBG_AUCV = 'NONE'
-!
- END IF
-!
- CASE ( 'KESS' )
- IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. (.NOT. LUSERI) .AND. &
- (.NOT. LUSERS) .AND. (.NOT. LUSERG) .AND. (.NOT. LUSERH) &
- ) ) THEN
-!
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A KESSLER MICROPHYSICAL " , &
- &" SCHEME. YOU WILL ONLY HAVE VAPOR, CLOUD WATER AND RAIN ",/, &
- &" LUSERV, LUSERC AND LUSERR ARE SET TO TRUE AND THE OTHERS TO FALSE ")')
-!
- LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
- LUSERI=.FALSE.; LUSERS=.FALSE.
- LUSERG=.FALSE.; LUSERH=.FALSE.
- END IF
-!
- IF (CSUBG_AUCV == 'SIGM') THEN
-!
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH A KESSLER MICROPHYSICAL SCHEME '
- WRITE(UNIT=ILUOUT,FMT=*) ' AND THE SUBGRID AUTOCONVERSION SCHEME USING'
- WRITE(UNIT=ILUOUT,FMT=*) 'SIGMA_RC.'
- WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT YET AVAILABLE.'
- WRITE(UNIT=ILUOUT,FMT=*) 'SET CSUBG_AUCV TO "CLFR" or "NONE" OR CCLOUD TO "ICE3"'
-!
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
- END IF
-!
- CASE ( 'ICE3' )
- IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. LUSERI .AND. LUSECI &
- .AND. LUSERS .AND. LUSERG .AND. (.NOT. LUSERH)) &
- .AND. CPROGRAM=='MESONH' ) THEN
- !
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE THE ice3 SIMPLE MIXED PHASE'
- WRITE(UNIT=ILUOUT,FMT=*) 'MICROPHYSICAL SCHEME. YOU WILL ONLY HAVE VAPOR, CLOUD WATER,'
- WRITE(UNIT=ILUOUT,FMT=*) 'RAIN WATER, CLOUD ICE (MIXING RATIO AND CONCENTRATION)'
- WRITE(UNIT=ILUOUT,FMT=*) 'SNOW-AGGREGATES AND GRAUPELN.'
- WRITE(UNIT=ILUOUT,FMT=*) 'LUSERV,LUSERC,LUSERR,LUSERI,LUSECI,LUSERS,LUSERG ARE SET TO TRUE'
- WRITE(UNIT=ILUOUT,FMT=*) 'AND LUSERH TO FALSE'
-!
- LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
- LUSERI=.TRUE. ; LUSECI=.TRUE.
- LUSERS=.TRUE. ; LUSERG=.TRUE.
- LUSERH=.FALSE.
- END IF
-!
- IF (CSUBG_AUCV == 'SIGM' .AND. .NOT. LSUBG_COND) THEN
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE SUBGRID AUTOCONVERSION SCHEME'
- WRITE(UNIT=ILUOUT,FMT=*) ' WITHOUT THE SUBGRID CONDENSATION SCHEME.'
- WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT ALLOWED: CSUBG_AUCV is SET to NONE'
- CSUBG_AUCV='NONE'
- END IF
-!
- IF (CSUBG_AUCV == 'CLFR' .AND. CSCONV /= 'EDKF') THEN
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE SUBGRID AUTOCONVERSION SCHEME'
- WRITE(UNIT=ILUOUT,FMT=*) 'WITH THE CONVECTIVE CLOUD FRACTION WITHOUT EDKF'
- WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT ALLOWED: CSUBG_AUCV is SET to NONE'
- CSUBG_AUCV='NONE'
- END IF
-!
- CASE ( 'ICE4' )
- IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. LUSERI .AND. LUSECI &
- .AND. LUSERS .AND. LUSERG .AND. LUSERH) &
- .AND. CPROGRAM=='MESONH' ) THEN
- !
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE THE ice4 SIMPLE MIXED PHASE'
- WRITE(UNIT=ILUOUT,FMT=*) 'MICROPHYSICAL SCHEME. YOU WILL ONLY HAVE VAPOR, CLOUD WATER,'
- WRITE(UNIT=ILUOUT,FMT=*) 'RAIN WATER, CLOUD ICE (MIXING RATIO AND CONCENTRATION)'
- WRITE(UNIT=ILUOUT,FMT=*) 'SNOW-AGGREGATES, GRAUPELN AND HAILSTONES.'
- WRITE(UNIT=ILUOUT,FMT=*) 'LUSERV,LUSERC,LUSERR,LUSERI,LUSECI,LUSERS,LUSERG'
- WRITE(UNIT=ILUOUT,FMT=*) 'AND LUSERH ARE SET TO TRUE'
-!
- LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
- LUSERI=.TRUE. ; LUSECI=.TRUE.
- LUSERS=.TRUE. ; LUSERG=.TRUE. ; LUSERH=.TRUE.
- END IF
-!
- IF (CSUBG_AUCV /= 'NONE' .AND. .NOT. LSUBG_COND) THEN
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE SUBGRID AUTOCONVERSION SCHEME'
- WRITE(UNIT=ILUOUT,FMT=*) ' WITHOUT THE SUBGRID CONDENSATION SCHEME.'
- WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT ALLOWED: CSUBG_AUCV is SET to NONE'
- CSUBG_AUCV='NONE'
- END IF
-!
- CASE ( 'C2R2','C3R5', 'KHKO' )
- IF (( EPARAM_CCN == 'XXX') .OR. (EINI_CCN == 'XXX')) THEN
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A 2-MOMENT MICROPHYSICAL ", &
- &" SCHEME BUT YOU DIDNT FILL CORRECTLY NAM_PARAM_C2R2", &
- &" YOU HAVE TO FILL HPARAM_CCN and HINI_CCN ")')
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
- END IF
- IF (HCLOUD == 'NONE') THEN
- CGETCLOUD = 'SKIP'
- ELSE IF (HCLOUD == 'REVE' ) THEN
- CGETCLOUD = 'INI1'
- ELSE IF (HCLOUD == 'KESS' ) THEN
- CGETCLOUD = 'INI2'
- ELSE IF (HCLOUD == 'ICE3' ) THEN
- IF (CCLOUD == 'C3R5') THEN
- CGETCLOUD = 'INI2'
- ELSE
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE WARM MICROPHYSICAL ", &
- &" SCHEME BUT YOU WERE USING THE ICE3 SCHEME PREVIOUSLY.",/, &
- &" AS THIS IS A LITTLE BIT STUPID IT IS NOT AUTHORIZED !!!")')
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
- END IF
- ELSE
- CGETCLOUD = 'READ' ! This is automatically done
- END IF
-!
- IF ((CCLOUD == 'C2R2' ).OR. (CCLOUD == 'KHKO' )) THEN
- IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. (.NOT. LUSERI) .AND. &
- (.NOT. LUSERS) .AND. (.NOT. LUSERG) .AND. (.NOT. LUSERH) &
- ) ) THEN
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE C2R2 MICROPHYSICAL ", &
- &" SCHEME. YOU WILL ONLY HAVE VAPOR, CLOUD WATER AND RAIN ",/, &
- &"LUSERV, LUSERC AND LUSERR ARE SET TO TRUE AND THE OTHERS TO FALSE ")')
-!
- LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
- LUSERI=.FALSE.; LUSERS=.FALSE.
- LUSERG=.FALSE.; LUSERH=.FALSE.
- END IF
- ELSE IF (CCLOUD == 'C3R5') THEN
- IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. LUSERI .AND. &
- LUSERS .AND. LUSERG .AND. (.NOT. LUSERH) &
- ) ) THEN
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE C3R5 MICROPHYS. SCHEME.",&
- &" YOU WILL HAVE VAPOR, CLOUD WATER/ICE, RAIN, SNOW AND GRAUPEL ",/, &
- &"LUSERV, LUSERC, LUSERR, LUSERI, LUSERS, LUSERG ARE SET TO TRUE")' )
-!
- LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
- LUSERI=.TRUE. ; LUSECI=.TRUE.
- LUSERS=.TRUE. ; LUSERG=.TRUE.
- LUSERH=.FALSE.
- END IF
- ELSE IF (CCLOUD == 'LIMA') THEN
- IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. LUSERI .AND. &
- LUSERS .AND. LUSERG .AND. (.NOT. LUSERH) &
- ) ) THEN
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE LIMA MICROPHYS. SCHEME.",&
- &" YOU WILL HAVE VAPOR, CLOUD WATER/ICE, RAIN, SNOW AND GRAUPEL ",/, &
- &"LUSERV, LUSERC, LUSERR, LUSERI, LUSERS, LUSERG ARE SET TO TRUE")' )
-!
- LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
- LUSERI=.TRUE. ; LUSECI=.TRUE.
- LUSERS=.TRUE. ; LUSERG=.TRUE.
- LUSERH=.FALSE.
- END IF
- END IF
-!
- IF (LSUBG_COND) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH THE SIMPLE MIXED PHASE'
- WRITE(UNIT=ILUOUT,FMT=*) 'MICROPHYS. SCHEME AND THE SUBGRID COND. SCHEME.'
- WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT YET AVAILABLE.'
- WRITE(UNIT=ILUOUT,FMT=*) 'SET LSUBG_COND TO FALSE OR CCLOUD TO "REVE", "KESS"'
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
- END IF
-!
- IF ( CEFRADL /= 'C2R2') THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT=*) ' YOU DID NOT CHOOSE CEFRADL=C2R2 FOR RADIATION'
- WRITE(UNIT=ILUOUT,FMT=*) ' IT IS ADVISED TO USE CEFRADL=C2R2 '
- WRITE(UNIT=ILUOUT,FMT=*) ' WITH A 2-MOMENT MICROPHYSICAL SCHEME'
- END IF
-!
- IF ( CCLOUD == 'C3R5' .AND. CEFRADI /= 'C3R5') THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT=*) ' YOU DID NOT CHOOSE CEFRADI=C3R5 FOR RADIATION'
- WRITE(UNIT=ILUOUT,FMT=*) ' IT IS ADVISED TO USE CEFRADI=C3R5 '
- WRITE(UNIT=ILUOUT,FMT=*) ' WITH A 2-MOMENT MICROPHYSICAL SCHEME'
- END IF
-!
- IF ( WALPHAC /= 3.0 .OR. WNUC /= 2.0) THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'IT IS ADVISED TO USE XALPHAC=3. and XNUC=2.'
- WRITE(UNIT=ILUOUT,FMT=*) 'FOR STRATOCUMULUS WITH KHKO SCHEME. '
- END IF
-!
- IF ( CEFRADL /= 'C2R2') THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT=*) ' YOU DID NOT CHOOSE CEFRADL=C2R2 FOR RADIATION'
- WRITE(UNIT=ILUOUT,FMT=*) ' IT IS ADVISED TO USE CEFRADL=C2R2 '
- WRITE(UNIT=ILUOUT,FMT=*) ' WITH A 2-MOMENT MICROPHYSICAL SCHEME'
- END IF
-!
- CASE ( 'LIMA')
- IF ((LACTI .AND. FINI_CCN == 'XXX')) THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A 2-MOMENT MICROPHYSICAL ", &
- &" SCHEME BUT YOU DIDNT FILL CORRECTLY NAM_PARAM_LIMA", &
- &" YOU HAVE TO FILL FINI_CCN ")')
- call Print_msg( NVERB_FATAL, 'GEN', 'READ_EXSEG_n', '' )
- END IF
-!
- IF(LACTI .AND. NMOD_CCN == 0) THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("ACTIVATION OF AEROSOL PARTICLES IS NOT ", &
- &"POSSIBLE IF NMOD_CCN HAS VALUE ZERO. YOU HAVE TO SET AN UPPER ", &
- &"VALUE OF NMOD_CCN IN ORDER TO USE LIMA WARM ACTIVATION SCHEME.")')
- call Print_msg( NVERB_FATAL, 'GEN', 'READ_EXSEG_n', '' )
- END IF
-!
- IF(LNUCL .AND. NMOD_IFN == 0 .AND. (.NOT.LMEYERS)) THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("NUCLEATION BY DEPOSITION AND CONTACT IS NOT ", &
- &"POSSIBLE IF NMOD_IFN HAS VALUE ZERO. YOU HAVE TO SET AN UPPER", &
- &"VALUE OF NMOD_IFN IN ORDER TO USE LIMA COLD NUCLEATION SCHEME.")')
- END IF
-!
- IF (HCLOUD == 'NONE') THEN
- CGETCLOUD = 'SKIP'
- ELSE IF (HCLOUD == 'REVE' ) THEN
- CGETCLOUD = 'INI1'
- ELSE IF (HCLOUD == 'KESS' ) THEN
- CGETCLOUD = 'INI2'
- ELSE IF (HCLOUD == 'ICE3' ) THEN
- CGETCLOUD = 'INI2'
- ELSE
- CGETCLOUD = 'READ' ! This is automatically done
- END IF
-!
- IF (NMOM_C.GE.1) THEN
- LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
- LUSERI=.FALSE.; LUSERS=.FALSE. ; LUSERG=.FALSE.; LUSERH=.FALSE.
- END IF
-!
- IF (NMOM_I.GE.1) THEN
- LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE.
- LUSERI=.TRUE. ; LUSERS=.TRUE. ; LUSERG=.TRUE.
- LUSERH= NMOM_H.GE.1
- END IF
- !
- IF (LSPRO) LADJ=.FALSE.
- IF (.NOT.LPTSPLIT) THEN
- IF (NMOM_C==1) NMOM_C=2
- IF (NMOM_R==1) NMOM_R=2
- IF (NMOM_I==1) NMOM_I=2
- IF (NMOM_S==2 .OR. NMOM_G==2 .OR. NMOM_H==2) THEN
- NMOM_S=2
- NMOM_G=2
- IF (NMOM_H.GE.1) NMOM_H=2
- END IF
- END IF
-!
- IF (LSUBG_COND .AND. (.NOT. LPTSPLIT)) THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'YOU MUST USE LPTSPLIT=T with CCLOUD=LIMA'
- WRITE(UNIT=ILUOUT,FMT=*) 'AND LSUBG_COND '
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','use LPTSPLIT=T with LIMA and LSUBG_COND=T')
- END IF
-!
- IF (LSUBG_COND .AND. (.NOT. LADJ)) THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'YOU MUST USE LADJ=T with CCLOUD=LIMA'
- WRITE(UNIT=ILUOUT,FMT=*) 'AND LSUBG_COND '
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','use LADJ=T with LIMA and LSUBG_COND=T')
- END IF
-!
- IF ( LKHKO .AND. (XALPHAC /= 3.0 .OR. XNUC /= 2.0) ) THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'IT IS ADVISED TO USE XALPHAC=3. and XNUC=2.'
- WRITE(UNIT=ILUOUT,FMT=*) 'FOR STRATOCUMULUS. '
- END IF
-!
- IF ( CEFRADL /= 'LIMA') THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT=*) ' YOU DID NOT CHOOSE CEFRADL=LIMA FOR RADIATION'
- WRITE(UNIT=ILUOUT,FMT=*) ' IT IS ADVISED TO USE CEFRADL=LIMA '
- WRITE(UNIT=ILUOUT,FMT=*) ' WITH A 2-MOMENT MICROPHYSICAL SCHEME "LIMA"'
- END IF
-!
-END SELECT
-!
-LUSERV_G(KMI) = LUSERV
-LUSERC_G(KMI) = LUSERC
-LUSERR_G(KMI) = LUSERR
-LUSERI_G(KMI) = LUSERI
-LUSERS_G(KMI) = LUSERS
-LUSERG_G(KMI) = LUSERG
-LUSERH_G(KMI) = LUSERH
-LUSETKE(KMI) = (CTURB /= 'NONE')
-!
-!-------------------------------------------------------------------------------
-!
-!* 2.3 Chemical and NSV_* variables initializations
-!
-CALL UPDATE_NAM_IBM_PARAMN
-CALL UPDATE_NAM_RECYCL_PARAMN
-CALL UPDATE_NAM_PARAMN
-CALL UPDATE_NAM_DYNN
-CALL UPDATE_NAM_CONFN
-!
-IF (LORILAM .AND. .NOT. LUSECHEM) THEN
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU CANNOT USE ORILAM AEROSOL SCHEME WITHOUT '
- WRITE(ILUOUT,FMT=*) 'CHEMICAL GASEOUS CHEMISTRY '
- WRITE(ILUOUT,FMT=*) 'THEREFORE LUSECHEM IS SET TO TRUE '
- LUSECHEM=.TRUE.
-END IF
-!
-IF (LUSECHAQ.AND.(.NOT.LUSECHEM)) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE AQUEOUS PHASE CHEMISTRY'
- WRITE(UNIT=ILUOUT,FMT=*) 'BUT THE CHEMISTRY IS NOT ACTIVATED'
- WRITE(UNIT=ILUOUT,FMT=*) 'SET LUSECHEM TO TRUE IF YOU WANT REALLY USE CHEMISTRY'
- WRITE(UNIT=ILUOUT,FMT=*) 'OR SET LUSECHAQ TO FALSE IF YOU DO NOT WANT USE IT'
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
-END IF
-IF (LUSECHAQ.AND.(.NOT.LUSERC).AND.CPROGRAM=='MESONH') THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE AQUEOUS PHASE CHEMISTRY'
- WRITE(UNIT=ILUOUT,FMT=*) 'BUT CLOUD MICROPHYSICS IS NOT ACTIVATED'
- WRITE(UNIT=ILUOUT,FMT=*) 'LUSECHAQ IS SET TO FALSE'
- LUSECHAQ = .FALSE.
-END IF
-IF (LUSECHAQ.AND.CCLOUD(1:3) == 'ICE'.AND. .NOT. LUSECHIC) THEN
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE AQUEOUS PHASE CHEMISTRY'
- WRITE(UNIT=ILUOUT,FMT=*) 'WITH MIXED PHASE CLOUD MICROPHYSICS'
- WRITE(UNIT=ILUOUT,FMT=*) 'SET LUSECHIC TO TRUE IF YOU WANT TO ACTIVATE'
- WRITE(UNIT=ILUOUT,FMT=*) 'ICE PHASE CHEMICAL SPECIES'
- IF (LCH_RET_ICE) THEN
- WRITE(UNIT=ILUOUT,FMT=*) 'LCH_RET_ICE TRUE MEANS ALL SOLUBLE'
- WRITE(UNIT=ILUOUT,FMT=*) 'GASES ARE RETAINED IN ICE PHASE'
- WRITE(UNIT=ILUOUT,FMT=*) 'WHEN SUPERCOOLED WATER FREEZES'
- ELSE
- WRITE(UNIT=ILUOUT,FMT=*) 'LCH_RET_ICE FALSE MEANS ALL SOLUBLE'
- WRITE(UNIT=ILUOUT,FMT=*) 'GASES GO BACK TO THE GAS PHASE WHEN'
- WRITE(UNIT=ILUOUT,FMT=*) 'SUPERCOOLED WATER FREEZES'
- ENDIF
-ENDIF
-IF (LUSECHIC.AND. .NOT. CCLOUD(1:3) == 'ICE'.AND.CPROGRAM=='MESONH') THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE ICE PHASE CHEMISTRY'
- WRITE(UNIT=ILUOUT,FMT=*) 'BUT MIXED PHASE CLOUD MICROPHYSICS IS NOT ACTIVATED'
- WRITE(UNIT=ILUOUT,FMT=*) 'LUSECHIC IS SET TO FALSE'
- LUSECHIC= .FALSE.
-ENDIF
-IF (LCH_PH.AND. (.NOT. LUSECHAQ)) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'DIAGNOSTIC PH COMPUTATION IS ACTIVATED'
- WRITE(UNIT=ILUOUT,FMT=*) 'BUT AQUEOUS PHASE CHEMISTRY IS NOT ACTIVATED'
- WRITE(UNIT=ILUOUT,FMT=*) 'SET LUSECHAQ TO TRUE IF YOU WANT TO ACTIVATE IT'
- WRITE(UNIT=ILUOUT,FMT=*) 'LCH_PH IS SET TO FALSE'
- LCH_PH= .FALSE.
-ENDIF
-IF (LUSECHIC.AND.(.NOT.LUSECHAQ)) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE ICE PHASE CHEMISTRY'
- WRITE(UNIT=ILUOUT,FMT=*) 'BUT THE AQUEOUS PHASE CHEMISTRY IS NOT ACTIVATED'
- WRITE(UNIT=ILUOUT,FMT=*) 'SET LUSECHAQ TO TRUE IF YOU WANT REALLY USE CLOUD CHEMISTRY'
- WRITE(UNIT=ILUOUT,FMT=*) 'OR SET LUSECHIC TO FALSE IF YOU DO NOT WANT USE IT'
-!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
-END IF
-IF ((LUSECHIC).AND.(LCH_RET_ICE)) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE RETENTION OF SOLUBLE GASES IN ICE'
- WRITE(UNIT=ILUOUT,FMT=*) 'BUT THE ICE PHASE CHEMISTRY IS ACTIVATED'
- WRITE(UNIT=ILUOUT,FMT=*) 'FLAG LCH_RET_ICE IS ONLY USES WHEN LUSECHIC IS SET'
- WRITE(UNIT=ILUOUT,FMT=*) 'TO FALSE IE NO CHEMICAL SPECIES IN ICE'
-ENDIF
-!
-CALL UPDATE_NAM_CH_MNHCN
-CALL INI_NSV(KMI)
-!
-! From this point, all NSV* variables contain valid values for model KMI
-!
-DO JSV = 1,NSV
- LUSESV(JSV,KMI) = .TRUE.
-END DO
-!
-IF ( CAOP=='EXPL' .AND. .NOT.LDUST .AND. .NOT.LORILAM &
- .AND. .NOT.LSALT .AND. .NOT.(CCLOUD=='LIMA') ) THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT=*) ' YOU WANT TO USE EXPLICIT AEROSOL OPTICAL '
- WRITE(UNIT=ILUOUT,FMT=*) 'PROPERTIES BUT YOU DONT HAVE DUST OR '
- WRITE(UNIT=ILUOUT,FMT=*) 'AEROSOL OR SALT THEREFORE CAOP=CLIM'
- CAOP='CLIM'
-END IF
-!-------------------------------------------------------------------------------
-!
-!* 3. CHECK COHERENCE BETWEEN EXSEG VARIABLES AND FMFILE ATTRIBUTES
-! -------------------------------------------------------------
-!
-!
-!* 3.1 Turbulence variable
-!
-IF ((CTURB /= 'NONE').AND.(HTURB == 'NONE')) THEN
- CGETTKET ='INIT'
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT=*)'YOU WANT TO USE TURBULENCE KINETIC ENERGY TKE'
- WRITE(UNIT=ILUOUT,FMT=*)'WHEREAS IT IS NOT IN INITIAL FMFILE'
- WRITE(UNIT=ILUOUT,FMT=*)'TKE WILL BE INITIALIZED TO ZERO'
-ELSE
- IF (CTURB /= 'NONE') THEN
- CGETTKET ='READ'
- IF ((CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETTKET='INIT'
- ELSE
- CGETTKET ='SKIP'
- END IF
-END IF
-!
-!
-IF ((CTOM == 'TM06').AND.(HTOM /= 'TM06')) THEN
- CGETBL_DEPTH ='INIT'
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT=*)'YOU WANT TO USE BL DEPTH FOR THIRD ORDER MOMENTS'
- WRITE(UNIT=ILUOUT,FMT=*)'WHEREAS IT IS NOT IN INITIAL FMFILE'
- WRITE(UNIT=ILUOUT,FMT=*)'IT WILL BE INITIALIZED TO ZERO'
-ELSE
- IF (CTOM == 'TM06') THEN
- CGETBL_DEPTH ='READ'
- ELSE
- CGETBL_DEPTH ='SKIP'
- END IF
-END IF
-!
-IF (LRMC01 .AND. .NOT. ORMC01) THEN
- CGETSBL_DEPTH ='INIT'
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT=*)'YOU WANT TO USE SBL DEPTH FOR RMC01'
- WRITE(UNIT=ILUOUT,FMT=*)'WHEREAS IT IS NOT IN INITIAL FMFILE'
- WRITE(UNIT=ILUOUT,FMT=*)'IT WILL BE INITIALIZED TO ZERO'
-ELSE
- IF (LRMC01) THEN
- CGETSBL_DEPTH ='READ'
- ELSE
- CGETSBL_DEPTH ='SKIP'
- END IF
-END IF
-!
-!
-!* 3.2 Moist variables
-!
-IF (LUSERV.AND. (.NOT.OUSERV)) THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE VAPOR VARIABLE Rv WHEREAS IT ", &
- & "IS NOT IN INITIAL FMFILE",/, &
- & "Rv WILL BE INITIALIZED TO ZERO")')
- CGETRVT='INIT'
-ELSE
- IF (LUSERV) THEN
- CGETRVT='READ'
- ELSE
- CGETRVT='SKIP'
- END IF
-END IF
-!
-IF (LUSERC.AND. (.NOT.OUSERC)) THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE CLOUD VARIABLE Rc WHEREAS IT ", &
- & " IS NOT IN INITIAL FMFILE",/, &
- & "Rc WILL BE INITIALIZED TO ZERO")')
- CGETRCT='INIT'
-ELSE
- IF (LUSERC) THEN
- CGETRCT='READ'
-! IF(CCONF=='START') CGETRCT='INIT'
- ELSE
- CGETRCT='SKIP'
- END IF
-END IF
-!
-IF (LUSERR.AND. (.NOT.OUSERR)) THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE RAIN VARIABLE Rr WHEREAS IT ", &
- & "IS NOT IN INITIAL FMFILE",/, &
- & " Rr WILL BE INITIALIZED TO ZERO")')
-
- CGETRRT='INIT'
-ELSE
- IF (LUSERR) THEN
- CGETRRT='READ'
-! IF( (CCONF=='START').AND. CPROGRAM /= 'DIAG') CGETRRT='INIT'
- ELSE
- CGETRRT='SKIP'
- END IF
-END IF
-!
-IF (LUSERI.AND. (.NOT.OUSERI)) THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE ICE VARIABLE Ri WHEREAS IT ", &
- & "IS NOT IN INITIAL FMFILE",/, &
- & " Ri WILL BE INITIALIZED TO ZERO")')
- CGETRIT='INIT'
-ELSE
- IF (LUSERI) THEN
- CGETRIT='READ'
-! IF(CCONF=='START') CGETRIT='INIT'
- ELSE
- CGETRIT='SKIP'
- END IF
-END IF
-!
-IF (LUSECI.AND. (.NOT.OUSECI)) THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE ICE CONC. VARIABLE Ci WHEREAS IT ",&
- & "IS NOT IN INITIAL FMFILE",/, &
- & " Ci WILL BE INITIALIZED TO ZERO")')
- CGETCIT='INIT'
-ELSE
- IF (LUSECI) THEN
- CGETCIT='READ'
- ELSE
- CGETCIT='SKIP'
- END IF
-END IF
-!
-IF (LUSERS.AND. (.NOT.OUSERS)) THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE SNOW VARIABLE Rs WHEREAS IT ",&
- & "IS NOT IN INITIAL FMFILE",/, &
- & " Rs WILL BE INITIALIZED TO ZERO")')
- CGETRST='INIT'
-ELSE
- IF (LUSERS) THEN
- CGETRST='READ'
-! IF ( (CCONF=='START').AND. CPROGRAM /= 'DIAG') CGETRST='INIT'
- ELSE
- CGETRST='SKIP'
- END IF
-END IF
-!
-IF (LUSERG.AND. (.NOT.OUSERG)) THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE GRAUPEL VARIABLE Rg WHEREAS ",&
- & " IT IS NOTIN INITIAL FMFILE",/, &
- & "Rg WILL BE INITIALIZED TO ZERO")')
- CGETRGT='INIT'
-ELSE
- IF (LUSERG) THEN
- CGETRGT='READ'
-! IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETRGT='INIT'
- ELSE
- CGETRGT='SKIP'
- END IF
-END IF
-!
-IF (LUSERH.AND. (.NOT.OUSERH)) THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE HAIL VARIABLE Rh WHEREAS",&
- & "IT IS NOT IN INITIAL FMFILE",/, &
- & " Rh WILL BE INITIALIZED TO ZERO")')
- CGETRHT='INIT'
-ELSE
- IF (LUSERH) THEN
- CGETRHT='READ'
-! IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETRHT='INIT'
- ELSE
- CGETRHT='SKIP'
- END IF
-END IF
-!
-IF (LUSERC.AND. (.NOT.OUSERC)) THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'THE CLOUD FRACTION WILL BE INITIALIZED ACCORDING'
- WRITE(UNIT=ILUOUT,FMT=*) 'TO CLOUD MIXING RATIO VALUE OR SET TO 0'
- CGETCLDFR = 'INIT'
-ELSE
- IF ( LUSERC ) THEN
- CGETCLDFR = 'READ'
- IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETCLDFR='INIT'
- ELSE
- CGETCLDFR = 'SKIP'
- END IF
-END IF
-!
-IF (LUSERI.AND. (.NOT.OUSERI)) THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'THE ICE CLOUD FRACTION WILL BE INITIALIZED ACCORDING'
- WRITE(UNIT=ILUOUT,FMT=*) 'TO CLOUD MIXING RATIO VALUE OR SET TO 0'
- CGETICEFR = 'INIT'
-ELSE
- IF ( LUSERI ) THEN
- CGETICEFR = 'READ'
- IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETICEFR='INIT'
- ELSE
- CGETICEFR = 'SKIP'
- END IF
-END IF
-!
-IF(CTURBLEN=='RM17' .OR. CTURBLEN=='HM21') THEN
- XCEDIS=0.34
-ELSE
- XCEDIS=0.84
-END IF
-!
-!* 3.3 Moist turbulence
-!
-IF ( LUSERC .AND. CTURB /= 'NONE' ) THEN
- IF ( .NOT. (OUSERC .AND. HTURB /= 'NONE') ) THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE MOIST TURBULENCE WHEREAS IT ",/, &
- & " WAS NOT THE CASE FOR THE INITIAL FMFILE GENERATION",/, &
- & "SRC AND SIGS ARE INITIALIZED TO 0")')
- CGETSRCT ='INIT'
- CGETSIGS ='INIT'
- ELSE
- CGETSRCT ='READ'
- IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETSRCT ='INIT'
- CGETSIGS ='READ'
- END IF
-ELSE
- CGETSRCT ='SKIP'
- CGETSIGS ='SKIP'
-END IF
-!
-IF(NMODEL_CLOUD==KMI .AND. CTURBLEN_CLOUD/='NONE') THEN
- IF (CTURB=='NONE' .OR. .NOT.LUSERC) THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO COMPUTE A MIXING LENGTH FOR CLOUD=", &
- & A4,/, &
- & ", WHEREAS YOU DO NOT SPECIFY A TURBULENCE SCHEME OR ", &
- & "USE OF RC,",/," CTURBLEN_CLOUD IS SET TO NONE")') &
- CTURBLEN_CLOUD
- CTURBLEN_CLOUD='NONE'
- END IF
- IF( XCEI_MIN > XCEI_MAX ) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT='("PROBLEM OF CEI LIMITS FOR CLOUD MIXING ",/, &
- & "LENGTH COMPUTATION: XCEI_MIN=",E9.3,", XCEI_MAX=",E9.3)')&
- XCEI_MIN,XCEI_MAX
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
- END IF
-END IF
-!
-IF ( LSIGMAS ) THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE SIGMA_S FROM TURBULENCE SCHEME",/, &
- & " IN ICE SUBGRID CONDENSATION, SO YOUR SIGMA_S"/, &
- & " MIGHT BE SMALL ABOVE PBL DEPENDING ON LENGTH SCALE")')
-END IF
-!
-IF (LSUBG_COND .AND. CTURB=='NONE' ) THEN
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE SUBGRID CONDENSATION'
- WRITE(UNIT=ILUOUT,FMT=*) ' WITHOUT TURBULENCE '
- WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT ALLOWED: LSUBG_COND is SET to FALSE'
- LSUBG_COND=.FALSE.
-END IF
-!
-IF (L1D .AND. CTURB/='NONE' .AND. CTURBDIM == '3DIM') THEN
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE 3D TURBULENCE IN 1D CONFIGURATION '
- WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT POSSIBLE: CTURBDIM IS SET TO 1DIM'
- CTURBDIM = '1DIM'
-END IF
-!
-!* 3.4 Additional scalar variables
-!
-IF (NSV_USER == KSV_USER) THEN
- DO JS = 1,KSV_USER ! to read all the variables in initial file
- CGETSVT(JS)='READ' ! and to initialize them
-! IF(CCONF=='START')CGETSVT(JS)='INIT' ! with these values
- END DO
-ELSEIF (NSV_USER > KSV_USER) THEN
- IF (KSV_USER == 0) THEN
- CGETSVT(1:NSV_USER)='INIT'
- ELSE
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE MORE ADDITIONAL SCALAR " ,&
- &" VARIABLES THAN THERE ARE IN INITIAL FMFILE",/, &
- & "THE SUPPLEMENTARY VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- DO JS = 1,KSV_USER ! to read all the variables in initial file
- CGETSVT(JS)='READ' ! and to initialize them
-! IF(CCONF=='START')CGETSVT(JS)='INIT' ! with these values
- END DO
- DO JS = KSV_USER+1, NSV_USER ! to initialize to zero supplementary
- CGETSVT(JS)='INIT' ! initial file)
- END DO
- END IF
-ELSE
- WRITE(UNIT=ILUOUT,FMT=9000) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE LESS ADDITIONAL SCALAR " ,&
- &" VARIABLES THAN THERE ARE IN INITIAL FMFILE")')
- DO JS = 1,NSV_USER ! to read the first NSV_USER variables in initial file
- CGETSVT(JS)='READ' ! and to initialize with these values
-! IF(CCONF=='START') CGETSVT(JS)='INIT'
- END DO
- DO JS = NSV_USER + 1, KSV_USER ! to skip the last (KSV_USER-NSV_USER) variables
- CGETSVT(JS)='SKIP'
- END DO
-END IF
-!
-! C2R2 and KHKO SV case
-!
-IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO') THEN
- IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO') THEN
- CGETSVT(NSV_C2R2BEG:NSV_C2R2END)='READ'
-! IF(CCONF=='START') CGETSVT(NSV_C2R2BEG:NSV_C2R2END)='INIT'
- ELSE
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR C2R2 &
- & (or KHKO) SCHEME IN INITIAL FMFILE",/,&
- & "THE C2R2 (or KHKO) VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVT(NSV_C2R2BEG:NSV_C2R2END)='INIT'
- END IF
-END IF
-!
-! C3R5 SV case
-!
-IF (CCLOUD == 'C3R5') THEN
- IF (HCLOUD == 'C3R5') THEN
- CGETSVT(NSV_C1R3BEG:NSV_C1R3END)='READ'
-! IF(CCONF=='START') CGETSVT(NSV_C1R3BEG:NSV_C1R3END)='INIT'
- ELSE
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR C3R5 &
- &SCHEME IN INITIAL FMFILE",/,&
- & "THE C1R3 VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVT(NSV_C1R3BEG:NSV_C1R3END)='INIT'
- END IF
-END IF
-!
-! LIMA SV case
-!
-IF (CCLOUD == 'LIMA') THEN
- IF (HCLOUD == 'LIMA') THEN
- CGETSVT(NSV_LIMA_BEG:NSV_LIMA_END)='READ'
- ELSE
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR LIMA &
- & SCHEME IN INITIAL FMFILE",/,&
- & "THE LIMA VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVT(NSV_LIMA_BEG:NSV_LIMA_END)='INIT'
- END IF
-END IF
-!
-! Electrical SV case
-!
-IF (CELEC /= 'NONE') THEN
- IF (HELEC /= 'NONE') THEN
- CGETSVT(NSV_ELECBEG:NSV_ELECEND)='READ'
-! IF(CCONF=='START') CGETSVT(NSV_ELECBEG:NSV_ELECEND)='INIT'
- ELSE
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR ELECTRICAL &
- &SCHEME IN INITIAL FMFILE",/,&
- & "THE ELECTRICAL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVT(NSV_ELECBEG:NSV_ELECEND)='INIT'
- END IF
-END IF
-!
-! (explicit) LINOx SV case
-!
-IF (CELEC /= 'NONE' .AND. LLNOX_EXPLICIT) THEN
- IF (HELEC /= 'NONE' .AND. OLNOX_EXPLICIT) THEN
- CGETSVT(NSV_LNOXBEG:NSV_LNOXEND)='READ'
- ELSE
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR LINOX &
- & IN INITIAL FMFILE",/,&
- & "THE LINOX VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVT(NSV_LNOXBEG:NSV_LNOXEND)='INIT'
- END IF
-END IF
-!
-! Chemical SV case (excluding aqueous chemical species)
-!
-IF (LUSECHEM) THEN
- IF (OUSECHEM) THEN
- CGETSVT(NSV_CHGSBEG:NSV_CHGSEND)='READ'
- IF(CCONF=='START' .AND. LCH_INIT_FIELD ) CGETSVT(NSV_CHGSBEG:NSV_CHGSEND)='INIT'
- ELSE
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR CHEMICAL &
- &SCHEME IN INITIAL FMFILE",/,&
- & "THE CHEMICAL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVT(NSV_CHGSBEG:NSV_CHGSEND)='INIT'
- END IF
-END IF
-! add aqueous chemical species
-IF (LUSECHAQ) THEN
- IF (OUSECHAQ) THEN
- CGETSVT(NSV_CHACBEG:NSV_CHACEND)='READ'
-! IF(CCONF=='START') CGETSVT(NSV_CHACBEG:NSV_CHACEND)='INIT'
- ELSE
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR CHEMICAL &
- &SCHEME IN AQUEOUS PHASE IN INITIAL FMFILE",/,&
- & "THE AQUEOUS PHASE CHEMICAL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVT(NSV_CHACBEG:NSV_CHACEND)='INIT'
- END IF
-END IF
-! add ice phase chemical species
-IF (LUSECHIC) THEN
- IF (OUSECHIC) THEN
- CGETSVT(NSV_CHICBEG:NSV_CHICEND)='READ'
-! IF(CCONF=='START') CGETSVT(NSV_CHICBEG:NSV_CHICEND)='INIT'
- ELSE
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR CHEMICAL &
- &SPECIES IN ICE PHASE IN INITIAL FMFILE",/,&
- & "THE ICE PHASE CHEMICAL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVT(NSV_CHICBEG:NSV_CHICEND)='INIT'
- END IF
-END IF
-! pH values = diagnostics
-IF (LCH_PH .AND. .NOT. OCH_PH) THEN
- CGETPHC ='INIT' !will be initialized to XCH_PHINIT
- IF (LUSERR) THEN
- CGETPHR = 'INIT' !idem
- ELSE
- CGETPHR = 'SKIP'
- ENDIF
-ELSE
- IF (LCH_PH) THEN
- CGETPHC ='READ'
- IF (LUSERR) THEN
- CGETPHR = 'READ'
- ELSE
- CGETPHR = 'SKIP'
- ENDIF
- ELSE
- CGETPHC ='SKIP'
- CGETPHR ='SKIP'
- END IF
-END IF
-!
-! Dust case
-!
-IF (LDUST) THEN
- IF (ODUST) THEN
- CGETSVT(NSV_DSTBEG:NSV_DSTEND)='READ'
-! IF(CCONF=='START') CGETSVT(NSV_DSTBEG:NSV_DSTEND)='INIT'
- ELSE
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR DUST &
- &SCHEME IN INITIAL FMFILE",/,&
- & "THE DUST VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVT(NSV_DSTBEG:NSV_DSTEND)='INIT'
- END IF
- IF (LDEPOS_DST(KMI)) THEN
-
- !UPG *PT
- IF((CCLOUD /= 'ICE3').AND.(CCLOUD /= 'ICE4').AND.(CCLOUD /= 'KESS')&
- .AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND.(CCLOUD /= 'LIMA').AND. &
- (CPROGRAM/='SPAWN').AND.(CPROGRAM/='REAL')) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT='("ERROR: WET DEPOSITION OF DUST IS ONLY CODED FOR THE",/,&
- & "MICROPHYSICAL SCHEME as ICE3, ICE4, KESS, KHKO, LIMA and C2R2")')
- !UPG *PT
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
- END IF
-
- IF (ODEPOS_DST(KMI) ) THEN
- CGETSVT(NSV_DSTDEPBEG:NSV_DSTDEPEND)='READ'
-! IF(CCONF=='START') CGETSVT(NSV_DSTDEPBEG:NSV_DSTDEPEND)='INIT'
- ELSE
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR RAIN and CLOUD DUST &
- & SCHEME IN INITIAL FMFILE",/,&
- & "THE MOIST DUST VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVT(NSV_DSTDEPBEG:NSV_DSTDEPEND)='INIT'
- END IF
- END IF
-
- IF(NMODE_DST.GT.3 .OR. NMODE_DST.LT.1) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT='("DUST MODES MUST BE BETWEEN 1 and 3 ")')
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
- END IF
-END IF
-!
-! Sea Salt case
-!
-IF (LSALT) THEN
- IF (OSALT) THEN
- CGETSVT(NSV_SLTBEG:NSV_SLTEND)='READ'
- CGETZWS='READ'
-! IF(CCONF=='START') CGETSVT(NSV_SLTBEG:NSV_SLTEND)='INIT'
- ELSE
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR SALT &
- &SCHEME IN INITIAL FMFILE",/,&
- & "THE SALT VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVT(NSV_SLTBEG:NSV_SLTEND)='INIT'
- CGETZWS='INIT'
- END IF
- IF (LDEPOS_SLT(KMI)) THEN
-
- !UPG*PT
- IF((CCLOUD /= 'ICE3').AND.(CCLOUD /= 'ICE4').AND.(CCLOUD /= 'KESS')&
- !.AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND. &
- .AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND.(CCLOUD /= 'LIMA').AND. &
- (CPROGRAM/='SPAWN').AND.(CPROGRAM/='REAL')) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT='("ERROR: WET DEPOSITION OF SEA SALT AEROSOLS IS ONLY CODED FOR THE",/,&
- & "MICROPHYSICAL SCHEME as ICE3, ICE4, KESS, KHKO, LIMA and C2R2")')
- !UPG*PT
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
- END IF
-
- IF (ODEPOS_SLT(KMI) ) THEN
- CGETSVT(NSV_SLTDEPBEG:NSV_SLTDEPEND)='READ'
-! IF(CCONF=='START') CGETSVT(NSV_SLTDEPBEG:NSV_SLTDEPEND)='INIT'
- ELSE
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR RAIN and CLOUD SEA SALT &
- & SCHEME IN INITIAL FMFILE",/,&
- & "THE MOIST SEA SALT VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVT(NSV_SLTDEPBEG:NSV_SLTDEPEND)='INIT'
- END IF
- END IF
- IF(NMODE_SLT.GT.8 .OR. NMODE_SLT.LT.1) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT='("SALT MODES MUST BE BETWEEN 1 and 8 ")')
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
- END IF
-END IF
-!
-! Orilam SV case
-!
-IF (LORILAM) THEN
- IF (OORILAM) THEN
- CGETSVT(NSV_AERBEG:NSV_AEREND)='READ'
-! IF(CCONF=='START') CGETSVT(NSV_AERBEG:NSV_AEREND)='INIT'
- ELSE
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR AEROSOL &
- &SCHEME IN INITIAL FMFILE",/,&
- & "THE AEROSOLS VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVT(NSV_AERBEG:NSV_AEREND)='INIT'
- END IF
- IF (LDEPOS_AER(KMI)) THEN
-
- !UPG*PT
- IF((CCLOUD /= 'ICE3').AND.(CCLOUD /= 'ICE4').AND.(CCLOUD /= 'KESS')&
- .AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND.(CCLOUD /= 'LIMA').AND. &
- !.AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND. &
- (CPROGRAM/='SPAWN').AND.(CPROGRAM/='REAL')) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT='("ERROR: WET DEPOSITION OF ORILAM AEROSOLS IS ONLY CODED FOR THE",/,&
- & "MICROPHYSICAL SCHEME as ICE3, ICE4, KESS, KHKO, LIMA and C2R2")')
- !UPG*PT
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
- END IF
-
- IF (ODEPOS_AER(KMI) ) THEN
- CGETSVT(NSV_AERDEPBEG:NSV_AERDEPEND)='READ'
-! IF(CCONF=='START') CGETSVT(NSV_AERDEPBEG:NSV_AERDEPEND)='INIT'
- ELSE
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR RAIN and IN CLOUD &
- & AEROSOL SCHEME IN INITIAL FMFILE",/,&
- & "THE MOIST AEROSOL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVT(NSV_AERDEPBEG:NSV_AERDEPEND)='INIT'
- END IF
- END IF
-END IF
-!
-! Lagrangian variables
-!
-IF (LINIT_LG .AND. .NOT.(LLG)) THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("IT IS INCOHERENT TO HAVE LINIT_LG=.T. AND LLG=.F.",/,&
- & "IF YOU WANT LAGRANGIAN TRACERS CHANGE LLG TO .T. ")')
-ENDIF
-IF (LLG) THEN
- IF (OLG .AND. .NOT.(LINIT_LG .AND. CPROGRAM=='MESONH')) THEN
- CGETSVT(NSV_LGBEG:NSV_LGEND)='READ'
-! IF(CCONF=='START') CGETSVT(NSV_LGBEG:NSV_LGEND)='INIT'
- ELSE
- IF(.NOT.(LINIT_LG) .AND. CPROGRAM=='MESONH') THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("THERE IS NO LAGRANGIAN VARIABLES IN INITIAL FMFILE",/,&
- & "THE LAGRANGIAN VARIABLES HAVE BEEN REINITIALIZED")')
- LINIT_LG=.TRUE.
- ENDIF
- CGETSVT(NSV_LGBEG:NSV_LGEND)='INIT'
- END IF
-END IF
-!
-!
-! LINOx SV case
-!
-IF (.NOT.LUSECHEM .AND. LCH_CONV_LINOX) THEN
- IF (.NOT.OUSECHEM .AND. OCH_CONV_LINOX) THEN
- CGETSVT(NSV_LNOXBEG:NSV_LNOXEND)='READ'
- ELSE
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR LINOX &
- &IN INITIAL FMFILE",/,&
- & "THE LINOX VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVT(NSV_LNOXBEG:NSV_LNOXEND)='INIT'
- END IF
-END IF
-!
-! Passive pollutant case
-!
-IF (LPASPOL) THEN
- IF (OPASPOL) THEN
- CGETSVT(NSV_PPBEG:NSV_PPEND)='READ'
-! IF(CCONF=='START') CGETSVT(NSV_PPBEG:NSV_PPEND)='INIT'
- ELSE
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("THERE IS NO PASSIVE SCALAR VARIABLES IN INITIAL FMFILE",/,&
- & "THE VARIABLES HAVE BEEN INITIALIZED TO ZERO")')
- CGETSVT(NSV_PPBEG:NSV_PPEND)='INIT'
- END IF
-END IF
-!
-#ifdef MNH_FOREFIRE
-! ForeFire
-!
-IF (LFOREFIRE) THEN
- IF (OFOREFIRE) THEN
- CGETSVT(NSV_FFBEG:NSV_FFEND)='READ'
- ELSE
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("THERE IS NO FOREFIRE SCALAR VARIABLES IN INITIAL FMFILE",/,&
- & "THE VARIABLES HAVE BEEN INITIALIZED TO ZERO")')
- CGETSVT(NSV_FFBEG:NSV_FFEND)='INIT'
- END IF
-END IF
-#endif
-! Blaze smoke
-!
-IF (LBLAZE) THEN
- IF (OFIRE) THEN
- CGETSVT(NSV_FIREBEG:NSV_FIREEND)='READ'
- ELSE
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("THERE IS NO BLAZE SCALAR VARIABLES IN INITIAL FMFILE",/,&
- & "THE VARIABLES HAVE BEEN INITIALIZED TO ZERO")')
- CGETSVT(NSV_FIREBEG:NSV_FIREEND)='INIT'
- END IF
-END IF
-!
-! Conditional sampling case
-!
-IF (LCONDSAMP) THEN
- IF (OCONDSAMP) THEN
- CGETSVT(NSV_CSBEG:NSV_CSEND)='READ'
-! IF(CCONF=='START') CGETSVT(NSV_CSBEG:NSV_CSEND)='INIT'
- ELSE
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("THERE IS NO PASSIVE SCALAR VARIABLES IN INITIAL FMFILE",/,&
- & "THE VARIABLES HAVE BEEN INITIALIZED TO ZERO")')
- CGETSVT(NSV_CSBEG:NSV_CSEND)='INIT'
- END IF
-END IF
-!
-! Blowing snow scheme
-!
-IF (LBLOWSNOW) THEN
- IF (OBLOWSNOW) THEN
- CGETSVT(NSV_SNWBEG:NSV_SNWEND)='READ'
- ELSE
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR BLOWING SNOW &
- &SCHEME IN INITIAL FMFILE",/,&
- & "THE BLOWING SNOW VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
- CGETSVT(NSV_SNWBEG:NSV_SNWEND)='INIT'
- END IF
-END IF
-!
-!
-!
-!* 3.5 Check coherence between the radiation control parameters
-!
-IF( CRAD == 'ECMW' .AND. CPROGRAM=='MESONH' ) THEN
- IF(CLW == 'RRTM' .AND. COPILW == 'SMSH') THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'the SMSH parametrisation of LW optical properties for cloud ice'
- WRITE(UNIT=ILUOUT,FMT=*) '(COPILW) can not be used with RRTM radiation scheme'
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
- ENDIF
- IF(CLW == 'MORC' .AND. COPWLW == 'LILI') THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'the LILI parametrisation of LW optical properties for cloud water'
- WRITE(UNIT=ILUOUT,FMT=*) '(COPWLW) can not be used with MORC radiation scheme'
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
- ENDIF
- IF( .NOT. LSUBG_COND) THEN
- WRITE(UNIT=ILUOUT,FMT=9000) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'YOU DO NOT WANT TO USE SUBGRID CONDENSATION'
- WRITE(UNIT=ILUOUT,FMT=*) 'THE OVERLAP OPTION IS NOVLP=5 IN ini_radconf.f90'
- ELSE IF (CLW == 'MORC') THEN
- WRITE(UNIT=ILUOUT,FMT=9000) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE MORCRETTE LW SCHEME'
- WRITE(UNIT=ILUOUT,FMT=*) 'THE OVERLAP OPTION IS NOVLP=5 IN ini_radconf.f90'
- ELSE
- WRITE(UNIT=ILUOUT,FMT=9000) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'THE OVERLAP OPTION IS NOVLP=6 IN ini_radconf.f90'
- ENDIF
-!
- IF( LCLEAR_SKY .AND. XDTRAD_CLONLY /= XDTRAD) THEN
- ! Check the validity of the LCLEAR_SKY approximation
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH THE CLEAR-SKY APPROXIMATION'
- WRITE(UNIT=ILUOUT,FMT=*) '(i.e. AVERAGE THE WHOLE CLOUDFREE VERTICALS BUT KEEP'
- WRITE(UNIT=ILUOUT,FMT=*) 'ALL THE CLOUDY VERTICALS) AND'
- WRITE(UNIT=ILUOUT,FMT=*) 'THE CLOUD-ONLY APPROXIMATION (i.e. YOU CALL MORE OFTEN THE'
- WRITE(UNIT=ILUOUT,FMT=*) 'RADIATIONS FOR THE CLOUDY VERTICALS THAN FOR CLOUDFREE ONES).'
- WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT POSSIBLE, SO CHOOSE BETWEEN :'
- WRITE(UNIT=ILUOUT,FMT=*) 'XDTRAD_CLONLY = XDTRAD and LCLEAR_SKY = FALSE'
-!
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
- END IF
-!
- IF( XDTRAD_CLONLY > XDTRAD ) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT='("BAD USE OF THE CLOUD-ONLY APPROXIMATION " ,&
- &" XDTRAD SHOULD BE LARGER THAN XDTRAD_CLONLY ")')
-!
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
- END IF
-!
- IF(( XDTRAD < XTSTEP ).OR. ( XDTRAD_CLONLY < XTSTEP )) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT='("THE RADIATION CALL XDTRAD OR XDTRAD_CLONLY " ,&
- &" IS MORE FREQUENT THAN THE TIME STEP SO ADJUST XDTRAD OR XDTRAD_CLONLY ")')
-!
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
- END IF
-END IF
-!
-IF ( CRAD /= 'NONE' .AND. CPROGRAM=='MESONH' ) THEN
- CGETRAD='READ'
- IF( HRAD == 'NONE' .AND. CCONF=='RESTA') THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'YOU ARE PERFORMING A RESTART. FOR THIS SEGMENT, YOU ARE USING A RADIATION'
- WRITE(UNIT=ILUOUT,FMT=*) 'SCHEME AND NO RADIATION SCHEME WAS USED FOR THE PREVIOUS SEGMENT.'
- CGETRAD='INIT'
- END IF
- IF(CCONF=='START') THEN
- CGETRAD='INIT'
- END IF
- IF(CCONF=='RESTA' .AND. (.NOT. LAERO_FT) .AND. (.NOT. LORILAM) &
- .AND. (.NOT. LSALT) .AND. (.NOT. LDUST)) THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT=*) '!!! WARNING !!! FOR REPRODUCTIBILITY BETWEEN START and START+RESTART,'
- WRITE(UNIT=ILUOUT,FMT=*) 'YOU MUST USE LAERO_FT=T WITH CAER=TEGE IF CCONF=RESTA IN ALL SEGMENTS'
- WRITE(UNIT=ILUOUT,FMT=*) 'TO UPDATE THE OZONE AND AEROSOLS CLIMATOLOGY USED BY THE RADIATION CODE;'
- END IF
-END IF
-!
-! 3.6 check the initialization of the deep convection scheme
-!
-IF ( (CDCONV /= 'KAFR') .AND. &
- (CSCONV /= 'KAFR') .AND. LCHTRANS ) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE LCHTRANS OPTION= ",&
- &"CONVECTIVE TRANSPORT OF TRACERS BUT IT CAN ONLY",&
- &"BE USED FOR THE KAIN FRITSCH SCHEME ")')
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
-END IF
-!
-SELECT CASE ( CDCONV )
- CASE( 'KAFR' )
- IF (.NOT. ( LUSERV ) ) THEN
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH DEEP CONV. ",&
- &" SCHEME. YOU MUST HAVE VAPOR ",/,"LUSERV IS SET TO TRUE ")')
- LUSERV=.TRUE.
- ELSE IF (.NOT. ( LUSERI ) ) THEN
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH",&
- &" DEEP CONV. SCHEME. BUT THE DETRAINED CLOUD ICE WILL BE ADDED TO ",&
- &" THE CLOUD WATER ")')
- ELSE IF (.NOT. ( LUSERI.AND.LUSERC ) ) THEN
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH",&
- &" DEEP CONV. SCHEME. BUT THE DETRAINED CLOUD WATER AND CLOUD ICE ",&
- &" WILL BE ADDED TO THE WATER VAPOR FIELD ")')
- END IF
- IF ( LCHTRANS .AND. NSV == 0 ) THEN
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE LCHTRANS OPTION= ",&
- &"CONVECTIVE TRANSPORT OF TRACERS BUT YOUR TRACER ",&
- &"NUMBER NSV IS ZERO ",/,"LCHTRANS IS SET TO FALSE")')
- LCHTRANS=.FALSE.
- END IF
-END SELECT
-!
-IF ( CDCONV == 'KAFR' .AND. LCHTRANS .AND. NSV > 0 ) THEN
- IF( OCHTRANS ) THEN
- CGETSVCONV='READ'
- ELSE
- CGETSVCONV='INIT'
- END IF
-END IF
-!
-SELECT CASE ( CSCONV )
- CASE( 'KAFR' )
- IF (.NOT. ( LUSERV ) ) THEN
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH SHALLOW CONV. ",&
- &" SCHEME. YOU MUST HAVE VAPOR ",/,"LUSERV IS SET TO TRUE ")')
- LUSERV=.TRUE.
- ELSE IF (.NOT. ( LUSERI ) ) THEN
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH",&
- &" SHALLOW CONV. SCHEME. BUT THE DETRAINED CLOUD ICE WILL BE ADDED TO ",&
- &" THE CLOUD WATER ")')
- ELSE IF (.NOT. ( LUSERI.AND.LUSERC ) ) THEN
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH",&
- &" SHALLOW CONV. SCHEME. BUT THE DETRAINED CLOUD WATER AND CLOUD ICE ",&
- &" WILL BE ADDED TO THE WATER VAPOR FIELD ")')
- END IF
- IF ( LCHTRANS .AND. NSV == 0 ) THEN
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE LCHTRANS OPTION= ",&
- &"CONVECTIVE TRANSPORT OF TRACERS BUT YOUR TRACER ",&
- &"NUMBER NSV IS ZERO ",/,"LCHTRANS IS SET TO FALSE")')
- LCHTRANS=.FALSE.
- END IF
- CASE( 'EDKF' )
- IF (CTURB == 'NONE' ) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE EDKF ", &
- &"SHALLOW CONVECTION WITHOUT TURBULENCE SCHEME : ", &
- &"IT IS NOT POSSIBLE")')
-!
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
- END IF
-END SELECT
-!
-!
-CGETCONV = 'SKIP'
-!
-IF ( (CDCONV /= 'NONE' .OR. CSCONV == 'KAFR' ) .AND. CPROGRAM=='MESONH') THEN
- CGETCONV = 'READ'
- IF( HDCONV == 'NONE' .AND. CCONF=='RESTA') THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(UNIT=ILUOUT,FMT='(" YOU ARE PERFORMING A RESTART. FOR THIS ",&
- &" SEGMENT, YOU ARE USING A DEEP CONVECTION SCHEME AND NO DEEP ",&
- &" CONVECTION SCHEME WAS USED FOR THE PREVIOUS SEGMENT. ")')
-!
- CGETCONV = 'INIT'
- END IF
- IF(CCONF=='START') THEN
- CGETCONV = 'INIT'
- END IF
-END IF
-!
-!* 3.7 configuration and model version
-!
-IF (KMI == 1) THEN
-!
- IF (L1D.AND.(CLBCX(1)/='CYCL'.AND.CLBCX(2)/='CYCL' &
- .AND.CLBCY(1)/='CYCL'.AND.CLBCY(2)/='CYCL')) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A 1D MODEL VERSION WITH NON-CYCL",&
- & "CLBCX OR CLBCY VALUES")')
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
- END IF
- IF (L2D.AND.(CLBCY(1)/='CYCL'.AND.CLBCY(2)/='CYCL')) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A 2D MODEL VERSION WITH NON-CYCL",&
- & " CLBCY VALUES")')
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
- END IF
- !
- IF ( (.NOT. LCARTESIAN) .AND. ( LCORIO) .AND. (.NOT. LGEOST_UV_FRC) ) THEN
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT='("BE CAREFUL YOU COULD HAVE SPURIOUS MOTIONS " ,&
- & " NEAR THE LBC AS LCORIO=T and LGEOST_UV_FRC=F")')
- END IF
- !
- IF ((.NOT.LFLAT).AND.OFLAT) THEN
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'ZERO OROGRAPHY IN INITIAL FILE'
- WRITE(UNIT=ILUOUT,FMT=*) '***** ALL TERMS HAVE BEEN NEVERTHELESS COMPUTED WITHOUT SIMPLIFICATION*****'
- WRITE(UNIT=ILUOUT,FMT=*) 'THIS SHOULD LEAD TO ERRORS IN THE PRESSURE COMPUTATION'
- END IF
- IF (LFLAT.AND.(.NOT.OFLAT)) THEN
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT='(" OROGRAPHY IS NOT EQUAL TO ZERO ", &
- & "IN INITIAL FILE" ,/, &
- & "******* OROGRAPHY HAS BEEN SET TO ZERO *********",/, &
- & "ACCORDING TO ZERO OROGRAPHY, SIMPLIFICATIONS HAVE ", &
- & "BEEN MADE IN COMPUTATIONS")')
- END IF
-END IF
-!
-!* 3.8 System of equations
-!
-IF ( HEQNSYS /= CEQNSYS ) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(ILUOUT,FMT=*) 'YOU HAVE CHANGED THE SYSTEM OF EQUATIONS'
- WRITE(ILUOUT,FMT=*) 'THE ANELASTIC CONSTRAINT IS PERHAPS CHANGED :'
- WRITE(ILUOUT,FMT=*) 'FOR THE INITIAL FILE YOU HAVE USED ',HEQNSYS
- WRITE(ILUOUT,FMT=*) 'FOR THE RUN YOU PLAN TO USE ',CEQNSYS
- WRITE(ILUOUT,FMT=*) 'THIS CAN LEAD TO A NUMERICAL EXPLOSION IN THE FIRST TIME STEPS'
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
-END IF
-!
-! 3.9 Numerical schemes
-!
-IF ( (CUVW_ADV_SCHEME == 'CEN4TH') .AND. &
- (CTEMP_SCHEME /= 'LEFR') .AND. (CTEMP_SCHEME /= 'RKC4') ) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT='("CEN4TH SCHEME HAS TO BE USED WITH ",&
- &"CTEMP_SCHEME = LEFR of RKC4 ONLY")')
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
-END IF
-!
-IF ( (CUVW_ADV_SCHEME == 'WENO_K') .AND. LNUMDIFU ) THEN
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE NUMERICAL DIFFUSION ",&
- &"WITH WENO SCHEME ALREADY DIFFUSIVE")')
-END IF
-!-------------------------------------------------------------------------------
-!
-!* 4. CHECK COHERENCE BETWEEN EXSEG VARIABLES
-! ---------------------------------------
-!
-!* 4.1 coherence between coupling variables in EXSEG file
-!
-IF (KMI == 1) THEN
- NCPL_NBR = 0
- DO JCI = 1,JPCPLFILEMAX
- IF (LEN_TRIM(CCPLFILE(JCI)) /= 0) THEN ! Finds the number
- NCPL_NBR = NCPL_NBR + 1 ! of coupling files
- ENDIF
- IF (JCI/=JPCPLFILEMAX) THEN ! Deplaces the coupling files
- IF ((LEN_TRIM(CCPLFILE(JCI)) == 0) .AND. &! names if one missing
- (LEN_TRIM(CCPLFILE(JCI+1)) /= 0)) THEN
- DO JI=JCI,JPCPLFILEMAX-1
- CCPLFILE(JI)=CCPLFILE(JI+1)
- END DO
- CCPLFILE(JPCPLFILEMAX)=' '
- END IF
- END IF
- END DO
-!
- IF (NCPL_NBR /= 0) THEN
- LSTEADYLS = .FALSE.
- ELSE
- LSTEADYLS = .TRUE.
- ENDIF
-END IF
-!
-!* 4.3 check consistency in forcing switches
-!
-IF ( LFORCING ) THEN
- IF ( LRELAX_THRV_FRC .AND. ( LTEND_THRV_FRC .OR. LGEOST_TH_FRC ) ) THEN
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU CHOSE A TEMPERATURE AND HUMIDITY RELAXATION'
- WRITE(ILUOUT,FMT=*) 'TOGETHER WITH TENDENCY OR GEOSTROPHIC FORCING'
- WRITE(ILUOUT,FMT=*) &
- 'YOU MIGHT CHECK YOUR SWITCHES: LRELAX_THRV_FRC, LTEND_THRV_FRC, AND'
- WRITE(ILUOUT,FMT=*) 'LGEOST_TH_FRC'
- END IF
-!
- IF ( LRELAX_UV_FRC .AND. LRELAX_UVMEAN_FRC) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(ILUOUT,FMT=*) 'YOU MUST CHOOSE BETWEEN A RELAXATION APPLIED TO'
- WRITE(ILUOUT,FMT=*) 'THE 3D FULL WIND FIELD (LRELAX_UV_FRC) OR'
- WRITE(ILUOUT,FMT=*) 'THE HORIZONTAL MEAN WIND (LRELAX_UVMEAN_FRC)'
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
- END IF
-!
- IF ( (LRELAX_UV_FRC .OR. LRELAX_UVMEAN_FRC) .AND. LGEOST_UV_FRC ) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(ILUOUT,FMT=*) 'YOU MUST NOT USE A WIND RELAXATION'
- WRITE(ILUOUT,FMT=*) 'TOGETHER WITH A GEOSTROPHIC FORCING'
- WRITE(ILUOUT,FMT=*) 'CHECK SWITCHES: LRELAX_UV_FRC, LRELAX_UVMEAN_FRC, LGEOST_UV_FRC'
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
- END IF
-!
- IF ( CRELAX_HEIGHT_TYPE.NE."FIXE" .AND. CRELAX_HEIGHT_TYPE.NE."THGR" ) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(ILUOUT,FMT=*) 'CRELAX_HEIGHT_TYPE MUST BE EITHER "FIXE" OR "THGR"'
- WRITE(ILUOUT,FMT=*) 'BUT IT IS "', CRELAX_HEIGHT_TYPE, '"'
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
- END IF
-!
- IF ( .NOT.LCORIO .AND. LGEOST_UV_FRC ) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(ILUOUT,FMT=*) 'YOU CANNOT HAVE A GEOSTROPHIC FORCING WITHOUT'
- WRITE(ILUOUT,FMT=*) 'ACTIVATING LCORIOLIS OPTION'
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
- END IF
-!
- IF ( LPGROUND_FRC ) THEN
- WRITE(ILUOUT,FMT=*) 'SURFACE PRESSURE FORCING NOT YET IMPLEMENTED'
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
- END IF
-!
-END IF
-!
-IF (LTRANS .AND. .NOT. LFLAT ) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(ILUOUT,FMT=*) 'YOU ASK FOR A CONSTANT SPEED DOMAIN TRANSLATION '
- WRITE(ILUOUT,FMT=*) 'BUT NOT IN THE FLAT TERRAIN CASE:'
- WRITE(ILUOUT,FMT=*) 'THIS IS NOT ALLOWED ACTUALLY'
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
-END IF
-!
-!* 4.4 Check the coherence between the LUSERn and LHORELAX
-!
-IF (.NOT. LUSERV .AND. LHORELAX_RV) THEN
- LHORELAX_RV=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RV FIELD BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RV=FALSE'
-END IF
-!
-IF (.NOT. LUSERC .AND. LHORELAX_RC) THEN
- LHORELAX_RC=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RC FIELD BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RC=FALSE'
-END IF
-!
-IF (.NOT. LUSERR .AND. LHORELAX_RR) THEN
- LHORELAX_RR=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RR FIELD BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RR=FALSE'
-END IF
-!
-IF (.NOT. LUSERI .AND. LHORELAX_RI) THEN
- LHORELAX_RI=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RI FIELD BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RI=FALSE'
-END IF
-!
-IF (.NOT. LUSERS .AND. LHORELAX_RS) THEN
- LHORELAX_RS=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RS FIELD BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RS=FALSE'
-END IF
-!
-IF (.NOT. LUSERG .AND. LHORELAX_RG) THEN
- LHORELAX_RG=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RG FIELD BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RG=FALSE'
-END IF
-!
-IF (.NOT. LUSERH .AND. LHORELAX_RH) THEN
- LHORELAX_RH=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RH FIELD BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RH=FALSE'
-END IF
-!
-IF (CTURB=='NONE' .AND. LHORELAX_TKE) THEN
- LHORELAX_TKE=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX TKE FIELD BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_TKE=FALSE'
-END IF
-!
-!
-IF (CCLOUD/='C2R2' .AND. CCLOUD/='KHKO' .AND. LHORELAX_SVC2R2) THEN
- LHORELAX_SVC2R2=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX C2R2 or KHKO FIELD BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVC2R2=FALSE'
-END IF
-!
-IF (CCLOUD/='C3R5' .AND. LHORELAX_SVC1R3) THEN
- LHORELAX_SVC1R3=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX C3R5 FIELD BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVC1R3=FALSE'
-END IF
-!
-IF (CCLOUD/='LIMA' .AND. LHORELAX_SVLIMA) THEN
- LHORELAX_SVLIMA=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX LIMA FIELD BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVLIMA=FALSE'
-END IF
-!
-IF (CELEC(1:3) /= 'ELE' .AND. LHORELAX_SVELEC) THEN
- LHORELAX_SVELEC=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX ELEC FIELD BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVELEC=FALSE'
-END IF
-!
-IF (.NOT. LUSECHEM .AND. LHORELAX_SVCHEM) THEN
- LHORELAX_SVCHEM=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX CHEM FIELD BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVCHEM=FALSE'
-END IF
-!
-IF (.NOT. LUSECHIC .AND. LHORELAX_SVCHIC) THEN
- LHORELAX_SVCHIC=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX ICE CHEM FIELD BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVCHIC=FALSE'
-END IF
-!
-IF (.NOT. LORILAM .AND. LHORELAX_SVAER) THEN
- LHORELAX_SVAER=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX AEROSOL FIELD BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVAER=FALSE'
-END IF
-
-IF (.NOT. LDUST .AND. LHORELAX_SVDST) THEN
- LHORELAX_SVDST=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX DUST FIELD BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVDST=FALSE'
-END IF
-
-IF (.NOT. LSALT .AND. LHORELAX_SVSLT) THEN
- LHORELAX_SVSLT=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX SEA SALT FIELD BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVSLT=FALSE'
-END IF
-
-IF (.NOT. LPASPOL .AND. LHORELAX_SVPP) THEN
- LHORELAX_SVPP=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX PASSIVE POLLUTANT FIELD BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVPP=FALSE'
-END IF
-#ifdef MNH_FOREFIRE
-IF (.NOT. LFOREFIRE .AND. LHORELAX_SVFF) THEN
- LHORELAX_SVFF=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX FOREFIRE FLUXES BUT THEY DO NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVFF=FALSE'
-END IF
-#endif
-IF (.NOT. LBLAZE .AND. LHORELAX_SVFIRE) THEN
- LHORELAX_SVFIRE=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX BLAZE FLUXES BUT THEY DO NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVFIRE=FALSE'
-END IF
-IF (.NOT. LCONDSAMP .AND. LHORELAX_SVCS) THEN
- LHORELAX_SVCS=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX CONDITIONAL SAMPLING FIELD BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVCS=FALSE'
-END IF
-
-IF (.NOT. LBLOWSNOW .AND. LHORELAX_SVSNW) THEN
- LHORELAX_SVSNW=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX BLOWING SNOW FIELD BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVSNW=FALSE'
-END IF
-
-IF (ANY(LHORELAX_SV(NSV+1:))) THEN
- LHORELAX_SV(NSV+1:)=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX SV(NSV+1:) FIELD BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SV(NSV+1:)=FALSE'
-END IF
-!
-!* 4.5 check the number of points for the horizontal relaxation
-!
-IF ( NRIMX > KRIMX .AND. .NOT.LHORELAX_SVELEC ) THEN
- NRIMX = KRIMX
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE A LARGER NUMBER OF POINTS '
- WRITE(ILUOUT,FMT=*) 'FOR THE HORIZONTAL RELAXATION THAN THE '
- WRITE(ILUOUT,FMT=*) 'CORRESPONDING NUMBER OF LARGE SCALE FIELDS:'
- WRITE(ILUOUT,FMT=*) 'IT IS THEREFORE REDUCED TO NRIMX =',NRIMX
-END IF
-!
-IF ( L2D .AND. KRIMY>0 ) THEN
- NRIMY = 0
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE A 2D MODEL THEREFORE NRIMY=0 '
-END IF
-!
-IF ( NRIMY > KRIMY .AND. .NOT.LHORELAX_SVELEC ) THEN
- NRIMY = KRIMY
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE A LARGER NUMBER OF POINTS '
- WRITE(ILUOUT,FMT=*) 'FOR THE HORIZONTAL RELAXATION THAN THE '
- WRITE(ILUOUT,FMT=*) 'CORRESPONDING NUMBER OF LARGE SCALE FIELDS:'
- WRITE(ILUOUT,FMT=*) 'IT IS THEREFORE REDUCED TO NRIMY =',NRIMY
-END IF
-!
-IF ( (.NOT. LHORELAX_UVWTH) .AND. (.NOT.(ANY(LHORELAX_SV))) .AND. &
- (.NOT. LHORELAX_SVC2R2).AND. (.NOT. LHORELAX_SVC1R3) .AND. &
- (.NOT. LHORELAX_SVLIMA).AND. &
- (.NOT. LHORELAX_SVELEC).AND. (.NOT. LHORELAX_SVCHEM) .AND. &
- (.NOT. LHORELAX_SVLG) .AND. (.NOT. LHORELAX_SVPP) .AND. &
- (.NOT. LHORELAX_SVCS) .AND. (.NOT. LHORELAX_SVFIRE) .AND. &
-#ifdef MNH_FOREFIRE
- (.NOT. LHORELAX_SVFF) .AND. &
-#endif
- (.NOT. LHORELAX_RV) .AND. (.NOT. LHORELAX_RC) .AND. &
- (.NOT. LHORELAX_RR) .AND. (.NOT. LHORELAX_RI) .AND. &
- (.NOT. LHORELAX_RS) .AND. (.NOT. LHORELAX_RG) .AND. &
- (.NOT. LHORELAX_RH) .AND. (.NOT. LHORELAX_TKE) .AND. &
- (.NOT. LHORELAX_SVCHIC).AND. &
- (NRIMX /= 0 .OR. NRIMY /= 0)) THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(ILUOUT,FMT=*) 'YOU DO NOT WANT TO USE THE HORIZONTAL RELAXATION '
- WRITE(ILUOUT,FMT=*) 'THEREFORE NRIMX=NRIMY=0 '
- NRIMX=0
- NRIMY=0
-END IF
-!
-IF ((LHORELAX_UVWTH .OR. LHORELAX_SVPP .OR. &
- LHORELAX_SVCS .OR. LHORELAX_SVFIRE .OR. &
-#ifdef MNH_FOREFIRE
- LHORELAX_SVFF .OR. &
-#endif
- LHORELAX_SVC2R2 .OR. LHORELAX_SVC1R3 .OR. &
- LHORELAX_SVLIMA .OR. &
- LHORELAX_SVELEC .OR. LHORELAX_SVCHEM .OR. &
- LHORELAX_SVLG .OR. ANY(LHORELAX_SV) .OR. &
- LHORELAX_RV .OR. LHORELAX_RC .OR. &
- LHORELAX_RR .OR. LHORELAX_RI .OR. &
- LHORELAX_RG .OR. LHORELAX_RS .OR. &
- LHORELAX_RH .OR. LHORELAX_TKE.OR. &
- LHORELAX_SVCHIC ) &
- .AND. (NRIMX==0 .OR. (NRIMY==0 .AND. .NOT.(L2D) ))) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE THE HORIZONTAL RELAXATION '
- WRITE(ILUOUT,FMT=*) 'BUT NRIMX OR NRIMY=0 CHANGE YOUR VALUES '
- WRITE(ILUOUT,FMT=*) "LHORELAX_UVWTH=",LHORELAX_UVWTH
- WRITE(ILUOUT,FMT=*) "LHORELAX_SVC2R2=",LHORELAX_SVC2R2
- WRITE(ILUOUT,FMT=*) "LHORELAX_SVC1R3=",LHORELAX_SVC1R3
- WRITE(ILUOUT,FMT=*) "LHORELAX_SVLIMA=",LHORELAX_SVLIMA
- WRITE(ILUOUT,FMT=*) "LHORELAX_SVELEC=",LHORELAX_SVELEC
- WRITE(ILUOUT,FMT=*) "LHORELAX_SVCHEM=",LHORELAX_SVCHEM
- WRITE(ILUOUT,FMT=*) "LHORELAX_SVCHIC=",LHORELAX_SVCHIC
- WRITE(ILUOUT,FMT=*) "LHORELAX_SVLG=",LHORELAX_SVLG
- WRITE(ILUOUT,FMT=*) "LHORELAX_SVPP=",LHORELAX_SVPP
- WRITE(ILUOUT,FMT=*) "LHORELAX_SVFIRE=",LHORELAX_SVFIRE
-#ifdef MNH_FOREFIRE
- WRITE(ILUOUT,FMT=*) "LHORELAX_SVFF=",LHORELAX_SVFF
-#endif
- WRITE(ILUOUT,FMT=*) "LHORELAX_SVCS=",LHORELAX_SVCS
- WRITE(ILUOUT,FMT=*) "LHORELAX_SV=",LHORELAX_SV
- WRITE(ILUOUT,FMT=*) "LHORELAX_RV=",LHORELAX_RV
- WRITE(ILUOUT,FMT=*) "LHORELAX_RC=",LHORELAX_RC
- WRITE(ILUOUT,FMT=*) "LHORELAX_RR=",LHORELAX_RR
- WRITE(ILUOUT,FMT=*) "LHORELAX_RI=",LHORELAX_RI
- WRITE(ILUOUT,FMT=*) "LHORELAX_RG=",LHORELAX_RG
- WRITE(ILUOUT,FMT=*) "LHORELAX_RS=",LHORELAX_RS
- WRITE(ILUOUT,FMT=*) "LHORELAX_RH=",LHORELAX_RH
- WRITE(ILUOUT,FMT=*) "LHORELAX_TKE=", LHORELAX_TKE
- WRITE(ILUOUT,FMT=*) "NRIMX=",NRIMX
- WRITE(ILUOUT,FMT=*) "NRIMY=",NRIMY
- WRITE(ILUOUT,FMT=*) "L2D=",L2D
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
-END IF
-!
-IF ((LHORELAX_UVWTH .OR. LHORELAX_SVPP .OR. &
- LHORELAX_SVCS .OR. LHORELAX_SVFIRE .OR. &
-#ifdef MNH_FOREFIRE
- LHORELAX_SVFF .OR. &
-#endif
- LHORELAX_SVC2R2 .OR. LHORELAX_SVC1R3 .OR. &
- LHORELAX_SVLIMA .OR. &
- LHORELAX_SVELEC .OR. LHORELAX_SVCHEM .OR. &
- LHORELAX_SVLG .OR. ANY(LHORELAX_SV) .OR. &
- LHORELAX_RV .OR. LHORELAX_RC .OR. &
- LHORELAX_RR .OR. LHORELAX_RI .OR. &
- LHORELAX_RG .OR. LHORELAX_RS .OR. &
- LHORELAX_RH .OR. LHORELAX_TKE.OR. &
- LHORELAX_SVCHIC ) &
- .AND. (KMI /=1)) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE THE HORIZONTAL RELAXATION '
- WRITE(ILUOUT,FMT=*) 'FOR A NESTED MODEL BUT THE COUPLING IS ALREADY DONE'
- WRITE(ILUOUT,FMT=*) 'BY THE GRID NESTING. CHANGE LHORELAX TO FALSE'
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
-END IF
-!
-IF ((LHORELAX_UVWTH .OR. LHORELAX_SVPP .OR. &
- LHORELAX_SVCS .OR. LHORELAX_SVFIRE .OR. &
-#ifdef MNH_FOREFIRE
- LHORELAX_SVFF .OR. &
-#endif
- LHORELAX_SVC2R2 .OR. LHORELAX_SVC1R3 .OR. &
- LHORELAX_SVLIMA .OR. &
- LHORELAX_SVELEC .OR. LHORELAX_SVCHEM .OR. &
- LHORELAX_SVLG .OR. ANY(LHORELAX_SV) .OR. &
- LHORELAX_RV .OR. LHORELAX_RC .OR. &
- LHORELAX_RR .OR. LHORELAX_RI .OR. &
- LHORELAX_RG .OR. LHORELAX_RS .OR. &
- LHORELAX_RH .OR. LHORELAX_TKE.OR. &
- LHORELAX_SVCHIC ) &
- .AND. (CLBCX(1)=='CYCL'.OR.CLBCX(2)=='CYCL' &
- .OR.CLBCY(1)=='CYCL'.OR.CLBCY(2)=='CYCL')) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE THE HORIZONTAL RELAXATION '
- WRITE(ILUOUT,FMT=*) 'FOR CYCLIC CLBCX OR CLBCY VALUES'
- WRITE(ILUOUT,FMT=*) 'CHANGE LHORELAX TO FALSE'
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
-END IF
-!
-IF (KMI==1) THEN
- GRELAX = .NOT.(OUSERV) .AND. LUSERV .AND. LHORELAX_RV
-ELSE
- GRELAX = .NOT.(LUSERV_G(NDAD(KMI))) .AND. LUSERV_G(KMI).AND. LHORELAX_RV
-END IF
-!
-IF ( GRELAX ) THEN
- LHORELAX_RV=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RV FIELD'
- WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
- WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RV=FALSE'
-END IF
-!
-IF (KMI==1) THEN
- GRELAX = .NOT.(OUSERC) .AND. LUSERC .AND. LHORELAX_RC
-ELSE
- GRELAX = .NOT.(LUSERC_G(NDAD(KMI))) .AND. LUSERC_G(KMI).AND. LHORELAX_RC
-END IF
-!
-IF ( GRELAX ) THEN
- LHORELAX_RC=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RC FIELD'
- WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
- WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RC=FALSE'
-END IF
-!
-IF (KMI==1) THEN
- GRELAX = .NOT.(OUSERR) .AND. LUSERR .AND. LHORELAX_RR
-ELSE
- GRELAX = .NOT.(LUSERR_G(NDAD(KMI))) .AND. LUSERR_G(KMI).AND. LHORELAX_RR
-END IF
-!
-IF ( GRELAX ) THEN
- LHORELAX_RR=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RR FIELD'
- WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
- WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RR=FALSE'
-END IF
-!
-IF (KMI==1) THEN
- GRELAX = .NOT.(OUSERI) .AND. LUSERI .AND. LHORELAX_RI
-ELSE
- GRELAX = .NOT.(LUSERI_G(NDAD(KMI))) .AND. LUSERI_G(KMI).AND. LHORELAX_RI
-END IF
-!
-IF ( GRELAX ) THEN
- LHORELAX_RI=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RI FIELD'
- WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
- WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RI=FALSE'
-END IF
-!
-IF (KMI==1) THEN
- GRELAX = .NOT.(OUSERG) .AND. LUSERG .AND. LHORELAX_RG
-ELSE
- GRELAX = .NOT.(LUSERG_G(NDAD(KMI))) .AND. LUSERG_G(KMI).AND. LHORELAX_RG
-END IF
-!
-IF ( GRELAX ) THEN
- LHORELAX_RG=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RG FIELD'
- WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
- WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RG=FALSE'
-END IF
-!
-IF (KMI==1) THEN
- GRELAX = .NOT.(OUSERH) .AND. LUSERH .AND. LHORELAX_RH
-ELSE
- GRELAX = .NOT.(LUSERH_G(NDAD(KMI))) .AND. LUSERH_G(KMI).AND. LHORELAX_RH
-END IF
-!
-IF ( GRELAX ) THEN
- LHORELAX_RH=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RH FIELD'
- WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
- WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RH=FALSE'
-END IF
-!
-IF (KMI==1) THEN
- GRELAX = .NOT.(OUSERS) .AND. LUSERS .AND. LHORELAX_RS
-ELSE
- GRELAX = .NOT.(LUSERS_G(NDAD(KMI))) .AND. LUSERS_G(KMI).AND. LHORELAX_RS
-END IF
-!
-IF ( GRELAX ) THEN
- LHORELAX_RS=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RS FIELD'
- WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
- WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RS=FALSE'
-END IF
-!
-IF (KMI==1) THEN
- GRELAX = HTURB=='NONE' .AND. LUSETKE(1).AND. LHORELAX_TKE
-ELSE
- GRELAX = .NOT.(LUSETKE(NDAD(KMI))) .AND. LUSETKE(KMI) .AND. LHORELAX_TKE
-END IF
-!
-IF ( GRELAX ) THEN
- LHORELAX_TKE=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE TKE FIELD'
- WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
- WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_TKE=FALSE'
-END IF
-!
-!
-DO JSV = 1,NSV_USER
-!
- IF (KMI==1) THEN
- GRELAX = KSV_USER<JSV .AND. LUSESV(JSV,1).AND. LHORELAX_SV(JSV)
- ELSE
- GRELAX = .NOT.(LUSESV(JSV,NDAD(KMI))) .AND. LUSESV(JSV,KMI) .AND. LHORELAX_SV(JSV)
- END IF
- !
- IF ( GRELAX ) THEN
- LHORELAX_SV(JSV)=.FALSE.
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE ',JSV,' SV FIELD'
- WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI)
- WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SV(',JSV,')=FALSE'
- END IF
-END DO
-!
-!* 4.6 consistency in LES diagnostics choices
-!
-IF (CLES_NORM_TYPE=='EKMA' .AND. .NOT. LCORIO) THEN
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE THE EKMAN NORMALIZATION'
- WRITE(ILUOUT,FMT=*) 'BUT CORIOLIS FORCE IS NOT USED (LCORIO=.FALSE.)'
- WRITE(ILUOUT,FMT=*) 'THEN, NO NORMALIZATION IS PERFORMED'
- CLES_NORM_TYPE='NONE'
-END IF
-!
-!* 4.7 Check the coherence with LNUMDIFF
-!
-IF (L1D .AND. (LNUMDIFU .OR. LNUMDIFTH .OR. LNUMDIFSV) ) THEN
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE HORIZONTAL DIFFUSION '
- WRITE(ILUOUT,FMT=*) 'BUT YOU ARE IN A COLUMN MODEL (L1D=.TRUE.).'
- WRITE(ILUOUT,FMT=*) 'THEREFORE LNUMDIFU and LNUMDIFTH and LNUMDIFSV'
- WRITE(ILUOUT,FMT=*) 'ARE SET TO FALSE'
- LNUMDIFU=.FALSE.
- LNUMDIFTH=.FALSE.
- LNUMDIFSV=.FALSE.
-END IF
-!
-IF (.NOT. LNUMDIFTH .AND. LZDIFFU) THEN
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(ILUOUT,FMT=*) 'YOU DO NOT WANT TO USE HORIZONTAL DIFFUSION (LNUMDIFTH=F)'
- WRITE(ILUOUT,FMT=*) 'BUT YOU WANT TO USE Z-NUMERICAL DIFFUSION '
- WRITE(ILUOUT,FMT=*) 'THEREFORE LNUMDIFTH IS SET TO TRUE'
- LNUMDIFTH=.TRUE.
-END IF
-!
-!* 4.8 Other
-!
-IF (XTNUDGING < 4.*XTSTEP) THEN
- XTNUDGING = 4.*XTSTEP
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT='("TIME SCALE FOR NUDGING CAN NOT BE SMALLER THAN", &
- & " FOUR TIMES THE TIME STEP")')
- WRITE(ILUOUT,FMT=*) 'XTNUDGING is SET TO ',XTNUDGING
-END IF
-!
-!
-IF (XWAY(KMI) == 3. ) THEN
- XWAY(KMI) = 2.
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT='("XWAY=3 DOES NOT EXIST ANYMORE; ", &
- & " IT IS REPLACED BY XWAY=2 ")')
-END IF
-!
-IF ( (KMI == 1) .AND. XWAY(KMI) /= 0. ) THEN
- XWAY(KMI) = 0.
- WRITE(UNIT=ILUOUT,FMT=9002) KMI
- WRITE(UNIT=ILUOUT,FMT='("XWAY MUST BE EQUAL TO 0 FOR DAD MODEL")')
-END IF
-!
-!JUANZ ZRESI solver need BSPLITTING
-IF ( CPRESOPT == 'ZRESI' .AND. CSPLIT /= 'BSPLITTING' ) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT='("Paralleliez in Z solver CPRESOPT=ZRESI need also CSPLIT=BSPLITTING ")')
- WRITE(ILUOUT,FMT=*) ' ERROR you have to set also CSPLIT=BSPLITTING '
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
-END IF
-!
-IF ( LEN_TRIM(HINIFILEPGD)>0 ) THEN
- IF ( CINIFILEPGD/=HINIFILEPGD ) THEN
- WRITE(UNIT=ILUOUT,FMT=9001) KMI
- WRITE(ILUOUT,FMT=*) ' ERROR : in EXSEG1.nam, in NAM_LUNITn you have CINIFILEPGD= ',CINIFILEPGD
- WRITE(ILUOUT,FMT=*) ' whereas in .des you have CINIFILEPGD= ',HINIFILEPGD
- WRITE(ILUOUT,FMT=*) ' Please check your Namelist '
- WRITE(ILUOUT,FMT=*) ' For example, you may have specified the un-nested PGD file instead of the nested PGD file '
- WRITE(ILUOUT,FMT=*)
- WRITE(ILUOUT,FMT=*) '###############'
- WRITE(ILUOUT,FMT=*) ' MESONH ABORTS'
- WRITE(ILUOUT,FMT=*) '###############'
- WRITE(ILUOUT,FMT=*)
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
- END IF
-ELSE
- CINIFILEPGD = ''
-!* note that after a spawning, there is no value for CINIFILEPGD in the .des file,
-! so the checking cannot be made if the user starts a simulation directly from
-! a spawned file (without the prep_real_case stage)
-END IF
-!-------------------------------------------------------------------------------
-!
-!* 5. WE DO NOT FORGET TO UPDATE ALL DOLLARN NAMELIST VARIABLES
-! ---------------------------------------------------------
-!
-CALL UPDATE_NAM_LUNITN
-CALL UPDATE_NAM_CONFN
-CALL UPDATE_NAM_DRAGTREEN
-CALL UPDATE_NAM_DRAGBLDGN
-CALL UPDATE_NAM_DYNN
-CALL UPDATE_NAM_ADVN
-CALL UPDATE_NAM_PARAMN
-CALL UPDATE_NAM_PARAM_RADN
-#ifdef MNH_ECRAD
-CALL UPDATE_NAM_PARAM_ECRADN
-#endif
-CALL UPDATE_NAM_PARAM_KAFRN
-CALL UPDATE_NAM_PARAM_MFSHALLN
-CALL UPDATE_NAM_LBCN
-CALL UPDATE_NAM_NUDGINGN
-CALL UPDATE_NAM_TURBN
-CALL UPDATE_NAM_BLANKN
-CALL UPDATE_NAM_CH_MNHCN
-CALL UPDATE_NAM_CH_SOLVERN
-CALL UPDATE_NAM_SERIESN
-CALL UPDATE_NAM_BLOWSNOWN
-CALL UPDATE_NAM_PROFILERn
-CALL UPDATE_NAM_STATIONn
-CALL UPDATE_NAM_FIREn
-!-------------------------------------------------------------------------------
-WRITE(UNIT=ILUOUT,FMT='(/)')
-!-------------------------------------------------------------------------------
-!
-!* 6. FORMATS
-! -------
-!
-9000 FORMAT(/,'NOTE IN READ_EXSEG FOR MODEL ', I2, ' : ',/, &
- '--------------------------------')
-9001 FORMAT(/,'CAUTION ERROR IN READ_EXSEG FOR MODEL ', I2,' : ',/, &
- '----------------------------------------' )
-9002 FORMAT(/,'WARNING IN READ_EXSEG FOR MODEL ', I2,' : ',/, &
- '----------------------------------' )
-9003 FORMAT(/,'FATAL ERROR IN READ_EXSEG FOR MODEL ', I2,' : ',/, &
- '--------------------------------------' )
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE READ_EXSEG_n
diff --git a/src/mesonh/ext/resolved_cloud.f90 b/src/mesonh/ext/resolved_cloud.f90
deleted file mode 100644
index 64d5eec3a..000000000
--- a/src/mesonh/ext/resolved_cloud.f90
+++ /dev/null
@@ -1,1108 +0,0 @@
-!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_RESOLVED_CLOUD
-! ##########################
-INTERFACE
- SUBROUTINE RESOLVED_CLOUD ( HCLOUD, HACTCCN, HSCONV, HMF_CLOUD, &
- KRR, KSPLITR, KSPLITG, KMI, KTCOUNT, &
- HLBCX, HLBCY, TPFILE, HRAD, HTURBDIM, &
- OSUBG_COND, OSIGMAS, HSUBG_AUCV, &
- PTSTEP, PZZ, PRHODJ, PRHODREF, PEXNREF, &
- PPABST, PTHT, PRT, PSIGS, PSIGQSAT, PMFCONV, &
- PTHM, PRCM, PPABSTT, &
- PW_ACT,PDTHRAD, PTHS, PRS, PSVT, PSVS, PSRCS, PCLDFR,&
- PICEFR, &
- PCIT, OSEDIC, OACTIT, OSEDC, OSEDI, &
- ORAIN, OWARM, OHHONI, OCONVHG, &
- PCF_MF,PRC_MF, PRI_MF, &
- PINPRC,PINPRC3D,PINPRR,PINPRR3D, PEVAP3D, &
- PINPRS,PINPRS3D,PINPRG,PINPRG3D,PINPRH,PINPRH3D, &
- PSOLORG,PMI, &
- PSPEEDC, PSPEEDR, PSPEEDS, PSPEEDG, PSPEEDH, &
- PINDEP, PSUPSAT, PNACT, PNPRO,PSSPRO, PRAINFR, &
- PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
- PSEA,PTOWN )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! kind of cloud
-CHARACTER(LEN=4), INTENT(IN) :: HACTCCN ! kind of CCN activation scheme
- ! paramerization
-CHARACTER(LEN=4), INTENT(IN) :: HSCONV ! Shallow convection scheme
-CHARACTER(LEN=4), INTENT(IN) :: HMF_CLOUD! Type of statistical cloud
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
- ! integrations for rain sedimendation
-INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
- ! integrations for ice sedimendation
-INTEGER, INTENT(IN) :: KMI ! Model index
-INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
-CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Dimensionality of the
- ! turbulence scheme
-LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid Cond.
-LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
- ! use values computed in CONDENSATION
- ! or that from turbulence scheme
-CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV
- ! Kind of Subgrid autoconversion method
-REAL, INTENT(IN) :: PTSTEP ! Time step :XTSTEP in namelist
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ !Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference dry air density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PRT ! Moist variables at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
-REAL, INTENT(IN) :: PSIGQSAT! coeff applied to qsat variance contribution
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-Dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSTT ! Pressure time t+Dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at time t-Dt
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_ACT ! W for CCN activation
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD! THeta RADiative Tendancy
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable sources
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Scalar variable at time t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable sources
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
- ! s'rc'/2Sigma_s2 at time t+1
- ! multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR! Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR! Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice number
- ! concentration at time t
-LOGICAL, INTENT(IN) :: OSEDIC! Switch to activate the
- ! cloud droplet sedimentation
- ! for ICE3
-LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
- ! activation through temp.
- ! evolution in C2R2 and KHKO
-LOGICAL, INTENT(IN) :: OSEDC ! Switch to activate the
- ! cloud droplet sedimentation
- ! for C2R2 or KHKO
-LOGICAL, INTENT(IN) :: OSEDI ! Switch to activate the
- ! cloud crystal sedimentation
-LOGICAL, INTENT(IN) :: ORAIN ! Switch to activate the
- ! raindrop formation
-LOGICAL, INTENT(IN) :: OWARM ! Control of the rain formation
- ! by slow warm microphysical
- ! processes
-LOGICAL, INTENT(IN) :: OHHONI! enable haze freezing
-LOGICAL, INTENT(IN) :: OCONVHG! Switch for conversion from
- ! hail to graupel
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux solid mixing ratio
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! sed flux of precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! evap profile
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRC3D ! sed flux of precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRS3D ! sed flux of precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRG3D ! sed flux of precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRH3D ! sed flux of precip
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSOLORG ![%] solubility fraction of soa
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PMI
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDC ! Cloud sedimentation speed
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDR ! Rain sedimentation speed
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDS ! Snow sedimentation speed
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDG ! Graupel sedimentation speed
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDH ! Hail sedimentation speed
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSUPSAT !sursat
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNACT !concentrtaion d'aérosols activés au temps t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNPRO !concentrtaion d'aérosols activés au temps t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSSPRO !sursat
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR ! Rain fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HRC !HighLow liquid content
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HCF !HighLow liquid cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HRI !HighLow ice content
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HCF !HighLow ice clous fraction
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
-!
-END SUBROUTINE RESOLVED_CLOUD
-END INTERFACE
-END MODULE MODI_RESOLVED_CLOUD
-!
-! ##########################################################################
- SUBROUTINE RESOLVED_CLOUD ( HCLOUD, HACTCCN, HSCONV, HMF_CLOUD, &
- KRR, KSPLITR, KSPLITG, KMI, KTCOUNT, &
- HLBCX, HLBCY, TPFILE, HRAD, HTURBDIM, &
- OSUBG_COND, OSIGMAS, HSUBG_AUCV, &
- PTSTEP, PZZ, PRHODJ, PRHODREF, PEXNREF, &
- PPABST, PTHT, PRT, PSIGS, PSIGQSAT, PMFCONV, &
- PTHM, PRCM, PPABSTT, &
- PW_ACT,PDTHRAD, PTHS, PRS, PSVT, PSVS, PSRCS, PCLDFR,&
- PICEFR, &
- PCIT, OSEDIC, OACTIT, OSEDC, OSEDI, &
- ORAIN, OWARM, OHHONI, OCONVHG, &
- PCF_MF,PRC_MF, PRI_MF, &
- PINPRC,PINPRC3D,PINPRR,PINPRR3D, PEVAP3D, &
- PINPRS,PINPRS3D,PINPRG,PINPRG3D,PINPRH,PINPRH3D, &
- PSOLORG,PMI, &
- PSPEEDC, PSPEEDR, PSPEEDS, PSPEEDG, PSPEEDH, &
- PINDEP, PSUPSAT, PNACT, PNPRO,PSSPRO, PRAINFR, &
- PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
- PSEA,PTOWN )
-! ##########################################################################
-!
-!!**** * - compute the resolved clouds and precipitation
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the microphysical sources
-!! related to the resolved clouds and precipitation
-!!
-!!
-!!** METHOD
-!! ------
-!! The main actions of this routine is to call the routines computing the
-!! microphysical sources. Before that:
-!! - it computes the real absolute pressure,
-!! - negative values of the current guess of all mixing ratio are removed.
-!! This is done by a global filling algorithm based on a multiplicative
-!! method (Rood, 1987), in order to conserved the total mass in the
-!! simulation domain.
-!! - Sources are transformed in physical tendencies, by removing the
-!! multiplicative term Rhod*J.
-!! - External points values are filled owing to the use of cyclic
-!! l.b.c., in order to performe computations on the full domain.
-!! After calling to microphysical routines, the physical tendencies are
-!! switched back to prognostic variables.
-!!
-!!
-!! EXTERNAL
-!! --------
-!! Subroutine SLOW_TERMS: Computes the explicit microphysical sources
-!! Subroutine FAST_TERMS: Performs the saturation adjustment for l
-!! Subroutine RAIN_ICE : Computes the explicit microphysical sources for i
-!! Subroutine ICE_ADJUST: Performs the saturation adjustment for i+l
-!! MIN_ll,SUM3D_ll : distributed functions equivalent to MIN and SUM
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_PARAMETERS : contains declarations of parameter variables
-!! JPHEXT : Horizontal external points number
-!! JPVEXT : Vertical external points number
-!! Module MODD_CST
-!! CST%XP00 ! Reference pressure
-!! CST%XRD ! Gaz constant for dry air
-!! CST%XCPD ! Cpd (dry air)
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book1 and book2 of documentation ( routine RESOLVED_CLOUD )
-!!
-!! AUTHOR
-!! ------
-!! E. Richard * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 21/12/94
-!! Modifications: June 8, 1995 ( J.Stein )
-!! Cleaning to improve efficienty and clarity
-!! in agreement with the MESO-NH coding norm
-!! March 1, 1996 ( J.Stein )
-!! store the cloud fraction
-!! March 18, 1996 ( J.Stein )
-!! check that ZMASSPOS /= 0
-!! Oct. 12, 1996 ( J.Stein )
-!! remove the negative values correction
-!! for the KES2 case
-!! Modifications: Dec 14, 1995 (J.-P. Pinty)
-!! Add the mixed-phase option
-!! Modifications: Jul 01, 1996 (J.-P. Pinty)
-!! Change arg. list in routine FAST_TERMS
-!! Modifications: Jan 27, 1997 (J.-P. Pinty)
-!! add W and SV in arg. list
-!! Modifications: March 23, 98 (E.Richard)
-!! correction of negative value based on
-!! rv+rc+ri and thetal or thetail conservation
-!! Modifications: April 08, 98 (J.-P. Lafore and V. Ducrocq )
-!! modify the correction of negative values
-!! Modifications: June 08, 00 (J.-P. Pinty and J.-M. Cohard)
-!! add the C2R2 scheme
-!! Modifications: April 08, 01 (J.-P. Pinty)
-!! add the C3R5 scheme
-!! Modifications: July 21, 01 (J.-P. Pinty)
-!! Add OHHONI and PW_ACT (for haze freezing)
-!! Modifications: Sept 21, 01 (J.-P. Pinty)
-!! Add XCONC_CCN limitation
-!! Modifications: Nov 21, 02 (J.-P. Pinty)
-!! Add ICE4 and C3R5 options
-!! June, 2005 (V. Masson)
-!! Technical change in interface for scalar arguments
-!! Modifications : March, 2006 (O.Geoffroy)
-!! Add KHKO scheme
-!! Modifications : March 2013 (O.Thouron)
-!! Add prognostic supersaturation
-!! July, 2015 (O.Nuissier/F.Duffourg) Add microphysics diagnostic for
-!! aircraft, ballon and profiler
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! M.Mazoyer : 04/2016 : Temperature radiative tendency used for
-!! activation by cooling (OACTIT)
-!! Modification 01/2016 (JP Pinty) Add LIMA
-!! 10/2016 M.Mazoyer New KHKO output fields
-!! 10/2016 (C.Lac) Add droplet deposition
-!! S.Riette : 11/2016 : ice_adjust before and after rain_ice
-!! ICE3/ICE4 modified, old version under LRED=F
-! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 01/02/2019: ZRSMIN is now allocatable (instead of size of XRTMIN which was sometimes not allocated)
-! C. Lac 02/2019: add rain fraction as an output field
-! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
-! B. Vie 03/2020: LIMA negativity checks after turbulence, advection and microphysics budgets
-! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation
-! P. Wautelet 11/06/2020: bugfix: correct ZSVS array indices
-! P. Wautelet 11/06/2020: bugfix: add "Non local correction for precipitating species" for ICE4
-! P. Wautelet + Benoit Vié 06/2020: improve removal of negative scalar variables + adapt the corresponding budgets
-! P. Wautelet 23/06/2020: remove ZSVS and ZSVT to improve code readability
-! P. Wautelet 30/06/2020: move removal of negative scalar variables to Sources_neg_correct
-! P. Wautelet 30/06/2020: remove non-local corrections
-! B. Vie 06/2020: add prognostic supersaturation for LIMA
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-USE MODD_BUDGET, ONLY: TBUDGETS, TBUCONF
-USE MODD_CH_AEROSOL, ONLY: LORILAM
-USE MODD_DUST, ONLY: LDUST
-USE MODD_CST, ONLY: CST
-USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
-USE MODD_DUST , ONLY: LDUST
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_NEB, ONLY: NEB
-USE MODD_NSV, ONLY: NSV, NSV_C1R3END, NSV_C2R2BEG, NSV_C2R2END, &
- NSV_LIMA_BEG, NSV_LIMA_END, NSV_LIMA_CCN_FREE, NSV_LIMA_IFN_FREE, &
- NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_NR, NSV_AEREND,NSV_DSTEND,NSV_SLTEND
-USE MODD_PARAM_C2R2, ONLY: LSUPSAT
-USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
-USE MODD_PARAM_ICE, ONLY: CSEDIM, LADJ_BEFORE, LADJ_AFTER, CFRAC_ICE_ADJUST, LRED, &
- PARAM_ICE
-USE MODD_PARAM_LIMA, ONLY: LADJ, LPTSPLIT, LSPRO, NMOD_CCN, NMOD_IFN, NMOD_IMM, NMOM_I
-USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN, RAIN_ICE_DESCR
-USE MODD_RAIN_ICE_PARAM, ONLY: RAIN_ICE_PARAM
-USE MODD_SALT, ONLY: LSALT
-USE MODD_TURB_n, ONLY: TURBN, CSUBG_AUCV_RI, CCONDENS, CLAMBDA3, CSUBG_MF_PDF
-!
-USE MODE_ll
-USE MODE_FILL_DIMPHYEX, ONLY: FILL_DIMPHYEX
-use mode_sources_neg_correct, only: Sources_neg_correct
-!
-USE MODI_C2R2_ADJUST
-USE MODI_FAST_TERMS
-USE MODI_GET_HALO
-USE MODI_ICE_ADJUST
-USE MODI_KHKO_NOTADJUST
-USE MODI_LIMA
-USE MODI_LIMA_ADJUST
-USE MODI_LIMA_ADJUST_SPLIT
-USE MODI_LIMA_COLD
-USE MODI_LIMA_MIXED
-USE MODI_LIMA_NOTADJUST
-USE MODI_LIMA_WARM
-USE MODI_RAIN_C2R2_KHKO
-USE MODI_RAIN_ICE
-USE MODI_RAIN_ICE_OLD
-USE MODI_SHUMAN
-USE MODI_SLOW_TERMS
-USE MODI_AER2LIMA
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-!
-!
-CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! kind of cloud paramerization
-CHARACTER(LEN=4), INTENT(IN) :: HACTCCN ! kind of CCN activation scheme
-CHARACTER(LEN=4), INTENT(IN) :: HSCONV ! Shallow convection scheme
-CHARACTER(LEN=4), INTENT(IN) :: HMF_CLOUD! Type of statistical cloud
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
- ! integrations for rain sedimendation
-INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
- ! integrations for ice sedimendation
-INTEGER, INTENT(IN) :: KMI ! Model index
-INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
-CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Dimensionality of the
- ! turbulence scheme
-LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid Cond.
-LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
- ! use values computed in CONDENSATION
- ! or that from turbulence scheme
-CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV
- ! Kind of Subgrid autoconversion method
-REAL, INTENT(IN) :: PTSTEP ! Time step :XTSTEP in namelist
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ !Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference dry air density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PRT ! Moist variables at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
-REAL, INTENT(IN) :: PSIGQSAT! coeff applied to qsat variance contribution
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-Dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSTT ! Pressure time t+Dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at time t-Dt
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_ACT ! W for CCN activation
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD! THeta RADiative Tendancy
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable sources
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Scalar variable at time t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable sources
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
- ! s'rc'/2Sigma_s2 at time t+1
- ! multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR! Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR! Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice number
- ! concentration at time t
-LOGICAL, INTENT(IN) :: OSEDIC! Switch to activate the
- ! cloud droplet sedimentation
- ! for ICE3
-LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
- ! activation through temp.
- ! evolution in C2R2 and KHKO
-LOGICAL, INTENT(IN) :: OSEDC ! Switch to activate the
- ! cloud droplet sedimentation
-LOGICAL, INTENT(IN) :: OSEDI ! Switch to activate the
- ! cloud crystal sedimentation
-LOGICAL, INTENT(IN) :: ORAIN ! Switch to activate the
- ! raindrop formation
-LOGICAL, INTENT(IN) :: OWARM ! Control of the rain formation
- ! by slow warm microphysical
- ! processes
-LOGICAL, INTENT(IN) :: OHHONI! enable haze freezing
-LOGICAL, INTENT(IN) :: OCONVHG! Switch for conversion from
- ! hail to graupel
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux solid mixing ratio
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! sed flux of precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! evap profile
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRC3D ! sed flux of precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRS3D ! sed flux of precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRG3D ! sed flux of precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRH3D ! sed flux of precip
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSOLORG ![%] solubility fraction of soa
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PMI
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDC ! Cloud sedimentation speed
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDR ! Rain sedimentation speed
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDS ! Snow sedimentation speed
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDG ! Graupel sedimentation speed
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDH ! Hail sedimentation speed
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSUPSAT !sursat
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNACT !concentrtaion d'aérosols activés au temps t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNPRO !concentrtaion d'aérosols activés au temps t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSSPRO !sursat
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR ! Rain fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HRC !HighLow liquid content
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HCF !HighLow liquid cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HRI !HighLow ice content
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HCF !HighLow ice clous fraction
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
-!
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: JRR,JSV ! Loop index for the moist and scalar variables
-INTEGER :: IIB ! Define the physical domain
-INTEGER :: IIE !
-INTEGER :: IJB !
-INTEGER :: IJE !
-INTEGER :: IKB !
-INTEGER :: IKE !
-INTEGER :: IKU
-INTEGER :: IINFO_ll ! return code of parallel routine
-INTEGER :: JK,JI,JL
-!
-!
-!
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZDZZ
-real, dimension(:,:,:), allocatable :: ZEXN
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZZZ
- ! model layer height
-! REAL :: ZMASSTOT ! total mass for one water category
-! ! including the negative values
-! REAL :: ZMASSPOS ! total mass for one water category
-! ! after removing the negative values
-! REAL :: ZRATIO ! ZMASSTOT / ZMASSCOR
-!
-INTEGER :: ISVBEG ! first scalar index for microphysics
-INTEGER :: ISVEND ! last scalar index for microphysics
-!UPG*PT
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVT ! scalar variable for microphysics only
-!UPG*PT
-
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3), KRR) :: ZFPR
-!
-INTEGER :: JMOD, JMOD_IFN
-LOGICAL :: GWEST,GEAST,GNORTH,GSOUTH
-LOGICAL :: LMFCONV ! =SIZE(PMFCONV)!=0
-! BVIE work array waiting for PINPRI
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)):: ZINPRI
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZICEFR
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZPRCFR
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZTM
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZSIGQSAT2D
-TYPE(DIMPHYEX_t) :: YLDIMPHYEX
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZDUM
-ZSIGQSAT2D(:,:) = PSIGQSAT
-!
-!------------------------------------------------------------------------------
-!
-!* 1. PRELIMINARY COMPUTATIONS
-! ------------------------
-!
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IKB=1+JPVEXT
-IKE=SIZE(PZZ,3) - JPVEXT
-IKU=SIZE(PZZ,3)
-!
-CALL FILL_DIMPHYEX(YLDIMPHYEX, SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3))
-!
-GWEST = LWEST_ll()
-GEAST = LEAST_ll()
-GSOUTH = LSOUTH_ll()
-GNORTH = LNORTH_ll()
-!
-LMFCONV=(SIZE(PMFCONV)/=0)
-!
-IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO') THEN
- ISVBEG = NSV_C2R2BEG
- ISVEND = NSV_C2R2END
-ELSE IF (HCLOUD == 'C3R5') THEN
- ISVBEG = NSV_C2R2BEG
- ISVEND = NSV_C1R3END
-ELSE IF (HCLOUD == 'LIMA') THEN
- ISVBEG = NSV_LIMA_BEG
- IF (.NOT. LDUST .AND. .NOT. LSALT .AND. .NOT. LORILAM) THEN
- ISVEND = NSV_LIMA_END
- ELSE
- IF (LORILAM) THEN
- ISVEND = NSV_AEREND
- END IF
- IF (LDUST) THEN
- ISVEND = NSV_DSTEND
- END IF
- IF (LSALT) THEN
- ISVEND = NSV_SLTEND
- END IF
- END IF
-ELSE
- ISVBEG = 0
- ISVEND = 0
-END IF
-!
-!
-!
-!* 1. From ORILAM to LIMA:
-!
-IF (HCLOUD == 'LIMA' .AND. ((LORILAM).OR.(LDUST).OR.(LSALT))) THEN
-! ORILAM : tendance s --> variable instant t
-ALLOCATE(ZSVT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3),NSV))
- DO JSV = 1, NSV
- ZSVT(:,:,:,JSV) = PSVS(:,:,:,JSV) * PTSTEP / PRHODJ(:,:,:)
- END DO
-
-CALL AER2LIMA(ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,:),&
- PRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), &
- PRT(IIB:IIE,IJB:IJE,IKB:IKE,1),&
- PPABST(IIB:IIE,IJB:IJE,IKB:IKE),&
- PTHT(IIB:IIE,IJB:IJE,IKB:IKE), &
- PZZ(IIB:IIE,IJB:IJE,IKB:IKE))
-
-! LIMA : variable instant t --> tendance s
- PSVS(:,:,:,NSV_LIMA_CCN_FREE) = ZSVT(:,:,:,NSV_LIMA_CCN_FREE) * &
- PRHODJ(:,:,:) / PTSTEP
- PSVS(:,:,:,NSV_LIMA_CCN_FREE+1) = ZSVT(:,:,:,NSV_LIMA_CCN_FREE+1) * &
- PRHODJ(:,:,:) / PTSTEP
- PSVS(:,:,:,NSV_LIMA_CCN_FREE+2) = ZSVT(:,:,:,NSV_LIMA_CCN_FREE+2) * &
- PRHODJ(:,:,:) / PTSTEP
-
- PSVS(:,:,:,NSV_LIMA_IFN_FREE) = ZSVT(:,:,:,NSV_LIMA_IFN_FREE) * &
- PRHODJ(:,:,:) / PTSTEP
- PSVS(:,:,:,NSV_LIMA_IFN_FREE+1) = ZSVT(:,:,:,NSV_LIMA_IFN_FREE+1) * &
- PRHODJ(:,:,:) / PTSTEP
-
-DEALLOCATE(ZSVT)
-END IF
-
-!UPG*PT
-!
-!
-!* 2. TRANSFORMATION INTO PHYSICAL TENDENCIES
-! ---------------------------------------
-!
-PTHS(:,:,:) = PTHS(:,:,:) / PRHODJ(:,:,:)
-DO JRR = 1,KRR
- PRS(:,:,:,JRR) = PRS(:,:,:,JRR) / PRHODJ(:,:,:)
-END DO
-!
-IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN
- DO JSV = ISVBEG, ISVEND
- PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) / PRHODJ(:,:,:)
- ENDDO
-ENDIF
-!
-! complete the lateral boundaries to avoid possible problems
-!
-DO JI=1,JPHEXT
- PTHS(JI,:,:) = PTHS(IIB,:,:)
- PTHS(IIE+JI,:,:) = PTHS(IIE,:,:)
- PTHS(:,JI,:) = PTHS(:,IJB,:)
- PTHS(:,IJE+JI,:) = PTHS(:,IJE,:)
-!
- PRS(JI,:,:,:) = PRS(IIB,:,:,:)
- PRS(IIE+JI,:,:,:) = PRS(IIE,:,:,:)
- PRS(:,JI,:,:) = PRS(:,IJB,:,:)
- PRS(:,IJE+JI,:,:) = PRS(:,IJE,:,:)
-END DO
-!
-! complete the physical boundaries to avoid some computations
-!
-IF(GWEST .AND. HLBCX(1) /= 'CYCL') PRT(:IIB-1,:,:,2:) = 0.0
-IF(GEAST .AND. HLBCX(2) /= 'CYCL') PRT(IIE+1:,:,:,2:) = 0.0
-IF(GSOUTH .AND. HLBCY(1) /= 'CYCL') PRT(:,:IJB-1,:,2:) = 0.0
-IF(GNORTH .AND. HLBCY(2) /= 'CYCL') PRT(:,IJE+1:,:,2:) = 0.0
-!
-IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN
-DO JI=1,JPHEXT
- PSVS(JI, :, :, ISVBEG:ISVEND) = PSVS(IIB, :, :, ISVBEG:ISVEND)
- PSVS(IIE+JI, :, :, ISVBEG:ISVEND) = PSVS(IIE, :, :, ISVBEG:ISVEND)
- PSVS(:, JI, :, ISVBEG:ISVEND) = PSVS(:, IJB, :, ISVBEG:ISVEND)
- PSVS(:, IJE+JI, :, ISVBEG:ISVEND) = PSVS(:, IJE, :, ISVBEG:ISVEND)
-END DO
- !
-! complete the physical boundaries to avoid some computations
-!
- IF(GWEST .AND. HLBCX(1) /= 'CYCL') PSVT(:IIB-1, :, :, ISVBEG:ISVEND) = 0.0
- IF(GEAST .AND. HLBCX(2) /= 'CYCL') PSVT(IIE+1:, :, :, ISVBEG:ISVEND) = 0.0
- IF(GSOUTH .AND. HLBCY(1) /= 'CYCL') PSVT(:, :IJB-1, :, ISVBEG:ISVEND) = 0.0
- IF(GNORTH .AND. HLBCY(2) /= 'CYCL') PSVT(:, IJE+1:, :, ISVBEG:ISVEND) = 0.0
-ENDIF
-!
-! complete the vertical boundaries
-!
-PTHS(:,:,IKB-1) = PTHS(:,:,IKB)
-PTHS(:,:,IKE+1) = PTHS(:,:,IKE)
-!
-PRS(:,:,IKB-1,:) = PRS(:,:,IKB,:)
-PRS(:,:,IKE+1,:) = PRS(:,:,IKE,:)
-!
-PRT(:,:,IKB-1,:) = PRT(:,:,IKB,:)
-PRT(:,:,IKE+1,:) = PRT(:,:,IKE,:)
-!
-IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO' &
- .OR. HCLOUD == 'LIMA') THEN
- PSVS(:,:,IKB-1,ISVBEG:ISVEND) = PSVS(:,:,IKB,ISVBEG:ISVEND)
- PSVS(:,:,IKE+1,ISVBEG:ISVEND) = PSVS(:,:,IKE,ISVBEG:ISVEND)
- PSVT(:,:,IKB-1,ISVBEG:ISVEND) = PSVT(:,:,IKB,ISVBEG:ISVEND)
- PSVT(:,:,IKE+1,ISVBEG:ISVEND) = PSVT(:,:,IKE,ISVBEG:ISVEND)
-ENDIF
-!
-!
-!* 3. REMOVE NEGATIVE VALUES
-! ----------------------
-!
-!* 3.1 Non local correction for precipitating species (Rood 87)
-!
-! IF ( HCLOUD == 'KESS' &
-! .OR. HCLOUD == 'ICE3' .OR. HCLOUD == 'ICE4' &
-! .OR. HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' &
-! .OR. HCLOUD == 'KHKO' .OR. HCLOUD == 'LIMA' ) THEN
-! !
-! DO JRR = 3,KRR
-! SELECT CASE (JRR)
-! CASE(3,5,6,7) ! rain, snow, graupel and hail
-!
-! IF ( MIN_ll( PRS(:,:,:,JRR), IINFO_ll) < 0.0 ) THEN
-! !
-! ! compute the total water mass computation
-! !
-! ZMASSTOT = MAX( 0. , SUM3D_ll( PRS(:,:,:,JRR), IINFO_ll ) )
-! !
-! ! remove the negative values
-! !
-! PRS(:,:,:,JRR) = MAX( 0., PRS(:,:,:,JRR) )
-! !
-! ! compute the new total mass
-! !
-! ZMASSPOS = MAX(XMNH_TINY,SUM3D_ll( PRS(:,:,:,JRR), IINFO_ll ) )
-! !
-! ! correct again in such a way to conserve the total mass
-! !
-! ZRATIO = ZMASSTOT / ZMASSPOS
-! PRS(:,:,:,JRR) = PRS(:,:,:,JRR) * ZRATIO
-! !
-! END IF
-! END SELECT
-! END DO
-! END IF
-!
-!* 3.2 Adjustement for liquid and solid cloud
-!
-! Remove non-physical negative values (unnecessary in a perfect world) + corresponding budgets
-call Sources_neg_correct( hcloud, 'NEGA', krr, ptstep, ppabst, ptht, prt, pths, prs, psvs, prhodj )
-!
-!* 3.4 Limitations of Na and Nc to the CCN max number concentration
-!
-! Commented by O.Thouron 03/2013
-!IF ((HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO') &
-! .AND.(XCONC_CCN > 0)) THEN
-! IF ((HACTCCN /= 'ABRK')) THEN
-! ZSVT(:,:,:,1) = MIN( ZSVT(:,:,:,1),XCONC_CCN )
-! ZSVT(:,:,:,2) = MIN( ZSVT(:,:,:,2),XCONC_CCN )
-! ZSVS(:,:,:,1) = MIN( ZSVS(:,:,:,1),XCONC_CCN )
-! ZSVS(:,:,:,2) = MIN( ZSVS(:,:,:,2),XCONC_CCN )
-! END IF
-!END IF
-!
-!
-!-------------------------------------------------------------------------------
-!
-SELECT CASE ( HCLOUD )
- CASE ('REVE')
-!
-!* 4. REVERSIBLE MICROPHYSICAL SCHEME
-! -------------------------------
-!
- CALL FAST_TERMS ( KRR, KMI, HRAD, HTURBDIM, &
- HSCONV, HMF_CLOUD, OSUBG_COND, PTSTEP, &
- PRHODJ, PSIGS, PPABST, &
- PCF_MF,PRC_MF, &
- PRVT=PRT(:,:,:,1), PRCT=PRT(:,:,:,2), &
- PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
- PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR )
-!
- CASE ('KESS')
-!
-!* 5. KESSLER MICROPHYSICAL SCHEME
-! ----------------------------
-!
-!
-!* 5.1 Compute the explicit microphysical sources
-!
- CALL SLOW_TERMS ( KSPLITR, PTSTEP, KMI, HSUBG_AUCV, &
- PZZ, PRHODJ, PRHODREF, PCLDFR, &
- PTHT, PRT(:,:,:,1), PRT(:,:,:,2), PRT(:,:,:,3), PPABST, &
- PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
- PINPRR, PINPRR3D, PEVAP3D )
-!
-!* 5.2 Perform the saturation adjustment
-!
- CALL FAST_TERMS ( KRR, KMI, HRAD, HTURBDIM, &
- HSCONV, HMF_CLOUD, OSUBG_COND, PTSTEP, &
- PRHODJ, PSIGS, PPABST, &
- PCF_MF,PRC_MF, &
- PRVT=PRT(:,:,:,1), PRCT=PRT(:,:,:,2), &
- PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), PRRS=PRS(:,:,:,3), &
- PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR )
-!
-!
- CASE ('C2R2','KHKO')
-!
-!* 7. 2-MOMENT WARM MICROPHYSICAL SCHEME C2R2 or KHKO
-! ---------------------------------------
-!
-!
-!* 7.1 Compute the explicit microphysical sources
-!
-!
- CALL RAIN_C2R2_KHKO ( HCLOUD, OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
- TPFILE, PZZ, PRHODJ, PRHODREF, PEXNREF, &
- PPABST, PTHT, PRT(:,:,:,1), PRT(:,:,:,2), PRT(:,:,:,3), &
- PTHM, PRCM, PPABSTT, &
- PW_ACT,PDTHRAD,PTHS, PRS(:,:,:,1),PRS(:,:,:,2),PRS(:,:,:,3), &
- PSVT(:,:,:,NSV_C2R2BEG), PSVT(:,:,:,NSV_C2R2BEG+1), &
- PSVT(:,:,:,NSV_C2R2BEG+2), PSVS(:,:,:,NSV_C2R2BEG), &
- PSVS(:,:,:,NSV_C2R2BEG+1), PSVS(:,:,:,NSV_C2R2BEG+2), &
- PINPRC, PINPRR, PINPRR3D, PEVAP3D , &
- PSVT(:,:,:,:), PSOLORG, PMI, HACTCCN, &
- PINDEP, PSUPSAT, PNACT )
-!
-!
-!* 7.2 Perform the saturation adjustment
-!
- IF (LSUPSAT) THEN
- CALL KHKO_NOTADJUST (KRR, KTCOUNT,TPFILE, HRAD, &
- PTSTEP, PRHODJ, PPABSTT, PPABST, PRHODREF, PZZ, &
- PTHT,PRT(:,:,:,1),PRT(:,:,:,2),PRT(:,:,:,3), &
- PTHS,PRS(:,:,:,1),PRS(:,:,:,2),PRS(:,:,:,3), &
- PSVS(:,:,:,NSV_C2R2BEG+1), PSVS(:,:,:,NSV_C2R2BEG), &
- PSVS(:,:,:,NSV_C2R2BEG+3), PCLDFR, PSRCS, PNPRO, PSSPRO )
-!
- ELSE
- CALL C2R2_ADJUST ( KRR,TPFILE, HRAD, &
- HTURBDIM, OSUBG_COND, PTSTEP, &
- PRHODJ, PSIGS, PPABST, &
- PTHS=PTHS, PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
- PCNUCS=PSVS(:,:,:,NSV_C2R2BEG), &
- PCCS=PSVS(:,:,:,NSV_C2R2BEG+1), &
- PSRCS=PSRCS, PCLDFR=PCLDFR, PRRS=PRS(:,:,:,3) )
-!
- END IF
-!
- CASE ('ICE3')
-!
-!* 9. MIXED-PHASE MICROPHYSICAL SCHEME (WITH 3 ICE SPECIES)
-! -----------------------------------------------------
-!
- allocate( zexn( size( pzz, 1 ), size( pzz, 2 ), size( pzz, 3 ) ) )
- ZEXN(:,:,:)= (PPABST(:,:,:)/CST%XP00)**(CST%XRD/CST%XCPD)
-!
-!* 9.1 Compute the explicit microphysical sources
-!
-!
- DO JK=IKB,IKE
- ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK)
- ENDDO
- ZZZ = MZF( PZZ )
- IF(LRED .AND. LADJ_BEFORE) THEN
- CALL ICE_ADJUST (YLDIMPHYEX,CST, RAIN_ICE_PARAM, NEB, TURBN, TBUCONF, KRR, &
- CFRAC_ICE_ADJUST, &
- 'ADJU', .FALSE., .FALSE., &
- PTSTEP, ZSIGQSAT2D, &
- PRHODJ, PEXNREF, PRHODREF, PSIGS, LMFCONV,PMFCONV, PPABST, ZZZ, &
- ZEXN, PCF_MF, PRC_MF, PRI_MF, &
- ZDUM, ZDUM, ZDUM, ZDUM, ZDUM, &
- PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
- PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
- PTH=PTHS*PTSTEP, PTHS=PTHS, &
- OCOMPUTE_SRC=SIZE(PSRCS, 3)/=0, PSRCS=PSRCS, PCLDFR=PCLDFR, &
- PRR=PRS(:,:,:,3)*PTSTEP, &
- PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
- PRS=PRS(:,:,:,5)*PTSTEP, &
- PRG=PRS(:,:,:,6)*PTSTEP, &
- TBUDGETS=TBUDGETS,KBUDGETS=SIZE(TBUDGETS), &
- PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
- PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
- ENDIF
- IF (LRED) THEN
- CALL RAIN_ICE (YLDIMPHYEX,CST, PARAM_ICE, RAIN_ICE_PARAM, RAIN_ICE_DESCR,TBUCONF,&
- 0, .FALSE., HSUBG_AUCV, CSUBG_AUCV_RI, &
- PTSTEP, KRR, ZEXN, &
- ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT,PCLDFR,&
- PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
- PTHT, PRT(:,:,:,1), PRT(:,:,:,2), &
- PRT(:,:,:,3), PRT(:,:,:,4), &
- PRT(:,:,:,5), PRT(:,:,:,6), &
- PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
- PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
- PINPRC,PINPRR, PEVAP3D, &
- PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, &
- TBUDGETS,SIZE(TBUDGETS), &
- PSEA,PTOWN, PFPR=ZFPR )
- ELSE
- CALL RAIN_ICE_OLD (YLDIMPHYEX, OSEDIC, CSEDIM, HSUBG_AUCV, OWARM, 1, IKU, 1, &
- KSPLITR, PTSTEP, KRR, &
- ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
- PTHT, PRT(:,:,:,1), PRT(:,:,:,2), &
- PRT(:,:,:,3), PRT(:,:,:,4), &
- PRT(:,:,:,5), PRT(:,:,:,6), &
- PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
- PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
- PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
- PINPRS, PINPRG, PSIGS,PINDEP, PRAINFR, &
- PSEA, PTOWN, PFPR=ZFPR)
- END IF
-
-!
-!* 9.2 Perform the saturation adjustment over cloud ice and cloud water
-!
-!
- IF (.NOT. LRED .OR. (LRED .AND. LADJ_AFTER) ) THEN
- CALL ICE_ADJUST (YLDIMPHYEX,CST, RAIN_ICE_PARAM, NEB, TURBN, TBUCONF, KRR, &
- CFRAC_ICE_ADJUST, &
- 'DEPI', .FALSE., .FALSE., &
- PTSTEP, ZSIGQSAT2D, &
- PRHODJ, PEXNREF, PRHODREF, PSIGS, LMFCONV, PMFCONV,PPABST, ZZZ, &
- ZEXN, PCF_MF, PRC_MF, PRI_MF, &
- ZDUM, ZDUM, ZDUM, ZDUM, ZDUM, &
- PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
- PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
- PTH=PTHS*PTSTEP, PTHS=PTHS, &
- OCOMPUTE_SRC=SIZE(PSRCS, 3)/=0, PSRCS=PSRCS, PCLDFR=PCLDFR, &
- PRR=PRS(:,:,:,3)*PTSTEP, &
- PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
- PRS=PRS(:,:,:,5)*PTSTEP, &
- PRG=PRS(:,:,:,6)*PTSTEP, &
- TBUDGETS=TBUDGETS,KBUDGETS=SIZE(TBUDGETS), &
- PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
- PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
- END IF
-
- deallocate( zexn )
-!
- CASE ('ICE4')
-!
-!* 10. MIXED-PHASE MICROPHYSICAL SCHEME (WITH 4 ICE SPECIES)
-! -----------------------------------------------------
-!
- allocate( zexn( size( pzz, 1 ), size( pzz, 2 ), size( pzz, 3 ) ) )
- ZEXN(:,:,:)= (PPABST(:,:,:)/CST%XP00)**(CST%XRD/CST%XCPD)
-!
-!* 10.1 Compute the explicit microphysical sources
-!
-!
- DO JK=IKB,IKE
- ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK)
- ENDDO
- ZZZ = MZF( PZZ )
- IF(LRED .AND. LADJ_BEFORE) THEN
- CALL ICE_ADJUST (YLDIMPHYEX,CST, RAIN_ICE_PARAM, NEB, TURBN, TBUCONF, KRR, &
- CFRAC_ICE_ADJUST, &
- 'ADJU', .FALSE., .FALSE., &
- PTSTEP, ZSIGQSAT2D, &
- PRHODJ, PEXNREF, PRHODREF, PSIGS, LMFCONV,PMFCONV, PPABST, ZZZ, &
- ZEXN, PCF_MF, PRC_MF, PRI_MF, &
- ZDUM, ZDUM, ZDUM, ZDUM, ZDUM, &
- PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
- PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
- PTH=PTHS*PTSTEP, PTHS=PTHS, &
- OCOMPUTE_SRC=SIZE(PSRCS, 3)/=0, PSRCS=PSRCS, PCLDFR=PCLDFR, &
- PRR=PRS(:,:,:,3)*PTSTEP, &
- PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
- PRS=PRS(:,:,:,5)*PTSTEP, &
- PRG=PRS(:,:,:,6)*PTSTEP, &
- TBUDGETS=TBUDGETS,KBUDGETS=SIZE(TBUDGETS), &
- PRH=PRS(:,:,:,7)*PTSTEP, &
- PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
- PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
- ENDIF
- IF (LRED) THEN
- CALL RAIN_ICE (YLDIMPHYEX,CST, PARAM_ICE, RAIN_ICE_PARAM, RAIN_ICE_DESCR,TBUCONF,&
- 0, .FALSE., HSUBG_AUCV, CSUBG_AUCV_RI, &
- PTSTEP, KRR, ZEXN, &
- ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
- PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
- PTHT, PRT(:,:,:,1), PRT(:,:,:,2), &
- PRT(:,:,:,3), PRT(:,:,:,4), &
- PRT(:,:,:,5), PRT(:,:,:,6), &
- PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
- PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
- PINPRC, PINPRR, PEVAP3D, &
- PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, &
- TBUDGETS,SIZE(TBUDGETS), &
- PSEA, PTOWN, &
- PRT(:,:,:,7), PRS(:,:,:,7), PINPRH, PFPR=ZFPR )
- ELSE
- CALL RAIN_ICE_OLD (YLDIMPHYEX, OSEDIC, CSEDIM, HSUBG_AUCV, OWARM, 1, IKU, 1, &
- KSPLITR, PTSTEP, KRR, &
- ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
- PTHT, PRT(:,:,:,1), PRT(:,:,:,2), &
- PRT(:,:,:,3), PRT(:,:,:,4), &
- PRT(:,:,:,5), PRT(:,:,:,6), &
- PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
- PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
- PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
- PINPRS, PINPRG, PSIGS,PINDEP, PRAINFR, &
- PSEA, PTOWN, &
- PRT(:,:,:,7), PRS(:,:,:,7), PINPRH, PFPR=ZFPR)
- END IF
-
-
-!
-!* 10.2 Perform the saturation adjustment over cloud ice and cloud water
-!
- IF (.NOT. LRED .OR. (LRED .AND. LADJ_AFTER) ) THEN
- CALL ICE_ADJUST (YLDIMPHYEX,CST, RAIN_ICE_PARAM, NEB, TURBN, TBUCONF, KRR, &
- CFRAC_ICE_ADJUST, &
- 'DEPI', .FALSE., .FALSE., &
- PTSTEP, ZSIGQSAT2D, &
- PRHODJ, PEXNREF, PRHODREF, PSIGS, LMFCONV, PMFCONV,PPABST, ZZZ, &
- ZEXN, PCF_MF, PRC_MF, PRI_MF, &
- ZDUM, ZDUM, ZDUM, ZDUM, ZDUM, &
- PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
- PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
- PTH=PTHS*PTSTEP, PTHS=PTHS, &
- OCOMPUTE_SRC=SIZE(PSRCS, 3)/=0, PSRCS=PSRCS, PCLDFR=PCLDFR, &
- PRR=PRS(:,:,:,3)*PTSTEP, &
- PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
- PRS=PRS(:,:,:,5)*PTSTEP, &
- PRG=PRS(:,:,:,6)*PTSTEP, &
- TBUDGETS=TBUDGETS,KBUDGETS=SIZE(TBUDGETS), &
- PRH=PRS(:,:,:,7)*PTSTEP, &
- PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
- PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
- END IF
-
- deallocate( zexn )
-!
-!
-!* 12. 2-MOMENT MIXED-PHASE MICROPHYSICAL SCHEME LIMA
-! --------------------------------------------------------------
-!
-!
-!* 12.1 Compute the explicit microphysical sources
-!
- CASE ('LIMA')
- !
- DO JK=IKB,IKE
- ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK)
- ENDDO
- ZZZ = MZF( PZZ )
- IF (LPTSPLIT) THEN
- CALL LIMA (YLDIMPHYEX,CST,TBUCONF,TBUDGETS,SIZE(TBUDGETS), &
- PTSTEP, &
- PRHODREF, PEXNREF, ZDZZ, &
- PRHODJ, PPABST, &
- NMOD_CCN, NMOD_IFN, NMOD_IMM, &
- PDTHRAD, PTHT, PRT, &
- PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), PW_ACT, &
- PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
- PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, PINPRH, &
- PEVAP3D, PCLDFR, PICEFR, PRAINFR, ZFPR )
- ELSE
-
- IF (OWARM) CALL LIMA_WARM(OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
- TPFILE, KRR, PZZ, PRHODJ, &
- PRHODREF, PEXNREF, PW_ACT, PPABST, &
- PDTHRAD, &
- PTHT, PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
- PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
- PINPRC, PINPRR, PINDEP, PINPRR3D, PEVAP3D )
-!
- IF (NMOM_I.GE.1) CALL LIMA_COLD(CST, OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
- KRR, PZZ, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, PW_ACT, &
- PTHT, PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
- PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
- PINPRS, PINPRG, PINPRH )
-!
- IF (OWARM .AND. NMOM_I.GE.1) CALL LIMA_MIXED(OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
- KRR, PZZ, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, PW_ACT, &
- PTHT, PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
- PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END) )
- ENDIF
-!
-!* 12.2 Perform the saturation adjustment
-!
- IF (LSPRO) THEN
- CALL LIMA_NOTADJUST (KMI, TPFILE, HRAD, &
- PTSTEP, PRHODJ, PPABSTT, PPABST, PRHODREF, PEXNREF, PZZ, &
- PTHT,PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
- PTHS,PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
- PCLDFR, PICEFR, PRAINFR, PSRCS )
- ELSE IF (LPTSPLIT) THEN
- CALL LIMA_ADJUST_SPLIT(YLDIMPHYEX,CST,TBUCONF,TBUDGETS,SIZE(TBUDGETS), &
- KRR, KMI, CCONDENS, CLAMBDA3, &
- OSUBG_COND, OSIGMAS, PTSTEP, PSIGQSAT, &
- PRHODREF, PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, PPABSTT, ZZZ,&
- PDTHRAD, PW_ACT, &
- PRT, PRS, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
- PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
- PTHS, PSRCS, PCLDFR, PICEFR, PRC_MF, PRI_MF, PCF_MF )
- ELSE
- CALL LIMA_ADJUST(KRR, KMI, TPFILE, &
- OSUBG_COND, PTSTEP, &
- PRHODREF, PRHODJ, PEXNREF, PPABST, PPABSTT, &
- PRT, PRS, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
- PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
- PTHS, PSRCS, PCLDFR, PICEFR, PRAINFR )
- ENDIF
-!
-END SELECT
-!
-IF(HCLOUD=='ICE3' .OR. HCLOUD=='ICE4' ) THEN
-! TODO: code a generic routine to update vertical lower and upper levels to 0, a
-! specific value or to IKB or IKE and apply it to every output prognostic variable of physics
- PCIT(:,:,1) = 0.
- PCIT(:,:,IKE+1) = 0.
-
- PINPRC3D=ZFPR(:,:,:,2) / CST%XRHOLW
- PINPRR3D=ZFPR(:,:,:,3) / CST%XRHOLW
- PINPRS3D=ZFPR(:,:,:,5) / CST%XRHOLW
- PINPRG3D=ZFPR(:,:,:,6) / CST%XRHOLW
- IF(KRR==7) PINPRH3D=ZFPR(:,:,:,7) / CST%XRHOLW
- WHERE (PRT(:,:,:,2) > 1.E-04 )
- PSPEEDC=ZFPR(:,:,:,2) / (PRT(:,:,:,2) * PRHODREF(:,:,:))
- ENDWHERE
- WHERE (PRT(:,:,:,3) > 1.E-04 )
- PSPEEDR=ZFPR(:,:,:,3) / (PRT(:,:,:,3) * PRHODREF(:,:,:))
- ENDWHERE
- WHERE (PRT(:,:,:,5) > 1.E-04 )
- PSPEEDS=ZFPR(:,:,:,5) / (PRT(:,:,:,5) * PRHODREF(:,:,:))
- ENDWHERE
- WHERE (PRT(:,:,:,6) > 1.E-04 )
- PSPEEDG=ZFPR(:,:,:,6) / (PRT(:,:,:,6) * PRHODREF(:,:,:))
- ENDWHERE
- IF(KRR==7) THEN
- WHERE (PRT(:,:,:,7) > 1.E-04 )
- PSPEEDH=ZFPR(:,:,:,7) / (PRT(:,:,:,7) * PRHODREF(:,:,:))
- ENDWHERE
- ENDIF
-ENDIF
-
-! Remove non-physical negative values (unnecessary in a perfect world) + corresponding budgets
-call Sources_neg_correct( hcloud, 'NECON', krr, ptstep, ppabst, ptht, prt, pths, prs, psvs, prhodj )
-
-!-------------------------------------------------------------------------------
-!
-!
-!* 13. SWITCH BACK TO THE PROGNOSTIC VARIABLES
-! ---------------------------------------
-!
-PTHS(:,:,:) = PTHS(:,:,:) * PRHODJ(:,:,:)
-!
-DO JRR = 1,KRR
- PRS(:,:,:,JRR) = PRS(:,:,:,JRR) * PRHODJ(:,:,:)
-END DO
-!
-IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN
- DO JSV = ISVBEG, ISVEND
- PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) * PRHODJ(:,:,:)
- ENDDO
-ENDIF
-
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE RESOLVED_CLOUD
--
GitLab