diff --git a/src/arome/aux/modd_misc.F90 b/src/arome/aux/modd_misc.F90
index 42af5c7481910ac498777db35703d1d0b0598f71..02bafe45acd289c59d7be28e0a6e8243d7802305 100644
--- a/src/arome/aux/modd_misc.F90
+++ b/src/arome/aux/modd_misc.F90
@@ -28,7 +28,9 @@ TYPE MISC_t
LOGICAL :: OFLYER=.FALSE. !< MesoNH flyer diagnostic
LOGICAL :: ODIAG_IN_RUN=.FALSE. !< LES diagnostics
LOGICAL :: O2D=.FALSE. !< 2D version of the turbulence
-
+ CHARACTER(LEN=4) :: CELEC='NONE' !< Name of the electricity scheme
+ LOGICAL :: OELEC=.FALSE. !< Lightning prognostic scheme
+ LOGICAL :: OSEDIM_BEARD=.FALSE. !< Switch for effect of electrical forces on sedim.
!These values are computed from the model setup
LOGICAL :: OFLAT !< Flat configuration
diff --git a/src/arome/aux/mode_posnam_phy.F90 b/src/arome/aux/mode_posnam_phy.F90
index 54e63bdc4b2b84e503c720c0e50fa68dd31b8243..8fe3dae2a3e898c57a1995a7433ccb7ee8a65449 100644
--- a/src/arome/aux/mode_posnam_phy.F90
+++ b/src/arome/aux/mode_posnam_phy.F90
@@ -1,19 +1,20 @@
MODULE MODE_POSNAM_PHY
IMPLICIT NONE
CONTAINS
-SUBROUTINE POSNAM_PHY(KUNITNML, CDNAML, LDNEEDNAM, LDFOUND, KLUOUT)
+SUBROUTINE POSNAM_PHY(TFILENAM, CDNAML, LDNEEDNAM, LDFOUND)
!Wrapper to call the AROME version of posnam
+USE MODD_IO, ONLY: TFILEDATA
+
IMPLICIT NONE
-INTEGER, INTENT(IN) :: KUNITNML !< Logical unit to access the namelist
+TYPE(TFILEDATA), INTENT(IN) :: TFILENAM !< Namelist file
CHARACTER(LEN=*), INTENT(IN) :: CDNAML !< Namelist name
LOGICAL, INTENT(IN) :: LDNEEDNAM !< True to abort if namelist is absent
LOGICAL, INTENT(OUT) :: LDFOUND !< True if namelist has been found
-INTEGER, INTENT(IN) :: KLUOUT !< Logical unit for output
#include "posnam.intfb.h"
-CALL POSNAM(KUNITNML, CDNAML)
+CALL POSNAM(TFILENAM%NLU, CDNAML)
LDFOUND=.TRUE. !Posnam aborts if not found
END SUBROUTINE POSNAM_PHY
diff --git a/src/arome/ext/aro_lima.F90 b/src/arome/ext/aro_lima.F90
index 60d4874ebbaec2eab7b22fd007600f78b42ae841..11bae1db68ebc14e480fe320fc62de2f8a0be10c 100644
--- a/src/arome/ext/aro_lima.F90
+++ b/src/arome/ext/aro_lima.F90
@@ -132,7 +132,7 @@ REAL :: ZMASSTOT ! total mass for one water category
REAL :: ZMASSPOS ! total mass for one water category
! after removing the negative values
REAL :: ZRATIO ! ZMASSTOT / ZMASSCOR
-
+REAL :: ZTHVREFZIKB
LOGICAL :: LL_RRR_BUDGET
!
TYPE(TBUDGETDATA), DIMENSION(NBUDGET_SV1+NSV_LIMA-1) :: YLBUDGET
@@ -156,7 +156,12 @@ ZDUM3DS=0.
ZDUM3DG=0.
ZDUM3DH=0.
PINPRH=0.
-
+IF (PHYEX%MISC%CELEC /='NONE') THEN
+CALL ABOR1('ARO_LIMA : CELEC ELECTRICITY SCHEME NOT YET CORRECLY PLUGGED HERE')
+! The following value of ZTHVREFZIKB must be removed from the electricity scheme or computed correctly here
+ELSE
+ ZTHVREFZIKB = 0. ! for electricity use only
+END IF
!
!* 2. TRANSFORMATION INTO PHYSICAL TENDENCIES
@@ -287,9 +292,11 @@ ENDDO
!
!
!
-CALL LIMA (D=YLDIMPHYEX, CST=PHYEX%CST, BUCONF=TBUCONF, TBUDGETS=YLBUDGET, KBUDGETS=SIZE(YLBUDGET), &
- PTSTEP=2*PTSTEP, &
- PRHODREF=PRHODREF, PEXNREF=PEXNREF, PDZZ=PDZZ, &
+CALL LIMA (D=YLDIMPHYEX, CST=PHYEX%CST, ICED=PHYEX%RAIN_ICE_DESCRN, ICEP=PHYEX%RAIN_ICE_PARAMN, &
+ ELECD=PHYEX%ELEC_DESCR, ELECP=PHYEX%ELEC_PARAM, &
+ BUCONF=TBUCONF, TBUDGETS=YLBUDGET, KBUDGETS=SIZE(YLBUDGET), &
+ PTSTEP=2*PTSTEP, OELEC=PHYEX%MISC%OELEC, HCLOUD= 'LIMA', &
+ PRHODREF=PRHODREF, PEXNREF=PEXNREF, PDZZ=PDZZ, PTHVREFZIKB=ZTHVREFZIKB, &
PRHODJ=PRHODJ, PPABST=PPABSM, &
NCCN=NMOD_CCN, NIFN=NMOD_IFN, NIMM=NMOD_IMM, &
PDTHRAD=PDTHRAD, PTHT=PTHT, PRT=PRT, PSVT=PSVT, PW_NU=PW_NU, &
diff --git a/src/arome/ext/aro_rain_ice.F90 b/src/arome/ext/aro_rain_ice.F90
index 8bf8635c2d56e99ccd09f1345643abe6c4649b91..634e842a2dd9b136a479b69cbcb1dacc1035fd6b 100644
--- a/src/arome/ext/aro_rain_ice.F90
+++ b/src/arome/ext/aro_rain_ice.F90
@@ -193,7 +193,7 @@ REAL :: ZMASSPOS ! total mass for one water category
! after removing the negative values
REAL :: ZRATIO ! ZMASSTOT / ZMASSCOR
REAL :: ZTWOTSTEP
-
+REAL :: ZTHVREFZIKB ! for electricity use only
TYPE(TBUDGETDATA), DIMENSION(NBUDGET_RH) :: YLBUDGET !NBUDGET_RH is the one with the highest number
TYPE(DIMPHYEX_t) :: YLDIMPHYEX
LOGICAL, DIMENSION(KLON,1,KLEV) :: LLMICRO
@@ -220,6 +220,12 @@ TLES%LLES_CALL=.FALSE.
ZTWOTSTEP=2*PTSTEP
ZINPRC=0.
PINPRH=0.
+IF (PHYEX%MISC%CELEC /='NONE') THEN
+CALL ABOR1('ARO_RAIN_ICE : CELEC ELECTRICITY SCHEME NOT YET CORRECLY PLUGGED HERE')
+! The following value of ZTHVREFZIKB must be removed from the electricity scheme or computed correctly here
+ELSE
+ ZTHVREFZIKB = 0. ! for electricity use only
+END IF
!Mask to limit computation
IF ( KRR == 7 ) THEN
@@ -358,8 +364,9 @@ ENDDO
!
IF (CMICRO=='ICE4' .AND. PHYEX%PARAM_ICEN%LRED) THEN
CALL RAIN_ICE( YLDIMPHYEX, PHYEX%CST, PHYEX%PARAM_ICEN, PHYEX%RAIN_ICE_PARAMN, &
- & PHYEX%RAIN_ICE_DESCRN, PHYEX%MISC%TBUCONF, &
- & PTSTEP=ZTWOTSTEP, &
+ & PHYEX%RAIN_ICE_DESCRN, PHYEX%ELEC_PARAM, PHYEX%ELEC_DESCR, &
+ & PHYEX%MISC%TBUCONF, OELEC=PHYEX%MISC%OELEC, OSEDIM_BEARD=PHYEX%MISC%OSEDIM_BEARD, &
+ & PTHVREFZIKB=ZTHVREFZIKB, HCLOUD=CMICRO, PTSTEP=ZTWOTSTEP, &
& KRR=KRR, PEXN=PEXNREF, &
& PDZZ=PDZZ, PRHODJ=PRHODJ, PRHODREF=PRHODREF, PEXNREF=PEXNREF,&
& PPABST=PPABSM, PCIT=PCIT, PCLDFR=PCLDFR, &
@@ -380,8 +387,9 @@ IF (CMICRO=='ICE4' .AND. PHYEX%PARAM_ICEN%LRED) THEN
& PRHT=PRT(:,:,:,7), PRHS=PRS(:,:,:,7), PINPRH=PINPRH, PFPR=PFPR)
ELSEIF (CMICRO=='ICE3' .AND. PHYEX%PARAM_ICEN%LRED) THEN
CALL RAIN_ICE( YLDIMPHYEX, PHYEX%CST, PHYEX%PARAM_ICEN, PHYEX%RAIN_ICE_PARAMN, &
- & PHYEX%RAIN_ICE_DESCRN, PHYEX%MISC%TBUCONF, &
- & PTSTEP=ZTWOTSTEP, &
+ & PHYEX%RAIN_ICE_DESCRN, PHYEX%ELEC_PARAM, PHYEX%ELEC_DESCR, &
+ & PHYEX%MISC%TBUCONF, OELEC=PHYEX%MISC%OELEC, OSEDIM_BEARD=PHYEX%MISC%OSEDIM_BEARD, &
+ & PTHVREFZIKB=ZTHVREFZIKB, HCLOUD=CMICRO, PTSTEP=ZTWOTSTEP, &
& KRR=KRR, PEXN=PEXNREF, &
& PDZZ=PDZZ, PRHODJ=PRHODJ, PRHODREF=PRHODREF,PEXNREF=PEXNREF,&
& PPABST=PPABSM, PCIT=PCIT, PCLDFR=PCLDFR, &
diff --git a/src/arome/ext/aro_turb_mnh.F90 b/src/arome/ext/aro_turb_mnh.F90
index 18dd0e0f50a38b42664123c7a8f583383628bcc3..f7dbb2a89ebdf830f646abc42e1465be340e2e2e 100644
--- a/src/arome/ext/aro_turb_mnh.F90
+++ b/src/arome/ext/aro_turb_mnh.F90
@@ -368,7 +368,7 @@ CALL TURB (PHYEX%CST,PHYEX%CSTURB,TBUCONF,PHYEX%TURBN, PHYEX%NEBN, YLDIMPHYEX,YL
& PHYEX%MISC%O2D, PHYEX%MISC%ONOMIXLG, PHYEX%MISC%OFLAT, PHYEX%MISC%OCOUPLES, PHYEX%MISC%OBLOWSNOW,&
& PHYEX%MISC%OIBM, PHYEX%MISC%OFLYER, PHYEX%MISC%OCOMPUTE_SRC, PHYEX%MISC%XRSNOW, &
& PHYEX%MISC%OOCEAN,PHYEX%MISC%ODEEPOC, PHYEX%MISC%ODIAG_IN_RUN, &
- & PHYEX%TURBN%CTURBLEN_CLOUD, CMICRO, &
+ & PHYEX%TURBN%CTURBLEN_CLOUD, CMICRO, PHYEX%MISC%CELEC, &
& ZTWOTSTEP,ZTFILE, &
& ZDXX,ZDYY,ZDZZ,ZDZX,ZDZY,ZZZ, &
& ZDIRCOSXW,ZDIRCOSYW,ZDIRCOSZW,ZCOSSLOPE,ZSINSLOPE, &
diff --git a/src/arome/ext/suphmpa.F90 b/src/arome/ext/suphmpa.F90
index 35ceb6164e74523771d371c78cd12f7b161a24ab..faa7f789ee30b123bd4f47f561019da94a75be9f 100644
--- a/src/arome/ext/suphmpa.F90
+++ b/src/arome/ext/suphmpa.F90
@@ -61,7 +61,7 @@ USE YOMCT0 ,ONLY : LELAM
USE MODD_BUDGET, ONLY : TBUCONF_ASSOCIATE, TBUCONF
USE MODI_INI_PHYEX, ONLY: INI_PHYEX
-
+USE MODD_IO, ONLY : TFILEDATA
! ------------------------------------------------------------------
IMPLICIT NONE
@@ -72,7 +72,7 @@ TYPE(MODEL_GENERAL_CONF_TYPE),INTENT(INOUT):: YDML_GCONF
TYPE(TDYNA), INTENT(IN) :: YDDYNA
TYPE(MODEL_PHYSICS_MF_TYPE),INTENT(INOUT):: YDML_PHY_MF
INTEGER(KIND=JPIM),INTENT(IN) :: KULOUT
-
+TYPE(TFILEDATA) :: TPFILE
! ------------------------------------------------------------------
@@ -115,7 +115,8 @@ IF(LMFSHAL.OR.LEDKF) THEN
ELSE
CSCONV='NONE'
ENDIF
-CALL INI_PHYEX(PHYEX%MISC%CPROGRAM, NULNAM, .TRUE., KULOUT, 0, 1, &
+TPFILE%NLU = NULNAM
+CALL INI_PHYEX(PHYEX%MISC%CPROGRAM, TPFILE, .TRUE., KULOUT, 0, 1, &
ZTSTEP, ZDZMIN, &
CMICRO, CSCONV, CTURB, &
KPRINT=2, &
diff --git a/src/arome/ial_version.json b/src/arome/ial_version.json
index c2b32c3530da8e4b3eb847bcd4ff8fd50788b645..dbff73cfdd4d842cc35a549be85516c6f2c961ad 100644
--- a/src/arome/ial_version.json
+++ b/src/arome/ial_version.json
@@ -17,7 +17,7 @@
"small_3D_alt10":"00148b1",
"small_3D_alt11":"00148b1",
"small_3D_alt12":"00148b1",
- "small_3D_lima":"00148b1",
+ "small_3D_lima":"cd4ccdd8",
"small_3D_np2":"00148b1",
"big_3D":"00148b1"
}
diff --git a/src/common/aux/ini_phyex.F90 b/src/common/aux/ini_phyex.F90
index 95c371288483251224cb7bc880762ee57bac965f..67f3626d061a61be34ef35514c7d107aa4ba61d5 100644
--- a/src/common/aux/ini_phyex.F90
+++ b/src/common/aux/ini_phyex.F90
@@ -1,4 +1,4 @@
-SUBROUTINE INI_PHYEX(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, KFROM, KTO, &
+SUBROUTINE INI_PHYEX(HPROGRAM, TPFILE, LDNEEDNAM, KLUOUT, KFROM, KTO, &
&PTSTEP, PDZMIN, &
&CMICRO, CSCONV, CTURB, &
&LDCHANGEMODEL, LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT, LDINIT, &
@@ -48,6 +48,7 @@ USE MODD_PARAM_LIMA_WARM, ONLY: PARAM_LIMA_WARM
USE MODD_PARAM_LIMA_COLD, ONLY: PARAM_LIMA_COLD
USE MODD_PARAM_LIMA_MIXED, ONLY: PARAM_LIMA_MIXED
USE MODD_NSV, ONLY: TNSV, NSV_ASSOCIATE
+USE MODD_IO, ONLY: TFILEDATA
!
USE MODE_INI_CST, ONLY: INI_CST
USE MODE_INI_RAIN_ICE, ONLY: INI_RAIN_ICE
@@ -86,7 +87,7 @@ USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
IMPLICIT NONE
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM !< Current program
-INTEGER, INTENT(IN) :: KUNITNML !< Logical unit to access the namelist
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE !< Namelist file
LOGICAL, INTENT(IN) :: LDNEEDNAM !< True to abort if namelist is absent
INTEGER, INTENT(IN) :: KLUOUT !< Logical unit for outputs
INTEGER, INTENT(IN) :: KFROM !< Old model number
@@ -163,10 +164,10 @@ IF(CMICRO=='ICE3' .OR. CMICRO=='ICE4' .OR. CMICRO=='LIMA') THEN
ENDIF
ENDIF
- CALL PARAM_ICEN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
+ CALL PARAM_ICEN_INIT(HPROGRAM, TPFILE, LDNEEDNAM, KLUOUT, &
&LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT)
IF(CMICRO=='LIMA') THEN
- CALL PARAM_LIMA_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
+ CALL PARAM_LIMA_INIT(HPROGRAM, TPFILE, LDNEEDNAM, KLUOUT, &
&LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT)
ENDIF
@@ -217,7 +218,7 @@ IF(CSCONV=='EDKF') THEN
IF(LLCHANGEMODEL) CALL PARAM_MFSHALL_GOTO_MODEL(KFROM, KTO)
IF(PRESENT(PHYEX_IN)) PARAM_MFSHALLN=PHYEX_IN%PARAM_MFSHALLN
- CALL PARAM_MFSHALLN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
+ CALL PARAM_MFSHALLN_INIT(HPROGRAM, TPFILE, LDNEEDNAM, KLUOUT, &
&LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT)
IF(LLINIT) THEN
CALL INI_MFSHALL()
@@ -233,7 +234,7 @@ IF(.TRUE.) THEN !Placeholder for configuration without cloud scheme or a differe
IF(LLCHANGEMODEL) CALL NEB_GOTO_MODEL(KFROM, KTO)
IF(PRESENT(PHYEX_IN)) NEBN=PHYEX_IN%NEBN
- CALL NEBN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
+ CALL NEBN_INIT(HPROGRAM, TPFILE, LDNEEDNAM, KLUOUT, &
&LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT)
IF(LLINIT) THEN
!Nothing to do, everything is read from namelist
@@ -255,7 +256,7 @@ IF(CTURB=='TKEL') THEN
CSTURB=PHYEX_IN%CSTURB
ENDIF
- CALL TURBN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
+ CALL TURBN_INIT(HPROGRAM, TPFILE, LDNEEDNAM, KLUOUT, &
&LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT)
IF(LLINIT) THEN
CALL INI_TURB(HPROGRAM)
diff --git a/src/common/aux/modd_dimphyexn.F90 b/src/common/aux/modd_dimphyexn.F90
index cac698c823aa8e03727ee9d744341830f5e9ef9a..f9b5cf5f0a39d20e5345ececc6006b5dc983e5b0 100644
--- a/src/common/aux/modd_dimphyexn.F90
+++ b/src/common/aux/modd_dimphyexn.F90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2022-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.
@@ -53,7 +53,7 @@ TYPE DIMPHYEX_t
! 1: as for Méso-NH, levels are numbered from ground to space
! -1: as for AROME, levels are numbered from space to ground
INTEGER :: NKT ! Array total dimension
- INTEGER :: NKLES ! Total physical k dimension (for LES diag)
+ INTEGER :: NKLES ! Number of vertical levels for LES diagnostics
INTEGER :: NKA ! Near ground array index (is an unphysical level if JPVEXT!=0)
INTEGER :: NKU ! Uppest atmosphere array index (is an unphysical level if JPVEXT!=0)
INTEGER :: NKB ! Near ground physical array index (e.g. equal to 1+JPVEXT if NKL==1)
diff --git a/src/common/aux/modd_io.F90 b/src/common/aux/modd_io.F90
index 56ae6db2b0feebb2decd74b3d29fafaa44a9d1e0..e66f61a044db4a5772afbd09b68ada9a24079613 100644
--- a/src/common/aux/modd_io.F90
+++ b/src/common/aux/modd_io.F90
@@ -30,5 +30,6 @@ TYPE TFILEDATA
INTEGER :: NMODEL = 0 !Model number corresponding to the file (field not always set)
INTEGER,DIMENSION(3) :: NMNHVERSION = (/0,0,0/) !MesoNH version used to create the file
!
+ INTEGER :: NLU = -1 ! logical unit number
END TYPE TFILEDATA
ENDMODULE MODD_IO
diff --git a/src/common/aux/modd_phyex.F90 b/src/common/aux/modd_phyex.F90
index 6b8ddb985f6e7736b12ae3c805788d684e4c377a..493013dda18d51d9f5b16389f2aea34fb9cddaef 100644
--- a/src/common/aux/modd_phyex.F90
+++ b/src/common/aux/modd_phyex.F90
@@ -32,6 +32,8 @@ USE MODD_PARAM_LIMA, ONLY: PARAM_LIMA_t
USE MODD_PARAM_LIMA_WARM, ONLY: PARAM_LIMA_WARM_t
USE MODD_PARAM_LIMA_COLD, ONLY: PARAM_LIMA_COLD_t
USE MODD_PARAM_LIMA_MIXED, ONLY: PARAM_LIMA_MIXED_t
+USE MODD_ELEC_DESCR, ONLY: ELEC_DESCR_t
+USE MODD_ELEC_PARAM, ONLY: ELEC_PARAM_t
USE MODD_NSV, ONLY: NSV_t
USE MODD_MISC, ONLY: MISC_t
!
@@ -52,6 +54,8 @@ TYPE PHYEX_t
TYPE(PARAM_LIMA_WARM_t):: PARAM_LIMA_WARM !< Microphysical factors for LIMA (warm processes)
TYPE(PARAM_LIMA_COLD_t):: PARAM_LIMA_COLD !< Microphysical factors for LIMA (cold processes)
TYPE(PARAM_LIMA_MIXED_t):: PARAM_LIMA_MIXED !< Microphysical factors for LIMA (mixed processes)
+ TYPE(ELEC_DESCR_t) :: ELEC_DESCR ! Electricity descriptive constants
+ TYPE(ELEC_PARAM_t) :: ELEC_PARAM ! Electricity parameters
TYPE(NSV_t) :: TNSV !< NSV indexes
!
! Supplementary strucuture to hold model specific values
diff --git a/src/common/aux/mode_posnam_phy.F90 b/src/common/aux/mode_posnam_phy.F90
index 06a6d49bc62b4bba3487b87af125848b8d868b6e..1b7abf128aff3e0e0be1c41611a196a584b8a51c 100644
--- a/src/common/aux/mode_posnam_phy.F90
+++ b/src/common/aux/mode_posnam_phy.F90
@@ -3,33 +3,33 @@ IMPLICIT NONE
PRIVATE
PUBLIC :: POSNAM_PHY
CONTAINS
-SUBROUTINE POSNAM_PHY(KULNAM, CDNAML, LDNEEDNAM, LDFOUND, KLUOUT)
+SUBROUTINE POSNAM_PHY(TFILENAM, CDNAML, LDNEEDNAM, LDFOUND)
!To position namelist file at correct place for reading namelists
!Code adapted from different sources (ECMWF, ARPIFS, MESO-NH)
USE MODE_MSG, ONLY: NVERB_FATAL, NVERB_WARNING, PRINT_MSG
+USE MODD_IO, ONLY: TFILEDATA
IMPLICIT NONE
-INTEGER, INTENT(IN) :: KULNAM !< Logical unit to access the namelist
+TYPE(TFILEDATA), INTENT(IN) :: TFILENAM !< Namelist file
CHARACTER(LEN=*), INTENT(IN) :: CDNAML !< Namelist name
LOGICAL, INTENT(IN) :: LDNEEDNAM !< True to abort if namelist is absent
LOGICAL, INTENT(OUT) :: LDFOUND !< True if namelist has been found
-INTEGER, INTENT(IN) :: KLUOUT !< Logical unit for output
INTEGER :: IVERB, ILEN, ISTATUS, ISCAN, IND
CHARACTER(LEN=120) :: CLINE
CHARACTER(LEN=1) :: CLTEST
-REWIND(KULNAM)
+REWIND(TFILENAM%NLU)
ILEN=LEN(CDNAML)
LDFOUND=.TRUE.
ISTATUS=0
ISCAN=0
CLINE=' '
DO WHILE(ISTATUS==0 .AND. ISCAN==0)
- READ(KULNAM,'(A)',IOSTAT=ISTATUS) CLINE
+ READ(TFILENAM%NLU,'(A)',IOSTAT=ISTATUS) CLINE
IF(ISTATUS<=-1) THEN
!End of file
LDFOUND=.FALSE.
@@ -54,7 +54,7 @@ DO WHILE(ISTATUS==0 .AND. ISCAN==0)
ENDIF
ENDIF
ENDDO
-BACKSPACE(KULNAM)
+BACKSPACE(TFILENAM%NLU)
END SUBROUTINE POSNAM_PHY
diff --git a/src/common/aux/mode_sources_neg_correct.F90 b/src/common/aux/mode_sources_neg_correct.F90
index 49bf5f75ddcb4a854bb3ddde0bd2c3c37c47be4c..daf1fceaad5bc2765b7f3d106644726714aebf4f 100644
--- a/src/common/aux/mode_sources_neg_correct.F90
+++ b/src/common/aux/mode_sources_neg_correct.F90
@@ -1,12 +1,13 @@
MODULE MODE_SOURCES_NEG_CORRECT
IMPLICIT NONE
CONTAINS
-SUBROUTINE SOURCES_NEG_CORRECT_PHY(D, KSV, HCLOUD, HBUDNAME, KRR, PTSTEP, PPABST, &
+SUBROUTINE SOURCES_NEG_CORRECT_PHY(D, KSV, HCLOUD, HELEC, HBUDNAME, KRR, PTSTEP, PPABST, &
&PTHT, PRT, PRTHS, PRRS, PRSVS, PRHODJ)
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
IMPLICIT NONE
TYPE(DIMPHYEX_t), INTENT(IN) :: D
INTEGER, INTENT(IN) :: KSV ! Number of SV variables
+CHARACTER(lEN=*), INTENT(IN) :: HELEC ! Kind of cloud electricity parameterization
CHARACTER(LEN=*), INTENT(IN) :: HCLOUD ! Kind of cloud parameterization
CHARACTER(LEN=*), INTENT(IN) :: HBUDNAME ! Budget name
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
diff --git a/src/common/aux/modi_ini_phyex.F90 b/src/common/aux/modi_ini_phyex.F90
index 70e2c41ff8bb9941c8439ec64b1d7768d7ad7e4c..99055d15ef654d9e799488b0bdb154732149c461 100644
--- a/src/common/aux/modi_ini_phyex.F90
+++ b/src/common/aux/modi_ini_phyex.F90
@@ -1,7 +1,7 @@
MODULE MODI_INI_PHYEX
IMPLICIT NONE
INTERFACE
-SUBROUTINE INI_PHYEX(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, KFROM, KTO, &
+SUBROUTINE INI_PHYEX(HPROGRAM, TPFILE, LDNEEDNAM, KLUOUT, KFROM, KTO, &
&PTSTEP, PDZMIN, &
&CMICRO, CSCONV, CTURB, &
&LDCHANGEMODEL, LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT, LDINIT, &
@@ -17,11 +17,12 @@ USE MODD_PARAM_MFSHALL_N,ONLY: PARAM_MFSHALL_t
USE MODD_TURB_N, ONLY: TURB_t
USE MODD_CTURB, ONLY: CSTURB_t
USE MODD_NEB_N, ONLY: NEB_t
+USE MODD_IO, ONLY: TFILEDATA
!
IMPLICIT NONE
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM !< Current program
-INTEGER, INTENT(IN) :: KUNITNML !< Logical unit to access the namelist
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE !< Logical unit to access the namelist
LOGICAL, INTENT(IN) :: LDNEEDNAM !< True to abort if namelist is absent
INTEGER, INTENT(IN) :: KLUOUT !< Logical unit for outputs
INTEGER, INTENT(IN) :: KFROM !< Old model number
diff --git a/src/common/micro/lima.F90 b/src/common/micro/lima.F90
index 6665319bc5689b249629c1cf42b6ce5ded85919b..43e886f16530eeb67bd532ef5794ba707e5d39b0 100644
--- a/src/common/micro/lima.F90
+++ b/src/common/micro/lima.F90
@@ -4,15 +4,16 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #####################################################################
-SUBROUTINE LIMA ( D, CST, BUCONF, TBUDGETS, KBUDGETS, &
- PTSTEP, &
- PRHODREF, PEXNREF, PDZZ, &
+SUBROUTINE LIMA ( D, CST, ICED, ICEP, ELECD, ELECP,BUCONF, TBUDGETS, KBUDGETS,&
+ PTSTEP, OELEC, HCLOUD, &
+ PRHODREF, PEXNREF, PDZZ,PTHVREFZIKB, &
PRHODJ, PPABST, &
NCCN, NIFN, NIMM, &
PDTHRAD, PTHT, PRT, PSVT, PW_NU, &
PTHS, PRS, PSVS, &
PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, PINPRH, &
- PEVAP3D, PCLDFR, PICEFR, PPRCFR, PFPR )
+ PEVAP3D, PCLDFR, PICEFR, PPRCFR, PFPR, &
+ PLATHAM_IAGGS, PEFIELDW, PSV_ELEC_T, PSV_ELEC_S )
! #####################################################################
!
!! PURPOSE
@@ -41,18 +42,25 @@ SUBROUTINE LIMA ( D, CST, BUCONF, TBUDGETS, KBUDGETS, &
! P. Wautelet 28/05/2020: bugfix: correct array start for PSVT and PSVS
! P. Wautelet 03/02/2021: budgets: add new source if LIMA splitting: CORR2
! B. Vie 06/2021: add subgrid condensation with LIMA
+! C. Barthe 04/2022: add cloud electrification
+! C. Barthe 03/2023: add CIBU, RDSF and 2 moments for s, g and h in cloud electrification
+!
!-----------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_RAIN_ICE_DESCR_n,ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM_n,ONLY: RAIN_ICE_PARAM_t
+USE MODD_ELEC_PARAM, ONLY: ELEC_PARAM_t
+USE MODD_ELEC_DESCR, ONLY: ELEC_DESCR_t
USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t, NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, &
NBUDGET_RI, NBUDGET_RR, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1
USE MODD_CST, ONLY: CST_t
USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI, &
NSV_LIMA_NI, NSV_LIMA_NS, NSV_LIMA_NG, NSV_LIMA_NH, &
NSV_LIMA_IFN_FREE, NSV_LIMA_IFN_NUCL, NSV_LIMA_IMM_NUCL, NSV_LIMA_HOM_HAZE, &
- NSV_LIMA_BEG
+ NSV_LIMA_BEG, NSV_ELECBEG
USE MODD_PARAM_LIMA, ONLY: NMOD_CCN, NMOD_IFN, NMOD_IMM, LHHONI, &
LFEEDBACKT, NMAXITER, XMRSTEP, XTSTEP_TS, &
LSEDC, LSEDI, XRTMIN, XCTMIN, LDEPOC, XVDEPOC, &
@@ -68,18 +76,27 @@ USE MODE_LIMA_NUCLEATION_PROCS, ONLY: LIMA_NUCLEATION_PROCS
USE MODE_LIMA_SEDIMENTATION, ONLY: LIMA_SEDIMENTATION
USE MODE_LIMA_TENDENCIES, ONLY: LIMA_TENDENCIES
!
+USE MODE_ELEC_TENDENCIES, ONLY : ELEC_TENDENCIES
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(ELEC_PARAM_t), INTENT(IN) :: ELECP ! electrical parameters
+TYPE(ELEC_DESCR_t), INTENT(IN) :: ELECD ! electrical descriptive csts
TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
INTEGER, INTENT(IN) :: KBUDGETS
!
REAL, INTENT(IN) :: PTSTEP ! Time step
!
+LOGICAL, INTENT(IN) :: OELEC ! if true, cloud electrification is activated
+!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
@@ -115,6 +132,12 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Cloud fraction
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Cloud fraction
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PFPR ! Precipitation fluxes in altitude
!
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PLATHAM_IAGGS ! Factor for IAGGS modification due to Efield
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PEFIELDW ! Vertical component of the electric field
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: PSV_ELEC_T ! Charge density at time t
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(INOUT) :: PSV_ELEC_S ! Charge density sources
+!
+REAL, INTENT(IN) :: PTHVREFZIKB ! Reference thv at IKB for electricity
!* 0.2 Declarations of local variables :
!
!
@@ -169,9 +192,15 @@ REAL, DIMENSION(:), ALLOCATABLE :: &
Z_RI_AGGS, Z_CI_AGGS, & ! aggregation of ice on snow (AGGS) : ri, Ni, rs=-ri
Z_TH_DEPG, Z_RG_DEPG, & ! deposition of vapor on graupel (DEPG) : rv=-rg, rg, th
Z_TH_BERFI, Z_RC_BERFI, & ! Bergeron (BERFI) : rc, ri=-rc, th
- Z_TH_RIM, Z_RC_RIM, Z_CC_RIM, Z_RS_RIM, Z_CS_RIM, Z_RG_RIM, & ! cloud droplet riming (RIM) : rc, Nc, rs, Ns, rg, Ng=-Ns, th
+!++cb++
+! Z_TH_RIM, Z_RC_RIM, Z_CC_RIM, Z_RS_RIM, Z_CS_RIM, Z_RG_RIM, & ! cloud droplet riming (RIM) : rc, Nc, rs, Ns, rg, Ng=-Ns, th
+ Z_TH_RIM, Z_CC_RIM, Z_CS_RIM, Z_RC_RIMSS, Z_RC_RIMSG, Z_RS_RIMCG, & ! cloud droplet riming (RIM) : rc, Nc, rs, rg, th
+!--cb--
Z_RI_HMS, Z_CI_HMS, Z_RS_HMS, & ! hallett mossop snow (HMS) : ri, Ni, rs
- Z_TH_ACC, Z_RR_ACC, Z_CR_ACC, Z_RS_ACC, Z_CS_ACC, Z_RG_ACC, & ! rain accretion on aggregates (ACC) : rr, Nr, rs, Ns, rg, Ng=-Ns, th
+!++cb++
+! Z_TH_ACC, Z_RR_ACC, Z_CR_ACC, Z_RS_ACC, Z_CS_ACC, Z_RG_ACC, & ! rain accretion on aggregates (ACC) : rr, Nr, rs, Ns, rg, Ng=-Ns, th
+ Z_TH_ACC, Z_CR_ACC, Z_CS_ACC, Z_RR_ACCSS, Z_RR_ACCSG, Z_RS_ACCRG, & ! rain accretion on aggregates (ACC) : rr, Nr, rs, rg, th
+!--cb--
Z_RS_CMEL, Z_CS_CMEL, & ! conversion-melting (CMEL) : rs, rg=-rs
Z_TH_CFRZ, Z_RR_CFRZ, Z_CR_CFRZ, Z_RI_CFRZ, Z_CI_CFRZ, & ! rain freezing (CFRZ) : rr, Nr, ri, Ni, rg=-rr-ri, th
Z_RI_CIBU, Z_CI_CIBU, & ! collisional ice break-up (CIBU) : ri, Ni, rs=-ri
@@ -188,7 +217,10 @@ REAL, DIMENSION(:), ALLOCATABLE :: &
Z_RG_COHG, Z_CG_COHG, & ! conversion of hail into graupel (COHG) : rg, rh
Z_TH_HMLT, Z_RR_HMLT, Z_CR_HMLT, Z_CH_HMLT, & ! hail melting (HMLT) : rr, Nr, rh=-rr, th
Z_RV_CORR2, Z_RC_CORR2, Z_RR_CORR2, Z_RI_CORR2, &
- Z_CC_CORR2, Z_CR_CORR2, Z_CI_CORR2
+ Z_CC_CORR2, Z_CR_CORR2, Z_CI_CORR2, &
+!++cb+ +
+ Z_RI_HIND, Z_RC_HINC, Z_RV_HENU, Z_RV_HONH
+!--cb--
!
! for the conversion from rain to cloud, we need a 3D variable instead of a 1D packed variable
REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
@@ -224,9 +256,15 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: &
ZTOT_RI_AGGS, ZTOT_CI_AGGS, & ! aggregation of ice on snow (AGGS)
ZTOT_TH_DEPG, ZTOT_RG_DEPG, & ! deposition of vapor on graupel (DEPG)
ZTOT_TH_BERFI, ZTOT_RC_BERFI, & ! Bergeron (BERFI)
- ZTOT_TH_RIM, ZTOT_RC_RIM, ZTOT_CC_RIM, ZTOT_RS_RIM, ZTOT_CS_RIM, ZTOT_RG_RIM, & ! cloud droplet riming (RIM)
+!++cb++
+! ZTOT_TH_RIM, ZTOT_RC_RIM, ZTOT_CC_RIM, ZTOT_RS_RIM, ZTOT_CS_RIM, ZTOT_RG_RIM, & ! cloud droplet riming (RIM)
+ ZTOT_TH_RIM, ZTOT_CC_RIM, ZTOT_CS_RIM, ZTOT_RC_RIMSS, ZTOT_RC_RIMSG, ZTOT_RS_RIMCG, & ! cloud droplet riming (RIM)
+!--cb--
ZTOT_RI_HMS, ZTOT_CI_HMS, ZTOT_RS_HMS, & ! hallett mossop snow (HMS)
- ZTOT_TH_ACC, ZTOT_RR_ACC, ZTOT_CR_ACC, ZTOT_RS_ACC, ZTOT_CS_ACC, ZTOT_RG_ACC, & ! rain accretion on aggregates (ACC)
+!++cb++
+! ZTOT_TH_ACC, ZTOT_RR_ACC, ZTOT_CR_ACC, ZTOT_RS_ACC, ZTOT_CS_ACC, ZTOT_RG_ACC, & ! rain accretion on aggregates (ACC)
+ ZTOT_TH_ACC, ZTOT_CR_ACC, ZTOT_CS_ACC, ZTOT_RR_ACCSS, ZTOT_RR_ACCSG, ZTOT_RS_ACCRG, & ! rain accretion on aggregates (ACC)
+!--cb--
ZTOT_RS_CMEL, ZTOT_CS_CMEL, & ! conversion-melting (CMEL)
ZTOT_TH_CFRZ, ZTOT_RR_CFRZ, ZTOT_CR_CFRZ, ZTOT_RI_CFRZ, ZTOT_CI_CFRZ, & ! rain freezing (CFRZ)
ZTOT_RI_CIBU, ZTOT_CI_CIBU, & ! collisional ice break-up (CIBU)
@@ -244,7 +282,10 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: &
ZTOT_TH_HMLT, ZTOT_RR_HMLT, ZTOT_CR_HMLT, ZTOT_CH_HMLT, & ! hail melting (HMLT)
ZTOT_RR_CVRC, ZTOT_CR_CVRC, & ! conversion of rain into cloud droplets if diameter too small
ZTOT_RV_CORR2, ZTOT_RC_CORR2, ZTOT_RR_CORR2, ZTOT_RI_CORR2, &
- ZTOT_CC_CORR2, ZTOT_CR_CORR2, ZTOT_CI_CORR2
+ ZTOT_CC_CORR2, ZTOT_CR_CORR2, ZTOT_CI_CORR2, &
+!++cb++
+ ZTOT_RI_HIND, ZTOT_RC_HINC, ZTOT_RV_HENU, ZTOT_RV_HONH
+!--cb--
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTOT_IFNN_IMLT
!
@@ -294,6 +335,16 @@ INTEGER :: ISV_LIMA_IFN_NUCL
INTEGER :: ISV_LIMA_IMM_NUCL
INTEGER :: ISV_LIMA_HOM_HAZE
!
+! Variables for the electrification scheme
+LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: GMASK_ELEC
+INTEGER :: JL ! loop index
+INTEGER :: IELEC ! nb of points where the electrification scheme may apply
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZQPIT, ZQNIT, ZQCT, ZQRT, ZQIT, ZQST, ZQGT, ZQHT
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZQPIS, ZQNIS, ZQCS, ZQRS, ZQIS, ZQSS, ZQGS, ZQHS
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRVT_ELEC, ZRCT_ELEC, ZRRT_ELEC, ZRIT_ELEC, ZRST_ELEC, ZRGT_ELEC, ZRHT_ELEC
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCCT_ELEC, ZCRT_ELEC, ZCIT_ELEC, ZCST_ELEC, ZCGT_ELEC, ZCHT_ELEC
+REAL, DIMENSION(:), ALLOCATABLE :: ZLATHAM_IAGGS
+!
!-------------------------------------------------------------------------------
!
!* 0. Init
@@ -354,7 +405,9 @@ ZIMMNS(:,:,:,:) = 0.
ZHOMFT(:,:,:) = 0.
ZHOMFS(:,:,:) = 0.
-if ( BUCONF%lbu_enable ) then
+!++cb++
+if ( BUCONF%lbu_enable .OR. OELEC) then
+!--cb--
Z_RR_CVRC(:,:,:) = 0.
Z_CR_CVRC(:,:,:) = 0.
allocate( ZTOT_CR_BRKU (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_BRKU(:,:,:) = 0.
@@ -395,21 +448,31 @@ if ( BUCONF%lbu_enable ) then
allocate( ZTOT_RG_DEPG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RG_DEPG(:,:,:) = 0.
allocate( ZTOT_TH_BERFI(size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_BERFI(:,:,:) = 0.
allocate( ZTOT_RC_BERFI(size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_BERFI(:,:,:) = 0.
+!++cb++ need rcrimss, rcrimsg and rsrimcg to be consistent with ice3
allocate( ZTOT_TH_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_RIM(:,:,:) = 0.
- allocate( ZTOT_RC_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_RIM(:,:,:) = 0.
+! allocate( ZTOT_RC_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_RIM(:,:,:) = 0.
allocate( ZTOT_CC_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CC_RIM(:,:,:) = 0.
- allocate( ZTOT_RS_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_RIM(:,:,:) = 0.
+! allocate( ZTOT_RS_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_RIM(:,:,:) = 0.
allocate( ZTOT_CS_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CS_RIM(:,:,:) = 0.
- allocate( ZTOT_RG_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RG_RIM(:,:,:) = 0.
+! allocate( ZTOT_RG_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RG_RIM(:,:,:) = 0.
+ allocate( ZTOT_RC_RIMSS (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_RIMSS(:,:,:) = 0.
+ allocate( ZTOT_RC_RIMSG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_RIMSG(:,:,:) = 0.
+ allocate( ZTOT_RS_RIMCG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_RIMCG(:,:,:) = 0.
+!--cb--
allocate( ZTOT_RI_HMS (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RI_HMS(:,:,:) = 0.
allocate( ZTOT_CI_HMS (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CI_HMS(:,:,:) = 0.
allocate( ZTOT_RS_HMS (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_HMS(:,:,:) = 0.
+!++cb++ need rraccss, rraccsg and rsaccrg to be consistent with ice3
allocate( ZTOT_TH_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_ACC(:,:,:) = 0.
- allocate( ZTOT_RR_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_ACC(:,:,:) = 0.
+! allocate( ZTOT_RR_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_ACC(:,:,:) = 0.
allocate( ZTOT_CR_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_ACC(:,:,:) = 0.
- allocate( ZTOT_RS_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_ACC(:,:,:) = 0.
+! allocate( ZTOT_RS_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_ACC(:,:,:) = 0.
allocate( ZTOT_CS_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CS_ACC(:,:,:) = 0.
- allocate( ZTOT_RG_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RG_ACC(:,:,:) = 0.
+! allocate( ZTOT_RG_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RG_ACC(:,:,:) = 0.
+ allocate( ZTOT_RR_ACCSS(size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_ACCSS(:,:,:) = 0.
+ allocate( ZTOT_RR_ACCSG(size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_ACCSG(:,:,:) = 0.
+ allocate( ZTOT_RS_ACCRG(size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_ACCRG(:,:,:) = 0.
+!--cb--
allocate( ZTOT_RS_CMEL (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_CMEL(:,:,:) = 0.
allocate( ZTOT_CS_CMEL (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CS_CMEL(:,:,:) = 0.
allocate( ZTOT_TH_CFRZ (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_CFRZ(:,:,:) = 0.
@@ -482,6 +545,13 @@ if ( BUCONF%lbu_enable ) then
allocate( ZTOT_CI_CORR2 (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CI_CORR2(:,:,:) = 0.
END IF
!
+!++cb++ necessaire pour l'electricite
+ALLOCATE (ZTOT_RI_HIND(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3))) ; ZTOT_RI_HIND(:,:,:) = 0.
+ALLOCATE (ZTOT_RC_HINC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3))) ; ZTOT_RC_HINC(:,:,:) = 0.
+ALLOCATE (ZTOT_RV_HENU(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3))) ; ZTOT_RV_HENU(:,:,:) = 0.
+ALLOCATE (ZTOT_RV_HONH(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3))) ; ZTOT_RV_HONH(:,:,:) = 0.
+!--cb--
+!
! Initial values computed as source * PTSTEP
!
! Mixing ratios
@@ -542,6 +612,69 @@ ZINV_TSTEP = 1./PTSTEP
ZEXN(:,:,:) = (PPABST(:,:,:)/CST%XP00)**(CST%XRD/CST%XCPD)
ZT(:,:,:) = ZTHT(:,:,:) * ZEXN(:,:,:)
!
+! Electric charge density
+!
+IF (OELEC) THEN
+ ALLOCATE(ZQPIT(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZQCT(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZQRT(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZQIT(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZQST(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZQGT(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZQNIT(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ IF (KRR == 7) ALLOCATE(ZQHT(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ !
+ ALLOCATE(ZQPIS(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZQCS(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZQRS(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZQIS(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZQSS(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZQGS(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZQNIS(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ IF (KRR == 7) ALLOCATE(ZQHS(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ !
+ ALLOCATE(ZRVT_ELEC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZRCT_ELEC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZRRT_ELEC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZRIT_ELEC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZRST_ELEC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZRGT_ELEC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ IF (KRR == 7) ALLOCATE(ZRHT_ELEC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZCCT_ELEC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZCRT_ELEC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZCIT_ELEC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZCST_ELEC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ ALLOCATE(ZCGT_ELEC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ IF (KRR == 7) ALLOCATE(ZCHT_ELEC(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+!
+!++cb++ 21/04/23 source * ptstep
+ ZQPIT(:,:,:) = PSV_ELEC_S(:,:,:,1) * PTSTEP
+ ZQCT(:,:,:) = PSV_ELEC_S(:,:,:,2) * PTSTEP
+ ZQRT(:,:,:) = PSV_ELEC_S(:,:,:,3) * PTSTEP
+ ZQIT(:,:,:) = PSV_ELEC_S(:,:,:,4) * PTSTEP
+ ZQST(:,:,:) = PSV_ELEC_S(:,:,:,5) * PTSTEP
+ ZQGT(:,:,:) = PSV_ELEC_S(:,:,:,6) * PTSTEP
+ IF (KRR == 6) THEN
+ ZQNIT(:,:,:) = PSV_ELEC_S(:,:,:,7) * PTSTEP
+ ELSE IF (KRR == 7) THEN
+ ZQHT(:,:,:) = PSV_ELEC_S(:,:,:,7) * PTSTEP
+ ZQNIT(:,:,:) = PSV_ELEC_S(:,:,:,8) * PTSTEP
+ END IF
+ !
+ ZQPIS(:,:,:) = PSV_ELEC_S(:,:,:,1)
+ ZQCS(:,:,:) = PSV_ELEC_S(:,:,:,2)
+ ZQRS(:,:,:) = PSV_ELEC_S(:,:,:,3)
+ ZQIS(:,:,:) = PSV_ELEC_S(:,:,:,4)
+ ZQSS(:,:,:) = PSV_ELEC_S(:,:,:,5)
+ ZQGS(:,:,:) = PSV_ELEC_S(:,:,:,6)
+ IF (KRR == 6) THEN
+ ZQNIS(:,:,:) = PSV_ELEC_S(:,:,:,7)
+ ELSE IF (KRR == 7) THEN
+ ZQHS(:,:,:) = PSV_ELEC_S(:,:,:,7)
+ ZQNIS(:,:,:) = PSV_ELEC_S(:,:,:,8)
+ END IF
+END IF
+!
!-------------------------------------------------------------------------------
!
!* 0. Check mean diameter for cloud, rain and ice
@@ -625,20 +758,20 @@ PINPRS=0.
PINPRG=0.
PINPRH=0.
if ( BUCONF%lbu_enable ) then
- if ( BUCONF%lbudget_th ) &
- call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_TH), 'SEDI', zths(:, :, :) * prhodj(:, :, :) )
- if ( BUCONF%lbudget_rc .and. nmom_c.ge.1 .and. lsedc ) &
- call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), 'SEDI', zrcs(:, :, :) * prhodj(:, :, :) )
- if ( BUCONF%lbudget_rr .and. nmom_r.ge.1 ) &
- call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RR), 'SEDI', zrrs(:, :, :) * prhodj(:, :, :) )
- if ( BUCONF%lbudget_ri .and. nmom_i.ge.1 .and. lsedi ) &
- call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RI), 'SEDI', zris(:, :, :) * prhodj(:, :, :) )
- if ( BUCONF%lbudget_rs .and. nmom_s.ge.1 ) &
- call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RS), 'SEDI', zrss(:, :, :) * prhodj(:, :, :) )
- if ( BUCONF%lbudget_rg .and. nmom_g.ge.1 ) &
- call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RG), 'SEDI', zrgs(:, :, :) * prhodj(:, :, :) )
- if ( BUCONF%lbudget_rh .and. nmom_h.ge.1 ) &
- call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RH), 'SEDI', zrhs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_th ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_TH), 'SEDI', zths(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rc .and. nmom_c.ge.1 .and. lsedc ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RC), 'SEDI', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rr .and. nmom_r.ge.1 ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RR), 'SEDI', zrrs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_ri .and. nmom_i.ge.1 .and. lsedi ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RI), 'SEDI', zris(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rs .and. nmom_s.ge.1 ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RS), 'SEDI', zrss(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rg .and. nmom_g.ge.1 ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RG), 'SEDI', zrgs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rh .and. nmom_h.ge.1 ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RH), 'SEDI', zrhs(:, :, :) * prhodj(:, :, :) )
if ( BUCONF%lbudget_sv ) then
if ( lsedc .and. nmom_c.ge.2) &
call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SEDI', zccs(:, :, :) * prhodj(:, :, :) )
@@ -652,53 +785,132 @@ if ( BUCONF%lbu_enable ) then
call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_ng), 'SEDI', zcgs(:, :, :) * prhodj(:, :, :) )
if ( nmom_h.ge.2) &
call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nh), 'SEDI', zchs(:, :, :) * prhodj(:, :, :) )
+ !
+ if (oelec) then
+ if ( lsedc ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_elecbeg + 1), 'SEDI', zqcs(:, :, :) * prhodj(:, :, :) )
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_elecbeg + 2), 'SEDI', zqrs(:, :, :) * prhodj(:, :, :) )
+ if ( lsedi ) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_elecbeg + 3), 'SEDI', zqis(:, :, :) * prhodj(:, :, :) )
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_elecbeg + 4), 'SEDI', zqss(:, :, :) * prhodj(:, :, :) )
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_elecbeg + 5), 'SEDI', zqgs(:, :, :) * prhodj(:, :, :) )
+ if (nmom_h .ge. 1) &
+ call BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_elecbeg + 6), 'SEDI', zqhs(:, :, :) * prhodj(:, :, :) )
+ end if
end if
end if
+!
PFPR(:,:,:,:)=0.
+!
+! sedimentation of cloud droplets
ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
ZCPT = CST%XCPD + (CST%XCPV * ZRVS + CST%XCL * (ZRCS + ZRRS) + CST%XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
-IF (NMOM_C.GE.1 .AND. LSEDC) CALL LIMA_SEDIMENTATION(D, CST, &
- 'L', 2, 2, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRCS, ZCCS, PINPRC, PFPR(:,:,:,2))
+IF (NMOM_C.GE.1 .AND. LSEDC) THEN
+ IF (OELEC) THEN
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'L', 2, 2, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PTHVREFZIKB, PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRCS, ZCCS, PINPRC, PFPR(:,:,:,2), PEFIELDW, ZQCS)
+ ELSE
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'L', 2, 2, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PTHVREFZIKB, PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRCS, ZCCS, PINPRC, PFPR(:,:,:,2))
+ END IF
+END IF
+!
+! sedimentation of raindrops
ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
ZCPT = CST%XCPD + (CST%XCPV * ZRVS + CST%XCL * (ZRCS + ZRRS) + CST%XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
-IF (NMOM_R.GE.1) CALL LIMA_SEDIMENTATION(D, CST, &
- 'L', NMOM_R, 3, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRRS, ZCRS, PINPRR, PFPR(:,:,:,3))
+IF (NMOM_R.GE.1) THEN
+ IF (OELEC) THEN
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'L', NMOM_R, 3, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PTHVREFZIKB,PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRRS, ZCRS, PINPRR, PFPR(:,:,:,3), PEFIELDW, ZQRS)
+ ELSE
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'L', NMOM_R, 3, 1, PTSTEP, OELEC, PDZZ, PRHODREF,PTHVREFZIKB, PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRRS, ZCRS, PINPRR, PFPR(:,:,:,3))
+ END IF
+END IF
+!
+! sedimentation of ice crystals
ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
ZCPT = CST%XCPD + (CST%XCPV * ZRVS + CST%XCL * (ZRCS + ZRRS) + CST%XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
-IF (NMOM_I.GE.1 .AND. LSEDI) CALL LIMA_SEDIMENTATION(D, CST, &
- 'I', NMOM_I, 4, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRIS, ZCIS, ZW2D, PFPR(:,:,:,4))
+IF (NMOM_I.GE.1 .AND. LSEDI) THEN
+ IF (OELEC) THEN
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'I', NMOM_I, 4, 1, PTSTEP, OELEC, PDZZ, PRHODREF,PTHVREFZIKB, PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRIS, ZCIS, ZW2D, PFPR(:,:,:,4), PEFIELDW, ZQIS)
+ ELSE
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'I', NMOM_I, 4, 1, PTSTEP, OELEC, PDZZ, PRHODREF,PTHVREFZIKB, PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRIS, ZCIS, ZW2D, PFPR(:,:,:,4))
+ END IF
+END IF
+!
+! sedimentation of snow/aggregates
ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
ZCPT = CST%XCPD + (CST%XCPV * ZRVS + CST%XCL * (ZRCS + ZRRS) + CST%XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
-IF (NMOM_S.GE.1) CALL LIMA_SEDIMENTATION(D, CST, &
- 'I', NMOM_S, 5, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRSS, ZCSS, PINPRS, PFPR(:,:,:,5))
+IF (NMOM_S.GE.1) THEN
+ IF (OELEC) THEN
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'I', NMOM_S, 5, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PTHVREFZIKB, PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRSS, ZCSS, PINPRS, PFPR(:,:,:,5), PEFIELDW, ZQSS)
+ ELSE
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'I', NMOM_S, 5, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PTHVREFZIKB, PPABST,ZT, ZRT_SUM, ZCPT, &
+ ZRSS, ZCSS, PINPRS, PFPR(:,:,:,5))
+ END IF
+END IF
+!
+! sedimentation of graupel
ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
ZCPT = CST%XCPD + (CST%XCPV * ZRVS + CST%XCL * (ZRCS + ZRRS) + CST%XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
-IF (NMOM_G.GE.1) CALL LIMA_SEDIMENTATION(D, CST, &
- 'I', NMOM_G, 6, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRGS, ZCGS, PINPRG, PFPR(:,:,:,6))
+IF (NMOM_G.GE.1) THEN
+ IF (OELEC) THEN
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'I', NMOM_G, 6, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PTHVREFZIKB, PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRGS, ZCGS, PINPRG, PFPR(:,:,:,6), PEFIELDW, ZQGS)
+ ELSE
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'I', NMOM_G, 6, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PTHVREFZIKB, PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRGS, ZCGS, PINPRG, PFPR(:,:,:,6))
+ END IF
+END IF
+!
+! sedimentation of hail
ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
ZCPT = CST%XCPD + (CST%XCPV * ZRVS + CST%XCL * (ZRCS + ZRRS) + CST%XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
-IF (NMOM_H.GE.1) CALL LIMA_SEDIMENTATION(D, CST, &
- 'I', NMOM_H, 7, 1, PTSTEP, PDZZ, PRHODREF, PPABST, ZT, ZRT_SUM, ZCPT, ZRHS, ZCHS, PINPRH, PFPR(:,:,:,7))
+IF (NMOM_H.GE.1) THEN
+ IF (OELEC) THEN
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'I', NMOM_H, 7, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PTHVREFZIKB, PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRHS, ZCHS, PINPRH, PFPR(:,:,:,7), PEFIELDW, ZQHS)
+ ELSE
+ CALL LIMA_SEDIMENTATION(D, CST, ICED, HCLOUD, &
+ 'I', NMOM_H, 7, 1, PTSTEP, OELEC, PDZZ, PRHODREF, PTHVREFZIKB, PPABST, ZT, ZRT_SUM, ZCPT, &
+ ZRHS, ZCHS, PINPRH, PFPR(:,:,:,7))
+ END IF
+END IF
!
ZTHS(:,:,:) = ZT(:,:,:) / ZEXN(:,:,:) * ZINV_TSTEP
!
! Call budgets
!
if ( BUCONF%lbu_enable ) then
- if ( BUCONF%lbudget_th ) &
- call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TH), 'SEDI', zths(:, :, :) * prhodj(:, :, :) )
- if ( BUCONF%lbudget_rc .and. nmom_c.ge.1 .and. lsedc ) &
- call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RC), 'SEDI', zrcs(:, :, :) * prhodj(:, :, :) )
- if ( BUCONF%lbudget_rr .and. nmom_r.ge.2 ) &
- call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RR), 'SEDI', zrrs(:, :, :) * prhodj(:, :, :) )
- if ( BUCONF%lbudget_ri .and. nmom_i.ge.1 .and. lsedi ) &
- call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RI), 'SEDI', zris(:, :, :) * prhodj(:, :, :) )
- if ( BUCONF%lbudget_rs .and. nmom_s.ge.1 ) &
- call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RS), 'SEDI', zrss(:, :, :) * prhodj(:, :, :) )
- if ( BUCONF%lbudget_rg .and. nmom_g.ge.1 ) &
- call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RG), 'SEDI', zrgs(:, :, :) * prhodj(:, :, :) )
- if ( BUCONF%lbudget_rh .and. nmom_h.ge.1 ) &
- call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RH), 'SEDI', zrhs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_th ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TH), 'SEDI', zths(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rc .and. nmom_c.ge.1 .and. lsedc ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RC), 'SEDI', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rr .and. nmom_r.ge.1 ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RR), 'SEDI', zrrs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_ri .and. nmom_i.ge.1 .and. lsedi ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RI), 'SEDI', zris(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rs .and. nmom_s.ge.1 ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RS), 'SEDI', zrss(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rg .and. nmom_g.ge.1 ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RG), 'SEDI', zrgs(:, :, :) * prhodj(:, :, :) )
+ if ( BUCONF%lbudget_rh .and. nmom_h.ge.1 ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RH), 'SEDI', zrhs(:, :, :) * prhodj(:, :, :) )
if ( BUCONF%lbudget_sv ) then
if ( lsedc .and. nmom_c.ge.2 ) &
call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SEDI', zccs(:, :, :) * prhodj(:, :, :) )
@@ -712,6 +924,18 @@ if ( BUCONF%lbu_enable ) then
call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_ng), 'SEDI', zcgs(:, :, :) * prhodj(:, :, :) )
if ( nmom_h.ge.2 ) &
call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_lima_nh), 'SEDI', zchs(:, :, :) * prhodj(:, :, :) )
+!
+ if (oelec) then
+ if ( lsedc ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_elecbeg + 1), 'SEDI', zqcs(:, :, :) * prhodj(:, :, :) )
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_elecbeg + 2), 'SEDI', zqrs(:, :, :) * prhodj(:, :, :) )
+ if ( lsedi ) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_elecbeg + 3), 'SEDI', zqis(:, :, :) * prhodj(:, :, :) )
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_elecbeg + 4), 'SEDI', zqss(:, :, :) * prhodj(:, :, :) )
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_elecbeg + 5), 'SEDI', zqgs(:, :, :) * prhodj(:, :, :) )
+ if (nmom_h .ge. 1) &
+ call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + nsv_elecbeg + 6), 'SEDI', zqhs(:, :, :) * prhodj(:, :, :) )
+ end if
end if
end if
!
@@ -786,6 +1010,15 @@ IF ( NMOM_I.GE.2 ) ZCIT(:,:,:) = ZCIS(:,:,:) * PTSTEP
IF ( NMOM_S.GE.2 ) ZCST(:,:,:) = ZCSS(:,:,:) * PTSTEP
IF ( NMOM_G.GE.2 ) ZCGT(:,:,:) = ZCGS(:,:,:) * PTSTEP
IF ( NMOM_H.GE.2 ) ZCHT(:,:,:) = ZCHS(:,:,:) * PTSTEP
+!
+IF (OELEC) THEN
+ ZQCT(:,:,:) = ZQCS(:,:,:) * PTSTEP
+ ZQRT(:,:,:) = ZQRS(:,:,:) * PTSTEP
+ ZQIT(:,:,:) = ZQIS(:,:,:) * PTSTEP
+ ZQST(:,:,:) = ZQSS(:,:,:) * PTSTEP
+ ZQGT(:,:,:) = ZQGS(:,:,:) * PTSTEP
+ IF (NMOM_H .GE. 1) ZQHT(:,:,:) = ZQHS(:,:,:) * PTSTEP
+END IF
!
!-------------------------------------------------------------------------------
!
@@ -801,6 +1034,7 @@ CALL LIMA_COMPUTE_CLOUD_FRACTIONS (D, &
ZCHT, ZRHT, &
PCLDFR, PICEFR, PPRCFR )
!
+!
!-------------------------------------------------------------------------------
!
!* 2. Nucleation processes
@@ -812,7 +1046,8 @@ CALL LIMA_NUCLEATION_PROCS (D, CST, BUCONF, TBUDGETS, KBUDGETS,
ZTHT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZRHT, &
ZCCT, ZCRT, ZCIT, &
ZCCNFT, ZCCNAT, ZIFNFT, ZIFNNT, ZIMMNT, ZHOMFT, &
- PCLDFR, PICEFR, PPRCFR )
+ PCLDFR, PICEFR, PPRCFR, &
+ ZTOT_RV_HENU, ZTOT_RC_HINC, ZTOT_RI_HIND, ZTOT_RV_HONH)
!
! Saving sources before microphysics time-splitting loop
!
@@ -841,6 +1076,21 @@ ZHOMFS(:,:,:) = ZHOMFT(:,:,:) *ZINV_TSTEP
ZTHS(:,:,:) = ZTHT(:,:,:) *ZINV_TSTEP
ZT(:,:,:) = ZTHT(:,:,:) * ZEXN(:,:,:)
!
+IF (OELEC) THEN
+ ZRVT_ELEC(:,:,:) = ZRVT(:,:,:)
+ ZRCT_ELEC(:,:,:) = ZRCT(:,:,:)
+ ZRRT_ELEC(:,:,:) = ZRRT(:,:,:)
+ ZRIT_ELEC(:,:,:) = ZRIT(:,:,:)
+ ZRST_ELEC(:,:,:) = ZRST(:,:,:)
+ ZRGT_ELEC(:,:,:) = ZRGT(:,:,:)
+ IF (NMOM_H .GE. 1) ZRHT_ELEC(:,:,:) = ZRHT(:,:,:)
+ IF (NMOM_C .GE. 2) ZCCT_ELEC(:,:,:) = ZCCT(:,:,:)
+ IF (NMOM_R .GE. 2) ZCRT_ELEC(:,:,:) = ZCRT(:,:,:)
+ IF (NMOM_I .GE. 2) ZCIT_ELEC(:,:,:) = ZCIT(:,:,:)
+ IF (NMOM_S .GE. 2) ZCST_ELEC(:,:,:) = ZCST(:,:,:)
+ IF (NMOM_G .GE. 2) ZCGT_ELEC(:,:,:) = ZCGT(:,:,:)
+ IF (NMOM_H .GE. 2) ZCHT_ELEC(:,:,:) = ZCHT(:,:,:)
+END IF
!
!-------------------------------------------------------------------------------
!
@@ -932,6 +1182,7 @@ DO WHILE(ANY(ZTIME(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)<PTSTEP))
ALLOCATE(ZCF1D(IPACK))
ALLOCATE(ZIF1D(IPACK))
ALLOCATE(ZPF1D(IPACK))
+ ALLOCATE(ZLATHAM_IAGGS(IPACK))
IPACK = COUNTJV(LLCOMPUTE,I1,I2,I3)
DO II=1,IPACK
ZRHODREF1D(II) = PRHODREF(I1(II),I2(II),I3(II))
@@ -968,6 +1219,11 @@ DO WHILE(ANY(ZTIME(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)<PTSTEP))
ZCF1D(II) = PCLDFR(I1(II),I2(II),I3(II))
ZIF1D(II) = PICEFR(I1(II),I2(II),I3(II))
ZPF1D(II) = PPRCFR(I1(II),I2(II),I3(II))
+ IF (OELEC) THEN
+ ZLATHAM_IAGGS(II) = PLATHAM_IAGGS(I1(II),I2(II),I3(II))
+ ELSE
+ ZLATHAM_IAGGS(II) = 1.0
+ END IF
END DO
!
WHERE(ZCF1D(:)<1.E-10 .AND. ZRCT1D(:)>XRTMIN(2) .AND. ZCCT1D(:)>XCTMIN(2)) ZCF1D(:)=1.
@@ -1048,21 +1304,31 @@ DO WHILE(ANY(ZTIME(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)<PTSTEP))
ALLOCATE(Z_RG_DEPG(IPACK)) ; Z_RG_DEPG(:) = 0.
ALLOCATE(Z_TH_BERFI(IPACK)) ; Z_TH_BERFI(:) = 0.
ALLOCATE(Z_RC_BERFI(IPACK)) ; Z_RC_BERFI(:) = 0.
+!++cb++
ALLOCATE(Z_TH_RIM(IPACK)) ; Z_TH_RIM(:) = 0.
- ALLOCATE(Z_RC_RIM(IPACK)) ; Z_RC_RIM(:) = 0.
+! ALLOCATE(Z_RC_RIM(IPACK)) ; Z_RC_RIM(:) = 0.
ALLOCATE(Z_CC_RIM(IPACK)) ; Z_CC_RIM(:) = 0.
- ALLOCATE(Z_RS_RIM(IPACK)) ; Z_RS_RIM(:) = 0.
+! ALLOCATE(Z_RS_RIM(IPACK)) ; Z_RS_RIM(:) = 0.
ALLOCATE(Z_CS_RIM(IPACK)) ; Z_CS_RIM(:) = 0.
- ALLOCATE(Z_RG_RIM(IPACK)) ; Z_RG_RIM(:) = 0.
+! ALLOCATE(Z_RG_RIM(IPACK)) ; Z_RG_RIM(:) = 0.
+ ALLOCATE(Z_RC_RIMSS(IPACK)) ; Z_RC_RIMSS = 0.
+ ALLOCATE(Z_RC_RIMSG(IPACK)) ; Z_RC_RIMSG = 0.
+ ALLOCATE(Z_RS_RIMCG(IPACK)) ; Z_RS_RIMCG = 0.
+!--cb--
ALLOCATE(Z_RI_HMS(IPACK)) ; Z_RI_HMS(:) = 0.
ALLOCATE(Z_CI_HMS(IPACK)) ; Z_CI_HMS(:) = 0.
ALLOCATE(Z_RS_HMS(IPACK)) ; Z_RS_HMS(:) = 0.
+!++cb++
ALLOCATE(Z_TH_ACC(IPACK)) ; Z_TH_ACC(:) = 0.
- ALLOCATE(Z_RR_ACC(IPACK)) ; Z_RR_ACC(:) = 0.
+! ALLOCATE(Z_RR_ACC(IPACK)) ; Z_RR_ACC(:) = 0.
ALLOCATE(Z_CR_ACC(IPACK)) ; Z_CR_ACC(:) = 0.
- ALLOCATE(Z_RS_ACC(IPACK)) ; Z_RS_ACC(:) = 0.
+! ALLOCATE(Z_RS_ACC(IPACK)) ; Z_RS_ACC(:) = 0.
ALLOCATE(Z_CS_ACC(IPACK)) ; Z_CS_ACC(:) = 0.
- ALLOCATE(Z_RG_ACC(IPACK)) ; Z_RG_ACC(:) = 0.
+! ALLOCATE(Z_RG_ACC(IPACK)) ; Z_RG_ACC(:) = 0.
+ ALLOCATE(Z_RR_ACCSS(IPACK)) ; Z_RR_ACCSS = 0.
+ ALLOCATE(Z_RR_ACCSG(IPACK)) ; Z_RR_ACCSG = 0.
+ ALLOCATE(Z_RS_ACCRG(IPACK)) ; Z_RS_ACCRG = 0.
+!--cb--
ALLOCATE(Z_RS_CMEL(IPACK)) ; Z_RS_CMEL(:) = 0.
ALLOCATE(Z_CS_CMEL(IPACK)) ; Z_CS_CMEL(:) = 0.
ALLOCATE(Z_TH_CFRZ(IPACK)) ; Z_TH_CFRZ(:) = 0.
@@ -1132,9 +1398,8 @@ DO WHILE(ANY(ZTIME(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)<PTSTEP))
ALLOCATE(Z_CR_CORR2(IPACK)) ; Z_CR_CORR2(:) = 0.
ALLOCATE(Z_CI_CORR2(IPACK)) ; Z_CI_CORR2(:) = 0.
!
- !*** 4.1 Tendecies computation
+ !*** 4.1 Tendencies computation
!
-
CALL LIMA_INST_PROCS (PTSTEP, LLCOMPUTE1D, &
ZEXNREF1D, ZP1D, &
ZTHT1D, ZRVT1D, ZRCT1D, ZRRT1D, ZRIT1D, ZRST1D, ZRGT1D, &
@@ -1166,9 +1431,15 @@ DO WHILE(ANY(ZTIME(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)<PTSTEP))
Z_RI_AGGS, Z_CI_AGGS, &
Z_TH_DEPG, Z_RG_DEPG, &
Z_TH_BERFI, Z_RC_BERFI, &
- Z_TH_RIM, Z_RC_RIM, Z_CC_RIM, Z_RS_RIM, Z_CS_RIM, Z_RG_RIM, &
+!++cb++
+! Z_TH_RIM, Z_RC_RIM, Z_CC_RIM, Z_RS_RIM, Z_CS_RIM, Z_RG_RIM, &
+ Z_TH_RIM, Z_CC_RIM, Z_CS_RIM, Z_RC_RIMSS, Z_RC_RIMSG, Z_RS_RIMCG, &
+!--cb--
Z_RI_HMS, Z_CI_HMS, Z_RS_HMS, &
- Z_TH_ACC, Z_RR_ACC, Z_CR_ACC, Z_RS_ACC, Z_CS_ACC, Z_RG_ACC, &
+!++cb++
+! Z_TH_ACC, Z_RR_ACC, Z_CR_ACC, Z_RS_ACC, Z_CS_ACC, Z_RG_ACC, &
+ Z_TH_ACC, Z_CR_ACC, Z_CS_ACC, Z_RR_ACCSS, Z_RR_ACCSG, Z_RS_ACCRG, &
+!--cb--
Z_RS_CMEL, Z_CS_CMEL, &
Z_TH_CFRZ, Z_RR_CFRZ, Z_CR_CFRZ, Z_RI_CFRZ, Z_CI_CFRZ, &
Z_RI_CIBU, Z_CI_CIBU, &
@@ -1187,7 +1458,8 @@ DO WHILE(ANY(ZTIME(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)<PTSTEP))
ZA_TH, ZA_RV, ZA_RC, ZA_CC, ZA_RR, ZA_CR, &
ZA_RI, ZA_CI, ZA_RS, ZA_CS, ZA_RG, ZA_CG, ZA_RH, ZA_CH, &
ZEVAP1D, &
- ZCF1D, ZIF1D, ZPF1D )
+ ZCF1D, ZIF1D, ZPF1D, &
+ ZLATHAM_IAGGS )
!
!*** 4.2 Integration time
@@ -1420,7 +1692,7 @@ DO WHILE(ANY(ZTIME(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)<PTSTEP))
!
!*** 4.4 Unpacking for budgets
!
- IF(BUCONF%LBU_ENABLE) THEN
+ IF(BUCONF%LBU_ENABLE .OR. OELEC) THEN
ZTOT_RR_CVRC(:,:,:) = ZTOT_RR_CVRC(:,:,:) + Z_RR_CVRC(:,:,:)
ZTOT_CR_CVRC(:,:,:) = ZTOT_CR_CVRC(:,:,:) + Z_CR_CVRC(:,:,:)
@@ -1469,20 +1741,20 @@ DO WHILE(ANY(ZTIME(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)<PTSTEP))
ZTOT_TH_BERFI(I1(II),I2(II),I3(II))= ZTOT_TH_BERFI(I1(II),I2(II),I3(II)) + Z_TH_BERFI(II) * ZMAXTIME(II)
ZTOT_RC_BERFI(I1(II),I2(II),I3(II))= ZTOT_RC_BERFI(I1(II),I2(II),I3(II)) + Z_RC_BERFI(II) * ZMAXTIME(II)
ZTOT_TH_RIM(I1(II),I2(II),I3(II)) = ZTOT_TH_RIM(I1(II),I2(II),I3(II)) + Z_TH_RIM(II) * ZMAXTIME(II)
- ZTOT_RC_RIM(I1(II),I2(II),I3(II)) = ZTOT_RC_RIM(I1(II),I2(II),I3(II)) + Z_RC_RIM(II) * ZMAXTIME(II)
ZTOT_CC_RIM(I1(II),I2(II),I3(II)) = ZTOT_CC_RIM(I1(II),I2(II),I3(II)) + Z_CC_RIM(II) * ZMAXTIME(II)
- ZTOT_RS_RIM(I1(II),I2(II),I3(II)) = ZTOT_RS_RIM(I1(II),I2(II),I3(II)) + Z_RS_RIM(II) * ZMAXTIME(II)
ZTOT_CS_RIM(I1(II),I2(II),I3(II)) = ZTOT_CS_RIM(I1(II),I2(II),I3(II)) + Z_CS_RIM(II) * ZMAXTIME(II)
- ZTOT_RG_RIM(I1(II),I2(II),I3(II)) = ZTOT_RG_RIM(I1(II),I2(II),I3(II)) + Z_RG_RIM(II) * ZMAXTIME(II)
+ ZTOT_RC_RIMSS(I1(II),I2(II),I3(II))= ZTOT_RC_RIMSS(I1(II),I2(II),I3(II)) + Z_RC_RIMSS(II) * ZMAXTIME(II)
+ ZTOT_RC_RIMSG(I1(II),I2(II),I3(II))= ZTOT_RC_RIMSG(I1(II),I2(II),I3(II)) + Z_RC_RIMSG(II) * ZMAXTIME(II)
+ ZTOT_RS_RIMCG(I1(II),I2(II),I3(II))= ZTOT_RS_RIMCG(I1(II),I2(II),I3(II)) + Z_RS_RIMCG(II) * ZMAXTIME(II)
ZTOT_RI_HMS(I1(II),I2(II),I3(II)) = ZTOT_RI_HMS(I1(II),I2(II),I3(II)) + Z_RI_HMS(II) * ZMAXTIME(II)
ZTOT_CI_HMS(I1(II),I2(II),I3(II)) = ZTOT_CI_HMS(I1(II),I2(II),I3(II)) + Z_CI_HMS(II) * ZMAXTIME(II)
ZTOT_RS_HMS(I1(II),I2(II),I3(II)) = ZTOT_RS_HMS(I1(II),I2(II),I3(II)) + Z_RS_HMS(II) * ZMAXTIME(II)
ZTOT_TH_ACC(I1(II),I2(II),I3(II)) = ZTOT_TH_ACC(I1(II),I2(II),I3(II)) + Z_TH_ACC(II) * ZMAXTIME(II)
- ZTOT_RR_ACC(I1(II),I2(II),I3(II)) = ZTOT_RR_ACC(I1(II),I2(II),I3(II)) + Z_RR_ACC(II) * ZMAXTIME(II)
ZTOT_CR_ACC(I1(II),I2(II),I3(II)) = ZTOT_CR_ACC(I1(II),I2(II),I3(II)) + Z_CR_ACC(II) * ZMAXTIME(II)
- ZTOT_RS_ACC(I1(II),I2(II),I3(II)) = ZTOT_RS_ACC(I1(II),I2(II),I3(II)) + Z_RS_ACC(II) * ZMAXTIME(II)
ZTOT_CS_ACC(I1(II),I2(II),I3(II)) = ZTOT_CS_ACC(I1(II),I2(II),I3(II)) + Z_CS_ACC(II) * ZMAXTIME(II)
- ZTOT_RG_ACC(I1(II),I2(II),I3(II)) = ZTOT_RG_ACC(I1(II),I2(II),I3(II)) + Z_RG_ACC(II) * ZMAXTIME(II)
+ ZTOT_RR_ACCSS(I1(II),I2(II),I3(II))= ZTOT_RR_ACCSS(I1(II),I2(II),I3(II)) + Z_RR_ACCSS(II) * ZMAXTIME(II)
+ ZTOT_RR_ACCSG(I1(II),I2(II),I3(II))= ZTOT_RR_ACCSG(I1(II),I2(II),I3(II)) + Z_RR_ACCSG(II) * ZMAXTIME(II)
+ ZTOT_RS_ACCRG(I1(II),I2(II),I3(II))= ZTOT_RS_ACCRG(I1(II),I2(II),I3(II)) + Z_RS_ACCRG(II) * ZMAXTIME(II)
ZTOT_CS_CMEL(I1(II),I2(II),I3(II)) = ZTOT_CS_CMEL(I1(II),I2(II),I3(II)) + Z_CS_CMEL(II) * ZMAXTIME(II)
ZTOT_RS_CMEL(I1(II),I2(II),I3(II)) = ZTOT_RS_CMEL(I1(II),I2(II),I3(II)) + Z_RS_CMEL(II) * ZMAXTIME(II)
ZTOT_TH_CFRZ(I1(II),I2(II),I3(II)) = ZTOT_TH_CFRZ(I1(II),I2(II),I3(II)) + Z_TH_CFRZ(II) * ZMAXTIME(II)
@@ -1544,14 +1816,14 @@ DO WHILE(ANY(ZTIME(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)<PTSTEP))
ZTOT_CR_HMLT(I1(II),I2(II),I3(II)) = ZTOT_CR_HMLT(I1(II),I2(II),I3(II)) + Z_CR_HMLT(II) * ZMAXTIME(II)
ZTOT_CH_HMLT(I1(II),I2(II),I3(II)) = ZTOT_CH_HMLT(I1(II),I2(II),I3(II)) + Z_CH_HMLT(II) * ZMAXTIME(II)
- !Correction term
- ZTOT_RV_CORR2(I1(II),I2(II),I3(II)) = ZTOT_RV_CORR2(I1(II),I2(II),I3(II)) + Z_RV_CORR2(II)
- ZTOT_RC_CORR2(I1(II),I2(II),I3(II)) = ZTOT_RC_CORR2(I1(II),I2(II),I3(II)) + Z_RC_CORR2(II)
- ZTOT_RR_CORR2(I1(II),I2(II),I3(II)) = ZTOT_RR_CORR2(I1(II),I2(II),I3(II)) + Z_RR_CORR2(II)
- ZTOT_RI_CORR2(I1(II),I2(II),I3(II)) = ZTOT_RI_CORR2(I1(II),I2(II),I3(II)) + Z_RI_CORR2(II)
- ZTOT_CC_CORR2(I1(II),I2(II),I3(II)) = ZTOT_CC_CORR2(I1(II),I2(II),I3(II)) + Z_CC_CORR2(II)
- ZTOT_CR_CORR2(I1(II),I2(II),I3(II)) = ZTOT_CR_CORR2(I1(II),I2(II),I3(II)) + Z_CR_CORR2(II)
- ZTOT_CI_CORR2(I1(II),I2(II),I3(II)) = ZTOT_CI_CORR2(I1(II),I2(II),I3(II)) + Z_CI_CORR2(II)
+ ! Correction term
+ ZTOT_RV_CORR2(I1(II),I2(II),I3(II)) = ZTOT_RV_CORR2(I1(II),I2(II),I3(II)) + Z_RV_CORR2(II)
+ ZTOT_RC_CORR2(I1(II),I2(II),I3(II)) = ZTOT_RC_CORR2(I1(II),I2(II),I3(II)) + Z_RC_CORR2(II)
+ ZTOT_RR_CORR2(I1(II),I2(II),I3(II)) = ZTOT_RR_CORR2(I1(II),I2(II),I3(II)) + Z_RR_CORR2(II)
+ ZTOT_RI_CORR2(I1(II),I2(II),I3(II)) = ZTOT_RI_CORR2(I1(II),I2(II),I3(II)) + Z_RI_CORR2(II)
+ ZTOT_CC_CORR2(I1(II),I2(II),I3(II)) = ZTOT_CC_CORR2(I1(II),I2(II),I3(II)) + Z_CC_CORR2(II)
+ ZTOT_CR_CORR2(I1(II),I2(II),I3(II)) = ZTOT_CR_CORR2(I1(II),I2(II),I3(II)) + Z_CR_CORR2(II)
+ ZTOT_CI_CORR2(I1(II),I2(II),I3(II)) = ZTOT_CI_CORR2(I1(II),I2(II),I3(II)) + Z_CI_CORR2(II)
END DO
ENDIF
!
@@ -1594,6 +1866,7 @@ DO WHILE(ANY(ZTIME(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)<PTSTEP))
DEALLOCATE(ZCF1D)
DEALLOCATE(ZIF1D)
DEALLOCATE(ZPF1D)
+ DEALLOCATE(ZLATHAM_IAGGS)
!
DEALLOCATE(ZMAXTIME)
DEALLOCATE(ZTIME_THRESHOLD)
@@ -1665,20 +1938,20 @@ DO WHILE(ANY(ZTIME(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)<PTSTEP))
DEALLOCATE(Z_TH_BERFI)
DEALLOCATE(Z_RC_BERFI)
DEALLOCATE(Z_TH_RIM)
- DEALLOCATE(Z_RC_RIM)
DEALLOCATE(Z_CC_RIM)
- DEALLOCATE(Z_RS_RIM)
DEALLOCATE(Z_CS_RIM)
- DEALLOCATE(Z_RG_RIM)
+ DEALLOCATE(Z_RC_RIMSS)
+ DEALLOCATE(Z_RC_RIMSG)
+ DEALLOCATE(Z_RS_RIMCG)
DEALLOCATE(Z_RI_HMS)
DEALLOCATE(Z_CI_HMS)
- DEALLOCATE(Z_RS_HMS)
+ DEALLOCATE(Z_RS_HMS)
DEALLOCATE(Z_TH_ACC)
- DEALLOCATE(Z_RR_ACC)
DEALLOCATE(Z_CR_ACC)
- DEALLOCATE(Z_RS_ACC)
DEALLOCATE(Z_CS_ACC)
- DEALLOCATE(Z_RG_ACC)
+ DEALLOCATE(Z_RR_ACCSS)
+ DEALLOCATE(Z_RR_ACCSG)
+ DEALLOCATE(Z_RS_ACCRG)
DEALLOCATE(Z_CS_CMEL)
DEALLOCATE(Z_RS_CMEL)
DEALLOCATE(Z_TH_CFRZ)
@@ -1753,6 +2026,188 @@ ENDDO
!
!-------------------------------------------------------------------------------
!
+!* 7. CLOUD ELECTRIFICATION
+! ---------------------
+!
+!* 7.1 Packing variables
+! -----------------
+!
+IF (OELEC) THEN
+ ALLOCATE(GMASK_ELEC(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
+ GMASK_ELEC(:,:,:) = .FALSE.
+ GMASK_ELEC(:,:,:) = ZTOT_RI_HIND(:,:,:) .NE. 0. .OR. ZTOT_RR_HONR(:,:,:) .NE. 0. .OR. &
+ ZTOT_RC_IMLT(:,:,:) .NE. 0. .OR. ZTOT_RC_HONC(:,:,:) .NE. 0. .OR. &
+ ZTOT_RS_DEPS(:,:,:) .NE. 0. .OR. ZTOT_RI_AGGS(:,:,:) .NE. 0. .OR. &
+ ZTOT_RI_CNVS(:,:,:) .NE. 0. .OR. ZTOT_RG_DEPG(:,:,:) .NE. 0. .OR. &
+ ZTOT_RC_AUTO(:,:,:) .NE. 0. .OR. ZTOT_RC_ACCR(:,:,:) .NE. 0. .OR. &
+ ZTOT_RR_EVAP(:,:,:) .NE. 0. .OR. ZTOT_RC_RIMSS(:,:,:) .NE. 0. .OR. &
+ ZTOT_RC_RIMSG(:,:,:) .NE. 0. .OR. ZTOT_RS_RIMCG(:,:,:) .NE. 0. .OR. &
+ ZTOT_RR_ACCSS(:,:,:) .NE. 0. .OR. ZTOT_RR_ACCSG(:,:,:) .NE. 0. .OR. &
+ ZTOT_RS_ACCRG(:,:,:) .NE. 0. .OR. ZTOT_RS_CMEL(:,:,:) .NE. 0. .OR. &
+ ZTOT_RR_CFRZ(:,:,:) .NE. 0. .OR. ZTOT_RI_CFRZ(:,:,:) .NE. 0. .OR. &
+ ZTOT_RI_CIBU(:,:,:) .NE. 0. .OR. ZTOT_RI_RDSF(:,:,:) .NE. 0. .OR. &
+ ZTOT_RC_WETG(:,:,:) .NE. 0. .OR. ZTOT_RI_WETG(:,:,:) .NE. 0. .OR. &
+ ZTOT_RR_WETG(:,:,:) .NE. 0. .OR. ZTOT_RS_WETG(:,:,:) .NE. 0. .OR. &
+ ZTOT_RC_DRYG(:,:,:) .NE. 0. .OR. ZTOT_RI_DRYG(:,:,:) .NE. 0. .OR. &
+ ZTOT_RR_DRYG(:,:,:) .NE. 0. .OR. ZTOT_RS_DRYG(:,:,:) .NE. 0. .OR. &
+ ZTOT_RH_WETG(:,:,:) .NE. 0. .OR. ZTOT_RR_GMLT(:,:,:) .NE. 0. .OR. &
+ ZTOT_RC_BERFI(:,:,:) .NE. 0. .OR. ZTOT_RV_HENU(:,:,:) .NE. 0. .OR. &
+ ZTOT_RC_HINC(:,:,:) .NE. 0. .OR. ZTOT_RV_HONH(:,:,:) .NE. 0. .OR. &
+ ZTOT_RR_CVRC(:,:,:) .NE. 0. .OR. ZTOT_RI_CNVI(:,:,:) .NE. 0. .OR. &
+ ZTOT_RI_DEPI(:,:,:) .NE. 0. .OR. ZTOT_RI_HMS(:,:,:) .NE. 0. .OR. &
+ ZTOT_RI_HMG(:,:,:) .NE. 0. .OR. ZTOT_RC_CORR2(:,:,:) .NE. 0. .OR. &
+ ZTOT_RR_CORR2(:,:,:) .NE. 0. .OR. ZTOT_RI_CORR2(:,:,:) .NE. 0.
+ IF (NMOM_H .GE. 1) &
+ GMASK_ELEC(:,:,:) = GMASK_ELEC(:,:,:) .OR. &
+ ZTOT_RC_WETH(:,:,:) .NE. 0. .OR. ZTOT_RI_WETH(:,:,:) .NE. 0. .OR. &
+ ZTOT_RS_WETH(:,:,:) .NE. 0. .OR. ZTOT_RG_WETH(:,:,:) .NE. 0. .OR. &
+ ZTOT_RR_WETH(:,:,:) .NE. 0. .OR. &
+ !ZTOT_RC_DRYH(:,:,:) .NE. 0. .OR. ZTOT_RI_DRYH(:,:,:) .NE. 0. .OR. &
+ !ZTOT_RS_DRYH(:,:,:) .NE. 0. .OR. ZTOT_RR_DRYH(:,:,:) .NE. 0. .OR. &
+ !ZTOT_RG_DRYH(:,:,:) .NE. 0. .OR. &
+ ZTOT_RG_COHG(:,:,:) .NE. 0. .OR. ZTOT_RR_HMLT(:,:,:) .NE. 0.
+ !
+ IELEC = COUNT(GMASK_ELEC)
+ !
+!
+!* 7.2 Cloud electrification:
+! ---------------------
+!
+! Attention, les signes des tendances ne sont pas traites de la meme facon dans ice3 et lima
+! On se cale sur la facon de faire dans ice3 => on fait en sorte que les tendances soient positives
+ IF (NMOM_H .GE. 1) THEN
+ CALL ELEC_TENDENCIES(D, CST, ICED, ICEP, ELECD, ELECP, &
+ KRR, IELEC, PTSTEP, GMASK_ELEC, &
+ BUCONF, TBUDGETS, KBUDGETS, &
+ HCLOUD, PTHVREFZIKB, &
+ PRHODREF, PRHODJ, ZT, ZCIT_ELEC, &
+ ZRVT_ELEC, ZRCT_ELEC, ZRRT_ELEC, ZRIT_ELEC, ZRST_ELEC, ZRGT_ELEC, &
+ ZQPIT, ZQCT, ZQRT, ZQIT, ZQST, ZQGT, ZQNIT, &
+ ZQPIS, ZQCS, ZQRS, ZQIS, ZQSS, ZQGS, ZQNIS, &
+ ZTOT_RI_HIND*ZINV_TSTEP, -ZTOT_RR_HONR*ZINV_TSTEP, ZTOT_RC_IMLT*ZINV_TSTEP, &
+ -ZTOT_RC_HONC*ZINV_TSTEP, ZTOT_RS_DEPS*ZINV_TSTEP, -ZTOT_RI_AGGS*ZINV_TSTEP, &
+ -ZTOT_RI_CNVS*ZINV_TSTEP, ZTOT_RG_DEPG*ZINV_TSTEP, -ZTOT_RC_AUTO*ZINV_TSTEP, &
+ -ZTOT_RC_ACCR*ZINV_TSTEP, -ZTOT_RR_EVAP*ZINV_TSTEP, &
+ ZTOT_RC_RIMSS*ZINV_TSTEP, ZTOT_RC_RIMSG*ZINV_TSTEP, ZTOT_RS_RIMCG*ZINV_TSTEP,&
+ ZTOT_RR_ACCSS*ZINV_TSTEP, ZTOT_RR_ACCSG*ZINV_TSTEP, ZTOT_RS_ACCRG*ZINV_TSTEP,&
+ -ZTOT_RS_CMEL*ZINV_TSTEP, -ZTOT_RI_CFRZ*ZINV_TSTEP, -ZTOT_RR_CFRZ*ZINV_TSTEP, &
+ -ZTOT_RC_WETG*ZINV_TSTEP, -ZTOT_RI_WETG*ZINV_TSTEP, -ZTOT_RR_WETG*ZINV_TSTEP, &
+ -ZTOT_RS_WETG*ZINV_TSTEP, &
+ -ZTOT_RC_DRYG*ZINV_TSTEP, -ZTOT_RI_DRYG*ZINV_TSTEP, -ZTOT_RR_DRYG*ZINV_TSTEP, &
+ -ZTOT_RS_DRYG*ZINV_TSTEP, &
+ ZTOT_RR_GMLT*ZINV_TSTEP, -ZTOT_RC_BERFI*ZINV_TSTEP, &
+! variables et processus optionnels propres a la grele : pas encore teste
+ PRWETGH=ZTOT_RH_WETG*ZINV_TSTEP, &
+ PRCWETH=ZTOT_RC_WETH, PRIWETH=ZTOT_RI_WETH, PRSWETH=ZTOT_RS_WETH, &
+ PRGWETH=ZTOT_RG_WETH, PRRWETH=ZTOT_RR_WETH, &
+! PRCDRYH=ZTOT_RC_DRYH, PRIDRYH=ZTOT_RI_DRYH, PRSDRYH=ZTOT_RS_DRYH, &
+! PRRDRYH=ZTOT_RR_DRYH, PRGDRYH=ZTOT_RG_DRYH, &
+ PRDRYHG=ZTOT_RG_COHG, PRHMLTR=ZTOT_RR_HMLT, &
+ PRHT=ZRHT, PRHS=ZRHS, PQHT=ZQHT, PQHS=ZQHS, PCHT=ZCHT, &
+! variables et processus optionnels propres a lima
+ PCCT=ZCCT_ELEC, PCRT=ZCRT_ELEC, PCST=ZCST_ELEC, PCGT=ZCGT_ELEC, &
+ PRVHENC=ZTOT_RV_HENU*ZINV_TSTEP, PRCHINC=-ZTOT_RC_HINC*ZINV_TSTEP, &
+ PRVHONH=-ZTOT_RV_HONH*ZINV_TSTEP, PRRCVRC=-ZTOT_RR_CVRC*ZINV_TSTEP, &
+ PRICNVI=ZTOT_RI_CNVI*ZINV_TSTEP, PRVDEPI=ZTOT_RI_DEPI*ZINV_TSTEP, &
+ PRSHMSI=ZTOT_RI_HMS*ZINV_TSTEP, PRGHMGI=ZTOT_RI_HMG*ZINV_TSTEP, &
+ PRICIBU=ZTOT_RI_CIBU*ZINV_TSTEP, PRIRDSF=ZTOT_RI_RDSF*ZINV_TSTEP, &
+ PRCCORR2=-ZTOT_RC_CORR2*ZINV_TSTEP, PRRCORR2=-ZTOT_RR_CORR2*ZINV_TSTEP, &
+ PRICORR2=-ZTOT_RI_CORR2*ZINV_TSTEP)
+ ELSE
+ CALL ELEC_TENDENCIES(D, CST, ICED, ICEP, ELECD, ELECP, &
+ KRR, IELEC, PTSTEP, GMASK_ELEC, &
+ BUCONF, TBUDGETS, KBUDGETS, &
+ HCLOUD, PTHVREFZIKB, &
+ PRHODREF, PRHODJ, ZT, ZCIT_ELEC, &
+ ZRVT_ELEC, ZRCT_ELEC, ZRRT_ELEC, ZRIT_ELEC, ZRST_ELEC, ZRGT_ELEC, &
+ ZQPIT, ZQCT, ZQRT, ZQIT, ZQST, ZQGT, ZQNIT, &
+ ZQPIS, ZQCS, ZQRS, ZQIS, ZQSS, ZQGS, ZQNIS, &
+ ZTOT_RI_HIND*ZINV_TSTEP, -ZTOT_RR_HONR*ZINV_TSTEP, ZTOT_RC_IMLT*ZINV_TSTEP, &
+ -ZTOT_RC_HONC*ZINV_TSTEP, ZTOT_RS_DEPS*ZINV_TSTEP, -ZTOT_RI_AGGS*ZINV_TSTEP, &
+ -ZTOT_RI_CNVS*ZINV_TSTEP, ZTOT_RG_DEPG*ZINV_TSTEP, -ZTOT_RC_AUTO*ZINV_TSTEP, &
+ -ZTOT_RC_ACCR*ZINV_TSTEP, -ZTOT_RR_EVAP*ZINV_TSTEP, &
+ ZTOT_RC_RIMSS*ZINV_TSTEP, ZTOT_RC_RIMSG*ZINV_TSTEP, ZTOT_RS_RIMCG*ZINV_TSTEP,&
+ ZTOT_RR_ACCSS*ZINV_TSTEP, ZTOT_RR_ACCSG*ZINV_TSTEP, ZTOT_RS_ACCRG*ZINV_TSTEP,&
+ -ZTOT_RS_CMEL*ZINV_TSTEP, -ZTOT_RI_CFRZ*ZINV_TSTEP, -ZTOT_RR_CFRZ*ZINV_TSTEP, &
+ -ZTOT_RC_WETG*ZINV_TSTEP, -ZTOT_RI_WETG*ZINV_TSTEP, -ZTOT_RR_WETG*ZINV_TSTEP, &
+ -ZTOT_RS_WETG*ZINV_TSTEP, &
+ -ZTOT_RC_DRYG*ZINV_TSTEP, -ZTOT_RI_DRYG*ZINV_TSTEP, -ZTOT_RR_DRYG*ZINV_TSTEP, &
+ -ZTOT_RS_DRYG*ZINV_TSTEP, &
+ ZTOT_RR_GMLT*ZINV_TSTEP, -ZTOT_RC_BERFI*ZINV_TSTEP, &
+! variables et processus optionnels propres a lima
+ PCCT=ZCCT, PCRT=ZCRT, PCST=ZCST, PCGT=ZCGT, &
+ PRVHENC=ZTOT_RV_HENU*ZINV_TSTEP, PRCHINC=-ZTOT_RC_HINC*ZINV_TSTEP, &
+ PRVHONH=-ZTOT_RV_HONH*ZINV_TSTEP, PRRCVRC=-ZTOT_RR_CVRC*ZINV_TSTEP, &
+ PRICNVI=ZTOT_RI_CNVI*ZINV_TSTEP, PRVDEPI=ZTOT_RI_DEPI*ZINV_TSTEP, &
+ PRSHMSI=ZTOT_RI_HMS*ZINV_TSTEP, PRGHMGI=ZTOT_RI_HMG*ZINV_TSTEP, &
+ PRICIBU=ZTOT_RI_CIBU*ZINV_TSTEP, PRIRDSF=ZTOT_RI_RDSF*ZINV_TSTEP, &
+ PRCCORR2=-ZTOT_RC_CORR2*ZINV_TSTEP, PRRCORR2=-ZTOT_RR_CORR2*ZINV_TSTEP, &
+ PRICORR2=-ZTOT_RI_CORR2*ZINV_TSTEP)
+ END IF
+ !
+ ! update the source variables
+ PSV_ELEC_S(:,:,:,1) = ZQPIS(:,:,:)
+ PSV_ELEC_S(:,:,:,2) = ZQCS(:,:,:)
+ PSV_ELEC_S(:,:,:,3) = ZQRS(:,:,:)
+ PSV_ELEC_S(:,:,:,4) = ZQIS(:,:,:)
+ PSV_ELEC_S(:,:,:,5) = ZQSS(:,:,:)
+ PSV_ELEC_S(:,:,:,6) = ZQGS(:,:,:)
+ IF (KRR == 6) THEN
+ PSV_ELEC_S(:,:,:,7) = ZQNIS(:,:,:)
+ ELSE IF (KRR == 7) THEN
+ PSV_ELEC_S(:,:,:,7) = ZQHS(:,:,:)
+ PSV_ELEC_S(:,:,:,8) = ZQNIS(:,:,:)
+ END IF
+ !
+ DEALLOCATE(GMASK_ELEC)
+ !
+ DEALLOCATE(ZQPIT)
+ DEALLOCATE(ZQNIT)
+ DEALLOCATE(ZQCT)
+ DEALLOCATE(ZQRT)
+ DEALLOCATE(ZQIT)
+ DEALLOCATE(ZQST)
+ DEALLOCATE(ZQGT)
+ IF (ALLOCATED(ZQHT)) DEALLOCATE(ZQHT)
+ DEALLOCATE(ZQPIS)
+ DEALLOCATE(ZQNIS)
+ DEALLOCATE(ZQCS)
+ DEALLOCATE(ZQRS)
+ DEALLOCATE(ZQIS)
+ DEALLOCATE(ZQSS)
+ DEALLOCATE(ZQGS)
+ IF (ALLOCATED(ZQHS)) DEALLOCATE(ZQHS)
+ !
+ DEALLOCATE(ZRVT_ELEC)
+ DEALLOCATE(ZRCT_ELEC)
+ DEALLOCATE(ZRRT_ELEC)
+ DEALLOCATE(ZRIT_ELEC)
+ DEALLOCATE(ZRST_ELEC)
+ DEALLOCATE(ZRGT_ELEC)
+ IF (ALLOCATED(ZRHT_ELEC)) DEALLOCATE(ZRHT_ELEC)
+ IF (ALLOCATED(ZCCT_ELEC)) DEALLOCATE(ZCCT_ELEC)
+ IF (ALLOCATED(ZCRT_ELEC)) DEALLOCATE(ZCRT_ELEC)
+ IF (ALLOCATED(ZCIT_ELEC)) DEALLOCATE(ZCIT_ELEC)
+ IF (ALLOCATED(ZCST_ELEC)) DEALLOCATE(ZCST_ELEC)
+ IF (ALLOCATED(ZCGT_ELEC)) DEALLOCATE(ZCGT_ELEC)
+ IF (ALLOCATED(ZCHT_ELEC)) DEALLOCATE(ZCHT_ELEC)
+ !
+END IF
+!
+DEALLOCATE(ZTOT_RI_HIND)
+DEALLOCATE(ZTOT_RC_HINC)
+DEALLOCATE(ZTOT_RV_HENU)
+DEALLOCATE(ZTOT_RV_HONH)
+!
+!
+!* 7.3 Unpacking variables
+! -------------------
+!
+! not necessary! the only variables needed in the following (PQxS) are already 3D
+!
+!
+!-------------------------------------------------------------------------------
+!
!* 7. TOTAL TENDENCIES
! ----------------
!
@@ -1826,7 +2281,9 @@ if ( BUCONF%lbu_enable ) then
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'HONC', ztot_rc_honc (:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'IMLT', ztot_rc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'BERFI', ztot_rc_berfi(:, :, :) * zrhodjontstep(:, :, :) )
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'RIM', ztot_rc_rim (:, :, :) * zrhodjontstep(:, :, :) )
+! call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'RIM', ztot_rc_rim (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'RIM', (ztot_rc_rimss(:, :, :) + ztot_rc_rimsg(:, :, :)) &
+ * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'WETG', ztot_rc_wetg (:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'DRYG', ztot_rc_dryg (:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'CVRC', -ztot_rr_cvrc (:, :, :) * zrhodjontstep(:, :, :) )
@@ -1839,7 +2296,9 @@ if ( BUCONF%lbu_enable ) then
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'ACCR', -ztot_rc_accr(:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'REVA', ztot_rr_evap(:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'HONR', ztot_rr_honr(:, :, :) * zrhodjontstep(:, :, :) )
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'ACC', ztot_rr_acc (:, :, :) * zrhodjontstep(:, :, :) )
+! call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'ACC', ztot_rr_acc (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'ACC', (ztot_rc_rimss(:, :, :) + ztot_rc_rimsg(:, :, :)) &
+ * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'CFRZ', ztot_rr_cfrz(:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'WETG', ztot_rr_wetg(:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RR), 'DRYG', ztot_rr_dryg(:, :, :) * zrhodjontstep(:, :, :) )
@@ -1874,9 +2333,13 @@ if ( BUCONF%lbu_enable ) then
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'DEPS', ztot_rs_deps(:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'CNVS', -ztot_ri_cnvs(:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'AGGS', -ztot_ri_aggs(:, :, :) * zrhodjontstep(:, :, :) )
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'RIM', ztot_rs_rim (:, :, :) * zrhodjontstep(:, :, :) )
+! call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'RIM', ztot_rs_rim (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'RIM', (-ztot_rc_rimss(:, :, :) - ztot_rs_rimcg(:, :, :)) &
+ * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'HMS', ztot_rs_hms (:, :, :) * zrhodjontstep(:, :, :) )
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'ACC', ztot_rs_acc (:, :, :) * zrhodjontstep(:, :, :) )
+! call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'ACC', ztot_rs_acc (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'ACC', (ztot_rr_accss(:, :, :) - ztot_rs_accrg (:, :, :)) &
+ * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'CMEL', ztot_rs_cmel(:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'CIBU', -ztot_ri_cibu(:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RS), 'WETG', ztot_rs_wetg(:, :, :) * zrhodjontstep(:, :, :) )
@@ -1887,8 +2350,12 @@ if ( BUCONF%lbu_enable ) then
if ( BUCONF%lbudget_rg ) then
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'HONR', -ztot_rr_honr(:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'DEPG', ztot_rg_depg(:, :, :) * zrhodjontstep(:, :, :) )
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'RIM', ztot_rg_rim (:, :, :) * zrhodjontstep(:, :, :) )
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'ACC', ztot_rg_acc (:, :, :) * zrhodjontstep(:, :, :) )
+! call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'RIM', ztot_rg_rim (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'RIM', (-ztot_rc_rimsg(:, :, :) + ztot_rs_rimcg(:, :, :) ) &
+ * zrhodjontstep(:, :, :) )
+! call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'ACC', ztot_rg_acc (:, :, :) * zrhodjontstep(:, :, :) )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'ACC', (ztot_rr_accsg(:, :, :) + ztot_rs_accrg (:, :, :)) &
+ * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'CMEL', -ztot_rs_cmel(:, :, :) * zrhodjontstep(:, :, :) )
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RG), 'CFRZ', ( -ztot_rr_cfrz(:, :, :) - ztot_ri_cfrz(:, :, :) ) &
* zrhodjontstep(:, :, :) )
diff --git a/src/mesonh/micro/modd_elec_descr.f90 b/src/common/micro/modd_elec_descr.F90
similarity index 86%
rename from src/mesonh/micro/modd_elec_descr.f90
rename to src/common/micro/modd_elec_descr.F90
index 82d346588cb8f8c435011290facd2b8c667f311f..db6aaa9587502e2c80bc9f6eb9be30cad41dade3 100644
--- a/src/mesonh/micro/modd_elec_descr.f90
+++ b/src/common/micro/modd_elec_descr.F90
@@ -31,6 +31,8 @@
!! Helsdon-Farley (JGR, 1987, 5661-5675)
!! Add "Beard" effect via sedimentation process
!! J.-P. Pinty 25/10/13 Add "Latham" effect via aggregation process
+!! C. Barthe 05/07/23 New data structures for PHYEX - for sedimentation in ICE3
+!! + Remove unused variables
!!
!-------------------------------------------------------------------------------
!
@@ -90,30 +92,11 @@ REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XQTMIN ! Min values allowed for the
! volumetric charge
REAL, DIMENSION(:) , ALLOCATABLE :: XRTMIN_ELEC ! Limit value of R where charge is available
!
-REAL, SAVE :: XCXR ! Exponent in the concentration-slope
REAL :: XEPSILON ! Dielectric permittivity of air (F/m)
-REAL :: XECHARGE ! Elementary charge (C)
-!
-! charge-diameter relationship : e_x and f_x in q_x=e_xD^f_x
-!
-REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XEC, XER, XEI, XES, XEG, XEH ! e_x
-REAL, SAVE :: XFC, XFR, XFI, XFS, XFG, XFH ! f_x
!
!
! parameters relative to electrification
!
-REAL :: XESR, & ! Mean collection efficiency for rain-aggregate,
- XEGR, & ! graupel_rain,
- XEGS ! graupel_snow
-REAL :: XDELTATMIN ! Minimum temperature gap between ZTT(:) and XQTC
-!
-REAL :: XQINDIV_C_CST, & !
- XQINDIV_R_CST, & !
- XQINDIV_I_CST, & ! Constants for the individual charge
- XQINDIV_I_EXP, & ! calculation
- XQINDIV_S_CST, & !
- XQINDIV_G_CST !
-!
REAL, SAVE :: XLBDAR_MAXE, & ! Max values allowed for the shape
XLBDAS_MAXE, & ! when computation of charge separation
XLBDAG_MAXE, & ! and of lightning neutralisation
@@ -175,4 +158,37 @@ LOGICAL :: LSEDIM_BEARD=.FALSE. ! .T.: to enable ELEC=>MICROPHYS via
LOGICAL :: LIAGGS_LATHAM=.FALSE. ! .T.: to enable ELEC=>MICROPHYS via
! ! ice aggregation rate
!
+! The following variables must be declared with a derived type to match with PHYEX requirements
+TYPE ELEC_DESCR_t
+ REAL :: XFC, XFR, XFI, XFS, XFG, XFH ! f_x in q_x = e_x D^f_x
+ REAL :: XCXR ! Exponent in the concentration-slope
+ REAL :: XECHARGE ! Elementary charge (C)
+END TYPE ELEC_DESCR_t
+!
+TYPE(ELEC_DESCR_t), SAVE, TARGET :: ELEC_DESCR
+!
+REAL, POINTER :: XFC => NULL(), &
+ XFR => NULL(), &
+ XFI => NULL(), &
+ XFS => NULL(), &
+ XFG => NULL(), &
+ XFH => NULL(), &
+ XCXR => NULL(), &
+ XECHARGE => NULL()
+!
+CONTAINS
+!
+SUBROUTINE ELEC_DESCR_ASSOCIATE()
+ IMPLICIT NONE
+ !
+ XFC => ELEC_DESCR%XFC
+ XFR => ELEC_DESCR%XFR
+ XFI => ELEC_DESCR%XFI
+ XFS => ELEC_DESCR%XFS
+ XFG => ELEC_DESCR%XFG
+ XFH => ELEC_DESCR%XFH
+ XCXR => ELEC_DESCR%XCXR
+ XECHARGE=> ELEC_DESCR%XECHARGE
+END SUBROUTINE ELEC_DESCR_ASSOCIATE
+!
END MODULE MODD_ELEC_DESCR
diff --git a/src/common/micro/modd_elec_param.F90 b/src/common/micro/modd_elec_param.F90
new file mode 100644
index 0000000000000000000000000000000000000000..128c292e931d918d3e805371a080dfad70fbfe3f
--- /dev/null
+++ b/src/common/micro/modd_elec_param.F90
@@ -0,0 +1,261 @@
+!MNH_LIC Copyright 2002-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 MODD_ELEC_PARAM
+! #######################
+!
+!!**** *MODD_ELEC_PARAM* - declaration of some electrical factors
+!! extensively used in the electrical scheme.
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to declare some precomputed
+! electrical parameters directly used in routines related to cloud electricity
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! Gilles Molinie * Laboratoire d'Aerologie *
+!!
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 14/11/02
+!! C. Barthe 31/01/2022 add XFQUPDNCI
+!! C. Barthe 07/06/2022 add parameters for charge sedimentation in LIMA
+!! C. Barthe 28/03/2023 add parameters for sedimentation of cloud droplets charge
+!! C. Barthe 05/07/2023 new data structures for PHYEX - for sedimentation in ICE3
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
+!
+IMPLICIT NONE
+!
+SAVE
+!
+REAL :: XCOEF_RQ_V, XCOEF_RQ_C, & ! Constants for proportionality
+ XCOEF_RQ_R, XCOEF_RQ_I, & ! between mass transfer and
+ XCOEF_RQ_S, XCOEF_RQ_G, & ! charge transfer
+ XCOEF_RQ_H
+!
+REAL :: XQHON ! Constant for spontaneous freezing of droplets if T<-35°
+!
+REAL, DIMENSION(:), ALLOCATABLE :: XFQSED ! Constant for sedimentation of
+ ! electric charge in LIMA
+REAL, DIMENSION(:), ALLOCATABLE :: XDQ ! Exponent for sedimentation of
+ ! electric charge in LIMA
+REAL :: XFQUPDNCI ! constant used to update e_i for sedimentation where
+ ! N_i follows McFarquhar and Heysmfield (1997)
+!
+REAL :: XQSRIMCG, XEXQSRIMCG ! Constant for riming of cloud droplets
+ ! on snow
+REAL, DIMENSION(:), ALLOCATABLE :: XGAMINC_RIM3
+!
+REAL :: XQRCFRIG, XEXQRCFRIG ! Constant for contact freezing between
+ ! raindrops and pristine ice
+REAL :: XFQRACCS ! Constant in RACCS
+!
+REAL :: XFQIAGGSBH, & ! Constant for IAGGS charging
+ XFQIAGGSBG, XEXFQIAGGSBG, & ! process for HELFA, GARDI,
+ XFQIAGGSBS, & ! SAUND and TAKAH
+ XFQIAGGSBT1, XFQIAGGSBT2, XFQIAGGSBT3
+!
+REAL :: XLBQRACCS1, XLBQRACCS2, XLBQRACCS3 ! Integral of normalization
+REAL :: XLBQSACCRG1, XLBQSACCRG2, XLBQSACCRG3 ! in accretion of raindrops
+ ! on snow process
+!
+REAL, DIMENSION(:,:), ALLOCATABLE & ! Normalized kernel for
+ :: XKER_Q_RACCS, XKER_Q_RACCSS, XKER_Q_SACCRG ! RACCS, RACCSS, SACCRG
+!
+REAL :: XFQSDRYG, XFQSDRYGB, XFQRDRYG ! Constant in SDRYG and RDRYG
+!
+! charge separation
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: XKER_Q_LIMSG
+REAL, DIMENSION(:,:), ALLOCATABLE :: XKER_Q_SDRYGB, XKER_Q_SDRYGB1, XKER_Q_SDRYGB2
+!
+! Helsdon-Farley
+!
+REAL :: XHIDRYG ! Constant charge separated
+REAL :: XHSDRYG ! Constant charge separated
+REAL :: XLBQSDRYGB4H, XLBQSDRYGB5H, XLBQSDRYGB6H ! Constants in QIDRYGB
+REAL :: XFQSDRYGBH !
+!
+! Gardiner
+!
+REAL :: XLWCC ! LWC critic in Gardiner NI charging
+REAL :: XFQIDRYGBG, XLBQIDRYGBG ! Constants in QIDRYGB
+REAL :: XFQSDRYGBG ! Constants in QSDRYGB
+REAL :: XLBQSDRYGB4G, XLBQSDRYGB5G, XLBQSDRYGB6G !
+!
+! Saunders
+!
+REAL :: XIMP, XINP, XIKP, & ! Parameters m, n and k
+ XIMN, XINN, XIKN, & ! for the NI processes
+ XSMP, XSNP, XSKP, & ! following
+ XSMN, XSNN, XSKN ! Saunders et al. (1991)
+REAL :: XFQIAGGSP, XFQIAGGSN, & ! Auxiliary parameters
+ XFQIDRYGBSP, XFQIDRYGBSN, & ! containing MOMG function
+ XLBQSDRYGB1SP, XLBQSDRYGB1SN, &
+ XLBQSDRYGB2SP, XLBQSDRYGB2SN, &
+ XLBQSDRYGB3SP, XLBQSDRYGB3SN, &
+ XAIGAMMABI
+REAL :: XIKP_TAK, XIKN_TAK, XSKP_TAK, XSKN_TAK ! Using Takahashi charge
+REAL :: XFQIAGGSP_TAK, XFQIAGGSN_TAK, XFQIDRYGBSP_TAK, XFQIDRYGBSN_TAK
+REAL :: XVSCOEF, XVGCOEF
+REAL :: XFQIDRYGBS, XLBQIDRYGBS ! Constants in QIDRYGB
+REAL :: XFQSDRYGBS ! Constants in QSDRYGB
+REAL :: XLBQSDRYGB1S, XLBQSDRYGB2S !
+!
+! Takahashi
+!
+INTEGER :: NIND_TEMP ! number of indexes for temperature
+INTEGER :: NIND_LWC ! number of indexes for liquid water content
+REAL, DIMENSION(:,:), ALLOCATABLE :: XMANSELL ! F(LWC, T) for Takahashi(1978) /Mansell
+REAL, DIMENSION(:,:), ALLOCATABLE :: XSAUNDER ! F(LWC, T) for SAUN1/SAUN2, BSMP1/BSMP2
+REAL, DIMENSION(:,:), ALLOCATABLE :: XTAKA_TM ! F(LWC, T) for Takahashi/Tsenova and Mitzeva
+!
+REAL :: XFQIDRYGBT1, XFQIDRYGBT2, XFQIDRYGBT3, & ! IDRYGB
+ XFQSDRYGBT1, XFQSDRYGBT2, XFQSDRYGBT3, & ! SDRYGB
+ XFQSDRYGBT4, XFQSDRYGBT5, XFQSDRYGBT6, & ! SDRYGB
+ XFQSDRYGBT7, XFQSDRYGBT8, XFQSDRYGBT9, & ! SDRYGB
+ XFQSDRYGBT10, XFQSDRYGBT11, XFQSDRYGBT12 ! SDRYGB
+!
+REAL :: XLBQRDRYG1, XLBQRDRYG2, XLBQRDRYG3 ! Integral of normalization in
+REAL :: XLBQSDRYG1, XLBQSDRYG2, XLBQSDRYG3 ! the accretion of graupel on
+ ! raindrop and snow process
+!
+REAL, DIMENSION(:,:), ALLOCATABLE &
+ :: XKER_Q_SDRYG, XKER_Q_RDRYG ! Normalized kernel for SDRYG and RDRYG
+!
+REAL :: XQREVAV1, XQREVAV2 ! Raindrops evaporation
+!
+! Add variables to limit the exchanged charge
+!
+REAL :: XAUX_LIM
+REAL :: XAUX_LIM1, XAUX_LIM2, XAUX_LIM3
+!
+!
+! Inductive charging process
+!
+REAL :: XCOLCG_IND ! collision effiency
+REAL :: XEBOUND ! rebound efficiency
+REAL :: XALPHA_IND ! fraction of droplets with grazing trajectories
+REAL :: XCOS_THETA ! average cosine of the angle of rebounding collision
+REAL :: XIND1, XIND2, XIND3
+!
+! lightning
+!
+REAL :: XFQLIGHTC, XFQLIGHTR, XFQLIGHTI, &
+ XFQLIGHTS, XFQLIGHTG, XFQLIGHTH ! Constant for charge redistribution
+REAL :: XEXQLIGHTR, XEXQLIGHTI, &
+ XEXQLIGHTS, XEXQLIGHTG, XEXQLIGHTH ! Exponent for charge redistribution
+!
+! The following variables must be declared with a derived type to match with PHYEX requirements
+TYPE ELEC_PARAM_t
+ REAL :: XFCI ! Constant for sedimentation of the mixing ratio of ice
+ ! which the computation is modified in regard of rain_ice.f90
+ !
+ REAL :: XFQSEDC, XEXQSEDC, & ! Constant for sedimentation of cloud droplets
+ XFQSEDR, XEXQSEDR, & ! rain
+ XFQSEDI, XEXQSEDI, & ! ice
+ XFQSEDS, XEXQSEDS, & ! snow
+ XFQSEDG, XEXQSEDG, & ! graupel
+ XFQSEDH, XEXQSEDH ! hail
+ !
+ REAL :: XEGMIN, XEGMAX, XESMIN, XESMAX, & ! Max and min values for
+ XEIMIN, XEIMAX, XECMIN, XECMAX, & ! e_x in q=e_x D^f_x
+ XERMIN, XERMAX, XEHMIN, XEHMAX
+ !
+ REAL :: XFQUPDC, XFQUPDR, XFQUPDI,& ! Update Q=f(D)
+ XEXFQUPDI, XFQUPDS, XFQUPDG, XFQUPDH
+END TYPE ELEC_PARAM_t
+!
+TYPE(ELEC_PARAM_t), SAVE, TARGET :: ELEC_PARAM
+!
+REAL, POINTER :: XFCI => NULL(), &
+ XFQSEDC => NULL(), &
+ XEXQSEDC => NULL(), &
+ XFQSEDR => NULL(), &
+ XEXQSEDR => NULL(), &
+ XFQSEDI => NULL(), &
+ XEXQSEDI => NULL(), &
+ XFQSEDS => NULL(), &
+ XEXQSEDS => NULL(), &
+ XFQSEDG => NULL(), &
+ XEXQSEDG => NULL(), &
+ XFQSEDH => NULL(), &
+ XEXQSEDH => NULL(), &
+ XEGMIN => NULL(), &
+ XEGMAX => NULL(), &
+ XESMIN => NULL(), &
+ XESMAX => NULL(), &
+ XEIMIN => NULL(), &
+ XEIMAX => NULL(), &
+ XECMIN => NULL(), &
+ XECMAX => NULL(), &
+ XERMIN => NULL(), &
+ XERMAX => NULL(), &
+ XEHMIN => NULL(), &
+ XEHMAX => NULL(), &
+ XFQUPDC => NULL(), &
+ XFQUPDR => NULL(), &
+ XFQUPDI => NULL(), &
+ XEXFQUPDI => NULL(),&
+ XFQUPDS => NULL(), &
+ XFQUPDG => NULL(), &
+ XFQUPDH => NULL()
+!
+CONTAINS
+!
+SUBROUTINE ELEC_PARAM_ASSOCIATE()
+ IMPLICIT NONE
+ !
+ XFCI => ELEC_PARAM%XFCI
+ XFQSEDC => ELEC_PARAM%XFQSEDC
+ XEXQSEDC => ELEC_PARAM%XEXQSEDC
+ XFQSEDR => ELEC_PARAM%XFQSEDR
+ XEXQSEDR => ELEC_PARAM%XEXQSEDR
+ XFQSEDI => ELEC_PARAM%XFQSEDI
+ XEXQSEDI => ELEC_PARAM%XEXQSEDI
+ XFQSEDS => ELEC_PARAM%XFQSEDS
+ XEXQSEDS => ELEC_PARAM%XEXQSEDS
+ XFQSEDG => ELEC_PARAM%XFQSEDG
+ XEXQSEDG => ELEC_PARAM%XEXQSEDG
+ XFQSEDH => ELEC_PARAM%XFQSEDH
+ XEXQSEDH => ELEC_PARAM%XEXQSEDH
+ XEGMIN => ELEC_PARAM%XEGMIN
+ XEGMAX => ELEC_PARAM%XEGMAX
+ XESMIN => ELEC_PARAM%XESMIN
+ XESMAX => ELEC_PARAM%XESMAX
+ XEIMIN => ELEC_PARAM%XEIMIN
+ XEIMAX => ELEC_PARAM%XEIMAX
+ XECMIN => ELEC_PARAM%XECMIN
+ XECMAX => ELEC_PARAM%XECMAX
+ XERMIN => ELEC_PARAM%XERMIN
+ XERMAX => ELEC_PARAM%XERMAX
+ XEHMIN => ELEC_PARAM%XEHMIN
+ XEHMAX => ELEC_PARAM%XEHMAX
+ XFQUPDC => ELEC_PARAM%XFQUPDC
+ XFQUPDR => ELEC_PARAM%XFQUPDR
+ XFQUPDI => ELEC_PARAM%XFQUPDI
+ XEXFQUPDI => ELEC_PARAM%XEXFQUPDI
+ XFQUPDS => ELEC_PARAM%XFQUPDS
+ XFQUPDG => ELEC_PARAM%XFQUPDG
+ XFQUPDH => ELEC_PARAM%XFQUPDH
+END SUBROUTINE ELEC_PARAM_ASSOCIATE
+!
+END MODULE MODD_ELEC_PARAM
diff --git a/src/common/micro/modd_elecn.F90 b/src/common/micro/modd_elecn.F90
new file mode 100644
index 0000000000000000000000000000000000000000..3147dcb1853b7358926b28a094be68ae125de6a2
--- /dev/null
+++ b/src/common/micro/modd_elecn.F90
@@ -0,0 +1,122 @@
+!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ####################
+ MODULE MODD_ELEC_n
+! ####################
+!
+!!**** *MODD_ELEC$n* - declaration of electric fields
+!!
+!! PURPOSE
+!! -------
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! MODIFICATIONS
+!! -------------
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
+IMPLICIT NONE
+
+TYPE ELEC_t
+!
+! REAL, DIMENSION(:,:,:), POINTER :: XNI_SDRYG=>NULL(), XNI_IDRYG=>NULL(), &
+! XNI_IAGGS=>NULL(), &
+! XEFIELDU=>NULL(), & ! The 3 components of the electric field
+! XEFIELDV=>NULL(), XEFIELDW=>NULL(), &
+ REAL, DIMENSION(:,:,:), POINTER :: XESOURCEFW=>NULL(), & ! Fair weather electric charge (C m^-3)
+! XIND_RATE=>NULL(), XEW=>NULL(), &
+ XEW=>NULL(), &
+ XIONSOURCEFW =>NULL(), & ! Fair weather ionic source
+ ! (ion pairs m-3 s-1) hold constant in time
+ XCION_POS_FW =>NULL(), XCION_NEG_FW =>NULL(), & !Positive and Negative ion mixing ratio
+ XMOBIL_POS =>NULL(), XMOBIL_NEG=>NULL() ! m2/V/s
+!
+! Parameters for flat lapalcian operator to solve the electric field
+! (see MODD_DYN_n)
+ REAL, DIMENSION(:), POINTER :: XRHOM_E =>NULL(), XAF_E =>NULL(), XCF_E =>NULL()
+ REAL, DIMENSION(:,:,:), POINTER :: XBFY_E =>NULL(), &
+ XBFB_E =>NULL(), XBF_SXP2_YP1_Z_E =>NULL()
+ ! Z_Splitting
+
+!
+END TYPE ELEC_t
+
+TYPE(ELEC_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: ELEC_MODEL
+
+REAL, DIMENSION(:,:,:), POINTER :: XNI_SDRYG=>NULL(), XNI_IDRYG=>NULL(), &
+ XNI_IAGGS=>NULL(), XEFIELDU=>NULL(), &
+ XESOURCEFW=>NULL(), XEFIELDV=>NULL(), XEFIELDW=>NULL(), &
+ XIND_RATE=>NULL(), XIONSOURCEFW =>NULL(), XEW=>NULL(), &
+ XCION_POS_FW =>NULL(), XCION_NEG_FW =>NULL(), &
+ XMOBIL_POS =>NULL(), XMOBIL_NEG=>NULL(), XBFY_E =>NULL(), &
+ XBFB_E =>NULL(), XBF_SXP2_YP1_Z_E =>NULL()
+REAL, DIMENSION(:), POINTER :: XRHOM_E =>NULL(), XAF_E =>NULL(), XCF_E =>NULL()
+
+CONTAINS
+
+SUBROUTINE ELEC_GOTO_MODEL(KFROM, KTO)
+INTEGER, INTENT(IN) :: KFROM, KTO
+!
+! Save current state for allocated arrays
+!ELEC_MODEL(KFROM)%XNI_SDRYG=>XNI_SDRYG !Done in FIELDLIST_GOTO_MODEL
+!ELEC_MODEL(KFROM)%XNI_IDRYG=>XNI_IDRYG !Done in FIELDLIST_GOTO_MODEL
+!ELEC_MODEL(KFROM)%XNI_IAGGS=>XNI_IAGGS !Done in FIELDLIST_GOTO_MODEL
+!ELEC_MODEL(KFROM)%XIND_RATE=>XIND_RATE !Done in FIELDLIST_GOTO_MODEL
+ELEC_MODEL(KFROM)%XEW=>XEW
+!ELEC_MODEL(KFROM)%XEFIELDU=>XEFIELDU !Done in FIELDLIST_GOTO_MODEL
+!ELEC_MODEL(KFROM)%XEFIELDV=>XEFIELDV !Done in FIELDLIST_GOTO_MODEL
+!ELEC_MODEL(KFROM)%XEFIELDW=>XEFIELDW !Done in FIELDLIST_GOTO_MODEL
+ELEC_MODEL(KFROM)%XESOURCEFW=>XESOURCEFW
+ELEC_MODEL(KFROM)%XIONSOURCEFW=>XIONSOURCEFW
+ELEC_MODEL(KFROM)%XCION_POS_FW=>XCION_POS_FW
+ELEC_MODEL(KFROM)%XCION_NEG_FW=>XCION_NEG_FW
+ELEC_MODEL(KFROM)%XMOBIL_POS=>XMOBIL_POS
+ELEC_MODEL(KFROM)%XMOBIL_NEG=>XMOBIL_NEG
+ELEC_MODEL(KFROM)%XBFY_E=>XBFY_E
+ELEC_MODEL(KFROM)%XBFB_E=>XBFB_E
+ELEC_MODEL(KFROM)%XBF_SXP2_YP1_Z_E=>XBF_SXP2_YP1_Z_E
+ELEC_MODEL(KFROM)%XRHOM_E=>XRHOM_E
+ELEC_MODEL(KFROM)%XAF_E=>XAF_E
+ELEC_MODEL(KFROM)%XCF_E=>XCF_E
+!
+! Current model is set to model KTO
+!XNI_SDRYG=>ELEC_MODEL(KTO)%XNI_SDRYG !Done in FIELDLIST_GOTO_MODEL
+!XNI_IDRYG=>ELEC_MODEL(KTO)%XNI_IDRYG !Done in FIELDLIST_GOTO_MODEL
+!XNI_IAGGS=>ELEC_MODEL(KTO)%XNI_IAGGS !Done in FIELDLIST_GOTO_MODEL
+!XIND_RATE=>ELEC_MODEL(KTO)%XIND_RATE !Done in FIELDLIST_GOTO_MODEL
+XEW=>ELEC_MODEL(KTO)%XEW
+!XEFIELDU=>ELEC_MODEL(KTO)%XEFIELDU !Done in FIELDLIST_GOTO_MODEL
+!XEFIELDV=>ELEC_MODEL(KTO)%XEFIELDV !Done in FIELDLIST_GOTO_MODEL
+!XEFIELDW=>ELEC_MODEL(KTO)%XEFIELDW !Done in FIELDLIST_GOTO_MODEL
+XESOURCEFW=>ELEC_MODEL(KTO)%XESOURCEFW
+XIONSOURCEFW=>ELEC_MODEL(KTO)%XIONSOURCEFW
+XCION_POS_FW=>ELEC_MODEL(KTO)%XCION_POS_FW
+XCION_NEG_FW=>ELEC_MODEL(KTO)%XCION_NEG_FW
+XMOBIL_POS=>ELEC_MODEL(KTO)%XMOBIL_POS
+XMOBIL_NEG=>ELEC_MODEL(KTO)%XMOBIL_NEG
+XBFY_E=>ELEC_MODEL(KTO)%XBFY_E
+XBFB_E=>ELEC_MODEL(KTO)%XBFB_E
+XBF_SXP2_YP1_Z_E=>ELEC_MODEL(KTO)%XBF_SXP2_YP1_Z_E
+XRHOM_E=>ELEC_MODEL(KTO)%XRHOM_E
+XAF_E=>ELEC_MODEL(KTO)%XAF_E
+XCF_E=>ELEC_MODEL(KTO)%XCF_E
+END SUBROUTINE ELEC_GOTO_MODEL
+
+END MODULE MODD_ELEC_n
diff --git a/src/common/micro/modd_nebn.F90 b/src/common/micro/modd_nebn.F90
index dce8f1d9aab9b16e9728812d8fbd01d52c26e5a3..fdc47f6a310a216583360260815a32b34149c86f 100644
--- a/src/common/micro/modd_nebn.F90
+++ b/src/common/micro/modd_nebn.F90
@@ -98,7 +98,7 @@ IF(.NOT. ASSOCIATED(NEBN, NEB_MODEL(KTO))) THEN
ENDIF
END SUBROUTINE NEB_GOTO_MODEL
!
-SUBROUTINE NEBN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
+SUBROUTINE NEBN_INIT(HPROGRAM, TFILENAM, LDNEEDNAM, KLUOUT, &
&LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT)
!!*** *NEBN_INIT* - Code needed to initialize the MODD_NEB_n module
!!
@@ -130,6 +130,7 @@ SUBROUTINE NEBN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
!
USE MODE_POSNAM_PHY, ONLY: POSNAM_PHY
USE MODE_CHECK_NAM_VAL, ONLY: CHECK_NAM_VAL_CHAR
+USE MODD_IO, ONLY: TFILEDATA
!
IMPLICIT NONE
!
@@ -137,7 +138,7 @@ IMPLICIT NONE
! ------------------------
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM !< Name of the calling program
-INTEGER, INTENT(IN) :: KUNITNML !< Logical unit to access the namelist
+TYPE(TFILEDATA), INTENT(IN) :: TFILENAM !< Namelist file
LOGICAL, INTENT(IN) :: LDNEEDNAM !< True to abort if namelist is absent
INTEGER, INTENT(IN) :: KLUOUT !< Logical unit for outputs
LOGICAL, OPTIONAL, INTENT(IN) :: LDDEFAULTVAL !< Must we initialize variables with default values (defaults to .TRUE.)
@@ -197,8 +198,8 @@ ENDIF
! -----------
!
IF(LLREADNAM) THEN
- CALL POSNAM_PHY(KUNITNML, 'NAM_NEBN', LDNEEDNAM, LLFOUND, KLUOUT)
- IF(LLFOUND) READ(UNIT=KUNITNML, NML=NAM_NEBn)
+ CALL POSNAM_PHY(TFILENAM, 'NAM_NEBN', LDNEEDNAM, LLFOUND)
+ IF(LLFOUND) READ(UNIT=TFILENAM%NLU, NML=NAM_NEBn)
ENDIF
!
!* 3. CHECKS
diff --git a/src/common/micro/modd_param_icen.F90 b/src/common/micro/modd_param_icen.F90
index 9ea39306b764f20e53c5046b9341022d8d150e7b..1113a1d47a056e65f6d3f4efaae8bf5438c71813 100644
--- a/src/common/micro/modd_param_icen.F90
+++ b/src/common/micro/modd_param_icen.F90
@@ -229,7 +229,7 @@ IF(.NOT. ASSOCIATED(PARAM_ICEN, PARAM_ICE_MODEL(KTO))) THEN
ENDIF
END SUBROUTINE PARAM_ICE_GOTO_MODEL
!
-SUBROUTINE PARAM_ICEN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
+SUBROUTINE PARAM_ICEN_INIT(HPROGRAM, TFILENAM, LDNEEDNAM, KLUOUT, &
&LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT)
!!*** *PARAM_ICEN_INIT* - Code needed to initialize the MODD_PARAM_ICE_n module
!!
@@ -262,6 +262,7 @@ SUBROUTINE PARAM_ICEN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
USE MODE_POSNAM_PHY, ONLY: POSNAM_PHY
USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
USE MODE_CHECK_NAM_VAL, ONLY: CHECK_NAM_VAL_CHAR, CHECK_NAM_VAL_REAL, CHECK_NAM_VAL_INT
+USE MODD_IO, ONLY: TFILEDATA
!
IMPLICIT NONE
!
@@ -269,7 +270,7 @@ IMPLICIT NONE
! ------------------------
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM !< Name of the calling program
-INTEGER, INTENT(IN) :: KUNITNML !< Logical unit to access the namelist
+TYPE(TFILEDATA), INTENT(IN) :: TFILENAM !< Namelist file
LOGICAL, INTENT(IN) :: LDNEEDNAM !< True to abort if namelist is absent
INTEGER, INTENT(IN) :: KLUOUT !< Logical unit for outputs
LOGICAL, OPTIONAL, INTENT(IN) :: LDDEFAULTVAL !< Must we initialize variables with default values (defaults to .TRUE.)
@@ -392,8 +393,8 @@ ENDIF
! -----------
!
IF(LLREADNAM) THEN
- CALL POSNAM_PHY(KUNITNML, 'NAM_PARAM_ICEN', LDNEEDNAM, LLFOUND, KLUOUT)
- IF(LLFOUND) READ(UNIT=KUNITNML, NML=NAM_PARAM_ICEn)
+ CALL POSNAM_PHY(TFILENAM, 'NAM_PARAM_ICEN', LDNEEDNAM, LLFOUND)
+ IF(LLFOUND) READ(UNIT=TFILENAM%NLU, NML=NAM_PARAM_ICEn)
ENDIF
!
!* 3. CHECKS
diff --git a/src/common/micro/modd_param_lima.F90 b/src/common/micro/modd_param_lima.F90
index 3565e1d9a705310dd2c37f73b2768b296fa88c53..61fd573f42c169d41cb4d217e604e399ea4efe13 100644
--- a/src/common/micro/modd_param_lima.F90
+++ b/src/common/micro/modd_param_lima.F90
@@ -557,7 +557,7 @@ SUBROUTINE PARAM_LIMA_ALLOCATE(HNAME, KDIM1, KDIM2, KDIM3)
END SELECT
END SUBROUTINE PARAM_LIMA_ALLOCATE
!
-SUBROUTINE PARAM_LIMA_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
+SUBROUTINE PARAM_LIMA_INIT(HPROGRAM, TFILENAM, LDNEEDNAM, KLUOUT, &
&LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT)
!!*** *PARAM_ICEN_INIT* - Code needed to initialize the MODD_PARAM_LIMA module
!!
@@ -590,6 +590,7 @@ SUBROUTINE PARAM_LIMA_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
USE MODE_POSNAM_PHY, ONLY: POSNAM_PHY
USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
USE MODE_CHECK_NAM_VAL, ONLY: CHECK_NAM_VAL_CHAR
+USE MODD_IO, ONLY: TFILEDATA
!
IMPLICIT NONE
!
@@ -597,7 +598,7 @@ IMPLICIT NONE
! ------------------------
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM !< Name of the calling program
-INTEGER, INTENT(IN) :: KUNITNML !< Logical unit to access the namelist
+TYPE(TFILEDATA), INTENT(IN) :: TFILENAM !< Namelist file
LOGICAL, INTENT(IN) :: LDNEEDNAM !< True to abort if namelist is absent
INTEGER, INTENT(IN) :: KLUOUT !< Logical unit for outputs
LOGICAL, OPTIONAL, INTENT(IN) :: LDDEFAULTVAL !< Must we initialize variables with default values (defaults to .TRUE.)
@@ -700,8 +701,8 @@ ENDIF
! -----------
!
IF(LLREADNAM) THEN
- CALL POSNAM_PHY(KUNITNML, 'NAM_PARAM_LIMA', LDNEEDNAM, LLFOUND, KLUOUT)
- IF(LLFOUND) READ(UNIT=KUNITNML, NML=NAM_PARAM_LIMA)
+ CALL POSNAM_PHY(TFILENAM, 'NAM_PARAM_LIMA', LDNEEDNAM, LLFOUND)
+ IF(LLFOUND) READ(UNIT=TFILENAM%NLU, NML=NAM_PARAM_LIMA)
ENDIF
!
!* 3. CHECKS
@@ -709,7 +710,7 @@ ENDIF
!
IF(LLCHECK) THEN
CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CPRISTINE_ICE_LIMA', CPRISTINE_ICE_LIMA, &
- 'PLAT', 'COLU', 'BURO')
+ 'PLAT', 'COLU', 'BURO','YPLA','YCOL','YBUR','YDRO','YHCO','YHBU')
CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CHEVRIMED_ICE_LIMA', CHEVRIMED_ICE_LIMA, &
'GRAU', 'HAIL')
@@ -727,7 +728,7 @@ IF(LLCHECK) THEN
&"VALUE OF NMOD_CCN IN ORDER TO USE LIMA WARM ACTIVATION SCHEME.")
END IF
- IF(LNUCL .AND. NMOD_IFN == 0 .AND. (.NOT.LMEYERS)) THEN
+ IF(LNUCL .AND. NMOD_IFN == 0 .AND. (.NOT.LMEYERS) .AND. NMOM_I >= 2) THEN
CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'MODD_PARAM_LIMA', &
&"NUCLEATION BY DEPOSITION AND CONTACT IS NOT " // &
&"POSSIBLE IF NMOD_IFN HAS VALUE ZERO. YOU HAVE TO SET AN UPPER" // &
diff --git a/src/common/micro/modd_param_lima_cold.F90 b/src/common/micro/modd_param_lima_cold.F90
index 3134e583f585419a5121808a9ac0fd302a1b9e89..cc3e3adc1e5639286c37689f9569905947dc8501 100644
--- a/src/common/micro/modd_param_lima_cold.F90
+++ b/src/common/micro/modd_param_lima_cold.F90
@@ -53,12 +53,14 @@ REAL :: XLBEXS,XLBS,XNS ! Snow/agg. distribution parameters
!
REAL :: XAI,XBI,XC_I,XDI ,XF0I,XF2I,XC1I ! Cloud ice charact.
REAL :: XF0IS,XF1IS ! (large Di vent. coef.)
+REAL :: XDELTAI, XGAMMAI ! cloud ice area-diameter parameters
REAL :: XAS,XBS,XCS,XDS,XCCS,XCXS,XF0S,XF1S,XC1S ! Snow/agg. charact.
!
REAL :: XLBDAS_MIN, XLBDAS_MAX ! Max values allowed for the shape parameter of snow
REAL :: XFVELOS ! Wurtz - snow fall speed parameterizaed after Thompson 2008
REAL :: XTRANS_MP_GAMMAS ! Wurtz - change between lambda value for MP and gen. gamma
!
+REAL :: XREFFI ! constante for ice crystal effective radius for ecRad
!
!-------------------------------------------------------------------------------
!
@@ -146,6 +148,8 @@ REAL, POINTER :: XLBEXI => NULL(), &
XNS => NULL(), &
XAI => NULL(), &
XBI => NULL(), &
+ XGAMMAI => NULL(), &
+ XDELTAI => NULL(), &
XC_I => NULL(), &
XDI => NULL(), &
XF0I => NULL(), &
@@ -166,6 +170,7 @@ REAL, POINTER :: XLBEXI => NULL(), &
XLBDAS_MAX => NULL(), &
XFVELOS => NULL(), &
XTRANS_MP_GAMMAS => NULL(), &
+ XREFFI => NULL(), &
XFSEDRI => NULL(), &
XFSEDCI => NULL(), &
XFSEDRS => NULL(), &
@@ -286,6 +291,8 @@ IF(.NOT. ASSOCIATED(XLBEXI)) THEN
XNS => PARAM_LIMA_COLD%XNS
XAI => PARAM_LIMA_COLD%XAI
XBI => PARAM_LIMA_COLD%XBI
+ XGAMMAI => PARAM_LIMA_COLD%XGAMMAI
+ XDELTAI => PARAM_LIMA_COLD%XDELTAI
XC_I => PARAM_LIMA_COLD%XC_I
XDI => PARAM_LIMA_COLD%XDI
XF0I => PARAM_LIMA_COLD%XF0I
@@ -306,6 +313,7 @@ IF(.NOT. ASSOCIATED(XLBEXI)) THEN
XLBDAS_MAX => PARAM_LIMA_COLD%XLBDAS_MAX
XFVELOS => PARAM_LIMA_COLD%XFVELOS
XTRANS_MP_GAMMAS => PARAM_LIMA_COLD%XTRANS_MP_GAMMAS
+ XREFFI => PARAM_LIMA_COLD%XREFFI
XFSEDRI => PARAM_LIMA_COLD%XFSEDRI
XFSEDCI => PARAM_LIMA_COLD%XFSEDCI
XFSEDRS => PARAM_LIMA_COLD%XFSEDRS
diff --git a/src/common/micro/mode_compute_lambda.F90 b/src/common/micro/mode_compute_lambda.F90
new file mode 100644
index 0000000000000000000000000000000000000000..ba45978ba3a82791b61a1f6449a501372d1eca5c
--- /dev/null
+++ b/src/common/micro/mode_compute_lambda.F90
@@ -0,0 +1,214 @@
+!MNH_LIC Copyright 2022-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 MODE_COMPUTE_LAMBDA
+! ##########################
+IMPLICIT NONE
+CONTAINS
+!
+! #########################################################
+ SUBROUTINE COMPUTE_LAMBDA (KID, KMOMENT, KSIZE, HCLOUD, &
+ PRHO, PRTMIN, PRX, PCX, PLBDX)
+! #########################################################
+!
+! Purpose : compute lambda, the slope parameter of the distribution
+! - for 1-moment species: lbda_x = [(rho r_x) / (a_x C_x G(b/alpha))]^(1/(x-b))
+! - for 2-moment species: lbda_x = [(rho r_x) / (a_x N_x G(b/alpha))]^(-1/b)
+!
+! AUTHOR
+! ------
+! C. Barthe * LAERO *
+!
+! MODIFICATIONS
+! -------------
+! Original June 2022
+! C. Barthe 12/07/23 adapt the code for LIMA2
+!
+!------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_RAIN_ICE_DESCR_n, ONLY: XLBC_I=>XLBC, XLBR_I=>XLBR, XLBI_I=>XLBI, XLBS_I=>XLBS, XLBG_I=>XLBG, XLBH_I=>XLBH, &
+ XLBEXC_I=>XLBEXC, XLBEXR_I=>XLBEXR, XLBEXI_I=>XLBEXI, XLBEXS_I=>XLBEXS, &
+ XLBEXG_I=>XLBEXG, XLBEXH_I=>XLBEXH, &
+ XLBDAS_MAX_I=>XLBDAS_MAX, &
+ XCCR_I=>XCCR, XCCS_I=>XCCS, XCCG_I=>XCCG, XCCH_I=>XCCH, &
+ XCXS_I=>XCXS, XCXG_I=>XCXG, XCXH_I=>XCXH
+USE MODD_ELEC_DESCR, ONLY: XCXR_I=>XCXR
+USE MODD_PARAM_LIMA_WARM, ONLY: XLBC_L=>XLBC, XLBR_L=>XLBR, XLBEXC_L=>XLBEXC, XLBEXR_L=>XLBEXR, &
+ XCXR_L=>XCXR, XCCR_L=>XCCR
+USE MODD_PARAM_LIMA_COLD, ONLY: XLBI_L=>XLBI, XLBS_L=>XLBS, XLBEXI_L=>XLBEXI, XLBEXS_L=>XLBEXS, &
+ XLBDAS_MAX_L=>XLBDAS_MAX, &
+ XCXS_L=>XCXS, XCCS_L=>XCCS
+USE MODD_PARAM_LIMA_MIXED, ONLY: XLBG_L=>XLBG, XLBH_L=>XLBH, XLBEXG_L=>XLBEXG, XLBEXH_L=>XLBEXH, &
+ XCXG_L=>XCXG, XCCG_L=>XCCG, XCXH_L=>XCXH, XCCH_L=>XCCH
+!
+USE MODI_MOMG
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of dummy arguments
+!
+INTEGER, INTENT(IN) :: KID ! nb of the hydrometeor category
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+INTEGER, INTENT(IN) :: KMOMENT ! nb of moments of the microphysics scheme
+INTEGER, INTENT(IN) :: KSIZE
+REAL, INTENT(IN) :: PRTMIN
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHO ! reference density
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRX ! Mixing ratio
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PCX ! Nb concentration
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PLBDX ! Slope parameter of the distribution
+!
+!* 0.2 Declaration of local variables
+!
+REAL :: ZRTMIN, ZLBX, ZLBEX, ZLBDAX_MAX, ZCCX, ZCXX
+!
+!---------------------------------------------------------------------------------
+!
+!* 1. PRELIMINARIES
+! -------------
+!
+ZRTMIN = PRTMIN
+!
+IF (KID == 2) THEN
+ IF (HCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
+ ZLBX = XLBC_L
+ ZLBEX = XLBEXC_L
+! ELSE
+! print*, 'ERROR: the computation of lambda_c is not available if c is 1-moment species'
+ END IF
+ELSE IF (KID == 3) THEN
+ IF (HCLOUD == 'LIMA') THEN
+ ZLBX = XLBR_L
+ ZLBEX = XLBEXR_L
+ IF (KMOMENT == 1) THEN
+ ZCCX = XCCR_L
+ ZCXX = XCXR_L
+ END IF
+ ELSE IF (HCLOUD(1:3) == 'ICE') THEN
+ ZLBX = XLBR_I
+ ZLBEX = XLBEXR_I
+ ZCCX = XCCR_I
+ ZCXX = XCXR_I
+ ELSE
+ PRINT*, 'ERROR: something wrong with the computation of lambda_r'
+ END IF
+ELSE IF (KID == 4) THEN
+ IF (HCLOUD == 'LIMA') THEN
+ ZLBX = XLBI_L
+ ZLBEX = XLBEXI_L
+ ELSE IF (HCLOUD(1:3) == 'ICE') THEN
+ ZLBX = XLBI_I
+ ZLBEX = XLBEXI_I
+ ELSE
+ PRINT*, 'ERROR: something wrong with the computation of lambda_i'
+ END IF
+ELSE IF (KID == 5) THEN
+ IF (HCLOUD == 'LIMA') THEN
+ ZLBX = XLBS_L
+ ZLBEX = XLBEXS_L
+ ZLBDAX_MAX = XLBDAS_MAX_L
+ IF (KMOMENT == 1) THEN
+ ZCCX = XCCS_L
+ ZCXX = XCXS_L
+ END IF
+ ELSE IF (HCLOUD(1:3) == 'ICE') THEN
+ ZLBX = XLBS_I
+ ZLBEX = XLBEXS_I
+ ZLBDAX_MAX = XLBDAS_MAX_I
+ ZCCX = XCCS_I
+ ZCXX = XCXS_I
+ ELSE
+ PRINT*, 'ERROR: something wrong with the computation of lambda_s'
+ END IF
+ELSE IF (KID == 6) THEN
+ IF (HCLOUD == 'LIMA') THEN ! .AND. KMOMENT == 1) THEN
+ ZLBX = XLBG_L
+ ZLBEX = XLBEXG_L
+ IF (KMOMENT == 1) THEN
+ ZCCX = XCCG_L
+ ZCXX = XCXG_L
+ END IF
+ ELSE IF (HCLOUD(1:3) == 'ICE') THEN
+ ZLBX = XLBG_I
+ ZLBEX = XLBEXG_I
+ ZCCX = XCCG_I
+ ZCXX = XCXG_I
+ ELSE
+ PRINT*, 'ERROR: something wrong with the computation of lambda_g'
+ END IF
+ELSE IF (KID == 7) THEN
+ IF (HCLOUD == 'LIMA') THEN ! .AND. KMOMENT == 1) THEN
+ ZLBX = XLBH_L
+ ZLBEX = XLBEXH_L
+ IF (KMOMENT == 1) THEN
+ ZCCX = XCCH_L
+ ZCXX = XCXH_L
+ END IF
+ ELSE IF (HCLOUD(1:3) == 'ICE') THEN
+ ZLBX = XLBH_I
+ ZLBEX = XLBEXH_I
+ ZCCX = XCCH_I
+ ZCXX = XCXH_I
+ ELSE
+ PRINT*, 'ERROR: something wrong with the computation of lambda_h'
+ END IF
+END IF
+!
+PLBDX(:) = 0. !1.E10
+!
+!
+!* 2. COMPUTE LBDA_x FOR 2-MOMENT SPECIES
+! -----------------------------------
+!
+IF (KMOMENT == 2) THEN
+ WHERE (PRX(:) > ZRTMIN .AND. PCX(:) > 0.)
+ PLBDX(:) = (ZLBX * PCX(:) / PRX(:))**ZLBEX
+ END WHERE
+ IF (KID == 5) PLBDX(:) = MIN(ZLBDAX_MAX, PLBDX(:))
+!
+!
+!* 3. COMPUTE LBDA_x and N_x FOR 1-MOMENT SPECIES
+! -------------------------------------------
+!
+ELSE IF (KMOMENT == 1) THEN
+!
+!* 3.1 Special case of cloud droplets
+!
+ IF (KID == 2) THEN
+! print*, 'computation of lambda_c in 1-moment configuration not treated'
+!
+!* 3.2 Special case of ice crystals
+!
+ ELSE IF (KID == 4) THEN
+! formulation utilisee dans rain_ice_fast_ri
+ WHERE (PRX(:) > ZRTMIN .AND. PCX(:) > 0.0)
+ PLBDX(:) = ZLBX * (PRHO(:) * PRX(:) / PCX(:))**ZLBEX
+ ENDWHERE
+!
+!* 3.3 Special case of snow
+!
+ ELSE IF (KID == 5) THEN
+! limitation of lbdas
+ WHERE (PRX(:) > ZRTMIN)
+ PLBDX(:) = MIN(200000., ZLBX * (PRHO(:) * PRX(:))**ZLBEX)
+ PCX(:) = ZCCX * PLBDX(:)**ZCXX / PRHO(:)
+ ENDWHERE
+!
+!* 3.4 Computation for all other hydrometeors
+!
+ ELSE
+ WHERE (PRX(:) > ZRTMIN)
+ PLBDX(:) = ZLBX * (PRHO(:) * PRX(:))**ZLBEX
+ PCX(:) = ZCCX * PLBDX(:)**ZCXX / PRHO(:)
+ ENDWHERE
+ END IF
+END IF
+!
+END SUBROUTINE COMPUTE_LAMBDA
+END MODULE MODE_COMPUTE_LAMBDA
diff --git a/src/common/micro/mode_elec_beard_effect.F90 b/src/common/micro/mode_elec_beard_effect.F90
new file mode 100644
index 0000000000000000000000000000000000000000..b7f8f94fc75236c9da3c572e50a0036946801a87
--- /dev/null
+++ b/src/common/micro/mode_elec_beard_effect.F90
@@ -0,0 +1,281 @@
+!MNH_LIC Copyright 2013-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 MODE_ELEC_BEARD_EFFECT
+!
+IMPLICIT NONE
+CONTAINS
+!
+! ###################################################################
+ SUBROUTINE ELEC_BEARD_EFFECT(D, CST, ICED, HCLOUD, KID, OSEDIM, PT, PRHODREF, PTHVREFZIKB, &
+ PRX, PQX, PEFIELDW, PLBDA, PBEARDCOEF)
+! ####################################################################
+!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the effect of the electric field
+!! on the terminal velocity of hydrometeors.
+!!
+!! METHOD
+!! ------
+!! From Beard, K. V., 1980: The Effects of Altitude and Electrical Force on
+!! the Terminal Velocity of Hydrometeors. J. Atmos. Sci., 37, 1363–1374,
+!! https://doi.org/10.1175/1520-0469(1980)037<1363:TEOAAE>2.0.CO;2.
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * LAERO *
+!! C. Barthe * LAERO *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 21/08/2013 first coded in rain_ice_elec
+!! C. Barthe 01/06/2023 : externalize the code to use it with ICE3 and LIMA
+!! C. Barthe 08/06/2023 : correction by 10-5 of the dynamic viscosity of air
+!! (unecessary for eta0/eta but necessary for Re0)
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY: CST_t
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+
+USE MODD_ELEC_DESCR, ONLY: XRTMIN_ELEC
+USE MODD_PARAM_LIMA, ONLY: XALPHAC_L=>XALPHAC, XNUC_L=>XNUC, XALPHAR_L=>XALPHAR, XNUR_L=>XNUR, &
+ XALPHAI_L=>XALPHAI, XNUI_L=>XNUI, XALPHAS_L=>XALPHAS, XNUS_L=>XNUS, &
+ XALPHAG_L=>XALPHAG, XNUG_L=>XNUG, &
+ XCEXVT_L=>XCEXVT
+USE MODD_PARAM_LIMA_COLD, ONLY: XBI_L=>XBI, XC_I_L=>XC_I, XDI_L=>XDI, &
+ XBS_L=>XBS, XCS_L=>XCS, XDS_L=>XDS
+USE MODD_PARAM_LIMA_MIXED,ONLY: XBG_L=>XBG, XCG_L=>XCG, XDG_L=>XDG, &
+ XBH_L=>XBH, XCH_L=>XCH, XDH_L=>XDH, &
+ XALPHAH_L=>XALPHAH, XNUH_L=>XNUH
+USE MODD_PARAM_LIMA_WARM, ONLY: XBR_L=>XBR, XCR_L=>XCR, XDR_L=>XDR, &
+ XBC_L=>XBC, XCC_L=>XCC, XDC_L=>XDC
+!
+USE MODI_MOMG
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+INTEGER, INTENT(IN) :: KID ! Hydrometeor ID
+LOGICAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: OSEDIM ! if T, compute the sedim. proc.
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRX ! m.r. source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PQX ! Elec. charge density source
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEFIELDW ! Vertical component of the electric field
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLBDA ! Slope param. of the distribution
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PBEARDCOEF ! Beard coefficient
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+!
+REAL, INTENT(IN) :: PTHVREFZIKB ! Reference thv at IKB for electricity
+!* 0.2 Declarations of local variables
+!
+INTEGER :: JIJ, JK ! loop indexes
+INTEGER :: IIJB, IIJE, IKTB, IKTE
+REAL :: ZCEXVT, ZBX, ZCX, ZDX, ZALPHAX, ZNUX
+REAL :: ZRE0
+REAL :: ZETA0
+REAL :: ZVX
+REAL :: ZK
+REAL :: ZCOR00, ZRHO00
+REAL :: ZT ! Temperature (C)
+REAL :: ZCOR ! To remove the Foote-duToit correction
+REAL :: ZF0, ZF1 ! Coef. in Beard's equation
+real, dimension(D%NIJT,D%NKT) :: zreynolds
+!
+!-------------------------------------------------------------------------------
+!
+
+ASSOCIATE(XALPHAC_I=>ICED%XALPHAC, XNUC_I=>ICED%XNUC, XALPHAR_I=>ICED%XALPHAR, XNUR_I=>ICED%XNUR, &
+ XALPHAI_I=>ICED%XALPHAI, XNUI_I=>ICED%XNUI, XALPHAS_I=>ICED%XALPHAS, XNUS_I=>ICED%XNUS, &
+ XALPHAG_I=>ICED%XALPHAG, XNUG_I=>ICED%XNUG, XALPHAH_I=>ICED%XALPHAH, XNUH_I=>ICED%XNUH, &
+ XBC_I=>ICED%XBC, XCC_I=>ICED%XCC, XDC_I=>ICED%XDC, &
+ XBR_I=>ICED%XBR, XCR_I=>ICED%XCR, XDR_I=>ICED%XDR, &
+ XBI_I=>ICED%XBI, XC_I_I=>ICED%XC_I, XDI_I=>ICED%XDI, &
+ XBS_I=>ICED%XBS, XCS_I=>ICED%XCS, XDS_I=>ICED%XDS, &
+ XBG_I=>ICED%XBG, XCG_I=>ICED%XCG, XDG_I=>ICED%XDG, &
+ XBH_I=>ICED%XBH, XCH_I=>ICED%XCH, XDH_I=>ICED%XDH, &
+ XCEXVT_I=>ICED%XCEXVT)
+
+
+!* 1. COMPUTE USEFULL PARAMETERS
+! --------------------------
+!
+IKTB = D%NKTB
+IKTE = D%NKTE
+IIJB = D%NIJB
+IIJE = D%NIJE
+!
+!* 1.1 Select the right parameters
+! --> depend on the microphysics scheme and the hydrometeor species
+!
+IF (HCLOUD(1:3) == 'ICE') THEN
+ ZCEXVT = XCEXVT_I
+ !
+ IF (KID == 2) THEN
+ ZBX = XBC_I
+ ZCX = XCC_I
+ ZDX = XDC_I
+ ZALPHAX = XALPHAC_I
+ ZNUX = XNUC_I
+ ELSE IF (KID == 3) THEN
+ ZBX = XBR_I
+ ZCX = XCR_I
+ ZDX = XDR_I
+ ZALPHAX = XALPHAR_I
+ ZNUX = XNUR_I
+ ELSE IF (KID == 4) THEN
+ ! values for columns are used to be consistent with the McF&H formula
+ ZBX = 1.7
+ ZCX = 2.1E5
+ ZDX = 1.585
+ ZALPHAX = XALPHAI_I
+ ZNUX = XNUI_I
+ ELSE IF (KID == 5) THEN
+ ZBX = XBS_I
+ ZCX = XCS_I
+ ZDX = XDS_I
+ ZALPHAX = XALPHAS_I
+ ZNUX = XNUS_I
+ ELSE IF (KID == 6) THEN
+ ZBX = XBG_I
+ ZCX = XCG_I
+ ZDX = XDG_I
+ ZALPHAX = XALPHAG_I
+ ZNUX = XNUG_I
+ ELSE IF (KID == 7) THEN
+ ZBX = XBH_I
+ ZCX = XCH_I
+ ZDX = XDH_I
+ ZALPHAX = XALPHAH_I
+ ZNUX = XNUH_I
+ END IF
+ELSE IF (HCLOUD == 'LIMA') THEN
+ ZCEXVT = XCEXVT_L
+ !
+ IF (KID == 2) THEN
+ ZBX = XBC_L
+ ZCX = XCC_L
+ ZDX = XDC_L
+ ZALPHAX = XALPHAC_L
+ ZNUX = XNUC_L
+ ELSE IF (KID == 3) THEN
+ ZBX = XBR_L
+ ZCX = XCR_L
+ ZDX = XDR_L
+ ZALPHAX = XALPHAR_L
+ ZNUX = XNUR_L
+ ELSE IF (KID == 4) THEN
+ ZBX = 1.7
+ ZCX = 2.1E5
+ ZDX = 1.585
+ ZALPHAX = XALPHAI_L
+ ZNUX = XNUI_L
+ ELSE IF (KID == 5) THEN
+ ZBX = XBS_L
+ ZCX = XCS_L
+ ZDX = XDS_L
+ ZALPHAX = XALPHAS_L
+ ZNUX = XNUS_L
+ ELSE IF (KID == 6) THEN
+ ZBX = XBG_L
+ ZCX = XCG_L
+ ZDX = XDG_L
+ ZALPHAX = XALPHAG_L
+ ZNUX = XNUG_L
+ ELSE IF (KID == 7) THEN
+ ZBX = XBH_L
+ ZCX = XCH_L
+ ZDX = XDH_L
+ ZALPHAX = XALPHAH_L
+ ZNUX = XNUH_L
+ END IF
+ !
+END IF
+!
+!* 1.2 Parameters from Table 1 in Beard (1980)
+!
+! Reference value of the dynamic viscosity of air
+ZETA0 = (1.718E-5 + 0.0049E-5 * (PTHVREFZIKB - CST%XTT))
+!
+ZRHO00 = CST%XP00 / (CST%XRD * PTHVREFZIKB)
+ZCOR00 = ZRHO00**ZCEXVT
+!
+! (rho_0 / eta_0) * (v * lambda^d)
+ZVX = (ZRHO00 / ZETA0) * ZCX * MOMG(ZALPHAX,ZNUX,ZBX+ZDX) / MOMG(ZALPHAX,ZNUX,ZBX)
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. COMPUTE THE VELOCITY ADJUSTMENT FACTOR
+! --------------------------------------
+!
+zreynolds(:,:) = 0.
+PBEARDCOEF(:,:) = 1.0
+!
+DO JK = IKTB, IKTE
+ DO JIJ = IIJB, IIJE
+!++cb++ 09/06/23 on n'applique l'effet Beard que pour les points ou le rapport de melange est
+! suffisamment eleve pour eviter que qE >> mg => coef de Beard tres eleve !
+! Ce pb intervient avec ICE3 pour lequel xrtmin est tres bas par rapport a LIMA.
+ IF (OSEDIM(JIJ,JK) .AND. PRX(JIJ,JK) .GT. XRTMIN_ELEC(KID) .AND. PLBDA(JIJ,JK) .GT. 0.) THEN
+!--cb--
+ ! Temperature K --> C
+ ZT = PT(JIJ,JK) - CST%XTT
+ !
+ ! Pre-factor of f_0
+ IF (ZT >= 0.0) THEN
+ ZF0 = ZETA0 / (1.718E-5 + 0.0049E-5 * ZT)
+ ELSE
+ ZF0 = ZETA0 / (1.718E-5 + 0.0049E-5 * ZT - 1.2E-10 * ZT * ZT)
+ END IF
+ !
+ ! Pre-factor of f_infty
+ ZF1 = SQRT(ZRHO00/PRHODREF(JIJ,JK))
+ !
+ ! compute (1 - K) = 1 - qE/mg
+ ZK = 1. - PQX(JIJ,JK) * PEFIELDW(JIJ,JK) / (PRX(JIJ,JK) * CST%XG)
+ !
+ ! Hyp : K_0 ~ 0
+ ! Hyp : si qE > mg, K > 1
+ IF (ZK <= 0.0) THEN
+ PBEARDCOEF(JIJ,JK) = 0. ! levitation
+ ELSE
+ ! Reynolds number
+ ZRE0 = ZVX / PLBDA(JIJ,JK)**(1.+ZDX)
+ zreynolds(jij,jk) = zre0
+ IF (ZRE0 <= 0.2) THEN
+ PBEARDCOEF(JIJ,JK) = ZF0 * ZK
+ ELSE IF (ZRE0 >= 1000.) THEN
+ PBEARDCOEF(JIJ,JK) = ZF1 * SQRT(ZK)
+ ELSE
+ PBEARDCOEF(JIJ,JK) = ZF0 * ZK + &
+ (ZF1 * SQRT(ZK) - ZF0 * ZK) * &
+ (1.61 + LOG(ZRE0)) / 8.52
+ END IF
+ ! remove the Foote-duToit correction
+ ZCOR = (PRHODREF(JIJ,JK) / ZRHO00)**ZCEXVT
+ PBEARDCOEF(JIJ,JK) = PBEARDCOEF(JIJ,JK) * ZCOR
+ END IF
+ ELSE
+ PBEARDCOEF(JIJ,JK) = 1.0 ! No "Beard" effect
+ END IF
+ END DO
+END DO
+!
+END ASSOCIATE
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE ELEC_BEARD_EFFECT
+END MODULE MODE_ELEC_BEARD_EFFECT
diff --git a/src/common/micro/mode_elec_compute_ex.F90 b/src/common/micro/mode_elec_compute_ex.F90
new file mode 100644
index 0000000000000000000000000000000000000000..7f0977cef7411fe7ba0b8c19ae470b1647e26bf7
--- /dev/null
+++ b/src/common/micro/mode_elec_compute_ex.F90
@@ -0,0 +1,206 @@
+!MNH_LIC Copyright 2022-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 MODE_ELEC_COMPUTE_EX
+! ###########################
+IMPLICIT NONE
+CONTAINS
+!
+!
+! #######################################################
+ SUBROUTINE ELEC_COMPUTE_EX (KID, KMOMENT, KSIZE,HCLOUD, &
+ PDUM, PRHO, PRTMIN, &
+ PRX, PQX, PEX, PLBDX, PCX )
+! #######################################################
+!
+! Purpose : update the parameter e_x in the relation q_x = e_x d**f_x
+! e_x = q_x/(N_x * M(f_x))
+!
+! AUTHOR
+! ------
+! C. Barthe * LAERO *
+!
+! MODIFICATIONS
+! -------------
+! Original June 2022
+!
+!------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_ELEC_PARAM, ONLY : XECMAX, XERMAX, XEIMAX, XESMAX, XEGMAX, XEHMAX, &
+ XFQUPDC, XFQUPDR, XFQUPDI, XEXFQUPDI, XFQUPDS, XFQUPDG, XFQUPDH
+USE MODD_ELEC_DESCR, ONLY : XCXR, XFC, XFR, XFI, XFS, XFG, XFH
+USE MODD_RAIN_ICE_DESCR_n, ONLY : XCXS_I=>XCXS, XCXG_I=>XCXG, XCXH_I=>XCXH
+USE MODD_PARAM_LIMA_COLD, ONLY : XCXS_L=>XCXS
+USE MODD_PARAM_LIMA_MIXED, ONLY : XCXG_L=>XCXG, XCXH_L=>XCXH, XALPHAH, XNUH
+USE MODD_PARAM_LIMA, ONLY : XALPHAC, XALPHAR, XALPHAI, XALPHAS, XALPHAG, &
+ XNUC, XNUR, XNUI, XNUS, XNUG
+!
+USE MODI_MOMG
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of dummy arguments
+!
+INTEGER, INTENT(IN) :: KID ! nb of the hydrometeor category
+INTEGER, INTENT(IN) :: KMOMENT ! nb of moments of the microphysics scheme
+INTEGER, INTENT(IN) :: KSIZE
+REAL, INTENT(IN) :: PDUM ! =1. if mixing ratio
+ ! =timestep if source
+REAL, INTENT(IN) :: PRTMIN
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHO ! reference density
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PQX ! Electric charge
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRX ! Mixing ratio
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PEX ! e coef of the q-D relation
+REAL, DIMENSION(KSIZE), OPTIONAL, INTENT(IN) :: PLBDX ! Slope parameter of the distribution
+REAL, DIMENSION(KSIZE), OPTIONAL, INTENT(IN) :: PCX ! Nb concentration
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+!
+!* 0.2 Declaration of local variables
+!
+REAL :: ZRTMIN, ZFX, ZCX, ZEXMAX, ZFQUPDX, ZALPHAX, ZNUX
+!
+!---------------------------------------------------------------------------------
+!
+!* 1. PRELIMINARIES
+! -------------
+!
+ZRTMIN = PRTMIN / PDUM
+PEX(:) = 0.
+!
+IF (KID == 2) THEN ! parameters for cloud droplets
+ ZFX = XFC
+ ZEXMAX = XECMAX
+ IF (HCLOUD(1:3) == 'ICE') ZFQUPDX = XFQUPDC
+ IF (HCLOUD == 'LIMA') THEN
+ ZALPHAX = XALPHAC
+ ZNUX = XNUC
+ END IF
+ELSE IF (KID == 3) THEN ! parameters for raindrops
+ ZFX = XFR
+ ZCX = XCXR
+ ZEXMAX = XERMAX
+ IF (HCLOUD(1:3) == 'ICE') ZFQUPDX = XFQUPDR
+ IF (HCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
+ ZALPHAX = XALPHAR
+ ZNUX = XNUR
+ END IF
+ELSE IF (KID == 4) THEN ! parameters for ice crystals
+ ZFX = XFI
+ ZEXMAX = XEIMAX
+ IF (HCLOUD(1:3) == 'ICE') ZFQUPDX = XFQUPDI
+ IF (HCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
+ ZALPHAX = XALPHAI
+ ZNUX = XNUI
+ END IF
+ELSE IF (KID == 5) THEN ! parameters for snow/aggregates
+ ZFX = XFS
+ ZEXMAX = XESMAX
+ ZFQUPDX = XFQUPDS
+ IF (HCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
+ ZALPHAX = XALPHAS
+ ZNUX = XNUS
+ ELSE IF (HCLOUD == 'LIMA' .AND. KMOMENT == 1) THEN
+ ZCX = XCXS_L
+ ELSE IF (HCLOUD(1:3) == 'ICE') THEN
+ ZCX = XCXS_I
+ END IF
+ELSE IF (KID == 6) THEN ! parameters for graupel
+ ZFX = XFG
+ ZEXMAX = XEGMAX
+ ZFQUPDX = XFQUPDG
+ IF (HCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
+ ZALPHAX = XALPHAG
+ ZNUX = XNUG
+ ELSE IF (HCLOUD == 'LIMA' .AND. KMOMENT == 1) THEN
+ ZCX = XCXG_L
+ ELSE IF (HCLOUD(1:3) == 'ICE') THEN
+ ZCX = XCXG_I
+ END IF
+ELSE IF (KID == 7) THEN ! parameters for hail
+ ZFX = XFH
+ ZEXMAX = XEHMAX
+ ZFQUPDX = XFQUPDH
+ IF (HCLOUD == 'LIMA' .AND. KMOMENT == 2) THEN
+ ZALPHAX = XALPHAH
+ ZNUX = XNUH
+ ELSE IF (HCLOUD == 'LIMA' .AND. KMOMENT == 1) THEN
+ ZCX = XCXH_L
+ ELSE IF (HCLOUD(1:3) == 'ICE') THEN
+ ZCX = XCXH_I
+ END IF
+END IF
+!
+IF (HCLOUD == 'LIMA') THEN
+ IF (KID == 2) THEN
+ ZALPHAX = XALPHAC
+ ZNUX = XNUC
+ ELSE IF (KID == 3) THEN
+ ZALPHAX = XALPHAR
+ ZNUX = XNUR
+ ELSE IF (KID == 4) THEN
+ ZALPHAX = XALPHAI
+ ZNUX = XNUI
+ ELSE IF (KID == 5) THEN
+ ZALPHAX = XALPHAS
+ ZNUX = XNUS
+ ELSE IF (KID == 6) THEN
+ ZALPHAX = XALPHAG
+ ZNUX = XNUG
+ ELSE IF (KID == 7) THEN
+ ZALPHAX = XALPHAH
+ ZNUX = XNUH
+ END IF
+END IF
+!
+!
+!* 2. UPDATE E_x FOR 2-MOMENT SPECIES
+! -------------------------------
+!
+IF (KMOMENT == 2) THEN
+ WHERE (PRX(:) > ZRTMIN .AND. PCX(:) > 0.0)
+ PEX(:) = PDUM * PRHO(:) * PQX(:) * PLBDX(:)**ZFX / (PCX(:) * MOMG(ZALPHAX,ZNUX,ZFX))
+ ENDWHERE
+!
+!
+!* 3. UPDATE E_x FOR 1-MOMENT SPECIES
+! -------------------------------
+!
+ELSE IF (KMOMENT == 1) THEN
+!
+!* 3.1 Special case of cloud droplets
+!
+ IF (KID == 2) THEN
+ WHERE (PRX(:) > ZRTMIN)
+ PEX(:) = PDUM * PRHO(:) * PQX(:) / ZFQUPDX
+ PEX(:) = SIGN( MIN(ABS(PEX(:)), ZEXMAX), PEX(:))
+ ENDWHERE
+!
+!* 3.2 Special case of ice crystals
+!
+ ELSE IF (KID == 4) THEN
+ WHERE (PRX(:) > ZRTMIN .AND. PCX(:) > 0.0)
+ PEX(:) = PDUM * PRHO(:) * PQX(:) / &
+ ((PCX**(1 - XEXFQUPDI)) * ZFQUPDX * (PRHO(:) * &
+ PDUM * PRX(:))**XEXFQUPDI)
+ PEX(:) = SIGN( MIN(ABS(PEX(:)), ZEXMAX), PEX(:))
+ ENDWHERE
+!
+!* 3.3 Computation for all other hydrometeors
+!
+ ELSE
+ WHERE (PRX(:) > ZRTMIN .AND. PLBDX(:) > 0.)
+ PEX(:) = PDUM * PRHO(:) * PQX(:) / (ZFQUPDX * PLBDX(:)**(ZCX - ZFX))
+ PEX(:) = SIGN( MIN(ABS(PEX(:)), ZEXMAX), PEX(:))
+ ENDWHERE
+ END IF
+END IF
+!
+END SUBROUTINE ELEC_COMPUTE_EX
+END MODULE MODE_ELEC_COMPUTE_EX
diff --git a/src/common/micro/mode_elec_tendencies.F90 b/src/common/micro/mode_elec_tendencies.F90
new file mode 100644
index 0000000000000000000000000000000000000000..af2a62376f1ebd296ca6c3b46f9d88c76e7a74ce
--- /dev/null
+++ b/src/common/micro/mode_elec_tendencies.F90
@@ -0,0 +1,3462 @@
+!MNH_LIC Copyright 2022-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 MODE_ELEC_TENDENCIES
+!
+IMPLICIT NONE
+CONTAINS
+!
+! #########################################################################################
+ SUBROUTINE ELEC_TENDENCIES (D, CST, ICED, ICEP, ELECD, ELECP, &
+ KRR, KMICRO, PTSTEP, ODMICRO, &
+ BUCONF, TBUDGETS, KBUDGETS, &
+ HCLOUD, PTHVREFZIKB, &
+ PRHODREF, PRHODJ, PZT, PCIT, &
+ PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PQPIT, PQCT, PQRT, PQIT, PQST, PQGT, PQNIT, &
+ PQPIS, PQCS, PQRS, PQIS, PQSS, PQGS, PQNIS, &
+ PRVHENI, PRRHONG, PRIMLTC, &
+ PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
+ PRCAUTR, PRCACCR, PRREVAV, &
+ PRCRIMSS, PRCRIMSG, PRSRIMCG, PRRACCSS, PRRACCSG, PRSACCRG, &
+ PRSMLTG, PRICFRRG, PRRCFRIG, &
+ PRCWETG, PRIWETG, PRRWETG, PRSWETG, &
+ PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, &
+ PRGMLTR, PRCBERI, &
+ PRCMLTSR, PRICFRR, & !- opt. param. for ICE3
+ PCCT, PCRT, PCST, PCGT, & !-- optional
+ PRVHENC, PRCHINC, PRVHONH, & !| parameters
+ PRRCVRC, PRICNVI, PRVDEPI, PRSHMSI, PRGHMGI, & !| for
+ PRICIBU, PRIRDSF, & !| LIMA
+ PRCCORR2, PRRCORR2, PRICORR2, & !--
+ PRWETGH, PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, & !-- optional
+ PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, & !| parameters
+ PRHMLTR, PRDRYHG, & !| for
+ PRHT, PRHS, PCHT, PQHT, PQHS) !-- hail
+! ##########################################################################################
+!
+!!**** * - compute the explicit cloud electrification sources
+!!
+!! This routine is adapted from rain_ice_elec.f90.
+!! To avoid duplicated routines, the cloud electrification routine is now CALLed
+!! at the end of the microphysics scheme but needs the microphysical tendencies as arguments.
+!! The sedimentation source for electric charges is treated separately.
+!!
+!! AUTHOR
+!! ------
+!! C. Barthe * LAERO *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original February 2022
+!!
+!! Modifications
+!! C. Barthe 12/04/2022 include electrification from LIMA
+!! C. Barthe 22/03/2023 5-6: take into account news from LIMA (Ns, Ng, Nh, CIBU and RDSF) and PHYEX
+!! C. Barthe 13/07/2023 5-6: Ns, Ng and Nh can be pronostic variables (LIMA2)
+!! C. Barthe 22/11/2023 initialize Nx to 0 when 1-moment
+!!
+!------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_BUDGET, ONLY: NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, &
+ NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ TBUDGETDATA, TBUDGETCONF_t
+!
+USE MODD_CST, ONLY: CST_t
+USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
+USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELECEND
+USE MODD_ELEC_DESCR
+USE MODD_ELEC_PARAM
+USE MODD_ELEC_n
+USE MODD_PARAM_LIMA, ONLY: XALPHAI_L=>XALPHAI, XNUI_L=>XNUI, &
+ XCEXVT_L=>XCEXVT, XRTMIN_L=>XRTMIN, &
+ LCIBU, LRDSF, &
+ NMOM_C, NMOM_R, NMOM_I, NMOM_S, NMOM_G, NMOM_H
+USE MODD_PARAM_LIMA_COLD, ONLY: XAI_L=>XAI, XBI_L=>XBI, &
+ XDS_L=>XDS, XCXS_L=>XCXS, &
+ XCOLEXIS_L=>XCOLEXIS
+USE MODD_PARAM_LIMA_MIXED, ONLY: XDG_L=>XDG, XCXG_L=>XCXG, &
+ XCOLIG_L=>XCOLIG, XCOLEXIG_L=>XCOLEXIG, &
+ XCOLSG_L=>XCOLSG, XCOLEXSG_L=>XCOLEXSG, &
+ NGAMINC_L=>NGAMINC, &
+ NACCLBDAR_L=>NACCLBDAR, NACCLBDAS_L=>NACCLBDAS, &
+ XACCINTP1S_L=>XACCINTP1S, XACCINTP2S_L=>XACCINTP2S, &
+ XACCINTP1R_L=>XACCINTP1R, XACCINTP2R_L=>XACCINTP2R, &
+ NDRYLBDAR_L=>NDRYLBDAR, NDRYLBDAS_L=>NDRYLBDAS, &
+ NDRYLBDAG_L=>NDRYLBDAG, &
+ XDRYINTP1R_L=>XDRYINTP1R, XDRYINTP2R_L=>XDRYINTP2R, &
+ XDRYINTP1S_L=>XDRYINTP1S, XDRYINTP2S_L=>XDRYINTP2S, &
+ XDRYINTP1G_L=>XDRYINTP1G, XDRYINTP2G_L=>XDRYINTP2G, &
+ XRIMINTP1_L=>XRIMINTP1, XRIMINTP2_L=>XRIMINTP2
+!
+!#ifdef MNH_PGI
+!USE MODE_PACK_PGI
+!#endif
+use mode_tools, only: Countjv
+USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_ADD_PHY, BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
+!
+USE MODE_COMPUTE_LAMBDA, ONLY: COMPUTE_LAMBDA
+USE MODE_ELEC_COMPUTE_EX,ONLY: ELEC_COMPUTE_EX
+USE MODI_MOMG
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 Declaration of dummy arguments
+!
+TYPE(DIMPHYEX_t), INTENT(IN) :: D
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF ! budget structure
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(ELEC_PARAM_t), INTENT(IN) :: ELECP ! electrical parameters
+TYPE(ELEC_DESCR_t), INTENT(IN) :: ELECD ! electrical descriptive csts
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS),INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+!
+INTEGER, INTENT(IN) :: KMICRO
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+!
+LOGICAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: ODMICRO ! mask to limit computation
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PZT ! Temperature (K)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PCIT ! Pristine ice n.c. at t
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQPIT ! Positive ion (Nb/kg) at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQNIT ! Negative ion (Nb/kg) at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQCT ! Cloud water charge at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQRT ! Raindrops charge at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQIT ! Pristine ice charge at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQST ! Snow/aggregates charge at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PQGT ! Graupel charge at t
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQPIS ! Positive ion (Nb/kg) source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQNIS ! Negative ion (Nb/kg) source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQCS ! Cloud water charge source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQRS ! Raindrops charge source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQIS ! Pristine ice charge source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQSS ! Snow/aggregates charge source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(INOUT) :: PQGS ! Graupel charge source
+!
+! microphysics rates common to ICE3 and LIMA
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), INTENT(IN) :: PRVHENI, & ! heterogeneous nucleation mixing ratio change (HIND for LIMA)
+ PRCHONI, & ! Homogeneous nucleation
+ PRRHONG, & ! Spontaneous freezing mixing ratio change
+ PRVDEPS, & ! Deposition on r_s,
+ PRIAGGS, & ! Aggregation on r_s
+ PRIAUTS, & ! Autoconversion of r_i for r_s production (CNVS for LIMA)
+ PRVDEPG, & ! Deposition on r_g
+ PRCAUTR, & ! Autoconversion of r_c for r_r production
+ PRCACCR, & ! Accretion of r_c for r_r production
+ PRREVAV, & ! Evaporation of r_r
+ PRIMLTC, & ! Cloud ice melting mixing ratio change
+ PRCBERI, & ! Bergeron-Findeisen effect
+ PRSMLTG, & ! Conversion-Melting of the aggregates
+ PRRACCSS, PRRACCSG, PRSACCRG, & ! Rain accretion onto the aggregates
+ PRCRIMSS, PRCRIMSG, PRSRIMCG, & ! Cloud droplet riming of the aggregates
+ PRICFRRG, PRRCFRIG, & ! Rain contact freezing
+ PRCWETG, PRIWETG, PRRWETG, PRSWETG, & ! Graupel wet growth
+ PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, & ! Graupel dry growth
+ PRGMLTR ! Melting of the graupel
+! microphysics rates specific to ICE3 (knmoments==1)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PRCMLTSR,& ! Cld droplet collection onto aggregates by pos. temp.
+ PRICFRR ! Rain contact freezing (part of ice crystals converted to rain)
+! microphysics rates specific to LIMA (knmoments==2)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PRVHENC, & ! Cld droplet formation
+ PRCHINC, & ! Heterogeneous nucleation of coated IFN
+ PRVHONH, & ! Nucleation of haze
+ PRRCVRC, & ! Conversion of small drops into droplets
+ PRICNVI, & ! Conversion snow --> ice
+ PRVDEPI, & ! Deposition on r_i
+ PRSHMSI, PRGHMGI, & ! Hallett Mossop for snow and graupel
+ PRICIBU, & ! Collisional ice breakup
+ PRIRDSF, & ! Raindrop shattering by freezing
+ PRCCORR2, PRRCORR2, PRICORR2 ! Correction inside LIMA splitting
+! microphysics rates related to hail (krr == 7, lhail = .t.)
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PRWETGH, & ! Conversion of graupel into hail
+ PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, & ! Dry growth of hail
+ PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, & ! Wet growth of hail
+ PRHMLTR, & ! Melting of hail
+ PRDRYHG ! Conversion of hail into graupel
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PCCT ! Cloud droplets conc. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PCRT ! Raindrops conc. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PCST ! Snow conc. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PCGT ! Graupel conc. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PCHT ! Hail conc. at t
+!
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(IN) :: PQHT ! Hail charge at t
+REAL, DIMENSION(D%NIT,D%NJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PQHS ! Hail charge source
+REAL, INTENT(IN) :: PTHVREFZIKB ! Reference thv at IKB for electricity
+!
+!
+!* 0.2 Declaration of local variables
+!
+INTEGER :: II, JJ, JL ! Loop indexes
+INTEGER :: IIB, IIE, & ! Define the domain
+ IJB, IJE, & ! where the microphysical sources
+ IKB, IKE ! must be computed
+INTEGER :: IMICRO ! nb of pts where r_x > 0
+INTEGER, DIMENSION(KMICRO) :: I1
+INTEGER, DIMENSION(KMICRO) :: II1, II2, II3
+!
+LOGICAL, DIMENSION(KMICRO) :: GMASK ! Mask
+!REAL, DIMENSION(KMICRO) :: ZMASK ! to reduce
+INTEGER :: IGMASK ! the computation domain
+!
+REAL, DIMENSION(KMICRO) :: ZRHODREF ! Reference density
+REAL, DIMENSION(KMICRO) :: ZRHODJ ! RHO times Jacobian
+REAL, DIMENSION(KMICRO) :: ZZT ! Temperature
+!
+REAL, DIMENSION(KMICRO) :: ZRVT ! Water vapor m.r. at t
+REAL, DIMENSION(KMICRO) :: ZRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KMICRO) :: ZRRT ! Rain water m.r. at t
+REAL, DIMENSION(KMICRO) :: ZRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(KMICRO) :: ZRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KMICRO) :: ZRGT ! Graupel m.r. at t
+REAL, DIMENSION(KMICRO) :: ZRHT ! Hail m.r. at t
+REAL, DIMENSION(KMICRO) :: ZCCT ! Cloud water conc. at t
+REAL, DIMENSION(KMICRO) :: ZCRT ! Raindrops conc. at t
+REAL, DIMENSION(KMICRO) :: ZCIT ! Pristine ice conc. at t
+REAL, DIMENSION(KMICRO) :: ZCST ! Snow/aggregate conc. at t
+REAL, DIMENSION(KMICRO) :: ZCGT ! Graupel conc. at t
+REAL, DIMENSION(KMICRO) :: ZCHT ! Hail conc. at t
+!
+REAL, DIMENSION(KMICRO) :: ZQPIT ! Positive ion (/kg) at t
+REAL, DIMENSION(KMICRO) :: ZQNIT ! Negative ion (/kg) at t
+REAL, DIMENSION(KMICRO) :: ZQCT ! Cloud water charge at t
+REAL, DIMENSION(KMICRO) :: ZQRT ! Raindrops charge at t
+REAL, DIMENSION(KMICRO) :: ZQIT ! Pristine ice charge at t
+REAL, DIMENSION(KMICRO) :: ZQST ! Snow/aggregate charge at t
+REAL, DIMENSION(KMICRO) :: ZQGT ! Graupel charge at t
+REAL, DIMENSION(KMICRO) :: ZQHT ! Hail charge at t
+!
+REAL, DIMENSION(KMICRO) :: ZQPIS ! Positive ion (/kg) source
+REAL, DIMENSION(KMICRO) :: ZQNIS ! Negative ion (/kg) source
+REAL, DIMENSION(KMICRO) :: ZQCS ! Cloud water charge source
+REAL, DIMENSION(KMICRO) :: ZQRS ! Raindrops charge source
+REAL, DIMENSION(KMICRO) :: ZQIS ! Pristine ice charge source
+REAL, DIMENSION(KMICRO) :: ZQSS ! Snow/aggregate charge source
+REAL, DIMENSION(KMICRO) :: ZQGS ! Graupel charge source
+REAL, DIMENSION(KMICRO) :: ZQHS ! Hail charge source
+!
+REAL, DIMENSION(KMICRO) :: ZLBDAC ! Slope parameter of the droplets distribution
+REAL, DIMENSION(KMICRO) :: ZLBDAR ! Slope parameter of the raindrop distribution
+REAL, DIMENSION(KMICRO) :: ZLBDAI ! Slope parameter of the pristine ice distribution
+REAL, DIMENSION(KMICRO) :: ZLBDAS ! Slope parameter of the aggregate distribution
+REAL, DIMENSION(KMICRO) :: ZLBDAG ! Slope parameter of the graupel distribution
+REAL, DIMENSION(KMICRO) :: ZLBDAH ! Slope parameter of the hail distribution
+!
+REAL, DIMENSION(KMICRO) :: ZECT !
+REAL, DIMENSION(KMICRO) :: ZERT ! e_x coef
+REAL, DIMENSION(KMICRO) :: ZEIT ! in the
+REAL, DIMENSION(KMICRO) :: ZEST ! q_x - D_x relation
+REAL, DIMENSION(KMICRO) :: ZEGT !
+REAL, DIMENSION(KMICRO) :: ZEHT !
+!
+LOGICAL, DIMENSION(KMICRO,4) :: GELEC ! Mask for non-inductive charging
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZDQ, ZDQ_IS, ZDQ_IG, ZDQ_SG
+!
+! Non-inductive charging process following Gardiner et al. (1995)
+REAL, DIMENSION(:), ALLOCATABLE :: ZDELTALWC ! Gap between LWC and a critical LWC
+REAL, DIMENSION(:), ALLOCATABLE :: ZFT ! Fct depending on temperature
+!
+! Non-inductive charging process following Saunders et al. (1991) / EW
+REAL, DIMENSION(:), ALLOCATABLE :: ZEW ! Effective liquid water content
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSK ! constant B
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIM ! d_i exponent
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIN ! v_g/s-v_i
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSM ! d_s exponent
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSN ! v_g-v_s
+REAL, DIMENSION(:), ALLOCATABLE :: ZFQIAGGS, ZFQIDRYGBS
+REAL, DIMENSION(:), ALLOCATABLE :: ZLBQSDRYGB1S, ZLBQSDRYGB2S, ZLBQSDRYGB3S
+!
+! Non-inductive charging process following Saunders and Peck (1998) / RAR
+REAL, DIMENSION(:), ALLOCATABLE :: ZRAR ! Rime accretion rate
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIM_IS ! d_i exponent
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIN_IS ! v_g/s-v_i
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIM_IG ! d_i exponent
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIN_IG ! v_g/s-v_i
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSK_SG ! constant B
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSM_SG ! d_s exponent
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSN_SG ! v_g-v_s
+!
+! Inductive charging process (Ziegler et al., 1991)
+REAL, DIMENSION(:), ALLOCATABLE :: ZEFIELDW ! Vertical component of the electric field
+!
+REAL, DIMENSION(KMICRO) :: ZLIMIT ! Used to limit the charge separated during NI process
+REAL, DIMENSION(KMICRO) :: ZQCOLIS ! Collection efficiency between ice and snow
+REAL, DIMENSION(KMICRO) :: ZQCOLIG ! Collection efficiency between ice and graupeln
+REAL, DIMENSION(KMICRO) :: ZQCOLSG ! Collection efficiency between snow and graupeln
+!
+REAL :: ZRHO00, ZCOR00 ! Surface reference air density
+REAL, DIMENSION(KMICRO) :: ZRHOCOR ! Density correction for fallspeed
+!
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1, IVEC2 ! Vectors of indices for interpolation
+REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1, ZVEC2, ZVEC3 ! Work vectors for interpolation
+REAL, DIMENSION(:), ALLOCATABLE :: ZVECQ1, ZVECQ2, ZVECQ3, ZVECQ4 ! Work vectors for interpolation
+!
+REAL, DIMENSION(KMICRO) :: ZWQ, ZWQ_NI ! Work arrays
+REAL, DIMENSION(KMICRO) :: ZWQ1, ZWQ2, ZWQ3, ZWQ4 ! for
+REAL, DIMENSION(KMICRO,9) :: ZWQ5 ! charge transfer
+!
+! variables used to select between common parameters between ICEx and LIMA
+INTEGER :: IMOM_C, IMOM_R, IMOM_I, IMOM_S, IMOM_G, IMOM_H ! number of moments for each hydrometeor
+INTEGER :: IGAMINC, &
+ IACCLBDAR, IACCLBDAS, &
+ IDRYLBDAR, IDRYLBDAS, IDRYLBDAG
+!
+REAL :: ZCEXVT, &
+ ZALPHAI, ZNUI, ZAI, ZBI, ZDS, ZDG, ZCXS, ZCXG, &
+ ZCOLIS, ZCOLEXIS, ZCOLIG, ZCOLEXIG, ZCOLSG, ZCOLEXSG, &
+ ZACCINTP1S, ZACCINTP2S, ZACCINTP1R, ZACCINTP2R, &
+ ZDRYINTP1R, ZDRYINTP2R, ZDRYINTP1S, ZDRYINTP2S, &
+ ZDRYINTP1G, ZDRYINTP2G, &
+ ZRIMINTP1, ZRIMINTP2
+REAL, DIMENSION(:), ALLOCATABLE :: ZRTMIN
+!
+! microphysical tendencies have to be transformed in 1D arrays
+REAL, DIMENSION(KMICRO) :: ZRVHENI, ZRCHONI, ZRRHONG, ZRVDEPS, ZRIAGGS, &
+ ZRIAUTS, ZRVDEPG, ZRCAUTR, ZRCACCR, ZRREVAV, &
+ ZRIMLTC, ZRCBERI, ZRSMLTG, ZRRACCSS, ZRRACCSG, &
+ ZRSACCRG, ZRCRIMSS, ZRCRIMSG, ZRSRIMCG, ZRICFRRG, &
+ ZRRCFRIG, ZRCWETG, ZRIWETG, ZRRWETG, ZRSWETG, &
+ ZRCDRYG, ZRIDRYG, ZRRDRYG, ZRSDRYG, ZRGMLTR
+! optional microphysical tendencies
+REAL, DIMENSION(:), ALLOCATABLE :: ZRCMLTSR, ZRICFRR, ZRVHENC, ZRCHINC, ZRVHONH, &
+ ZRRCVRC, ZRICNVI, ZRVDEPI, ZRSHMSI, ZRGHMGI, &
+ ZRICIBU, ZRIRDSF, ZRCCORR2, ZRRCORR2, ZRICORR2, &
+ ZRWETGH, ZRCWETH, ZRIWETH, ZRSWETH, ZRGWETH, &
+ ZRRWETH, ZRCDRYH, ZRIDRYH, ZRSDRYH, ZRRDRYH, &
+ ZRGDRYH, ZRHMLTR, ZRDRYHG
+!
+!------------------------------------------------------------------
+ASSOCIATE(XCEXVT_I=>ICED%XCEXVT, XRTMIN_I=>ICED%XRTMIN, &
+ XALPHAI_I=>ICED%XALPHAI, XNUI_I=>ICED%XNUI, XAI_I=>ICED%XAI, XBI_I=>ICED%XBI, &
+ XDS_I=>ICED%XDS, XDG_I=>ICED%XDG, &
+ XCXS_I=>ICED%XCXS, XCXG_I=>ICED%XCXG, &
+ XCOLIS_I=>ICEP%XCOLIS, XCOLEXIS_I=>ICEP%XCOLEXIS, &
+ XCOLIG_I=>ICEP%XCOLIG, XCOLEXIG_I=>ICEP%XCOLEXIG, &
+ XCOLSG_I=>ICEP%XCOLSG, XCOLEXSG_I=>ICEP%XCOLEXSG, &
+ NGAMINC_I=>ICEP%NGAMINC, &
+ NACCLBDAR_I=>ICEP%NACCLBDAR, NACCLBDAS_I=>ICEP%NACCLBDAS, &
+ XACCINTP1S_I=>ICEP%XACCINTP1S, XACCINTP2S_I=>ICEP%XACCINTP2S, &
+ XACCINTP1R_I=>ICEP%XACCINTP1R, XACCINTP2R_I=>ICEP%XACCINTP2R, &
+ NDRYLBDAR_I=>ICEP%NDRYLBDAR, NDRYLBDAS_I=>ICEP%NDRYLBDAS, &
+ NDRYLBDAG_I=>ICEP%NDRYLBDAG, &
+ XDRYINTP1R_I=>ICEP%XDRYINTP1R, XDRYINTP2R_I=>ICEP%XDRYINTP2R, &
+ XDRYINTP1S_I=>ICEP%XDRYINTP1S, XDRYINTP2S_I=>ICEP%XDRYINTP2S, &
+ XDRYINTP1G_I=>ICEP%XDRYINTP1G, XDRYINTP2G_I=>ICEP%XDRYINTP2G, &
+ XRIMINTP1_I=>ICEP%XRIMINTP1, XRIMINTP2_I=>ICEP%XRIMINTP2 )
+!
+!* 1. INITIALIZATIONS
+! ---------------
+!
+!* 1.1 compute the loop bounds
+!
+IIB = D%NIB
+IIE = D%NIE
+IJB = D%NJB
+IJE = D%NJE
+IKB = D%NKB
+IKE = D%NKE
+!
+!
+!* 1.2 select parameters between ICEx and LIMA
+!
+IF (HCLOUD(1:3) == 'ICE') THEN
+ ZCEXVT = XCEXVT_I
+ IMOM_C = 1
+ IMOM_R = 1
+ IMOM_I = 2 ! Ni is diagnostic and always available
+ IMOM_S = 1
+ IMOM_G = 1
+ IF (KRR == 7) THEN
+ IMOM_H = 1
+ ELSE
+ IMOM_H = 0
+ END IF
+ELSE IF (HCLOUD == 'LIMA') THEN
+ ZCEXVT = XCEXVT_L
+ IMOM_C = NMOM_C
+ IMOM_R = NMOM_R
+ IMOM_I = 2 ! Ni is diagnostic and always available
+ IMOM_S = NMOM_S
+ IMOM_G = NMOM_G
+ IMOM_H = NMOM_H
+END IF
+!
+ZRHO00 = CST%XP00 / (CST%XRD * PTHVREFZIKB)
+ZCOR00 = ZRHO00**ZCEXVT
+!
+IF (LINDUCTIVE) ALLOCATE (ZEFIELDW(KMICRO))
+!
+!
+!* 1.3 packing
+!
+! optimization by looking for locations where
+! the microphysical fields are larger than a minimal value only !!!
+!
+IF (KMICRO >= 0) THEN
+ IMICRO = COUNTJV(ODMICRO(:,:,:), II1(:), II2(:), II3(:))
+ !
+ ! some microphysical tendencies are optional: the corresponding 1D arrays must be allocated
+ IF (HCLOUD(1:3) == 'ICE') THEN ! ICE3 scheme
+ ALLOCATE(ZRCMLTSR(IMICRO))
+ ALLOCATE(ZRICFRR(IMICRO))
+ END IF
+ IF (HCLOUD == 'LIMA') THEN ! LIMA scheme
+ ALLOCATE(ZRVHENC(IMICRO))
+ ALLOCATE(ZRCHINC(IMICRO))
+ ALLOCATE(ZRVHONH(IMICRO))
+ ALLOCATE(ZRRCVRC(IMICRO))
+ ALLOCATE(ZRICNVI(IMICRO))
+ ALLOCATE(ZRVDEPI(IMICRO))
+ ALLOCATE(ZRSHMSI(IMICRO))
+ ALLOCATE(ZRGHMGI(IMICRO))
+ ALLOCATE(ZRICIBU(IMICRO))
+ ALLOCATE(ZRIRDSF(IMICRO))
+ ALLOCATE(ZRCCORR2(IMICRO))
+ ALLOCATE(ZRRCORR2(IMICRO))
+ ALLOCATE(ZRICORR2(IMICRO))
+ END IF
+ IF (KRR == 7) THEN ! hail activated
+ ALLOCATE(ZRWETGH(IMICRO))
+ ALLOCATE(ZRCWETH(IMICRO))
+ ALLOCATE(ZRIWETH(IMICRO))
+ ALLOCATE(ZRSWETH(IMICRO))
+ ALLOCATE(ZRGWETH(IMICRO))
+ ALLOCATE(ZRRWETH(IMICRO))
+ ALLOCATE(ZRCDRYH(IMICRO))
+ ALLOCATE(ZRRDRYH(IMICRO))
+ ALLOCATE(ZRIDRYH(IMICRO))
+ ALLOCATE(ZRSDRYH(IMICRO))
+ ALLOCATE(ZRGDRYH(IMICRO))
+ ALLOCATE(ZRHMLTR(IMICRO))
+ ALLOCATE(ZRDRYHG(IMICRO))
+ END IF
+ !
+ DO JL = 1, IMICRO
+ ZZT(JL) = PZT(II1(JL),II2(JL),II3(JL))
+ ZRHODREF(JL) = PRHODREF(II1(JL),II2(JL),II3(JL))
+ ZRHOCOR(JL) = (ZRHO00 / ZRHODREF(JL))**ZCEXVT
+ ZRHODJ(JL) = PRHODJ(II1(JL),II2(JL),II3(JL))
+ !
+ ZCIT(JL) = PCIT(II1(JL),II2(JL),II3(JL))
+ IF (IMOM_C == 2) ZCCT(JL) = PCCT(II1(JL),II2(JL),II3(JL))
+ IF (IMOM_R == 2) ZCRT(JL) = PCRT(II1(JL),II2(JL),II3(JL))
+ IF (IMOM_S == 2) ZCST(JL) = PCST(II1(JL),II2(JL),II3(JL))
+ IF (IMOM_G == 2) ZCGT(JL) = PCGT(II1(JL),II2(JL),II3(JL))
+ IF (IMOM_H == 2) ZCHT(JL) = PCHT(II1(JL),II2(JL),II3(JL))
+ IF (IMOM_C == 1) ZCCT(JL) = 0.
+ IF (IMOM_R == 1) ZCRT(JL) = 0.
+ IF (IMOM_S == 1) ZCST(JL) = 0.
+ IF (IMOM_G == 1) ZCGT(JL) = 0.
+ IF (IMOM_H == 1) ZCHT(JL) = 0.
+ !
+ ZRVT(JL) = PRVT(II1(JL),II2(JL),II3(JL))
+ ZRCT(JL) = PRCT(II1(JL),II2(JL),II3(JL))
+ ZRRT(JL) = PRRT(II1(JL),II2(JL),II3(JL))
+ ZRIT(JL) = PRIT(II1(JL),II2(JL),II3(JL))
+ ZRST(JL) = PRST(II1(JL),II2(JL),II3(JL))
+ ZRGT(JL) = PRGT(II1(JL),II2(JL),II3(JL))
+ IF (KRR == 7) ZRHT(JL) = PRHT(II1(JL),II2(JL),II3(JL))
+ !
+ ZQPIT(JL) = PQPIT(II1(JL),II2(JL),II3(JL))
+ ZQNIT(JL) = PQNIT(II1(JL),II2(JL),II3(JL))
+ ZQCT(JL) = PQCT(II1(JL),II2(JL),II3(JL))
+ ZQRT(JL) = PQRT(II1(JL),II2(JL),II3(JL))
+ ZQIT(JL) = PQIT(II1(JL),II2(JL),II3(JL))
+ ZQST(JL) = PQST(II1(JL),II2(JL),II3(JL))
+ ZQGT(JL) = PQGT(II1(JL),II2(JL),II3(JL))
+ IF (KRR == 7) ZQHT(JL) = PQHT(II1(JL),II2(JL),II3(JL))
+ !
+ ZQPIS(JL) = PQPIS(II1(JL), II2(JL), II3(JL))
+ ZQNIS(JL) = PQNIS(II1(JL), II2(JL), II3(JL))
+ ZQCS(JL) = PQCS(II1(JL), II2(JL), II3(JL))
+ ZQRS(JL) = PQRS(II1(JL), II2(JL), II3(JL))
+ ZQIS(JL) = PQIS(II1(JL), II2(JL), II3(JL))
+ ZQSS(JL) = PQSS(II1(JL), II2(JL), II3(JL))
+ ZQGS(JL) = PQGS(II1(JL), II2(JL), II3(JL))
+ IF (KRR == 7) ZQHS(JL) = PQHS(II1(JL), II2(JL), II3(JL))
+ !
+ IF (LINDUCTIVE) ZEFIELDW(JL) = XEFIELDW(II1(JL), II2(JL), II3(JL))
+ !
+ ! microphysical tendencies
+ ZRVHENI(JL) = PRVHENI(II1(JL), II2(JL), II3(JL))
+ ZRRHONG(JL) = PRRHONG(II1(JL), II2(JL), II3(JL))
+ ZRIMLTC(JL) = PRIMLTC(II1(JL), II2(JL), II3(JL))
+ ZRCHONI(JL) = PRCHONI(II1(JL), II2(JL), II3(JL))
+ ZRVDEPS(JL) = PRVDEPS(II1(JL), II2(JL), II3(JL))
+ ZRIAGGS(JL) = PRIAGGS(II1(JL), II2(JL), II3(JL))
+ ZRIAUTS(JL) = PRIAUTS(II1(JL), II2(JL), II3(JL))
+ ZRVDEPG(JL) = PRVDEPG(II1(JL), II2(JL), II3(JL))
+ ZRCAUTR(JL) = PRCAUTR(II1(JL), II2(JL), II3(JL))
+ ZRCACCR(JL) = PRCACCR(II1(JL), II2(JL), II3(JL))
+ ZRREVAV(JL) = PRREVAV(II1(JL), II2(JL), II3(JL))
+ ZRCRIMSS(JL) = PRCRIMSS(II1(JL), II2(JL), II3(JL))
+ ZRCRIMSG(JL) = PRCRIMSG(II1(JL), II2(JL), II3(JL))
+ ZRSRIMCG(JL) = PRSRIMCG(II1(JL), II2(JL), II3(JL))
+ ZRRACCSS(JL) = PRRACCSS(II1(JL), II2(JL), II3(JL))
+ ZRRACCSG(JL) = PRRACCSG(II1(JL), II2(JL), II3(JL))
+ ZRSACCRG(JL) = PRSACCRG(II1(JL), II2(JL), II3(JL))
+ ZRSMLTG(JL) = PRSMLTG(II1(JL), II2(JL), II3(JL))
+ ZRICFRRG(JL) = PRICFRRG(II1(JL), II2(JL), II3(JL))
+ ZRRCFRIG(JL) = PRRCFRIG(II1(JL), II2(JL), II3(JL))
+ ZRCWETG(JL) = PRCWETG(II1(JL), II2(JL), II3(JL))
+ ZRIWETG(JL) = PRIWETG(II1(JL), II2(JL), II3(JL))
+ ZRRWETG(JL) = PRRWETG(II1(JL), II2(JL), II3(JL))
+ ZRSWETG(JL) = PRSWETG(II1(JL), II2(JL), II3(JL))
+ ZRCDRYG(JL) = PRCDRYG(II1(JL), II2(JL), II3(JL))
+ ZRIDRYG(JL) = PRIDRYG(II1(JL), II2(JL), II3(JL))
+ ZRRDRYG(JL) = PRRDRYG(II1(JL), II2(JL), II3(JL))
+ ZRSDRYG(JL) = PRSDRYG(II1(JL), II2(JL), II3(JL))
+ ZRGMLTR(JL) = PRGMLTR(II1(JL), II2(JL), II3(JL))
+ ZRCBERI(JL) = PRCBERI(II1(JL), II2(JL), II3(JL))
+ IF (HCLOUD(1:3) == 'ICE') THEN
+ ZRCMLTSR(JL) = PRCMLTSR(II1(JL), II2(JL), II3(JL))
+ ZRICFRR(JL) = PRICFRR(II1(JL), II2(JL), II3(JL))
+ END IF
+ IF (HCLOUD == 'LIMA') THEN
+ ZCST(JL) = PCST(II1(JL), II2(JL), II3(JL))
+ ZCGT(JL) = PCGT(II1(JL), II2(JL), II3(JL))
+ ZRVHENC(JL) = PRVHENC(II1(JL), II2(JL), II3(JL))
+ ZRCHINC(JL) = PRCHINC(II1(JL), II2(JL), II3(JL))
+ ZRVHONH(JL) = PRVHONH(II1(JL), II2(JL), II3(JL))
+ ZRRCVRC(JL) = PRRCVRC(II1(JL), II2(JL), II3(JL))
+ ZRICNVI(JL) = PRICNVI(II1(JL), II2(JL), II3(JL))
+ ZRVDEPI(JL) = PRVDEPI(II1(JL), II2(JL), II3(JL))
+ ZRSHMSI(JL) = PRSHMSI(II1(JL), II2(JL), II3(JL))
+ ZRGHMGI(JL) = PRGHMGI(II1(JL), II2(JL), II3(JL))
+ ZRICIBU(JL) = PRICIBU(II1(JL), II2(JL), II3(JL))
+ ZRIRDSF(JL) = PRIRDSF(II1(JL), II2(JL), II3(JL))
+ ZRCCORR2(JL) = PRCCORR2(II1(JL), II2(JL), II3(JL))
+ ZRRCORR2(JL) = PRRCORR2(II1(JL), II2(JL), II3(JL))
+ ZRICORR2(JL) = PRICORR2(II1(JL), II2(JL), II3(JL))
+ END IF
+ IF (KRR == 7) THEN
+ ZCHT(JL) = PCHT(II1(JL), II2(JL), II3(JL))
+ ZRWETGH(JL) = PRWETGH(II1(JL), II2(JL), II3(JL))
+ ZRCWETH(JL) = PRCWETH(II1(JL), II2(JL), II3(JL))
+ ZRIWETH(JL) = PRIWETH(II1(JL), II2(JL), II3(JL))
+ ZRSWETH(JL) = PRSWETH(II1(JL), II2(JL), II3(JL))
+ ZRGWETH(JL) = PRGWETH(II1(JL), II2(JL), II3(JL))
+ ZRRWETH(JL) = PRRWETH(II1(JL), II2(JL), II3(JL))
+ ZRCDRYH(JL) = PRCDRYH(II1(JL), II2(JL), II3(JL))
+ ZRRDRYH(JL) = PRRDRYH(II1(JL), II2(JL), II3(JL))
+ ZRIDRYH(JL) = PRIDRYH(II1(JL), II2(JL), II3(JL))
+ ZRSDRYH(JL) = PRSDRYH(II1(JL), II2(JL), II3(JL))
+ ZRGDRYH(JL) = PRGDRYH(II1(JL), II2(JL), II3(JL))
+ ZRHMLTR(JL) = PRHMLTR(II1(JL), II2(JL), II3(JL))
+ ZRDRYHG(JL) = PRDRYHG(II1(JL), II2(JL), II3(JL))
+ END IF
+ END DO
+ !
+ ZRHOCOR(:) = (ZRHO00 / ZRHODREF(:))**ZCEXVT
+!
+!
+!* 1.4 allocations for the non-inductive parameterizations
+!
+ IF (CNI_CHARGING == 'GARDI') THEN
+ ALLOCATE( ZDELTALWC(KMICRO) )
+ ALLOCATE( ZFT(KMICRO) )
+ END IF
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'TAKAH' .OR. &
+ CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2' .OR. &
+ CNI_CHARGING == 'TEEWC' .OR. CNI_CHARGING == 'TERAR') THEN
+ ALLOCATE( ZEW(KMICRO) )
+ END IF
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'TAKAH' .OR. CNI_CHARGING == 'TEEWC') THEN
+ ALLOCATE( ZDQ(KMICRO) )
+ END IF
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'TEEWC' ) THEN
+ ALLOCATE( ZSAUNSK(KMICRO) )
+ ALLOCATE( ZSAUNIM(KMICRO) )
+ ALLOCATE( ZSAUNIN(KMICRO) )
+ ALLOCATE( ZSAUNSM(KMICRO) )
+ ALLOCATE( ZSAUNSN(KMICRO) )
+ END IF
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'SAP98' .OR. &
+ CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2' .OR. &
+ CNI_CHARGING == 'TEEWC' .OR. CNI_CHARGING == 'TERAR') THEN
+ ALLOCATE( ZFQIAGGS(KMICRO) )
+ ALLOCATE( ZFQIDRYGBS(KMICRO) )
+ ALLOCATE( ZLBQSDRYGB1S(KMICRO) )
+ ALLOCATE( ZLBQSDRYGB2S(KMICRO) )
+ ALLOCATE( ZLBQSDRYGB3S(KMICRO) )
+ END IF
+!
+ IF (CNI_CHARGING == 'SAP98' .OR. CNI_CHARGING == 'TERAR' .OR. &
+ CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2') THEN
+ ALLOCATE( ZRAR(KMICRO) )
+ ALLOCATE( ZDQ_IS(KMICRO) )
+ ALLOCATE( ZDQ_IG(KMICRO) )
+ ALLOCATE( ZDQ_SG(KMICRO) )
+ ALLOCATE( ZSAUNIM_IS(KMICRO) )
+ ALLOCATE( ZSAUNIN_IS(KMICRO) )
+ ALLOCATE( ZSAUNIM_IG(KMICRO) )
+ ALLOCATE( ZSAUNIN_IG(KMICRO) )
+ ALLOCATE( ZSAUNSK_SG(KMICRO) )
+ ALLOCATE( ZSAUNSM_SG(KMICRO) )
+ ALLOCATE( ZSAUNSN_SG(KMICRO) )
+ END IF
+!
+!
+!* 1.5 select parameters between ICEx and LIMA
+!
+ ALLOCATE(ZRTMIN(KRR))
+ IF (HCLOUD(1:3) == 'ICE') THEN
+! in ini_rain_ice, xrtmin is initialized with dimension 6 (hail not activated) or 7 (hail activated)
+ ZRTMIN(1:KRR) = XRTMIN_I(1:KRR)
+ !
+ ZALPHAI = XALPHAI_I
+ ZNUI = XNUI_I
+ ZAI = XAI_I
+ ZBI = XBI_I
+ ZDS = XDS_I
+ ZDG = XDG_I
+ ZCXS = XCXS_I
+ ZCXG = XCXG_I
+ !
+ ZCOLIS = XCOLIS_I
+ ZCOLEXIS = XCOLEXIS_I
+ ZCOLIG = XCOLIG_I
+ ZCOLEXIG = XCOLEXIG_I
+ ZCOLSG = XCOLSG_I
+ ZCOLEXSG = XCOLEXSG_I
+ !
+ IGAMINC = NGAMINC_I
+ !
+ IACCLBDAR = NACCLBDAR_I
+ IACCLBDAS = NACCLBDAS_I
+ ZACCINTP1S = XACCINTP1S_I
+ ZACCINTP2S = XACCINTP2S_I
+ ZACCINTP1R = XACCINTP1R_I
+ ZACCINTP2R = XACCINTP2R_I
+ !
+ IDRYLBDAR = NDRYLBDAR_I
+ IDRYLBDAS = NDRYLBDAS_I
+ IDRYLBDAG = NDRYLBDAG_I
+ ZDRYINTP1R = XDRYINTP1R_I
+ ZDRYINTP2R = XDRYINTP2R_I
+ ZDRYINTP1S = XDRYINTP1S_I
+ ZDRYINTP2S = XDRYINTP2S_I
+ ZDRYINTP1G = XDRYINTP1G_I
+ ZDRYINTP2G = XDRYINTP2G_I
+ !
+ ZRIMINTP1 = XRIMINTP1_I
+ ZRIMINTP2 = XRIMINTP2_I
+ !
+ ELSE IF (HCLOUD == 'LIMA') THEN
+! in ini_lima, xrtmin is initialized with dimension 7
+ ZRTMIN(1:KRR) = XRTMIN_L(1:KRR)
+ !
+ ZALPHAI = XALPHAI_L
+ ZNUI = XNUI_L
+ ZAI = XAI_L
+ ZBI = XBI_L
+ ZDS = XDS_L
+ ZDG = XDG_L
+ ZCXS = XCXS_L
+ ZCXG = XCXG_L
+ !
+ ZCOLIS = 0.25 ! variable not defined in LIMA, the value of ICEx is used
+ ZCOLEXIS = XCOLEXIS_L
+ ZCOLIG = XCOLIG_L
+ ZCOLEXIG = XCOLEXIG_L
+ ZCOLSG = XCOLSG_L
+ ZCOLEXSG = XCOLEXSG_L
+ !
+ IGAMINC = NGAMINC_L
+ !
+ IACCLBDAR = NACCLBDAR_L
+ IACCLBDAS = NACCLBDAS_L
+ ZACCINTP1S = XACCINTP1S_L
+ ZACCINTP2S = XACCINTP2S_L
+ ZACCINTP1R = XACCINTP1R_L
+ ZACCINTP2R = XACCINTP2R_L
+ !
+ IDRYLBDAR = NDRYLBDAR_L
+ IDRYLBDAS = NDRYLBDAS_L
+ IDRYLBDAG = NDRYLBDAG_L
+ ZDRYINTP1R = XDRYINTP1R_L
+ ZDRYINTP2R = XDRYINTP2R_L
+ ZDRYINTP1S = XDRYINTP1S_L
+ ZDRYINTP2S = XDRYINTP2S_L
+ ZDRYINTP1G = XDRYINTP1G_L
+ ZDRYINTP2G = XDRYINTP2G_L
+ !
+ ZRIMINTP1 = XRIMINTP1_L
+ ZRIMINTP2 = XRIMINTP2_L
+ END IF
+!
+!
+!* 1.6 update the slope parameter of the distribution
+!* and compute N_x if necessary
+!
+ IF (HCLOUD(1:3) == 'ICE') ZCCT(:) = 0.
+ CALL COMPUTE_LAMBDA(2, IMOM_C, KMICRO, HCLOUD, ZRHODREF, ZRTMIN(2), ZRCT, ZCCT, ZLBDAC)
+ CALL COMPUTE_LAMBDA(3, IMOM_R, KMICRO, HCLOUD, ZRHODREF, ZRTMIN(3), ZRRT, ZCRT, ZLBDAR)
+ CALL COMPUTE_LAMBDA(4, IMOM_I, KMICRO, HCLOUD, ZRHODREF, ZRTMIN(4), ZRIT, ZCIT, ZLBDAI)
+ CALL COMPUTE_LAMBDA(5, IMOM_S, KMICRO, HCLOUD, ZRHODREF, ZRTMIN(5), ZRST, ZCST, ZLBDAS)
+ CALL COMPUTE_LAMBDA(6, IMOM_G, KMICRO, HCLOUD, ZRHODREF, ZRTMIN(6), ZRGT, ZCGT, ZLBDAG)
+ IF (KRR == 7) CALL COMPUTE_LAMBDA(7, IMOM_H, KMICRO, HCLOUD, ZRHODREF, ZRTMIN(7), ZRHT, ZCHT, ZLBDAH)
+!
+!
+!* 1.7 update the parameter e in the charge-diameter relationship
+!
+! Compute e_x at time t
+ IF (HCLOUD == 'LIMA') THEN
+ CALL ELEC_COMPUTE_EX(2, IMOM_C, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(2), ZRCT, ZQCT, ZECT, PLBDX=ZLBDAC, PCX=ZCCT)
+ CALL ELEC_COMPUTE_EX(3, IMOM_R, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(3), ZRRT, ZQRT, ZERT, PLBDX=ZLBDAR, PCX=ZCRT)
+ CALL ELEC_COMPUTE_EX(4, IMOM_I, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(4), ZRIT, ZQIT, ZEIT, PLBDX=ZLBDAI, PCX=ZCIT)
+ CALL ELEC_COMPUTE_EX(5, IMOM_S, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(5), ZRST, ZQST, ZEST, PLBDX=ZLBDAS, PCX=ZCST)
+ CALL ELEC_COMPUTE_EX(6, IMOM_G, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(6), ZRGT, ZQGT, ZEGT, PLBDX=ZLBDAG, PCX=ZCGT)
+ IF (KRR == 7) CALL ELEC_COMPUTE_EX(7, IMOM_H, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(7), ZRHT, ZQHT, ZEHT, PLBDX=ZLBDAH, PCX=ZCHT)
+ ELSE IF (HCLOUD(1:3) == 'ICE') THEN
+ CALL ELEC_COMPUTE_EX(2, 1, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(2), ZRCT, ZQCT, ZECT)
+ CALL ELEC_COMPUTE_EX(3, 1, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(3), ZRRT, ZQRT, ZERT, PLBDX=ZLBDAR)
+ CALL ELEC_COMPUTE_EX(4, 1, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(4), ZRIT, ZQIT, ZEIT, PCX=ZCIT)
+ CALL ELEC_COMPUTE_EX(5, 1, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(5), ZRST, ZQST, ZEST, PLBDX=ZLBDAS)
+ CALL ELEC_COMPUTE_EX(6, 1, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(6), ZRGT, ZQGT, ZEGT, PLBDX=ZLBDAG)
+ IF (KRR == 7) CALL ELEC_COMPUTE_EX(7, 1, KMICRO, HCLOUD, 1., ZRHODREF, ZRTMIN(7), ZRHT, ZQHT, ZEHT, PLBDX=ZLBDAH)
+ END IF
+!
+!
+!* 1.8 initialization for the non-inductive charging process
+!
+ SELECT CASE (CNI_CHARGING)
+ ! Initialization for the parameterization of Gardiner et al. (1995)
+ CASE ('GARDI')
+ CALL ELEC_INIT_NOIND_GARDI()
+ ! Save the effective water content
+ DO JL = 1, KMICRO
+ XEW(II1(JL),II2(JL),II3(JL)) = ZDELTALWC(JL) !
+ END DO
+ !
+ ! Initialization for the parameterizations of Saunders et al. (1991)
+ ! with and without anomalies, and Tsenova and Mitzeva (2009)
+ CASE ('SAUN1', 'SAUN2', 'TEEWC')
+ CALL ELEC_INIT_NOIND_EWC()
+ ! Save the effective water content
+ DO JL = 1, KMICRO
+ XEW(II1(JL),II2(JL),II3(JL)) = ZEW(JL) ! g/m3
+ END DO
+ !
+ ! Initialization for the parameterizations of Saunders and Peck (1998),
+ ! Brooks et al. (1997) and Tsenova and Mitzeva (2011)
+ CASE ('SAP98', 'BSMP1', 'BSMP2', 'TERAR')
+ CALL ELEC_INIT_NOIND_RAR()
+ ! Save the rime accretion rate (not recorded properly: 3 different RAR are computed !!!)
+ DO JL = 1, KMICRO
+ XEW(II1(JL),II2(JL),II3(JL)) = ZRAR(JL) ! g/m3
+ END DO
+ !
+ ! Initialization for the parameterization of Takahashi (1978)
+ CASE ('TAKAH')
+ CALL ELEC_INIT_NOIND_TAKAH()
+ ! Save the effective water content
+ DO JL = 1, KMICRO
+ XEW(II1(JL),II2(JL),II3(JL)) = ZEW(JL) ! g/m3
+ END DO
+ END SELECT
+!
+!
+!------------------------------------------------------------------
+!
+!* 2. COMPUTE THE SLOW COLD PROCESS SOURCES
+! -------------------------------------
+!
+!* 2.1 heterogeneous nucleation
+!
+! --> rien n'est fait pour l'elec pour le moment
+! ICE3/4 : rvheni/rvhind
+! LIMA : rvhenc, rchinc, rvhonh
+!
+!
+!* 2.2 spontaneous freezing (rhong)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'SFR', &
+ Unpack( zqrs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'SFR', &
+ Unpack( zqgs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+ ZWQ(:) = 0.
+ WHERE (ZRRHONG(:) > 0. .AND. &
+ ZRRT(:) > XRTMIN_ELEC(3) .AND. ABS(ZQRT(:)) > XQTMIN(3))
+ ZWQ(:) = ZQRS(:)
+ !
+ ZQGS(:) = ZQGS(:) + ZQRS(:)
+ ZQRS(:) = 0.
+ END WHERE
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'SFR', &
+ Unpack( zqrs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'SFR', &
+ Unpack( zqgs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 2.3 cloud ice melting (rimltc)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'IMLT', &
+ Unpack( zqcs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'IMLT', &
+ Unpack( zqis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+ WHERE (ZRIMLTC(:) > 0.)
+ ZQCS(:) = ZQCS(:) + ZQIS(:)
+ ZQIS(:) = 0.
+ END WHERE
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'IMLT', &
+ Unpack( zqcs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'IMLT', &
+ Unpack( zqis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 2.4 riming-conversion of the large sized aggregates into graupel ???
+! ancienne param => on calcule plutot cette tendance un peu plus loin ?
+!
+!
+!* 2.5 homogeneous nucleation (rchoni)
+!
+! CB : traitement different entre ice3 et lima --> a modifier eventuellement
+!
+ ZWQ(:) = 0.
+ WHERE (ZRCHONI(:) > 0. .AND. &
+ ZRCT(:) > XRTMIN_ELEC(2) .AND. &
+ ABS(ZQCT(:)) > XQTMIN(2) .AND. ABS(ZECT(:)) > ELECP%XECMIN)
+ ZWQ(:) = XQHON * ZECT(:) * ZRCHONI(:)
+ ZWQ(:) = SIGN( MIN( ABS(ZQCT(:)/PTSTEP),ABS(ZWQ(:)) ),ZQCS(:) )
+ !
+ ZQIS(:) = ZQIS(:) + ZWQ(:)
+ ZQCS(:) = ZQCS(:) - ZWQ(:)
+ END WHERE
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'HON', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'HON', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 2.6 deposition on snow/aggregates (rvdeps)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'DEPS', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECEND ), 'DEPS', &
+ Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+ ZWQ(:) = 0.
+ !
+ ! Only the sublimation of snow/aggregates is considered (negative part of PRVDEPS)
+ WHERE (ZRVDEPS(:) < 0. .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ABS(ZQST(:)) > XQTMIN(5))
+ ZWQ(:) = XCOEF_RQ_S * ZQST(:) * ZRVDEPS(:) / ZRST(:)
+ ZWQ(:) = SIGN( MIN( ABS(ZQST(:)/PTSTEP),ABS(ZWQ(:)) ),ZQSS(:) )
+ !
+ ZQSS(:) = ZQSS(:) - ZWQ(:)
+ ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ(:)/ELECD%XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ(:)/ELECD%XECHARGE )
+ END WHERE
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'DEPS', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECEND ), 'DEPS', &
+ Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'DEPS', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 2.7 aggregation on snow/aggregates (riaggs)
+!
+ CALL COMPUTE_CHARGE_TRANSFER (ZRIAGGS, ZRIT, ZQIT, PTSTEP, &
+ XRTMIN_ELEC(4), XQTMIN(4), XCOEF_RQ_I, &
+ ZWQ, ZQIS, ZQSS)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'AGGS', &
+ Unpack( -zwq(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'AGGS', &
+ Unpack( zwq(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 2.8 non-inductive charging during ice - snow collisions
+!
+ CALL ELEC_IAGGS_B()
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'NIIS', &
+ Unpack( -zwq_ni(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'NIIS', &
+ Unpack( zwq_ni(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+! Save the NI charging rate
+ DO JL = 1, KMICRO
+ XNI_IAGGS(II1(JL),II2(JL),II3(JL)) = ZWQ_NI(JL) * ZRHODREF(JL) ! C/m3/s
+ END DO
+!
+!
+!* 2.9 autoconversion of r_i for r_s production (riauts/ricnvs)
+!
+ CALL COMPUTE_CHARGE_TRANSFER (ZRIAUTS, ZRIT, ZQIT, PTSTEP, &
+ XRTMIN_ELEC(4), XQTMIN(4), XCOEF_RQ_I, &
+ ZWQ, ZQIS, ZQSS)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'AUTS', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'AUTS', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 2.10 snow --> ice conversion (rscnvi)
+!
+ IF (HCLOUD == 'LIMA') THEN
+ CALL COMPUTE_CHARGE_TRANSFER (ZRICNVI, ZRST, ZQST, PTSTEP, &
+ XRTMIN_ELEC(5), XQTMIN(5), XCOEF_RQ_S, &
+ ZWQ, ZQSS, ZQIS)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'CNVI', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'CNVI', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!* 2.11 water vapor deposition on ice crystals (rvdepi)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'SUBI', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECEND ), 'SUBI', &
+ Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+ !
+ ZWQ(:) = 0.
+ !
+ ! Only the sublimation of ice crystals is considered (negative part of PRVDEPI)
+ WHERE (ZRVDEPI(:) < 0. .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ABS(ZQIT(:)) > XQTMIN(4))
+ ZWQ(:) = XCOEF_RQ_I * ZQIT(:) * ZRVDEPI(:) / ZRIT(:)
+ ZWQ(:) = SIGN( MIN( ABS(ZQIT(:)/PTSTEP),ABS(ZWQ(:)) ),ZQIS(:) )
+ !
+ ZQIS(:) = ZQIS(:) - ZWQ(:)
+ ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ(:)/ELECD%XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ(:)/ELECD%XECHARGE )
+ END WHERE
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'SUBI', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECEND ), 'SUBI', &
+ Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'SUBI', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+ END IF
+!
+!
+!* 2.12 water vapor deposition on graupel (rvdepg)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'DEPG', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECEND ), 'DEPG', &
+ Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+ ZWQ(:) = 0.
+ !
+ ! Only the sublimation of graupel is considered (negative part of PRVDEPG)
+ WHERE (ZRVDEPG(:) < 0. .AND. &
+ ZRGT(:) > XRTMIN_ELEC(6) .AND. ABS(ZQGT(:)) > XQTMIN(6))
+ ZWQ(:) = XCOEF_RQ_G * ZQGT(:) * ZRVDEPG(:) / ZRGT(:)
+ ZWQ(:) = SIGN( MIN( ABS(ZQGT(:)/PTSTEP),ABS(ZWQ(:)) ),ZQGS(:) )
+ !
+ ZQGS(:) = ZQGS(:) - ZWQ(:)
+ ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ(:)/ELECD%XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ(:)/ELECD%XECHARGE )
+ END WHERE
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'DEPG', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECEND ), 'DEPG', &
+ Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'DEPG', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!------------------------------------------------------------------
+!
+!* 3. COMPUTE THE WARM PROCESS SOURCES
+! --------------------------------
+!
+!* 3.1 autoconversion of r_c for r_r production (rcautr)
+!
+ CALL COMPUTE_CHARGE_TRANSFER (ZRCAUTR, ZRCT, ZQCT, PTSTEP, &
+ XRTMIN_ELEC(2), XQTMIN(2), XCOEF_RQ_C, &
+ ZWQ, ZQCS, ZQRS)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'AUTO', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'AUTO', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 3.2 accretion of r_c for r_r production (rcaccr)
+!
+ CALL COMPUTE_CHARGE_TRANSFER (ZRCACCR, ZRCT, ZQCT, PTSTEP, &
+ XRTMIN_ELEC(2), XQTMIN(2), XCOEF_RQ_C, &
+ ZWQ, ZQCS, ZQRS)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'ACCR', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'ACCR', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 3.3 evaporation of raindrops (rrevav)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'REVA', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECEND ), 'REVA', &
+ Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+ ZWQ(:) = 0.
+ WHERE (ZRREVAV(:) > 0. .AND. &
+ ZRRT(:) > XRTMIN_ELEC(3) .AND. ABS(ZQRT(:)) > XQTMIN(3))
+ ZWQ(:) = XCOEF_RQ_R * ZQRT(:) * ZRREVAV(:) / ZRRT(:)
+ ZWQ(:) = SIGN( MIN( ABS(ZQRT(:)/PTSTEP),ABS(ZWQ(:)) ),ZQRS(:) )
+ !
+ ZQRS(:) = ZQRS(:) - ZWQ(:)
+ ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ(:)/ELECD%XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ(:)/ELECD%XECHARGE )
+ END WHERE
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'REVA', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECEND ), 'REVA', &
+ Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'REVA', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 3.4 conversion of drops to droplets (rrcvrc)
+!
+ IF (HCLOUD == 'LIMA') THEN
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'R2C1', &
+ Unpack( zqcs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'R2C1', &
+ Unpack( zqrs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+ CALL COMPUTE_CHARGE_TRANSFER (ZRRCVRC, ZRRT, ZQRT, PTSTEP, &
+ XRTMIN_ELEC(3), XQTMIN(3), XCOEF_RQ_R, &
+ ZWQ, ZQRS, ZQCS)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'R2C1', &
+ Unpack( zqcs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'R2C1', &
+ Unpack( zqrs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+ END IF
+!
+!------------------------------------------------------------------
+!
+!* 4. COMPUTE THE FAST COLD PROCESS SOURCES FOR r_s
+! ---------------------------------------------
+!
+!* 4.1 cloud droplet riming of the aggregates
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'RIM', &
+ Unpack( zqcs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'RIM', &
+ Unpack( zqss(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'RIM', &
+ Unpack( zqgs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!* 4.1.1 riming of the small sized aggregates (rcrimss)
+!
+ CALL COMPUTE_CHARGE_TRANSFER (ZRCRIMSS, ZRCT, ZQCT, PTSTEP, &
+ XRTMIN_ELEC(2), XQTMIN(2), XCOEF_RQ_C, &
+ ZWQ, ZQCS, ZQSS)
+!
+!
+!* 4.1.2 riming conversion of the large sized aggregates into graupel (rcrimsg)
+!
+ ZWQ(:) = 0.
+ WHERE (ZRCRIMSG(:) > 0. .AND. &
+ ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ABS(ZQCT(:)) > XQTMIN(2))
+ ZWQ(:) = XCOEF_RQ_C * ZQCT(:) * ZRCRIMSG(:) / ZRCT(:) ! QCRIMSG
+ ZWQ(:) = SIGN( MIN( ABS(ZQCT(:)/PTSTEP),ABS(ZWQ(:)) ),ZQCS(:) )
+ !
+ ZQGS(:) = ZQGS(:) + ZWQ(:)
+ ZQCS(:) = ZQCS(:) - ZWQ(:)
+ END WHERE
+!
+!
+!* 4.1.3 riming conversion of the large sized aggregates into graupel (rsrimcg)
+!
+ GMASK(:) = .FALSE.
+ IGMASK = 0
+ DO JJ = 1, SIZE(GMASK)
+ IF (ZRSRIMCG(JJ) > 0. .AND. ZZT(JJ) < CST%XTT .AND. &
+ ZRCT(JJ) > XRTMIN_ELEC(2) .AND. ZRST(JJ) > XRTMIN_ELEC(5) .AND. &
+ ZLBDAS(JJ) > 0.) THEN !++cb-- 12/07/23 condition ajoutee pour eviter log(0)
+ IGMASK = IGMASK + 1
+ I1(IGMASK) = JJ
+ GMASK(JJ) = .TRUE.
+ ELSE
+ GMASK(JJ) = .FALSE.
+ END IF
+ END DO
+ !
+ ALLOCATE(ZVEC1(IGMASK))
+ ALLOCATE(ZVEC2(IGMASK))
+ ALLOCATE(IVEC2(IGMASK))
+ !
+ ! select the ZLBDAS
+ DO JJ = 1, IGMASK
+ ZVEC1(JJ) = ZLBDAS(I1(JJ))
+ END DO
+ ! find the next lower indice for the ZLBDAS in the geometrical set of Lbda_s
+ ! used to tabulate some moments of the incomplete gamma function
+ ZVEC2(1:IGMASK) = MAX( 1.00001, MIN( REAL(IGAMINC)-0.00001, &
+ ZRIMINTP1 * LOG( ZVEC1(1:IGMASK) ) + ZRIMINTP2 ) )
+ IVEC2(1:IGMASK) = INT( ZVEC2(1:IGMASK) )
+ ZVEC2(1:IGMASK) = ZVEC2(1:IGMASK) - REAL( IVEC2(1:IGMASK) )
+ !
+ ! perform the linear interpolation of the normalized "XFS"-moment of
+ ! the incomplete gamma function
+ ZVEC1(1:IGMASK) = XGAMINC_RIM3( IVEC2(1:IGMASK)+1 ) * ZVEC2(1:IGMASK) &
+ - XGAMINC_RIM3( IVEC2(1:IGMASK) ) * (ZVEC2(1:IGMASK) - 1.0)
+ !
+ ZWQ(:) = 0.
+ DO JJ = 1, IGMASK
+ ZWQ(I1(JJ)) = ZVEC1(JJ)
+ END DO
+ !
+ DEALLOCATE(ZVEC1)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(IVEC2)
+ !
+ ! riming-conversion of the large sized aggregates into graupeln (rsrimcg)
+ WHERE (ZRSRIMCG(:) > 0. .AND. &
+ ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ABS(ZQCT(:)) > XQTMIN(2) .AND. ABS(ZEST(:)) > XESMIN)
+ ZWQ(:) = XQSRIMCG * ZEST(:) * ZCST(:) * & ! QSRIMCG
+ ZLBDAS(:)**XEXQSRIMCG * (1. - ZWQ(:)) / &
+ (PTSTEP * ZRHODREF(:))
+ ZWQ(:) = SIGN( MIN( ABS(ZQST(:)/PTSTEP),ABS(ZWQ(:)) ),ZQSS(:) )
+ !
+ ZQGS(:) = ZQGS(:) + ZWQ(:)
+ ZQSS(:) = ZQSS(:) - ZWQ(:)
+ END WHERE
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'RIM', &
+ Unpack( zqcs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'RIM', &
+ Unpack( zqss(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'RIM', &
+ Unpack( zqgs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 4.2 Hallett-Mossop ice multiplication process due to snow riming (rhmsi)
+!
+ IF (HCLOUD == 'LIMA') THEN
+ CALL COMPUTE_CHARGE_TRANSFER (ZRSHMSI, ZRST, ZQST, PTSTEP, &
+ XRTMIN_ELEC(4), XQTMIN(4), XCOEF_RQ_S, &
+ ZWQ, ZQSS, ZQIS)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'HMS', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'HMS', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+ END IF
+!
+!
+!* 4.3 Raindrop accretion onto the aggregates
+!
+ IGMASK = 0
+ DO JJ = 1, SIZE(GMASK)
+ IF (ZRRT(JJ) > ZRTMIN(3) .AND. ZLBDAR(JJ) > 0. .AND. &
+ ZRST(JJ) > ZRTMIN(5) .AND. ZLBDAS(JJ) > 0.) THEN
+ IGMASK = IGMASK + 1
+ I1(IGMASK) = JJ
+ GMASK(JJ) = .TRUE.
+ ELSE
+ GMASK(JJ) = .FALSE.
+ END IF
+ END DO
+ !
+ IF (IGMASK > 0) THEN
+ ALLOCATE(ZVEC1(IGMASK))
+ ALLOCATE(ZVEC2(IGMASK))
+ ALLOCATE(IVEC1(IGMASK))
+ ALLOCATE(IVEC2(IGMASK))
+ ALLOCATE(ZVECQ1(IGMASK))
+ ALLOCATE(ZVECQ2(IGMASK))
+ ALLOCATE(ZVECQ3(IGMASK))
+ !
+ ! select the (ZLBDAS,ZLBDAR) couplet
+ DO JJ = 1, IGMASK
+ ZVEC1(JJ) = ZLBDAS(I1(JJ))
+ ZVEC2(JJ) = ZLBDAR(I1(JJ))
+ END DO
+ !
+ ! find the next lower indice for the ZLBDAS and for the ZLBDAR in the geometrical
+ ! set of (Lbda_s,Lbda_r) couplet use to tabulate the kernels
+ ZVEC1(1:IGMASK) = MAX( 1.00001, MIN( REAL(IACCLBDAS)-0.00001, &
+ ZACCINTP1S * LOG( ZVEC1(1:IGMASK) ) + ZACCINTP2S ) )
+ IVEC1(1:IGMASK) = INT( ZVEC1(1:IGMASK) )
+ ZVEC1(1:IGMASK) = ZVEC1(1:IGMASK) - REAL( IVEC1(1:IGMASK) )
+ !
+ ZVEC2(1:IGMASK) = MAX( 1.00001, MIN( REAL(IACCLBDAR)-0.00001, &
+ ZACCINTP1R * LOG( ZVEC2(1:IGMASK) ) + ZACCINTP2R ) )
+ IVEC2(1:IGMASK) = INT( ZVEC2(1:IGMASK) )
+ ZVEC2(1:IGMASK) = ZVEC2(1:IGMASK) - REAL( IVEC2(1:IGMASK) )
+ !
+ ! perform the bilinear interpolation of the normalized kernels
+ ZVECQ1(:) = BI_LIN_INTP_V(XKER_Q_RACCSS, IVEC1, IVEC2, ZVEC1, ZVEC2, IGMASK)
+ ZVECQ2(:) = BI_LIN_INTP_V(XKER_Q_RACCS, IVEC1, IVEC2, ZVEC1, ZVEC2, IGMASK)
+ ZVECQ3(:) = BI_LIN_INTP_V(XKER_Q_SACCRG, IVEC1, IVEC2, ZVEC1, ZVEC2, IGMASK)
+ ZWQ1(:) = 0.
+ ZWQ2(:) = 0.
+ ZWQ3(:) = 0.
+ DO JJ = 1, IGMASK
+ ZWQ1(I1(JJ)) = ZVECQ1(JJ)
+ ZWQ2(I1(JJ)) = ZVECQ2(JJ)
+ ZWQ3(I1(JJ)) = ZVECQ3(JJ)
+ END DO
+!
+ DEALLOCATE(ZVEC1)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(ZVECQ1)
+ DEALLOCATE(ZVECQ2)
+ DEALLOCATE(ZVECQ3)
+!
+!
+!* 4.3.1 raindrop accretion onto the small sized aggregates (rraccss)
+!
+ ZWQ4(:) = 0.
+ ZWQ5(:,:) = 0.
+ WHERE (ZRRACCSS(:) > 0. .AND. &
+ ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCRT(:) > 0. .AND. ZCST(:) > 0. .AND. &
+ ZLBDAR(:) > 0. .AND. ZLBDAS(:) > 0. .AND. &
+ ABS(ZERT(:)) > ELECP%XERMIN) ! and zzt(:) < xtt ?
+ ZWQ4(:) = XFQRACCS * ZERT(:) * ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) * &
+ ZCRT(:) * ZCST(:) * &
+ (XLBQRACCS1 * ZLBDAR(:)**(-2.0 - XFR) + &
+ XLBQRACCS2 * ZLBDAR(:)**(-1.0 - XFR) * ZLBDAS(:)**(-1.0) + &
+ XLBQRACCS3 * ZLBDAR(:)**(-XFR) * ZLBDAS(:)**(-2.0))
+ ZWQ5(:,1) = ZWQ4(:) * ZWQ1(:) ! QRACCSS
+ ZWQ5(:,1) = SIGN( MIN( ABS(ZQRT(:)/PTSTEP),ABS(ZWQ5(:,1)) ),ZQRS(:) )
+ !
+ ZQRS(:) = ZQRS(:) - ZWQ5(:,1)
+ ZQSS(:) = ZQSS(:) + ZWQ5(:,1)
+ END WHERE
+!
+!
+!* 4.3.2 raindrop accretion-conversion of the large sized aggregates into graupel
+!* (rsaccrg & rraccsg)
+!
+ ZWQ5(:,2) = ZWQ2(:) * ZWQ4(:) ! QRACCS
+ WHERE (ZRRACCSG(:) > 0. .AND. &
+ ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZLBDAR(:) > 0. .AND. ZLBDAS(:) > 0.)
+ ZWQ5(:,3) = ZWQ5(:,2) - ZWQ5(:,1) ! QRACCSG
+ ZWQ5(:,3) = SIGN( MIN( ABS(ZQRT(:)/PTSTEP),ABS(ZWQ5(:,3)) ),ZQRS(:) )
+ !
+ ZQRS(:) = ZQRS(:) - ZWQ5(:,3)
+ ZQGS(:) = ZQGS(:) + ZWQ5(:,3)
+ END WHERE
+!
+ WHERE (ZRSACCRG(:) > 0. .AND. &
+ ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCRT(:) > 0. .AND. ZCST(:) > 0. .AND. &
+ ZLBDAR(:) > 0. .AND. ZLBDAS(:) > 0. .AND. &
+ ABS(ZEST) > XESMIN)
+ ZWQ5(:,4) = ZWQ3(:) * XFQRACCS * ZEST(:) * &
+ ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) * &
+ ZCRT(:) * ZCST(:) * &
+ (XLBQSACCRG1 * ZLBDAS(:)**(-2.0 - XFS) + &
+ XLBQSACCRG2 * ZLBDAS(:)**(-1.0 - XFS) * ZLBDAR(:)**(-1.0) + &
+ XLBQSACCRG3 * ZLBDAS(:)**(-XFS) * ZLBDAR(:)**(-2.0)) ! QSACCR
+ ZWQ5(:,4) = SIGN( MIN( ABS(ZQST(:)/PTSTEP),ABS(ZWQ5(:,4)) ),ZQSS(:) )
+ !
+ ZQSS(:) = ZQSS(:) - ZWQ5(:,4)
+ ZQGS(:) = ZQGS(:) + ZWQ5(:,4)
+ END WHERE
+ !
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'ACC', &
+ Unpack( (-zwq5(:,1) - zwq5(:,3)) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'ACC', &
+ Unpack( ( zwq5(:,1) - zwq5(:,4)) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'ACC', &
+ Unpack( ( zwq5(:,3) + zwq5(:,4)) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+ !
+ END IF ! end if igmask>0
+!
+!
+!* 4.4 conversion-melting of the aggregates (rsmltg)
+!
+ CALL COMPUTE_CHARGE_TRANSFER (ZRSMLTG, ZRST, ZQST, PTSTEP, &
+ XRTMIN_ELEC(5), XQTMIN(5), XCOEF_RQ_S, &
+ ZWQ, ZQSS, ZQGS)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'CMEL', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'CMEL', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 4.5 cloud droplet collection onto aggregates by positive temperature (rcmltsr)
+!
+ IF (HCLOUD(1:3) == 'ICE') THEN
+ CALL COMPUTE_CHARGE_TRANSFER (ZRCMLTSR, ZRCT, ZQCT, PTSTEP, &
+ XRTMIN_ELEC(2), XQTMIN(2), XCOEF_RQ_C, &
+ ZWQ, ZQCS, ZQRS)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'CMEL', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'CMEL', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+ END IF
+!
+!
+!------------------------------------------------------------------
+!
+!* 5. COMPUTE THE FAST COLD PROCESS SOURCES FOR r_g
+! ---------------------------------------------
+!
+!* 5.1 rain contact freezing (ricfrrg, rrcfrig, ricfrr)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'CFRZ', &
+ Unpack( zqrs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'CFRZ', &
+ Unpack( zqis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'CFRZ', &
+ Unpack( zqgs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+ !
+ ZWQ(:) = 0.
+ WHERE (ZRRCFRIG(:) > 0. .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRRT(:) > XRTMIN_ELEC(3) .AND. &
+ ZCRT(:) > 0. .AND. &
+ ABS(ZERT(:)) > ELECP%XERMIN .AND. ABS(ZQRT(:)) > XQTMIN(3))
+ ZWQ(:) = XQRCFRIG * ZLBDAR(:)**XEXQRCFRIG * ZCIT(:) * ZCRT(:) * &
+ ZERT(:) * ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) ! QRCFRIG
+ ZWQ(:) = SIGN( MIN( ABS(ZQRT(:)/PTSTEP),ABS(ZWQ(:)) ),ZQRS(:) )
+ !
+ ZQGS(:) = ZQGS(:) + ZWQ(:)
+ ZQRS(:) = ZQRS(:) - ZWQ(:)
+ END WHERE
+ !
+ ZWQ(:) = 0.
+ WHERE (ZRICFRRG(:) > 0. .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRRT(:) > XRTMIN_ELEC(3) .AND. &
+ ABS(ZQIT(:)) > XQTMIN(4))
+ ZWQ(:) = XCOEF_RQ_I * ZQIT(:) * ZRICFRRG(:) / ZRIT(:) ! QICFRRG
+ ZWQ(:) = SIGN( MIN( ABS(ZQIT(:)/PTSTEP),ABS(ZWQ(:)) ),ZQIS(:) )
+ !
+ ZQGS(:) = ZQGS(:) + ZWQ(:)
+ ZQIS(:) = ZQIS(:) - ZWQ(:)
+ ENDWHERE
+!
+!++CB-- 16/06/2022 il manque le traitement de qricfrr
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'CFRZ', &
+ Unpack( zqrs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'CFRZ', &
+ Unpack( zqis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'CFRZ', &
+ Unpack( zqgs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 5.2 graupel dry growth (qcdryg, qrdryg, qidryg & qsdryg)
+!
+ ZWQ5(:,:) = 0.
+!
+!* 5.2.1 compute qcdryg
+!
+ WHERE (ZRCDRYG(:) > 0. .AND. &
+ ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ABS(ZQCT(:)) > XQTMIN(2))
+ ZWQ5(:,1) = XCOEF_RQ_C * ZQCT(:) * ZRCDRYG(:) / ZRCT(:)
+ ZWQ5(:,1) = SIGN( MIN( ABS(ZQCT(:)/PTSTEP),ABS(ZWQ5(:,1)) ),ZQCS(:) )
+ !
+ ZQCS(:) = ZQCS(:) - ZWQ5(:,1)
+ ZQGS(:) = ZQGS(:) + ZWQ5(:,1)
+ ENDWHERE
+!
+!
+!* 5.2.2 compute qidryg = qidryg_coal + qidryg_boun
+!
+ WHERE (ZRIDRYG(:) > 0. .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ABS(ZQIT(:)) > XQTMIN(4))
+ ZWQ5(:,2) = XCOEF_RQ_I * ZQIT(:) * ZRIDRYG(:) / ZRIT(:) ! QIDRYG_coal
+ ZWQ5(:,2) = SIGN( MIN( ABS(ZQIT(:)/PTSTEP),ABS(ZWQ5(:,2)) ),ZQIS(:) )
+ !
+ ZQIS(:) = ZQIS(:) - ZWQ5(:,2)
+ ZQGS(:) = ZQGS(:) + ZWQ5(:,2)
+ END WHERE
+!
+!
+!* 5.2.3 compute non-inductive charging durig ice - graupel collisions
+!
+ ! charge separation during collision between ice and graupel
+ CALL ELEC_IDRYG_B() ! QIDRYG_boun
+ !
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'NIIG', &
+ Unpack( -zwq_ni(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'NIIG', &
+ Unpack( zwq_ni(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+ !
+ ! Save the NI charging rate
+ DO JL = 1, KMICRO
+ XNI_IDRYG(II1(JL),II2(JL),II3(JL)) = ZWQ_NI(JL) * ZRHODREF(JL) ! C/m3/s
+ END DO
+!
+!
+!* 5.2.4 compute qsdryg
+!
+ IGMASK = 0
+ DO JJ = 1, SIZE(GMASK)
+ IF (ZRST(JJ) > ZRTMIN(5) .AND. ZLBDAS(JJ) > 0. .AND. &
+ ZRGT(JJ) > ZRTMIN(6) .AND. ZLBDAG(JJ) > 0.) THEN
+ IGMASK = IGMASK + 1
+ I1(IGMASK) = JJ
+ GMASK(JJ) = .TRUE.
+ ELSE
+ GMASK(JJ) = .FALSE.
+ END IF
+ END DO
+ !
+ IF (IGMASK > 0) THEN
+ !
+ ALLOCATE(ZVEC1(IGMASK))
+ ALLOCATE(ZVEC2(IGMASK))
+ ALLOCATE(IVEC1(IGMASK))
+ ALLOCATE(IVEC2(IGMASK))
+ ALLOCATE(ZVECQ1(IGMASK))
+ ALLOCATE(ZVECQ2(IGMASK))
+ ALLOCATE(ZVECQ3(IGMASK))
+ ALLOCATE(ZVECQ4(IGMASK))
+ !
+ ! select the (ZLBDAG,ZLBDAS) couplet
+ DO JJ = 1, IGMASK
+ ZVEC1(JJ) = ZLBDAG(I1(JJ))
+ ZVEC2(JJ) = ZLBDAS(I1(JJ))
+ END DO
+ !
+ ! find the next lower indice for the ZLBDAG and for the ZLBDAS in the geometrical set
+ ! of (Lbda_g,Lbda_s) couplet use to tabulate the SDRYG-kernel
+ ZVEC1(1:IGMASK) = MAX(1.00001, MIN(REAL(IDRYLBDAG)-0.00001, &
+ ZDRYINTP1G*LOG(ZVEC1(1:IGMASK))+ZDRYINTP2G))
+ IVEC1(1:IGMASK) = INT(ZVEC1(1:IGMASK) )
+ ZVEC1(1:IGMASK) = ZVEC1(1:IGMASK) - REAL(IVEC1(1:IGMASK))
+ !
+ ZVEC2(1:IGMASK) = MAX(1.00001, MIN( REAL(IDRYLBDAS)-0.00001, &
+ ZDRYINTP1S*LOG(ZVEC2(1:IGMASK))+ZDRYINTP2S))
+ IVEC2(1:IGMASK) = INT(ZVEC2(1:IGMASK))
+ ZVEC2(1:IGMASK) = ZVEC2(1:IGMASK) - REAL(IVEC2(1:IGMASK))
+ !
+ ! perform the bilinear interpolation of the normalized QSDRYG-kernels
+ ! normalized Q-SDRYG-kernel
+ ZVECQ1(:) = BI_LIN_INTP_V(XKER_Q_SDRYG, IVEC1, IVEC2, ZVEC1, ZVEC2, IGMASK)
+ ZWQ5(:,3) = 0. ! normalement pas utile
+ DO JJ = 1, IGMASK
+ ZWQ5(I1(JJ),3) = ZVECQ1(JJ)
+ END DO
+ !
+ ! normalized Q-???-kernel
+ IF (CNI_CHARGING == 'TAKAH' .OR. CNI_CHARGING == 'SAUN1' .OR. &
+ CNI_CHARGING == 'SAUN2' .OR. CNI_CHARGING == 'SAP98' .OR. &
+ CNI_CHARGING == 'GARDI' .OR. &
+ CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2' .OR. &
+ CNI_CHARGING == 'TEEWC' .OR. CNI_CHARGING == 'TERAR') THEN
+ ZVECQ2(:) = BI_LIN_INTP_V(XKER_Q_LIMSG, IVEC1, IVEC2, ZVEC1, ZVEC2, IGMASK)
+ ZWQ5(:,4) = 0. ! normalement pas utile
+ DO JJ = 1, IGMASK
+ ZWQ5(I1(JJ),4) = ZVECQ2(JJ)
+ END DO
+ END IF
+ !
+ ! normalized Q-SDRYG-bouncing kernel
+ IF (CNI_CHARGING == 'TAKAH' .OR. CNI_CHARGING == 'HELFA' .OR. &
+ CNI_CHARGING == 'GARDI') THEN
+ ZVECQ3(:) = BI_LIN_INTP_V(XKER_Q_SDRYGB,IVEC1,IVEC2,ZVEC1,ZVEC2,IGMASK)
+ ZWQ5(:,5) = 0. ! normalement pas utile
+ DO JJ = 1, IGMASK
+ ZWQ5(I1(JJ),5) = ZVECQ3(JJ)
+ END DO
+ ELSE
+ ZVECQ3(:) = BI_LIN_INTP_V(XKER_Q_SDRYGB1,IVEC1,IVEC2,ZVEC1,ZVEC2,IGMASK)
+ ZVECQ4(:) = BI_LIN_INTP_V(XKER_Q_SDRYGB2,IVEC1,IVEC2,ZVEC1,ZVEC2,IGMASK)
+ ZWQ5(:,6:7) = 0. ! normalement pas utile
+ DO JJ = 1, IGMASK
+ ZWQ5(I1(JJ),6) = ZVECQ3(JJ) ! Dvqsgmn if charge>0
+ ZWQ5(I1(JJ),7) = ZVECQ4(JJ) ! Dvqsgmn if charge<0
+ END DO
+ ENDIF
+ !
+ DEALLOCATE(ZVEC1)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(ZVECQ1)
+ DEALLOCATE(ZVECQ2)
+ DEALLOCATE(ZVECQ3)
+ DEALLOCATE(ZVECQ4)
+!
+!++CB-- CALCULER E_SG ICI POUR EVITER DES CALCULS REDONDANTS
+ !
+ ! compute QSDRYG_coal
+ WHERE (ZRSDRYG(:) > 0 .AND. & !GDRY(:) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAG(:) > 0. .AND. &
+ ABS(ZQST(:)) > XQTMIN(5) .AND. ABS(ZEST(:)) > XESMIN)
+ ZWQ5(:,3) = ZWQ5(:,3) * XFQSDRYG * &
+ ZCOLSG * EXP(ZCOLEXSG * (ZZT(:) - CST%XTT)) * &
+ ZEST(:) * ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) * &
+ ZCGT(:) * ZCST(:) * &
+ (XLBQSDRYG1 * ZLBDAS(:)**(-2.0-XFS) + &
+ XLBQSDRYG2 * ZLBDAS(:)**(-1.0-XFS) * ZLBDAG(:)**(-1.0) + &
+ XLBQSDRYG3 * ZLBDAS(:)**(-XFS) * ZLBDAG(:)**(-2.0)) ! QSDRYG_coal
+ ZWQ5(:,3) = SIGN( MIN( ABS(ZQST(:)/PTSTEP),ABS(ZWQ5(:,3)) ),ZQSS(:) )
+ !
+ ZQSS(:) = ZQSS(:) - ZWQ5(:,3)
+ ZQGS(:) = ZQGS(:) + ZWQ5(:,3)
+ ELSEWHERE
+ ZWQ5(:,3) = 0.
+ END WHERE
+!
+!
+!* 5.2.5 compute non-inductive charging during snow - graupel collisions
+!
+ ! compute QSDRYG_boun
+ CALL ELEC_SDRYG_B()
+ !
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'NISG', &
+ Unpack( -zwq_ni(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'NISG', &
+ Unpack( zwq_ni(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+ !
+ ! Save the NI charging rate
+ DO JL = 1, KMICRO
+ XNI_SDRYG(II1(JL),II2(JL),II3(JL)) = ZWQ_NI(JL) * ZRHODREF(JL) ! C/m3/s
+ END DO
+ END IF ! end if igmask>0
+!
+!
+!* 5.2.6 compute qrdryg
+!
+ IGMASK = 0
+ GMASK(:) = .FALSE.
+ DO JJ = 1, SIZE(GMASK)
+ IF (ZRRT(JJ) > ZRTMIN(3) .AND. ZLBDAR(JJ) > 0. .AND. &
+ ZRGT(JJ) > ZRTMIN(6) .AND. ZLBDAG(JJ) > 0.) THEN
+ IGMASK = IGMASK + 1
+ I1(IGMASK) = JJ
+ GMASK(JJ) = .TRUE.
+ ELSE
+ GMASK(JJ) = .FALSE.
+ END IF
+ END DO
+ !
+ IF (IGMASK > 0) THEN
+ !
+ ALLOCATE(ZVEC1(IGMASK))
+ ALLOCATE(ZVEC2(IGMASK))
+ ALLOCATE(IVEC1(IGMASK))
+ ALLOCATE(IVEC2(IGMASK))
+ ALLOCATE(ZVECQ1(IGMASK))
+ !
+ ! select the (ZLBDAG,ZLBDAR) couplet
+ DO JJ = 1, IGMASK
+ ZVEC1(JJ) = ZLBDAG(I1(JJ))
+ ZVEC2(JJ) = ZLBDAR(I1(JJ))
+ END DO
+ !
+ ! find the next lower indice for the ZLBDAG and for the ZLBDAR in the geometrical set
+ ! of (Lbda_g,Lbda_r) couplet use to tabulate the QDRYG-kernel
+ ZVEC1(1:IGMASK) = MAX(1.00001, MIN( REAL(IDRYLBDAG)-0.00001, &
+ ZDRYINTP1G*LOG(ZVEC1(1:IGMASK))+ZDRYINTP2G))
+ IVEC1(1:IGMASK) = INT(ZVEC1(1:IGMASK))
+ ZVEC1(1:IGMASK) = ZVEC1(1:IGMASK) - REAL(IVEC1(1:IGMASK))
+ !
+ ZVEC2(1:IGMASK) = MAX(1.00001, MIN( REAL(IDRYLBDAR)-0.00001, &
+ ZDRYINTP1R*LOG(ZVEC2(1:IGMASK))+ZDRYINTP2R))
+ IVEC2(1:IGMASK) = INT(ZVEC2(1:IGMASK))
+ ZVEC2(1:IGMASK) = ZVEC2(1:IGMASK) - REAL(IVEC2(1:IGMASK))
+ !
+ ! perform the bilinear interpolation of the normalized RDRYG-kernel
+ ZVECQ1(:) = BI_LIN_INTP_V(XKER_Q_RDRYG, IVEC1, IVEC2, ZVEC1, ZVEC2, IGMASK)
+ ZWQ5(:,4) = 0.
+ DO JJ = 1, IGMASK
+ ZWQ5(I1(JJ),4) = ZVECQ1(JJ)
+ END DO
+ !
+ DEALLOCATE(ZVEC1)
+ DEALLOCATE(ZVEC2)
+ DEALLOCATE(IVEC1)
+ DEALLOCATE(IVEC2)
+ DEALLOCATE(ZVECQ1)
+ !
+ ! compute QRDRYG
+ WHERE (ZRRDRYG(:) > 0. .AND. &
+ ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZCRT(:) > 0. .AND. ZCGT(:) > 0. .AND. &
+ ZLBDAR(:) > 0. .AND. ZLBDAG(:) > 0. .AND. &
+ ABS(ZERT(:)) > ELECP%XERMIN .AND. ABS(ZQRT(:)) > XQTMIN(3))
+ ZWQ5(:,4) = ZWQ5(:,4) * XFQRDRYG * &
+ ZRHODREF(:)**(-ZCEXVT) * &
+ ZERT(:) * ZCGT(:) * ZCRT(:) * &
+ (XLBQRDRYG1 * ZLBDAR(:)**(-2.0 - XFR) + &
+ XLBQRDRYG2 * ZLBDAR(:)**(-1.0 - XFR) * ZLBDAG(:)**(-1.0) + &
+ XLBQRDRYG3 * ZLBDAR(:)**(-XFR) * ZLBDAG(:)**(-2.0))
+ ZWQ5(:,4) = SIGN( MIN( ABS(ZQRT(:)/PTSTEP),ABS(ZWQ5(:,4)) ),ZQRS(:) )
+ !
+ ZQRS(:) = ZQRS(:) - ZWQ5(:,4)
+ ZQGS(:) = ZQGS(:) + ZWQ5(:,4)
+ ELSEWHERE
+ ZWQ5(:,4) = 0.
+ ENDWHERE
+! ZRDRYG(:) = ZWQ5(:,1) + ZWQ5(:,2) + ZWQ5(:,3) + ZWQ5(:,4)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'DRYG', &
+ Unpack( -zwq5(:,1) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'DRYG', &
+ Unpack( -zwq5(:,4) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'DRYG', &
+ Unpack( -zwq5(:,2) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'DRYG', &
+ Unpack( -zwq5(:,3) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'DRYG', &
+ Unpack( (zwq5(:,1) + zwq5(:,2) + zwq5(:,3) + zwq5(:,4)) * zrhodj(:), &
+ mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+ END IF ! end if igmask>0
+!
+!
+!* 5.3 Hallett-Mossop ice multiplication process due to graupel riming (rhmgi)
+!
+ IF (HCLOUD == 'LIMA') THEN
+ CALL COMPUTE_CHARGE_TRANSFER (ZRGHMGI, ZRGT, ZQGT, PTSTEP, &
+ XRTMIN_ELEC(6), XQTMIN(6), XCOEF_RQ_G, &
+ ZWQ, ZQGS, ZQIS)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'HMG', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'HMG', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+ END IF
+!
+!
+!* 5.4 graupel wet growth (rcwetg, rrwetg, riwetg & rswetg)
+!
+!* 5.4.1 compute qcwetg
+!
+ ZWQ5(:,5) = 0.
+ WHERE (ZRCWETG(:) > 0. .AND. ZRCT(:) > XRTMIN_ELEC(2) .AND. ABS(ZQCT(:)) > XQTMIN(2) .AND. &
+ ZRGT(:) > XRTMIN_ELEC(6))
+ ZWQ5(:,5) = XCOEF_RQ_C * ZRCWETG(:) * ZQCT(:) / ZRCT(:)
+ ZWQ5(:,5) = SIGN( MIN( ABS(ZQCT(:)/PTSTEP),ABS(ZWQ5(:,5)) ),ZQCS(:) )
+ END WHERE
+!
+!
+!* 5.4.1 compute qiwetg
+!
+ ZWQ5(:,6) = 0.
+ WHERE (ZRIWETG(:) > 0. .AND. ZRIT(:) > XRTMIN_ELEC(4) .AND. ABS(ZQIT(:)) > XQTMIN(4) .AND. &
+ ZRGT(:) > XRTMIN_ELEC(6))
+ ZWQ5(:,6) = XCOEF_RQ_I * ZRIWETG(:) * ZQIT(:) / ZRIT(:)
+ ZWQ5(:,6) = SIGN( MIN( ABS(ZQIT(:)/PTSTEP),ABS(ZWQ5(:,6)) ),ZQIS(:) )
+ END WHERE
+!
+!
+!* 5.4.2 compute qswetg
+!
+ ZWQ5(:,7) = 0.
+ WHERE (ZRSWETG(:) > 0. .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. ABS(ZQST(:)) > XQTMIN(5) .AND. &
+ ZRGT(:) > XRTMIN_ELEC(6))
+ ZWQ5(:,7) = XCOEF_RQ_S * ZRSWETG(:) * ZQST(:) / ZRST(:)
+ ZWQ5(:,7) = SIGN( MIN( ABS(ZQST(:)/PTSTEP),ABS(ZWQ5(:,7)) ),ZQSS(:) )
+ END WHERE
+!
+!
+!* 5.4.3 compute qrwetg
+!
+ ZWQ5(:,8) = 0.
+ WHERE (ZRRWETG(:) > 0. .AND. ZRRT(:) > XRTMIN_ELEC(3) .AND. ABS(ZQRT(:)) > XQTMIN(3) .AND. &
+ ZRGT(:) > XRTMIN_ELEC(6))
+ ZWQ5(:,8) = XCOEF_RQ_R * ZQRT(:) * ZRRWETG(:) / ZRRT(:)
+ ZWQ5(:,8) = SIGN( MIN( ABS(ZQRT(:)/PTSTEP),ABS(ZWQ5(:,8)) ),ZQRS(:) )
+ ENDWHERE
+!
+!
+!* 5.4.4 conversion of graupel into hail (rwetgh)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'WETG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+ IF (KRR == 7) THEN
+ ZWQ5(:,9) = 0.
+ WHERE (ZRWETGH(:) > 0. .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. ABS(ZQGT(:)) > XQTMIN(6))
+ ZWQ5(:,9) = XCOEF_RQ_G * ZQGT(:) * ZRWETGH(:) / ZRGT(:)
+ ZWQ5(:,9) = SIGN( MIN( ABS(ZQGT(:)/PTSTEP),ABS(ZWQ5(:,9)) ),ZQGS(:) )
+ END WHERE
+ !
+ WHERE (ZRCWETG(:) > 0. .OR. ZRRWETG(:) > 0. .OR. ZRIWETG(:) > 0. .OR. &
+ ZRSWETG(:) > 0. .OR. ZRWETGH(:) > 0.)
+ ZQCS(:) = ZQCS(:) - ZWQ5(:,5)
+ ZQRS(:) = ZQRS(:) - ZWQ5(:,8)
+ ZQIS(:) = ZQIS(:) - ZWQ5(:,6)
+ ZQSS(:) = ZQSS(:) - ZWQ5(:,7)
+ ZQGS(:) = ZQGS(:) + ZWQ5(:,5) + ZWQ5(:,8) + ZWQ5(:,6) + ZWQ5(:,7) - ZWQ5(:,9)
+ ZQHS(:) = ZQHS(:) + ZWQ5(:,9)
+ END WHERE
+ ELSE IF (KRR == 6) THEN
+ WHERE (ZRCWETG(:) > 0. .OR. ZRRWETG(:) > 0. .OR. ZRIWETG(:) > 0. .OR. &
+ ZRSWETG(:) > 0.)
+ ZQCS(:) = ZQCS(:) - ZWQ5(:,5)
+ ZQRS(:) = ZQRS(:) - ZWQ5(:,8)
+ ZQIS(:) = ZQIS(:) - ZWQ5(:,6)
+ ZQSS(:) = ZQSS(:) - ZWQ5(:,7)
+ ZQGS(:) = ZQGS(:) + ZWQ5(:,5) + ZWQ5(:,8) + ZWQ5(:,6) + ZWQ5(:,7)
+ END WHERE
+ END IF
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'WETG', &
+ Unpack( -zwq5(:,5) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'WETG', &
+ Unpack( -zwq5(:,8) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'WETG', &
+ Unpack( -zwq5(:,6) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'WETG', &
+ Unpack( -zwq5(:,7) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'WETG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ if ( krr == 7 ) &
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 6 ), 'WETG', &
+ Unpack( zwq5(:,9) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 5.5 compute charge separation by the inductive mechanism
+!
+! Computation of the charge transfer rate during inductive mechanism
+! Only the bouncing droplet-graupel collision when the graupel is in the dry
+! growth mode is considered
+! The electric field is limited to 100 kV/m
+!
+ IF (LINDUCTIVE) THEN
+ ZWQ(:) = 0.
+ GMASK(:) = ZRCDRYG(:) > 0.
+ IGMASK = COUNT(GMASK(:))
+ !
+ IF (IGMASK > 0) THEN
+ ZWQ(:) = 0.
+ !
+ WHERE (GMASK(:) .AND. &
+ ZEFIELDW(:) /= 0. .AND. ABS(ZEGT(:)) > ELECP%XEGMIN .AND. &
+ ZLBDAG(:) > 0. .AND. ZCGT(:) > 0. .AND. &
+ ZRGT(:) > XRTMIN_ELEC(6) .AND. ZRCT(:) > XRTMIN_ELEC(2))
+ ZWQ(:) = XIND1 * ZCGT(:) * ZRHOCOR(:) * &
+ (XIND2 * SIGN(MIN(100.E3, ABS(ZEFIELDW(:))), ZEFIELDW(:)) * &
+ ZLBDAG(:) **(-2.-ZDG) - &
+ XIND3 * ZEGT(:) * ZLBDAG(:)**(-XFG-ZDG))
+ ZWQ(:) = ZWQ(:) / ZRHODREF(:)
+ !
+ ZQGS(:) = ZQGS(:) + ZWQ(:)
+ ZQCS(:) = ZQCS(:) - ZWQ(:)
+ END WHERE
+ !
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'INCG', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'INCG', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+ !
+ ! Save the inductive charging rate
+ DO JL = 1, KMICRO
+ XIND_RATE(II1(JL),II2(JL),II3(JL)) = ZWQ(JL) * ZRHODREF(JL) ! C/m3/s
+ END DO
+ END IF
+ !
+ ! Save the inductive charging rate
+ DO JL = 1, KMICRO
+ XIND_RATE(II1(JL),II2(JL),II3(JL)) = ZWQ(JL) * ZRHODREF(JL) ! C/m3/s
+ END DO
+ END IF
+!
+!
+!* 5.6 melting of the graupel (rgmltr)
+!
+ CALL COMPUTE_CHARGE_TRANSFER (ZRGMLTR, ZRGT, ZQGT, PTSTEP, &
+ XRTMIN_ELEC(6), XQTMIN(6), XCOEF_RQ_G, &
+ ZWQ, ZQGS, ZQRS)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'GMLT', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'GMLT', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!------------------------------------------------------------------
+!
+!* 6. COMPUTE THE OPTIONAL SECONDARY ICE PRODUCTION
+! ---------------------------------------------
+!
+! dans un premier temps, on considere que la charge echangee est proportionnelle
+! a la masse echangee
+!
+!* 6.1 collisional ice breakup (cibu)
+!
+ IF (HCLOUD == 'LIMA' .AND. LCIBU) &
+ CALL COMPUTE_CHARGE_TRANSFER (ZRICIBU, ZRST, ZQST, PTSTEP, &
+ XRTMIN_ELEC(5), XQTMIN(5), XCOEF_RQ_S, &
+ ZWQ, ZQSS, ZQIS)
+!
+!* 6.2 raindrop shattering freezing (rdsf)
+!
+ IF (HCLOUD == 'LIMA' .AND. LRDSF) &
+ CALL COMPUTE_CHARGE_TRANSFER (ZRIRDSF, ZRRT, ZQRT, PTSTEP, &
+ XRTMIN_ELEC(3), XQTMIN(3), XCOEF_RQ_R, &
+ ZWQ, ZQRS, ZQIS)
+!
+!
+!------------------------------------------------------------------
+!
+!* 7. COMPUTE THE FAST COLD PROCESS SOURCES FOR r_h
+! ---------------------------------------------
+!
+ IF (KRR == 7) THEN
+!
+!* 7.1 wet growth of hail (qcweth, qrweth, qiweth, qsweth, qgweth)
+!
+ ZWQ5(:,:) = 0.
+ !
+ WHERE (ZRCWETH(:) > 0. .AND. ZRCT(:) > XRTMIN_ELEC(2))
+ ZWQ5(:,1) = XCOEF_RQ_C * ZQCT(:) * ZRCWETH(:) / ZRCT(:) ! QCWETH
+ ZWQ5(:,1) = SIGN( MIN( ABS(ZQCT(:)/PTSTEP),ABS(ZWQ5(:,1)) ),ZQCS(:) )
+ !
+ ZQCS(:) = ZQCS(:) - ZWQ5(:,1)
+ ZQHS(:) = ZQHS(:) + ZWQ5(:,1)
+ END WHERE
+ !
+ WHERE (ZRIWETH(:) > 0. .AND. ZRIT(:) > XRTMIN_ELEC(4))
+ ZWQ5(:,2) = XCOEF_RQ_I * ZQIT(:) * ZRIWETH(:) / ZRIT(:) ! QIWETH
+ ZWQ5(:,2) = SIGN( MIN( ABS(ZQIT(:)/PTSTEP),ABS(ZWQ5(:,2)) ),ZQIS(:) )
+ !
+ ZQIS(:) = ZQIS(:) - ZWQ5(:,2)
+ ZQHS(:) = ZQHS(:) + ZWQ5(:,2)
+ END WHERE
+ !
+ WHERE (ZRSWETH(:) > 0. .AND. ZRST(:) > XRTMIN_ELEC(5))
+ ZWQ5(:,3) = XCOEF_RQ_S * ZQST(:) * ZRSWETH(:) / ZRST(:) ! QSWETH
+ ZWQ5(:,3) = SIGN( MIN( ABS(ZQST(:)/PTSTEP),ABS(ZWQ5(:,3)) ),ZQSS(:) )
+ !
+ ZQSS(:) = ZQSS(:) - ZWQ5(:,3)
+ ZQHS(:) = ZQHS(:) + ZWQ5(:,3)
+ END WHERE
+ !
+ WHERE (ZRGWETH(:) > 0. .AND. ZRGT(:) > XRTMIN_ELEC(6))
+ ZWQ5(:,5) = XCOEF_RQ_G * ZQGT(:) * ZRGWETH(:) / ZRGT(:) ! QGWETH
+ ZWQ5(:,5) = SIGN( MIN( ABS(ZQGT(:)/PTSTEP),ABS(ZWQ5(:,5)) ),ZQGS(:) )
+ !
+ ZQGS(:) = ZQGS(:) - ZWQ5(:,5)
+ ZQHS(:) = ZQHS(:) + ZWQ5(:,5)
+ END WHERE
+ !
+ WHERE (ZRRWETH(:) > 0. .AND. ZRRT(:) > XRTMIN_ELEC(3))
+ ZWQ5(:,4) = XCOEF_RQ_R * ZQRT(:) * ZRRWETH(:) / ZRRT(:) ! QRWETH
+ ZWQ5(:,4) = SIGN( MIN( ABS(ZQRT(:)/PTSTEP),ABS(ZWQ5(:,4)) ),ZQRS(:) )
+ !
+ ZQRS(:) = ZQRS(:) - ZWQ5(:,4)
+ ZQHS(:) = ZQHS(:) + ZWQ5(:,4)
+ END WHERE
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'WETH', &
+ Unpack( -zwq5(:, 1) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'WETH', &
+ Unpack( -zwq5(:, 4) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'WETH', &
+ Unpack( -zwq5(:, 2) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'WETH', &
+ Unpack( -zwq5(:, 3) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'WETH', &
+ Unpack( -zwq5(:, 5) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 6 ), 'WETH', &
+ Unpack( ( zwq5(:, 1) + zwq5(:, 2) + zwq5(:, 3) + zwq5(:, 4) + zwq5(:, 5) ) &
+ * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 7.2 dry growth of hail (qcdryh, qrdryh, qidryh, qsdryh, qgdryh)
+!
+ ZWQ5(:,:) = 0.
+ !
+ WHERE (ZRCDRYH(:) > 0. .AND. ZRCT(:) > XRTMIN_ELEC(2))
+ ZWQ5(:,1) = XCOEF_RQ_C * ZQCT(:) * ZRCDRYH(:) / ZRCT(:) ! QCDRYH
+ ZWQ5(:,1) = SIGN( MIN( ABS(ZQCT(:)/PTSTEP),ABS(ZWQ5(:,1)) ),ZQCS(:) )
+ !
+ ZQCS(:) = ZQCS(:) - ZWQ5(:,1)
+ ZQHS(:) = ZQHS(:) + ZWQ5(:,1)
+ END WHERE
+ !
+ WHERE (ZRIDRYH(:) > 0. .AND. ZRIT(:) > XRTMIN_ELEC(4))
+ ZWQ5(:,2) = XCOEF_RQ_I * ZQIT(:) * ZRIDRYH(:) / ZRIT(:) ! QIDRYH
+ ZWQ5(:,2) = SIGN( MIN( ABS(ZQIT(:)/PTSTEP),ABS(ZWQ5(:,2)) ),ZQIS(:) )
+ !
+ ZQIS(:) = ZQIS(:) - ZWQ5(:,2)
+ ZQHS(:) = ZQHS(:) + ZWQ5(:,2)
+ END WHERE
+ !
+ WHERE (ZRSDRYH(:) > 0. .AND. ZRST(:) > XRTMIN_ELEC(5))
+ ZWQ5(:,3) = XCOEF_RQ_S * ZQST(:) * ZRSDRYH(:) / ZRST(:) ! QSDRYH
+ ZWQ5(:,3) = SIGN( MIN( ABS(ZQST(:)/PTSTEP),ABS(ZWQ5(:,3)) ),ZQSS(:) )
+ !
+ ZQSS(:) = ZQSS(:) - ZWQ5(:,3)
+ ZQHS(:) = ZQHS(:) + ZWQ5(:,3)
+ END WHERE
+ !
+ WHERE (ZRGDRYH(:) > 0. .AND. ZRGT(:) > XRTMIN_ELEC(6))
+ ZWQ5(:,5) = XCOEF_RQ_G * ZQGT(:) * ZRGDRYH(:) / ZRGT(:) ! QGDRYH
+ ZWQ5(:,5) = SIGN( MIN( ABS(ZQGT(:)/PTSTEP),ABS(ZWQ5(:,5)) ),ZQGS(:) )
+ !
+ ZQGS(:) = ZQGS(:) - ZWQ5(:,5)
+ ZQHS(:) = ZQHS(:) + ZWQ5(:,5)
+ END WHERE
+ !
+ WHERE (ZRRDRYH(:) > 0. .AND. ZRRT(:) > XRTMIN_ELEC(3))
+ ZWQ5(:,4) = XCOEF_RQ_R * ZQRT(:) * ZRRDRYH(:) / ZRRT(:) ! QRDRYH
+ ZWQ5(:,4) = SIGN( MIN( ABS(ZQRT(:)/PTSTEP),ABS(ZWQ5(:,4)) ),ZQRS(:) )
+ !
+ ZQRS(:) = ZQRS(:) - ZWQ5(:,4)
+ ZQHS(:) = ZQHS(:) + ZWQ5(:,4)
+ END WHERE
+!
+!
+!* 7.3 conversion of hail into graupel (qdryhg)
+!
+ CALL COMPUTE_CHARGE_TRANSFER (ZRDRYHG, ZRHT, ZQHT, PTSTEP, &
+ XRTMIN_ELEC(7), XQTMIN(7), XCOEF_RQ_H, &
+ ZWQ, ZQHS, ZQGS)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'DRYH', &
+ Unpack( -zwq5(:, 1) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'DRYH', &
+ Unpack( -zwq5(:, 4) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'DRYH', &
+ Unpack( -zwq5(:, 2) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 4 ), 'DRYH', &
+ Unpack( -zwq5(:, 3) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 5 ), 'DRYH', &
+ Unpack( (-zwq5(:, 5) - zwq(:)) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 6 ), 'DRYH', &
+ Unpack( ( zwq5(:, 1) + zwq5(:, 2) + zwq5(:, 3) + zwq5(:, 4) + zwq5(:, 5) + zwq(:) ) &
+ * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!* 7.4 melting of hail (qhmltr)
+!
+ CALL COMPUTE_CHARGE_TRANSFER (ZRHMLTR, ZRHT, ZQHT, PTSTEP, &
+ XRTMIN_ELEC(7), XQTMIN(7), XCOEF_RQ_H, &
+ ZWQ, ZQHS, ZQRS)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'HMLT', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 6 ), 'HMLT', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+ END IF ! end if krr==7
+!
+!
+!------------------------------------------------------------------
+!
+!* 8. COMPUTE THE FAST COLD PROCESS SOURCES FOR r_i
+! ---------------------------------------------
+!
+!* 8.1 Bergeron-Findeisen effect (qcberi)
+!
+ CALL COMPUTE_CHARGE_TRANSFER (ZRCBERI, ZRCT, ZQCT, PTSTEP, &
+ XRTMIN_ELEC(2), XQTMIN(2), XCOEF_RQ_C, &
+ ZWQ, ZQCS, ZQIS)
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'BERFI', &
+ Unpack( -zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'BERFI', &
+ Unpack( zwq(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+!
+!------------------------------------------------------------------
+!
+!* 9. COMPUTE THE CHARGE TRANSFER ASSOCIATED WITH THE CORRECTION TERM
+! ---------------------------------------------------------------
+!
+ IF (HCLOUD == 'LIMA') THEN
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'CORR2', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECEND ), 'CORR2', &
+ Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+!
+ ZWQ1(:) = 0.
+ WHERE (ZRCCORR2(:) .NE. 0. .AND. ZRCT(:) .GT. XRTMIN_ELEC(2))
+ ZWQ1(:) = XCOEF_RQ_C * ZQCT(:) * ZRCCORR2(:) / ZRCT(:)
+ ZWQ(:) = SIGN( MIN( ABS(ZQCT(:)/PTSTEP),ABS(ZWQ1(:)) ),ZQCS(:) )
+ !
+ ZQCS(:) = ZQCS(:) - ZWQ1(:)
+ ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ1(:)/ELECD%XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ1(:)/ELECD%XECHARGE )
+ END WHERE
+ !
+ !
+ ZWQ2(:) = 0.
+ WHERE (ZRRCORR2(:) .NE. 0. .AND. ZRRT(:) .GT. XRTMIN_ELEC(3))
+ ZWQ2(:) = XCOEF_RQ_R * ZQRT(:) * ZRRCORR2(:) / ZRRT(:)
+ ZWQ2(:) = SIGN( MIN( ABS(ZQRT(:)/PTSTEP),ABS(ZWQ2(:)) ),ZQRS(:) )
+ !
+ ZQRS(:) = ZQRS(:) - ZWQ2(:)
+ ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ2(:)/ELECD%XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ2(:)/ELECD%XECHARGE )
+ END WHERE
+ !
+ ZWQ3(:) = 0.
+ WHERE (ZRICORR2(:) .NE. 0. .AND. ZRIT(:) .GT. XRTMIN_ELEC(4))
+ ZWQ3(:) = XCOEF_RQ_I * ZQIT(:) * ZRICORR2(:) / ZRIT(:)
+ ZWQ3(:) = SIGN( MIN( ABS(ZQIT(:)/PTSTEP),ABS(ZWQ3(:)) ),ZQIS(:) )
+ !
+ ZQIS(:) = ZQIS(:) - ZWQ3(:)
+ ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ3(:)/ELECD%XECHARGE )
+ ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ3(:)/ELECD%XECHARGE )
+ END WHERE
+!
+ if ( BUCONF%LBUDGET_SV ) then
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG ), 'CORR2', &
+ Unpack( zqpis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECEND ), 'CORR2', &
+ Unpack( zqnis(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 1 ), 'CORR2', &
+ Unpack( zwq1(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 2 ), 'CORR2', &
+ Unpack( zwq2(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ CALL BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + NSV_ELECBEG + 3 ), 'CORR2', &
+ Unpack( zwq3(:) * zrhodj(:), mask = odmicro(:, :, :), field = 0. ) )
+ end if
+ END IF
+!
+!
+!------------------------------------------------------------------
+!
+!* X. COMPUTE THE SEDIMENTATION SOURCE FOR Q_x
+! ----------------------------------------
+!
+! The sedimentation for electric charges is computed directly
+! in the microphysics scheme
+!
+!
+!------------------------------------------------------------------
+!
+!* 10. UPDATE VOLUMETRIC CHARGE CONCENTRATIONS
+! ---------------------------------------
+!
+ DO JL = 1, KMICRO
+ PQPIS(II1(JL),II2(JL),II3(JL)) = ZQPIS(JL)
+ PQNIS(II1(JL),II2(JL),II3(JL)) = ZQNIS(JL)
+ PQCS (II1(JL),II2(JL),II3(JL)) = ZQCS(JL)
+ PQRS (II1(JL),II2(JL),II3(JL)) = ZQRS(JL)
+ PQIS (II1(JL),II2(JL),II3(JL)) = ZQIS(JL)
+ PQSS (II1(JL),II2(JL),II3(JL)) = ZQSS(JL)
+ PQGS (II1(JL),II2(JL),II3(JL)) = ZQGS(JL)
+ END DO
+ IF ( KRR == 7 ) THEN
+ DO JL = 1, KMICRO
+ PQHS(II1(JL),II2(JL),II3(JL)) = ZQHS(JL)
+ END DO
+ END IF
+END IF ! end if kmicro>0
+!
+!
+!------------------------------------------------------------------
+!
+!* 11. DEALLOCATE
+! ----------
+!
+IF (ALLOCATED( ZDELTALWC )) DEALLOCATE( ZDELTALWC )
+IF (ALLOCATED( ZFT )) DEALLOCATE( ZFT )
+!
+IF (ALLOCATED( ZEW )) DEALLOCATE( ZEW )
+IF (ALLOCATED( ZSAUNSK )) DEALLOCATE( ZSAUNSK )
+IF (ALLOCATED( ZSAUNIM )) DEALLOCATE( ZSAUNIM )
+IF (ALLOCATED( ZSAUNIN )) DEALLOCATE( ZSAUNIN )
+IF (ALLOCATED( ZSAUNSM )) DEALLOCATE( ZSAUNSM )
+IF (ALLOCATED( ZSAUNSN )) DEALLOCATE( ZSAUNSN )
+IF (ALLOCATED( ZFQIAGGS )) DEALLOCATE( ZFQIAGGS )
+IF (ALLOCATED( ZFQIDRYGBS )) DEALLOCATE( ZFQIDRYGBS )
+IF (ALLOCATED( ZLBQSDRYGB1S )) DEALLOCATE( ZLBQSDRYGB1S )
+IF (ALLOCATED( ZLBQSDRYGB2S )) DEALLOCATE( ZLBQSDRYGB2S )
+IF (ALLOCATED( ZLBQSDRYGB3S )) DEALLOCATE( ZLBQSDRYGB3S )
+!
+IF (ALLOCATED( ZDQ )) DEALLOCATE( ZDQ )
+IF (ALLOCATED( ZRAR )) DEALLOCATE( ZRAR )
+IF (ALLOCATED( ZDQ_IS )) DEALLOCATE( ZDQ_IS )
+IF (ALLOCATED( ZSAUNIM_IS )) DEALLOCATE( ZSAUNIM_IS )
+IF (ALLOCATED( ZSAUNIN_IS )) DEALLOCATE( ZSAUNIN_IS )
+IF (ALLOCATED( ZDQ_IG )) DEALLOCATE( ZDQ_IG )
+IF (ALLOCATED( ZSAUNIM_IG )) DEALLOCATE( ZSAUNIM_IG )
+IF (ALLOCATED( ZSAUNIN_IG )) DEALLOCATE( ZSAUNIN_IG )
+IF (ALLOCATED( ZDQ_SG )) DEALLOCATE( ZDQ_SG )
+IF (ALLOCATED( ZSAUNSK_SG )) DEALLOCATE( ZSAUNSK_SG )
+IF (ALLOCATED( ZSAUNSM_SG )) DEALLOCATE( ZSAUNSM_SG )
+IF (ALLOCATED( ZSAUNSN_SG )) DEALLOCATE( ZSAUNSN_SG )
+!
+IF (ALLOCATED( ZEFIELDW )) DEALLOCATE( ZEFIELDW )
+!
+IF (ALLOCATED(ZRCMLTSR)) DEALLOCATE(ZRCMLTSR)
+IF (ALLOCATED(ZRICFRR)) DEALLOCATE(ZRICFRR)
+IF (ALLOCATED(ZRVHENC)) DEALLOCATE(ZRVHENC)
+IF (ALLOCATED(ZRCHINC)) DEALLOCATE(ZRCHINC)
+IF (ALLOCATED(ZRVHONH)) DEALLOCATE(ZRVHONH)
+IF (ALLOCATED(ZRRCVRC)) DEALLOCATE(ZRRCVRC)
+IF (ALLOCATED(ZRICNVI)) DEALLOCATE(ZRICNVI)
+IF (ALLOCATED(ZRVDEPI)) DEALLOCATE(ZRVDEPI)
+IF (ALLOCATED(ZRSHMSI)) DEALLOCATE(ZRSHMSI)
+IF (ALLOCATED(ZRGHMGI)) DEALLOCATE(ZRGHMGI)
+IF (ALLOCATED(ZRICIBU)) DEALLOCATE(ZRICIBU)
+IF (ALLOCATED(ZRIRDSF)) DEALLOCATE(ZRIRDSF)
+IF (ALLOCATED(ZRCCORR2)) DEALLOCATE(ZRCCORR2)
+IF (ALLOCATED(ZRRCORR2)) DEALLOCATE(ZRRCORR2)
+IF (ALLOCATED(ZRICORR2)) DEALLOCATE(ZRICORR2)
+IF (ALLOCATED(ZRWETGH)) DEALLOCATE(ZRWETGH)
+IF (ALLOCATED(ZRCWETH)) DEALLOCATE(ZRCWETH)
+IF (ALLOCATED(ZRIWETH)) DEALLOCATE(ZRIWETH)
+IF (ALLOCATED(ZRSWETH)) DEALLOCATE(ZRSWETH)
+IF (ALLOCATED(ZRGWETH)) DEALLOCATE(ZRGWETH)
+IF (ALLOCATED(ZRRWETH)) DEALLOCATE(ZRRWETH)
+IF (ALLOCATED(ZRCDRYH)) DEALLOCATE(ZRCDRYH)
+IF (ALLOCATED(ZRRDRYH)) DEALLOCATE(ZRRDRYH)
+IF (ALLOCATED(ZRIDRYH)) DEALLOCATE(ZRIDRYH)
+IF (ALLOCATED(ZRSDRYH)) DEALLOCATE(ZRSDRYH)
+IF (ALLOCATED(ZRGDRYH)) DEALLOCATE(ZRGDRYH)
+IF (ALLOCATED(ZRHMLTR)) DEALLOCATE(ZRHMLTR)
+IF (ALLOCATED(ZRDRYHG)) DEALLOCATE(ZRDRYHG)
+!
+!------------------------------------------------------------------
+END ASSOCIATE
+!
+CONTAINS
+!
+! - routines to initialize the non-inductive charging
+! - routines to compute the non-inductive charging
+! - various useful routines
+!
+!------------------------------------------------------------------
+!
+! ##################################
+ SUBROUTINE ELEC_INIT_NOIND_GARDI()
+! ##################################
+!
+!
+! Purpose : initialization for the non-inductive charging process
+! following Gardiner et al. (1985)
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!
+!* 1. COMPUTE f(DeltaT) AND (LWC - LWC_crit)
+! --------------------------------------
+!
+GELEC(:,:) = .FALSE.
+!
+ZDELTALWC(:) = 0.
+ZFT(:) = 0.
+!
+GELEC(:,3) = ZZT(:) > (CST%XTT - 40.) .AND. ZZT(:) < CST%XTT
+GELEC(:,1) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE
+GELEC(:,2) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+GELEC(:,3) = GELEC(:,3) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. &
+ ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+GELEC(:,4) = GELEC(:,1) .OR. GELEC(:,2) .OR. GELEC(:,3)
+!
+WHERE (GELEC(:,4))
+ ! f(DeltaT)
+ ZFT(:) = - 1.7E-5 * ((-21 / (XQTC - CST%XTT)) * (ZZT(:) - CST%XTT))**3 &
+ - 0.003 * ((-21 / (XQTC - CST%XTT)) * (ZZT(:) - CST%XTT))**2 &
+ - 0.05 * ((-21 / (XQTC - CST%XTT)) * (ZZT(:) - CST%XTT)) &
+ + 0.13
+ !
+ ! LWC - LWC_crit
+ ZDELTALWC(:) = (ZRCT(:) * ZRHODREF(:) * 1.E3) - XLWCC ! (g m^-3)
+ENDWHERE
+!
+END SUBROUTINE ELEC_INIT_NOIND_GARDI
+!
+!-----------------------------------------------------------------
+!
+! ################################
+ SUBROUTINE ELEC_INIT_NOIND_EWC()
+! ################################
+!
+!
+! Purpose : initialization for the non-inductive charging process
+! following Saunders et al. (1991)
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!
+!* 1. PARAMETERS FOR POSITIVE NI CHARGING
+! -----------------------------------
+!
+GELEC(:,:) = .FALSE.
+ZDQ(:) = 0.
+ZEW(:) = 0.
+!
+! positive case is the default value
+IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2') THEN
+ ZFQIAGGS(:) = XFQIAGGSP
+ ZFQIDRYGBS(:) = XFQIDRYGBSP
+ELSE IF (CNI_CHARGING == 'TEEWC') THEN
+ ZFQIAGGS(:) = XFQIAGGSP_TAK
+ ZFQIDRYGBS(:) = XFQIDRYGBSP_TAK
+END IF
+ZLBQSDRYGB1S(:) = XLBQSDRYGB1SP
+ZLBQSDRYGB2S(:) = XLBQSDRYGB2SP
+ZLBQSDRYGB3S(:) = XLBQSDRYGB3SP
+ZSAUNIM(:) = XIMP !3.76
+ZSAUNIN(:) = XINP !2.5
+ZSAUNSK(:) = XSKP !52.8
+ZSAUNSM(:) = XSMP !0.44
+ZSAUNSN(:) = XSNP !2.5
+!
+!
+!* 2. PARAMETERS FOR NEGATIVE NI CHARGING
+! -----------------------------------
+!
+! Mansell et al. (2005, JGR): droplet collection efficiency of the graupel ~ 0.6-1.0
+WHERE (ZLBDAG(:) > 0. .AND. ZRCT(:) > 0.)
+ ZEW(:) = 0.8 * ZRCT(:) * ZRHODREF(:) * 1.E3 ! (g m^-3)
+END WHERE
+!
+GELEC(:,3) = ZZT(:) > (CST%XTT - 40.) .AND. ZZT(:) <= CST%XTT .AND. &
+ ZEW(:) >= 0.01 .AND. ZEW(:) <= 10.
+GELEC(:,1) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE
+GELEC(:,2) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+GELEC(:,3) = GELEC(:,3) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. &
+ ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+!
+GELEC(:,4) = GELEC(:,1) .OR. GELEC(:,2) .OR. GELEC(:,3)
+!
+IF (COUNT(GELEC(:,4)) > 0) THEN
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2') THEN
+ CALL INTERP_DQ_TABLE (KMICRO, NIND_TEMP, NIND_LWC, GELEC(:,4), &
+ ZEW, ZZT, XSAUNDER, ZDQ)
+ !
+ WHERE (ZDQ(:) < 0.)
+ ZFQIAGGS(:) = XFQIAGGSN
+ ZFQIDRYGBS(:) = XFQIDRYGBSN
+ END WHERE
+ ELSE IF (CNI_CHARGING == 'TEEWC') THEN
+ CALL INTERP_DQ_TABLE (KMICRO, NIND_TEMP, NIND_LWC, GELEC(:,4), &
+ ZEW, ZZT, XTAKA_TM, ZDQ)
+ !
+ WHERE (ZDQ(:) < 0.)
+ ZFQIAGGS(:) = XFQIAGGSN_TAK
+ ZFQIDRYGBS(:) = XFQIDRYGBSN_TAK
+ END WHERE
+ END IF
+!
+! value of the parameters for the negative case
+ WHERE (ZDQ(:) < 0.)
+ ZLBQSDRYGB1S(:) = XLBQSDRYGB1SN
+ ZLBQSDRYGB2S(:) = XLBQSDRYGB2SN
+ ZLBQSDRYGB3S(:) = XLBQSDRYGB3SN
+ ZSAUNIM(:) = XIMN !2.54
+ ZSAUNIN(:) = XINN !2.8
+ ZSAUNSK(:) = XSKN !24.
+ ZSAUNSM(:) = XSMN !0.5
+ ZSAUNSN(:) = XSNN !2.8
+ ENDWHERE
+ENDIF
+!
+END SUBROUTINE ELEC_INIT_NOIND_EWC
+!
+!------------------------------------------------------------------
+!
+! ################################
+ SUBROUTINE ELEC_INIT_NOIND_RAR()
+! ################################
+!
+!
+! Purpose : initialization for the non-inductive charging process
+! following Saunders and Peck (1998)
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+! local variables
+REAL, DIMENSION(KMICRO) :: ZRAR_CRIT ! critical rime accretion rate
+REAL, DIMENSION(KMICRO) :: ZVGMEAN, & ! mean velocity of graupel
+ ZVSMEAN ! mean velocity of snow
+!
+!
+!* 1. COMPUTE THE CRITICAL RIME ACCRETION RATE
+! ----------------------------------------
+!
+ZRAR_CRIT(:) = 0.
+!
+IF (CNI_CHARGING == 'SAP98') THEN
+!
+ WHERE (ZZT(:) <= CST%XTT .AND. ZZT(:) >= (CST%XTT - 23.7)) ! Original from SAP98
+ ZRAR_CRIT(:) = 1.0 + 7.93E-2 * (ZZT(:) - CST%XTT) + &
+ 4.48E-2 * (ZZT(:) - CST%XTT)**2 + &
+ 7.48E-3 * (ZZT(:) - CST%XTT)**3 + &
+ 5.47E-4 * (ZZT(:) - CST%XTT)**4 + &
+ 1.67E-5 * (ZZT(:) - CST%XTT)**5 + &
+ 1.76E-7 * (ZZT(:) - CST%XTT)**6
+ END WHERE
+ !
+ WHERE (ZZT(:) < (CST%XTT - 23.7) .AND. ZZT(:) > (CST%XTT - 40.)) ! Added by Mansell
+ ZRAR_CRIT(:) = 3.4 * (1.0 - (ABS(ZZT(:) - CST%XTT + 23.7) / & ! et al. (2005)
+ (-23.7 + 40.))**3.)
+ END WHERE
+ !
+ GELEC(:,3) = ZZT(:) >= (CST%XTT - 40.) .AND. ZZT(:) <= CST%XTT
+!
+ELSE IF (CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2') THEN
+!
+ WHERE (ZZT(:) > (CST%XTT - 10.7))
+ ZRAR_CRIT(:) = 0.66
+ END WHERE
+ WHERE (ZZT(:) <= (CST%XTT - 10.7) .AND. ZZT(:) >= (CST%XTT - 23.7))
+ ZRAR_CRIT(:) = -1.47 - 0.2 * (ZZT(:) - CST%XTT)
+ END WHERE
+ WHERE (ZZT(:) < (CST%XTT - 23.7) .AND. ZZT(:) > (CST%XTT - 40.))
+ ZRAR_CRIT(:) = 3.3
+ END WHERE
+ !
+ GELEC(:,3) = ZZT(:) > (CST%XTT - 40.) .AND. ZZT(:) <= CST%XTT .AND. &
+ ZEW(:) >= 0.01 .AND. ZEW(:) <= 10.
+!
+ELSE IF (CNI_CHARGING == 'TERAR') THEN
+!
+ GELEC(:,3) = ZZT(:) >= (CST%XTT - 40.) .AND. ZZT(:) <= CST%XTT
+END IF
+!
+GELEC(:,1) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE
+GELEC(:,2) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+GELEC(:,3) = GELEC(:,3) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. &
+ ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+!
+!
+!* 2. INITIALIZATION FOR ICE CRYSTAL - GRAUPEL COLLISIONS
+! ---------------------------------------------------
+!
+ZDQ_IG(:) = 0.
+!
+! positive case is the default value
+ZSAUNIM_IG(:) = XIMP
+ZSAUNIN_IG(:) = XINP
+!
+! Compute the Rime Accretion Rate
+ZRAR(:) = 0.
+ZVGMEAN(:) = 0.
+WHERE (ZLBDAG(:) > 0. .AND. ZRCT(:) > 0.)
+ ZVGMEAN(:) = XVGCOEF * ZRHOCOR(:) * ZLBDAG(:)**(-ZDG)
+ ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ZVGMEAN(:) * 1.E3
+END WHERE
+!
+IF (CNI_CHARGING == 'TERAR') THEN
+ GELEC(:,2) = GELEC(:,2) .AND. ZRAR(:) > 0.01 .AND. ZRAR(:) <= 80.
+ELSE
+ GELEC(:,2) = GELEC(:,2) .AND. ZRAR(:) > 0.1
+END IF
+GELEC(:,4) = GELEC(:,2)
+!
+IF (COUNT(GELEC(:,4)) .GT. 0) THEN
+! compute the coefficients for I-G collisions
+ IF (CNI_CHARGING == 'SAP98') THEN
+ CALL ELEC_INI_NI_SAP98 (KMICRO, GELEC(:,4), ZRAR, ZRAR_CRIT, ZDQ_IG)
+ !
+ ELSE IF (CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2') THEN
+ ZRAR(:) = ZRAR(:) / 3
+ CALL INTERP_DQ_TABLE (KMICRO, NIND_TEMP, NIND_LWC, GELEC(:,4), &
+ ZRAR, ZZT, XSAUNDER, ZDQ_IG)
+ !
+ ELSE IF (CNI_CHARGING == 'TERAR') THEN
+ ZRAR(:) = ZRAR(:) / 8.
+ CALL INTERP_DQ_TABLE (KMICRO, NIND_TEMP, NIND_LWC, GELEC(:,4), &
+ ZRAR, ZZT, XTAKA_TM, ZDQ_IG)
+ !
+ END IF
+ !
+ WHERE (ZDQ_IG(:) < 0.)
+ ZSAUNIM_IG(:) = XIMN
+ ZSAUNIN_IG(:) = XINN
+ ENDWHERE
+ENDIF
+!
+!
+!* 3. INITIALIZATION FOR ICE CRYSTAL - SNOW COLLISIONS
+! ------------------------------------------------
+!
+ZDQ_IS(:) = 0.
+!
+! positive case is the default value
+ZSAUNIM_IS(:) = XIMP
+ZSAUNIN_IS(:) = XINP
+!
+! Compute the Rime Accretion Rate
+ZRAR(:) = 0.
+ZVSMEAN(:) = 0.
+WHERE (ZLBDAS(:) > 0. .AND. ZRCT(:) > 0.)
+ ZVSMEAN(:) = XVSCOEF * ZRHOCOR(:) * ZLBDAS(:)**(-ZDS)
+ ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ZVSMEAN(:) * 1.E3
+END WHERE
+!
+IF (CNI_CHARGING == 'TERAR') THEN
+ GELEC(:,1) = GELEC(:,1) .AND. ZRAR(:) > 0.01 .AND. ZRAR(:) <= 80.
+ELSE
+ GELEC(:,1) = GELEC(:,1) .AND. ZRAR(:) > 0.1
+END IF
+GELEC(:,4) = GELEC(:,1)
+!
+IF (COUNT(GELEC(:,4)) .GT. 0) THEN
+! compute the coefficients for I-S collisions
+ IF (CNI_CHARGING == 'SAP98') THEN
+ CALL ELEC_INI_NI_SAP98 (KMICRO, GELEC(:,4), ZRAR, ZRAR_CRIT, ZDQ_IS)
+ !
+ ELSE IF (CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2') THEN
+ ZRAR(:) = ZRAR(:) / 3
+ CALL INTERP_DQ_TABLE (KMICRO, NIND_TEMP, NIND_LWC, GELEC(:,4), &
+ ZRAR, ZZT, XSAUNDER, ZDQ_IS)
+ !
+ ELSE IF (CNI_CHARGING == 'TERAR') THEN
+ ZRAR(:) = ZRAR(:) / 8.
+ CALL INTERP_DQ_TABLE (KMICRO, NIND_TEMP, NIND_LWC, GELEC(:,4), &
+ ZRAR, ZZT, XTAKA_TM, ZDQ_IS)
+ !
+ END IF
+ !
+ WHERE (ZDQ_IS(:) < 0.)
+ ZSAUNIM_IS(:) = XIMN
+ ZSAUNIN_IS(:) = XINN
+ ENDWHERE
+ENDIF
+!
+!
+!* 4. INITIALIZATION FOR GRAUPEL - SNOW COLLISIONS
+! --------------------------------------------
+!
+ZDQ_SG(:) = 0.
+!
+! positive case is the default value
+ZSAUNSK_SG(:) = XSKP
+ZSAUNSM_SG(:) = XSMP
+ZSAUNSN_SG(:) = XSNP
+!
+! Compute the Rime Accretion Rate
+ZRAR(:) = 0.
+WHERE (ZVSMEAN(:) > 0. .AND. ZVGMEAN(:) > 0.)
+ ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ABS(ZVGMEAN(:) - ZVSMEAN(:)) * 1.E3
+END WHERE
+!
+IF (CNI_CHARGING == 'TERAR') THEN
+ GELEC(:,3) = GELEC(:,3) .AND. ZRAR(:) > 0.01 .AND. ZRAR(:) <= 80.
+ELSE
+ GELEC(:,3) = GELEC(:,3) .AND. ZRAR(:) > 0.1
+END IF
+GELEC(:,4) = GELEC(:,3)
+!
+IF( COUNT(GELEC(:,4)) .GT. 0) THEN
+! compute the coefficients for S-G collisions
+ IF (CNI_CHARGING == 'SAP98') THEN
+ CALL ELEC_INI_NI_SAP98 (KMICRO, GELEC(:,4), ZRAR, ZRAR_CRIT, ZDQ_SG)
+ !
+ ELSE IF (CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2') THEN
+ ZRAR(:) = ZRAR(:) / 3
+ CALL INTERP_DQ_TABLE (KMICRO, NIND_TEMP, NIND_LWC, GELEC(:,4), &
+ ZRAR, ZZT, XSAUNDER, ZDQ_SG)
+ !
+ ELSE IF (CNI_CHARGING == 'TERAR') THEN
+ ZRAR(:) = ZRAR(:) / 8.
+ CALL INTERP_DQ_TABLE (KMICRO, NIND_TEMP, NIND_LWC, GELEC(:,4), &
+ ZRAR, ZZT, XTAKA_TM, ZDQ_SG)
+ !
+ END IF
+ !
+ WHERE (ZDQ_SG(:) < 0.)
+ ZSAUNSK_SG(:) = XSKN
+ ZSAUNSM_SG(:) = XSMN
+ ZSAUNSN_SG(:) = XSNN
+ ENDWHERE
+ENDIF
+!
+END SUBROUTINE ELEC_INIT_NOIND_RAR
+!
+!------------------------------------------------------------------
+!
+! ##################################
+ SUBROUTINE ELEC_INIT_NOIND_TAKAH()
+! ##################################
+!
+! Purpose : initialization for the non-inductive charging process
+! following Takahashi (1978)
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!
+!* 1. COMPUTE f(T, LWC)
+! -----------------
+!
+ZDQ(:) = 0.
+!
+ZEW(:) = ZRCT(:) * ZRHODREF(:) * 1.E3 ! (g m^-3)
+!
+GELEC(:,3) = ZZT(:) > (CST%XTT - 40.) .AND. ZZT(:) <= CST%XTT .AND. &
+ ZEW(:) >= 0.01 .AND. ZEW(:) <= 10.
+GELEC(:,1) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE
+GELEC(:,2) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+GELEC(:,3) = GELEC(:,3) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. &
+ ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+GELEC(:,4) = GELEC(:,1) .OR. GELEC(:,2) .OR. GELEC(:,3)
+!
+IF (COUNT(GELEC(:,4)) > 0) THEN
+ CALL INTERP_DQ_TABLE (KMICRO, NIND_TEMP, NIND_LWC, GELEC(:,4), &
+ ZEW, ZZT, XMANSELL, ZDQ)
+ENDIF
+!
+END SUBROUTINE ELEC_INIT_NOIND_TAKAH
+!
+!------------------------------------------------------------------
+!
+! ##################################
+ SUBROUTINE ELEC_INIT_NOIND_TEEWC()
+! ##################################
+!
+!
+! Purpose : initialization for the non-inductive charging process
+! following Tsenova and Mitzeva (2009)
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!
+!* 1. PARAMETERS FOR POSITIVE NI CHARGING
+! -----------------------------------
+!
+GELEC(:,:) = .FALSE.
+ZDQ(:) = 0.
+!
+! positive case is the default value
+ZFQIAGGS(:) = XFQIAGGSP_TAK
+ZFQIDRYGBS(:) = XFQIDRYGBSP_TAK
+ZLBQSDRYGB1S(:) = XLBQSDRYGB1SP
+ZLBQSDRYGB2S(:) = XLBQSDRYGB2SP
+ZLBQSDRYGB3S(:) = XLBQSDRYGB3SP
+ZSAUNIM(:) = XIMP !3.76
+ZSAUNIN(:) = XINP !2.5
+ZSAUNSK(:) = XSKP_TAK !6.5
+ZSAUNSM(:) = XSMP !0.44
+ZSAUNSN(:) = XSNP !2.5
+!
+!
+!* 2. PARAMETERS FOR NEGATIVE NI CHARGING
+! -----------------------------------
+!
+! Compute the effective water content
+ZEW(:) = 0.
+!
+WHERE (ZLBDAG(:) > 0. .AND. ZRCT(:) > 0.)
+ ZEW(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * 1.E3
+END WHERE
+!
+GELEC(:,3) = ZZT(:) >= (CST%XTT - 40.) .AND. ZZT(:) <= CST%XTT .AND. &
+ ZEW(:) >= 0.01 .AND. ZEW(:) <= 10.
+GELEC(:,1) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE
+GELEC(:,2) = GELEC(:,3) .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+GELEC(:,3) = GELEC(:,3) .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. &
+ ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. &
+ ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE
+!
+GELEC(:,4) = GELEC(:,1) .OR. GELEC(:,2) .OR. GELEC(:,3)
+!
+IF (COUNT(GELEC(:,4)) > 0) THEN
+ CALL INTERP_DQ_TABLE (KMICRO, NIND_TEMP, NIND_LWC, GELEC(:,4), &
+ ZEW, ZZT, XTAKA_TM, ZDQ)
+!
+ WHERE (ZDQ(:) < 0.)
+ ZFQIAGGS(:) = XFQIAGGSN_TAK
+ ZFQIDRYGBS(:) = XFQIDRYGBSN_TAK
+ ZLBQSDRYGB1S(:) = XLBQSDRYGB1SN
+ ZLBQSDRYGB2S(:) = XLBQSDRYGB2SN
+ ZLBQSDRYGB3S(:) = XLBQSDRYGB3SN
+ ZSAUNIM(:) = XIMN !2.54
+ ZSAUNIN(:) = XINN !2.8
+ ZSAUNSK(:) = XSKN_TAK !2.0
+ ZSAUNSM(:) = XSMN !0.5
+ ZSAUNSN(:) = XSNN !2.8
+ ENDWHERE
+ENDIF
+!
+END SUBROUTINE ELEC_INIT_NOIND_TEEWC
+!
+!------------------------------------------------------------------
+!
+! #################################################################
+ SUBROUTINE ELEC_INI_NI_SAP98(KMICRO, OMASK, PRAR, PRAR_CRIT, PDQ)
+! #################################################################
+!
+!
+! Purpose : compute dQ(RAR,T) in the parameterization of Saunders and Peck (1998)
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KMICRO
+LOGICAL, DIMENSION(KMICRO), INTENT(IN) :: OMASK
+REAL, DIMENSION(KMICRO), INTENT(IN) :: PRAR ! Rime accretion rate
+REAL, DIMENSION(KMICRO), INTENT(IN) :: PRAR_CRIT ! Critical rime accretion rate
+REAL, DIMENSION(KMICRO), INTENT(INOUT) :: PDQ ! interpolated dQ
+!
+!
+!* 1. COMPUTE dQ(RAR, T)
+! ------------------
+!
+PDQ(:) = 0.
+!
+! positive region : Mansell et al., 2005
+WHERE (OMASK(:) .AND. PRAR(:) > PRAR_CRIT(:))
+ PDQ(:) = MAX(0., 6.74 * (PRAR(:) - PRAR_CRIT(:)) * 1.E-15)
+ENDWHERE
+!
+! negative region : Mansell et al. 2005
+WHERE (OMASK(:) .AND. PRAR(:) < PRAR_CRIT(:))
+ PDQ(:) = MIN(0., 3.9 * (PRAR_CRIT(:) - 0.1) * &
+ (4.0 * ((PRAR(:) - (PRAR_CRIT(:) + 0.1) / 2.) / &
+ (PRAR_CRIT(:) - 0.1))**2 - 1.) * 1.E-15)
+ENDWHERE
+!
+END SUBROUTINE ELEC_INI_NI_SAP98
+!
+!------------------------------------------------------------------
+!
+! #################################################################
+ SUBROUTINE INTERP_DQ_TABLE (KMICRO, KIND_TEMP, KIND_LWC, OMASK, &
+ PLIQ, PTEMP, PTABLE, PDQ)
+! #################################################################
+!
+!
+! Purpose : interpolate dQ from a lookup table at each gridpoint
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KMICRO
+INTEGER, INTENT(IN) :: KIND_TEMP, KIND_LWC
+LOGICAL, DIMENSION(KMICRO), INTENT(IN) :: OMASK
+REAL, DIMENSION(KMICRO), INTENT(IN) :: PLIQ ! effective water content or rime accretion rate
+REAL, DIMENSION(KMICRO), INTENT(IN) :: PTEMP ! temperature
+REAL, DIMENSION(KIND_LWC+1,KIND_TEMP+1), INTENT(IN) :: PTABLE ! lookup table
+REAL, DIMENSION(KMICRO), INTENT(INOUT) :: PDQ ! interpolated dQ
+!
+! declaration of local variables
+INTEGER :: IGAUX
+REAL, DIMENSION(:), ALLOCATABLE :: ZDQ_INTERP
+REAL, DIMENSION(:), ALLOCATABLE :: ZVECT1, ZVECT2
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVECT1, IVECT2
+!
+!
+!* 1. FIND THE INDEXES FOR RAR/EW AND T
+! ---------------------------------
+!
+PDQ(:) = 0.
+!
+IGAUX = 0
+DO II = 1, KMICRO
+ IF (OMASK(II)) THEN
+ IGAUX = IGAUX + 1
+ I1(IGAUX) = II
+ END IF
+END DO
+!
+IF (IGAUX > 0) THEN
+ ALLOCATE(ZDQ_INTERP(IGAUX))
+ ALLOCATE(ZVECT1(IGAUX))
+ ALLOCATE(ZVECT2(IGAUX))
+ ALLOCATE(IVECT1(IGAUX))
+ ALLOCATE(IVECT2(IGAUX))
+ ZDQ_INTERP(:) = 0.
+ IVECT1(:) = 0
+ IVECT2(:) = 0
+!
+ DO II = 1, IGAUX
+ ZVECT1(II) = PTEMP(I1(II))
+ ZVECT2(II) = PLIQ(I1(II))
+ ZDQ_INTERP(II) = PDQ(I1(II))
+ END DO
+!
+! Temperature index (0C --> -40C)
+ ZVECT1(1:IGAUX) = MAX( 1.00001, MIN( REAL(KIND_TEMP)-0.00001, &
+ (ZVECT1(1:IGAUX) - CST%XTT - 1.)/(-1.) ) )
+ IVECT1(1:IGAUX) = INT( ZVECT1(1:IGAUX) )
+ ZVECT1(1:IGAUX) = ZVECT1(1:IGAUX) - REAL(IVECT1(1:IGAUX))
+!
+! LWC index (0.01 g.m^-3 --> 10 g.m^-3)
+ WHERE (ZVECT2(:) >= 0.01 .AND. ZVECT2(:) < 0.1)
+ ZVECT2(:) = MAX( 1.00001, MIN( REAL(10)-0.00001, &
+ ZVECT2(:) * 100. ))
+ IVECT2(:) = INT(ZVECT2(:))
+ ZVECT2(:) = ZVECT2(:) - REAL(IVECT2(:))
+ ENDWHERE
+!
+ WHERE (ZVECT2(:) >= 0.1 .AND. ZVECT2(:) < 1. .AND. IVECT2(:) == 0)
+ ZVECT2(:) = MAX( 10.00001, MIN( REAL(19)-0.00001, &
+ ZVECT2(:) * 10. + 9. ) )
+ IVECT2(:) = INT(ZVECT2(:))
+ ZVECT2(:) = ZVECT2(:) - REAL(IVECT2(:))
+ ENDWHERE
+!
+ WHERE ((ZVECT2(:) >= 1.) .AND. ZVECT2(:) <= 10.)
+ ZVECT2(:) = MAX( 19.00001, MIN( REAL(KIND_LWC)-0.00001, &
+ ZVECT2(:) + 18. ) )
+ IVECT2(:) = INT(ZVECT2(:))
+ ZVECT2(:) = ZVECT2(:) - REAL(IVECT2(:))
+ ENDWHERE
+!
+!
+!* 2. INTERPOLATE dQ(RAR or EW,T)
+! ---------------------------
+!
+ ZDQ_INTERP(:) = BI_LIN_INTP_V( PTABLE, IVECT2, IVECT1, ZVECT2, ZVECT1, &
+ IGAUX )
+!
+ DO II = 1, IGAUX
+ PDQ(I1(II)) = ZDQ_INTERP(II)
+ END DO
+END IF
+!
+DEALLOCATE(ZDQ_INTERP)
+DEALLOCATE(ZVECT1)
+DEALLOCATE(ZVECT2)
+DEALLOCATE(IVECT1)
+DEALLOCATE(IVECT2)
+!
+END SUBROUTINE INTERP_DQ_TABLE
+!
+!------------------------------------------------------------------
+!
+! #########################
+ SUBROUTINE ELEC_IAGGS_B()
+! #########################
+!
+!
+! Purpose : compute charge separation process during the collision
+! between ice and snow
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!
+!* 1. COMPUTE THE COLLISION EFFICIENCY
+! --------------------------------
+!
+ZQCOLIS(:) = ZCOLIS * EXP(ZCOLEXIS * (ZZT(:) - CST%XTT))
+!
+ZWQ_NI(:) = 0.
+ZLIMIT(:) = 0.
+!
+!* 2. COMPUTE THE RATE OF SEPARATED CHARGE
+! ------------------------------------
+!
+!* 2.1 Charging process following Helsdon and Farley (1987)
+!
+IF (CNI_CHARGING == 'HELFA') THEN
+ !
+ WHERE (ZCIT(:) > 0.0 .AND. &
+ ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5))
+ ZWQ_NI(:) = XFQIAGGSBH * ZRIAGGS(:) * ZCIT(:) / ZRIT(:)
+ ZWQ_NI(:) = ZWQ_NI(:) * (1. - ZQCOLIS(:)) / ZQCOLIS(:)
+!
+! Temperature dependance of the charge transferred
+ ZWQ_NI(:) = ZWQ_NI(:) * (ZZT(:) - XQTC) / ABS(ZZT(:) - XQTC)
+ ZWQ_NI(:) = ZWQ_NI(:) / ZRHODREF(:)
+ END WHERE
+!
+ELSE
+!
+!
+!* 2.2 Charging process following Gardiner et al. (1985)
+!
+ IF (CNI_CHARGING == 'GARDI') THEN
+ WHERE (GELEC(:,1) .AND. ZDELTALWC(:) > 0.)
+ ZWQ_NI(:) = XFQIAGGSBG * (1 - ZQCOLIS(:)) * &
+ ZRHODREF(:)**(-4. * ZCEXVT + 4. / ZBI) * &
+ ZCIT(:)**(1 - 4. / ZBI) * &
+ ZDELTALWC(:) * ZFT(:) * &
+ ZCST(:) * ZLBDAS(:)**(-2. - 4. * ZDS) * &
+ (ZAI * MOMG(ZALPHAI, ZNUI, ZBI) / &
+ ZRIT(:))**(-4 / ZBI)
+ ENDWHERE
+ END IF
+!
+!
+!* 2.3 Charging process based on EW: SAUN1/SAUN2, TEEWC
+!* following Saunders et al. (1991), Takahashi via Tsenova and Mitzeva (2009)
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'TEEWC') THEN
+ WHERE (GELEC(:,1) .AND. ZDQ(:) /= 0.)
+ ZWQ_NI(:) = XFQIAGGSBS * (1 - ZQCOLIS(:)) * &
+ ZRHOCOR(:)**(1 + ZSAUNIN(:)) * &
+ ZFQIAGGS(:) * ZDQ(:) * &
+ ZCIT(:)**(1 - ZSAUNIM(:) / ZBI) * &
+ ZCST(:) * ZLBDAS(:)**(-2.- ZDS * (1. + ZSAUNIN(:))) * &
+ (ZRHODREF(:) * ZRIT(:) / XAIGAMMABI)**(ZSAUNIM(:) / ZBI)
+ ENDWHERE
+ END IF
+!
+!
+!* 2.4 Charging process based on RAR (=EW*V): SAP98, BSMP1/BSMP2, TERAR
+!* following Saunders and Peck (1998) or Brooks et al., 1997 (with/out anomalies)
+!* or Takahashi via Tsenova and Mitzeva (2011)
+!
+ IF (CNI_CHARGING == 'SAP98' .OR. CNI_CHARGING == 'BSMP1' .OR. &
+ CNI_CHARGING == 'BSMP2' .OR. CNI_CHARGING == 'TERAR') THEN
+ IF (CNI_CHARGING /= 'TERAR') THEN
+ ZFQIAGGS(:) = XFQIAGGSP
+ WHERE (ZDQ_IS(:) < 0.)
+ ZFQIAGGS(:) = XFQIAGGSN
+ ENDWHERE
+ ELSE
+ ZFQIAGGS(:) = XFQIAGGSP_TAK
+ WHERE (ZDQ_IS(:) < 0.)
+ ZFQIAGGS(:) = XFQIAGGSN_TAK
+ ENDWHERE
+ ENDIF
+!
+ WHERE (GELEC(:,1) .AND. ZDQ_IS(:) /= 0.)
+ ZWQ_NI(:) = XFQIAGGSBS * (1 - ZQCOLIS(:)) * &
+ ZRHOCOR(:)**(1 + ZSAUNIN_IS(:)) * &
+ ZFQIAGGS(:) * ZDQ_IS(:) * &
+ ZCIT(:)**(1 - ZSAUNIM_IS(:) / ZBI) * &
+ ZCST(:) * ZLBDAS(:)**(-2.- ZDS * (1. + ZSAUNIN_IS(:))) * &
+ (ZRHODREF(:) * ZRIT(:) / XAIGAMMABI)**(ZSAUNIM_IS(:) / ZBI)
+ ENDWHERE
+ END IF
+!
+!
+!* 2.5 Charging process following Takahashi (1978)
+!
+ IF (CNI_CHARGING == 'TAKAH') THEN
+ WHERE (GELEC(:,1) .AND. ZDQ(:) /= 0.)
+ ZWQ_NI(:) = XFQIAGGSBT1 * (1.0 - ZQCOLIS(:)) * ZRHOCOR(:) * &
+ ZCIT(:) * ZCST(:) * ZDQ(:) * &
+ MIN( XFQIAGGSBT2 / (ZLBDAS(:)**(2. + ZDS)) , &
+ XFQIAGGSBT3 * ZRHOCOR(:) * ZRHODREF(:)**(2./ZBI) * &
+ ZRIT(:)**(2. / ZBI) / &
+ (ZCIT(:)**(2. / ZBI) * ZLBDAS(:)**(2. + 2. * ZDS)))
+ ENDWHERE
+ END IF
+!
+!
+!* 3. LIMITATION OF THE SEPARATED CHARGE
+! ----------------------------------
+!
+! Dq is limited to XLIM_NI_IS
+ WHERE (ZWQ_NI(:) .NE. 0.)
+ ZLIMIT(:) = XLIM_NI_IS * ZRIAGGS(:) * ZCIT(:) * &
+ (1 - ZQCOLIS(:)) / (ZRIT(:) * ZQCOLIS(:))
+ ZWQ_NI(:) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ_NI(:) ) ), ZWQ_NI(:) )
+ ZWQ_NI(:) = ZWQ_NI(:) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperatures lower than -30C --> linear interpolation
+ WHERE (ZWQ_NI(:) /= 0. .AND. ZZT(:) < (CST%XTT-30.) .AND. ZZT(:) >= (CST%XTT-40.))
+ ZWQ_NI(:) = ZWQ_NI(:) * (ZZT(:) - CST%XTT + 40.) / 10.
+ ENDWHERE
+!
+END IF
+!
+ZQSS(:) = ZQSS(:) + ZWQ_NI(:)
+ZQIS(:) = ZQIS(:) - ZWQ_NI(:)
+!
+END SUBROUTINE ELEC_IAGGS_B
+!
+!------------------------------------------------------------------
+!
+! #########################
+ SUBROUTINE ELEC_IDRYG_B()
+! #########################
+!
+!
+! Purpose : compute charge separation process during the dry collision
+! between ice and graupeln
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!
+!* 1. COMPUTE THE COLLISION EFFICIENCY
+! --------------------------------
+!
+ZQCOLIG(:) = ZCOLIG * EXP(ZCOLEXIG * (ZZT(:) - CST%XTT))
+!
+ZWQ_NI(:) = 0.
+ZLIMIT(:) = 0.
+!
+!* 2. COMPUTE THE RATE OF SEPARATED CHARGE
+! ------------------------------------
+!
+!* 2.1 Charging process following Helsdon and Farley (1987)
+!
+IF (CNI_CHARGING == 'HELFA') THEN
+ !
+ WHERE (ZRIT(:) > XRTMIN_ELEC(4) .AND. ZCIT(:) > 0. .AND. &
+ ZRGT(:) > XRTMIN_ELEC(6))
+ ZWQ_NI(:) = XHIDRYG * ZRIDRYG(:) * ZCIT(:) / ZRIT(:)
+ ZWQ_NI(:) = ZWQ_NI(:) * (1. - ZQCOLIG(:)) / ZQCOLIG(:) ! QIDRYG_boun
+!
+! Temperature dependance of the charge transfered
+ ZWQ_NI(:) = ZWQ_NI(:) * (ZZT(:) - XQTC) / ABS(ZZT(:) - XQTC)
+ ZWQ_NI(:) = ZWQ_NI(:) / ZRHODREF(:)
+ END WHERE
+!
+ELSE
+!
+!
+!* 2.2 Charging process following Gardiner et al. (1985)
+!
+ IF (CNI_CHARGING == 'GARDI') THEN
+ WHERE (GELEC(:,2) .AND. ZDELTALWC(:) > 0.)
+ ZWQ_NI(:) = XFQIDRYGBG * XLBQIDRYGBG * (1 - ZQCOLIG) * &
+ ZRHODREF(:)**(-4. * ZCEXVT + 4. / ZBI) * &
+ ZCIT(:)**(1 - 4. / ZBI) * &
+ ZDELTALWC(:) * ZFT(:) * &
+ ZCGT(:) * ZLBDAG(:)**(-2. - 4. * ZDG) * &
+ (ZAI * MOMG(ZALPHAI, ZNUI, ZBI) / &
+ ZRIT(:))**(-4 / ZBI)
+ ENDWHERE
+ END IF
+!
+!
+!* 2.3 Charging process based on EW: SAUN1/SAUN2, TEEWC following
+!* Saunders et al. (1991), Takahashi via Tsenova and Mitzeva(2009)
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'TEEWC') THEN
+ WHERE (GELEC(:,2) .AND. ZDQ(:) /= 0.)
+ ZWQ_NI(:) = XFQIDRYGBS * (1. - ZQCOLIG(:)) * &
+ ZRHOCOR(:)**(1. + ZSAUNIN(:)) * &
+ ZFQIDRYGBS(:) * ZDQ(:) * &
+ ZCIT(:)**(1. - ZSAUNIM(:) / ZBI) * &
+ ZCGT(:) * ZLBDAG(:)**(-2. - ZDG * (1. + ZSAUNIN(:))) * &
+ (ZRHODREF(:) * ZRIT(:) / XAIGAMMABI)**(ZSAUNIM(:) / ZBI)
+ ENDWHERE
+ END IF
+!
+!
+!* 2.4 Charging process based on RAR (=EW*V): SAP98, BSMP1/BSMP2, TERAR
+!* following Saunders and Peck (1998) or Brooks et al., 1997 (with/out anomalies)
+!* or Takahashi via Tsenova and Mitzeva (2011)
+!
+ IF (CNI_CHARGING == 'SAP98' .OR. CNI_CHARGING == 'BSMP1' .OR. &
+ CNI_CHARGING == 'BSMP2' .OR. CNI_CHARGING == 'TERAR') THEN
+ IF (CNI_CHARGING /= 'TERAR') THEN
+ ZFQIDRYGBS(:) = XFQIDRYGBSP
+ WHERE (ZDQ_IG(:) < 0.)
+ ZFQIDRYGBS(:) = XFQIDRYGBSN
+ ENDWHERE
+ ELSE
+ ZFQIDRYGBS(:) = XFQIDRYGBSP_TAK
+ WHERE (ZDQ_IG(:) <0.)
+ ZFQIDRYGBS(:) = XFQIDRYGBSN_TAK
+ ENDWHERE
+ END IF
+!
+ WHERE (GELEC(:,2) .AND. ZDQ_IG(:) /= 0.)
+ ZWQ_NI(:) = XFQIDRYGBS * (1. - ZQCOLIG(:)) * &
+ ZRHOCOR(:)**(1 + ZSAUNIN_IG(:)) * &
+ ZFQIDRYGBS(:) * ZDQ_IG(:) * &
+ ZCIT(:)**(1 - ZSAUNIM_IG(:) / ZBI) * &
+ ZCGT(:) * ZLBDAG(:)**(-2. - ZDG * (1. + ZSAUNIN_IG(:))) * &
+ (ZRHODREF(:) * ZRIT(:) / XAIGAMMABI)**(ZSAUNIM_IG(:) / ZBI)
+ ENDWHERE
+ END IF
+!
+!
+!* 2.5 Charging process following Takahashi (1978)
+!
+ IF (CNI_CHARGING == 'TAKAH') THEN
+ WHERE (GELEC(:,2) .AND. ZDQ(:) /= 0.)
+ ZWQ_NI(:) = XFQIDRYGBT1 * (1. - ZQCOLIG(:)) * ZRHOCOR(:) * &
+ ZCIT(:) * ZCGT(:) * ZDQ(:) * &
+ MIN( XFQIDRYGBT2 / (ZLBDAG(:)**(2. + ZDG)), &
+ XFQIDRYGBT3 * ZRHOCOR(:) * ZRHODREF(:)**(2./ZBI) * &
+ ZRIT(:)**(2. / ZBI) / (ZCIT(:)**(2. / ZBI) * &
+ ZLBDAG(:)**(2. + 2. * ZDG)) )
+ ENDWHERE
+ END IF
+!
+!
+!* 3. LIMITATION OF THE SEPARATED CHARGE
+! ----------------------------------
+!
+! Dq is limited to XLIM_NI_IG
+ WHERE (ZWQ_NI(:) .NE. 0. .AND. ZRIT(:) > 0.)
+ ZLIMIT(:) = XLIM_NI_IG * ZRIDRYG(:) * ZCIT(:) * (1 - ZQCOLIG(:)) / &
+ (ZRIT(:) * ZQCOLIG(:))
+ ZWQ_NI(:) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ_NI(:) ) ), ZWQ_NI(:) )
+ ZWQ_NI(:) = ZWQ_NI(:) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperatures lower than -30C --> linear interpolation
+ WHERE (ZWQ_NI(:) /= 0. .AND. ZZT(:) < (CST%XTT-30.) .AND. ZZT(:) >= (CST%XTT-40.))
+ ZWQ_NI(:) = ZWQ_NI(:) * (ZZT(:) - CST%XTT + 40.) / 10.
+ ENDWHERE
+!
+END IF
+!
+WHERE (ZRIDRYG(:) > 0.)
+ ZQGS(:) = ZQGS(:) + ZWQ_NI(:)
+ ZQIS(:) = ZQIS(:) - ZWQ_NI(:)
+END WHERE
+!
+END SUBROUTINE ELEC_IDRYG_B
+!
+!------------------------------------------------------------------
+!
+! #########################
+ SUBROUTINE ELEC_SDRYG_B()
+! #########################
+!
+!
+! Purpose : compute the charge separation during the dry collision
+! between snow and graupel
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!
+!* 1. COMPUTE THE COLLECTION EFFICIENCY
+! ---------------------------------
+!
+ZQCOLSG(:) = ZCOLSG * EXP (ZCOLEXSG * (ZZT(:) - CST%XTT))
+!
+ZWQ_NI(:) = 0.
+ZLIMIT(:) = 0.
+!
+!* 2. COMPUTE THE RATE OF SEPARATED CHARGE
+! ------------------------------------
+!
+!* 2.1 Charge separation following Helsdon and Farley (1987)
+!
+IF (CNI_CHARGING == 'HELFA') THEN
+!
+ WHERE (ZRGT(:) > XRTMIN_ELEC(6) .AND. ZLBDAG(:) > 0. .AND. &
+ ZRST(:) > XRTMIN_ELEC(5) .AND. ZLBDAS(:) > 0.)
+ ZWQ_NI(:) = ZWQ5(:,5) * XFQSDRYGBH * ZRHODREF(:)**(-ZCEXVT) * &
+ (1. - ZQCOLSG(:)) * &
+ ZCST(:) * ZCGT(:) * &
+ (XLBQSDRYGB4H * ZLBDAS(:)**(-2.) + &
+ XLBQSDRYGB5H * ZLBDAS(:)**(-1.) * ZLBDAG(:)**(-1.) + &
+ XLBQSDRYGB6H * ZLBDAG(:)**(-2.))
+!
+! Temperature dependance of the charge transfered
+ ZWQ_NI(:) = ZWQ_NI(:) * (ZZT(:) - XQTC) / ABS(ZZT(:) - XQTC)
+ ZWQ_NI(:) = ZWQ_NI(:) / ZRHODREF(:)
+ ENDWHERE
+!
+ELSE
+!
+!
+!* 2.2 Charge separation following Gardiner et al. (1985)
+!
+ IF (CNI_CHARGING == 'GARDI') THEN
+ WHERE (GELEC(:,3) .AND. ZDELTALWC(:) > 0.)
+ ZWQ_NI(:) = XFQSDRYGBG * (1. - ZQCOLSG(:)) * &
+ ZRHODREF(:)**(-4. * ZCEXVT) * &
+ ZFT(:) * ZDELTALWC(:) * &
+ ZCST(:) * ZCGT(:) * &
+ (XLBQSDRYGB4G * ZLBDAS(:)**(-4.) * ZLBDAG(:)**(-2.) + &
+ XLBQSDRYGB5G * ZLBDAS(:)**(-5.) * ZLBDAG(:)**(-1.) + &
+ XLBQSDRYGB6G * ZLBDAS(:)**(-6.)) * &
+ ZWQ5(:,5)
+ ENDWHERE
+ END IF
+!
+!
+!* 2.3 Charging process based on EW: SAUN1/SAUN2, TEEWC following
+!* Saunders et al. (1991), Takahashi via Tsenova and Mitzeva(2009)
+!
+ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'TEEWC') THEN
+ WHERE (GELEC(:,3) .AND. ZDQ(:) /= 0.)
+! ZWQ_NI(:) = ZWQ5(:,6) If graupel gains positive charge ZDQ(:) > 0.
+! ZWQ_NI(:) = ZWQ5(:,7) If graupel gains negative charge ZDQ(:) < 0.
+ ZWQ_NI(:) = ZWQ5(:,6) * (0.5 + SIGN(0.5,ZDQ(:))) + &
+ ZWQ5(:,7) * (0.5 - SIGN(0.5,ZDQ(:)))
+!
+ ZWQ_NI(:) = ZWQ_NI(:) * XFQSDRYGBS * (1. - ZQCOLSG(:)) * &
+ ZRHOCOR(:)**(1. + ZSAUNSN(:)) * ZSAUNSK(:) * ZDQ(:) * &
+ ZCST(:) * ZCGT(:) * &
+ ( ZLBQSDRYGB1S(:) / (ZLBDAS(:)**ZSAUNSM(:) * ZLBDAG(:)**2) + &
+ ZLBQSDRYGB2S(:) / (ZLBDAS(:)**( 1.+ZSAUNSM(:)) * ZLBDAG(:)) + &
+ ZLBQSDRYGB3S(:) / ZLBDAS(:)**(2.+ZSAUNSM(:)) )
+ ENDWHERE
+ END IF
+!
+!
+!* 2.4 Charging process based on RAR (=EW*V): SAP98, BSMP1/BSMP2, TERAR
+!* following Saunders and Peck (1998) or Brooks et al., 1997 (with/out anomalies)
+!* or Takahashi via Tsenova and Mitzeva (2011)
+!
+ IF (CNI_CHARGING == 'SAP98' .OR. CNI_CHARGING == 'BSMP1' .OR. &
+ CNI_CHARGING == 'BSMP2' .OR. CNI_CHARGING == 'TERAR') THEN
+ ZLBQSDRYGB1S(:) = XLBQSDRYGB1SP
+ ZLBQSDRYGB2S(:) = XLBQSDRYGB2SP
+ ZLBQSDRYGB3S(:) = XLBQSDRYGB3SP
+ WHERE (ZDQ_SG(:) < 0.)
+ ZLBQSDRYGB1S(:) = XLBQSDRYGB1SN
+ ZLBQSDRYGB2S(:) = XLBQSDRYGB2SN
+ ZLBQSDRYGB3S(:) = XLBQSDRYGB3SN
+ ENDWHERE
+!
+ WHERE (GELEC(:,3) .AND. ZDQ_SG(:) /= 0.)
+ ZWQ_NI(:) = ZWQ5(:,6) * (0.5+SIGN(0.5,ZDQ_SG(:))) + &
+ ZWQ5(:,7) * (0.5-SIGN(0.5,ZDQ_SG(:)))
+!
+ ZWQ_NI(:) = ZWQ_NI(:) * XFQSDRYGBS * (1. - ZQCOLSG(:)) * &
+ ZRHOCOR(:)**(1. + ZSAUNSN_SG(:)) * ZSAUNSK_SG(:) * ZDQ_SG(:) * &
+ ZCST(:) * ZCGT(:) * &
+ (ZLBQSDRYGB1S(:) / (ZLBDAS(:)**ZSAUNSM_SG(:) * ZLBDAG(:)**2) + &
+ ZLBQSDRYGB2S(:) / (ZLBDAS(:)**(1.+ZSAUNSM_SG(:)) * ZLBDAG(:)) + &
+ ZLBQSDRYGB3S(:) / ZLBDAS(:)**(2.+ZSAUNSM_SG(:)) )
+ ENDWHERE
+ END IF
+!
+!
+!* 2.5 Charging process following Takahashi (1978)
+!
+ IF (CNI_CHARGING == 'TAKAH') THEN
+ WHERE (GELEC(:,3) .AND. ZDQ(:) /= 0.)
+ ZWQ_NI(:) = XFQSDRYGBT1 * (1. - ZQCOLSG(:)) * ZRHOCOR(:) * &
+ ZCGT(:) * ZCST(:) * ZDQ(:) * &
+ MIN(10. * ( &
+ ABS(XFQSDRYGBT2 / (ZLBDAG(:)**ZDG * ZLBDAS(:)**2.) - &
+ XFQSDRYGBT3 / (ZLBDAS(:)**(2. + ZDS))) + &
+ ABS(XFQSDRYGBT4 / (ZLBDAG(:)**(2. + ZDG)) - &
+ XFQSDRYGBT5 / (ZLBDAS(:)**ZDS * ZLBDAG(:)**2.)) + &
+ ABS(XFQSDRYGBT6 / (ZLBDAG(:)**(1. + ZDG) * ZLBDAS(:)) - &
+ XFQSDRYGBT7 / (ZLBDAS(:)**(1. + ZDS) * ZLBDAG(:)))), &
+ XFQSDRYGBT8 * ZRHOCOR(:) * ZWQ5(:,5) * &
+ (XFQSDRYGBT9 / (ZLBDAS(:)**2. * ZLBDAG(:)**2.) + &
+ XFQSDRYGBT10 / (ZLBDAS(:)**4.) + &
+ XFQSDRYGBT11 / (ZLBDAS(:)**3. * ZLBDAG(:))))
+ ENDWHERE
+ END IF
+!
+!
+!* 3. LIMITATION OF THE SEPARATED CHARGE
+! ----------------------------------
+!
+! Dq is limited to XLIM_NI_SG
+ WHERE (ZWQ_NI(:) .NE. 0.)
+ ZLIMIT(:) = XLIM_NI_SG * ZWQ5(:,4) * XAUX_LIM * &
+ ZRHOCOR(:) * (1. - ZQCOLSG(:)) * &
+ ZCST(:) * ZCGT(:) * &
+ ( XAUX_LIM1 / ZLBDAS(:)**2 + &
+ XAUX_LIM2 /(ZLBDAS(:) * ZLBDAG(:)) + &
+ XAUX_LIM3 / ZLBDAG(:)**2 )
+!
+ ZWQ_NI(:) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ_NI(:) ) ), ZWQ_NI(:) )
+ ZWQ_NI(:) = ZWQ_NI(:) / ZRHODREF(:)
+ ENDWHERE
+!
+! For temperatures lower than -30C --> linear interpolation
+ WHERE (ZWQ_NI(:) /= 0. .AND. ZZT(:) < (CST%XTT-30.) .AND. ZZT(:) >= (CST%XTT-40.))
+ ZWQ_NI(:) = ZWQ_NI(:) * (ZZT(:) - CST%XTT + 40.) / 10.
+ ENDWHERE
+!
+END IF
+!
+WHERE (ZRSDRYG(:) > 0.)
+ ZQGS(:) = ZQGS(:) + ZWQ_NI(:)
+ ZQSS(:) = ZQSS(:) - ZWQ_NI(:)
+END WHERE
+!
+END SUBROUTINE ELEC_SDRYG_B
+!
+!------------------------------------------------------------------
+!
+! #########################################################################
+ SUBROUTINE COMPUTE_CHARGE_TRANSFER (PR_RATE, PRXT, PQXT, PTSTEP, &
+ PRX_THRESH, PQX_THRESH, PCOEF_RQ_X, &
+ PQ_RATE, PQXS, PQYS )
+! #########################################################################
+!
+! Purpose : compute the charge transfer rate in proportion of the mass transfer rate
+! x --> y
+! q_rate_xy = r_rate_xy * coef_rq_x * qx_t / rx_t
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of dummy arguments
+!
+REAL, INTENT(IN), DIMENSION(:) :: PR_RATE ! Mass exchange rate from x to y
+REAL, INTENT(IN), DIMENSION(:) :: PRXT ! Mixing ratio of x at t
+REAL, INTENT(IN), DIMENSION(:) :: PQXT ! Electric charge of x at t
+REAL, INTENT(IN) :: PRX_THRESH ! Threshold on mixing ratio
+REAL, INTENT(IN) :: PQX_THRESH ! Threshold on electric charge
+REAL, INTENT(IN) :: PCOEF_RQ_X ! Coefficient for charge exchange
+REAL, INTENT(IN) :: PTSTEP ! Time step
+REAL, INTENT(INOUT), DIMENSION(:) :: PQ_RATE ! Charge exchange rate from x to y
+REAL, INTENT(INOUT), DIMENSION(:) :: PQXS ! Electric charge of x - source term
+REAL, INTENT(INOUT), DIMENSION(:) :: PQYS ! Electric charge of y - source term
+!
+!
+!* 0.2 Declaration of local variables
+!
+!
+PQ_RATE(:) = 0.
+!
+WHERE (PR_RATE(:) > 0. .AND. &
+ PRXT(:) > PRX_THRESH .AND. ABS(PQXT(:)) > PQX_THRESH)
+! Compute the charge exchanged during the mass tranfer from species x to y
+ PQ_RATE(:) = PCOEF_RQ_X * PR_RATE(:) * PQXT(:) / PRXT(:)
+! Limit the charge exchanged to the charge available on x at t
+ PQ_RATE(:) = SIGN( MIN( ABS(PQXT(:)/PTSTEP),ABS(PQ_RATE(:)) ), PQXT(:)/PTSTEP )
+ !
+! Update the source terms of x and y
+ PQXS(:) = PQXS(:) - PQ_RATE(:)
+ PQYS(:) = PQYS(:) + PQ_RATE(:)
+END WHERE
+!
+END SUBROUTINE COMPUTE_CHARGE_TRANSFER
+!
+!------------------------------------------------------------------
+!
+! ###########################################################
+ FUNCTION BI_LIN_INTP_V(ZT, KI, KJ, PDX, PDY, KN) RESULT(PY)
+! ###########################################################
+!
+! Purpose :
+!
+! | |
+! ZT(KI(1),KJ(2))-|-------------------|-ZT(KI(2),KJ(2))
+! | |
+! | |
+! x2-|-------|y(x1,x2) |
+! | | |
+! PDY| | |
+! | | |
+! | | |
+!ZT( KI(1),KJ(1))-|-------------------|-ZT(KI(2),KJ(1))
+! | PDX |x1 |
+! | |
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of dummy arguments
+!
+INTEGER, INTENT(IN) :: KN ! Size of the result vector
+INTEGER, INTENT(IN), DIMENSION(KN) :: KI ! Tabulated coordinate
+INTEGER, INTENT(IN), DIMENSION(KN) :: KJ ! Tabulated coordinate
+REAL, INTENT(IN), DIMENSION(:,:) :: ZT ! Tabulated data
+REAL, INTENT(IN), DIMENSION(KN) :: PDX, PDY !
+!
+REAL, DIMENSION(KN) :: PY ! Interpolated value
+!
+!* 0.2 Declaration of local variables
+!
+INTEGER :: JJ ! Loop index
+!
+!
+!* 1. INTERPOLATION
+! -------------
+!
+DO JJ = 1, KN
+ PY(JJ) = (1.0 - PDX(JJ)) * (1.0 - PDY(JJ)) * ZT(KI(JJ), KJ(JJ)) + &
+ PDX(JJ) * (1.0 - PDY(JJ)) * ZT(KI(JJ)+1,KJ(JJ)) + &
+ PDX(JJ) * PDY(JJ) * ZT(KI(JJ)+1,KJ(JJ)+1) + &
+ (1.0 - PDX(JJ)) * PDY(JJ) * ZT(KI(JJ) ,KJ(JJ)+1)
+ENDDO
+!
+END FUNCTION BI_LIN_INTP_V
+!
+!------------------------------------------------------------------
+!
+END SUBROUTINE ELEC_TENDENCIES
+END MODULE MODE_ELEC_TENDENCIES
diff --git a/src/common/micro/mode_ice4_correct_negativities.F90 b/src/common/micro/mode_ice4_correct_negativities.F90
index cf569687e9cf6ddaac782d09e9f869eb0c5dde51..c680d207ae65aa592c4b3dfe44827e800b1cccaf 100644
--- a/src/common/micro/mode_ice4_correct_negativities.F90
+++ b/src/common/micro/mode_ice4_correct_negativities.F90
@@ -6,9 +6,14 @@
MODULE MODE_ICE4_CORRECT_NEGATIVITIES
IMPLICIT NONE
CONTAINS
-SUBROUTINE ICE4_CORRECT_NEGATIVITIES(D, ICED, KRR, PRV, PRC, PRR, &
+ SUBROUTINE ICE4_CORRECT_NEGATIVITIES(D, ICED, KRR, PRV, PRC, PRR, &
&PRI, PRS, PRG, &
&PTH, PLVFACT, PLSFACT, PRH)
+ !SUBROUTINE ICE4_CORRECT_NEGATIVITIES(D, ICED, KRR, OELEC, PRV, PRC, PRR, &
+! &PRI, PRS, PRG, &
+! &PTH, PLVFACT, PLSFACT, PRH, &
+! &PQPI, PQC, PQR, PQI, PQS, PQG, PQNI, &
+! &PTH, PLVFACT, PLSFACT, PRH, PQH)
!
USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
@@ -19,11 +24,15 @@ IMPLICIT NONE
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
INTEGER, INTENT(IN) :: KRR
+!LOGICAL, INTENT(IN) :: OELEC
REAL, DIMENSION(D%NIJT, D%NKT), INTENT(INOUT) :: PRV, PRC, PRR, PRI, PRS, PRG, PTH
+!REAL, DIMENSION(D%NIJT, D%NKT), INTENT(INOUT) :: PQPI, PQC, PQR, PQI, PQS, PQG, PQNI
REAL, DIMENSION(D%NIJT, D%NKT), INTENT(IN) :: PLVFACT, PLSFACT
REAL, DIMENSION(D%NIJT, D%NKT), OPTIONAL, INTENT(INOUT) :: PRH
+!REAL, DIMENSION(D%NIJT, D%NKT), OPTIONAL, INTENT(INOUT) :: PQH
!
REAL :: ZW
+!REAL :: ZION, ZADD
INTEGER :: JIJ, JK, IKTB, IKTE, IIJB, IIJE
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
@@ -43,32 +52,75 @@ DO JK = IKTB, IKTE
PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLVFACT(JIJ,JK)
PRC(JIJ,JK)=PRC(JIJ,JK)-ZW
+!++cb-- pour l'elec, on peut eventuellement appeler une routine : ca evitera les pb avec xecharge ?
+! IF (OELEC .AND. ZW .LT. 0.) THEN
+! ZION = PQC(JIJ,JK) / XECHARGE
+! ZADD = 0.5 + SIGN(0.5, PQC(JIJ,JK))
+! PQPI(JIJ,JK) = PQPI(JIJ,JK) + ZADD * ZION
+! PQNI(JIJ,JK) = PQNI(JIJ,JK) + (1. - ZADD) * ZION
+! PQC(JIJ,JK) = 0.
+! END IF
ZW =PRR(JIJ,JK)-MAX(PRR(JIJ,JK), 0.)
PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLVFACT(JIJ,JK)
PRR(JIJ,JK)=PRR(JIJ,JK)-ZW
+! IF (OELEC .AND. ZW .LT. 0.) THEN
+! ZION = PQR(JIJ,JK) / XECHARGE
+! ZADD = 0.5 + SIGN(0.5, PQR(JIJ,JK))
+! PQPI(JIJ,JK) = PQPI(JIJ,JK) + ZADD * ZION
+! PQNI(JIJ,JK) = PQNI(JIJ,JK) + (1. - ZADD) * ZION
+! PQR(JIJ,JK) = 0.
+! END IF
ZW =PRI(JIJ,JK)-MAX(PRI(JIJ,JK), 0.)
PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
PRI(JIJ,JK)=PRI(JIJ,JK)-ZW
+! IF (OELEC .AND. ZW .LT. 0.) THEN
+! ZION = PQI(JIJ,JK) / XECHARGE
+! ZADD = 0.5 + SIGN(0.5, PQI(JIJ,JK))
+! PQPI(JIJ,JK) = PQPI(JIJ,JK) + ZADD * ZION
+! PQNI(JIJ,JK) = PQNI(JIJ,JK) + (1. - ZADD) * ZION
+! PQI(JIJ,JK) = 0.
+! END IF
ZW =PRS(JIJ,JK)-MAX(PRS(JIJ,JK), 0.)
PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
PRS(JIJ,JK)=PRS(JIJ,JK)-ZW
+! IF (OELEC .AND. ZW .LT. 0.) THEN
+! ZION = PQS(JIJ,JK) / XECHARGE
+! ZADD = 0.5 + SIGN(0.5, PQS(JIJ,JK))
+! PQPI(JIJ,JK) = PQPI(JIJ,JK) + ZADD * ZION
+! PQNI(JIJ,JK) = PQNI(JIJ,JK) + (1. - ZADD) * ZION
+! PQS(JIJ,JK) = 0.
+! END IF
ZW =PRG(JIJ,JK)-MAX(PRG(JIJ,JK), 0.)
PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
PRG(JIJ,JK)=PRG(JIJ,JK)-ZW
+! IF (OELEC .AND. ZW .LT. 0.) THEN
+! ZION = PQG(JIJ,JK) / XECHARGE
+! ZADD = 0.5 + SIGN(0.5, PQG(JIJ,JK))
+! PQPI(JIJ,JK) = PQPI(JIJ,JK) + ZADD * ZION
+! PQNI(JIJ,JK) = PQNI(JIJ,JK) + (1. - ZADD) * ZION
+! PQG(JIJ,JK) = 0.
+! END IF
IF(KRR==7) THEN
ZW =PRH(JIJ,JK)-MAX(PRH(JIJ,JK), 0.)
PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLSFACT(JIJ,JK)
PRH(JIJ,JK)=PRH(JIJ,JK)-ZW
+! IF (OELEC .AND. ZW .LT. 0.) THEN
+! ZION = PQH(JIJ,JK) / XECHARGE
+! ZADD = 0.5 + SIGN(0.5, PQH(JIJ,JK))
+! PQPI(JIJ,JK) = PQPI(JIJ,JK) + ZADD * ZION
+! PQNI(JIJ,JK) = PQNI(JIJ,JK) + (1. - ZADD) * ZION
+! PQH(JIJ,JK) = 0.
+! END IF
ENDIF
! 2) deal with negative vapor mixing ratio
@@ -87,6 +139,13 @@ DO JK = IKTB, IKTE
PRV(JIJ,JK)=PRV(JIJ,JK)+ZW
PRR(JIJ,JK)=PRR(JIJ,JK)-ZW
PTH(JIJ,JK)=PTH(JIJ,JK)-ZW*PLVFACT(JIJ,JK)
+! IF (OELEC .AND. ZW .GT. 0.) THEN
+! ZION = PQR(JIJ,JK) / XECHARGE
+! ZADD = 0.5 + SIGN(0.5, PQG(JIJ,JK))
+! PQPI(JIJ,JK) = PQPI(JIJ,JK) + ZADD * ZION
+! PQNI(JIJ,JK) = PQNI(JIJ,JK) + (1. - ZADD) * ZION
+! PQR(JIJ,JK) = 0.
+! END IF
ZW=MIN(MAX(PRS(JIJ,JK), 0.), &
&MAX(ICED%XRTMIN(1)-PRV(JIJ,JK), 0.)) ! Quantity of rs to convert into rv
diff --git a/src/common/micro/mode_ice4_pack.F90 b/src/common/micro/mode_ice4_pack.F90
index c434a4a2e4052032603e4bb144334e85320e6ace..80819b19ed757b9959685a39873aae97618e6c62 100644
--- a/src/common/micro/mode_ice4_pack.F90
+++ b/src/common/micro/mode_ice4_pack.F90
@@ -8,7 +8,7 @@ IMPLICIT NONE
CONTAINS
SUBROUTINE ICE4_PACK(D, CST, PARAMI, ICEP, ICED, BUCONF, &
KPROMA, KSIZE, KSIZE2, &
- PTSTEP, KRR, ODMICRO, PEXN, &
+ PTSTEP, KRR, OSAVE_MICRO, ODMICRO, OELEC, PEXN, &
PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
@@ -17,7 +17,7 @@ SUBROUTINE ICE4_PACK(D, CST, PARAMI, ICEP, ICED, BUCONF, &
PRVHENI, PLVFACT, PLSFACT, &
PWR, &
TBUDGETS, KBUDGETS, &
- PRHS )
+ PMICRO_TEND, PLATHAM_IAGGS, PRHS )
! ######################################################################
!
!!**** * - compute the explicit microphysical sources
@@ -101,6 +101,8 @@ INTEGER, INTENT(IN) :: KSIZE
INTEGER, INTENT(IN) :: KSIZE2
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+LOGICAL, INTENT(IN) :: OSAVE_MICRO ! If true, microphysical tendencies are saved
+LOGICAL, INTENT(IN) :: OELEC ! if true, cloud electricity is activated
LOGICAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: ODMICRO ! mask to limit computation
!
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXN ! Exner function
@@ -133,6 +135,11 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PLSFACT
REAL, DIMENSION(D%NIJT,D%NKT,0:7), INTENT(INOUT) :: PWR
TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
INTEGER, INTENT(IN) :: KBUDGETS
+REAL, DIMENSION(MERGE(D%NIJT,0,OSAVE_MICRO),MERGE(D%NKT,0,OSAVE_MICRO),MERGE(IBUNUM-IBUNUM_EXTRA,0,OSAVE_MICRO)), &
+ INTENT(INOUT) :: PMICRO_TEND ! Microphysical tendencies
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), &
+ INTENT(IN) :: PLATHAM_IAGGS ! E Function to simulate
+ ! enhancement of IAGGS
REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
!
!
@@ -174,6 +181,9 @@ REAL, DIMENSION(KPROMA, IBUNUM-IBUNUM_EXTRA) :: ZBU_SUM
REAL, DIMENSION(KPROMA,0:7) :: ZVART !Packed variables
REAL, DIMENSION(KSIZE2,0:7) :: ZEXTPK !To take into acount external tendencies inside the splitting
!
+!For retroaction of E on IAGGS
+REAL, DIMENSION(MERGE(KPROMA,0,OELEC)) :: ZLATHAM_IAGGS
+!
INTEGER, DIMENSION(KPROMA) :: I1,I2 ! Used to replace the COUNT and PACK intrinsics on variables
INTEGER, DIMENSION(KSIZE) :: I1TOT, I2TOT ! Used to replace the COUNT and PACK intrinsics
!
@@ -197,7 +207,7 @@ LLSIGMA_RC=(PARAMI%CSUBG_AUCV_RC=='PDF ' .AND. PARAMI%CSUBG_PR_PDF=='SIGM')
LL_AUCV_ADJU=(PARAMI%CSUBG_AUCV_RC=='ADJU' .OR. PARAMI%CSUBG_AUCV_RI=='ADJU')
!
IF(PARAMI%LPACK_MICRO) THEN
- IF(BUCONF%LBU_ENABLE) THEN
+ IF(BUCONF%LBU_ENABLE .OR. OSAVE_MICRO) THEN
DO JV=1, IBUNUM-IBUNUM_EXTRA
ZBU_PACK(:, JV)=0.
ENDDO
@@ -278,10 +288,11 @@ IF(PARAMI%LPACK_MICRO) THEN
ZHLI_HRI(IC) = PHLI_HRI(JIJ, JK)
ENDIF
ZRAINFR(IC)=PRAINFR(JIJ, JK)
+ IF (OELEC) ZLATHAM_IAGGS(IC) = PLATHAM_IAGGS(JIJ, JK)
! Save indices for later usages:
I1(IC) = JIJ
I2(IC) = JK
- IF(BUCONF%LBU_ENABLE) THEN
+ IF(BUCONF%LBU_ENABLE .OR. OSAVE_MICRO) THEN
I1TOT(JMICRO+IC-1)=JIJ
I2TOT(JMICRO+IC-1)=JK
ENDIF
@@ -316,14 +327,15 @@ IF(PARAMI%LPACK_MICRO) THEN
CALL ICE4_STEPPING(D, CST, PARAMI, ICEP, ICED, BUCONF, &
&LLSIGMA_RC, LL_AUCV_ADJU, GEXT_TEND, &
&KPROMA, IMICRO, LLMICRO, PTSTEP, &
- &KRR, &
+ &KRR, OSAVE_MICRO, OELEC, &
&ZEXN, ZRHODREF, I1, I2, &
&ZPRES, ZCF, ZSIGMA_RC, &
&ZCIT, &
&ZVART, &
&ZHLC_HCF, ZHLC_HRC, &
&ZHLI_HCF, ZHLI_HRI, ZRAINFR, &
- &ZEXTPK, ZBU_SUM, ZRREVAV)
+ &ZEXTPK, ZBU_SUM, ZRREVAV, &
+ &ZLATHAM_IAGGS)
!
!* 6. UNPACKING
! ---------
@@ -344,7 +356,7 @@ IF(PARAMI%LPACK_MICRO) THEN
ENDIF
PRAINFR(I1(JL),I2(JL))=ZRAINFR(JL)
ENDDO
- IF(BUCONF%LBU_ENABLE) THEN
+ IF(BUCONF%LBU_ENABLE .OR. OSAVE_MICRO) THEN
DO JV=1, IBUNUM-IBUNUM_EXTRA
DO JL=1, IMICRO
ZBU_PACK(JMICRO+JL-1, JV) = ZBU_SUM(JL, JV)
@@ -426,17 +438,31 @@ ELSE ! PARAMI%LPACK_MICRO
CALL ICE4_STEPPING(D, CST, PARAMI, ICEP, ICED, BUCONF, &
&LLSIGMA_RC, LL_AUCV_ADJU, GEXT_TEND, &
&KSIZE, KSIZE, ODMICRO, PTSTEP, &
- &KRR, &
+ &KRR, OSAVE_MICRO, OELEC, &
&PEXN, PRHODREF, I1TOT, I2TOT, &
&PPABST, PCLDFR, ZSIGMA_RC, &
&PCIT, &
&PWR, &
&PHLC_HCF, PHLC_HRC, &
&PHLI_HCF, PHLI_HRI, PRAINFR, &
- &ZEXTPK, ZBU_PACK, PEVAP3D)
+ &ZEXTPK, ZBU_PACK, PEVAP3D, &
+ &ZLATHAM_IAGGS)
ENDIF ! PARAMI%LPACK_MICRO
!
+!
+!* 6. SAVE MICROPHYSICAL TENDENCIES USED BY OTHER PHYSICAL PARAMETERIZATIONS
+! ----------------------------------------------------------------------
+!
+IF (OSAVE_MICRO) THEN
+ DO JV = 1, IBUNUM-IBUNUM_EXTRA
+ DO JL = 1, KSIZE
+ PMICRO_TEND(I1TOT(JL),I2TOT(JL),JV) = ZBU_PACK(JL,JV)
+ ENDDO
+ ENDDO
+END IF
+!
+!
!* 7. BUDGETS
! -------
!
diff --git a/src/common/micro/mode_ice4_sedimentation.F90 b/src/common/micro/mode_ice4_sedimentation.F90
index 9bab7506fb3316a3eb26427f85e874da59020fb7..b54b50eb80f4e4199a11980c8164c542c67dcbb3 100644
--- a/src/common/micro/mode_ice4_sedimentation.F90
+++ b/src/common/micro/mode_ice4_sedimentation.F90
@@ -6,14 +6,16 @@
MODULE MODE_ICE4_SEDIMENTATION
IMPLICIT NONE
CONTAINS
-SUBROUTINE ICE4_SEDIMENTATION(D, CST, ICEP, ICED, PARAMI, BUCONF, &
- &PTSTEP, KRR, PDZZ, &
+SUBROUTINE ICE4_SEDIMENTATION(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, BUCONF, &
+ &OELEC, OSEDIM_BEARD, HCLOUD, PTSTEP, KRR, PDZZ, PTHVREFZIKB, &
&PLVFACT, PLSFACT, PRHODREF, PPABST, PTHT, PT, PRHODJ, &
&PTHS, PRVS, PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINPRR, PINPRS, PINPRG, &
+ &PQCT, PQRT, PQIT, PQST, PQGT, PQCS, PQRS, PQIS, PQSS, PQGS, PEFIELDW, &
&TBUDGETS, KBUDGETS, &
&PSEA, PTOWN, &
- &PINPRH, PRHT, PRHS, PFPR)
+ &PINPRH, PRHT, PRHS, PFPR, &
+ &PQHT, PQHS)
!!
!!** PURPOSE
!! -------
@@ -33,12 +35,15 @@ SUBROUTINE ICE4_SEDIMENTATION(D, CST, ICEP, ICED, PARAMI, BUCONF, &
!
USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
-USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t, NBUDGET_RC, &
+USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t, NBUDGET_RC, NBUDGET_SV1, &
NBUDGET_RI, NBUDGET_RR, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH
USE MODD_CST, ONLY: CST_t
USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
+USE MODD_ELEC_DESCR, ONLY: ELEC_DESCR_t
+USE MODD_ELEC_PARAM, ONLY: ELEC_PARAM_t
+USE MODD_NSV, ONLY: NSV_ELECBEG
!
USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
@@ -57,7 +62,12 @@ TYPE(CST_t), INTENT(IN) :: CST
TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
+TYPE(ELEC_PARAM_t), INTENT(IN) :: ELECP ! electrical parameters
+TYPE(ELEC_DESCR_t), INTENT(IN) :: ELECD ! electrical descriptive csts
TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+LOGICAL, INTENT(IN) :: OELEC ! switch to activate cloud electrification
+LOGICAL, INTENT(IN) :: OSEDIM_BEARD ! Switch for effect of electrical forces on sedim.
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
@@ -86,12 +96,34 @@ REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRS ! Snow ins
REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
INTEGER, INTENT(IN) :: KBUDGETS
+REAL, INTENT(IN) :: PTHVREFZIKB ! Reference thv at IKB for electricity
+!
+! variables for cloud electricity
+!
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQCT ! Cloud droplet |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQRT ! Rain | electric
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQIT ! Ice crystals | charge
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQST ! Snow | at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQGT ! Graupel |
+!
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQCS ! Cloud droplet |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQRS ! Rain | electric
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQIS ! Ice crystals | charge
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQSS ! Snow | source
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQGS ! Graupel |
+!
+REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)), INTENT(IN) :: PEFIELDW ! vert. E field
+!
+! optional variables
REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
REAL, DIMENSION(D%NIJT,D%NKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(IN) :: PQHT ! Hail electric charge at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQHS ! Hail electric charge source
+!
!
!* 0.2 declaration of local variables
!
@@ -120,7 +152,17 @@ IF (BUCONF%LBUDGET_RI) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDG
IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RS), 'SEDI', PRSS(:, :) * PRHODJ(:, :))
IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RG), 'SEDI', PRGS(:, :) * PRHODJ(:, :))
IF (BUCONF%LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RH), 'SEDI', PRHS(:, :) * PRHODJ(:, :))
-
+!
+! budget of electric charges
+IF (BUCONF%LBUDGET_SV .AND. OELEC) THEN
+ IF (PARAMI%LSEDIC) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1-1+NSV_ELECBEG+1), 'SEDI', PQCS(:, :) * PRHODJ(:, :))
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1-1+NSV_ELECBEG+2), 'SEDI', PQRS(:, :) * PRHODJ(:, :))
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1-1+NSV_ELECBEG+3), 'SEDI', PQIS(:, :) * PRHODJ(:, :))
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1-1+NSV_ELECBEG+4), 'SEDI', PQSS(:, :) * PRHODJ(:, :))
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1-1+NSV_ELECBEG+5), 'SEDI', PQGS(:, :) * PRHODJ(:, :))
+ IF (KRR == 7) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1-1+NSV_ELECBEG+6), 'SEDI', PQHS(:, :) * PRHODJ(:, :))
+END IF
+!
IF(PARAMI%CSEDIM=='STAT') THEN
DO JK = IKTB,IKTE
DO JIJ = IIJB,IIJE
@@ -143,13 +185,16 @@ IF(PARAMI%CSEDIM=='STAT') THEN
PINPRS(IIJB:IIJE) = PINPRS(IIJB:IIJE) + ZINPRI(IIJB:IIJE)
!No negativity correction here as we apply sedimentation on PR.S*PTSTEP variables
ELSEIF(PARAMI%CSEDIM=='SPLI') THEN
- CALL ICE4_SEDIMENTATION_SPLIT(D, CST, ICEP, ICED, PARAMI, &
- &PTSTEP, KRR, PDZZ, &
+ CALL ICE4_SEDIMENTATION_SPLIT(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, &
+ &OELEC, OSEDIM_BEARD, PTHVREFZIKB, HCLOUD, PTSTEP, KRR, PDZZ, &
&PRHODREF, PPABST, PTHT, PT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINPRR, ZINPRI, PINPRS, PINPRG, &
+ &PQCT, PQRT, PQIT, PQST, PQGT, PQCS, PQRS, PQIS, PQSS, PQGS, &
+ &PEFIELDW, &
&PSEA=PSEA, PTOWN=PTOWN, &
- &PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
+ &PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR, &
+ &PQHT=PQHT, PQHS=PQHS)
PINPRS(IIJB:IIJE) = PINPRS(IIJB:IIJE) + ZINPRI(IIJB:IIJE)
!We correct negativities with conservation
!SPLI algorith uses a time-splitting. Inside the loop a temporary m.r. is used.
@@ -161,9 +206,15 @@ ELSEIF(PARAMI%CSEDIM=='SPLI') THEN
! will be still active and will lead to negative values.
! We could prevent the algorithm to not consume too much a species, instead we apply
! a correction here.
+!++cb-- il faudrait faire la correction correspondante sur les charges electriques pour eviter de se retrouver
+! avec des points ou il y a de la charge mais pas de masse !
CALL ICE4_CORRECT_NEGATIVITIES(D, ICED, KRR, PRVS, PRCS, PRRS, &
&PRIS, PRSS, PRGS, &
&PTHS, PLVFACT, PLSFACT, PRHS)
+! CALL ICE4_CORRECT_NEGATIVITIES(D, ICED, KRR, PRVS, PRCS, PRRS, &
+! &PRIS, PRSS, PRGS, &
+! &PQPIS, PQCS, PQRS, PQIS, PQSS, PQGS, PQNIS, &
+! &PTHS, PLVFACT, PLSFACT, PRHS, PQHS)
ELSEIF(PARAMI%CSEDIM=='NONE') THEN
ELSE
CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'no sedimentation scheme for PARAMI%CSEDIM='//PARAMI%CSEDIM)
@@ -177,6 +228,16 @@ IF (BUCONF%LBUDGET_RS) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGE
IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RG), 'SEDI', PRGS(:, :) * PRHODJ(:, :))
IF (BUCONF%LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RH), 'SEDI', PRHS(:, :) * PRHODJ(:, :))
!
+! Budget for electric charges
+IF (BUCONF%LBUDGET_SV .AND. OELEC) THEN
+ IF (PARAMI%LSEDIC) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1-1+NSV_ELECBEG+1), 'SEDI', PQCS(:, :) * PRHODJ(:, :))
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1-1+NSV_ELECBEG+2), 'SEDI', PQRS(:, :) * PRHODJ(:, :))
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1-1+NSV_ELECBEG+3), 'SEDI', PQIS(:, :) * PRHODJ(:, :))
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1-1+NSV_ELECBEG+4), 'SEDI', PQSS(:, :) * PRHODJ(:, :))
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1-1+NSV_ELECBEG+5), 'SEDI', PQGS(:, :) * PRHODJ(:, :))
+ IF (KRR == 7) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1-1+NSV_ELECBEG+6), 'SEDI', PQHS(:, :) * PRHODJ(:, :))
+END IF
+!
IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION', 1, ZHOOK_HANDLE)
!
END SUBROUTINE ICE4_SEDIMENTATION
diff --git a/src/common/micro/mode_ice4_sedimentation_split.F90 b/src/common/micro/mode_ice4_sedimentation_split.F90
index 19baa141ba88fd0d1a88438e5adbf2a74e0f5bed..0613e7d2852cac95197128d471b52b86d712b31b 100644
--- a/src/common/micro/mode_ice4_sedimentation_split.F90
+++ b/src/common/micro/mode_ice4_sedimentation_split.F90
@@ -6,13 +6,17 @@
MODULE MODE_ICE4_SEDIMENTATION_SPLIT
IMPLICIT NONE
CONTAINS
-SUBROUTINE ICE4_SEDIMENTATION_SPLIT(D, CST, ICEP, ICED, PARAMI, &
+SUBROUTINE ICE4_SEDIMENTATION_SPLIT(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, &
+ &OELEC, OSEDIM_BEARD, PTHVREFZIKB, HCLOUD, &
&PTSTEP, KRR, PDZZ, &
&PRHODREF, PPABST, PTHT, PT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINPRR, PINPRI, PINPRS, PINPRG, &
+ &PQCT, PQRT, PQIT, PQST, PQGT, PQCS, PQRS, PQIS, PQSS, PQGS,&
+ &PEFIELDW, &
&PSEA, PTOWN, &
- &PINPRH, PRHT, PRHS, PFPR)
+ &PINPRH, PRHT, PRHS, PFPR, &
+ &PQHT, PQHS)
!!
!!** PURPOSE
!! -------
@@ -28,6 +32,7 @@ SUBROUTINE ICE4_SEDIMENTATION_SPLIT(D, CST, ICEP, ICED, PARAMI, &
!!
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! J. Wurtz 03/2022: New snow characteristics with LSNOW_T
+! C. Barthe 03/2023: Add sedimentation of electric charges
!
!
!* 0. DECLARATIONS
@@ -39,8 +44,11 @@ USE MODD_CST, ONLY: CST_t
USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
+USE MODD_ELEC_DESCR, ONLY: ELEC_DESCR_t
+USE MODD_ELEC_PARAM, ONLY: ELEC_PARAM_t
!
USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
+USE MODE_ELEC_BEARD_EFFECT, ONLY: ELEC_BEARD_EFFECT
!
USE MODI_GAMMA, ONLY: GAMMA
!
@@ -48,13 +56,18 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-TYPE(DIMPHYEX_t), INTENT(IN) :: D !array dimensions
-TYPE(CST_t), INTENT(IN) :: CST
-TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
-TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
-TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
-REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
-INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+TYPE(DIMPHYEX_t), INTENT(IN) :: D !array dimensions
+TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
+TYPE(ELEC_PARAM_t), INTENT(IN) :: ELECP ! electrical parameters
+TYPE(ELEC_DESCR_t), INTENT(IN) :: ELECD ! electrical descriptive csts
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+LOGICAL, INTENT(IN) :: OELEC ! if true, cloud electricity is activated
+LOGICAL, INTENT(IN) :: OSEDIM_BEARD ! if true, effect of electrical forces on sedim.
+REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
+INTEGER, INTENT(IN) :: KRR ! Number of moist variable
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODREF! Reference density
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABST ! absolute pressure at t
@@ -71,44 +84,62 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRSS ! Snow/aggrega
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
-REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
-REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
REAL, DIMENSION(D%NIJT,D%NKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
-!
+! variables for cloud electricity
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQCT ! Cloud water electric charge at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQRT ! Rain water electric charge at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQIT ! Pristine ice electric charge at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQST ! Snow/aggregate electric charge at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PQGT ! Graupel electric charge at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(IN) :: PQHT ! Hail electric charge at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQCS ! Cloud water electric charge source
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQRS ! Rain water electric charge source
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQIS ! Pristine ice electric charge source
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQSS ! Snow/aggregate electric charge source
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQGS ! Graupel electric charge source
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQHS ! Hail electric charge source
+REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)), INTENT(IN) :: PEFIELDW ! Vertical E field
+REAL, INTENT(IN) :: PTHVREFZIKB ! Reference thv at IKB for electricity
!* 0.2 declaration of local variables
!
!
-INTEGER :: JIJ, JK
-INTEGER :: IKTB, IKTE, IIJE, IIJB
-INTEGER :: IRR !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
-LOGICAL :: GSEDIC !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
-LOGICAL :: GPRESENT_PFPR, GPRESENT_PSEA
-REAL :: ZINVTSTEP
-REAL, DIMENSION(D%NIJT) :: ZCONC_TMP ! Weighted concentration
-REAL, DIMENSION(D%NIJT,D%NKTB:D%NKTE) :: ZW ! work array
-REAL, DIMENSION(D%NIJT, D%NKT) :: ZCONC3D, & ! droplet condensation
- & ZRAY, & ! Cloud Mean radius
- & ZLBC, & ! XLBC weighted by sea fraction
- & ZFSEDC, &
- & ZPRCS,ZPRRS,ZPRIS,ZPRSS,ZPRGS,ZPRHS, & ! Mixing ratios created during the time step
- & ZRCT, &
- & ZRRT, &
- & ZRIT, &
- & ZRST, &
- & ZRGT, &
- & ZRHT
+INTEGER :: JIJ, JK
+INTEGER :: IKTB, IKTE, IKB, IKL, IIJE, IIJB
+INTEGER :: IRR !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
+LOGICAL :: GSEDIC !Workaround of PGI bug with OpenACC (at least up to 18.10 version)
+LOGICAL :: GPRESENT_PFPR, GPRESENT_PSEA
+REAL :: ZINVTSTEP
+REAL, DIMENSION(D%NIJT) :: ZCONC_TMP ! Weighted concentration
+REAL, DIMENSION(D%NIJT,D%NKTB:D%NKTE) :: ZW ! work array
+REAL, DIMENSION(D%NIJT, D%NKT) :: ZCONC3D, & ! droplet condensation
+ & ZRAY, & ! Cloud Mean radius
+ & ZLBC, & ! XLBC weighted by sea fraction
+ & ZFSEDC, &
+ & ZPRCS,ZPRRS,ZPRIS,ZPRSS,ZPRGS,ZPRHS, & ! Mixing ratios created during the time step
+ & ZRCT, &
+ & ZRRT, &
+ & ZRIT, &
+ & ZRST, &
+ & ZRGT, &
+ & ZRHT
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)) :: &
+ ZQCT, ZQRT, ZQIT, ZQST, ZQGT, ZQHT, & ! electric charge a t
+ ZPQCS, ZPQRS, ZPQIS, ZPQSS, ZPQGS, ZPQHS ! electric charge created during the time step
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_SPLIT', 0, ZHOOK_HANDLE)
+
!-------------------------------------------------------------------------------
!
!
@@ -204,6 +235,23 @@ DO JK=IKTB, IKTE
END IF
!
ZW(JIJ,JK) =1./(PRHODREF(JIJ,JK)* PDZZ(JIJ,JK))
+ !
+ ! Cloud electricity
+ IF (OELEC) THEN
+ IF (GSEDIC) ZPQCS(JIJ,JK) = PQCS(JIJ,JK) - PQCT(JIJ,JK) * ZINVTSTEP
+ ZPQRS(JIJ,JK) = PQRS(JIJ,JK) - PQRT(JIJ,JK) * ZINVTSTEP
+ ZPQIS(JIJ,JK) = PQIS(JIJ,JK) - PQIT(JIJ,JK) * ZINVTSTEP
+ ZPQSS(JIJ,JK) = PQSS(JIJ,JK) - PQST(JIJ,JK) * ZINVTSTEP
+ ZPQGS(JIJ,JK) = PQGS(JIJ,JK) - PQGT(JIJ,JK) * ZINVTSTEP
+ IF (IRR==7) ZPQHS(JIJ,JK) = PQHS(JIJ,JK) - PQHT(JIJ,JK) * ZINVTSTEP
+ !
+ ZQCT(JIJ,JK) = PQCT(JIJ,JK)
+ ZQRT(JIJ,JK) = PQST(JIJ,JK)
+ ZQIT(JIJ,JK) = PQIT(JIJ,JK)
+ ZQST(JIJ,JK) = PQST(JIJ,JK)
+ ZQGT(JIJ,JK) = PQGT(JIJ,JK)
+ IF (IRR==7) ZQHT(JIJ,JK) = PQHT(JIJ,JK)
+ ENDIF
ENDDO
ENDDO
!
@@ -211,52 +259,65 @@ ENDDO
!* 2.1 for cloud
!
IF (GSEDIC) THEN
- CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, KRR, &
+ CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, &
+ &KRR, OELEC, OSEDIM_BEARD, &
&PRHODREF, ZW, PDZZ, PPABST, PTHT, PT, PTSTEP, &
&2, &
&ZRCT, PRCS, PINPRC, ZPRCS, &
- &ZRAY, ZLBC, ZFSEDC, ZCONC3D, PFPR=PFPR)
+ &ZQCT, PQCS, ZPQCS, PEFIELDW, &
+ &PRAY=ZRAY, PLBC=ZLBC, PFSEDC=ZFSEDC, PCONC3D=ZCONC3D, &
+ &PFPR=PFPR)
ENDIF
!
!* 2.2 for rain
!
- CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, KRR, &
+ CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, &
+ &KRR, OELEC, OSEDIM_BEARD, &
&PRHODREF, ZW, PDZZ, PPABST, PTHT, PT, PTSTEP, &
&3, &
&ZRRT, PRRS, PINPRR, ZPRRS, &
+ &ZQRT, PQRS, ZPQRS, PEFIELDW, &
&PFPR=PFPR)
!
!* 2.3 for pristine ice
!
- CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, KRR, &
+ CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, &
+ &KRR, OELEC, OSEDIM_BEARD, &
&PRHODREF, ZW, PDZZ, PPABST, PTHT, PT, PTSTEP, &
&4, &
&ZRIT, PRIS, PINPRI, ZPRIS, &
+ &ZQIT, PQIS, ZPQIS, PEFIELDW, &
&PFPR=PFPR)
!
!* 2.4 for aggregates/snow
!
- CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, KRR, &
+ CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, &
+ &KRR, OELEC, OSEDIM_BEARD, &
&PRHODREF, ZW, PDZZ, PPABST, PTHT, PT, PTSTEP, &
&5, &
&ZRST, PRSS, PINPRS, ZPRSS, &
+ &ZQST, PQSS, ZPQSS, PEFIELDW, &
&PFPR=PFPR)
!
!* 2.5 for graupeln
!
- CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, KRR, &
+ CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, &
+ &KRR, OELEC, OSEDIM_BEARD, &
&PRHODREF, ZW, PDZZ, PPABST, PTHT, PT, PTSTEP, &
&6, &
&ZRGT, PRGS, PINPRG, ZPRGS, &
+ &ZQGT, PQGS, ZPQGS, PEFIELDW, &
&PFPR=PFPR)
!
!* 2.6 for hail
!
IF (IRR==7) THEN
- CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, KRR, &
+ CALL INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, &
+ &KRR, OELEC, OSEDIM_BEARD, &
&PRHODREF, ZW, PDZZ, PPABST, PTHT, PT, PTSTEP, &
&7, &
&ZRHT, PRHS, PINPRH, ZPRHS, &
+ &ZQHT, PQHS, ZPQHS, PEFIELDW, &
&PFPR=PFPR)
ENDIF
!
@@ -268,10 +329,12 @@ CONTAINS
!-------------------------------------------------------------------------------
!
!
-SUBROUTINE INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, KRR, &
+SUBROUTINE INTERNAL_SEDIM_SPLI(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, &
+ &KRR, OELEC, OSEDIM_BEARD, &
&PRHODREF, POORHODZ, PDZZ, PPABST, PTHT, PT, PTSTEP, &
&KSPE, &
&PRXT, PRXS, PINPRX, PPRXS, &
+ &PQXT, PQXS, PPQXS, PEFIELDW, &
&PRAY, PLBC, PFSEDC, PCONC3D, PFPR)
!
!* 0. DECLARATIONS
@@ -282,6 +345,12 @@ USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
!
+! parameters for electricity
+USE MODD_ELEC_PARAM, ONLY: ELEC_PARAM_t
+USE MODD_ELEC_DESCR, ONLY: ELEC_DESCR_t
+!
+USE MODI_MOMG
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -291,19 +360,28 @@ TYPE(CST_t), INTENT(IN) :: CST
TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
+TYPE(ELEC_PARAM_t), INTENT(IN) :: ELECP ! electrical parameters
+TYPE(ELEC_DESCR_t), INTENT(IN) :: ELECD ! electrical descriptive csts
INTEGER, INTENT(IN) :: KRR
-REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(D%NIJT,D%NKTB:D%NKTE), INTENT(IN) :: POORHODZ ! One Over (Rhodref times delta Z)
-REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! layer thikness (m)
-REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABST
-REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHT
-REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PT
-REAL, INTENT(IN) :: PTSTEP ! total timestep
-INTEGER, INTENT(IN) :: KSPE ! 1 for rc, 2 for rr...
-REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRXT ! mr of specy X
-REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRXS !Tendency of the specy KSPE
-REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRX ! instant precip
-REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPRXS ! external tendencie
+LOGICAL, INTENT(IN) :: OELEC ! if true, sedimentation of elec. charges
+LOGICAL, INTENT(IN) :: OSEDIM_BEARD ! if true, effect of electric forces on sedim.
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(D%NIJT,D%NKTB:D%NKTE), INTENT(IN) :: POORHODZ ! One Over (Rhodref times delta Z)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! layer thikness (m)
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPABST
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PTHT
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PT
+REAL, INTENT(IN) :: PTSTEP ! total timestep
+INTEGER, INTENT(IN) :: KSPE ! 1 for rc, 2 for rr...
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRXT ! mr of specy X
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRXS !Tendency of the specy KSPE
+REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRX ! instant precip
+REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PPRXS ! external tendencie
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQXT ! electric charge at t for specy KSPE
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(INOUT) :: PQXS ! tendency of the electric charge
+ ! for specy KSPE
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), INTENT(IN) :: PPQXS ! external tendency
+REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)), INTENT(IN) :: PEFIELDW ! Vertical E field
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN), OPTIONAL :: PRAY, PLBC, PFSEDC, PCONC3D
REAL, DIMENSION(D%NIJT,D%NKT,KRR), INTENT(INOUT), OPTIONAL :: PFPR ! upper-air precipitation fluxes
!
@@ -316,7 +394,7 @@ REAL :: ZINVTSTEP
REAL :: ZZWLBDC, ZZRAY, ZZT, ZZWLBDA, ZZCC
REAL :: ZLBDA
REAL :: ZFSED, ZEXSED
-REAL :: ZMRCHANGE
+REAL :: ZMRCHANGE
REAL, DIMENSION(D%NIJT) :: ZMAX_TSTEP ! Maximum CFL in column
REAL, DIMENSION(SIZE(ICED%XRTMIN)) :: ZRSMIN
REAL, DIMENSION(D%NIJT) :: ZREMAINT ! Remaining time until the timestep end
@@ -324,6 +402,33 @@ LOGICAL :: ZANYREMAINT
REAL, DIMENSION(D%NIJT, 0:D%NKT+1) :: ZWSED ! Sedimentation fluxes
INTEGER :: IKTB, IKTE, IKB, IKL, IIJE, IIJB
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
+!
+! local variables for cloud electricity
+REAL :: ZEXT ! e_x coefficient of the q(D) relation
+REAL :: ZNCI ! N_ci for ice crystal sedimentation
+!REAL, DIMENSION(D%NIJT,0:D%NKT+1) :: ZWSEDQ ! Sedimentation fluxes for electric charges
+!REAL, DIMENSION(D%NIJT,0:D%NKT+1) :: ZBEARDCOEFF ! effect of electric forces on sedimentation
+!REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(0:D%NKT+1,0,OELEC)) :: &
+!++cb-- est-ce que cette declaration est correcte par rapport a ce qui est fait pour zwsed ?
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT+2,0,OELEC)) :: &
+ ZWSEDQ ! Sedimentation fluxes for electric charges
+!REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(0:D%NKT+1,0,OSEDIM_BEARD)) :: &
+REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)) :: &
+ ZBEARDCOEFF ! effect of electric forces on sedimentation
+!REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(0:D%NKT+1,0,OSEDIM_BEARD)) :: &
+REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)) :: &
+ ZLBDA3 ! slope parameter of the distribution
+!LOGICAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(0:D%NKT+1,0,OSEDIM_BEARD)) :: GMASK
+LOGICAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)) :: GMASK
+REAL :: ZQCHANGE
+REAL :: ZFQSED, ZEXQSED
+REAL :: ZEXMIN, ZEXMAX
+REAL :: ZLBX, ZLBEXX
+REAL :: ZFQUPDX
+REAL :: ZCXX
+REAL :: ZFX
+! end - local variables for cloud electricity
+!
IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_SPLIT:INTERNAL_SEDIM_SPLIT', 0, ZHOOK_HANDLE)
!
IKTB=D%NKTB
@@ -350,6 +455,18 @@ ZREMAINT(IIJB:IIJE) = PTSTEP
ZANYREMAINT = .TRUE.
DO WHILE (ZANYREMAINT)
!
+ ! Effect of electrical forces on sedimentation
+ IF (OELEC .AND. OSEDIM_BEARD) THEN
+ DO JK = IKTB, IKTE
+ DO JIJ = IIJB, IIJE
+ IF (PRXT(JIJ,JK)>ICED%XRTMIN(KSPE) .AND. ZREMAINT(JIJ)>0.) THEN
+ GMASK(JIJ,JK) = .TRUE.
+ ELSE
+ GMASK(JIJ,JK) = .FALSE.
+ END IF
+ END DO
+ END DO
+ END IF
!
!* 1. Parameters for cloud sedimentation
!
@@ -360,6 +477,10 @@ DO WHILE (ZANYREMAINT)
IF(KSPE==2) THEN
!******* for cloud
ZWSED(:,:) = 0.
+ IF (OELEC) THEN
+ ZWSEDQ(:,:) = 0.
+ ZLBDA3(:,:) = 0.
+ END IF
DO JK = IKTB,IKTE
DO JIJ = IIJB,IIJE
IF(PRXT(JIJ,JK)>ICED%XRTMIN(KSPE) .AND. ZREMAINT(JIJ)>0.) THEN
@@ -372,12 +493,38 @@ DO WHILE (ZANYREMAINT)
ZZCC = ICED%XCC*(1.+1.26*ZZWLBDA/ZZRAY)
ZWSED(JIJ, JK) = PRHODREF(JIJ,JK)**(-ICED%XCEXVT +1 ) * &
&ZZWLBDC**(-ICED%XDC)*ZZCC*PFSEDC(JIJ,JK) * PRXT(JIJ,JK)
+!++cb++ nouveau : traitement de la sedimentation des charges portees par les gouttelettes
+! A TESTER
+ IF (OELEC) THEN
+ ZEXT = PQXT(JIJ,JK) / ELECP%XFQUPDC * PRHODREF(JIJ,JK)
+ IF (ABS(ZEXT) .GT. ELECP%XECMIN) THEN
+ ZWSEDQ(JIJ,JK) = ELECP%XFQSEDC * ZEXT * PCONC3D(JIJ,JK) * &
+ PRHODREF(JIJ,JK)**(-ICED%XCEXVT) * &
+ ZZCC * ZZWLBDC**(-ELECP%XEXQSEDC)
+ IF (OSEDIM_BEARD) ZLBDA3(JIJ,JK) = ZZWLBDC
+ ENDIF
+ ENDIF
ENDIF
+!--cb--
ENDDO
ENDDO
+ IF (OELEC .AND. OSEDIM_BEARD) THEN
+ CALL ELEC_BEARD_EFFECT(D, CST, ICED, HCLOUD, KSPE, GMASK, PT, PRHODREF, PTHVREFZIKB, &
+ PRXT, PQXT, PEFIELDW, ZLBDA3, ZBEARDCOEFF)
+ DO JK = IKTB,IKTE
+ DO JIJ = IIJB,IIJE
+ ZWSED(JIJ,JK) = ZWSED(JIJ,JK) * ZBEARDCOEFF(JIJ,JK)
+ ZWSEDQ(JIJ,JK) = ZWSEDQ(JIJ,JK) * ZBEARDCOEFF(JIJ,JK)
+ END DO
+ END DO
+ END IF
ELSEIF(KSPE==4) THEN
! ******* for pristine ice
ZWSED(:,:) = 0.
+ IF (OELEC) THEN
+ ZWSEDQ(:,:) = 0.
+ ZLBDA3(:,:) = 0.
+ END IF
DO JK = IKTB,IKTE
DO JIJ = IIJB,IIJE
IF(PRXT(JIJ, JK) .GT. MAX(ICED%XRTMIN(4), 1.0E-7) .AND. ZREMAINT(JIJ)>0.) THEN
@@ -385,12 +532,43 @@ DO WHILE (ZANYREMAINT)
& PRHODREF(JIJ,JK)**(1.-ICED%XCEXVT) * & ! McF&H
& MAX( 0.05E6,-0.15319E6-0.021454E6* &
& ALOG(PRHODREF(JIJ,JK)*PRXT(JIJ,JK)) )**ICEP%XEXCSEDI
+ IF (OELEC) THEN
+ ! N_ci from McF&H
+ ZNCI = ELECP%XFCI * PRHODREF(JIJ,JK) * PRXT(JIJ,JK) * &
+ MAX(0.05E6,-0.15319E6-0.021454E6*ALOG(PRHODREF(JIJ,JK)*PRXT(JIJ,JK)))**3.
+ ! compute e_i of the q - D relationship
+ ZEXT = PQXT(JIJ,JK) / ELECP%XFQUPDI * &
+ (PRHODREF(JIJ,JK) * PRXT(JIJ,JK))**(-ELECP%XEXFQUPDI) * &
+ ZNCI**(ELECP%XEXFQUPDI-1.)
+ IF (ABS(ZEXT) .GT. ELECP%XEIMIN) THEN
+ ZWSEDQ(JIJ,JK) = ELECP%XFQSEDI * ZEXT * PRXT(JIJ,JK) * &
+ PRHODREF(JIJ,JK)**(1.-ICED%XCEXVT) * &
+ MAX( 0.05E6,-0.15319E6-0.021454E6* & ! McF&H
+ ALOG(PRHODREF(JIJ,JK)*PRXT(JIJ,JK)) )**(3.*(1-ELECP%XEXQSEDI))
+ IF (OSEDIM_BEARD) ZLBDA3(JIJ,JK) = (2.14E-3 * MOMG(ICED%XALPHAI,ICED%XNUI,1.7) * &
+ ZNCI / (PRHODREF(JIJ,JK) * PRXT(JIJ,JK)))**0.588235
+ ENDIF
+ ENDIF
ENDIF
ENDDO
ENDDO
+ IF (OELEC .AND. OSEDIM_BEARD) THEN
+ CALL ELEC_BEARD_EFFECT(D, CST, ICED, HCLOUD, KSPE, GMASK, PT, PRHODREF, PTHVREFZIKB, &
+ PRXT, PQXT, PEFIELDW, ZLBDA3, ZBEARDCOEFF)
+ DO JK = IKTB,IKTE
+ DO JIJ = IIJB,IIJE
+ ZWSED(JIJ,JK) = ZWSED(JIJ,JK) * ZBEARDCOEFF(JIJ,JK)
+ ZWSEDQ(JIJ,JK) = ZWSEDQ(JIJ,JK) * ZBEARDCOEFF(JIJ,JK)
+ END DO
+ END DO
+ END IF
ELSEIF(KSPE==5) THEN
! ******* for snow
ZWSED(:,:) = 0.
+ IF (OELEC) THEN
+ ZWSEDQ(:,:) = 0.
+ ZLBDA3(:,:) = 0.
+ END IF
#ifdef REPRO48
!The following lines must be kept equal to the computation in the general case ("for other species" case below)
ZFSED=ICEP%XFSEDS
@@ -407,22 +585,41 @@ DO WHILE (ZANYREMAINT)
DO JK = IKTB,IKTE
DO JIJ = IIJB,IIJE
IF(PRXT(JIJ,JK)> ICED%XRTMIN(KSPE) .AND. ZREMAINT(JIJ)>0.) THEN
- IF (PARAMI%LSNOW_T .AND. PT(JIJ,JK)>263.15) THEN
- ZLBDA = MAX(MIN(ICED%XLBDAS_MAX, 10**(14.554-0.0423*PT(JIJ,JK))),ICED%XLBDAS_MIN)*ICED%XTRANS_MP_GAMMAS
- ELSE IF (PARAMI%LSNOW_T) THEN
- ZLBDA = MAX(MIN(ICED%XLBDAS_MAX, 10**(6.226 -0.0106*PT(JIJ,JK))),ICED%XLBDAS_MIN)*ICED%XTRANS_MP_GAMMAS
- ELSE
- ZLBDA=MAX(MIN(ICED%XLBDAS_MAX, ICED%XLBS * ( PRHODREF(JIJ,JK) * PRXT(JIJ,JK) )**ICED%XLBEXS),ICED%XLBDAS_MIN)
- END IF
- ZWSED(JIJ, JK) = ICEP%XFSEDS * &
- & PRXT(JIJ,JK)* &
- & PRHODREF(JIJ,JK)**(1-ICED%XCEXVT) * &
- & (1 + (ICED%XFVELOS/ZLBDA)**ICED%XALPHAS)** (-ICED%XNUS+ICEP%XEXSEDS/ICED%XALPHAS) * &
- & ZLBDA ** (ICED%XBS+ICEP%XEXSEDS)
-
+ IF (PARAMI%LSNOW_T .AND. PT(JIJ,JK)>263.15) THEN
+ ZLBDA = MAX(MIN(ICED%XLBDAS_MAX, 10**(14.554-0.0423*PT(JIJ,JK))),ICED%XLBDAS_MIN)*ICED%XTRANS_MP_GAMMAS
+ ELSE IF (PARAMI%LSNOW_T) THEN
+ ZLBDA = MAX(MIN(ICED%XLBDAS_MAX, 10**(6.226 -0.0106*PT(JIJ,JK))),ICED%XLBDAS_MIN)*ICED%XTRANS_MP_GAMMAS
+ ELSE
+ ZLBDA=MAX(MIN(ICED%XLBDAS_MAX, ICED%XLBS * ( PRHODREF(JIJ,JK) * PRXT(JIJ,JK) )**ICED%XLBEXS),ICED%XLBDAS_MIN)
+ END IF
+ ZWSED(JIJ, JK) = ICEP%XFSEDS * &
+ & PRXT(JIJ,JK)* &
+ & PRHODREF(JIJ,JK)**(1-ICED%XCEXVT) * &
+ & (1 + (ICED%XFVELOS/ZLBDA)**ICED%XALPHAS)** (-ICED%XNUS+ICEP%XEXSEDS/ICED%XALPHAS) * &
+ & ZLBDA ** (ICED%XBS+ICEP%XEXSEDS)
+ IF (OELEC .AND. ZLBDA > 0.) THEN
+ ! compute the e_x coefficient of the q - D relationship
+ ZEXT = PRHODREF(JIJ,JK) * PQXT(JIJ,JK) / (ELECP%XFQUPDS * ZLBDA**(ICED%XCXS-ELECD%XFS))
+ ZEXT = SIGN( MIN(ABS(ZEXT), ELECP%XESMAX), ZEXT)
+ IF (ABS(ZEXT) > ELECP%XESMIN) THEN
+ ZWSEDQ(JIJ,JK) = ELECP%XFQSEDS * ZEXT * PRXT(JIJ,JK)**ELECP%XEXQSEDS &
+ * PRHODREF(JIJ,JK)**(ELECP%XEXQSEDS-ICED%XCEXVT)
+ IF (OSEDIM_BEARD) ZLBDA3(JIJ,JK) = ZLBDA
+ ENDIF
+ ENDIF
ENDIF
ENDDO
ENDDO
+ IF (OELEC .AND. OSEDIM_BEARD) THEN
+ CALL ELEC_BEARD_EFFECT(D, CST, ICED, HCLOUD, KSPE, GMASK, PT, PRHODREF, PTHVREFZIKB,&
+ PRXT, PQXT, PEFIELDW, ZLBDA3, ZBEARDCOEFF)
+ DO JK = IKTB,IKTE
+ DO JIJ = IIJB,IIJE
+ ZWSED(JIJ,JK) = ZWSED(JIJ,JK) * ZBEARDCOEFF(JIJ,JK)
+ ZWSEDQ(JIJ,JK) = ZWSEDQ(JIJ,JK) * ZBEARDCOEFF(JIJ,JK)
+ END DO
+ END DO
+ END IF
#endif
ELSE
! ******* for other species
@@ -441,15 +638,81 @@ DO WHILE (ZANYREMAINT)
CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'ICE4_SEDIMENTATION_SPLIT', 'no sedimentation parameter for KSPE='//TRIM(YSPE) )
END SELECT
!
+ IF (OELEC) THEN
+ SELECT CASE(KSPE)
+ CASE(3)
+ ZFQSED = ELECP%XFQSEDR
+ ZEXQSED = ELECP%XEXQSEDR
+ ZEXMIN = ELECP%XERMIN
+ ZEXMAX = ELECP%XERMAX
+ ZLBX = ICED%XLBR
+ ZLBEXX = ICED%XLBEXR
+ ZFQUPDX = ELECP%XFQUPDR
+ ZCXX = ELECD%XCXR
+ ZFX = ELECD%XFR
+ CASE(6)
+ ZFQSED = ELECP%XFQSEDG
+ ZEXQSED = ELECP%XEXQSEDG
+ ZEXMIN = ELECP%XEGMIN
+ ZEXMAX = ELECP%XEGMAX
+ ZLBX = ICED%XLBG
+ ZLBEXX = ICED%XLBEXG
+ ZFQUPDX = ELECP%XFQUPDG
+ ZCXX = ICED%XCXG
+ ZFX = ELECD%XFG
+ CASE(7)
+ ZFQSED = ELECP%XFQSEDH
+ ZEXQSED = ELECP%XEXQSEDH
+ ZEXMIN = ELECP%XEHMIN
+ ZEXMAX = ELECP%XEHMAX
+ ZLBX = ICED%XLBH
+ ZLBEXX = ICED%XLBEXH
+ ZFQUPDX = ELECP%XFQUPDH
+ ZCXX = ICED%XCXH
+ ZFX = ELECD%XFH
+ CASE DEFAULT
+ write( yspe, '( I10 )' ) kspe
+ call Print_msg( NVERB_FATAL, 'GEN', 'ICE4_SEDIMENTATION_SPLIT', 'no sedimentation parameter for KSPE='//trim(yspe) )
+ END SELECT
+ END IF
+ !
ZWSED(:,:) = 0.
+ IF (OELEC) THEN
+ ZWSEDQ(:,:) = 0.
+ ZLBDA3(:,:) = 0.
+ END IF
DO JK = IKTB,IKTE
DO JIJ = IIJB,IIJE
IF(PRXT(JIJ,JK)>ICED%XRTMIN(KSPE) .AND. ZREMAINT(JIJ)>0.) THEN
ZWSED(JIJ, JK) = ZFSED * PRXT(JIJ, JK)**ZEXSED &
& * PRHODREF(JIJ, JK)**(ZEXSED-ICED%XCEXVT)
+ IF (OELEC) THEN
+ ! need lambda_x to compute e_x
+ ZLBDA = ZLBX * (PRHODREF(JIJ,JK) * MAX(PRXT(JIJ,JK), ICED%XRTMIN(KSPE)))**ZLBEXX
+ IF (ZLBDA > 0.) THEN
+ ! compute the e_x coefficient of the q - D relationship
+ ZEXT = PRHODREF(JIJ,JK) * PQXT(JIJ,JK) / (ZFQUPDX * ZLBDA**(ZCXX-ZFX))
+ ZEXT = SIGN( MIN(ABS(ZEXT), ZEXMAX), ZEXT)
+ END IF
+ IF (ABS(ZEXT) > ZEXMIN) THEN
+ ZWSEDQ(JIJ,JK) = ZFQSED * ZEXT * PRXT(JIJ,JK)**ZEXQSED &
+ * PRHODREF(JIJ,JK)**(ZEXQSED-ICED%XCEXVT)
+ IF (OSEDIM_BEARD) ZLBDA3(JIJ,JK) = ZLBDA
+ END IF
+ ENDIF
ENDIF
ENDDO
ENDDO
+ IF (OELEC .AND. OSEDIM_BEARD) THEN
+ CALL ELEC_BEARD_EFFECT(D, CST, ICED, HCLOUD, KSPE, GMASK, PT, PRHODREF, PTHVREFZIKB, &
+ PRXT, PQXT, PEFIELDW, ZLBDA3, ZBEARDCOEFF)
+ DO JK = IKTB,IKTE
+ DO JIJ = IIJB,IIJE
+ ZWSED(JIJ,JK) = ZWSED(JIJ,JK) * ZBEARDCOEFF(JIJ,JK)
+ ZWSEDQ(JIJ,JK) = ZWSEDQ(JIJ,JK) * ZBEARDCOEFF(JIJ,JK)
+ END DO
+ END DO
+ END IF
ENDIF
ZMAX_TSTEP(:) = ZREMAINT(:)
DO JK = IKTB,IKTE
@@ -474,6 +737,11 @@ DO WHILE (ZANYREMAINT)
IF (GPRESENT_PFPR) THEN
PFPR(JIJ,JK,KSPE) = PFPR(JIJ,JK,KSPE) + ZWSED(JIJ,JK) * (ZMAX_TSTEP(JIJ) * ZINVTSTEP)
ENDIF
+ IF (OELEC) THEN
+ ZQCHANGE = ZMAX_TSTEP(JIJ) * POORHODZ(JIJ,JK) * (ZWSEDQ(JIJ,JK+IKL) - ZWSEDQ(JIJ,JK))
+ PQXT(JIJ,JK) = PQXT(JIJ,JK) + ZQCHANGE + PPQXS(JIJ,JK) * ZMAX_TSTEP(JIJ)
+ PQXS(JIJ,JK) = PQXS(JIJ,JK) + ZQCHANGE * ZINVTSTEP
+ ENDIF
ENDDO
ENDDO
!
diff --git a/src/common/micro/mode_ice4_slow.F90 b/src/common/micro/mode_ice4_slow.F90
index e05c784fae93f11baa945c7859f61084cd5ccbcc..6b6c7140e0351dbedde6ffe0a1850d2e39b0982b 100644
--- a/src/common/micro/mode_ice4_slow.F90
+++ b/src/common/micro/mode_ice4_slow.F90
@@ -5,11 +5,12 @@
MODULE MODE_ICE4_SLOW
IMPLICIT NONE
CONTAINS
-SUBROUTINE ICE4_SLOW(CST, ICEP, ICED, KPROMA, KSIZE, LDSOFT, LDCOMPUTE, PRHODREF, PT, &
+SUBROUTINE ICE4_SLOW(CST, ICEP, ICED, KPROMA, KSIZE, LDSOFT, OELEC, LDCOMPUTE, PRHODREF, PT, &
&PSSI, PLVFACT, PLSFACT, &
&PRVT, PRCT, PRIT, PRST, PRGT, &
&PLBDAS, PLBDAG, &
&PAI, PCJ, PHLI_HCF, PHLI_HRI,&
+ &PLATHAM_IAGGS, &
&PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG)
!!
!!** PURPOSE
@@ -25,6 +26,7 @@ SUBROUTINE ICE4_SLOW(CST, ICEP, ICED, KPROMA, KSIZE, LDSOFT, LDCOMPUTE, PRHODREF
!!
!! R. El Khatib 24-Aug-2021 Optimizations
! J. Wurtz 03/2022: New snow characteristics with LSNOW_T
+! C. Barthe 06/2023: Add retroaction of electric field on IAGGS
!
!
!* 0. DECLARATIONS
@@ -44,6 +46,7 @@ TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
INTEGER, INTENT(IN) :: KPROMA, KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
+LOGICAL, INTENT(IN) :: OELEC
LOGICAL, DIMENSION(KPROMA), INTENT(IN) :: LDCOMPUTE
REAL, DIMENSION(KPROMA), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KPROMA), INTENT(IN) :: PT ! Temperature
@@ -61,6 +64,7 @@ REAL, DIMENSION(KPROMA), INTENT(IN) :: PAI ! Thermodynamical functi
REAL, DIMENSION(KPROMA), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
REAL, DIMENSION(KPROMA), INTENT(IN) :: PHLI_HCF !
REAL, DIMENSION(KPROMA), INTENT(IN) :: PHLI_HRI !
+REAL, DIMENSION(MERGE(KPROMA,0,OELEC)), INTENT(IN) :: PLATHAM_IAGGS ! enhancement factor of IAGGS due to Efield
REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRCHONI ! Homogeneous nucleation
REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRVDEPS ! Deposition on r_s
REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRIAGGS ! Aggregation on r_s
@@ -144,6 +148,7 @@ DO JL=1, KSIZE
* PRHODREF(JL)**(-ICED%XCEXVT+1.) &
* ((PLBDAS(JL))**(ICED%XBS+ICEP%XEXIAGGS))
#endif
+ IF (OELEC) PRIAGGS(JL) = PRIAGGS(JL) * PLATHAM_IAGGS(JL)
ENDIF
ELSE
PRIAGGS(JL) = 0.
diff --git a/src/common/micro/mode_ice4_stepping.F90 b/src/common/micro/mode_ice4_stepping.F90
index a2b9e46c990826a4b141766f9a782091da51a7ba..06cd511afc949e9d8f27cf5c1df4c7e6be5c42c1 100644
--- a/src/common/micro/mode_ice4_stepping.F90
+++ b/src/common/micro/mode_ice4_stepping.F90
@@ -9,14 +9,15 @@ CONTAINS
SUBROUTINE ICE4_STEPPING(D, CST, PARAMI, ICEP, ICED, BUCONF, &
&LDSIGMA_RC, LDAUCV_ADJU, LDEXT_TEND, &
&KPROMA, KMICRO, LDMICRO, PTSTEP, &
- &KRR, &
+ &KRR, OSAVE_MICRO, OELEC, &
&PEXN, PRHODREF, K1, K2, &
&PPRES, PCF, PSIGMA_RC, &
&PCIT, &
&PVART, &
&PHLC_HCF, PHLC_HRC, &
&PHLI_HCF, PHLI_HRI, PRAINFR, &
- &PEXTPK, PBU_SUM, PRREVAV)
+ &PEXTPK, PBU_SUM, PRREVAV, &
+ &PLATHAM_IAGGS)
! ######################################################################
!
!!**** * - compute the explicit microphysical sources
@@ -83,6 +84,8 @@ INTEGER, INTENT(IN) :: KMICRO ! Case r_x>0 locations
LOGICAL, DIMENSION(KPROMA), INTENT(IN) :: LDMICRO
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+LOGICAL, INTENT(IN) :: OSAVE_MICRO ! if true, save the microphysical tendencies
+LOGICAL, INTENT(IN) :: OELEC ! if true, cloud electricity is activated
!
REAL, DIMENSION(KPROMA), INTENT(IN) :: PEXN ! Exner function
REAL, DIMENSION(KPROMA), INTENT(IN) :: PRHODREF! Reference density
@@ -99,7 +102,9 @@ REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PHLI_HCF
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(INOUT) :: PRAINFR
REAL, DIMENSION(KPROMA,0:7), INTENT(INOUT) :: PEXTPK !To take into acount external tendencies inside the splitting
REAL, DIMENSION(KPROMA, IBUNUM-IBUNUM_EXTRA),INTENT(OUT) :: PBU_SUM
-REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PRREVAV
+REAL, DIMENSION(KPROMA), INTENT(OUT) :: PRREVAV
+REAL, DIMENSION(MERGE(KPROMA,0,OELEC)), INTENT(IN) :: PLATHAM_IAGGS ! E Function to simulate
+ ! enhancement of IAGGS
!
!
!* 0.2 Declarations of local variables :
@@ -157,7 +162,7 @@ IF (LHOOK) CALL DR_HOOK('ICE4_STEPPING', 0, ZHOOK_HANDLE)
!
ZINV_TSTEP=1./PTSTEP
!
-IF(BUCONF%LBU_ENABLE) THEN
+IF(BUCONF%LBU_ENABLE .OR. OSAVE_MICRO) THEN
DO JV=1, IBUNUM-IBUNUM_EXTRA
PBU_SUM(:, JV)=0.
ENDDO
@@ -256,10 +261,12 @@ DO WHILE(ANY(ZTIME(1:KMICRO)<PTSTEP)) ! Loop to *really* compute tendencies
CALL ICE4_TENDENCIES(CST, PARAMI, ICEP, ICED, BUCONF, &
&KPROMA, KMICRO, &
&KRR, LSOFT, LLCOMPUTE, &
+ &OSAVE_MICRO, OELEC, &
&PEXN, PRHODREF, ZLVFACT, ZLSFACT, K1, K2, &
&PPRES, PCF, PSIGMA_RC, &
&PCIT, &
&ZZT, PVART, &
+ &PLATHAM_IAGGS, &
&ZBU_INST, &
&ZRS_TEND, ZRG_TEND, ZRH_TEND, ZSSI, &
&ZA, ZB, &
@@ -399,7 +406,7 @@ DO WHILE(ANY(ZTIME(1:KMICRO)<PTSTEP)) ! Loop to *really* compute tendencies
!
!*** 4.8 Mixing ratio change due to each process
!
- IF(BUCONF%LBU_ENABLE) THEN
+ IF(BUCONF%LBU_ENABLE .OR. OSAVE_MICRO) THEN
!Mixing ratio change due to a tendency
DO JV=1, IBUNUM-IBUNUM_MR-IBUNUM_EXTRA
DO JL=1, KMICRO
diff --git a/src/common/micro/mode_ice4_tendencies.F90 b/src/common/micro/mode_ice4_tendencies.F90
index 1c986d3922afd015805cf8b6c130112b649c2ced..215030e7a9e4f4d5bf545649e2389033a48fee7d 100644
--- a/src/common/micro/mode_ice4_tendencies.F90
+++ b/src/common/micro/mode_ice4_tendencies.F90
@@ -8,10 +8,12 @@ IMPLICIT NONE
CONTAINS
SUBROUTINE ICE4_TENDENCIES(CST, PARAMI, ICEP, ICED, BUCONF, KPROMA, KSIZE, &
&KRR, ODSOFT, LDCOMPUTE, &
+ &OSAVE_MICRO, OELEC, &
&PEXN, PRHODREF, PLVFACT, PLSFACT, K1, K2, &
&PPRES, PCF, PSIGMA_RC, &
&PCIT, &
&PT, PVART, &
+ &PLATHAM_IAGGS, &
&PBU_INST, &
&PRS_TEND, PRG_TEND, PRH_TEND, PSSI, &
&PA, PB, &
@@ -32,6 +34,7 @@ SUBROUTINE ICE4_TENDENCIES(CST, PARAMI, ICEP, ICED, BUCONF, KPROMA, KSIZE, &
!!
! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
!! R. El Khatib 24-Aug-2021 Optimizations
+!! C. Barthe 06/2023: Add retroaction of electric field on IAGGS
!
!
!* 0. DECLARATIONS
@@ -70,6 +73,8 @@ INTEGER, INTENT(IN) :: KPROMA, KSIZE
INTEGER, INTENT(IN) :: KRR
LOGICAL, INTENT(IN) :: ODSOFT
LOGICAL, DIMENSION(KPROMA), INTENT(IN) :: LDCOMPUTE
+LOGICAL, INTENT(IN) :: OSAVE_MICRO
+LOGICAL, INTENT(IN) :: OELEC
REAL, DIMENSION(KPROMA), INTENT(IN) :: PEXN
REAL, DIMENSION(KPROMA), INTENT(IN) :: PRHODREF
REAL, DIMENSION(KPROMA), INTENT(IN) :: PLVFACT
@@ -82,6 +87,7 @@ REAL, DIMENSION(KPROMA), INTENT(IN) :: PSIGMA_RC
REAL, DIMENSION(KPROMA), INTENT(INOUT) :: PCIT
REAL, DIMENSION(KPROMA), INTENT(IN) :: PT
REAL, DIMENSION(KPROMA,0:KRR), INTENT(IN) :: PVART
+REAL, DIMENSION(MERGE(KPROMA,0,OELEC)), INTENT(IN) :: PLATHAM_IAGGS
REAL, DIMENSION(KPROMA, IBUNUM),INTENT(INOUT):: PBU_INST
REAL, DIMENSION(KPROMA, 8), INTENT(INOUT) :: PRS_TEND
REAL, DIMENSION(KPROMA, 8), INTENT(INOUT) :: PRG_TEND
@@ -320,11 +326,12 @@ DO JL=1, KSIZE
ENDDO
!
!
-CALL ICE4_SLOW(CST, ICEP, ICED, KPROMA, KSIZE, ODSOFT, LDCOMPUTE, PRHODREF, ZT, &
+CALL ICE4_SLOW(CST, ICEP, ICED, KPROMA, KSIZE, ODSOFT, OELEC, LDCOMPUTE, PRHODREF, ZT, &
&PSSI, PLVFACT, PLSFACT, &
&ZVART(:,IRV), ZVART(:,IRC), ZVART(:,IRI), ZVART(:,IRS), ZVART(:,IRG), &
&ZLBDAS, ZLBDAG, &
&ZAI, ZCJ, PHLI_HCF, PHLI_HRI, &
+ &PLATHAM_IAGGS, &
&PBU_INST(:, IRCHONI), PBU_INST(:, IRVDEPS), PBU_INST(:, IRIAGGS), PBU_INST(:, IRIAUTS), PBU_INST(:, IRVDEPG))
!
!-------------------------------------------------------------------------------
@@ -407,7 +414,7 @@ IF (KRR==7) THEN
&PBU_INST(:, IRCDRYH), PBU_INST(:, IRIDRYH), PBU_INST(:, IRSDRYH), PBU_INST(:, IRRDRYH), &
&PBU_INST(:, IRGDRYH), PBU_INST(:, IRDRYHG), PBU_INST(:, IRHMLTR), &
&PRH_TEND)
-ELSEIF (BUCONF%LBU_ENABLE) THEN
+ELSEIF (BUCONF%LBU_ENABLE .OR. OSAVE_MICRO) THEN
PBU_INST(:, IRCWETH)=0.
PBU_INST(:, IRIWETH)=0.
PBU_INST(:, IRSWETH)=0.
diff --git a/src/common/micro/mode_ini_lima_cold_mixed.F90 b/src/common/micro/mode_ini_lima_cold_mixed.F90
index e8774847097e970a599f89335616b835b54b3c94..0f6c055af6426f00ebb763dc1a7bd4675aec260b 100644
--- a/src/common/micro/mode_ini_lima_cold_mixed.F90
+++ b/src/common/micro/mode_ini_lima_cold_mixed.F90
@@ -130,6 +130,8 @@ REAL :: ZBOUND_RDSF_RMIN ! XDCRLIM*Lbda_r : lower bound used in the tabulated
REAL :: ZRATE_R ! Geometrical growth of Lbda_r in the tabulated function
REAL :: ZKHI_LWM ! Coefficient of Lawson et al. (2015)
!
+REAL :: ZRHOIW ! ice density
+!
!-------------------------------------------------------------------------------
!
!
@@ -151,19 +153,73 @@ SELECT CASE (CPRISTINE_ICE_LIMA)
XBI = 2.5 ! Plates
XC_I = 747. ! Plates
XDI = 1.0 ! Plates
+ XGAMMAI = 0.096
+ XDELTAI = 1.83
XC1I = 1./XPI ! Plates
CASE('COLU')
XAI = 2.14E-3 ! Columns
XBI = 1.7 ! Columns
XC_I = 1.96E5 ! Columns
XDI = 1.585 ! Columns
+ XGAMMAI = 0.659
+ XDELTAI = 2.0
XC1I = 0.8 ! Columns
CASE('BURO')
XAI = 44.0 ! Bullet rosettes
XBI = 3.0 ! Bullet rosettes
XC_I = 4.E5 ! Bullet rosettes
XDI = 1.663 ! Bullet rosettes
+ XGAMMAI = 0.062
+ XDELTAI = 1.81
XC1I = 0.5 ! Bullet rosettes
+ CASE('YPLA')
+ XAI = 0.745 ! Plates_from Yang et al (2013)
+ XBI = 2.47 ! Plates_from Yang et al (2013)
+ XC_I = 63. ! Plates_from Yang et al (2013)
+ XDI = 0.68 ! Plates_from Yang et al (2013)
+ XGAMMAI = 0.096
+ XDELTAI = 1.83
+ XC1I = 1./XPI ! Plates_from Yang et al (2013)
+ CASE('YCOL')
+ XAI = 261.102 ! Columns_from Yang et al (2013)
+ XBI = 2.99 ! Columns_from Yang et al (2013)
+ XC_I = 671 ! Columns_from Yang et al (2013)
+ XDI = 0.62 ! Columns_from Yang et al (2013)
+ XGAMMAI = 0.659
+ XDELTAI = 2.0
+ XC1I = 0.8 ! Columns_from Yang et al (2013)
+ CASE('YBUR')
+ XAI = 1.268 ! Bullet rosettes_from Yang et al (2013)
+ XBI = 2.59 ! Bullet rosettes_from Yang et al (2013)
+ XC_I = 128 ! Bullet rosettes_from Yang et al (2013)
+ XDI = 0.72 ! Bullet rosettes_from Yang et al (2013)
+ XGAMMAI = 0.062
+ XDELTAI = 1.81
+ XC1I = 0.5 ! Bullet rosettes_from Yang et al (2013)
+ CASE('YDRO')
+ XAI = 1.268 ! Droxtals_from Yang et al (2013)
+ XBI = 2.59 ! Droxtals_from Yang et al (2013)
+ XC_I = 128 ! Droxtals_from Yang et al (2013)
+ XDI = 0.72 ! Droxtals_from Yang et al (2013)
+ XGAMMAI = 0.673
+ XDELTAI = 2.0
+ XC1I = 0.5 ! Droxtals_from Yang et al (2013)
+ CASE('YHCO')
+ XAI = 217.586 ! Hollow_Columns_from Yang et al (2013)
+ XBI = 2.99 ! Hollow_Columns_from Yang et al (2013)
+ XC_I = 641 ! Hollow_Columns_from Yang et al (2013)
+ XDI = 0.63 ! Hollow_Columns_from Yang et al (2013)
+ XGAMMAI = 0.659
+ XDELTAI = 2.0
+ XC1I = 0.8 ! Hollow_Columns_from Yang et al (2013)
+ CASE('YHBU')
+ XAI = 1.258 ! Hollow_Bullet rosettes_from Yang et al (2013)
+ XBI = 2.61 ! Hollow_Bullet rosettes_from Yang et al (2013)
+ XC_I = 147 ! Hollow_Bullet rosettes_from Yang et al (2013)
+ XDI = 0.73 ! Hollow_Bullet rosettes_from Yang et al (2013)
+ XGAMMAI = 0.061
+ XDELTAI = 1.81
+ XC1I = 0.5 ! Hollow_Bullet rosettes_from Yang et al (2013)
END SELECT
!
! Note that XCCI=N_i (a locally predicted value) and XCXI=0.0, implicitly
@@ -337,6 +393,10 @@ ZCONC_MAX = 1.E6 ! Maximal concentration for falling particules set to 1 per cc
!XLBDAG_MAX = ( ZCONC_MAX/XCCG )**(1./XCXG)
!XLBDAH_MAX = ( ZCONC_MAX/XCCH )**(1./XCXH)
!
+! constante for ecRad effective radius
+ZRHOIW = 0.917
+XREFFI = (3*XAI/(2*ZRHOIW*10**3*XGAMMAI)*MOMG(XALPHAI,XNUI,XBI)/MOMG(XALPHAI,XNUI,XDELTAI))*1E6
+!
!-------------------------------------------------------------------------------
!
!
diff --git a/src/common/micro/mode_lima_ccn_activation.F90 b/src/common/micro/mode_lima_ccn_activation.F90
index 38732eee869583c4958e6624ee743a1e322a847f..b7886c3bb8d572d3a1ce708194ae1fe719926b4f 100644
--- a/src/common/micro/mode_lima_ccn_activation.F90
+++ b/src/common/micro/mode_lima_ccn_activation.F90
@@ -10,7 +10,7 @@ CONTAINS
SUBROUTINE LIMA_CCN_ACTIVATION (CST, &
PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT, &
- PCLDFR )
+ PCLDFR, PTOT_RV_HENU )
! ##############################################################################
!
!!
@@ -59,6 +59,7 @@ CONTAINS
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! C. Barthe 06/2022: save mixing ratio change for cloud electrification
!
!-------------------------------------------------------------------------------
!
@@ -107,6 +108,8 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN C. activated at t
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Precipitation fraction
!
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PTOT_RV_HENU ! Mixing ratio change due to HENU
+!
!* 0.1 Declarations of local variables :
!
! Packing variables
@@ -421,8 +424,10 @@ IF( INUCT >= 1 ) THEN
ZZW1(:) = MIN(XCSTDCRIT*ZZW6(:)/(((ZZT(:)*ZSMAX(:))**3)*ZRHODREF(:)),1.E-5)
END WHERE
!
+ PTOT_RV_HENU(:,:,:) = 0.
IF (.NOT.LSUBG_COND) THEN
ZW(:,:,:) = MIN( UNPACK( ZZW1(:),MASK=GNUCT(:,:,:),FIELD=0.0 ),PRVT(:,:,:) )
+ PTOT_RV_HENU(:,:,:) = ZW(:,:,:)
PTHT(:,:,:) = PTHT(:,:,:) + ZW(:,:,:) * (CST%XLVTT+(CST%XCPV-CST%XCL)*(PT(:,:,:)-CST%XTT))/ &
(PEXNREF(:,:,:)*(CST%XCPD+CST%XCPV*PRVT(:,:,:)+CST%XCL*(PRCT(:,:,:)+PRRT(:,:,:))))
PRVT(:,:,:) = PRVT(:,:,:) - ZW(:,:,:)
@@ -433,6 +438,8 @@ IF( INUCT >= 1 ) THEN
PCCT(:,:,:) = PCCT(:,:,:) + ZCLDFR(:,:,:) * UNPACK( ZZW6(:),MASK=GNUCT(:,:,:),FIELD=0. )
END IF
!
+!++cb-- A quoi servent ces 2 dernieres lignes ? variables locales, non sauvees, et ne servent pas
+! a calculer quoi que ce soit (fin de la routine)
ZW(:,:,:) = UNPACK( 100.0*ZSMAX(:),MASK=GNUCT(:,:,:),FIELD=0.0 )
ZW2(:,:,:) = ZCLDFR(:,:,:) * UNPACK( ZZW6(:),MASK=GNUCT(:,:,:),FIELD=0.0 )
!
diff --git a/src/common/micro/mode_lima_ccn_hom_freezing.F90 b/src/common/micro/mode_lima_ccn_hom_freezing.F90
index 38f760fc59473f3cad1d4d5ef76083cf52a7bd16..f3b9dc125e3d7a7282392b769be65ea4950f0c7d 100644
--- a/src/common/micro/mode_lima_ccn_hom_freezing.F90
+++ b/src/common/micro/mode_lima_ccn_hom_freezing.F90
@@ -10,7 +10,7 @@ CONTAINS
SUBROUTINE LIMA_CCN_HOM_FREEZING (CST, PRHODREF, PEXNREF, PPABST, PW_NU, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PCCT, PCRT, PCIT, PNFT, PNHT , &
- PICEFR )
+ PICEFR, PTOT_RV_HONH )
! ##########################################################################
!
!! PURPOSE
@@ -29,6 +29,7 @@ CONTAINS
!! -------------
!! Original 15/03/2018
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! C. Barthe 07/06/2022: save mixing ratio change for cloud electrification
!
!-------------------------------------------------------------------------------
!
@@ -74,6 +75,8 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHT ! haze homogeneous freezing
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Ice fraction
!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTOT_RV_HONH ! Mixing ratio change due to HONH
+!
!* 0.2 Declarations of local variables :
!
REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
@@ -299,6 +302,8 @@ IF (INEGT.GT.0) THEN
END WHERE
PNFT(:,:,:,JMOD_CCN) = PNFT(:,:,:,JMOD_CCN) - UNPACK( ZCCNFROZEN(:), MASK=GNEGT(:,:,:),FIELD=0.)
END DO
+!
+ PTOT_RV_HONH(:,:,:) = UNPACK( ZZW(:), MASK=GNEGT(:,:,:),FIELD=0.)
!
PTHT(:,:,:) = PTHT(:,:,:) + UNPACK( ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)), MASK=GNEGT(:,:,:),FIELD=0.)
PRVT(:,:,:) = PRVT(:,:,:) - UNPACK( ZZW(:), MASK=GNEGT(:,:,:),FIELD=0.)
diff --git a/src/common/micro/mode_lima_droplets_riming_snow.F90 b/src/common/micro/mode_lima_droplets_riming_snow.F90
index 9974166a1111a0ed9f0815781a6333b6eac5661e..56b57d5d8c7ecdecdbdd168e9da5ad189697de28 100644
--- a/src/common/micro/mode_lima_droplets_riming_snow.F90
+++ b/src/common/micro/mode_lima_droplets_riming_snow.F90
@@ -6,13 +6,16 @@
MODULE MODE_LIMA_DROPLETS_RIMING_SNOW
IMPLICIT NONE
CONTAINS
-! #########################################################################################
- SUBROUTINE LIMA_DROPLETS_RIMING_SNOW (PTSTEP, LDCOMPUTE, &
- PRHODREF, PT, &
- PRCT, PCCT, PRST, PCST, PLBDC, PLBDS, PLVFACT, PLSFACT, &
- P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_CS_RIM, P_RG_RIM, &
- P_RI_HMS, P_CI_HMS, P_RS_HMS )
-! #########################################################################################
+! ###########################################################################################
+ SUBROUTINE LIMA_DROPLETS_RIMING_SNOW (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PT, &
+ PRCT, PCCT, PRST, PCST, PLBDC, PLBDS, PLVFACT, PLSFACT, &
+!++cb++
+! P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_CS_RIM, P_RG_RIM, &
+ P_TH_RIM, P_CC_RIM, P_CS_RIM, &
+ P_RC_RIMSS, P_RC_RIMSG, P_RS_RIMCG, &
+ P_RI_HMS, P_CI_HMS, P_RS_HMS )
+! ###########################################################################################
!
!! PURPOSE
!! -------
@@ -31,6 +34,8 @@ CONTAINS
!! Original 15/03/2018
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! J. Wurtz 03/2022: new snow characteristics
+! C. Barthe 06/2022: modify the microphysics terms to save to simplify the merging with the electrification scheme
+! (same terms as in ICE3)
!
!-------------------------------------------------------------------------------
!
@@ -63,11 +68,16 @@ REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
!
-REAL, DIMENSION(:), INTENT(OUT) :: P_RC_RIM
+!++cb++
+!REAL, DIMENSION(:), INTENT(OUT) :: P_RC_RIM
REAL, DIMENSION(:), INTENT(OUT) :: P_CC_RIM
-REAL, DIMENSION(:), INTENT(OUT) :: P_RS_RIM
+!REAL, DIMENSION(:), INTENT(OUT) :: P_RS_RIM
REAL, DIMENSION(:), INTENT(OUT) :: P_CS_RIM
-REAL, DIMENSION(:), INTENT(OUT) :: P_RG_RIM
+!REAL, DIMENSION(:), INTENT(OUT) :: P_RG_RIM
+REAL, DIMENSION(:), INTENT(OUT) :: P_RC_RIMSS
+REAL, DIMENSION(:), INTENT(OUT) :: P_RC_RIMSG
+REAL, DIMENSION(:), INTENT(OUT) :: P_RS_RIMCG
+!--cb--
!
REAL, DIMENSION(:), INTENT(OUT) :: P_TH_RIM
REAL, DIMENSION(:), INTENT(OUT) :: P_RI_HMS
@@ -77,6 +87,7 @@ REAL, DIMENSION(:), INTENT(OUT) :: P_RS_HMS
!* 0.2 Declarations of local variables :
!
REAL, DIMENSION(SIZE(PRCT)) :: ZZW1, ZZW2, ZZW3, ZZW4, ZZW5
+REAL, DIMENSION(SIZE(PRCT)) :: Z_RC_RIM, Z_RS_RIM, Z_RG_RIM !++cb--
!
INTEGER, DIMENSION(SIZE(PRCT)) :: IVEC2 ! Vector of indices
REAL, DIMENSION(SIZE(PRCT)) :: ZVEC1,ZVEC2,ZVEC1W ! Work vectors
@@ -85,112 +96,127 @@ INTEGER :: JI
!-------------------------------------------------------------------------------
!
!
-!
DO JI = 1, SIZE(PRCT)
!
!* Cloud droplet riming of the aggregates
! --------------------------------------
!
- IF ( PRCT(JI)>XRTMIN(2) .AND. PRST(JI)>XRTMIN(5) .AND. PT(JI)<XTT .AND. &
- PCCT(JI)>XCTMIN(2) .AND. PCST(JI)>XCTMIN(5) .AND. LDCOMPUTE(JI) ) THEN
+ IF ( PRCT(JI)>XRTMIN(2) .AND. PRST(JI)>XRTMIN(5) .AND. PT(JI)<XTT .AND. &
+ PCCT(JI)>XCTMIN(2) .AND. PCST(JI)>XCTMIN(5) .AND. LDCOMPUTE(JI) ) THEN
!
- ZVEC1(JI) = PLBDS(JI)
- ZVEC1W(JI)= ( XFVELOS**XALPHAS + PLBDS(JI)**XALPHAS ) ** (1./XALPHAS) ! modified equivalent lambda
+ ZVEC1(JI) = PLBDS(JI)
+ ZVEC1W(JI)= ( XFVELOS**XALPHAS + PLBDS(JI)**XALPHAS ) ** (1./XALPHAS) ! modified equivalent lambda
!
! 2. perform the linear interpolation of the normalized
! "2+XDS"-moment of the incomplete gamma function using the modified equivalent lambda
!
- ZVEC2(JI) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, &
- XRIMINTP1 * LOG( ZVEC1W(JI) ) + XRIMINTP2 ) )
- IVEC2(JI) = INT( ZVEC2(JI) )
- ZVEC2(JI) = ZVEC2(JI) - REAL( IVEC2(JI) )
+ ZVEC2(JI) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, &
+ XRIMINTP1 * LOG( ZVEC1W(JI) ) + XRIMINTP2 ) )
+ IVEC2(JI) = INT( ZVEC2(JI) )
+ ZVEC2(JI) = ZVEC2(JI) - REAL( IVEC2(JI) )
!
- ZZW1(JI) = XGAMINC_RIM1( IVEC2(JI)+1 )* ZVEC2(JI) &
- - XGAMINC_RIM1( IVEC2(JI) )*(ZVEC2(JI) - 1.0)
+ ZZW1(JI) = XGAMINC_RIM1( IVEC2(JI)+1 )* ZVEC2(JI) &
+ - XGAMINC_RIM1( IVEC2(JI) )*(ZVEC2(JI) - 1.0)
!
! 3. perform the linear interpolation of the normalized
! "XBS"-moment of the incomplete gamma function
!
- ZVEC2(JI) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, &
- XRIMINTP1 * LOG( ZVEC1(JI) ) + XRIMINTP2 ) )
- IVEC2(JI) = INT( ZVEC2(JI) )
- ZVEC2(JI) = ZVEC2(JI) - REAL( IVEC2(JI) )
+ ZVEC2(JI) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, &
+ XRIMINTP1 * LOG( ZVEC1(JI) ) + XRIMINTP2 ) )
+ IVEC2(JI) = INT( ZVEC2(JI) )
+ ZVEC2(JI) = ZVEC2(JI) - REAL( IVEC2(JI) )
!
- ZZW2(JI) = XGAMINC_RIM2( IVEC2(JI)+1 )* ZVEC2(JI) &
- - XGAMINC_RIM2( IVEC2(JI) )*(ZVEC2(JI) - 1.0)
+ ZZW2(JI) = XGAMINC_RIM2( IVEC2(JI)+1 )* ZVEC2(JI) &
+ - XGAMINC_RIM2( IVEC2(JI) )*(ZVEC2(JI) - 1.0)
!
! 4. riming
!
+!++cb++
! Cloud droplets collected
- P_RC_RIM(JI) = - XCRIMSS * PRCT(JI) * PCST(JI)*(1+(XFVELOS/PLBDS(JI))**XALPHAS)**(-XNUS+XEXCRIMSS/XALPHAS) &
+! P_RC_RIM(JI) = - XCRIMSS * PRCT(JI) * PCST(JI)*(1+(XFVELOS/PLBDS(JI))**XALPHAS)**(-XNUS+XEXCRIMSS/XALPHAS) &
+! * PRHODREF(JI)**(-XCEXVT+1) * PLBDS(JI)**XEXCRIMSS
+! P_CC_RIM(JI) = P_RC_RIM(JI) * PCCT(JI)/PRCT(JI) ! Lambda_c**3
+! total mass loss of cloud droplets, < 0
+ Z_RC_RIM(JI) = - XCRIMSS * PRCT(JI) * PCST(JI)*(1+(XFVELOS/PLBDS(JI))**XALPHAS)**(-XNUS+XEXCRIMSS/XALPHAS) &
* PRHODREF(JI)**(-XCEXVT+1) * PLBDS(JI)**XEXCRIMSS
- P_CC_RIM(JI) = P_RC_RIM(JI) * PCCT(JI)/PRCT(JI) ! Lambda_c**3
- !
- ! Cloud droplets collected on small aggregates add to snow
- P_RS_RIM(JI) = - P_RC_RIM(JI) * ZZW1(JI)
- !
- ! Cloud droplets collected on large aggregates add to graupel
- P_RG_RIM(JI) = - P_RC_RIM(JI) - P_RS_RIM(JI)
- !
- IF (LMURAKAMI) THEN
- ! Graupel formation based on Murakami
- ZVEC1(JI) = XGAMINC_RIM4( IVEC2(JI)+1 )* ZVEC2(JI) &
- - XGAMINC_RIM4( IVEC2(JI) )*(ZVEC2(JI) - 1.0)
- ZZW5(JI) = ZVEC1(JI)
- ZZW3(JI) = XSRIMCG * PRHODREF(JI) * PCST(JI) * PLBDS(JI)**XEXSRIMCG * (1.0 - ZZW2(JI))!/(PTSTEP*PRHODREF(JI))
- ZZW3(JI) = P_RG_RIM(JI)*ZZW3(JI)/ &
- MAX(1.E-10, & !-20
- XSRIMCG3*XSRIMCG2*PCST(JI)*PRHODREF(JI)*PLBDS(JI)**(XEXSRIMCG2)*(1.-ZZW5(JI))- &
- XSRIMCG3*ZZW3(JI))
- ELSE
- ! Large aggregates collecting droplets add to graupel (instant process ???)
- ZZW3(JI) = PRST(JI)*(1.0 - ZZW2(JI))/PTSTEP
- END IF
- P_RS_RIM(JI) = P_RS_RIM(JI) - ZZW3(JI)
- P_CS_RIM(JI) = -ZZW3(JI) * PCST(JI)/PRST(JI)
- P_RG_RIM(JI) = P_RG_RIM(JI) + ZZW3(JI)
- !
- P_TH_RIM(JI) = - P_RC_RIM(JI)*(PLSFACT(JI)-PLVFACT(JI))
- ELSE
- P_TH_RIM(JI) = 0.
- P_RC_RIM(JI) = 0.
- P_CC_RIM(JI) = 0.
- P_RS_RIM(JI) = 0.
- P_CS_RIM(JI) = 0.
- P_RG_RIM(JI) = 0.
- END IF
+ P_CC_RIM(JI) = Z_RC_RIM(JI) * (PCCT(JI) / PRCT(JI)) ! Lambda_c**3
+ !
+ ! Cloud droplets collected on small aggregates add to snow
+! P_RS_RIM(JI) = - P_RC_RIM(JI) * ZZW1(JI)
+ Z_RS_RIM(JI) = -Z_RC_RIM(JI) * ZZW1(JI)
+ P_RC_RIMSS(JI) = Z_RC_RIM(JI) * ZZW1(JI) ! < 0, loss of mass for rc
+ !
+ ! Cloud droplets collected on large aggregates add to graupel
+! P_RG_RIM(JI) = - P_RC_RIM(JI) - P_RS_RIM(JI)
+ Z_RG_RIM(JI) = -Z_RC_RIM(JI) - Z_RS_RIM(JI)
+ P_RC_RIMSG(JI) = Z_RC_RIM(JI) - P_RC_RIMSS(JI) ! < 0, loss of mass for rc
+ !
+ IF (LMURAKAMI) THEN
+ ! Graupel formation based on Murakami
+ ZVEC1(JI) = XGAMINC_RIM4( IVEC2(JI)+1 )* ZVEC2(JI) &
+ - XGAMINC_RIM4( IVEC2(JI) )*(ZVEC2(JI) - 1.0)
+ ZZW5(JI) = ZVEC1(JI)
+ ZZW3(JI) = XSRIMCG * PRHODREF(JI) * PCST(JI) * PLBDS(JI)**XEXSRIMCG * (1.0 - ZZW2(JI))!/(PTSTEP*PRHODREF(JI))
+ ZZW3(JI) = Z_RG_RIM(JI)*ZZW3(JI)/ &
+ MAX(1.E-10, & !-20
+ XSRIMCG3*XSRIMCG2*PCST(JI)*PRHODREF(JI)*PLBDS(JI)**(XEXSRIMCG2)*(1.-ZZW5(JI))- &
+ XSRIMCG3*ZZW3(JI))
+ ELSE
+ ! Large aggregates collecting droplets add to graupel (instant process ???)
+ ZZW3(JI) = PRST(JI)*(1.0 - ZZW2(JI))/PTSTEP
+ END IF
+ !
+ P_RS_RIMCG(JI) = ZZW3(JI)
+ P_CS_RIM(JI) = -ZZW3(JI) * PCST(JI)/PRST(JI)
+! P_RS_RIM(JI) = P_RS_RIM(JI) - ZZW3(JI)
+! P_RG_RIM(JI) = P_RG_RIM(JI) + ZZW3(JI)
+ !
+! P_TH_RIM(JI) = - P_RC_RIM(JI)*(PLSFACT(JI)-PLVFACT(JI))
+ P_TH_RIM(JI) = - Z_RC_RIM(JI)*(PLSFACT(JI)-PLVFACT(JI))
+!--cb--
+ ELSE
+ P_TH_RIM(JI) = 0.
+ P_RC_RIMSS(JI) = 0.
+ P_RC_RIMSG(JI) = 0.
+ P_RS_RIMCG(JI) = 0.
+ Z_RC_RIM(JI) = 0.
+ P_CC_RIM(JI) = 0.
+ Z_RS_RIM(JI) = 0.
+ P_CS_RIM(JI) = 0.
+ Z_RG_RIM(JI) = 0.
+ END IF
!
!* Hallett-Mossop ice production (HMS)
! -----------------------------------
!
- IF ( PRST(JI)>XRTMIN(5) .AND. PRCT(JI)>XRTMIN(2) .AND. PT(JI)<XHMTMAX .AND. PT(JI)>XHMTMIN .AND. &
- PCST(JI)>XCTMIN(5) .AND. PCCT(JI)>XCTMIN(2) .AND. LDCOMPUTE(JI) ) THEN
-!
- ZVEC1(JI) = PLBDC(JI)
- ZVEC2(JI) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, &
- XHMLINTP1 * LOG( ZVEC1(JI) ) + XHMLINTP2 ) )
- IVEC2(JI) = INT( ZVEC2(JI) )
- ZVEC2(JI) = ZVEC2(JI) - REAL( IVEC2(JI) )
- ZVEC1(JI) = XGAMINC_HMC( IVEC2(JI)+1 )* ZVEC2(JI) &
- - XGAMINC_HMC( IVEC2(JI) )*(ZVEC2(JI) - 1.0)
- ZZW4(JI) = ZVEC1(JI) ! Large droplets
-!
- IF ( ZZW4(JI)<0.99 ) THEN
- P_CI_HMS(JI) = - P_RC_RIM(JI) * (PCCT(JI)/PRCT(JI)) * (1.0-ZZW4(JI)) * XHM_FACTS * &
- MAX( 0.0, MIN( (PT(JI)-XHMTMIN)/3.0,(XHMTMAX-PT(JI))/2.0 ) ) ! CCHMSI
-!
- P_RI_HMS(JI) = P_CI_HMS(JI) * XMNU0 ! RCHMSI
- P_RS_HMS(JI) = - P_RI_HMS(JI)
- ELSE
- P_RI_HMS(JI) = 0.
- P_CI_HMS(JI) = 0.
- P_RS_HMS(JI) = 0.
- END IF
- ELSE
+ IF ( PRST(JI)>XRTMIN(5) .AND. PRCT(JI)>XRTMIN(2) .AND. PT(JI)<XHMTMAX .AND. PT(JI)>XHMTMIN .AND. &
+ PCST(JI)>XCTMIN(5) .AND. PCCT(JI)>XCTMIN(2) .AND. LDCOMPUTE(JI) ) THEN
+!
+ ZVEC1(JI) = PLBDC(JI)
+ ZVEC2(JI) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, &
+ XHMLINTP1 * LOG( ZVEC1(JI) ) + XHMLINTP2 ) )
+ IVEC2(JI) = INT( ZVEC2(JI) )
+ ZVEC2(JI) = ZVEC2(JI) - REAL( IVEC2(JI) )
+ ZVEC1(JI) = XGAMINC_HMC( IVEC2(JI)+1 )* ZVEC2(JI) &
+ - XGAMINC_HMC( IVEC2(JI) )*(ZVEC2(JI) - 1.0)
+ ZZW4(JI) = ZVEC1(JI) ! Large droplets
+!
+ IF ( ZZW4(JI)<0.99 ) THEN
+ P_CI_HMS(JI) = - Z_RC_RIM(JI) * (PCCT(JI)/PRCT(JI)) * (1.0-ZZW4(JI)) * XHM_FACTS * &
+ MAX( 0.0, MIN( (PT(JI)-XHMTMIN)/3.0,(XHMTMAX-PT(JI))/2.0 ) ) ! CCHMSI
+!
+ P_RI_HMS(JI) = P_CI_HMS(JI) * XMNU0 ! RCHMSI
+ P_RS_HMS(JI) = - P_RI_HMS(JI)
+ ELSE
P_RI_HMS(JI) = 0.
P_CI_HMS(JI) = 0.
P_RS_HMS(JI) = 0.
- END IF
+ END IF
+ ELSE
+ P_RI_HMS(JI) = 0.
+ P_CI_HMS(JI) = 0.
+ P_RS_HMS(JI) = 0.
+ END IF
END DO
!
!-------------------------------------------------------------------------------
diff --git a/src/common/micro/mode_lima_ice_aggregation_snow.F90 b/src/common/micro/mode_lima_ice_aggregation_snow.F90
index c442ab8b02965cbbf95a0a20709632085783b02b..6097a688e663a38d0d722fd828ef85e9972a4d3f 100644
--- a/src/common/micro/mode_lima_ice_aggregation_snow.F90
+++ b/src/common/micro/mode_lima_ice_aggregation_snow.F90
@@ -10,6 +10,7 @@ CONTAINS
SUBROUTINE LIMA_ICE_AGGREGATION_SNOW (LDCOMPUTE, &
PT, PRHODREF, &
PRIT, PRST, PCIT, PCST, PLBDI, PLBDS, &
+ PLATHAM_IAGGS, &
P_RI_AGGS, P_CI_AGGS )
! #######################################################################
!
@@ -30,6 +31,7 @@ CONTAINS
! J. Wurtz 03/2022: new snow characteristics
! B. Vie 03/2022: Add option for 1-moment pristine ice
! M. Taufour 07/2022: add concentration for snow, graupel, hail
+! C. Barthe 06/2023: add Latham effect (Efield) for IAGGS
!
!-------------------------------------------------------------------------------
!
@@ -56,6 +58,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PCIT
REAL, DIMENSION(:), INTENT(IN) :: PCST
REAL, DIMENSION(:), INTENT(IN) :: PLBDI
REAL, DIMENSION(:), INTENT(IN) :: PLBDS
+REAL, DIMENSION(:), INTENT(IN) :: PLATHAM_IAGGS
!
REAL, DIMENSION(:), INTENT(OUT) :: P_RI_AGGS
REAL, DIMENSION(:), INTENT(OUT) :: P_CI_AGGS
@@ -81,6 +84,7 @@ P_CI_AGGS(:) = 0.
IF (NMOM_I.EQ.1) THEN
WHERE ( PRIT(:)>XRTMIN(4) .AND. PRST(:)>XRTMIN(5) .AND. LDCOMPUTE(:) )
ZZW1(:) = XFIAGGS * EXP( XCOLEXIS*(PT(:)-XTT) ) &
+ * PLATHAM_IAGGS(:) &
* PRIT(:) &
* PCST(:) * (1+(XFVELOS/PLBDS(:))**XALPHAS)**(-XNUS+XEXIAGGS/XALPHAS) &
* PRHODREF(:)**(-XCEXVT+1.) &
diff --git a/src/common/micro/mode_lima_nucleation_procs.F90 b/src/common/micro/mode_lima_nucleation_procs.F90
index 58f9212cc92f27eeca5fb93952f8a5e476357ba9..7a70adf55443ad065d97e46b04548f0416f840d4 100644
--- a/src/common/micro/mode_lima_nucleation_procs.F90
+++ b/src/common/micro/mode_lima_nucleation_procs.F90
@@ -6,15 +6,17 @@
MODULE MODE_LIMA_NUCLEATION_PROCS
IMPLICIT NONE
CONTAINS
-! #############################################################################
+! ###############################################################################
SUBROUTINE LIMA_NUCLEATION_PROCS (D, CST, BUCONF, TBUDGETS, KBUDGETS, &
PTSTEP, PRHODJ, &
PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
PCCT, PCRT, PCIT, &
PNFT, PNAT, PIFT, PINT, PNIT, PNHT, &
- PCLDFR, PICEFR, PPRCFR )
-! #############################################################################
+ PCLDFR, PICEFR, PPRCFR, &
+ PTOT_RV_HENU, PTOT_RC_HINC, PTOT_RI_HIND, &
+ PTOT_RV_HONH )
+! ###############################################################################
!
!! PURPOSE
!! -------
@@ -33,6 +35,7 @@ CONTAINS
! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation
! B. Vie 03/2022: Add option for 1-moment pristine ice
+! C. Barthe 06/2022: add dummy arguments (mass transfer rates) for cloud electrication
!-------------------------------------------------------------------------------
!
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
@@ -100,10 +103,16 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Ice fraction
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Precipitation fraction
!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTOT_RV_HENU ! Mixing ratio change due to HENU
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTOT_RC_HINC ! Mixing ratio change due to HINC
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTOT_RI_HIND ! Mixing ratio change due to HIND
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTOT_RV_HONH ! Mixing ratio change due to HONH
+!
!-------------------------------------------------------------------------------
!
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, Z_TH_HINC, Z_RC_HINC, Z_CC_HINC
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZLSFACT, ZRVHENIMR
+!REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, Z_TH_HINC, Z_RC_HINC, Z_CC_HINC
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: Z_TH_HIND, Z_CI_HIND, Z_TH_HINC, Z_CC_HINC
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZLSFACT, ZRVHENIMR
!
integer :: idx, jl
INTEGER :: JI,JJ
@@ -132,9 +141,11 @@ IF ( LACTI .AND. NMOD_CCN >=1 .AND. NMOM_C.GE.2) THEN
end if
end if
- CALL LIMA_CCN_ACTIVATION( CST, &
+ CALL LIMA_CCN_ACTIVATION( CST, &
PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
- PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT, PCLDFR )
+ PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT, PCLDFR, &
+ PTOT_RV_HENU )
+
if ( BUCONF%lbu_enable ) then
if ( BUCONF%lbudget_th ) &
call BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TH), 'HENU', ptht(:, :, :) * prhodj(:, :, :) / ptstep )
@@ -186,18 +197,18 @@ IF ( LNUCL .AND. NMOM_I>=2 .AND. .NOT.LMEYERS .AND. NMOD_IFN >= 1 ) THEN
PRHODREF, PEXNREF, PPABST, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PCCT, PCIT, PNAT, PIFT, PINT, PNIT, &
- Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, &
- Z_TH_HINC, Z_RC_HINC, Z_CC_HINC, &
+ Z_TH_HIND, PTOT_RI_HIND, Z_CI_HIND, &
+ Z_TH_HINC, PTOT_RC_HINC, Z_CC_HINC, &
PICEFR )
WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
!
if ( BUCONF%lbu_enable ) then
if ( BUCONF%lbudget_th ) &
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
if ( BUCONF%lbudget_rv ) &
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'HIND', -z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'HIND', -ptot_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
if ( BUCONF%lbudget_ri ) &
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HIND', z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HIND', ptot_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
if ( BUCONF%lbudget_sv ) then
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1-1+nsv_lima_ni), 'HIND', z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
do jl = 1, nmod_ifn
@@ -209,11 +220,11 @@ IF ( LNUCL .AND. NMOM_I>=2 .AND. .NOT.LMEYERS .AND. NMOD_IFN >= 1 ) THEN
end if
if ( BUCONF%lbudget_th ) &
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
if ( BUCONF%lbudget_rc ) &
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'HINC', z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'HINC', ptot_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
if ( BUCONF%lbudget_ri ) &
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HINC', -ptot_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
if ( BUCONF%lbudget_sv ) then
if (nmom_c.ge.2) then
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1-1+nsv_lima_nc), 'HINC', z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
@@ -238,18 +249,18 @@ IF (LNUCL .AND. NMOM_I>=2 .AND. LMEYERS) THEN
PRHODREF, PEXNREF, PPABST, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PCCT, PCIT, PINT, &
- Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, &
- Z_TH_HINC, Z_RC_HINC, Z_CC_HINC, &
+ Z_TH_HIND, PTOT_RI_HIND, Z_CI_HIND, &
+ Z_TH_HINC, PTOT_RC_HINC, Z_CC_HINC, &
PICEFR )
WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
!
if ( BUCONF%lbu_enable ) then
if ( BUCONF%lbudget_th ) &
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
if ( BUCONF%lbudget_rv ) &
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'HIND', -z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RV), 'HIND', -ptot_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
if ( BUCONF%lbudget_ri ) &
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HIND', z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HIND', ptot_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
if ( BUCONF%lbudget_sv ) then
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1-1+nsv_lima_ni), 'HIND', z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
if (nmod_ifn > 0 ) &
@@ -258,11 +269,11 @@ IF (LNUCL .AND. NMOM_I>=2 .AND. LMEYERS) THEN
end if
if ( BUCONF%lbudget_th ) &
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
if ( BUCONF%lbudget_rc ) &
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'HINC', z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RC), 'HINC', ptot_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
if ( BUCONF%lbudget_ri ) &
- call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_RI), 'HINC', -ptot_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
if ( BUCONF%lbudget_sv ) then
if (nmom_c.ge.2) then
call BUDGET_STORE_ADD_PHY(D, TBUDGETS(NBUDGET_SV1-1+nsv_lima_nc), 'HINC', z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
@@ -277,6 +288,8 @@ END IF
!
!-------------------------------------------------------------------------------
!
+!++cb-- pour l'instant, on ne recupere pas cette tendance
+! actuellement, les echanges vapeur-->glace/eau lies a la nucleation ne sont pas traites dans l'electrisation
IF (LNUCL .AND. NMOM_I.EQ.1) THEN
WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
!
@@ -357,7 +370,7 @@ IF ( LNUCL .AND. LHHONI .AND. NMOD_CCN >= 1 .AND. NMOM_I.GE.2) THEN
CALL LIMA_CCN_HOM_FREEZING (CST, PRHODREF, PEXNREF, PPABST, PW_NU, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PCCT, PCRT, PCIT, PNFT, PNHT, &
- PICEFR )
+ PICEFR, PTOT_RV_HONH )
WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
!
if ( BUCONF%lbu_enable ) then
diff --git a/src/common/micro/mode_lima_rain_accr_snow.F90 b/src/common/micro/mode_lima_rain_accr_snow.F90
index 6c83bf6cd49554c08f21caed8d9d6258be9d5fd5..e7ee26f7e5bccf8d571eae3b7639011b2fe16042 100644
--- a/src/common/micro/mode_lima_rain_accr_snow.F90
+++ b/src/common/micro/mode_lima_rain_accr_snow.F90
@@ -6,12 +6,16 @@
MODULE MODE_LIMA_RAIN_ACCR_SNOW
IMPLICIT NONE
CONTAINS
-! ###################################################################################
- SUBROUTINE LIMA_RAIN_ACCR_SNOW (PTSTEP, LDCOMPUTE, &
- PRHODREF, PT, &
- PRRT, PCRT, PRST, PCST, PLBDR, PLBDS, PLVFACT, PLSFACT, &
- P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_CS_ACC, P_RG_ACC )
-! ###################################################################################
+! ######################################################################################
+ SUBROUTINE LIMA_RAIN_ACCR_SNOW (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PT, &
+ PRRT, PCRT, PRST, PCST, PLBDR, PLBDS, PLVFACT, PLSFACT, &
+!++cb++
+! P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_CS_ACC, P_RG_ACC )
+ P_TH_ACC, P_CR_ACC, P_CS_ACC, &
+ P_RR_ACCSS, P_RR_ACCSG, P_RS_ACCRG )
+!--cb--
+! ######################################################################################
!
!! PURPOSE
!! -------
@@ -30,6 +34,9 @@ CONTAINS
!! Original 15/03/2018
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! J. Wurtz 03/2022: new snow characteristics
+! C. Barthe 04/07/2022: modify the microphysics terms to save to simplify the merging
+! with the electrification scheme
+! QUESTION : ne fonctionne pas si NMOM_R=1 ???
!
!-------------------------------------------------------------------------------
!
@@ -68,12 +75,17 @@ REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
!
+!++cb++
REAL, DIMENSION(:), INTENT(OUT) :: P_TH_ACC
-REAL, DIMENSION(:), INTENT(OUT) :: P_RR_ACC
+!REAL, DIMENSION(:), INTENT(OUT) :: P_RR_ACC
REAL, DIMENSION(:), INTENT(OUT) :: P_CR_ACC
-REAL, DIMENSION(:), INTENT(OUT) :: P_RS_ACC
+!REAL, DIMENSION(:), INTENT(OUT) :: P_RS_ACC
REAL, DIMENSION(:), INTENT(OUT) :: P_CS_ACC
-REAL, DIMENSION(:), INTENT(OUT) :: P_RG_ACC
+!REAL, DIMENSION(:), INTENT(OUT) :: P_RG_ACC
+REAL, DIMENSION(:), INTENT(OUT) :: P_RR_ACCSS
+REAL, DIMENSION(:), INTENT(OUT) :: P_RR_ACCSG
+REAL, DIMENSION(:), INTENT(OUT) :: P_RS_ACCRG
+!--cb--
!
!* 0.2 Declarations of local variables :
!
@@ -85,15 +97,22 @@ REAL, DIMENSION(SIZE(PRRT)) :: ZZWC1, ZZWC2, ZZWC3, ZZWC4, ZZWC5
!
INTEGER, DIMENSION(SIZE(PRRT)) :: IVEC1,IVEC2 ! Vectors of indices
REAL, DIMENSION(SIZE(PRRT)) :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors
+REAL, DIMENSION(SIZE(PRRT)) :: Z_RR_ACC ! ++cb-- for elec
!
!-------------------------------------------------------------------------------
!
-!
+!++cb++
P_TH_ACC(:) = 0.
-P_RR_ACC(:) = 0.
+!P_RR_ACC(:) = 0.
P_CR_ACC(:) = 0.
-P_RS_ACC(:) = 0.
-P_RG_ACC(:) = 0.
+P_CS_ACC(:) = 0.
+!P_RS_ACC(:) = 0.
+!P_RG_ACC(:) = 0.
+P_RR_ACCSS(:) = 0.
+P_RR_ACCSG(:) = 0.
+P_RS_ACCRG(:) = 0.
+Z_RR_ACC(:) = 0.
+!--cb--
!
ZZW1(:) = 0.
ZZW2(:) = 0.
@@ -268,12 +287,19 @@ WHERE( GACC )
XLBNSACCR2/( PLBDR(:) * PLBDS(:) ) + &
XLBNSACCR3/( PLBDS(:)**2 ) )
!
- P_RR_ACC(:) = - ZZW4(:) * ZZW2(:)
+!++cb++
+ Z_RR_ACC(:) = - ZZW4(:) * ZZW2(:) ! < 0
+! P_RR_ACC(:) = - ZZW4(:) * ZZW2(:)
P_CR_ACC(:) = - ZZWC4(:) * ZZWC2(:)
- P_RS_ACC(:) = ZZW4(:) * ZZW1(:) - ZZW5(:)
+! P_RS_ACC(:) = ZZW4(:) * ZZW1(:) - ZZW5(:)
P_CS_ACC(:) = - ZZWC5(:)
- P_RG_ACC(:) = ZZW4(:) * ( ZZW2(:) - ZZW1(:) ) + ZZW5(:)
- P_TH_ACC(:) = - P_RR_ACC(:) * (PLSFACT(:)-PLVFACT(:))
+! P_RG_ACC(:) = ZZW4(:) * ( ZZW2(:) - ZZW1(:) ) + ZZW5(:)
+ P_RR_ACCSS(:) = ZZW4(:) * ZZW1(:) ! perte pour rr, > 0
+ P_RR_ACCSG(:) = ZZW4(:) * ( ZZW2(:) - ZZW1(:) ) ! rraccsg = rraccs - rraccss
+ P_RS_ACCRG(:) = ZZW5(:) ! perte pour rs, > 0
+! P_TH_ACC(:) = - P_RR_ACC(:) * (PLSFACT(:)-PLVFACT(:))
+ P_TH_ACC(:) = - Z_RR_ACC(:) * (PLSFACT(:)-PLVFACT(:))
+!--cb--
!
END WHERE
!
diff --git a/src/common/micro/mode_lima_sedimentation.F90 b/src/common/micro/mode_lima_sedimentation.F90
index 1efeb31919684052c0a3fe5ba224450e668fb0e9..d9342305c5bf0ac7ad153c2ebd43d52d4a20950f 100644
--- a/src/common/micro/mode_lima_sedimentation.F90
+++ b/src/common/micro/mode_lima_sedimentation.F90
@@ -7,9 +7,11 @@ MODULE MODE_LIMA_SEDIMENTATION
IMPLICIT NONE
CONTAINS
! ######################################################################
- SUBROUTINE LIMA_SEDIMENTATION (D, CST, &
- HPHASE, KMOMENTS, KID, KSPLITG, PTSTEP, PDZZ, PRHODREF, &
- PPABST, PT, PRT_SUM, PCPT, PRS, PCS, PINPR, PFPR )
+ SUBROUTINE LIMA_SEDIMENTATION (D, CST, ICED, HCLOUD, &
+ HPHASE, KMOMENTS, KID, KSPLITG, PTSTEP, OELEC, &
+ PDZZ, PRHODREF, PTHVREFZIKB, &
+ PPABST, PT, PRT_SUM, PCPT, PRS, PCS, PINPR, PFPR, &
+ PEFIELDW, PQS)
! ######################################################################
!
!! PURPOSE
@@ -40,6 +42,8 @@ CONTAINS
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
! B. Vie 03/2020: disable temperature change of droplets by air temperature
! J. Wurtz 03/2022: new snow characteristics
+! C. Barthe 03/06/2022: add sedimentation for electric charges
+! C. Barthe 02/06/2023: add the Beard effect (electric field)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -47,16 +51,23 @@ CONTAINS
!
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
USE MODD_CST, ONLY: CST_t
+USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
+USE MODD_ELEC_DESCR, ONLY: LSEDIM_BEARD
+USE MODD_ELEC_PARAM, ONLY: XFQSED, XDQ
USE MODD_PARAM_LIMA, ONLY: XCEXVT, XRTMIN, XCTMIN, NSPLITSED, &
XLB, XLBEX, XD, XFSEDR, XFSEDC, &
XALPHAC, XNUC, XALPHAS, XNUS, LSNOW_T, &
NMOM_S
-USE MODD_PARAM_LIMA_COLD, ONLY: XLBDAS_MAX, XBS, &
- XLBDAS_MIN, XTRANS_MP_GAMMAS, XFVELOS
+USE MODD_PARAM_LIMA_COLD, ONLY: XLBEXI, XLBI, XDI, XLBDAS_MAX, XBS, XEXSEDS, &
+ XLBDAS_MIN, XTRANS_MP_GAMMAS, XFVELOS, &
+ XCCS, XCXS
+USE MODD_PARAM_LIMA_MIXED, ONLY: XCCG, XCXG, XCCH, XCXH
use mode_tools, only: Countjv
-USE MODI_GAMMA, ONLY: GAMMA_X0D
+USE MODI_GAMMA, ONLY: GAMMA_X0D
+USE MODE_ELEC_COMPUTE_EX, ONLY: ELEC_COMPUTE_EX
+USE MODE_ELEC_BEARD_EFFECT, ONLY: ELEC_BEARD_EFFECT
!
IMPLICIT NONE
!
@@ -64,11 +75,13 @@ IMPLICIT NONE
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
CHARACTER(1), INTENT(IN) :: HPHASE ! Liquid or solid hydrometeors
INTEGER, INTENT(IN) :: KMOMENTS ! Number of moments
INTEGER, INTENT(IN) :: KID ! Hydrometeor ID
INTEGER, INTENT(IN) :: KSPLITG !
-REAL, INTENT(IN) :: PTSTEP ! Time step
+REAL, INTENT(IN) :: PTSTEP ! Time step
+LOGICAL, INTENT(IN) :: OELEC ! if true, cloud electrification is activated
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Height (z)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
@@ -79,6 +92,10 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRS ! m.r. source
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCS ! C. source
REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPR ! Instant precip rate
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFPR ! Precip. fluxes in altitude
+REAL, DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PEFIELDW ! Vertical component of the electric field
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+REAL, INTENT(IN) :: PTHVREFZIKB ! Reference thv at IKB for electricity
+REAL, DIMENSION(:,:,:), INTENT(INOUT), OPTIONAL :: PQS ! Elec. charge density source
!
!* 0.2 Declarations of local variables :
!
@@ -110,12 +127,21 @@ INTEGER , DIMENSION(SIZE(PRHODREF)) :: I1,I2,I3 ! Indexes for PACK replacement
!
REAL :: ZTSPLITG ! Small time step for rain sedimentation
REAL :: ZC ! Cpl or Cpi
-INTEGER :: ZMOMENTS
+INTEGER :: IMOMENTS
!
+! Variables for cloud electricity
+REAL :: ZCX, ZXX ! C and x parameters for N-lambda relationship
+REAL, DIMENSION(:), ALLOCATABLE :: ZQS, & ! Electric charge density source
+ ZZQ, & ! Work array
+ ZES ! e in q-D relationship
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWSEDQ ! Sedimentation of electric charge density
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBDA3
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZBEARDCOEFF ! effect of
+ ! electrical forces on terminal fall speed
!
!-------------------------------------------------------------------------------
!
-ZMOMENTS=KMOMENTS
+IMOMENTS=KMOMENTS
!
! Time splitting
!
@@ -128,6 +154,7 @@ ZWSEDC(:,:,:) = 0.
!
PRS(:,:,:) = PRS(:,:,:) * PTSTEP
IF (KMOMENTS==2) PCS(:,:,:) = PCS(:,:,:) * PTSTEP
+IF (OELEC) PQS(:,:,:) = PQS(:,:,:) * PTSTEP
DO JK = D%NKTB , D%NKTE
ZW(:,:,JK)=ZTSPLITG/PDZZ(:,:,JK)
END DO
@@ -135,8 +162,10 @@ END DO
IF (HPHASE=='L') ZC=CST%XCL
IF (HPHASE=='I') ZC=CST%XCI
!
-IF (KID==4 .AND. ZMOMENTS==1) THEN
- ZMOMENTS=2
+! When pristine ice is 1-moment, nb concentration is parameterized following
+! McFarquhar and Heymsfield (1997) for columns as in ICE3
+IF (KID==4 .AND. IMOMENTS==1) THEN
+ IMOMENTS=2
WHERE(PRS(:,:,:)>0) PCS(:,:,:)=1/(4*CST%XPI*900.) * PRS(:,:,:) * &
MAX(0.05E6,-0.15319E6-0.021454E6*ALOG(PRHODREF(:,:,:)*PRS(:,:,:)))**3
END IF
@@ -149,7 +178,7 @@ DO JN = 1 , NSPLITSED(KID)
! Computation only where enough ice, snow, graupel or hail
GSEDIM(:,:,:) = .FALSE.
GSEDIM(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE) = PRS(D%NIB:D%NIE,D%NJB:D%NJE,D%NKTB:D%NKTE)>XRTMIN(KID)
- IF (ZMOMENTS==2) GSEDIM(:,:,:) = GSEDIM(:,:,:) .AND. PCS(:,:,:)>XCTMIN(KID)
+ IF (IMOMENTS==2) GSEDIM(:,:,:) = GSEDIM(:,:,:) .AND. PCS(:,:,:)>XCTMIN(KID)
ISEDIM = COUNTJV( GSEDIM(:,:,:),I1(:),I2(:),I3(:))
!
IF( ISEDIM >= 1 ) THEN
@@ -164,15 +193,24 @@ DO JN = 1 , NSPLITSED(KID)
ALLOCATE(ZZW(ISEDIM)) ; ZZW(:) = 0.0
ALLOCATE(ZZX(ISEDIM)) ; ZZX(:) = 0.0
ALLOCATE(ZZY(ISEDIM)) ; ZZY(:) = 0.0
+ !
+ IF (OELEC) THEN
+ ALLOCATE(ZWSEDQ(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3))) ; ZWSEDQ(:,:,:) = 0.
+ ALLOCATE(ZES(ISEDIM)) ; ZES(:) = 0.0
+ ALLOCATE(ZQS(ISEDIM)) ; ZQS(:) = 0.0
+ ALLOCATE(ZZQ(ISEDIM)) ; ZZQ(:) = 0.0
+ END IF
!
DO JL = 1,ISEDIM
ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
ZPABST(JL) = PPABST(I1(JL),I2(JL),I3(JL))
ZT(JL) = PT(I1(JL),I2(JL),I3(JL))
ZRS(JL) = PRS(I1(JL),I2(JL),I3(JL))
- IF (ZMOMENTS==2) ZCS(JL) = PCS(I1(JL),I2(JL),I3(JL))
+ IF (IMOMENTS==2) ZCS(JL) = PCS(I1(JL),I2(JL),I3(JL))
+ IF (OELEC) ZQS(JL) = PQS(I1(JL),I2(JL),I3(JL))
END DO
!
+! Compute lambda
IF (KID == 5 .AND. NMOM_S.EQ.1 .AND. LSNOW_T) THEN
ZLBDA(:) = 1.E10
WHERE(ZT(:)>263.15 .AND. ZRS(:)>XRTMIN(5))
@@ -185,8 +223,8 @@ DO JN = 1 , NSPLITSED(KID)
ZZW(:) = XFSEDR(KID) * ZRHODREF(:)**(1.-XCEXVT)*ZRS(:)* &
(1 + (XFVELOS/ZLBDA(:))**XALPHAS)**(-XNUS-(XD(KID)+XBS)/XALPHAS) * ZLBDA(:)**(-XD(KID))
ELSE
- IF (ZMOMENTS==1) ZLBDA(:) = XLB(KID) * ( ZRHODREF(:) * ZRS(:) )**XLBEX(KID)
- IF (ZMOMENTS==2) ZLBDA(:) = ( XLB(KID)*ZCS(:) / ZRS(:) )**XLBEX(KID)
+ IF (IMOMENTS==1) ZLBDA(:) = XLB(KID) * ( ZRHODREF(:) * ZRS(:) )**XLBEX(KID)
+ IF (IMOMENTS==2) ZLBDA(:) = ( XLB(KID)*ZCS(:) / ZRS(:) )**XLBEX(KID)
ZZY(:) = ZRHODREF(:)**(-XCEXVT) * ZLBDA(:)**(-XD(KID))
IF (LSNOW_T .AND. KID==5) &
ZZY(:) = ZZY(:) * (1 + (XFVELOS/ZLBDA(:))**XALPHAS)**(-XNUS-(XD(KID)+XBS)/XALPHAS)
@@ -196,20 +234,73 @@ DO JN = 1 , NSPLITSED(KID)
IF (KMOMENTS==2) ZZX(:) = XFSEDC(KID) * ZCS(:) * ZZY(:) * ZRHODREF(:)
IF (KID==2) THEN
+ ! mean cloud droplet diameter
ZCC(:) = 0.5*GAMMA_X0D(XNUC+1./XALPHAC)/(GAMMA_X0D(XNUC)*ZLBDA(:))
+ ! correction factor for cloud droplet terminal fall speed
ZCC(:) = 1.+1.26*6.6E-8*(101325./ZPABST(:))*(ZT(:)/293.15)/ZCC(:)
ZZW(:) = ZCC(:) * ZZW(:)
ZZX(:) = ZCC(:) * ZZX(:)
END IF
-
+!
+! If the electrical scheme is activated, the electric field can impact the sedimentation
+ ZBEARDCOEFF(:,:,:) = 1.0
+ IF (OELEC .AND. LSEDIM_BEARD) THEN
+ ALLOCATE(ZLBDA3(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)))
+ ZLBDA3(:,:,:) = UNPACK( ZLBDA(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ CALL ELEC_BEARD_EFFECT(D, CST, ICED, HCLOUD, KID, GSEDIM, PT, PRHODREF, PTHVREFZIKB, &
+ PRS, PQS, PEFIELDW, ZLBDA3, ZBEARDCOEFF)
+ DEALLOCATE(ZLBDA3)
+ END IF
+!
ZWSEDR(:,:,1:D%NKT) = UNPACK( ZZW(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- ZWSEDR(:,:,D%NKTB:D%NKTE) = MIN( ZWSEDR(:,:,D%NKTB:D%NKTE), PRS(:,:,D%NKTB:D%NKTE) &
- * PRHODREF(:,:,D%NKTB:D%NKTE) / ZW(:,:,D%NKTB:D%NKTE) )
+ ZWSEDR(:,:,D%NKTB:D%NKTE) = MIN( ZWSEDR(:,:,D%NKTB:D%NKTE) * ZBEARDCOEFF(:,:,D%NKTB:D%NKTE), &
+ PRS(:,:,D%NKTB:D%NKTE) * PRHODREF(:,:,D%NKTB:D%NKTE) / &
+ ZW(:,:,D%NKTB:D%NKTE) )
IF (KMOMENTS==2) THEN
ZWSEDC(:,:,1:D%NKT) = UNPACK( ZZX(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- ZWSEDC(:,:,D%NKTB:D%NKTE) = MIN( ZWSEDC(:,:,D%NKTB:D%NKTE), PCS(:,:,D%NKTB:D%NKTE) &
- * PRHODREF(:,:,D%NKTB:D%NKTE) / ZW(:,:,D%NKTB:D%NKTE) )
+ ZWSEDC(:,:,D%NKTB:D%NKTE) = MIN( ZWSEDC(:,:,D%NKTB:D%NKTE) * ZBEARDCOEFF(:,:,D%NKTB:D%NKTE), &
+ PCS(:,:,D%NKTB:D%NKTE) * PRHODREF(:,:,D%NKTB:D%NKTE) / &
+ ZW(:,:,D%NKTB:D%NKTE) )
END IF
+!
+! Sedimentation of electric charges
+ IF (OELEC) THEN
+ ! compute e of the q-D relationship
+ IF (IMOMENTS == 2) THEN ! 2-moment species
+ CALL ELEC_COMPUTE_EX (KID, IMOMENTS, ISEDIM, HCLOUD, PTSTEP, ZRHODREF, XRTMIN(KID), &
+ ZRS, ZQS, ZES, PLBDX=ZLBDA, PCX=ZCS)
+ ELSE ! 1-moment species
+ CALL ELEC_COMPUTE_EX (KID, IMOMENTS, ISEDIM, HCLOUD, PTSTEP, ZRHODREF, XRTMIN(KID), &
+ ZRS, ZQS, ZES, PLBDX=ZLBDA)
+ END IF
+ !
+ ! number concentration for 1-moment species
+ ! for precipitating hydrometeors, N=C\lambda^x, except for snow if lsnow_t=t
+ IF (IMOMENTS == 1) THEN
+ IF (KID == 5) THEN
+ ZCX = XCCS
+ ZXX = XCXS
+ ELSE IF (KID == 6) THEN
+ ZCX = XCCG
+ ZXX = XCXG
+ ELSE IF (KID == 7) THEN
+ ZCX = XCCH
+ ZXX = XCXH
+ END IF
+ ZCS(:) = ZCX * ZLBDA(:)**ZXX
+ END IF
+ !
+ ZZQ(:) = ZRHODREF(:)**(1.-XCEXVT) * ZES(:) * ZCS(:) * XFQSED(KID) * ZLBDA(:)**(-XDQ(KID))
+ !
+ ! correction for cloud droplet terminal fall speed
+ IF (KID == 2) ZZQ(:) = ZZQ(:) * ZCC(:)
+ !
+ ZWSEDQ(:,:,1:D%NKT) = UNPACK( ZZQ(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
+ ZWSEDQ(:,:,1:D%NKT) = ZWSEDQ(:,:,1:D%NKT) * ZBEARDCOEFF(:,:,1:D%NKT)
+ ZWSEDQ(:,:,D%NKTB:D%NKTE) = SIGN(MIN(ABS(ZWSEDQ(:,:,D%NKTB:D%NKTE)), &
+ ABS(PQS(:,:,D%NKTB:D%NKTE)*PRHODREF(:,:,D%NKTB:D%NKTE)/ZW(:,:,D%NKTB:D%NKTE))), &
+ ZWSEDQ(:,:,D%NKTB:D%NKTE))
+ END IF
DO JK = D%NKTB , D%NKTE
PRS(:,:,JK) = PRS(:,:,JK) + ZW(:,:,JK)* &
@@ -226,7 +317,11 @@ DO JN = 1 , NSPLITSED(KID)
! ZW(:,:,JK)*ZWSEDR(:,:,JK+1)*ZC*PT(:,:,JK+D%NKL)) / &
! (PRHODREF(:,:,JK+D%NKL)*(1.+PRT_SUM(:,:,JK))*PCPT(:,:,JK) + ZW(:,:,JK)*ZWSEDR(:,:,JK+D%NKL)*ZC)
!ZWDT(:,:,JK) = ZWDT(:,:,JK) - PT(:,:,JK)
+ IF (OELEC) PQS(:,:,JK) = PQS(:,:,JK) + ZW(:,:,JK) * &
+ (ZWSEDQ(:,:,JK+D%NKL) - ZWSEDQ(:,:,JK)) / PRHODREF(:,:,JK)
+
END DO
+ !
DEALLOCATE(ZRHODREF)
DEALLOCATE(ZPABST)
DEALLOCATE(ZT)
@@ -237,6 +332,10 @@ DO JN = 1 , NSPLITSED(KID)
DEALLOCATE(ZZW)
DEALLOCATE(ZZX)
DEALLOCATE(ZZY)
+ IF (ALLOCATED(ZWSEDQ)) DEALLOCATE(ZWSEDQ)
+ IF (ALLOCATED(ZQS)) DEALLOCATE(ZQS)
+ IF (ALLOCATED(ZZQ)) DEALLOCATE(ZZQ)
+ IF (ALLOCATED(ZES)) DEALLOCATE(ZES)
!
PINPR(:,:) = PINPR(:,:) + ZWSEDR(:,:,D%NKB)/CST%XRHOLW/NSPLITSED(KID) ! in m/s
!PT(:,:,:) = PT(:,:,:) + ZWDT(:,:,:)
@@ -246,6 +345,7 @@ END DO
!
PRS(:,:,:) = PRS(:,:,:) / PTSTEP
IF (KMOMENTS==2) PCS(:,:,:) = PCS(:,:,:) / PTSTEP
+IF (OELEC) PQS(:,:,:) = PQS(:,:,:) / PTSTEP
!
END SUBROUTINE LIMA_SEDIMENTATION
END MODULE MODE_LIMA_SEDIMENTATION
diff --git a/src/common/micro/mode_lima_tendencies.F90 b/src/common/micro/mode_lima_tendencies.F90
index cbfde662f9a2a3c67c487e313b5199da0dd7ebc1..5fc16d817744e60c66e2ad622a5266ed55befd97 100644
--- a/src/common/micro/mode_lima_tendencies.F90
+++ b/src/common/micro/mode_lima_tendencies.F90
@@ -25,9 +25,13 @@ CONTAINS
P_RI_AGGS, P_CI_AGGS, &
P_TH_DEPG, P_RG_DEPG, &
P_TH_BERFI, P_RC_BERFI, &
- P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_CS_RIM, P_RG_RIM, &
+!++cb++
+! P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_CS_RIM, P_RG_RIM, &
+ P_TH_RIM, P_CC_RIM, P_CS_RIM, P_RC_RIMSS, P_RC_RIMSG, P_RS_RIMCG, &
P_RI_HMS, P_CI_HMS, P_RS_HMS, &
- P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_CS_ACC, P_RG_ACC, &
+! P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_CS_ACC, P_RG_ACC, &
+ P_TH_ACC, P_CR_ACC, P_CS_ACC, P_RR_ACCSS, P_RR_ACCSG, P_RS_ACCRG, &
+!--cb--
P_RS_CMEL, P_CS_CMEL, &
P_TH_CFRZ, P_RR_CFRZ, P_CR_CFRZ, P_RI_CFRZ, P_CI_CFRZ, &
P_RI_CIBU, P_CI_CIBU, &
@@ -46,7 +50,8 @@ CONTAINS
PA_TH, PA_RV, PA_RC, PA_CC, PA_RR, PA_CR, &
PA_RI, PA_CI, PA_RS, PA_CS, PA_RG, PA_CG, PA_RH, PA_CH, &
PEVAP3D, &
- PCF1D, PIF1D, PPF1D )
+ PCF1D, PIF1D, PPF1D, &
+ PLATHAM_IAGGS )
! ######################################################################
!!
!! PURPOSE
@@ -65,6 +70,8 @@ CONTAINS
! Delbeke/Vie 03/2022 : KHKO option
! J. Wurtz 03/2022 : new snow characteristics
! B. Vie 03/2022: Add option for 1-moment pristine ice
+! C. Barthe 06/2022: change some mass transfer rates to be consistent with ICE3, for cloud electrification
+! C. Barthe 06/2023: add Latham effet for IAGGS
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -171,23 +178,33 @@ REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_DEPG ! deposition of vapor on graup
REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_BERFI
REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_BERFI ! Bergeron (BERFI) : rc, ri=-rc, th
!
+!++cb++
REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_RIM
+!REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_RIM
REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_RIM
+!REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_RIM
REAL, DIMENSION(:), INTENT(INOUT) :: P_CS_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_RIM ! cloud droplet riming (RIM) : rc, Nc, rs, rg, th
+!REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_RIM ! cloud droplet riming (RIM) : rc, Nc, rs, rg, th
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_RIMSS
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_RIMSG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_RIMCG ! cloud droplet riming (RIM) : rc, Nc, rs, rg, th
+!--cb--
!
REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_HMS
REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_HMS
REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_HMS ! hallett mossop snow (HMS) : ri, Ni, rs
!
+!++cb++
REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_ACC
+!REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_ACC
REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_ACC
+!REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_ACC
REAL, DIMENSION(:), INTENT(INOUT) :: P_CS_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_ACC ! rain accretion on aggregates (ACC) : rr, Nr, rs, Ns, rg, Ng=-Ns, th
+!REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_ACC ! rain accretion on aggregates (ACC) : rr, Nr, rs, Ns, rg, Ng=-Ns, th
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_ACCSS
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_ACCSG
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_ACCRG ! rain accretion on aggregates (ACC) : rr, Nr, rs, rg, th
+!--cb--
!
REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_CMEL
REAL, DIMENSION(:), INTENT(INOUT) :: P_CS_CMEL ! conversion-melting (CMEL) : rs, Ns, rg=-rs, Ng=-Ns
@@ -282,6 +299,8 @@ REAL, DIMENSION(:), INTENT(IN) :: PCF1D
REAL, DIMENSION(:), INTENT(IN) :: PIF1D
REAL, DIMENSION(:), INTENT(IN) :: PPF1D
!
+REAL, DIMENSION(:), INTENT(IN) :: PLATHAM_IAGGS ! factor to account for the effect of Efield on IAGGS
+!
!* 0.2 Declarations of local variables :
!
REAL, DIMENSION(SIZE(PRCT)) :: ZT
@@ -557,11 +576,13 @@ IF ((.NOT. LKHKO) .AND. NMOM_R.GE.2) THEN
P_CR_SCBU )
!
P_CR_SCBU(:) = P_CR_SCBU(:) * ZPF1D(:)
+ ! process limited until checks on concentrations are added to the time-splitting loop
+ P_CR_SCBU(:) = MAX(P_CR_SCBU(:),-0.5*PCRT(:)/PTSTEP)
!
PA_CR(:) = PA_CR(:) + P_CR_SCBU(:)
END IF
!
-IF (NMOM_R.GE.2) THEN
+IF (NMOM_R.GE.1) THEN
CALL LIMA_RAIN_EVAPORATION (PTSTEP, LDCOMPUTE, & ! depends on PF > CF
PRHODREF, ZT, ZLV, ZLVFACT, ZEVSAT, ZRVSAT, &
PRVT, ZRCT/ZPF1D, ZRRT/ZPF1D, PCRT/ZPF1D, ZLBDR, &
@@ -647,6 +668,7 @@ IF (NMOM_I.GE.1 .AND. NMOM_S.GE.1) THEN
CALL LIMA_ICE_AGGREGATION_SNOW (LDCOMPUTE, & ! depends on IF, PF
ZT, PRHODREF, &
ZRIT/ZIF1D, ZRST/ZPF1D, PCIT/ZIF1D, PCST/ZPF1D, ZLBDI, ZLBDS, &
+ PLATHAM_IAGGS, &
P_RI_AGGS, P_CI_AGGS )
P_CI_AGGS(:) = P_CI_AGGS(:) * ZIF1D(:)
P_RI_AGGS(:) = P_RI_AGGS(:) * ZIF1D(:)
@@ -686,53 +708,71 @@ IF (NMOM_C.GE.1 .AND. NMOM_S.GE.1) THEN
! Graupel production as tendency (or should be tendency + instant to stick to the previous version ?)
! Includes the Hallett Mossop process for riming of droplets by snow (HMS)
!
+!++cb++
CALL LIMA_DROPLETS_RIMING_SNOW (PTSTEP, LDCOMPUTE, & ! depends on CF
PRHODREF, ZT, &
ZRCT/ZCF1D, PCCT/ZCF1D, ZRST/ZPF1D, PCST/ZPF1D, ZLBDC, ZLBDS, ZLVFACT, ZLSFACT, &
- P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_CS_RIM, P_RG_RIM, &
+! P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_CS_RIM, P_RG_RIM, &
+ P_TH_RIM, P_CC_RIM, P_CS_RIM, P_RC_RIMSS, P_RC_RIMSG, P_RS_RIMCG, &
P_RI_HMS, P_CI_HMS, P_RS_HMS )
- P_RC_RIM(:) = P_RC_RIM(:) * ZCF1D(:)
+! P_RC_RIM(:) = P_RC_RIM(:) * ZCF1D(:)
P_CC_RIM(:) = P_CC_RIM(:) * ZCF1D(:)
- P_RS_RIM(:) = P_RS_RIM(:) * ZCF1D(:)
+! P_RS_RIM(:) = P_RS_RIM(:) * ZCF1D(:)
P_CS_RIM(:) = P_CS_RIM(:) * ZCF1D(:)
- P_RG_RIM(:) = P_RG_RIM(:) * ZCF1D(:)
- P_TH_RIM(:) = - P_RC_RIM(:) * (ZLSFACT(:)-ZLVFACT(:))
+! P_RG_RIM(:) = P_RG_RIM(:) * ZCF1D(:)
+ P_RC_RIMSS(:) = P_RC_RIMSS(:) * ZCF1D(:)
+ P_RC_RIMSG(:) = P_RC_RIMSG(:) * ZCF1D(:)
+ P_RS_RIMCG(:) = P_RS_RIMCG(:) * ZCF1D(:)
+! P_TH_RIM(:) = - P_RC_RIM(:) * (ZLSFACT(:)-ZLVFACT(:))
+ P_TH_RIM(:) = - (P_RC_RIMSS(:) + P_RC_RIMSG(:)) * (ZLSFACT(:)-ZLVFACT(:))
P_RI_HMS(:) = P_RI_HMS(:) * ZCF1D(:)
P_CI_HMS(:) = P_CI_HMS(:) * ZCF1D(:)
P_RS_HMS(:) = P_RS_HMS(:) * ZCF1D(:)
!
- PA_RC(:) = PA_RC(:) + P_RC_RIM(:)
+! PA_RC(:) = PA_RC(:) + P_RC_RIM(:)
+ PA_RC(:) = PA_RC(:) + P_RC_RIMSS(:) + P_RC_RIMSG(:) ! RCRIMSS < 0 and RCRIMSG < 0 (both loss for rc)
IF (NMOM_C.GE.2) PA_CC(:) = PA_CC(:) + P_CC_RIM(:)
PA_RI(:) = PA_RI(:) + P_RI_HMS(:)
IF (NMOM_I.GE.2) PA_CI(:) = PA_CI(:) + P_CI_HMS(:)
- PA_RS(:) = PA_RS(:) + P_RS_RIM(:) + P_RS_HMS(:)
+! PA_RS(:) = PA_RS(:) + P_RS_RIM(:) + P_RS_HMS(:)
+ PA_RS(:) = PA_RS(:) - P_RC_RIMSS(:) - P_RS_RIMCG(:) ! RCRIMSS < 0 (gain for rs), RSRIMCG > 0 (loss for rs)
IF (NMOM_S.GE.2) PA_CS(:) = PA_CS(:) + P_CS_RIM(:)
- PA_RG(:) = PA_RG(:) + P_RG_RIM(:)
+! PA_RG(:) = PA_RG(:) + P_RG_RIM(:)
+ PA_RG(:) = PA_RG(:) - P_RC_RIMSG(:) + P_RS_RIMCG(:) ! RCRIMSG < 0 (gain for rg), RSRIMCG > 0 (gain for rg)
IF (NMOM_G.GE.2) PA_CG(:) = PA_CG(:) - P_CS_RIM(:)
PA_TH(:) = PA_TH(:) + P_TH_RIM(:)
-
+!--cb--
END IF
!
IF (NMOM_R.GE.1 .AND. NMOM_S.GE.1) THEN
+!++cb++
CALL LIMA_RAIN_ACCR_SNOW (PTSTEP, LDCOMPUTE, & ! depends on PF
PRHODREF, ZT, &
ZRRT/ZPF1D, PCRT/ZPF1D, ZRST/ZPF1D, PCST/ZPF1D, ZLBDR, ZLBDS, ZLVFACT, ZLSFACT, &
- P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_CS_ACC, P_RG_ACC )
- P_RR_ACC(:) = P_RR_ACC(:) * ZPF1D(:)
+! P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_CS_ACC, P_RG_ACC )
+ P_TH_ACC, P_CR_ACC, P_CS_ACC, P_RR_ACCSS, P_RR_ACCSG, P_RS_ACCRG )
+! P_RR_ACC(:) = P_RR_ACC(:) * ZPF1D(:)
P_CR_ACC(:) = P_CR_ACC(:) * ZPF1D(:)
- P_RS_ACC(:) = P_RS_ACC(:) * ZPF1D(:)
+! P_RS_ACC(:) = P_RS_ACC(:) * ZPF1D(:)
P_CS_ACC(:) = P_CS_ACC(:) * ZPF1D(:)
- P_RG_ACC(:) = P_RG_ACC(:) * ZPF1D(:)
- P_TH_ACC(:) = - P_RR_ACC(:) * (ZLSFACT(:)-ZLVFACT(:))
- !
- PA_RR(:) = PA_RR(:) + P_RR_ACC(:)
+! P_RG_ACC(:) = P_RG_ACC(:) * ZPF1D(:)
+! P_TH_ACC(:) = - P_RR_ACC(:) * (ZLSFACT(:)-ZLVFACT(:))
+ P_RR_ACCSS(:) = P_RR_ACCSS(:) * ZPF1D(:)
+ P_RR_ACCSG(:) = P_RR_ACCSG(:) * ZPF1D(:)
+ P_RS_ACCRG(:) = P_RS_ACCRG(:) * ZPF1D(:)
+ P_TH_ACC(:) = (P_RR_ACCSS(:) + P_RR_ACCSG(:)) * (ZLSFACT(:)-ZLVFACT(:))
+ !
+! PA_RR(:) = PA_RR(:) + P_RR_ACC(:)
+ PA_RR(:) = PA_RR(:) - P_RR_ACCSS(:) - P_RR_ACCSG(:)
IF (NMOM_R.GE.2) PA_CR(:) = PA_CR(:) + P_CR_ACC(:)
- PA_RS(:) = PA_RS(:) + P_RS_ACC(:)
+! PA_RS(:) = PA_RS(:) + P_RS_ACC(:)
+ PA_RS(:) = PA_RS(:) + P_RR_ACCSS(:) - P_RS_ACCRG(:)
IF (NMOM_S.GE.2) PA_CS(:) = PA_CS(:) + P_CS_ACC(:)
- PA_RG(:) = PA_RG(:) + P_RG_ACC(:)
+! PA_RG(:) = PA_RG(:) + P_RG_ACC(:)
+ PA_RG(:) = PA_RG(:) + P_RR_ACCSG(:) + P_RS_ACCRG(:)
IF (NMOM_G.GE.2) PA_CG(:) = PA_CG(:) - P_CS_ACC(:)
PA_TH(:) = PA_TH(:) + P_TH_ACC(:)
-
+!--cb--
END IF
!
IF (NMOM_S.GE.1) THEN
diff --git a/src/common/micro/modi_lima.F90 b/src/common/micro/modi_lima.F90
index 383df6c4d7fcad487defdff132df7cca37bb3b74..74f5ba53b482491dfa36636c728b1761c53a6d01 100644
--- a/src/common/micro/modi_lima.F90
+++ b/src/common/micro/modi_lima.F90
@@ -3,30 +3,42 @@ MODULE MODI_LIMA
IMPLICIT NONE
INTERFACE
!
- SUBROUTINE LIMA ( D, CST, BUCONF, TBUDGETS, KBUDGETS, &
- PTSTEP, &
- PRHODREF, PEXNREF, PDZZ, &
+ SUBROUTINE LIMA ( D, CST, ICED, ICEP, ELECD, ELECP, BUCONF, TBUDGETS, KBUDGETS,&
+ PTSTEP, OELEC, HCLOUD, &
+ PRHODREF, PEXNREF, PDZZ, PTHVREFZIKB, &
PRHODJ, PPABST, &
NCCN, NIFN, NIMM, &
PDTHRAD, PTHT, PRT, PSVT, PW_NU, &
PTHS, PRS, PSVS, &
PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, PINPRH, &
- PEVAP3D, PCLDFR, PICEFR, PPRCFR, PFPR )
+ PEVAP3D, PCLDFR, PICEFR, PPRCFR, PFPR, &
+ PLATHAM_IAGGS, PEFIELDW, PSV_ELEC_T, PSV_ELEC_S )
!
USE MODD_IO, ONLY: TFILEDATA
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_RAIN_ICE_DESCR_n,ONLY: RAIN_ICE_DESCR_t
+USE MODD_RAIN_ICE_PARAM_n,ONLY: RAIN_ICE_PARAM_t
+USE MODD_ELEC_PARAM, ONLY: ELEC_PARAM_t
+USE MODD_ELEC_DESCR, ONLY: ELEC_DESCR_t
USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t
USE MODD_CST, ONLY: CST_t
IMPLICIT NONE
!
TYPE(DIMPHYEX_t), INTENT(IN) :: D
TYPE(CST_t), INTENT(IN) :: CST
+TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
+TYPE(ELEC_PARAM_t), INTENT(IN) :: ELECP ! electrical parameters
+TYPE(ELEC_DESCR_t), INTENT(IN) :: ELECD ! electrical descriptive csts
TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
INTEGER, INTENT(IN) :: KBUDGETS
!
REAL, INTENT(IN) :: PTSTEP ! Time step
!
+LOGICAL, INTENT(IN) :: OELEC ! if true, cloud electrification is activated
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
@@ -62,6 +74,12 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Cloud fraction
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Cloud fraction
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PFPR ! Precipitation fluxes in altitude
!
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PLATHAM_IAGGS ! Factor for IAGGS modification due to Efield
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PEFIELDW ! Vertical component of the electric field
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: PSV_ELEC_T ! Charge density at time t
+REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(INOUT) :: PSV_ELEC_S ! Charge density sources
+!
+REAL, INTENT(IN) :: PTHVREFZIKB ! Reference thv at IKB for electricity
END SUBROUTINE LIMA
END INTERFACE
END MODULE MODI_LIMA
diff --git a/src/common/micro/modi_rain_ice.F90 b/src/common/micro/modi_rain_ice.F90
index 9d921712b714761aa398ffbdd5bc736b66cddb7e..e0bcef9df4c63039398a8caac95509d4df1b3f31 100644
--- a/src/common/micro/modi_rain_ice.F90
+++ b/src/common/micro/modi_rain_ice.F90
@@ -4,7 +4,8 @@
!
IMPLICIT NONE
INTERFACE
- SUBROUTINE RAIN_ICE ( D, CST, PARAMI, ICEP, ICED, BUCONF, &
+ SUBROUTINE RAIN_ICE ( D, CST, PARAMI, ICEP, ICED, ELECP, ELECD, BUCONF, &
+ OELEC, OSEDIM_BEARD, PTHVREFZIKB, HCLOUD, &
PTSTEP, KRR, PEXN, &
PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
@@ -13,15 +14,19 @@ INTERFACE
PINPRC, PINPRR, PEVAP3D, &
PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, &
TBUDGETS, KBUDGETS, &
+ PQPIT, PQCT, PQRT, PQIT, PQST, PQGT, PQNIT, &
+ PQPIS, PQCS, PQRS, PQIS, PQSS, PQGS, PQNIS, &
+ PEFIELDW, PLATHAM_IAGGS, &
PSEA, PTOWN, &
- PRHT, PRHS, PINPRH, PFPR )
+ PRHT, PRHS, PINPRH, PFPR, PQHT, PQHS )
!
USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t
USE MODD_CST, ONLY: CST_t
USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
-USE MODD_TURB_n, ONLY: TURB_t
+USE MODD_ELEC_DESCR, ONLY: ELEC_DESCR_t
+USE MODD_ELEC_PARAM, ONLY: ELEC_PARAM_t
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
IMPLICIT NONE
@@ -31,9 +36,14 @@ TYPE(CST_t), INTENT(IN) :: CST
TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+TYPE(ELEC_PARAM_t), INTENT(IN) :: ELECP ! electrical parameters
+TYPE(ELEC_DESCR_t), INTENT(IN) :: ELECD ! electrical descriptive csts
TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+LOGICAL, INTENT(IN) :: OELEC ! Switch for cloud electricity
+LOGICAL, INTENT(IN) :: OSEDIM_BEARD ! Switch for effect of electrical forces on sedim.
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
!
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXN ! Exner function
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
@@ -76,12 +86,37 @@ REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSIGS ! Sigma_s at t
!
TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
INTEGER, INTENT(IN) :: KBUDGETS
+!
+! scalar variables for cloud electricity
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(IN) :: PQPIT ! Positive ion -
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQCT ! Cloud droplet |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQRT ! Rain | electric
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQIT ! Ice crystals | charge
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQST ! Snow | at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQGT ! Graupel |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(IN) :: PQNIT ! Negative ion -
+!
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQPIS ! Positive ion -
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQCS ! Cloud droplet |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQRS ! Rain | electric
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQIS ! Ice crystals | charge
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQSS ! Snow | source
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQGS ! Graupel |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQNIS ! Negative ion -
+!
+REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)), OPTIONAL, INTENT(IN) :: PEFIELDW ! vertical electric field
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(IN) :: PLATHAM_IAGGS ! E Function to simulate
+REAL, INTENT(IN) :: PTHVREFZIKB ! Reference thv at IKB for electricity
+ ! enhancement of IAGGS
+!
REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(OUT) :: PINPRH! Hail instant precip
REAL, DIMENSION(D%NIJT,D%NKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQHT ! Hail electric charge at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQHS ! Hail electric charge source
!
END SUBROUTINE RAIN_ICE
END INTERFACE
diff --git a/src/common/micro/momg.F90 b/src/common/micro/momg.F90
new file mode 100644
index 0000000000000000000000000000000000000000..40296659745b7a8d9e20a2bf0bbe8e9aed208d45
--- /dev/null
+++ b/src/common/micro/momg.F90
@@ -0,0 +1,96 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! ################
+ MODULE MODI_MOMG
+! ################
+!
+INTERFACE MOMG
+!
+FUNCTION MOMG_X0D(PALPHA, PNU, PP) RESULT(PMOMG)
+REAL, INTENT(IN) :: PALPHA, PNU
+REAL, INTENT(IN) :: PP
+REAL :: PMOMG
+END FUNCTION MOMG_X0D
+!
+FUNCTION MOMG_X1D(PALPHA, PNU, PP) RESULT(PMOMG)
+REAL, INTENT(IN) :: PALPHA, PNU
+REAL, DIMENSION(:), INTENT(IN) :: PP
+REAL, DIMENSION(SIZE(PP)) :: PMOMG
+END FUNCTION MOMG_X1D
+!
+END INTERFACE
+END MODULE MODI_MOMG
+!
+!--------------------------------------------------------------------------
+!
+!
+!!**** *MOMG* -
+!!
+!! PURPOSE
+!! -------
+!! Compute: G(p) = Gamma(nu + p/alpha) / Gamma(nu)
+!! = M(p) * lambda^p
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! C. Barthe * Laboratoire de l'Atmosphere et des Cyclones *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 26 Nov. 2009
+!!
+!--------------------------------------------------------------------------------
+!
+!* 1. FUNCTION MOMG FOR SCALAR VARIABLE
+! ---------------------------------
+!
+! ##############################################
+ FUNCTION MOMG_X0D(PALPHA, PNU, PP) RESULT(PMOMG)
+! ##############################################
+!
+USE MODI_GAMMA
+!
+IMPLICIT NONE
+!
+REAL, INTENT(IN) :: PALPHA, PNU
+REAL, INTENT(IN) :: PP
+REAL :: PMOMG
+!
+!
+PMOMG = GAMMA(PNU+PP/PALPHA) / GAMMA(PNU)
+RETURN
+!
+END FUNCTION MOMG_X0D
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. FUNCTION MOMG FOR 1D ARRAY
+! --------------------------
+!
+! ##############################################
+ FUNCTION MOMG_X1D(PALPHA, PNU, PP) RESULT(PMOMG)
+! ##############################################
+!
+USE MODI_GAMMA
+!
+IMPLICIT NONE
+!
+REAL, INTENT(IN) :: PALPHA, PNU
+REAL, DIMENSION(:), INTENT(IN) :: PP
+REAL, DIMENSION(SIZE(PP)) :: PMOMG
+!
+!
+PMOMG(:) = GAMMA(PNU+PP(:)/PALPHA) / GAMMA(PNU)
+RETURN
+!
+END FUNCTION MOMG_X1D
+!
+!------------------------------------------------------------------------------
diff --git a/src/common/micro/rain_ice.F90 b/src/common/micro/rain_ice.F90
index ef288e454eb3106961d75eb6b7b60482f1e9c538..26e230ed9c5e9bf81708cce57def0beab26d667f 100644
--- a/src/common/micro/rain_ice.F90
+++ b/src/common/micro/rain_ice.F90
@@ -4,7 +4,8 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ######spl
- SUBROUTINE RAIN_ICE ( D, CST, PARAMI, ICEP, ICED, BUCONF, &
+ SUBROUTINE RAIN_ICE ( D, CST, PARAMI, ICEP, ICED, ELECP, ELECD, BUCONF, &
+ OELEC, OSEDIM_BEARD, PTHVREFZIKB, HCLOUD, &
PTSTEP, KRR, PEXN, &
PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
@@ -13,9 +14,12 @@
PINPRC, PINPRR, PEVAP3D, &
PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, &
TBUDGETS, KBUDGETS, &
+ PQPIT, PQCT, PQRT, PQIT, PQST, PQGT, PQNIT, &
+ PQPIS, PQCS, PQRS, PQIS, PQSS, PQGS, PQNIS, &
+ PEFIELDW, PLATHAM_IAGGS, &
PSEA, PTOWN, &
- PRHT, PRHS, PINPRH, PFPR )
-! ######################################################################
+ PRHT, PRHS, PINPRH, PFPR, PQHT, PQHS )
+! #############################################################################
!
!!**** * - compute the explicit microphysical sources
!!
@@ -170,7 +174,10 @@
!! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!! P. Wautelet 25/02/2020: bugfix: add missing budget: WETH_BU_RRG
!! R. El Khatib 24-Aug-2021 Optimizations
-!! J. Wurtz 03/2022: New snow characteristics with LSNOW_T
+! J. Wurtz 03/2022: New snow characteristics with LSNOW_T
+! C. Barthe 03/2023: Add call to cloud electrification
+! C. Barthe 06/2023: Add retroaction of electric field on IAGGS
+! C. Barthe 07/2023: use new data structures for electricity
!! S. Riette Sept 23: e from ice4_tendencies
!-----------------------------------------------------------------
!
@@ -186,15 +193,47 @@ USE MODD_CST, ONLY: CST_t
USE MODD_PARAM_ICE_n, ONLY: PARAM_ICE_t
USE MODD_RAIN_ICE_DESCR_n, ONLY: RAIN_ICE_DESCR_t
USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAM_t
-USE MODD_FIELDS_ADDRESS, ONLY : & ! common fields adress
- & ITH, & ! Potential temperature
- & IRV, & ! Water vapor
- & IRC, & ! Cloud water
- & IRR, & ! Rain water
- & IRI, & ! Pristine ice
- & IRS, & ! Snow/aggregate
- & IRG, & ! Graupel
- & IRH ! Hail
+USE MODD_ELEC_PARAM, ONLY: ELEC_PARAM_t
+USE MODD_ELEC_DESCR, ONLY: ELEC_DESCR_t
+USE MODD_FIELDS_ADDRESS
+!USE MODD_FIELDS_ADDRESS, ONLY : & ! common fields adress
+! & ITH, & ! Potential temperature
+! & IRV, & ! Water vapor
+! & IRC, & ! Cloud water
+! & IRR, & ! Rain water
+! & IRI, & ! Pristine ice
+! & IRS, & ! Snow/aggregate
+! & IRG, & ! Graupel
+! & IRH, & ! Hail
+! & IBUNUM, & ! Number of tendency terms
+! & IBUNUM_EXTRA, & ! Number of extra tendency terms
+! & IRCHONI, & ! Homogeneous nucleation
+! & IRVDEPS, & ! Deposition on r_s,
+! & IRIAGGS, & ! Aggregation on r_s
+! & IRIAUTS, & ! Autoconversion of r_i for r_s production
+! & IRVDEPG, & ! Deposition on r_g
+! & IRCAUTR, & ! Autoconversion of r_c for r_r production
+! & IRCACCR, & ! Accretion of r_c for r_r production
+! & IRREVAV, & ! Evaporation of r_r
+! & IRCBERI, & ! Bergeron-Findeisen effect
+! & IRHMLTR, & ! Melting of the hailstones
+! & IRSMLTG, & ! Conversion-Melting of the aggregates
+! & IRCMLTSR, & ! Cloud droplet collection onto aggregates by positive temperature
+! & IRRACCSS, IRRACCSG, IRSACCRG, & ! Rain accretion onto the aggregates
+! & IRCRIMSS, IRCRIMSG, IRSRIMCG, & ! Cloud droplet riming of the aggregates
+! & IRICFRRG, IRRCFRIG, IRICFRR, & ! Rain contact freezing
+! & IRCWETG, IRIWETG, IRRWETG, IRSWETG, & ! Graupel wet growth
+! & IRCDRYG, IRIDRYG, IRRDRYG, IRSDRYG, & ! Graupel dry growth
+! & IRWETGH, & ! Conversion of graupel into hail
+! & IRGMLTR, & ! Melting of the graupel
+! & IRCWETH, IRIWETH, IRSWETH, IRGWETH, IRRWETH, & ! Dry growth of hailstone
+! & IRCDRYH, IRIDRYH, IRSDRYH, IRRDRYH, IRGDRYH, & ! Wet growth of hailstone
+! & IRDRYHG, &
+! & IRVHENI_MR, & ! heterogeneous nucleation mixing ratio change
+! & IRRHONG_MR, & ! Spontaneous freezing mixing ratio change
+! & IRIMLTC_MR, & ! Cloud ice melting mixing ratio change
+! & IRSRIMCG_MR,& ! Cloud droplet riming of the aggregates
+! & IRWETGH_MR
USE MODE_BUDGET_PHY, ONLY: BUDGET_STORE_INIT_PHY, BUDGET_STORE_END_PHY
USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
@@ -205,6 +244,8 @@ USE MODE_ICE4_SEDIMENTATION, ONLY: ICE4_SEDIMENTATION
USE MODE_ICE4_PACK, ONLY: ICE4_PACK
USE MODE_ICE4_CORRECT_NEGATIVITIES, ONLY: ICE4_CORRECT_NEGATIVITIES
!
+USE MODE_ELEC_TENDENCIES, ONLY : ELEC_TENDENCIES
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -216,9 +257,14 @@ TYPE(CST_t), INTENT(IN) :: CST
TYPE(PARAM_ICE_t), INTENT(IN) :: PARAMI
TYPE(RAIN_ICE_PARAM_t), INTENT(IN) :: ICEP
TYPE(RAIN_ICE_DESCR_t), INTENT(IN) :: ICED
+TYPE(ELEC_PARAM_t), INTENT(IN) :: ELECP ! electrical parameters
+TYPE(ELEC_DESCR_t), INTENT(IN) :: ELECD ! electrical descriptive csts
TYPE(TBUDGETCONF_t), INTENT(IN) :: BUCONF
+LOGICAL, INTENT(IN) :: OELEC ! Switch for cloud electricity
+LOGICAL, INTENT(IN) :: OSEDIM_BEARD ! Switch for effect of electrical forces on sedim.
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
!
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PEXN ! Exner function
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
@@ -258,15 +304,41 @@ REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINPRG! Graupel instant precip
REAL, DIMENSION(D%NIJT), INTENT(OUT) :: PINDEP ! Cloud instant deposition
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(OUT) :: PRAINFR !Precipitation fraction
REAL, DIMENSION(D%NIJT,D%NKT), INTENT(IN) :: PSIGS ! Sigma_s at t
+REAL, INTENT(IN) :: PTHVREFZIKB ! Reference thv at IKB for electricity
!
TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
INTEGER, INTENT(IN) :: KBUDGETS
-REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
-REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(OUT) :: PINPRH! Hail instant precip
-REAL, DIMENSION(D%NIJT,D%NKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+!
+! scalar variables for cloud electricity
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(IN) :: PQPIT ! Positive ion -
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQCT ! Cloud droplet |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQRT ! Rain | electric
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQIT ! Ice crystals | charge
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQST ! Snow | at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQGT ! Graupel |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(IN) :: PQNIT ! Negative ion -
+!
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQPIS ! Positive ion -
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQCS ! Cloud droplet |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQRS ! Rain | electric
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQIS ! Ice crystals | charge
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQSS ! Snow | source
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQGS ! Graupel |
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQNIS ! Negative ion -
+!
+REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)), OPTIONAL, INTENT(IN) :: PEFIELDW ! vertical electric field
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(IN) :: PLATHAM_IAGGS ! E Function to simulate
+ ! enhancement of IAGGS
+!
+! optional variables
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(IN) :: PTOWN ! Fraction that is town
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(D%NIJT,D%NKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(D%NIJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(D%NIJT,D%NKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQHT ! Hail electric charge at t
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)), OPTIONAL, INTENT(INOUT) :: PQHS ! Hail electric charge source
!
!
!* 0.2 Declarations of local variables :
@@ -298,6 +370,13 @@ LOGICAL, DIMENSION(D%NIJT,D%NKT) :: LLW3D
REAL, DIMENSION(KRR) :: ZRSMIN
INTEGER :: ISIZE, IPROMA, IGPBLKS, ISIZE2
!
+LOGICAL :: LSAVE_MICRO = .FALSE. ! if true, microphysical tendencies are saved for cloud electricity
+REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC),MERGE(IBUNUM-IBUNUM_EXTRA,0,OELEC)) :: &
+ ZMICRO_TEND ! Total mixing ratio change, used for electric charge tendencies
+LOGICAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT,0,OELEC)) :: GMASK_ELEC
+INTEGER :: IELEC ! nb of points where microphysical tendencies are not null
+INTEGER :: JI ! loop index
+!
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('RAIN_ICE', 0, ZHOOK_HANDLE)
!
@@ -313,9 +392,6 @@ IIJE=D%NIJE
IIJT=D%NIJT
!-------------------------------------------------------------------------------
!
-IF(PARAMI%LOCND2) THEN
- CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'RAIN_ICE', 'LOCND2 OPTION NOT CODED IN THIS RAIN_ICE VERSION')
-END IF
ZINV_TSTEP=1./PTSTEP
!
! LSFACT and LVFACT without exner, and LLMICRO
@@ -360,14 +436,16 @@ ENDDO
! -------------------------------------
!
IF(.NOT. PARAMI%LSEDIM_AFTER) THEN
- CALL ICE4_SEDIMENTATION(D, CST, ICEP, ICED, PARAMI, BUCONF, &
- &PTSTEP, KRR, PDZZ, &
+ CALL ICE4_SEDIMENTATION(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, BUCONF, &
+ &OELEC, OSEDIM_BEARD, HCLOUD, PTSTEP, KRR, PDZZ, PTHVREFZIKB, &
&ZZ_LVFACT, ZZ_LSFACT, PRHODREF, PPABST, PTHT, ZT, PRHODJ, &
&PTHS, PRVS, PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINPRR, PINPRS, PINPRG, &
+ &PQCT, PQRT, PQIT, PQST, PQGT, PQCS, PQRS, PQIS, PQSS, PQGS, PEFIELDW, &
&TBUDGETS, KBUDGETS, &
&PSEA=PSEA, PTOWN=PTOWN, &
- &PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
+ &PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR, &
+ &PQHT=PQHT, PQHS=PQHS)
ENDIF
!
!
@@ -403,7 +481,7 @@ ENDDO
!* 4.1 COMPUTES THE SLOW COLD PROCESS SOURCES OUTSIDE OF LLMICRO POINTS
! -----------------------------------------------------------------
!
-!The nucelation must be call everywhere
+!The nucleation must be called everywhere
!This call is for points outside of the LLMICR mask, another call is coded in ice4_tendencies
LLW3D(:,:)=.FALSE.
DO JK=IKTB,IKTE
@@ -521,10 +599,17 @@ ELSE
IPROMA=0
ISIZE2=ISIZE
ENDIF
+!
+!Microphysical tendencies must be saved for some physical parameterizations
+IF (OELEC) THEN
+ LSAVE_MICRO = .TRUE.
+ ZMICRO_TEND(:,:,:) = 0.
+END IF
+!
!This part is put in another routine to separate pack/unpack operations from computations
CALL ICE4_PACK(D, CST, PARAMI, ICEP, ICED, BUCONF, &
IPROMA, ISIZE, ISIZE2, &
- PTSTEP, KRR, LLMICRO, PEXN, &
+ PTSTEP, KRR, LSAVE_MICRO, LLMICRO, OELEC, PEXN, &
PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
@@ -533,15 +618,109 @@ CALL ICE4_PACK(D, CST, PARAMI, ICEP, ICED, BUCONF, &
ZZ_RVHENI, ZZ_LVFACT, ZZ_LSFACT, &
ZWR, &
TBUDGETS, KBUDGETS, &
- PRHS )
+ ZMICRO_TEND, PLATHAM_IAGGS, PRHS )
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. CALL TO PHYSICAL PARAMETERIZATIONS CLOSELY LINKED TO MICROPHYSICS
+! -----------------------------------------------------------------
+!
+! Cloud electrification, water isotopes and aqueous chemistry need the mixing ratio tendencies
+! to compute the evolution of electric charges, water isotopes and ...
+!
+!* 7.1 Cloud electrification
+!
+IF (OELEC) THEN
+ DO JK = IKTB, IKTE
+ DO JIJ = IIJB, IIJE
+ DO JI = 1, IBUNUM-IBUNUM_EXTRA
+ ZMICRO_TEND(JIJ,JK,JI) = ZMICRO_TEND(JIJ,JK,JI) * ZINV_TSTEP
+ !
+ ! transfer of electric charges occurs only where transfer of mass is non null
+ GMASK_ELEC(JIJ,JK) = GMASK_ELEC(JIJ,JK) .OR. (ZMICRO_TEND(JIJ,JK,JI) .NE. 0.)
+ END DO
+ END DO
+ END DO
+ !
+ IELEC = COUNT(GMASK_ELEC)
+ !
+ ! RVHENI : ajout de prvheni ?
+ ! traitement des deux termes extra ? irwetgh_mr et irsrimcg_mr ?
+ IF (KRR == 7) THEN
+ CALL ELEC_TENDENCIES(D, CST, ICED, ICEP, ELECD, ELECP, &
+ KRR, IELEC, PTSTEP, GMASK_ELEC, &
+ BUCONF, TBUDGETS, KBUDGETS, &
+ HCLOUD, PTHVREFZIKB, PRHODREF, PRHODJ, ZT, PCIT, &
+ PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PQPIT, PQCT, PQRT, PQIT, PQST, PQGT, PQNIT, &
+ PQPIS, PQCS, PQRS, PQIS, PQSS, PQGS, PQNIS, &
+ ZMICRO_TEND(:,:,IRVHENI_MR), ZMICRO_TEND(:,:,IRRHONG_MR), &
+ ZMICRO_TEND(:,:,IRIMLTC_MR), ZMICRO_TEND(:,:,IRCHONI), &
+ ZMICRO_TEND(:,:,IRVDEPS), ZMICRO_TEND(:,:,IRIAGGS), &
+ ZMICRO_TEND(:,:,IRIAUTS), ZMICRO_TEND(:,:,IRVDEPG), &
+ ZMICRO_TEND(:,:,IRCAUTR), ZMICRO_TEND(:,:,IRCACCR), &
+ ZMICRO_TEND(:,:,IRREVAV), ZMICRO_TEND(:,:,IRCRIMSS), &
+ ZMICRO_TEND(:,:,IRCRIMSG), ZMICRO_TEND(:,:,IRSRIMCG), &
+ ZMICRO_TEND(:,:,IRRACCSS), ZMICRO_TEND(:,:,IRRACCSG), &
+ ZMICRO_TEND(:,:,IRSACCRG), ZMICRO_TEND(:,:,IRSMLTG), &
+ ZMICRO_TEND(:,:,IRICFRRG), ZMICRO_TEND(:,:,IRRCFRIG), &
+ ZMICRO_TEND(:,:,IRCWETG), ZMICRO_TEND(:,:,IRIWETG), &
+ ZMICRO_TEND(:,:,IRRWETG), ZMICRO_TEND(:,:,IRSWETG), &
+ ZMICRO_TEND(:,:,IRCDRYG), ZMICRO_TEND(:,:,IRIDRYG), &
+ ZMICRO_TEND(:,:,IRRDRYG), ZMICRO_TEND(:,:,IRSDRYG), &
+ ZMICRO_TEND(:,:,IRGMLTR), ZMICRO_TEND(:,:,IRCBERI), &
+ PRCMLTSR=ZMICRO_TEND(:,:,IRCMLTSR), PRICFRR=ZMICRO_TEND(:,:,IRICFRR),&
+ PRWETGH=ZMICRO_TEND(:,:,IRWETGH), &
+ PRCWETH=ZMICRO_TEND(:,:,IRCWETH), PRIWETH=ZMICRO_TEND(:,:,IRIWETH), &
+ PRSWETH=ZMICRO_TEND(:,:,IRSWETH), &
+ PRGWETH=ZMICRO_TEND(:,:,IRGWETH), PRRWETH=ZMICRO_TEND(:,:,IRRWETH), &
+ PRCDRYH=ZMICRO_TEND(:,:,IRCDRYH), PRIDRYH=ZMICRO_TEND(:,:,IRIDRYH), &
+ PRSDRYH=ZMICRO_TEND(:,:,IRSDRYH), &
+ PRRDRYH=ZMICRO_TEND(:,:,IRRDRYH), PRGDRYH=ZMICRO_TEND(:,:,IRGDRYH), &
+ PRDRYHG=ZMICRO_TEND(:,:,IRDRYHG), PRHMLTR=ZMICRO_TEND(:,:,IRHMLTR), &
+ PRHT=PRHT, PRHS=PRHS, PQHT=PQHT, PQHS=PQHS )
+ ELSE
+ CALL ELEC_TENDENCIES(D, CST, ICED, ICEP, ELECD, ELECP, &
+ KRR, ISIZE, PTSTEP, LLMICRO, &
+ BUCONF, TBUDGETS, KBUDGETS, &
+ HCLOUD, PTHVREFZIKB, PRHODREF, PRHODJ, ZT, PCIT, &
+ PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PQPIT, PQCT, PQRT, PQIT, PQST, PQGT, PQNIT, &
+ PQPIS, PQCS, PQRS, PQIS, PQSS, PQGS, PQNIS, &
+ ZMICRO_TEND(:,:,IRVHENI_MR), ZMICRO_TEND(:,:,IRRHONG_MR), &
+ ZMICRO_TEND(:,:,IRIMLTC_MR), ZMICRO_TEND(:,:,IRCHONI), &
+ ZMICRO_TEND(:,:,IRVDEPS), ZMICRO_TEND(:,:,IRIAGGS), &
+ ZMICRO_TEND(:,:,IRIAUTS), ZMICRO_TEND(:,:,IRVDEPG), &
+ ZMICRO_TEND(:,:,IRCAUTR), ZMICRO_TEND(:,:,IRCACCR), &
+ ZMICRO_TEND(:,:,IRREVAV), ZMICRO_TEND(:,:,IRCRIMSS), &
+ ZMICRO_TEND(:,:,IRCRIMSG), ZMICRO_TEND(:,:,IRSRIMCG), &
+ ZMICRO_TEND(:,:,IRRACCSS), ZMICRO_TEND(:,:,IRRACCSG), &
+ ZMICRO_TEND(:,:,IRSACCRG), ZMICRO_TEND(:,:,IRSMLTG), &
+ ZMICRO_TEND(:,:,IRICFRRG), ZMICRO_TEND(:,:,IRRCFRIG), &
+ ZMICRO_TEND(:,:,IRCWETG), ZMICRO_TEND(:,:,IRIWETG), &
+ ZMICRO_TEND(:,:,IRRWETG), ZMICRO_TEND(:,:,IRSWETG), &
+ ZMICRO_TEND(:,:,IRCDRYG), ZMICRO_TEND(:,:,IRIDRYG), &
+ ZMICRO_TEND(:,:,IRRDRYG), ZMICRO_TEND(:,:,IRSDRYG), &
+ ZMICRO_TEND(:,:,IRGMLTR), ZMICRO_TEND(:,:,IRCBERI), &
+ PRCMLTSR=ZMICRO_TEND(:,:,IRCMLTSR), PRICFRR=ZMICRO_TEND(:,:,IRICFRR))
+ END IF
+END IF
+!
+!
+!* 7.2 Water isotopologues
+!
+!
+!* 7.3 Aqueous chemistry
+!
!
!-------------------------------------------------------------------------------
!
-!* 6. TOTAL TENDENCIES
+!* 8. TOTAL TENDENCIES
! ----------------
!
!
-!*** 6.1 total tendencies limited by available species
+!*** 8.1 total tendencies limited by available species
!
DO JK = IKTB, IKTE
DO JIJ=IIJB, IIJE
@@ -581,7 +760,7 @@ DO JK = IKTB, IKTE
ENDDO
!-------------------------------------------------------------------------------
!
-!*** 6.2 Negative corrections
+!*** 8.2 Negative corrections
!
!NOTE:
! This call cannot be moved before the preeceding budget calls because,
@@ -602,11 +781,16 @@ IF(BUCONF%LBU_ENABLE) THEN
IF (BUCONF%LBUDGET_RG) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RG), 'CORR', PRGS(:, :)*PRHODJ(:, :))
IF (BUCONF%LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RH), 'CORR', PRHS(:, :)*PRHODJ(:, :))
END IF
+!++cb-- ajouter les bilans pour l'elec !!!
!We correct negativities with conservation
CALL ICE4_CORRECT_NEGATIVITIES(D, ICED, KRR, PRVS, PRCS, PRRS, &
&PRIS, PRSS, PRGS, &
&PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
+!CALL ICE4_CORRECT_NEGATIVITIES(D, ICED, KRR, OELEC, PRVS, PRCS, PRRS, &
+! &PRIS, PRSS, PRGS, &
+! &PQPIS, PQCS, PQRS, PQIS, PQSS, PQGS, PQNIS, &
+! &PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS, PQHS)
IF (BUCONF%LBU_ENABLE) THEN
IF (BUCONF%LBUDGET_TH) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_TH), 'CORR', PTHS(:, :)*PRHODJ(:, :))
@@ -621,19 +805,21 @@ END IF
!
!-------------------------------------------------------------------------------
!
-!* 7. COMPUTE THE SEDIMENTATION (RS) SOURCE
+!* 9. COMPUTE THE SEDIMENTATION (RS) SOURCE
! -------------------------------------
!
IF(PARAMI%LSEDIM_AFTER) THEN
- CALL ICE4_SEDIMENTATION(D, CST, ICEP, ICED, PARAMI, BUCONF, &
- &PTSTEP, KRR, PDZZ, &
+ CALL ICE4_SEDIMENTATION(D, CST, ICEP, ICED, PARAMI, ELECP, ELECD, BUCONF, &
+ &OELEC, OSEDIM_BEARD, HCLOUD, PTSTEP, KRR, PDZZ, PTHVREFZIKB, &
&ZZ_LVFACT, ZZ_LSFACT, PRHODREF, PPABST, PTHT, ZT, PRHODJ, &
&PTHS, PRVS, PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINPRR, PINPRS, PINPRG, &
+ &PQCT, PQRT, PQIT, PQST, PQGT, PQCS, PQRS, PQIS, PQSS, PQGS, PEFIELDW, &
&TBUDGETS, KBUDGETS, &
&PSEA=PSEA, PTOWN=PTOWN, &
- &PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
-
+ &PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR, &
+ &PQHT=PQHT, PQHS=PQHS)
+
!"sedimentation" of rain fraction
DO JK = IKTB, IKTE
DO JIJ=IIJB,IIJE
@@ -656,7 +842,7 @@ ENDIF
!
!-------------------------------------------------------------------------------
!
-!* 8. COMPUTE THE FOG DEPOSITION TERM
+!* 10. COMPUTE THE FOG DEPOSITION TERM
! -------------------------------------
!
IF (PARAMI%LDEPOSC) THEN !cloud water deposition on vegetation
diff --git a/src/common/turb/modd_param_mfshalln.F90 b/src/common/turb/modd_param_mfshalln.F90
index 664812c582f179a458ab25c786b1c0db22964a46..a4724bcc176a2fc67855d781dc54eb89890da0d0 100644
--- a/src/common/turb/modd_param_mfshalln.F90
+++ b/src/common/turb/modd_param_mfshalln.F90
@@ -82,6 +82,7 @@ REAL :: XGZ !< Tuning of the surface initialisation for Grey Zo
!
LOGICAL :: LTHETAS_MF !< .TRUE. to use ThetaS1 instead of ThetaL
REAL :: XLAMBDA_MF !< Thermodynamic parameter: Lambda to compute ThetaS1 from ThetaL
+LOGICAL :: LVERLIMUP !< .TRUE. to use correction on vertical limitation of updraft (issue #38 PHYEX)
END TYPE PARAM_MFSHALL_t
@@ -119,13 +120,15 @@ REAL, POINTER :: XR=>NULL()
LOGICAL, POINTER :: LTHETAS_MF=>NULL()
REAL, POINTER :: XLAMBDA_MF=>NULL()
LOGICAL, POINTER :: LGZ=>NULL()
-REAL, POINTER :: XGZ=>NULL()
+REAL, POINTER :: XGZ=>NULL()
+LOGICAL, POINTER :: LVERLIMUP=>NULL()
!
NAMELIST/NAM_PARAM_MFSHALLn/XIMPL_MF,CMF_UPDRAFT,CMF_CLOUD,LMIXUV,LMF_FLX,&
XALP_PERT,XABUO,XBENTR,XBDETR,XCMF,XENTR_MF,&
XCRAD_MF,XENTR_DRY,XDETR_DRY,XDETR_LUP,XKCF_MF,&
XKRC_MF,XTAUSIGMF,XPRES_UV,XALPHA_MF,XSIGMA_MF,&
- XFRAC_UP_MAX,XA1,XB,XC,XBETA1,XR,LTHETAS_MF,LGZ,XGZ
+ XFRAC_UP_MAX,XA1,XB,XC,XBETA1,XR,LTHETAS_MF,LGZ,XGZ,&
+ LVERLIMUP
!
!-------------------------------------------------------------------------------
!
@@ -176,12 +179,13 @@ LTHETAS_MF=>PARAM_MFSHALL_MODEL(KTO)%LTHETAS_MF
XLAMBDA_MF=>PARAM_MFSHALL_MODEL(KTO)%XLAMBDA_MF
LGZ=>PARAM_MFSHALL_MODEL(KTO)%LGZ
XGZ=>PARAM_MFSHALL_MODEL(KTO)%XGZ
+LVERLIMUP=>PARAM_MFSHALL_MODEL(KTO)%LVERLIMUP
!
ENDIF
!
END SUBROUTINE PARAM_MFSHALL_GOTO_MODEL
-SUBROUTINE PARAM_MFSHALLN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
+SUBROUTINE PARAM_MFSHALLN_INIT(HPROGRAM, TFILENAM, LDNEEDNAM, KLUOUT, &
&LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT)
!!*** *PARAM_MFSHALLN* - Code needed to initialize the MODD_PARAM_MFSHALL_n module
!!
@@ -213,6 +217,7 @@ SUBROUTINE PARAM_MFSHALLN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
!
USE MODE_POSNAM_PHY, ONLY: POSNAM_PHY
USE MODE_CHECK_NAM_VAL, ONLY: CHECK_NAM_VAL_CHAR
+USE MODD_IO, ONLY: TFILEDATA
!
IMPLICIT NONE
!
@@ -220,7 +225,7 @@ IMPLICIT NONE
! ------------------------
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM !< Name of the calling program
-INTEGER, INTENT(IN) :: KUNITNML !< Logical unit to access the namelist
+TYPE(TFILEDATA), INTENT(IN) :: TFILENAM !< Namelist file
LOGICAL, INTENT(IN) :: LDNEEDNAM !< True to abort if namelist is absent
INTEGER, INTENT(IN) :: KLUOUT !< Logical unit for outputs
LOGICAL, OPTIONAL, INTENT(IN) :: LDDEFAULTVAL !< Must we initialize variables with default values (defaults to .TRUE.)
@@ -284,14 +289,16 @@ IF(LLDEFAULTVAL) THEN
XLAMBDA_MF=0.
LGZ=.FALSE.
XGZ=1.83 ! between 1.83 and 1.33
+ LVERLIMUP=.FALSE.
+ IF(HPROGRAM=='MESONH') LVERLIMUP=.TRUE.
ENDIF
!
!* 2. NAMELIST
! -----------
!
IF(LLREADNAM) THEN
- CALL POSNAM_PHY(KUNITNML, 'NAM_PARAM_MFSHALLN', LDNEEDNAM, LLFOUND, KLUOUT)
- IF(LLFOUND) READ(UNIT=KUNITNML, NML=NAM_PARAM_MFSHALLn)
+ CALL POSNAM_PHY(TFILENAM, 'NAM_PARAM_MFSHALLN', LDNEEDNAM, LLFOUND)
+ IF(LLFOUND) READ(UNIT=TFILENAM%NLU, NML=NAM_PARAM_MFSHALLn)
ENDIF
!
!* 3. CHECKS
diff --git a/src/common/turb/modd_turbn.F90 b/src/common/turb/modd_turbn.F90
index b4c173c55c0f15b29987a2d25658bbb25a326a2f..ef3ad4cbe1da3b08d6e7aca87a58f73b0079519e 100644
--- a/src/common/turb/modd_turbn.F90
+++ b/src/common/turb/modd_turbn.F90
@@ -122,6 +122,7 @@ REAL :: XCEI_MAX !< maximum threshold for the instability index C
!(beginning of the saturation of the amplification)
REAL, DIMENSION(:,:,:), POINTER :: XCEI !< Cloud Entrainment instability index to emphasize localy
! turbulent fluxes
+ LOGICAL :: LTURB_PRECIP ! switch to apply turbulence to precipitating hydrometeor mixing ratios
!
END TYPE TURB_t
@@ -180,6 +181,7 @@ REAL, POINTER :: XCOEF_AMPL_SAT=>NULL()
REAL, POINTER :: XCEI_MIN=>NULL()
REAL, POINTER :: XCEI_MAX =>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XCEI=>NULL()
+LOGICAL, POINTER :: LTURB_PRECIP=>NULL()
!
NAMELIST/NAM_TURBn/XIMPL,CTURBLEN,CTURBDIM,LTURB_FLX,LTURB_DIAG, &
LSIG_CONV,LRMC01,CTOM,&
@@ -188,7 +190,7 @@ NAMELIST/NAM_TURBn/XIMPL,CTURBLEN,CTURBDIM,LTURB_FLX,LTURB_DIAG, &
XALTHGRAD, XCLDTHOLD, XLINI, LHARAT, &
LPROJQITURB, LSMOOTH_PRANDTL, XMINSIGS, NTURBSPLIT, &
LCLOUDMODIFLM, CTURBLEN_CLOUD, &
- XCOEF_AMPL_SAT, XCEI_MIN, XCEI_MAX
+ XCOEF_AMPL_SAT, XCEI_MIN, XCEI_MAX, LTURB_PRECIP
!
!-------------------------------------------------------------------------------
!
@@ -276,12 +278,13 @@ XCOEF_AMPL_SAT=>TURB_MODEL(KTO)%XCOEF_AMPL_SAT
XCEI_MIN=>TURB_MODEL(KTO)%XCEI_MIN
XCEI_MAX =>TURB_MODEL(KTO)%XCEI_MAX
XCEI=>TURB_MODEL(KTO)%XCEI
+LTURB_PRECIP=>TURB_MODEL(KTO)%LTURB_PRECIP
!
ENDIF
!
END SUBROUTINE TURB_GOTO_MODEL
-SUBROUTINE TURBN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
+SUBROUTINE TURBN_INIT(HPROGRAM, TFILENAM, LDNEEDNAM, KLUOUT, &
&LDDEFAULTVAL, LDREADNAM, LDCHECK, KPRINT)
!!*** *TURBN_INIT* - Code needed to initialize the MODD_TURB_n module
!!
@@ -314,6 +317,8 @@ SUBROUTINE TURBN_INIT(HPROGRAM, KUNITNML, LDNEEDNAM, KLUOUT, &
USE MODE_POSNAM_PHY, ONLY: POSNAM_PHY
USE MODE_CHECK_NAM_VAL, ONLY: CHECK_NAM_VAL_CHAR
USE MODD_PARAMETERS, ONLY: XUNDEF
+USE MODD_IO, ONLY: TFILEDATA
+
!
IMPLICIT NONE
!
@@ -321,7 +326,7 @@ IMPLICIT NONE
! ------------------------
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM !< Name of the calling program
-INTEGER, INTENT(IN) :: KUNITNML !< Logical unit to access the namelist
+TYPE(TFILEDATA), INTENT(IN) :: TFILENAM !< Namelist file
LOGICAL, INTENT(IN) :: LDNEEDNAM !< True to abort if namelist is absent
INTEGER, INTENT(IN) :: KLUOUT !< Logical unit for outputs
LOGICAL, OPTIONAL, INTENT(IN) :: LDDEFAULTVAL !< Must we initialize variables with default values (defaults to .TRUE.)
@@ -384,6 +389,7 @@ IF(LLDEFAULTVAL) THEN
XCOEF_AMPL_SAT = 5.
XCEI_MIN = 0.001E-06
XCEI_MAX = 0.01E-06
+ LTURB_PRECIP =.FALSE.
!
IF(HPROGRAM=='AROME') THEN
XTKEMIN=1.E-6
@@ -404,8 +410,8 @@ ENDIF
! -----------
!
IF(LLREADNAM) THEN
- CALL POSNAM_PHY(KUNITNML, 'NAM_TURBN', LDNEEDNAM, LLFOUND, KLUOUT)
- IF(LLFOUND) READ(UNIT=KUNITNML, NML=NAM_TURBn)
+ CALL POSNAM_PHY(TFILENAM, 'NAM_TURBN', LDNEEDNAM, LLFOUND)
+ IF(LLFOUND) READ(UNIT=TFILENAM%NLU, NML=NAM_TURBn)
ENDIF
!
!* 3. CHECKS
@@ -413,9 +419,9 @@ ENDIF
!
IF(LLCHECK) THEN
CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CTURBDIM', CTURBDIM, '1DIM', '3DIM')
- CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CTURBLEN', CTURBLEN, 'DELT', 'BL89', 'RM17', 'DEAR', 'BLKR', 'ADAP')
+ CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CTURBLEN', CTURBLEN, 'DELT', 'BL89', 'RM17', 'DEAR', 'BLKR', 'HM21')
CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CTOM', CTOM, 'NONE', 'TM06')
- CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CTURBLEN_CLOUD', CTURBLEN_CLOUD, 'DELT', 'BL89', 'RM17', 'DEAR', 'BLKR', 'ADAP')
+ CALL CHECK_NAM_VAL_CHAR(KLUOUT, 'CTURBLEN_CLOUD', CTURBLEN_CLOUD, 'DELT', 'BL89', 'RM17', 'DEAR', 'BLKR', 'HM21')
ENDIF
!
diff --git a/src/common/turb/mode_compute_updraft.F90 b/src/common/turb/mode_compute_updraft.F90
index 2f8cabf9a6276f55e41c8db4ee1eeee3acc3a508..04b96c802f419664a523e489259a4e19ad590102 100644
--- a/src/common/turb/mode_compute_updraft.F90
+++ b/src/common/turb/mode_compute_updraft.F90
@@ -190,7 +190,7 @@ REAL :: ZTMAX,ZRMAX ! control value
REAL, DIMENSION(D%NIJT) :: ZSURF
REAL, DIMENSION(D%NIJT,D%NKT) :: ZSHEAR,ZDUDZ,ZDVDZ ! vertical wind shear
!
-REAL, DIMENSION(D%NIJT,D%NKT) :: ZWK
+REAL, DIMENSION(D%NIJT,D%NKT) :: ZWK, KDEPTH
REAL, DIMENSION(D%NIJT,16) :: ZBUF
!
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
@@ -688,14 +688,24 @@ IF(OENTR_DETR) THEN
DO JIJ=IIJB,IIJE
PDEPTH(JIJ) = MAX(0., PZZ(JIJ,KKCTL(JIJ)) - PZZ(JIJ,KKLCL(JIJ)) )
END DO
-
+ IF(PARAMMF%LVERLIMUP) THEN
+ DO JK=1,IKT
+ DO JIJ=IIJB,IIJE
+ KDEPTH(JIJ,JK) = MIN(MAX(0., PZZ(JIJ,JK) - PZZ(JIJ,KKLCL(JIJ)) ), PDEPTH(JIJ))
+ END DO
+ END DO
+ END IF
!$mnh_expand_array(JIJ=IIJB:IIJE)
GWORK1(IIJB:IIJE)= (GTESTLCL(IIJB:IIJE) .AND. (PDEPTH(IIJB:IIJE) > ZDEPTH_MAX1) )
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
DO JK=1,IKT
!$mnh_expand_array(JIJ=IIJB:IIJE)
GWORK2(IIJB:IIJE,JK) = GWORK1(IIJB:IIJE)
- ZCOEF(IIJB:IIJE,JK) = (1.-(PDEPTH(IIJB:IIJE)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1))
+ IF(PARAMMF%LVERLIMUP) THEN
+ ZCOEF(IIJB:IIJE,JK) = (1.-(KDEPTH(IIJB:IIJE,JK)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1))
+ ELSE
+ ZCOEF(IIJB:IIJE,JK) = (1.-(PDEPTH(IIJB:IIJE)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1))
+ END IF
ZCOEF(IIJB:IIJE,JK)=MIN(MAX(ZCOEF(IIJB:IIJE,JK),0.),1.)
!$mnh_end_expand_array(JIJ=IIJB:IIJE)
ENDDO
diff --git a/src/common/turb/mode_ini_turb.F90 b/src/common/turb/mode_ini_turb.F90
index fc70cfaf945db2312defa67a60b887f9f3bea4af..fb860ba83cb79ac0a23d9b6093c80148a457e531 100644
--- a/src/common/turb/mode_ini_turb.F90
+++ b/src/common/turb/mode_ini_turb.F90
@@ -82,7 +82,7 @@ IF(XCED == XUNDEF) THEN
! Schmidt-Schumann (1989) = 0.845
! Cheng-Canuto-Howard (2002) = 0.845
! Rodier, Masson, Couvreux, Paci (2017) = 0.34
- IF(CTURBLEN=='RM17' .OR. CTURBLEN=='ADAP') THEN
+ IF(CTURBLEN=='RM17' .OR. CTURBLEN=='HM21') THEN
XCED=0.34
ELSE
IF(HPROGRAM=='AROME') THEN
diff --git a/src/common/turb/modi_turb.F90 b/src/common/turb/modi_turb.F90
index 9762dc484b7eff5c5945392ab8db5c685f7ac36e..e36d2aaa36d55d238aadb2590788274a135e419d 100644
--- a/src/common/turb/modi_turb.F90
+++ b/src/common/turb/modi_turb.F90
@@ -12,7 +12,7 @@ INTERFACE
& O2D,ONOMIXLG,OFLAT,OCOUPLES,OBLOWSNOW,OIBM,OFLYER, &
& OCOMPUTE_SRC, PRSNOW, &
& OOCEAN,ODEEPOC,ODIAG_IN_RUN, &
- & HTURBLEN_CL,HCLOUD, &
+ & HTURBLEN_CL,HCLOUD,HELEC, &
& PTSTEP,TPFILE, &
& PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
& PDIRCOSXW,PDIRCOSYW,PDIRCOSZW,PCOSSLOPE,PSINSLOPE, &
@@ -72,6 +72,7 @@ LOGICAL, INTENT(IN) :: ODIAG_IN_RUN ! switch to activate onlin
LOGICAL, INTENT(IN) :: OIBM ! switch to modity mixing length near building with IBM
CHARACTER(LEN=4), INTENT(IN) :: HTURBLEN_CL ! kind of cloud mixing length
CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+CHARACTER (LEN=4), INTENT(IN) :: HELEC ! Kind of cloud electricity scheme
REAL, INTENT(IN) :: PRSNOW ! Ratio for diffusion coeff. scalar (blowing snow)
REAL, INTENT(IN) :: PTSTEP ! timestep
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
diff --git a/src/common/turb/turb.F90 b/src/common/turb/turb.F90
index d3b1b2d216ef9e1227f4338e83c89bc76f5ecf03..394600ba8147319769a39d99c8f1b0bb8696c8e5 100644
--- a/src/common/turb/turb.F90
+++ b/src/common/turb/turb.F90
@@ -10,7 +10,7 @@
& O2D,ONOMIXLG,OFLAT,OCOUPLES,OBLOWSNOW,OIBM,OFLYER, &
& OCOMPUTE_SRC, PRSNOW, &
& OOCEAN,ODEEPOC,ODIAG_IN_RUN, &
- & HTURBLEN_CL,HCLOUD, &
+ & HTURBLEN_CL,HCLOUD,HELEC, &
& PTSTEP,TPFILE, &
& PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
& PDIRCOSXW,PDIRCOSYW,PDIRCOSZW,PCOSSLOPE,PSINSLOPE, &
@@ -234,6 +234,7 @@
! P. Wautelet 30/06/2020: move removal of negative scalar variables to Sources_neg_correct
! R. Honnert/V. Masson 02/2021: new mixing length in the grey zone
! J.L. Redelsperger 03/2021: add Ocean LES case
+! C. Barthe 08/02/2022: add helec in arguments of Sources_neg_correct
! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -243,7 +244,7 @@ USE MODE_SHUMAN_PHY, ONLY: MZF_PHY,MXF_PHY,MYF_PHY
USE YOMHOOK , ONLY: LHOOK, DR_HOOK, JPHOOK
!
USE MODD_BUDGET, ONLY: NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, &
- NBUDGET_RI, NBUDGET_SV1, &
+ NBUDGET_RI, NBUDGET_SV1, NBUDGET_RG, NBUDGET_RH, NBUDGET_RR, NBUDGET_RS, &
TBUDGETDATA, TBUDGETCONF_t
USE MODD_CST, ONLY: CST_t
USE MODD_CTURB, ONLY: CSTURB_t
@@ -313,6 +314,8 @@ LOGICAL, INTENT(IN) :: ODIAG_IN_RUN ! switch to activate onlin
LOGICAL, INTENT(IN) :: OIBM ! switch to modity mixing length near building with IBM
CHARACTER(LEN=4), INTENT(IN) :: HTURBLEN_CL ! kind of cloud mixing length
CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+CHARACTER (LEN=4), INTENT(IN) :: HELEC ! Kind of cloud electricity scheme
+
REAL, INTENT(IN) :: PRSNOW ! Ratio for diffusion coeff. scalar (blowing snow)
REAL, INTENT(IN) :: PTSTEP ! timestep
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
@@ -499,6 +502,11 @@ REAL :: ZALPHA ! work coefficient :
REAL :: ZTIME1, ZTIME2
TYPE(TFIELDMETADATA) :: TZFIELD
!
+REAL, DIMENSION(D%NIJT,D%NKT,MERGE(KSV+KRR,KSV,TURBN%LTURB_PRECIP)) :: ZWORKT, ZWORKS
+REAL, DIMENSION(D%NIJT, MERGE(KSV+KRR,KSV,TURBN%LTURB_PRECIP)) :: ZWORKSFSV
+REAL, DIMENSION(D%NIJT,D%NKT,MERGE(KSV+KRR,KSV,TURBN%LTURB_PRECIP)) :: ZWORKWSV
+INTEGER :: ISV
+!
!* 1.PRELIMINARIES
! -------------
!
@@ -538,6 +546,15 @@ END IF
!Save LIMA scalar variables sources
ZRSVS(IIJB:IIJE,1:IKT,1:KSV)=PRSVS(IIJB:IIJE,1:IKT,1:KSV)
!
+ISV=KSV
+IF (TURBN%LTURB_PRECIP) ISV=KSV+KRR
+ZWORKT(:,:,1:KSV)=PSVT(:,:,:)
+ZWORKS(:,:,1:KSV)=PRSVS(:,:,:)
+IF (TURBN%LTURB_PRECIP) ZWORKT(:,:,KSV+1:KSV+KRR)=PRT(:,:,:)
+IF (TURBN%LTURB_PRECIP) ZWORKS(:,:,KSV+1:KSV+KRR)=PRRS(:,:,:)
+ZWORKSFSV(:,:)=0.
+ZWORKWSV(:,:,:)=0.
+ZWORKSFSV(:,1:KSV)=PSFSV(:,:)
!
!----------------------------------------------------------------------------
!
@@ -992,29 +1009,29 @@ IF( BUCONF%LBUDGET_RI ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RI), 'VTU
IF( BUCONF%LBUDGET_SV ) THEN
DO JSV = 1, KSV
- CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + JSV), 'VTURB', PRSVS(:,:, JSV) )
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + JSV), 'VTURB', ZWORKS(:,:, JSV) )
END DO
END IF
CALL TURB_VER(D,CST,CSTURB,TURBN,NEBN,TLES, &
KRR,KRRL,KRRI,KGRADIENTS, &
OOCEAN, ODEEPOC, OCOMPUTE_SRC, &
- KSV,KSV_LGBEG,KSV_LGEND, &
+ ISV,KSV_LGBEG,KSV_LGEND, &
ZEXPL, O2D, ONOMIXLG, OFLAT, &
OCOUPLES,OBLOWSNOW,OFLYER, PRSNOW, &
PTSTEP,TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
PCOSSLOPE,PSINSLOPE, &
PRHODJ,PTHVREF,PSFU,PSFV, &
- PSFTH,PSFRV,PSFSV,PSFTH,PSFRV,PSFSV, &
+ PSFTH,PSFRV,ZWORKSFSV,PSFTH,PSFRV,ZWORKSFSV, &
ZCDUEFF,ZTAU11M,ZTAU12M,ZTAU33M, &
- PUT,PVT,PWT,ZUSLOPE,ZVSLOPE,PTHLT,PRT,PSVT, &
+ PUT,PVT,PWT,ZUSLOPE,ZVSLOPE,PTHLT,PRT,ZWORKT, &
PTKET,ZLM,PLENGTHM,PLENGTHH,ZLEPS,MFMOIST, &
ZLOCPEXNM,ZATHETA,ZAMOIST,PSRCT,ZFRAC_ICE, &
ZFWTH,ZFWR,ZFTH2,ZFR2,ZFTHR,PBL_DEPTH, &
PSBL_DEPTH,ZLMO,PHGRAD,PZS, &
- PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS, &
- PDP,PTP,PSIGS,PWTH,PWRC,PWSV, &
+ PRUS,PRVS,PRWS,PRTHLS,PRRS,ZWORKS, &
+ PDP,PTP,PSIGS,PWTH,PWRC,ZWORKWSV, &
PSSTFL, PSSTFL_C, PSSRFL_C,PSSUFL_C,PSSVFL_C, &
PSSUFL,PSSVFL )
@@ -1025,6 +1042,21 @@ CALL TURB_VER(D,CST,CSTURB,TURBN,NEBN,TLES, &
! IF (KSV_LIMA_NH.GT.0) PRSVS(:,:,KSV_LIMA_NH) = ZRSVS(:,:,KSV_LIMA_NH)
!END IF
+IF (TURBN%LTURB_PRECIP) THEN
+ IF( BUCONF%LBUDGET_RR ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RR), 'VTURB', PRRS(:,:, 3) )
+ IF( BUCONF%LBUDGET_RS ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RS), 'VTURB', PRRS(:,:, 5) )
+ IF( BUCONF%LBUDGET_RG ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RG), 'VTURB', PRRS(:,:, 6) )
+ IF( BUCONF%LBUDGET_RH .AND. KRR ==7) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RH), 'VTURB', PRRS(:,:, 7) )
+ IF (KRR.GE.3) PRRS(:,:,3)=ZWORKS(:,:,KSV+3)
+ IF (KRR.GE.5) PRRS(:,:,5)=ZWORKS(:,:,KSV+5)
+ IF (KRR.GE.6) PRRS(:,:,6)=ZWORKS(:,:,KSV+6)
+ IF (KRR.GE.7) PRRS(:,:,7)=ZWORKS(:,:,KSV+7)
+ IF( BUCONF%LBUDGET_RR ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RR), 'VTURB', PRRS(:,:, 3) )
+ IF( BUCONF%LBUDGET_RS ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RS), 'VTURB', PRRS(:,:, 5) )
+ IF( BUCONF%LBUDGET_RG ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RG), 'VTURB', PRRS(:,:, 6) )
+ IF( BUCONF%LBUDGET_RH .AND. KRR ==7) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RH), 'VTURB', PRRS(:,:, 7) )
+END IF
+
IF( BUCONF%LBUDGET_U ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_U), 'VTURB', PRUS(:,:) )
IF( BUCONF%LBUDGET_V ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_V), 'VTURB', PRVS(:,:) )
IF( BUCONF%LBUDGET_W ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_W), 'VTURB', PRWS(:,:) )
@@ -1055,7 +1087,7 @@ IF( BUCONF%LBUDGET_RI ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RI), 'VTUR
IF( BUCONF%LBUDGET_SV ) THEN
DO JSV = 1, KSV
- CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + JSV), 'VTURB', PRSVS(:,:, JSV) )
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + JSV), 'VTURB', ZWORKS(:,:, JSV) )
END DO
END IF
!
@@ -1090,11 +1122,11 @@ IF( TURBN%CTURBDIM == '3DIM' ) THEN
IF( BUCONF%LBUDGET_SV ) THEN
DO JSV = 1, KSV
- CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + JSV), 'HTURB', PRSVS(:,:, JSV) )
+ CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + JSV), 'HTURB', ZWORKS(:,:, JSV) )
END DO
END IF
CALL TURB_HOR_SPLT(D,CST,CSTURB, TURBN, NEBN, TLES, &
- KSPLIT, KRR, KRRL, KRRI, KSV,KSV_LGBEG,KSV_LGEND, &
+ KSPLIT, KRR, KRRL, KRRI, ISV,KSV_LGBEG,KSV_LGEND, &
PTSTEP,HLBCX,HLBCY, OFLAT,O2D, ONOMIXLG, &
OOCEAN,OCOMPUTE_SRC,OBLOWSNOW,PRSNOW, &
TPFILE, KHALO, &
@@ -1102,14 +1134,14 @@ IF( TURBN%CTURBDIM == '3DIM' ) THEN
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
PCOSSLOPE,PSINSLOPE, &
PRHODJ,PTHVREF, &
- PSFTH,PSFRV,PSFSV, &
+ PSFTH,PSFRV,ZWORKSFSV, &
ZCDUEFF,ZTAU11M,ZTAU12M,ZTAU22M,ZTAU33M, &
- PUT,PVT,PWT,ZUSLOPE,ZVSLOPE,PTHLT,PRT,PSVT, &
+ PUT,PVT,PWT,ZUSLOPE,ZVSLOPE,PTHLT,PRT,ZWORKT, &
PTKET,ZLM,ZLEPS, &
ZLOCPEXNM,ZATHETA,ZAMOIST,PSRCT,ZFRAC_ICE, &
PDP,PTP,PSIGS, &
ZTRH, &
- PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS )
+ PRUS,PRVS,PRWS,PRTHLS,PRRS,ZWORKS )
!
! IF (HCLOUD == 'LIMA') THEN
! IF (KSV_LIMA_NR.GT.0) PRSVS(:,:,KSV_LIMA_NR) = ZRSVS(:,:,KSV_LIMA_NR)
@@ -1117,6 +1149,21 @@ IF( TURBN%CTURBDIM == '3DIM' ) THEN
! IF (KSV_LIMA_NG.GT.0) PRSVS(:,:,KSV_LIMA_NG) = ZRSVS(:,:,KSV_LIMA_NG)
! IF (KSV_LIMA_NH.GT.0) PRSVS(:,:,KSV_LIMA_NH) = ZRSVS(:,:,KSV_LIMA_NH)
! END IF
+ !
+ IF (TURBN%LTURB_PRECIP) THEN
+ IF( BUCONF%LBUDGET_RR ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RR), 'HTURB', PRRS(:,:, 3) )
+ IF( BUCONF%LBUDGET_RS ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RS), 'HTURB', PRRS(:,:, 5) )
+ IF( BUCONF%LBUDGET_RG ) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RG), 'HTURB', PRRS(:,:, 6) )
+ IF( BUCONF%LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_INIT_PHY(D, TBUDGETS(NBUDGET_RH), 'HTURB', PRRS(:,:, 7) )
+ IF (KRR.GE.3) PRRS(:,:,3)=ZWORKS(:,:,KSV+3)
+ IF (KRR.GE.5) PRRS(:,:,5)=ZWORKS(:,:,KSV+5)
+ IF (KRR.GE.6) PRRS(:,:,6)=ZWORKS(:,:,KSV+6)
+ IF (KRR.GE.7) PRRS(:,:,7)=ZWORKS(:,:,KSV+7)
+ IF( BUCONF%LBUDGET_RR ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RR), 'HTURB', PRRS(:,:, 3) )
+ IF( BUCONF%LBUDGET_RS ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RS), 'HTURB', PRRS(:,:, 5) )
+ IF( BUCONF%LBUDGET_RG ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RG), 'HTURB', PRRS(:,:, 6) )
+ IF( BUCONF%LBUDGET_RH .AND. KRR==7) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_RH), 'HTURB', PRRS(:,:, 7) )
+ END IF
!
IF( BUCONF%LBUDGET_U ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_U), 'HTURB', PRUS(:,:) )
IF( BUCONF%LBUDGET_V ) CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_V), 'HTURB', PRVS(:,:) )
@@ -1148,7 +1195,7 @@ IF( TURBN%CTURBDIM == '3DIM' ) THEN
IF( BUCONF%LBUDGET_SV ) THEN
DO JSV = 1, KSV
- CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + JSV), 'HTURB', PRSVS(:,:, JSV) )
+ CALL BUDGET_STORE_END_PHY(D, TBUDGETS(NBUDGET_SV1 - 1 + JSV), 'HTURB', ZWORKS(:,:, JSV) )
END DO
END IF
END IF
@@ -1269,6 +1316,8 @@ IF ( TURBN%LTURB_DIAG .AND. TPFILE%LOPENED ) THEN
END IF
END IF
!
+PRSVS(:,:,:) = ZWORKS(:,:,1:KSV)
+IF (OFLYER) PWSV(:,:,:)=ZWORKWSV(:,:,1:KSV)
!* stores value of conservative variables & wind before turbulence tendency (AROME only)
IF(PRESENT(PDRUS_TURB)) THEN
!$mnh_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
@@ -1311,10 +1360,11 @@ IF ( KRRL >= 1 ) THEN
* PRRS(IIJB:IIJE,1:IKT,2)
!$mnh_end_expand_array(JIJ=IIJB:IIJE,JK=1:IKT)
END IF
-END IF
-
+END IF!
+!
+!
! Remove non-physical negative values (unnecessary in a perfect world) + corresponding budgets
-CALL SOURCES_NEG_CORRECT_PHY(D,KSV,HCLOUD, 'NETUR',KRR,PTSTEP,PPABST,PTHLT,PRT,PRTHLS,PRRS,PRSVS)
+CALL SOURCES_NEG_CORRECT_PHY(D,KSV,HCLOUD,HELEC,'NETUR',KRR,PTSTEP,PPABST,PTHLT,PRT,PRTHLS,PRRS,PRSVS)
!----------------------------------------------------------------------------
!
!* 9. LES averaged surface fluxes
diff --git a/src/lmdz/aux/modd_misc.F90 b/src/lmdz/aux/modd_misc.F90
index d2e39b49066543d99333dc833488181ff9083b4a..279fccab7194c6d060deee2d198e4456f5fa22ac 100644
--- a/src/lmdz/aux/modd_misc.F90
+++ b/src/lmdz/aux/modd_misc.F90
@@ -29,6 +29,9 @@ TYPE MISC_t
TYPE(TFILEDATA) :: ZTFILE
TYPE(TLES_t) :: TLES
CHARACTER(LEN=6) :: CPROGRAM
+ CHARACTER(LEN=4) :: CELEC='NONE' !< Name of the electricity scheme
+ LOGICAL :: OELEC=.FALSE. !< Lightning prognostic scheme
+ LOGICAL :: OSEDIM_BEARD=.FALSE. !< Switch for effect of electrical forces on sedim.
CHARACTER(LEN=4) ::CMICRO
CHARACTER(LEN=4) ::CSCONV
CHARACTER(LEN=4) ::CTURB
diff --git a/src/lmdz/ext/mode_init_phyex.F90 b/src/lmdz/ext/mode_init_phyex.F90
index 8fb3e00d8d65f52908c3fd38f3d935bf022c5d4f..d195da1c8125465c55cdce69724a87f63461af9d 100644
--- a/src/lmdz/ext/mode_init_phyex.F90
+++ b/src/lmdz/ext/mode_init_phyex.F90
@@ -41,6 +41,7 @@ SUBROUTINE INIT_PHYEX(PTSTEP, PDZMIN, PHYEX)
!
USE MODD_PHYEX, ONLY: PHYEX_t
USE MODI_INI_PHYEX, ONLY: INI_PHYEX
+USE MODD_IO, ONLY: TFILEDATA
USE print_control_mod, ONLY : lunout
!
IMPLICIT NONE
@@ -55,7 +56,8 @@ CHARACTER(LEN=4) :: CSCONV
CHARACTER(LEN=4) :: CTURB
INTEGER :: K
LOGICAL :: LREADNAM, LOPENED
-INTEGER :: IUNITNML, ILUN
+INTEGER :: ILUN
+TYPE(TFILEDATA) :: TPFILE
!
!General configuration, cannot be modified by namelist
CPROGRAM='LMDZ'
@@ -67,17 +69,17 @@ CTURB='TKEL'
!If the namelist file exists, we use it
INQUIRE(FILE='phyex.nam', EXIST=LREADNAM)
IF(LREADNAM) THEN
- IUNITNML=-1
+ TPFILE%NLU=-1
DO ILUN=1,100
INQUIRE(UNIT=ILUN, OPENED=LOPENED)
IF (.NOT. LOPENED) THEN
- IUNITNML=ILUN
+ TPFILE%NLU=ILUN
EXIT
END IF
END DO
- OPEN(ACTION='read', FILE='phyex.nam', UNIT=IUNITNML)
+ OPEN(ACTION='read', FILE='phyex.nam', UNIT=TPFILE%NLU)
ENDIF
-CALL INI_PHYEX(HPROGRAM=CPROGRAM, KUNITNML=IUNITNML, LDNEEDNAM=.FALSE., &
+CALL INI_PHYEX(HPROGRAM=CPROGRAM, TPFILE=TPFILE, LDNEEDNAM=.FALSE., &
&KLUOUT=lunout, KFROM=0, KTO=1, &
&PTSTEP=PTSTEP, PDZMIN=PDZMIN, &
&CMICRO=CMICRO, CSCONV=CSCONV, CTURB=CTURB, &
diff --git a/src/lmdz/ext/physiqex_mod.F90 b/src/lmdz/ext/physiqex_mod.F90
index ebbd45c1a3cb63f510e48b72917d1440d3db950e..f5b294c1c596ea49acbf21b9d5cc79794344cd7a 100644
--- a/src/lmdz/ext/physiqex_mod.F90
+++ b/src/lmdz/ext/physiqex_mod.F90
@@ -162,6 +162,7 @@ REAL, DIMENSION(klon,klev+2) :: ZDP ! Dynamic TKE production
REAL, DIMENSION(klon,klev+2) :: ZTDIFF ! Diffusion TKE term
REAL, DIMENSION(klon,klev+2) :: ZTDISS ! Dissipation TKE term
REAL, DIMENSION(0,0) :: PLENGTHM, PLENGTHH ! length scale from vdfexcu (HARMONIE-AROME)
+REAL :: ZTHVREFZIKB ! for electricity scheme interface
REAL, DIMENSION(klon,klev+2) :: ZDXX,ZDYY,ZDZX,ZDZY,ZZZ
REAL, DIMENSION(klon) :: ZDIRCOSXW,ZDIRCOSYW,ZDIRCOSZW,ZCOSSLOPE,ZSINSLOPE
! Shallow variables
@@ -480,7 +481,7 @@ CALL TURB(PHYEX%CST, PHYEX%CSTURB, PHYEX%MISC%TBUCONF, PHYEX%TURBN, PHYEX%NEBN,
& PHYEX%MISC%OBLOWSNOW,PHYEX%MISC%OIBM, &
& PHYEX%MISC%OFLYER, PHYEX%MISC%COMPUTE_SRC, PHYEX%MISC%PRSNOW, &
& PHYEX%MISC%OOCEAN, PHYEX%MISC%ODEEPOC, PHYEX%MISC%ODIAG_IN_RUN, &
- & PHYEX%TURBN%CTURBLEN_CLOUD, PHYEX%MISC%CMICRO, &
+ & PHYEX%TURBN%CTURBLEN_CLOUD, PHYEX%MISC%CMICRO, PHYEX%MISC%CELEC, &
& pdtphys,PHYEX%MISC%ZTFILE, &
& ZDXX(:,:),ZDYY(:,:),zdzm(:,:), &
& ZDZX(:,:),ZDZY(:,:),zz_flux(:,:), &
@@ -513,7 +514,11 @@ ENDIF
ZSEA=1.
ZTOWN=0.
ZCIT=0.
-CALL RAIN_ICE (D, PHYEX%CST, PHYEX%PARAM_ICEN, PHYEX%RAIN_ICE_PARAMN, PHYEX%RAIN_ICE_DESCRN, PHYEX%MISC%TBUCONF, &
+ZTHVREFZIKB=0
+CALL RAIN_ICE (D, PHYEX%CST, PHYEX%PARAM_ICEN, PHYEX%RAIN_ICE_PARAMN, PHYEX%RAIN_ICE_DESCRN, &
+ PHYEX%ELEC_PARAM, PHYEX%ELEC_DESCR, PHYEX%MISC%TBUCONF, &
+ OELEC=PHYEX%MISC%OELEC, OSEDIM_BEARD=PHYEX%MISC%OSEDIM_BEARD, &
+ PTHVREFZIKB=ZTHVREFZIKB, HCLOUD='ICE3', &
pdtphys, KRR, ZEXN, &
zdzf, PRHODJ, ZRHOD, ZEXN, ZPABST, ZCIT, ZCLDFR, &
ZHLC_HRC, ZHLC_HCF, ZHLI_HRI, ZHLI_HCF, &
diff --git a/src/mesonh/aux/mode_fill_dimphyexn.F90 b/src/mesonh/aux/mode_fill_dimphyexn.F90
index 5f965be18b7d6a788d424ab047032aded219485c..469ae60851a7750d02d1e5c37a652c0502c7901f 100644
--- a/src/mesonh/aux/mode_fill_dimphyexn.F90
+++ b/src/mesonh/aux/mode_fill_dimphyexn.F90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2022-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.
@@ -6,7 +6,7 @@
MODULE MODE_FILL_DIMPHYEX
IMPLICIT NONE
CONTAINS
-SUBROUTINE FILL_DIMPHYEX(YDDIMPHYEX, KIT, KJT, KKT, LTURB,KLES_TIMES)
+SUBROUTINE FILL_DIMPHYEX( YDDIMPHYEX, KIT, KJT, KKT, LTURB, KLES_TIMES, KLES_K )
! #########################
!
!!
@@ -29,6 +29,7 @@ SUBROUTINE FILL_DIMPHYEX(YDDIMPHYEX, KIT, KJT, KKT, LTURB,KLES_TIMES)
!! MODIFICATIONS
!! -------------
!! Original January 2022
+! P. Wautelet 04/10/2023: bugfix: set NKLES correctly
!
!-----------------------------------------------------------------
!* 0. DECLARATIONS
@@ -48,9 +49,11 @@ IMPLICIT NONE
!
TYPE(DIMPHYEX_t), INTENT(OUT) :: YDDIMPHYEX ! Structure to fill in
INTEGER, INTENT(IN) :: KIT, KJT, KKT ! Array dimensions
-INTEGER, INTENT(IN), OPTIONAL :: KLES_TIMES ! Number of LES data storage frequency
LOGICAL, INTENT(IN), OPTIONAL :: LTURB ! Flag to replace array dimensions I/JB and I/JE to the full array size
! needed if computation in HALO points (e.g. in turbulence)
+INTEGER, INTENT(IN), OPTIONAL :: KLES_TIMES ! number of LES computations in time
+INTEGER, INTENT(IN), OPTIONAL :: KLES_K ! number of vertical levels for LES diagnostics
+
LOGICAL :: YTURB
!
!* 0.2 declaration of local variables
@@ -75,7 +78,6 @@ YDDIMPHYEX%NKA=1
YDDIMPHYEX%NKU=KKT
YDDIMPHYEX%NKB=1+JPVEXT
YDDIMPHYEX%NKE=KKT-JPVEXT
-YDDIMPHYEX%NKLES=KKT-2*JPVEXT
YDDIMPHYEX%NKTB=1+JPVEXT
YDDIMPHYEX%NKTE=KKT-JPVEXT
!
@@ -103,6 +105,10 @@ YDDIMPHYEX%NLES_TIMES=0
IF (PRESENT(KLES_TIMES)) THEN
YDDIMPHYEX%NLES_TIMES = KLES_TIMES
END IF
+YDDIMPHYEX%NKLES=0
+IF (PRESENT(KLES_K)) THEN
+ YDDIMPHYEX%NKLES = KLES_K
+END IF
IF (LLES_MY_MASK) YDDIMPHYEX%NLESMASK = YDDIMPHYEX%NLESMASK + NLES_MASKS_USER
IF (LLES_NEB_MASK) YDDIMPHYEX%NLESMASK = YDDIMPHYEX%NLESMASK + 2
IF (LLES_CORE_MASK) YDDIMPHYEX%NLESMASK = YDDIMPHYEX%NLESMASK + 2
diff --git a/src/mesonh/aux/mode_posnam_phy.F90 b/src/mesonh/aux/mode_posnam_phy.F90
index 692ade32693b100f3b984d76bf0d0acc487cb84d..5f5f47b584035599d30348614e34ba5d729a79c4 100644
--- a/src/mesonh/aux/mode_posnam_phy.F90
+++ b/src/mesonh/aux/mode_posnam_phy.F90
@@ -3,22 +3,22 @@ IMPLICIT NONE
PRIVATE
PUBLIC :: POSNAM_PHY
CONTAINS
-SUBROUTINE POSNAM_PHY(KULNAM, CDNAML, LDNEEDNAM, LDFOUND, KLUOUT)
+SUBROUTINE POSNAM_PHY(TFILENAM, CDNAML, LDNEEDNAM, LDFOUND)
!Wrapper to call the Meso-NH version of posnam
USE MODE_MSG, ONLY: NVERB_FATAL, PRINT_MSG
USE MODE_POS, ONLY: POSNAM
+USE MODD_IO, ONLY: TFILEDATA
IMPLICIT NONE
-INTEGER, INTENT(IN) :: KULNAM !< Logical unit to access the namelist
+TYPE(TFILEDATA), INTENT(IN) :: TFILENAM !< Namelist file
CHARACTER(LEN=*), INTENT(IN) :: CDNAML !< Namelist name
LOGICAL, INTENT(IN) :: LDNEEDNAM !< True to abort if namelist is absent
LOGICAL, INTENT(OUT) :: LDFOUND !< True if namelist has been found
-INTEGER, INTENT(IN) :: KLUOUT !< Logical unit for output
-CALL POSNAM(KULNAM, CDNAML, LDFOUND, KLUOUT)
+CALL POSNAM(TFILENAM, CDNAML, LDFOUND)
IF(LDNEEDNAM .AND. .NOT. LDFOUND) CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'POSNAM_PHY', 'CANNOT LOCATE '//CDNAML)
END SUBROUTINE POSNAM_PHY
diff --git a/src/mesonh/aux/sources_neg_correct.f90 b/src/mesonh/aux/sources_neg_correct.f90
index 0302839408bb4045ae0b78adc29bdc812452c071..1abd41813466a70337c747a0e4ee19eb1b1cfd63 100644
--- a/src/mesonh/aux/sources_neg_correct.f90
+++ b/src/mesonh/aux/sources_neg_correct.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2020-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2020-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.
@@ -8,6 +8,7 @@
! P. Wautelet 30/06/2020: remove non-local corrections in resolved_cloud for NEGA => new local corrections here
! J. Escobar 21/07/2020: bug <-> array of size(:,:,:,0) => return if krr=0
! P. Wautelet 10/02/2021: budgets: add missing sources for NSV_C2R2BEG+3 budget
+! C. Barthe 03/02/2022: add corrections for electric charges
!-----------------------------------------------------------------
module mode_sources_neg_correct
@@ -19,7 +20,7 @@ public :: Sources_neg_correct,Sources_neg_correct_phy
contains
-subroutine Sources_neg_correct_phy(D, KSV, hcloud, hbudname, KRR, ptstep, ppabst, ptht, prt, prths, prrs, prsvs, prhodj)
+subroutine Sources_neg_correct_phy(D, KSV, hcloud, helec, hbudname, KRR, ptstep, ppabst, ptht, prt, prths, prrs, prsvs, prhodj)
!
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
!
@@ -28,22 +29,23 @@ IMPLICIT NONE
TYPE(DIMPHYEX_t), INTENT(IN) :: D
INTEGER, INTENT(IN) :: KSV
character(len=*), intent(in) :: hcloud ! Kind of cloud parameterization
+character(len=*), intent(in) :: helec ! Kind of cloud electricity parameterization
character(len=*), intent(in) :: hbudname ! Budget name
integer, intent(in) :: KRR ! Number of moist variables
real, intent(in) :: ptstep ! Timestep
real, dimension(D%NIT,D%NJT,D%NKT), intent(in) :: ppabst ! Absolute pressure at time t
real, dimension(D%NIT,D%NJT,D%NKT), intent(in) :: ptht ! Theta at time t
-real, dimension(D%NIT,D%NJT,D%NKT, KRR), intent(in) :: prt ! Moist variables at time t
+real, dimension(D%NIT,D%NJT,D%NKT, KRR), intent(in) :: prt ! Moist variables at time t
real, dimension(D%NIT,D%NJT,D%NKT), intent(inout) :: prths ! Source terms
-real, dimension(D%NIT,D%NJT,D%NKT, KRR), intent(inout) :: prrs ! Source terms
-real, dimension(D%NIT,D%NJT,D%NKT, KSV), intent(inout) :: prsvs ! Source terms
+real, dimension(D%NIT,D%NJT,D%NKT, KRR), intent(inout) :: prrs ! Source terms
+real, dimension(D%NIT,D%NJT,D%NKT, KSV), intent(inout) :: prsvs ! Source terms
real, dimension(D%NIT,D%NJT,D%NKT), intent(in), optional :: prhodj ! Dry density * jacobian
!
-CALL SOURCES_NEG_CORRECT(HCLOUD, 'NETUR',KRR,PTSTEP,PPABST,PTHT,PRT,PRTHS,PRRS,PRSVS)
+CALL SOURCES_NEG_CORRECT(HCLOUD, HELEC, 'NETUR',KRR,PTSTEP,PPABST,PTHT,PRT,PRTHS,PRRS,PRSVS)
!
end subroutine Sources_neg_correct_phy
!
-subroutine Sources_neg_correct( hcloud, hbudname, krr, ptstep, ppabst, ptht, prt, prths, prrs, prsvs, prhodj )
+subroutine Sources_neg_correct( hcloud, helec, hbudname, krr, ptstep, ppabst, ptht, prt, prths, prrs, prsvs, prhodj )
use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, &
lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
@@ -51,8 +53,10 @@ use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudg
NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
tbudgets
use modd_cst, only: xci, xcl, xcpd, xcpv, xlstt, xlvtt, xp00, xrd, xtt
-use modd_nsv, only: nsv_c2r2beg, nsv_c2r2end, nsv_lima_beg, nsv_lima_end, nsv_lima_nc, nsv_lima_nr,&
- nsv_lima_ni, nsv_lima_ns, nsv_lima_ng, nsv_lima_nh
+use modd_elec_descr, only: xrtmin_elec, xecharge
+use modd_nsv, only: nsv_c2r2beg, nsv_c2r2end, nsv_lima_beg, nsv_lima_end, nsv_lima_nc, nsv_lima_nr, &
+ nsv_lima_ni, nsv_lima_ns, nsv_lima_ng, nsv_lima_nh, &
+ nsv_elecbeg, nsv_elecend
use modd_param_lima, only: lspro_lima => lspro, &
xctmin_lima => xctmin, xrtmin_lima => xrtmin
@@ -62,6 +66,7 @@ use mode_msg
implicit none
character(len=*), intent(in) :: hcloud ! Kind of cloud parameterization
+character(len=*), intent(in) :: helec ! Kind of cloud electricity parameterization
character(len=*), intent(in) :: hbudname ! Budget name
integer, intent(in) :: krr ! Number of moist variables
real, intent(in) :: ptstep ! Timestep
@@ -80,6 +85,7 @@ integer :: jsv
integer :: isv_lima_end
real, dimension(:, :, :), allocatable :: zt, zexn, zlv, zls, zcph, zcor
logical, dimension(:, :, :), allocatable :: zmask
+real, dimension(:, :, :), allocatable :: zadd, zion_number !++cb--
if ( krr == 0 ) return
@@ -124,6 +130,11 @@ if ( hbudname /= 'NECON' .and. hbudname /= 'NEGA' ) then
call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) )
end do
end if
+ if ( lbudget_sv .and. helec(1:3) == 'ELE' ) then
+ do ji = nsv_elecbeg, nsv_elecend
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) )
+ end do
+ end if
else !NECON + NEGA
if ( .not. present( prhodj ) ) &
call Print_msg( NVERB_FATAL, 'GEN', 'Sources_neg_correct', 'optional argument prhodj not present' )
@@ -150,6 +161,11 @@ else !NECON + NEGA
call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) * prhodj(:, :, :) )
end do
end if
+ if ( lbudget_sv .and. helec(1:3) == 'ELE' ) then
+ do ji = nsv_elecbeg, nsv_elecend
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) * prhodj(:, :, :) )
+ end do
+ end if
end if
allocate( zt ( Size( prths, 1 ), Size( prths, 2 ), Size( prths, 3 ) ) )
@@ -166,6 +182,13 @@ if ( hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA' ) then
end if
zcph(:, :, :) = xcpd + xcpv * prt(:, :, :, 1)
+!++cb++
+if ( helec(1:3) == 'ELE' ) then
+ allocate( zadd( Size( prths, 1 ), Size( prths, 2 ), Size( prths, 3 ) ) )
+ allocate( zion_number( Size( prths, 1 ), Size( prths, 2 ), Size( prths, 3 ) ) )
+end if
+!--cb--
+
deallocate( zt )
CLOUD: select case ( hcloud )
@@ -195,12 +218,29 @@ CLOUD: select case ( hcloud )
jrmax = Size( prrs, 4 )
end if
do jr = 4, jrmax
- where ( prrs(:, :, :, jr) < 0.)
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, jr)
- prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, jr) * zls(:, :, :) / &
- ( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, jr) = 0.
- end where
+ if ( helec(1:3) == 'ELE' ) then
+ where ( prrs(:, :, :, jr) < 0.)
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, jr)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, jr) * zls(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, jr) = 0.
+ !
+ zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg+jr-1)) / xecharge
+ zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg+jr-1))
+ prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+ zadd(:,:,:) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+ (1. - zadd(:,:,:)) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecbeg+jr-1) = 0.0
+ end where
+ else
+ where ( prrs(:, :, :, jr) < 0.)
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, jr)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, jr) * zls(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, jr) = 0.
+ end where
+ end if
end do
!
! cloud
@@ -210,34 +250,119 @@ CLOUD: select case ( hcloud )
jrmax = 3
end if
do jr = 2, jrmax
- where ( prrs(:, :, :, jr) < 0.)
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, jr)
- prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, jr) * zlv(:, :, :) / &
- ( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, jr) = 0.
- end where
+ if ( helec(1:3) == 'ELE' ) then
+ where ( prrs(:, :, :, jr) < 0.)
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, jr)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, jr) * zlv(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, jr) = 0.
+ !
+ zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg+jr-1)) / xecharge
+ zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg+jr-1))
+ prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+ zadd(:,:,:) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+ (1. - zadd(:,:,:)) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecbeg+jr-1) = 0.0
+ end where
+ else
+ where ( prrs(:, :, :, jr) < 0.)
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, jr)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, jr) * zlv(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, jr) = 0.
+ end where
+ end if
end do
!
! if rc or ri are positive, we can correct negative rv
+ if ( helec(1:3) == 'ELE' ) then
! cloud
- where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 2) > 0. )
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 2)
- prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 2) * zlv(:, :, :) / &
- ( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, 2) = 0.
- end where
+ where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 2) > 0. )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 2)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 2) * zlv(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 2) = 0.
+ !
+ zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg+1)) / xecharge
+ zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg+1))
+ prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+ zadd(:,:,:) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+ (1. - zadd(:,:,:)) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecbeg+1) = 0.0
+ end where
! ice
- if ( krr > 3 ) then
- allocate( zcor( Size( prths, 1 ), Size( prths, 2 ), Size( prths, 3 ) ) )
- where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 4) > 0. )
- zcor(:, :, :) = Min( -prrs(:, :, :, 1), prrs(:, :, :, 4) )
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + zcor(:, :, :)
- prths(:, :, :) = prths(:, :, :) - zcor(:, :, :) * zls(:, :, :) / &
+ if ( krr > 3 ) then
+ allocate( zcor( Size( prths, 1 ), Size( prths, 2 ), Size( prths, 3 ) ) )
+ where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 4) > 0. )
+ zcor(:, :, :) = Min( -prrs(:, :, :, 1), prrs(:, :, :, 4) )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + zcor(:, :, :)
+ prths(:, :, :) = prths(:, :, :) - zcor(:, :, :) * zls(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 4) = prrs(:, :, :, 4) - zcor(:, :, :)
+ !
+ zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg+3)) / xecharge
+ zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg+3))
+ prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+ zadd(:,:,:) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+ (1. - zadd(:,:,:)) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecbeg+3) = 0.0
+ end where
+ deallocate(zcor)
+ end if
+ else
+! cloud
+ where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 2) > 0. )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 2)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 2) * zlv(:, :, :) / &
( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, 4) = prrs(:, :, :, 4) - zcor(:, :, :)
+ prrs(:, :, :, 2) = 0.
end where
+! ice
+ if ( krr > 3 ) then
+ allocate( zcor( Size( prths, 1 ), Size( prths, 2 ), Size( prths, 3 ) ) )
+ where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 4) > 0. )
+ zcor(:, :, :) = Min( -prrs(:, :, :, 1), prrs(:, :, :, 4) )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + zcor(:, :, :)
+ prths(:, :, :) = prths(:, :, :) - zcor(:, :, :) * zls(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 4) = prrs(:, :, :, 4) - zcor(:, :, :)
+ end where
+ deallocate(zcor)
+ end if
end if
!
+!++cb++ 08/06/23 deplace a la fin pour traiter aussi le cas de lima
+! cascade the electric charge in the absence of hydrometeor
+! if ( helec(1:3) == 'ELE' ) then
+! do jr = krr, 5, -1
+! where(prrs(:,:,:,jr) < xrtmin_elec(jr))
+! prsvs(:,:,:,nsv_elecbeg-2+jr) = prsvs(:,:,:,nsv_elecbeg-2+jr) + &
+! prsvs(:,:,:,nsv_elecbeg-1+jr)
+! prsvs(:,:,:,nsv_elecbeg-1+jr) = 0.0
+! end where
+! end do
+! jr = 3
+! where(prrs(:,:,:,jr) < xrtmin_elec(jr))
+! prsvs(:,:,:,nsv_elecbeg-2+jr) = prsvs(:,:,:,nsv_elecbeg-2+jr) + &
+! prsvs(:,:,:,nsv_elecbeg-1+jr)
+! prsvs(:,:,:,nsv_elecbeg-1+jr) = 0.0
+! end where
+! do jr = 4, 2, -2
+! where(prrs(:,:,:,jr) < xrtmin_elec(jr))
+! zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg-1+jr)) / xecharge
+! zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg-1+jr))
+! prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+! zadd(:,:,:) * zion_number(:,:,:)
+! prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+! (1. - zadd(:,:,:)) * zion_number(:,:,:)
+! prsvs(:,:,:,nsv_elecbeg-1+jr) = 0.0
+! end where
+! end do
+! end if
+!--cb--
!
case( 'C2R2', 'KHKO' )
where ( prrs(:, :, :, 2) < 0. .or. prsvs(:, :, :, nsv_c2r2beg + 1) < 0. )
@@ -262,110 +387,246 @@ CLOUD: select case ( hcloud )
!
!
case( 'LIMA' )
- allocate( zmask ( Size( prths, 1 ), Size( prths, 2 ), Size( prths, 3 ) ) )
+ allocate( zmask ( Size( prths, 1 ), Size( prths, 2 ), Size( prths, 3 ) ) )
+!
! Correction where rc<0 or Nc<0
- if ( krr.GE.2 ) then
- zmask(:,:,:)=(prrs(:, :, :, 2) < xrtmin_lima(2) / ptstep)
- if (nsv_lima_nc.gt.0) zmask(:,:,:)=(zmask(:,:,:) .or. prsvs(:, :, :, nsv_lima_nc) < xctmin_lima(2) / ptstep )
+ if ( krr.GE.2 ) then
+ zmask(:,:,:)=(prrs(:, :, :, 2) < xrtmin_lima(2) / ptstep)
+ if (nsv_lima_nc.gt.0) zmask(:,:,:)=(zmask(:,:,:) .or. prsvs(:, :, :, nsv_lima_nc) < xctmin_lima(2) / ptstep )
+ if ( helec == 'ELE4' ) then
where ( zmask(:,:,:) )
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 2)
- prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 2) * zlv(:, :, :) / &
- ( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, 2) = 0.
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 2)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 2) * zlv(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 2) = 0.
+ !
+ zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg+1)) / xecharge
+ zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg+1))
+ prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+ zadd(:,:,:) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+ (1. - zadd(:,:,:)) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecbeg+1) = 0.0
end where
where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 2) > 0. )
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 2)
- prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 2) * zlv(:, :, :) / &
- ( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, 2) = 0.
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 2)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 2) * zlv(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 2) = 0.
+ !
+ zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg+1)) / xecharge
+ zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg+1))
+ prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+ zadd(:,:,:) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+ (1. - zadd(:,:,:)) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecbeg+1) = 0.0
+ end where
+ else
+ where ( zmask(:,:,:) )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 2)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 2) * zlv(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 2) = 0.
end where
- if (nsv_lima_nc.gt.0) then
- where (prrs(:, :, :, 2) == 0.) prsvs(:, :, :, nsv_lima_nc) = 0.
- end if
- end if
+ where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 2) > 0. )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 2)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 2) * zlv(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 2) = 0.
+ end where
+ end if
+ if (nsv_lima_nc.gt.0) then
+ where (prrs(:, :, :, 2) == 0.) prsvs(:, :, :, nsv_lima_nc) = 0.
+ end if
+ end if
+!
! Correction where rr<0 or Nr<0
- if ( krr.GE.3 .and. hbudname.ne.'NETUR' ) then
- zmask(:,:,:)=(prrs(:, :, :, 3) < xrtmin_lima(3) / ptstep)
- if (nsv_lima_nr.gt.0) zmask(:,:,:)=(zmask(:,:,:) .or. prsvs(:, :, :, nsv_lima_nr) < xctmin_lima(3) / ptstep )
+ if ( krr.GE.3 .and. hbudname.ne.'NETUR' ) then
+ zmask(:,:,:)=(prrs(:, :, :, 3) < xrtmin_lima(3) / ptstep)
+ if (nsv_lima_nr.gt.0) zmask(:,:,:)=(zmask(:,:,:) .or. prsvs(:, :, :, nsv_lima_nr) < xctmin_lima(3) / ptstep )
+ where ( zmask(:,:,:) )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 3)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 3) * zlv(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 3) = 0.
+ end where
+ if ( helec == 'ELE4' ) then
where ( zmask(:,:,:) )
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 3)
- prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 3) * zlv(:, :, :) / &
- ( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, 3) = 0.
+ zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg+2)) / xecharge
+ zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg+2))
+ prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+ zadd(:,:,:) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+ (1. - zadd(:,:,:)) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecbeg+2) = 0.0
end where
- if (nsv_lima_nr.gt.0) then
- where (prrs(:, :, :, 3) == 0.) prsvs(:, :, :, nsv_lima_nr) = 0.
- end if
- end if
+ end if
+ if (nsv_lima_nr.gt.0) then
+ where (prrs(:, :, :, 3) == 0.) prsvs(:, :, :, nsv_lima_nr) = 0.
+ end if
+ end if
+!
! Correction where ri<0 or Ni<0
- if ( krr.GE.4 ) then
- zmask(:,:,:)=(prrs(:, :, :, 4) < xrtmin_lima(4) / ptstep)
- if (nsv_lima_ni.gt.0) zmask(:,:,:)=(zmask(:,:,:) .or. prsvs(:, :, :, nsv_lima_ni) < xctmin_lima(4) / ptstep)
+ if ( krr.GE.4 ) then
+ zmask(:,:,:)=(prrs(:, :, :, 4) < xrtmin_lima(4) / ptstep)
+ if (nsv_lima_ni.gt.0) zmask(:,:,:)=(zmask(:,:,:) .or. prsvs(:, :, :, nsv_lima_ni) < xctmin_lima(4) / ptstep)
+ where ( zmask(:,:,:) )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 4)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 4) * zls(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 4) = 0.
+ end where
+ if ( helec == 'ELE4' ) then
where ( zmask(:,:,:) )
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 4)
- prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 4) * zls(:, :, :) / &
- ( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, 4) = 0.
+ zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg+3)) / xecharge
+ zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg+3))
+ prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+ zadd(:,:,:) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+ (1. - zadd(:,:,:)) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecbeg+3) = 0.0
end where
- allocate( zcor( Size( prths, 1 ), Size( prths, 2 ), Size( prths, 3 ) ) )
where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 4) > 0. )
- zcor(:, :, :) = Min( -prrs(:, :, :, 1), prrs(:, :, :, 4) )
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + zcor(:, :, :)
- prths(:, :, :) = prths(:, :, :) - zcor(:, :, :) * zls(:, :, :) / &
- ( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, 4) = prrs(:, :, :, 4) - zcor(:, :, :)
+ zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg+3)) / xecharge
+ zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg+3))
+ prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+ zadd(:,:,:) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+ (1. - zadd(:,:,:)) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecbeg+3) = 0.0
end where
- deallocate( zcor )
- if (nsv_lima_ni.gt.0) then
- where (prrs(:, :, :, 4) == 0.) prsvs(:, :, :, nsv_lima_ni) = 0.
- end if
- end if
+ end if
+ allocate( zcor( Size( prths, 1 ), Size( prths, 2 ), Size( prths, 3 ) ) )
+ where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 4) > 0. )
+ zcor(:, :, :) = Min( -prrs(:, :, :, 1), prrs(:, :, :, 4) )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + zcor(:, :, :)
+ prths(:, :, :) = prths(:, :, :) - zcor(:, :, :) * zls(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 4) = prrs(:, :, :, 4) - zcor(:, :, :)
+ end where
+ deallocate( zcor )
+ if (nsv_lima_ni.gt.0) then
+ where (prrs(:, :, :, 4) == 0.) prsvs(:, :, :, nsv_lima_ni) = 0.
+ end if
+ end if
+!
! Snow
- if ( krr.GE.5 .and. hbudname.ne.'NETUR' ) then
- zmask(:,:,:)=(prrs(:, :, :, 5) < xrtmin_lima(5) / ptstep)
- if (nsv_lima_ns.gt.0) zmask(:,:,:)=(zmask(:,:,:) .or. prsvs(:, :, :, nsv_lima_ns) < xctmin_lima(5) / ptstep )
+ if ( krr.GE.5 .and. hbudname.ne.'NETUR' ) then
+ zmask(:,:,:)=(prrs(:, :, :, 5) < xrtmin_lima(5) / ptstep)
+ if (nsv_lima_ns.gt.0) zmask(:,:,:)=(zmask(:,:,:) .or. prsvs(:, :, :, nsv_lima_ns) < xctmin_lima(5) / ptstep )
+ where ( zmask(:,:,:) )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 5)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 5) * zls(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 5) = 0.
+ end where
+ if ( helec == 'ELE4' ) then
where ( zmask(:,:,:) )
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 5)
- prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 5) * zls(:, :, :) / &
- ( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, 5) = 0.
+ zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg+4)) / xecharge
+ zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg+4))
+ prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+ zadd(:,:,:) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+ (1. - zadd(:,:,:)) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecbeg+4) = 0.0
end where
- if (nsv_lima_ns.gt.0) then
- where (prrs(:, :, :, 5) == 0.) prsvs(:, :, :, nsv_lima_ns) = 0.
- end if
- end if
+ end if
+ if (nsv_lima_ns.gt.0) then
+ where (prrs(:, :, :, 5) == 0.) prsvs(:, :, :, nsv_lima_ns) = 0.
+ end if
+ end if
+!
! Graupel
- if ( krr.GE.6 .and. hbudname.ne.'NETUR' ) then
- zmask(:,:,:)=(prrs(:, :, :, 6) < xrtmin_lima(6) / ptstep)
- if (nsv_lima_ng.gt.0) zmask(:,:,:)=(zmask(:,:,:) .or. prsvs(:, :, :, nsv_lima_ng) < xctmin_lima(6) / ptstep )
+ if ( krr.GE.6 .and. hbudname.ne.'NETUR' ) then
+ zmask(:,:,:)=(prrs(:, :, :, 6) < xrtmin_lima(6) / ptstep)
+ if (nsv_lima_ng.gt.0) zmask(:,:,:)=(zmask(:,:,:) .or. prsvs(:, :, :, nsv_lima_ng) < xctmin_lima(6) / ptstep )
+ where ( zmask(:,:,:) )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 6)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 6) * zls(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 6) = 0.
+ end where
+ if ( helec == 'ELE4' ) then
where ( zmask(:,:,:) )
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 6)
- prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 6) * zls(:, :, :) / &
- ( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, 6) = 0.
+ zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg+5)) / xecharge
+ zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg+5))
+ prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+ zadd(:,:,:) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+ (1. - zadd(:,:,:)) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecbeg+5) = 0.0
end where
- if (nsv_lima_ng.gt.0) then
- where (prrs(:, :, :, 6) == 0.) prsvs(:, :, :, nsv_lima_ng) = 0.
- end if
- end if
+ end if
+ if (nsv_lima_ng.gt.0) then
+ where (prrs(:, :, :, 6) == 0.) prsvs(:, :, :, nsv_lima_ng) = 0.
+ end if
+ end if
+!
! Hail
- if ( krr.GE.7 .and. hbudname.ne.'NETUR' ) then
- zmask(:,:,:)=(prrs(:, :, :, 7) < xrtmin_lima(7) / ptstep)
- if (nsv_lima_nh.gt.0) zmask(:,:,:)=(zmask(:,:,:) .or. prsvs(:, :, :, nsv_lima_nh) < xctmin_lima(7) / ptstep )
+ if ( krr.GE.7 .and. hbudname.ne.'NETUR' ) then
+ zmask(:,:,:)=(prrs(:, :, :, 7) < xrtmin_lima(7) / ptstep)
+ if (nsv_lima_nh.gt.0) zmask(:,:,:)=(zmask(:,:,:) .or. prsvs(:, :, :, nsv_lima_nh) < xctmin_lima(7) / ptstep )
+ where ( zmask(:,:,:) )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 7)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 7) * zls(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 7) = 0.
+ end where
+ if ( helec == 'ELE4' ) then
where ( zmask(:,:,:) )
- prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 7)
- prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 7) * zls(:, :, :) / &
- ( zcph(:, :, :) * zexn(:, :, :) )
- prrs(:, :, :, 7) = 0.
+ zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg+6)) / xecharge
+ zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg+6))
+ prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+ zadd(:,:,:) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+ (1. - zadd(:,:,:)) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecbeg+6) = 0.0
end where
- if (nsv_lima_nh.gt.0) then
- where (prrs(:, :, :, 7) == 0.) prsvs(:, :, :, nsv_lima_nh) = 0.
- end if
- end if
+ end if
+ if (nsv_lima_nh.gt.0) then
+ where (prrs(:, :, :, 7) == 0.) prsvs(:, :, :, nsv_lima_nh) = 0.
+ end if
+ end if
!
- prsvs(:, :, :, nsv_lima_beg : isv_lima_end) = Max( 0.0, prsvs(:, :, :, nsv_lima_beg : isv_lima_end) )
- deallocate(zmask)
+ prsvs(:, :, :, nsv_lima_beg : isv_lima_end) = Max( 0.0, prsvs(:, :, :, nsv_lima_beg : isv_lima_end) )
+ deallocate(zmask)
end select CLOUD
+!
+! cascade the electric charge in the absence of hydrometeor
+if ( helec(1:3) == 'ELE' ) then
+ do jr = krr, 5, -1
+ where(prrs(:,:,:,jr) < xrtmin_elec(jr))
+ prsvs(:,:,:,nsv_elecbeg-2+jr) = prsvs(:,:,:,nsv_elecbeg-2+jr) + &
+ prsvs(:,:,:,nsv_elecbeg-1+jr)
+ prsvs(:,:,:,nsv_elecbeg-1+jr) = 0.0
+ end where
+ end do
+ jr = 3
+ where(prrs(:,:,:,jr) < xrtmin_elec(jr))
+ prsvs(:,:,:,nsv_elecbeg-2+jr) = prsvs(:,:,:,nsv_elecbeg-2+jr) + &
+ prsvs(:,:,:,nsv_elecbeg-1+jr)
+ prsvs(:,:,:,nsv_elecbeg-1+jr) = 0.0
+ end where
+ do jr = 4, 2, -2
+ where(prrs(:,:,:,jr) < xrtmin_elec(jr))
+ zion_number(:,:,:) = abs(prsvs(:,:,:,nsv_elecbeg-1+jr)) / xecharge
+ zadd(:,:,:) = 0.5 + sign(0.5, prsvs(:,:,:,nsv_elecbeg-1+jr))
+ prsvs(:,:,:,nsv_elecbeg) = prsvs(:,:,:,nsv_elecbeg) + &
+ zadd(:,:,:) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecend) = prsvs(:,:,:,nsv_elecend) + &
+ (1. - zadd(:,:,:)) * zion_number(:,:,:)
+ prsvs(:,:,:,nsv_elecbeg-1+jr) = 0.0
+ end where
+ end do
+end if
+!
+if (allocated(zion_number)) deallocate( zion_number )
+if (allocated(zadd)) deallocate( zadd )
+if (allocated(zls)) deallocate( zls )
+deallocate( zexn )
+deallocate( zlv )
+deallocate( zcph )
if ( hbudname /= 'NECON' .and. hbudname /= 'NEGA' ) then
@@ -397,6 +658,11 @@ if ( hbudname /= 'NECON' .and. hbudname /= 'NEGA' ) then
call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) )
end do
end if
+ if ( lbudget_sv .and. helec(1:3) == 'ELE' ) then
+ do ji = nsv_elecbeg, nsv_elecend
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) )
+ end do
+ end if
else !NECON + NEGA
if ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. &
hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) then
@@ -420,6 +686,11 @@ else !NECON + NEGA
call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) * prhodj(:, :, :) )
end do
end if
+ if ( lbudget_sv .and. helec(1:3) == 'ELE' ) then
+ do ji = nsv_elecbeg, nsv_elecend
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) * prhodj(:, :, :) )
+ end do
+ end if
end if
end subroutine Sources_neg_correct
diff --git a/src/mesonh/ext/advection_metsv.f90 b/src/mesonh/ext/advection_metsv.f90
deleted file mode 100644
index 8473c5a3b9f58609ef24a788a49f2153056a0380..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/advection_metsv.f90
+++ /dev/null
@@ -1,719 +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_ADVECTION_METSV
-! ###########################
-!
-INTERFACE
- SUBROUTINE ADVECTION_METSV (TPFILE, HUVW_ADV_SCHEME, &
- HMET_ADV_SCHEME,HSV_ADV_SCHEME, HCLOUD, KSPLIT, &
- OSPLIT_CFL, PSPLIT_CFL, OCFL_WRIT, &
- HLBCX, HLBCY, KRR, KSV, TPDTCUR, PTSTEP, &
- PUT, PVT, PWT, PTHT, PRT, PTKET, PSVT, PPABST, &
- PTHVREF, PRHODJ, PDXX, PDYY, PDZZ, PDZX, PDZY, &
- PRTHS, PRRS, PRTKES, PRSVS, &
- PRTHS_CLD, PRRS_CLD, PRSVS_CLD, PRTKES_ADV )
-!
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_TYPE_DATE, ONLY: DATE_TIME
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-CHARACTER(LEN=6), INTENT(IN) :: HMET_ADV_SCHEME, & ! Control of the
- HSV_ADV_SCHEME, & ! scheme applied
- HUVW_ADV_SCHEME
-CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of cloud parameterization
-!
-INTEGER, INTENT(INOUT):: KSPLIT ! Number of time splitting
- ! for PPM advection
-LOGICAL, INTENT(IN) :: OSPLIT_CFL ! flag to automatically chose number of iterations
-REAL, INTENT(IN) :: PSPLIT_CFL ! maximum CFL to automatically chose number of iterations
-LOGICAL, INTENT(IN) :: OCFL_WRIT ! flag to write CFL fields in output files
-!
-CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
-!
-TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! current date and time
-REAL, INTENT(IN) :: PTSTEP
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT , PVT , PWT
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET, PRHODJ
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT , PSVT
- ! Variables at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Temperature
- ! of the reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDZX,PDZY
- ! metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS, PRTKES
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS , PRSVS
- ! Sources terms
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTHS_CLD
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRRS_CLD,PRSVS_CLD
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRTKES_ADV ! Advection TKE source term
-!
-END SUBROUTINE ADVECTION_METSV
-!
-END INTERFACE
-!
-END MODULE MODI_ADVECTION_METSV
-! ##########################################################################
- SUBROUTINE ADVECTION_METSV (TPFILE, HUVW_ADV_SCHEME, &
- HMET_ADV_SCHEME,HSV_ADV_SCHEME, HCLOUD, KSPLIT, &
- OSPLIT_CFL, PSPLIT_CFL, OCFL_WRIT, &
- HLBCX, HLBCY, KRR, KSV, TPDTCUR, PTSTEP, &
- PUT, PVT, PWT, PTHT, PRT, PTKET, PSVT, PPABST, &
- PTHVREF, PRHODJ, PDXX, PDYY, PDZZ, PDZX, PDZY, &
- PRTHS, PRRS, PRTKES, PRSVS, &
- PRTHS_CLD, PRRS_CLD, PRSVS_CLD, PRTKES_ADV )
-! ##########################################################################
-!
-!!**** *ADVECTION_METSV * - routine to call the specialized advection routines
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to control the advection routines.
-!! For that, it is first necessary to compute the metric coefficients
-!! and the contravariant components of the momentum.
-!!
-!!** METHOD
-!! ------
-!! Once the scheme is selected, it is applied to the following group of
-!! variables: METeorologicals (temperature, water substances, TKE,
-!! dissipation TKE) and Scalar Variables. It is possible to select different
-!! advection schemes for each group of variables.
-!!
-!! EXTERNAL
-!! --------
-!! CONTRAV : computes the contravariant components.
-!! ADVECUVW : computes the advection terms for momentum.
-!! ADVECSCALAR : computes the advection terms for scalar fields.
-!! ADD3DFIELD_ll : add a field to 3D-list
-!! ADVEC_4TH_ORDER : 4th order advection scheme
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! NONE
-!!
-!! REFERENCE
-!! ---------
-!! Book1 and book2 ( routine ADVECTION )
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! J.-P. Lafore * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 06/07/94
-!! 01/04/95 (Ph. Hereil J. Nicolau) add the model number
-!! 23/10/95 (J. Vila and JP Lafore) advection schemes scalar
-!! 16/01/97 (JP Pinty) change presentation
-!! 30/04/98 (J. Stein P Jabouille) extrapolation for the cyclic
-!! case and parallelisation
-!! 24/06/99 (P Jabouille) case of NHALO>1
-!! 25/10/05 (JP Pinty) 4th order scheme
-!! 24/04/06 (C.Lac) Split scalar and passive
-!! tracer routines
-!! 08/06 (T.Maric) PPM scheme
-!! 04/2011 (V.Masson & C. Lac) splits the routine and add time splitting
-!! 04/2014 (C.Lac) adaptation of time
-!! splitting for L1D and L2D
-!! 09/2014 (G.Delautier) close OUTPUT_LISTING before STOP
-!! 04/2015 (J.Escobar) remove/commente some NHALO=1 test
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! J.Escobar : 01/10/2015 : add computation of CFL for L1D case
-!! 04/2016 (C.Lac) : correction of negativity for KHKO
-!! 10/2016 (C.Lac) Correction on the flag for Strang splitting
-!! to insure reproducibility between START and RESTA
-! V. Vionnet 07/2017: add advection of 2D variables at the surface for the blowing snow scheme
-! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
-! 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
-! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
-! P. Wautelet 11/06/2020: bugfix: correct PRSVS array indices
-! P. Wautelet + Benoît Vié 06/2020: improve removal of negative scalar variables + adapt the corresponding budgets
-! P. Wautelet 30/06/2020: move removal of negative scalar variables to Sources_neg_correct
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-use modd_budget, only: lbudget_th, lbudget_tke, lbudget_rv, lbudget_rc, &
- lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
- NBUDGET_TH, NBUDGET_TKE, NBUDGET_RV, NBUDGET_RC, &
- NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
- tbudgets
-USE MODD_CST
-USE MODD_TURB_n, ONLY: XTKEMIN
-USE MODD_CONF, ONLY: LNEUTRAL,NHALO,L1D, L2D
-use modd_field, only: tfieldmetadata, TYPEREAL
-USE MODD_IBM_PARAM_n, ONLY: LIBM,XIBM_LS,XIBM_EPSI
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_NSV
-USE MODD_PARAM_LIMA
-USE MODD_PARAM_n
-USE MODD_TYPE_DATE, ONLY: DATE_TIME
-USE MODD_BLOWSNOW
-USE MODD_BLOWSNOW_n
-USE MODD_PARAMETERS
-USE MODD_REF_n, ONLY: XRHODJ,XRHODREF
-!
-use mode_budget, only: Budget_store_init, Budget_store_end
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODE_ll
-USE MODE_MSG
-use mode_sources_neg_correct, only: Sources_neg_correct
-!
-USE MODI_ADV_BOUNDARIES
-USE MODI_CONTRAV
-USE MODI_GET_HALO
-USE MODI_PPM_RHODJ
-USE MODI_PPM_MET
-USE MODI_PPM_SCALAR
-!
-!
-!-------------------------------------------------------------------------------
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-CHARACTER(LEN=6), INTENT(IN) :: HMET_ADV_SCHEME, & ! Control of the
- HSV_ADV_SCHEME, & ! scheme applied
- HUVW_ADV_SCHEME
-CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of cloud parameterization
-!
-INTEGER, INTENT(INOUT):: KSPLIT ! Number of time splitting
- ! for PPM advection
-LOGICAL, INTENT(IN) :: OSPLIT_CFL ! flag to automatically chose number of iterations
-REAL, INTENT(IN) :: PSPLIT_CFL ! maximum CFL to automatically chose number of iterations
-LOGICAL, INTENT(IN) :: OCFL_WRIT ! flag to write CFL fields in output files
-!
-CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
-!
-TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! current date and time
-REAL, INTENT(IN) :: PTSTEP
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT , PVT , PWT
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET, PRHODJ
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT , PSVT
- ! Variables at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Temperature
- ! of the reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDZX,PDZY
- ! metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS, PRTKES
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS , PRSVS
- ! Sources terms
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTHS_CLD
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRRS_CLD, PRSVS_CLD
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRTKES_ADV ! Advection TKE source term
-!
-!
-!* 0.2 declarations of local variables
-!
-!
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUCPPM
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVCPPM
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWCPPM
- ! contravariant
- ! components
- ! of momentum
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZCFLU
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZCFLV
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZCFLW
-! ! CFL numbers on each direction
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZCFL
-! ! CFL number
-!
-REAL :: ZCFLU_MAX, ZCFLV_MAX, ZCFLW_MAX, ZCFL_MAX ! maximum CFL numbers
-!
-REAL, DIMENSION(SIZE(PTHT,1), SIZE(PTHT,2), SIZE(PTHT,3) ) :: ZTH
-REAL, DIMENSION(SIZE(PTKET,1),SIZE(PTKET,2),SIZE(PTKET,3)) :: ZTKE
-REAL, DIMENSION(SIZE(PTHT,1), SIZE(PTHT,2), SIZE(PTHT,3) ) :: ZRTHS_OTHER
-REAL, DIMENSION(SIZE(PTKET,1),SIZE(PTKET,2),SIZE(PTKET,3)) :: ZRTKES_OTHER
-REAL, DIMENSION(SIZE(PTHT,1), SIZE(PTHT,2), SIZE(PTHT,3) ) :: ZRTHS_PPM
-REAL, DIMENSION(SIZE(PTKET,1),SIZE(PTKET,2),SIZE(PTKET,3)) :: ZRTKES_PPM
-REAL, DIMENSION(SIZE(PRT,1), SIZE(PRT,2), SIZE(PRT,3), SIZE(PRT,4) ) :: ZR
-REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),SIZE(PSVT,4)) :: ZSV
-REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3), NBLOWSNOW_2D) :: ZSNWC
-REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3), NBLOWSNOW_2D) :: ZSNWC_INIT
-REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3), NBLOWSNOW_2D) :: ZRSNWCS
-! Guess at the sub time step
-REAL, DIMENSION(SIZE(PRT,1), SIZE(PRT,2), SIZE(PRT,3), SIZE(PRT,4) ) :: ZRRS_OTHER
-REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),SIZE(PSVT,4)) :: ZRSVS_OTHER
-REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),NBLOWSNOW_2D) :: ZRSNWCS_OTHER
-! Tendencies since the beginning of the time step
-REAL, DIMENSION(SIZE(PRT,1), SIZE(PRT,2), SIZE(PRT,3), SIZE(PRT,4) ) :: ZRRS_PPM
-REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),SIZE(PSVT,4)) :: ZRSVS_PPM
-REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),NBLOWSNOW_2D) :: ZRSNWCS_PPM
-! Guess at the end of the sub time step
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRHOX1,ZRHOX2
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRHOY1,ZRHOY2
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRHOZ1,ZRHOZ2
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)):: ZT,ZEXN,ZLV,ZLS,ZCPH,ZCOR
-! Temporary advected rhodj for PPM routines
-!
-INTEGER :: JS,JR,JSV,JSPL, JI, JJ ! Loop index
-REAL :: ZTSTEP_PPM ! Sub Time step
-LOGICAL :: GTKE
-!
-INTEGER :: IINFO_ll ! return code of parallel routine
-TYPE(LIST_ll), POINTER :: TZFIELDS0_ll ! list of fields to exchange
-TYPE(LIST_ll), POINTER :: TZFIELDS1_ll ! list of fields to exchange
-!
-!
-INTEGER :: IRESP ! Return code of FM routines
-INTEGER :: ILUOUT ! logical unit
-INTEGER :: ISPLIT_PPM ! temporal time splitting
-INTEGER :: IIB, IIE, IJB, IJE,IKB,IKE
-TYPE(TFIELDMETADATA) :: TZFIELD
-!-------------------------------------------------------------------------------
-!
-!* 0. INITIALIZATION
-! --------------
-
-GTKE=(SIZE(PTKET)/=0)
-
-if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH ), 'ADV', prths (:, :, :) )
-if ( lbudget_tke ) call Budget_store_init( tbudgets(NBUDGET_TKE), 'ADV', prtkes(:, :, :) )
-if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV ), 'ADV', prrs (:, :, :, 1) )
-if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC ), 'ADV', prrs (:, :, :, 2) )
-if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR ), 'ADV', prrs (:, :, :, 3) )
-if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI ), 'ADV', prrs (:, :, :, 4) )
-if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS ), 'ADV', prrs (:, :, :, 5) )
-if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG ), 'ADV', prrs (:, :, :, 6) )
-if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH ), 'ADV', prrs (:, :, :, 7) )
-if ( lbudget_sv) then
- do jsv = 1, ksv
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv ), 'ADV', prsvs(:, :, :, jsv) )
- end do
-end if
-
-ILUOUT = TLUOUT%NLU
-!
-CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
-IKB=1+JPVEXT
-IKE=SIZE(PSVT,3) - JPVEXT
-!
-IF(LBLOWSNOW) THEN ! Put 2D Canopy blowing snow variables into a 3D array for advection
- ZSNWC_INIT = 0.
- ZRSNWCS = 0.
-
- DO JSV=1,(NBLOWSNOW_2D)
- ZSNWC_INIT(:,:,IKB,JSV) = XSNWCANO(:,:,JSV)
- ZRSNWCS(:,:,IKB,JSV) = XRSNWCANOS(:,:,JSV)
- END DO
-ENDIF
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. COMPUTES THE CONTRAVARIANT COMPONENTS (FOR PPM ONLY)
-! --------------------------------------
-!
-!* 2.1 computes contravariant components
-!
-IF (HUVW_ADV_SCHEME=='CEN2ND' ) THEN
- CALL CONTRAV (HLBCX,HLBCY,PUT,PVT,PWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCPPM,ZRVCPPM,ZRWCPPM,2)
-ELSE
- CALL CONTRAV (HLBCX,HLBCY,PUT,PVT,PWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCPPM,ZRVCPPM,ZRWCPPM,4)
-END IF
-!
-!
-!* 2.2 computes CFL numbers
-!
-
-IF (.NOT. L1D) THEN
- ZCFLU = 0.0 ; ZCFLV = 0.0 ; ZCFLW = 0.0
- ZCFLU(IIB:IIE,IJB:IJE,:) = ABS(ZRUCPPM(IIB:IIE,IJB:IJE,:) * PTSTEP)
- ZCFLV(IIB:IIE,IJB:IJE,:) = ABS(ZRVCPPM(IIB:IIE,IJB:IJE,:) * PTSTEP)
- ZCFLW(IIB:IIE,IJB:IJE,:) = ABS(ZRWCPPM(IIB:IIE,IJB:IJE,:) * PTSTEP)
- IF (LIBM) THEN
- ZCFLU(IIB:IIE,IJB:IJE,:) = ZCFLU(IIB:IIE,IJB:IJE,:)*(1.-exp(-(XIBM_LS(IIB:IIE,IJB:IJE,:,2)/&
- (XRHODJ(IIB:IIE,IJB:IJE,:)/XRHODREF(IIB:IIE,IJB:IJE,:))**(1./3.))**2.))
- ZCFLV(IIB:IIE,IJB:IJE,:) = ZCFLV(IIB:IIE,IJB:IJE,:)*(1.-exp(-(XIBM_LS(IIB:IIE,IJB:IJE,:,3)/&
- (XRHODJ(IIB:IIE,IJB:IJE,:)/XRHODREF(IIB:IIE,IJB:IJE,:))**(1./3.))**2.))
- ZCFLW(IIB:IIE,IJB:IJE,:) = ZCFLW(IIB:IIE,IJB:IJE,:)*(1.-exp(-(XIBM_LS(IIB:IIE,IJB:IJE,:,4)/&
- (XRHODJ(IIB:IIE,IJB:IJE,:)/XRHODREF(IIB:IIE,IJB:IJE,:))**(1./3.))**2.))
- WHERE (XIBM_LS(IIB:IIE,IJB:IJE,:,2).GT.(-XIBM_EPSI)) ZCFLU(IIB:IIE,IJB:IJE,:)=0.
- WHERE (XIBM_LS(IIB:IIE,IJB:IJE,:,3).GT.(-XIBM_EPSI)) ZCFLV(IIB:IIE,IJB:IJE,:)=0.
- WHERE (XIBM_LS(IIB:IIE,IJB:IJE,:,4).GT.(-XIBM_EPSI)) ZCFLW(IIB:IIE,IJB:IJE,:)=0.
- ENDIF
- IF (.NOT. L2D) THEN
- ZCFL = SQRT(ZCFLU**2+ZCFLV**2+ZCFLW**2)
- ELSE
- ZCFL = SQRT(ZCFLU**2+ZCFLW**2)
- END IF
-ELSE
- ZCFLU = 0.0 ; ZCFLV = 0.0 ; ZCFLW = 0.0
- ZCFLW(IIB:IIE,IJB:IJE,:) = ABS(ZRWCPPM(IIB:IIE,IJB:IJE,:) * PTSTEP)
- ZCFL = SQRT(ZCFLW**2)
-END IF
-!
-!* prints in the file the 3D Courant numbers (one should flag this)
-!
-IF ( tpfile%lopened .AND. OCFL_WRIT .AND. (.NOT. L1D) ) THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'CFLU', &
- CSTDNAME = '', &
- CLONGNAME = 'CFLU', &
- CUNITS = '1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_CFLU', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZCFLU)
-!
- IF (.NOT. L2D) THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'CFLV', &
- CSTDNAME = '', &
- CLONGNAME = 'CFLV', &
- CUNITS = '1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_CFLV', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZCFLV)
- END IF
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'CFLW', &
- CSTDNAME = '', &
- CLONGNAME = 'CFLW', &
- CUNITS = '1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_CFLW', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZCFLW)
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'CFL', &
- CSTDNAME = '', &
- CLONGNAME = 'CFL', &
- CUNITS = '1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_CFL', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZCFL)
-END IF
-!
-!* prints in the output file the maximum CFL
-!
-ZCFLU_MAX = MAX_ll(ZCFLU,IINFO_ll)
-ZCFLV_MAX = MAX_ll(ZCFLV,IINFO_ll)
-ZCFLW_MAX = MAX_ll(ZCFLW,IINFO_ll)
-ZCFL_MAX = MAX_ll(ZCFL,IINFO_ll)
-!
-WRITE(ILUOUT,FMT='(A24,F10.2,A5,F10.2,A5,F10.2,A9,F10.2)') &
- 'Max. CFL number for U : ',ZCFLU_MAX, &
- ' V : ',ZCFLV_MAX,' W : ', ZCFLW_MAX,&
- 'global : ',ZCFL_MAX
-!
-!
-!* 2.3 updates time step splitting loop
-!
-IF (OSPLIT_CFL .AND. (.NOT.L1D) ) THEN
-!
- ISPLIT_PPM = INT(ZCFL_MAX/PSPLIT_CFL)+1
- IF ( KSPLIT /= ISPLIT_PPM ) &
- WRITE(ILUOUT,FMT='(A37,I2,A4,I2,A11)') &
- 'PPM time spliting loop changed from ', &
- KSPLIT,' to ',ISPLIT_PPM, ' iterations'
-!
- KSPLIT = ISPLIT_PPM
-!
-END IF
-! ---------------------------------------------------------------
-IF (( (ZCFLU_MAX>=3.) .AND. (.NOT.L1D) ) .OR. &
- ( (ZCFLV_MAX>=3.) .AND. (.NOT.L1D) .AND. (.NOT.L2D) ) .OR. &
- ( (ZCFLW_MAX>=8.) .AND. (.NOT.L1D) ) ) THEN
- WRITE(ILUOUT,*) ' '
- WRITE(ILUOUT,*) ' +---------------------------------------------------+'
- WRITE(ILUOUT,*) ' | MODEL ERROR |'
- WRITE(ILUOUT,*) ' +---------------------------------------------------+'
- WRITE(ILUOUT,*) ' | |'
- WRITE(ILUOUT,*) ' | The model wind speed becomes too high |'
- WRITE(ILUOUT,*) ' | |'
- IF ( ZCFLU_MAX>=3. .OR. ZCFLV_MAX>=3. ) &
- WRITE(ILUOUT,*) ' | The horizontal CFL value reaches 3. or more |'
- IF ( ZCFLW_MAX>=8. ) &
- WRITE(ILUOUT,*) ' | The vertical CFL value reaches 8. or more |'
- WRITE(ILUOUT,*) ' | |'
- WRITE(ILUOUT,*) ' | This can be due either to : |'
- WRITE(ILUOUT,*) ' | - a numerical explosion of the model |'
- WRITE(ILUOUT,*) ' | - or a too high wind speed for an |'
- WRITE(ILUOUT,*) ' | acceptable accuracy of the advection |'
- WRITE(ILUOUT,*) ' | |'
- WRITE(ILUOUT,*) ' | Please decrease your time-step |'
- WRITE(ILUOUT,*) ' | |'
- WRITE(ILUOUT,*) ' +---------------------------------------------------+'
- WRITE(ILUOUT,*) ' '
- WRITE(ILUOUT,*) ' +---------------------------------------------------+'
- WRITE(ILUOUT,*) ' | MODEL STOPS |'
- WRITE(ILUOUT,*) ' +---------------------------------------------------+'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','ADVECTION_METSV','')
-END IF
-!
-!
-ZTSTEP_PPM = PTSTEP / REAL(KSPLIT)
-!
-!
-!* 2.4 normalized contravariant components for split PPM time-step
-!
-ZRUCPPM = ZRUCPPM*ZTSTEP_PPM
-ZRVCPPM = ZRVCPPM*ZTSTEP_PPM
-ZRWCPPM = ZRWCPPM*ZTSTEP_PPM
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 3. COMPUTES THE TENDENCIES SINCE THE BEGINNING OF THE TIME STEP
-! ------------------------------------------------------------
-!
-!* This represent the effects of all OTHER processes
-! Clouds related processes from previous time-step are taken into account in PRTHS_CLD
-! Advection related processes from previous time-step will be taken into account in ZRTHS_PPM
-!
-ZRTHS_OTHER = PRTHS - PTHT * PRHODJ / PTSTEP
-IF (GTKE) ZRTKES_OTHER = PRTKES - PTKET * PRHODJ / PTSTEP
-DO JR = 1, KRR
- ZRRS_OTHER(:,:,:,JR) = PRRS(:,:,:,JR) - PRT(:,:,:,JR) * PRHODJ(:,:,:) / PTSTEP
-END DO
-DO JSV = 1, KSV
- ZRSVS_OTHER(:,:,:,JSV) = PRSVS(:,:,:,JSV) - PSVT(:,:,:,JSV) * PRHODJ / PTSTEP
-END DO
-IF(LBLOWSNOW) THEN
- DO JSV = 1, (NBLOWSNOW_2D)
- ZRSNWCS_OTHER(:,:,:,JSV) = ZRSNWCS(:,:,:,JSV) - ZSNWC_INIT(:,:,:,JSV) * PRHODJ / PTSTEP
- END DO
-ENDIF
-!
-! Top and bottom Boundaries
-!
-CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRTHS_OTHER)
-IF (GTKE) CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRTKES_OTHER)
-DO JR = 1, KRR
- CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRRS_OTHER(:,:,:,JR))
-END DO
-DO JSV = 1, KSV
- CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRSVS_OTHER(:,:,:,JSV))
-END DO
-IF(LBLOWSNOW) THEN
- DO JSV = 1, (NBLOWSNOW_2D)
- CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRSNWCS_OTHER(:,:,:,JSV))
- END DO
-END IF
-!
-! Exchanges on processors
-!
-NULLIFY(TZFIELDS0_ll)
-!!$IF(NHALO == 1) THEN
- CALL ADD3DFIELD_ll( TZFIELDS0_ll, ZRTHS_OTHER, 'ADVECTION_METSV::ZRTHS_OTHER' )
- IF (GTKE) CALL ADD3DFIELD_ll( TZFIELDS0_ll, ZRTKES_OTHER, 'ADVECTION_METSV::ZRTKES_OTHER' )
- IF ( KRR>0 ) CALL ADD4DFIELD_ll( TZFIELDS0_ll, ZRRS_OTHER(:,:,:,1:KRR), 'ADVECTION_METSV::ZRRS_OTHER' )
- IF ( KSV>0 ) CALL ADD4DFIELD_ll( TZFIELDS0_ll, ZRSVS_OTHER(:,:,:,1:KSV), 'ADVECTION_METSV::ZRSVS_OTHER' )
- IF(LBLOWSNOW) CALL ADD4DFIELD_ll( TZFIELDS0_ll, ZRSNWCS_OTHER(:,:,:,1:NBLOWSNOW_2D), 'ADVECTION_METSV::ZRSNWCS_OTHER' )
- CALL UPDATE_HALO_ll(TZFIELDS0_ll,IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDS0_ll)
-!!$END IF
-!
-!
-
-!-------------------------------------------------------------------------------
-!
-!* 4. CALLS THE PPM ADVECTION INSIDE A TIME SPLITTING
-! --------------------------------------
-!
-CALL PPM_RHODJ(HLBCX,HLBCY, ZRUCPPM, ZRVCPPM, ZRWCPPM, &
- ZTSTEP_PPM, PRHODJ, ZRHOX1, ZRHOX2, ZRHOY1, ZRHOY2, &
- ZRHOZ1, ZRHOZ2 )
-!
-!* values of the fields at the beginning of the time splitting loop
-ZTH = PTHT
-ZTKE = PTKET
-IF (KRR /=0 ) ZR = PRT
-IF (KSV /=0 ) ZSV = PSVT
-IF(LBLOWSNOW) THEN
- DO JSV = 1, (NBLOWSNOW_2D)
- ZSNWC(:,:,:,JSV) = ZRSNWCS(:,:,:,JSV)* PTSTEP/ PRHODJ
- CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZSNWC(:,:,:,JSV))
- END DO
- ZSNWC_INIT=ZSNWC
-ENDIF
-!
-IF (GTKE) PRTKES_ADV(:,:,:) = 0.
-!
-!* time splitting loop
-DO JSPL=1,KSPLIT
-!
- !ZRTHS_PPM(:,:,:) = 0.
- !ZRTKES_PPM(:,:,:) = 0.
- !IF (KRR /=0) ZRRS_PPM(:,:,:,:) = 0.
- !IF (KSV /=0) ZRSVS_PPM(:,:,:,:) = 0.
-!
- IF (LNEUTRAL) ZTH=ZTH-PTHVREF !* To be removed with the new PPM scheme ?
- CALL PPM_MET (HLBCX,HLBCY, KRR, TPDTCUR,ZRUCPPM, ZRVCPPM, ZRWCPPM, PTSTEP,ZTSTEP_PPM, &
- PRHODJ, ZRHOX1, ZRHOX2, ZRHOY1, ZRHOY2, ZRHOZ1, ZRHOZ2, &
- ZTH, ZTKE, ZR, ZRTHS_PPM, ZRTKES_PPM, ZRRS_PPM, HMET_ADV_SCHEME)
- IF (LNEUTRAL) ZTH=ZTH+PTHVREF !* To be removed with the new PPM scheme ?
-!
- CALL PPM_SCALAR (HLBCX,HLBCY, KSV, TPDTCUR, ZRUCPPM, ZRVCPPM, ZRWCPPM, PTSTEP, &
- ZTSTEP_PPM, PRHODJ, ZRHOX1, ZRHOX2, ZRHOY1, ZRHOY2, ZRHOZ1, ZRHOZ2, &
- ZSV, ZRSVS_PPM, HSV_ADV_SCHEME )
-!
-! Tendencies of PPM
-!
- PRTHS(:,:,:) = PRTHS (:,:,:) + ZRTHS_PPM (:,:,:) / KSPLIT
- IF (GTKE) PRTKES_ADV(:,:,:) = PRTKES_ADV(:,:,:) + ZRTKES_PPM(:,:,:) / KSPLIT
- IF (KRR /=0) PRRS (:,:,:,:) = PRRS (:,:,:,:) + ZRRS_PPM (:,:,:,:) / KSPLIT
- IF (KSV /=0 ) PRSVS (:,:,:,:) = PRSVS (:,:,:,:) + ZRSVS_PPM (:,:,:,:) / KSPLIT
-!
- IF (JSPL<KSPLIT) THEN
-!
-! Guesses of the field inside the time splitting loop
-!
- ZTH = ZTH + ( ZRTHS_PPM(:,:,:) + ZRTHS_OTHER(:,:,:) + PRTHS_CLD(:,:,:)) * &
- ZTSTEP_PPM / PRHODJ(:,:,:)
- IF (GTKE) ZTKE = ZTKE + ( ZRTKES_PPM(:,:,:) + ZRTKES_OTHER(:,:,:) ) * ZTSTEP_PPM / PRHODJ(:,:,:)
- DO JR = 1, KRR
- ZR(:,:,:,JR) = ZR(:,:,:,JR) + ( ZRRS_PPM(:,:,:,JR) + ZRRS_OTHER(:,:,:,JR) + PRRS_CLD(:,:,:,JR) ) &
- * ZTSTEP_PPM / PRHODJ(:,:,:)
- END DO
- DO JSV = 1, KSV
- ZSV(:,:,:,JSV) = ZSV(:,:,:,JSV) + ( ZRSVS_PPM(:,:,:,JSV) + ZRSVS_OTHER(:,:,:,JSV) + &
- PRSVS_CLD(:,:,:,JSV) ) * ZTSTEP_PPM / PRHODJ(:,:,:)
- END DO
-!
-! Top and bottom Boundaries and LBC for the guesses
-!
- CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZTH, PTHT )
- IF (GTKE) CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZTKE, PTKET)
- DO JR = 1, KRR
- CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZR(:,:,:,JR), PRT(:,:,:,JR))
- END DO
- DO JSV = 1, KSV
- CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZSV(:,:,:,JSV), PSVT(:,:,:,JSV))
- END DO
-
- IF(LBLOWSNOW) THEN ! Advection of Canopy mass at the 1st atmospheric level
- ZRSNWCS_PPM(:,:,:,:) = 0.
- !
-
- CALL PPM_SCALAR (HLBCX,HLBCY, NBLOWSNOW_2D, TPDTCUR, ZRUCPPM, ZRVCPPM, ZRWCPPM,PTSTEP, &
- ZTSTEP_PPM, PRHODJ, ZRHOX1, ZRHOX2, ZRHOY1, ZRHOY2, ZRHOZ1, ZRHOZ2, &
- ZSNWC, ZRSNWCS_PPM, HSV_ADV_SCHEME)
-
-
-! Tendencies of PPM
- ZRSNWCS(:,:,:,:) = ZRSNWCS(:,:,:,:) + ZRSNWCS_PPM (:,:,:,:) / KSPLIT
-! Guesses of the field inside the time splitting loop
- DO JSV = 1, ( NBLOWSNOW_2D)
- ZSNWC(:,:,:,JSV) = ZSNWC(:,:,:,JSV) + ZRSNWCS_PPM(:,:,:,JSV)*ZTSTEP_PPM/ PRHODJ(:,:,:)
- END DO
-
-! Top and bottom Boundaries and LBC for the guesses
- DO JSV = 1, (NBLOWSNOW_2D)
- CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZSNWC(:,:,:,JSV), ZSNWC_INIT(:,:,:,JSV))
- END DO
- END IF
-!
-! Exchanges fields between processors
-!
- NULLIFY(TZFIELDS1_ll)
-!!$ IF(NHALO == 1) THEN
- CALL ADD3DFIELD_ll( TZFIELDS1_ll, ZTH, 'ZTH' )
- IF (GTKE) CALL ADD3DFIELD_ll( TZFIELDS1_ll, ZTKE, 'ADVECTION_METSV::ZTKE' )
- IF ( KRR>0 ) CALL ADD4DFIELD_ll( TZFIELDS1_ll, ZR (:,:,:,1:KRR), 'ADVECTION_METSV::ZR' )
- IF ( KSV>0 ) CALL ADD4DFIELD_ll( TZFIELDS1_ll, ZSV(:,:,:,1:KSV), 'ADVECTION_METSV::ZSV' )
- IF ( LBLOWSNOW ) CALL ADD4DFIELD_ll( TZFIELDS1_ll, ZSNWC(:,:,:,1:NBLOWSNOW_2D), 'ADVECTION_METSV::ZSNWC' )
- CALL UPDATE_HALO_ll(TZFIELDS1_ll,IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDS1_ll)
-!!$ END IF
- END IF
-!
-END DO
-!
-!-------------------------------------------------------------------------------
-!
-! TKE special case: advection is the last process for TKE
-!
-! TKE must be greater than its minimum value
-! (previously done in tke_eps_sources)
-!
-IF (GTKE) THEN
- PRTKES(:,:,:) = PRTKES(:,:,:) + PRTKES_ADV(:,:,:)
- PRTKES(:,:,:) = MAX (PRTKES(:,:,:) , XTKEMIN * PRHODJ(:,:,:) / PTSTEP )
-END IF
-!
-!
-!-------------------------------------------------------------------------------
-! Update tendency for cano variables : from 3D to 2D
-!
-IF(LBLOWSNOW) THEN
-
- DO JSV=1,(NBLOWSNOW_2D)
- DO JI=1,SIZE(PSVT,1)
- DO JJ=1,SIZE(PSVT,2)
- XRSNWCANOS(JI,JJ,JSV) = SUM(ZRSNWCS(JI,JJ,IKB:IKE,JSV))
- END DO
- END DO
- END DO
-IF(LWEST_ll()) XRSNWCANOS(IIB,:,:) = ZRSNWCS(IIB,:,IKB,:)
-IF(LEAST_ll()) XRSNWCANOS(IIE,:,:) = ZRSNWCS(IIE,:,IKB,:)
-IF(LSOUTH_ll()) XRSNWCANOS(:,IJB,:) = ZRSNWCS(:,IJB,IKB,:)
-IF(LNORTH_ll()) XRSNWCANOS(:,IJE,:) = ZRSNWCS(:,IJE,IKB,:)
-
-END IF
-!-------------------------------------------------------------------------------
-!
-!* 5. BUDGETS
-! -------
-!
-if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH ), 'ADV', prths (:, :, :) )
-if ( lbudget_tke ) call Budget_store_end( tbudgets(NBUDGET_TKE), 'ADV', prtkes(:, :, :) )
-if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV ), 'ADV', prrs (:, :, :, 1) )
-if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC ), 'ADV', prrs (:, :, :, 2) )
-if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR ), 'ADV', prrs (:, :, :, 3) )
-if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI ), 'ADV', prrs (:, :, :, 4) )
-if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS ), 'ADV', prrs (:, :, :, 5) )
-if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG ), 'ADV', prrs (:, :, :, 6) )
-if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH ), 'ADV', prrs (:, :, :, 7) )
-if ( lbudget_sv) then
- do jsv = 1, ksv
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv ), 'ADV', prsvs(:, :, :, jsv) )
- end do
-end if
-
-! Remove non-physical negative values (unnecessary in a perfect world) + corresponding budgets
-call Sources_neg_correct( hcloud, 'NEADV', krr, ptstep, ppabst, ptht, prt, prths, prrs, prsvs )
-
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE ADVECTION_METSV
diff --git a/src/mesonh/ext/aer_effic.f90 b/src/mesonh/ext/aer_effic.f90
deleted file mode 100644
index 7b91959ce7cac78848bdefcdb50673cf811955ae..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/aer_effic.f90
+++ /dev/null
@@ -1,257 +0,0 @@
-!ORILAM_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
-!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence
-!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!ORILAM_LIC for details.
-! ######spl
- MODULE MODI_AER_EFFIC
-!! ########################
-!!
-!
-INTERFACE
-!!
-SUBROUTINE AER_EFFIC(PRG,PVGG, & !aerosol radius/fall speed (m/s)
- PRHODREF, & !Air density
- PMUW, PMU, & !mu water/air
- PDPG, PEFC, & !diffusivity, efficiency
- PRRS, & ! Rain water m.r. at time
- KMODE, & ! Number of aerosol modes
- PTEMP, PCOR, & ! air temp, cunningham corr factor
- PDENSITY_AER, & ! aerosol density
- PRR, PNT ) ! radius and number of rain drops
-!
-IMPLICIT NONE
-REAL, DIMENSION(:,:), INTENT(IN) :: PRG, PVGG
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF
-REAL, DIMENSION(:,:), INTENT(IN) :: PDPG
-REAL, DIMENSION(:), INTENT(IN) :: PMU, PMUW
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PEFC
-REAL, DIMENSION(:), INTENT(IN) :: PRRS
-REAL, DIMENSION(:), INTENT(IN) :: PTEMP
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOR
-REAL, DIMENSION(:), INTENT(IN) :: PRR, PNT
-INTEGER, INTENT(IN) :: KMODE
-REAL, DIMENSION(:,:), INTENT(IN) :: PDENSITY_AER
-
-
-END SUBROUTINE AER_EFFIC
-!!
-END INTERFACE
-END MODULE MODI_AER_EFFIC
-! ######spl
-SUBROUTINE AER_EFFIC(PRG,PVGG, & !aerosol radius/fall speed (m/s)
- PRHODREF, & !Air density
- PMUW, PMU, & !mu water/air
- PDPG, PEFC, & !diffusivity, efficiency
- PRRT, & ! Rain water m.r. at time t
- KMODE, & ! Number of aerosol modes
- PTEMP, PCOR, & ! air temp, cunningham corr factor
- PDENSITY_AER, & ! aerosol density
- PRR, PNT ) ! radius and number of rain drops
-!! #######################################
-!!**********AER_EFFIC**********
-!! PURPOSE
-!! -------
-!! Calculate the collection efficiency of
-! a falling drop interacting with a dust aerosol
-! for use with aer_wet_dep_kmt_warm.f90
-!!
-!!** METHOD
-!! ------
-!! Using basic theory, and the one dimensional variables sent
-!! from aer_wet_dep_kmt_warm.f90, calculation of the average
-!! fall speed calculations, chapter 17.3.4, MESONH Handbook
-!! droplet number based on the Marshall_Palmer distribution
-!! and Stokes number, Reynolds number, etc. based on theory
-!! (S&P, p.1019)
-!!
-!! REFERENCE
-!! ---------
-!! Seinfeld and Pandis p.1019
-!! MESONH Handbook chapter 17.3.4
-!!
-!! AUTHOR
-!! ------
-!! K. Crahan Kaku / P. Tulet (CNRM/GMEI)
-!!
-!! MODIFICATIONS
-!! -------------
-!! T. Hoarau (LACy) 15/05/17 add LIMA
-!! Philippe Wautelet 28/05/2018: corrected truncated integer division (1/12 -> 1./12.)
-!! P. Tulet and C. Barthe (LAERO) 15/01/22 correction for lima
-!!
-!-----------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_RAIN_ICE_PARAM_n, ONLY : YFSEDR => XFSEDR, YEXSEDR => XEXSEDR
-!++cb++
-!++th++
-USE MODD_RAIN_ICE_DESCR_n, ONLY : YCCR => XCCR, YLBR => XLBR, YLBEXR => XLBEXR, &
- YCEXVT => XCEXVT
-USE MODD_PARAM_LIMA_WARM, ONLY : WCCR => XCCR, WLBR => XLBR, WLBEXR => XLBEXR, &
- XFSEDRR, XFSEDRC
-USE MODD_PARAM_LIMA, ONLY : WCEXVT => XCEXVT, WFSEDR => XFSEDR, WFSEDC=>XFSEDC, &
- XRTMIN
-!--cb--
-USE MODD_PARAM_n, ONLY: CCLOUD
-!--th--
-USE MODD_CST, ONLY : XPI, XRHOLW, XP00, XRD
-USE MODD_PARAMETERS , ONLY : JPVEXT
-USE MODD_REF, ONLY : XTHVREFZ
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-REAL, DIMENSION(:,:), INTENT(IN) :: PRG, PVGG
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF
-REAL, DIMENSION(:,:), INTENT(IN) :: PDPG
-REAL, DIMENSION(:), INTENT(IN) :: PMU, PMUW
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PEFC
-REAL, DIMENSION(:), INTENT(IN) :: PRRT
-REAL, DIMENSION(:), INTENT(IN) :: PTEMP
-REAL, DIMENSION(:), INTENT(IN) :: PRR, PNT
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOR
-INTEGER, INTENT(IN) :: KMODE
-REAL, DIMENSION(:,:), INTENT(IN) :: PDENSITY_AER
-!
-!
-!* 0.2 declaration of local variables
-!
-INTEGER :: IKB ! Coordinates of the first physical
- ! points along z
-REAL :: ZRHO00 ! Surface reference air density
-!viscosity ratio, Reynolds number
-REAL, DIMENSION(SIZE(PRG,1)) :: ZOMG, ZREY
-!rain radius, m, and rain fall speed, m/s; aerosol radius (m),
-REAL, DIMENSION(SIZE(PRG,1)) :: ZRR, ZVR
-!lambda, number concentration according to marshall palmer,
-REAL, DIMENSION(SIZE(PRG,1)) :: ZNT, ZLBDA1
-!RHO_dref*r_r, Rain LWC
-REAL, DIMENSION(SIZE(PRG,1)) :: RLWC
-! schmidts number
-REAL, DIMENSION(SIZE(PRG,1),KMODE) :: ZSCH
-!
-!Stokes number, ratio of diameters,aerosol radius
-REAL, DIMENSION(SIZE(PRG,1),KMODE) :: ZSTO, ZPHI, ZRG
-! S Star Term
-REAL, DIMENSION(SIZE(PRG,1)) :: ZSTA, ZDIFF, ZTAU
-!
-!Term 1, Term 2, Term 3, Term 4 such that
-! E = Term1 * Term 2 + Term 3 + Term 4
-REAL, DIMENSION(SIZE(PRG,1),KMODE) :: ZT1, ZT2
-REAL, DIMENSION(SIZE(PRG,1),KMODE) :: ZT3, ZT4
-!
-INTEGER :: JI,JK
-!++th++
-REAL :: KLBEXR, KLBR, KCEXVT, KCCR, ZFSEDR, ZBR, ZDR, ZEXSEDR
-!--th--
-!
-!-----------------------------------------------------------------
-IKB = 1 + JPVEXT
-ZRHO00 = XP00 / (XRD * XTHVREFZ(IKB))
-ZRG(:,:) = PRG(:,:) * 1.E-6 !change units to meters
-ZVR(:) = 0.
-
-SELECT CASE(CCLOUD)
-CASE('ICE3')
- KLBEXR = YLBEXR
- KLBR = YLBR
- KCEXVT = YCEXVT
- KCCR = YCCR
- ZFSEDR = YFSEDR
- ZEXSEDR = YEXSEDR
-
-!Fall Speed calculations
-!similar to rain_ice.f90, chapter 17.3.4, MESONH Handbook
- ZVR(:) = ZFSEDR * PRRT(:)**(ZEXSEDR-1) * &
- PRHODREF(:)**(ZEXSEDR-KCEXVT)
-
-CASE('LIMA')
- KLBEXR = WLBEXR
- KLBR = WLBR
- KCEXVT = WCEXVT
- KCCR = WCCR
- ZFSEDR = XFSEDRR
- ZBR = 3.0
- ZDR = 0.8
- ZEXSEDR = (ZBR + ZDR + 1.0) / (ZBR + 1.0)
- WHERE (PRRT(:) > XRTMIN(3) .AND. PNT(:) > 0.)
- ZLBDA1(:) = (KLBR * PNT(:) / PRRT(:))**KLBEXR
- ZVR(:) = XFSEDRR * PRHODREF(:)**(1.-KCEXVT) * ZLBDA1(:)**(-ZDR)
- END WHERE
-END SELECT
-
-
-!Fall speed cannot be faster than 7 m/s
-ZVR(:) = MIN(ZVR(:), 7.)
-
-KCCR = 8.E6
-
-
-!Ref SEINFELD AND PANDIS p.1019
-! Viscosity Ratio
-ZOMG(:) = PMUW(:) / PMU(:)
-!!Reynolds number
-ZREY(:) = PRR(:) * ZVR(:) * PRHODREF(:) / PMU(:)
-ZREY(:) = MAX(ZREY(:), 1.E-2)
-!
-!S Star
-ZSTA(:) = (1.2 + 1./12. * LOG(1.+ZREY(:))) / (1. + LOG(1.+ZREY(:)))
-
-PEFC(:,:) = 0.0
-!
-DO JI = 1, KMODE
-!Scmidts number
- ZSCH(:,JI) = PMU(:) / PRHODREF(:) / PDPG(:,JI)
-!
-! Rain-Aerosol relative velocity
- ZDIFF(:) = MAX(ZVR(:)-PVGG(:,JI), 0.)
-!
-! Relaxation time
- ZTAU(:) = (ZRG(:,JI)*2.)**2. * PDENSITY_AER(:,JI) * PCOR(:,JI) / (18. * PMU(:))
-!
-! Stockes number
- ZSTO(:,JI) = ZTAU(:) * ZDIFF(:) / PRR(:)
-!
-!Ratio of diameters
- ZPHI(:,JI) = ZRG(:,JI) / PRR(:)
- ZPHI(:,JI) = MIN(ZPHI(:,JI), 1.)
-!
-!Term 1
- ZT1(:,JI) = 4.0 / ZREY(:) / ZSCH(:,JI)
-!
-!Term 2
- ZT2(:,JI) = 1.0 + 0.4 * ZREY(:)**(0.5) * ZSCH(:,JI)**(1./3.) + &
- 0.16 * ZREY(:)**(0.5) * ZSCH(:,JI)**(0.5)
-!
-!Brownian diffusion
- ZT1(:,JI) = ZT1(:,JI) * ZT2(:,JI)
-!
-!Term 3 - interception
- ZT3(:,JI) = 4. * ZPHI(:,JI) * (1. / ZOMG(:) + &
- (1.0 + 2.0 * ZREY(:)**0.5) * ZPHI(:,JI))
-!
- ZT4(:,JI) = 0.0
-!
- WHERE(ZSTO(:,JI) .GT. ZSTA(:))
-!Term 4 - impaction
- ZT4(:,JI) = ((ZSTO(:,JI) - ZSTA(:)) / &
- (ZSTO(:,JI) - ZSTA(:) + 2. / 3.))**(3./2.) * &
- (XRHOLW / PDENSITY_AER(:,JI))**(1./2.)
-
- END WHERE
-!
-!Collision Efficiancy
- PEFC(:,JI) = ZT1(:,JI) + ZT3(:,JI) + ZT4(:,JI)
-!
-! Physical radius of a rain collector droplet up than 20 um
- WHERE (PRR(:) .LE. 20.E-6)
- PEFC(:,JI) = 0.
- END WHERE
-ENDDO
-!
-PEFC(:,:) = MIN(PEFC(:,:), 1.0)
-PEFC(:,:) = MAX(PEFC(:,:), 0.0)
-
-END SUBROUTINE AER_EFFIC
diff --git a/src/mesonh/ext/aer_effic3D.f90 b/src/mesonh/ext/aer_effic3D.f90
deleted file mode 100644
index 568965581e10742596a7f9c730a8564659c955a6..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/aer_effic3D.f90
+++ /dev/null
@@ -1,225 +0,0 @@
-!ORILAM_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
-!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence
-!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!ORILAM_LIC for details.
-!
-! ######spll
- MODULE MODI_AER_EFFIC3D
-!! ########################
-!!
-!
-INTERFACE
-!!
-SUBROUTINE AER_EFFIC3D(PRG,PVGG, & !aerosol radius/fall speed (m/s)
- PRHODREF, & !Air density
- PMUW, PMU, & !mu water/air
- PDPG, & !diffusivity
- PURR, & ! Rain water m.r. at time t
- NMODE_DST, & ! Number of aerosol modes
- PTEMP, PCOR, & ! air temp, cunningham corr factor
- PDENSITY_AER, & ! aerosol density
- PEFFIC ) ! scavenging efficiency
-!
-IMPLICIT NONE
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRG, PVGG
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PDPG
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMU, PMUW
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PURR
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTEMP
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PCOR
-INTEGER, INTENT(IN) :: NMODE_DST
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PDENSITY_AER
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PEFFIC
-
-
-
-END SUBROUTINE AER_EFFIC3D
-!!
-END INTERFACE
-END MODULE MODI_AER_EFFIC3D
-! ######spll
-SUBROUTINE AER_EFFIC3D(PRG,PVGG, & !aerosol radius/fall speed (m/s)
- PRHODREF, & !Air density
- PMUW, PMU, & !mu water/air
- PDPG, & !diffusivity
- PURR, & ! Rain water m.r. at time t
- NMODE_DST, & ! Number of aerosol modes
- PTEMP, PCOR, & ! air temp, cunningham corr factor
- PDENSITY_AER, & ! aerosol density
- PEFFIC ) ! scavenging efficiency
-!! #######################################
-!!**********AER_EFFIC3D**********
-!! PURPOSE
-!! -------
-!! Calculate the collection efficiency of
-! a falling drop interacting with a dust aerosol
-! for use with aer_wet_dep_kmt_warm.f90
-!!
-!!** METHOD
-!! ------
-!! Using basic theory, and the one dimensional variables sent
-!! from aer_wet_dep_kmt_warm.f90, calculation of the average
-!! fall speed calculations, chapter 17.3.4, MESONH Handbook
-!! droplet number based on the Marshall_Palmer distribution
-!! and Stokes number, Reynolds number, etc. based on theory
-!! (S&P, p.1019)
-!!
-!! REFERENCE
-!! ---------
-!! Seinfeld and Pandis p.1019
-!! MESONH Handbook chapter 17.3.4
-!!
-!! AUTHOR
-!! ------
-!! K. Crahan Kaku / P. Tulet (CNRM/GMEI)
-!!
-!! MODIFICATIONS
-!! -------------
-!! Philippe Wautelet 28/05/2018: corrected truncated integer division (1/12 -> 1./12.)
-!!
-!-----------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_RAIN_ICE_PARAM_n
-USE MODD_RAIN_ICE_DESCR_n
-USE MODD_CST, ONLY : XPI, XRHOLW, XP00, XRD
-USE MODD_PARAMETERS , ONLY : JPVEXT
-USE MODD_REF, ONLY : XTHVREFZ
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRG, PVGG
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PDPG
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMU, PMUW
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PURR
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTEMP
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PCOR
-INTEGER, INTENT(IN) :: NMODE_DST
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PDENSITY_AER
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PEFFIC
-!
-!* 0.2 declaration of local variables
-!
-INTEGER :: IKB ! Coordinates of the first physical
- ! points along z
-REAL :: ZRHO00 ! Surface reference air density
-!viscosity ratio, Reynolds number
-REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3)) :: ZOMG, ZREY
-!rain radius, m, and rain fall speed, m/s; aerosol radius (m),
-REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3)) :: ZRR, ZVR
-!lambda, number concentration according to marshall palmer,
-REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3)) :: ZNT, ZLBDA
-! Rain water m.r. source
-REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3)) :: ZRRS
-!RHO_dref*r_r, Rain LWC
-REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3)) :: ZRLWC
-! schmidts number
-REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3),NMODE_DST) :: ZSCH
-!
-!Stokes number, ratio of diameters,aerosol radius
-REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3),NMODE_DST) :: ZSTO, ZPHI, ZRG
-! S Star Term
-REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3)) :: ZSTA, ZDIFF, ZTAU
-!
-!Term 1, Term 2, Term 3, Term 4 such that
-! E = Term1 * Term 2 + Term 3 + Term 4
-REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3),NMODE_DST) :: ZT1, ZT2
-REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3),NMODE_DST) :: ZT3, ZT4
-!
-INTEGER :: JI,JK
-!
-!-----------------------------------------------------------------
-ZLBDA = 1E20
-ZNT = 1E-20
-ZRR = 10E-6
-ZRRS(:,:,:)=PURR(:,:,:)
-IKB = 1 + JPVEXT
-ZRHO00 = XP00/(XRD*XTHVREFZ(IKB))
-ZRG(:,:,:,:)=PRG(:,:,:,:)*1.E-6 !change units to meters
-!
-!Fall Speed calculations
-!similar to rain_ice.f90, chapter 17.3.4, MESONH Handbook
-!
-ZVR (:,:,:)= XFSEDR * ZRRS(:,:,:)**(XEXSEDR-1) * &
- PRHODREF(:,:,:)**(XEXSEDR-XCEXVT-1)
-
-! Drop Radius calculation in m
-!lbda = pi*No*rho(lwc)/(rho(dref)*rain rate) p.212 MESONH Handbook
-! compute the slope parameter Lbda_r
-
-WHERE((ZRRS(:,:,:).GT. 0.).AND.(PRHODREF(:,:,:) .GT. 0.))
-
-ZLBDA(:,:,:) = XLBR*(PRHODREF(:,:,:)*ZRRS(:,:,:))**XLBEXR
-!Number concentration NT=No/lbda p. 415 Jacobson
-ZNT(:,:,:) = XCCR/ZLBDA(:,:,:)
-!rain lwc (kg/m3) = rain m.r.(kg/kg) * rho_air(kg/m3)
-ZRLWC(:,:,:)=ZRRS(:,:,:)*PRHODREF(:,:,:)
-!4/3 *pi *r**3*NT*rho_eau(kg/m3) =rho(lwc)=rho(air)* qc(kg/kg)
-ZRR(:,:,:) = (ZRLWC(:,:,:)/(XRHOLW*ZNT(:,:,:)*4./3.*XPI))**(1./3.)
-END WHERE
-
-ZRR(:,:,:) = MIN(ZRR(:,:,:), 100.E-6)
-!Fall speed cannot be faster than 7 m/s
-ZVR (:,:,:)=MIN(ZVR (:,:,:),7.)
-
-!Ref SEINFELD AND PANDIS p.1019
-! Viscosity Ratio
-ZOMG(:,:,:)=PMUW(:,:,:)/PMU(:,:,:)
-!!Reynolds number
-ZREY(:,:,:)=ZRR(:,:,:)*ZVR(:,:,:)*PRHODREF(:,:,:)/PMU(:,:,:)
-ZREY(:,:,:)= MAX(ZREY(:,:,:), 1E-2)
-
-
-!S Star
-ZSTA(:,:,:)=(1.2+(1./12.)*LOG(1.+ZREY(:,:,:)))/(1.+LOG(1.+ZREY(:,:,:)))
-PEFFIC(:,:,:,:)=0.0
-DO JI=1,NMODE_DST
-!
-!Scmidts number
- ZSCH(:,:,:,JI)=PMU(:,:,:)/PRHODREF(:,:,:)/PDPG(:,:,:,JI)
-! Rain-Aerosol relative velocity
- ZDIFF(:,:,:) = MAX(ZVR(:,:,:)-PVGG(:,:,:,JI),0.)
-! Relaxation time
- ZTAU(:,:,:) = (ZRG(:,:,:,JI)*2.)**2. * PDENSITY_AER(:,:,:,JI) * PCOR(:,:,:,JI) / (18.*PMU(:,:,:))
-! Stockes number
- ZSTO(:,:,:,JI)= ZTAU(:,:,:) * ZDIFF(:,:,:) / ZRR(:,:,:)
-!Ratio of diameters
- ZPHI(:,:,:,JI)=ZRG(:,:,:,JI)/ZRR(:,:,:)
- ZPHI(:,:,:,JI)=MIN(ZPHI(:,:,:,JI), 1.)
-!Term 1
- ZT1(:,:,:,JI)=4.0/ZREY(:,:,:)/ZSCH(:,:,:,JI)
-!Term 2
- ZT2(:,:,:,JI)=1.0+(0.4*ZREY(:,:,:)**(0.5)*ZSCH(:,:,:,JI)**(1./3.))+ &
- (0.16*ZREY(:,:,:)**(0.5)*ZSCH(:,:,:,JI)**(0.5))
-
-!Brownian diffusion
- ZT1(:,:,:,JI)= ZT1(:,:,:,JI)*ZT2(:,:,:,JI)
-!Term 3 - interception
- ZT3(:,:,:,JI)=4.*ZPHI(:,:,:,JI)*(1./ZOMG(:,:,:)+ &
- (1.0+(2.0*ZREY(:,:,:)**0.5))*ZPHI(:,:,:,JI))
-
- ZT4(:,:,:,JI)=0.0
- WHERE(ZSTO(:,:,:,JI).GT.ZSTA(:,:,:))
-!Term 4 - impaction
- ZT4(:,:,:,JI)=((ZSTO(:,:,:,JI)-ZSTA(:,:,:))/ &
- (ZSTO(:,:,:,JI)-ZSTA(:,:,:)+2./3.))**(3./2.) &
- *((XRHOLW/PDENSITY_AER(:,:,:,JI))**(1./2.))
-
- END WHERE
-!Collision Efficiancy
- PEFFIC(:,:,:,JI)=ZT1(:,:,:,JI)+ ZT3(:,:,:,JI)+ZT4(:,:,:,JI)
-! Physical radius of a rain collector droplet up than 20 um
-WHERE (ZRR(:,:,:) .LE. 9.9E-6)
- PEFFIC(:,:,:,JI)= 0.
-END WHERE
-ENDDO
-PEFFIC(:,:,:,:)=MIN(PEFFIC(:,:,:,:),1.0)
-PEFFIC(:,:,:,:)=MAX(PEFFIC(:,:,:,:),0.0)
-
-END SUBROUTINE AER_EFFIC3D
diff --git a/src/mesonh/ext/aer_wet_dep_kmt_warm.f90 b/src/mesonh/ext/aer_wet_dep_kmt_warm.f90
deleted file mode 100644
index cb2bb68e73e1fa5de72b8c7c206463ab5afc6fac..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/aer_wet_dep_kmt_warm.f90
+++ /dev/null
@@ -1,1057 +0,0 @@
-!ORILAM_LIC Copyright 2007-2023 CNRS, Meteo-France and Universite Paul Sabatier
-!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence
-!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!ORILAM_LIC for details.
-!-----------------------------------------------------------------
-! ################################
- MODULE MODI_AER_WET_DEP_KMT_WARM
-!! ################################
-!!
-!
-INTERFACE
-!!
-SUBROUTINE AER_WET_DEP_KMT_WARM(KSPLITR, PTSTEP, PZZ, PRHODREF, &
- PRCT, PRRT, &
- PRCS, PRRS, PSVT, PTHT, &
- PPABST, PRGAER, PEVAP3D, KMODE, &
- PDENSITY_AER, PMASSMIN, PSEA, PTOWN, &
- PCCT, PCRT )
-!
-IMPLICIT NONE
-INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
- ! integration for rain sedimendation
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference [kg/m3] air density
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Tracer m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS ! Cloud water conc derived from source term
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rain water conc derifed from source term
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEVAP3D ! Instantaneous 3D Rain Evaporation flux (KG/KG/S)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT !Potential temp
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! [Pa] pressure
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRGAER ! Aerosol radius (um)
-INTEGER, INTENT(IN) :: KMODE ! Nb aerosols mode
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PDENSITY_AER ! Begin Index for aerosol in cloud
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PMASSMIN ! Aerosol mass minimum value
-REAL, DIMENSION(:,:),OPTIONAL, INTENT(IN) :: PSEA ! Sea mask
-REAL, DIMENSION(:,:),OPTIONAL, INTENT(IN) :: PTOWN ! Town mask
-REAL, DIMENSION(:,:,:),OPTIONAL, INTENT(IN) :: PCCT ! Cloud water concentration
-REAL, DIMENSION(:,:,:),OPTIONAL, INTENT(IN) :: PCRT ! Rain water concentration
-!
-END SUBROUTINE AER_WET_DEP_KMT_WARM
-!!
-END INTERFACE
-END MODULE MODI_AER_WET_DEP_KMT_WARM
-
-! ###############################################################
- SUBROUTINE AER_WET_DEP_KMT_WARM (KSPLITR, PTSTEP, PZZ, &
- PRHODREF, PRCT, PRRT, &
- PRCS, PRRS, PSVT, PTHT, &
- PPABST, PRGAER, PEVAP3D, KMODE, &
- PDENSITY_AER, PMASSMIN, PSEA, PTOWN, &
- PCCT, PCRT )
-! ###############################################################
-!
-!!**** * - compute the explicit microphysical processes involved in the
-!!*** * - wet deposition of aerosols species in mixed clouds
-!!
-!! PURPOSE
-!! -------
-!!
-!! The purpose of this subroutine is to calculate the mass transfer
-!! of aerosol species between cloud hydrometeors.
-!!
-!!
-!!
-!!** METHOD
-!! ------
-!! Aerosols mass are dissolved into the cloud water and rain
-!! drops, it is subject to transfer through the microphysical processes
-!! that affect the parent hydrometeor [Rutledge et al., 1986].
-!! Aerosol mass transfer has been computed using scavenging coefficient
-!! and brownian nucleation scavenging coefficient (Seinfeld and Pandis,
-!! 1998; Tost et al, 2006).
-!!
-!! The sedimentation rate is computed with a time spliting technique and
-!! an upstream scheme, written as a difference of non-advective fluxes.
-!!
-!! KMODE: Number of aerosol modes (lognormal, bin..)
-!! PSVT : 1 => KMODE : dry aerosol mass
-!! PSVT : KMODE+1 => 2*KMODE : aerosol mass in cloud
-!! PSVT : 2*KMODE+1 => 3*KMODE: aerosol mass in rain
-
-!!
-!! EXTERNAL
-!! --------
-!! None
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CST
-!! XP00 ! Reference pressure
-!! XRD,XRV ! Gaz constant for dry air, vapor
-!! XMD,XMV ! Molecular weight for dry air, vapor
-!! XCPD ! Cpd (dry air)
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! P. Tulet & K. Crahan-Kaku * CNRM *
-!!
-!! Based on rain_ice.f90 and ch_wet_dep_kmt_warm.f90
-!! from C. Mari & J.P. Pinty * LA*
-!!
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 09/05/07
-! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-USE MODD_RAIN_ICE_PARAM_n
-!++th++ 10/05/17
-USE MODD_RAIN_ICE_DESCR_n, ONLY : YRTMIN => XRTMIN, YCEXVT => XCEXVT, &
- XCONC_LAND, XCONC_SEA, XCONC_URBAN, &
- XNUC2, XALPHAC2, XNUC, XALPHAC, &
- YLBC => XLBC, XLBEXC, &
- XCCR, &
- YLBR => XLBR, YLBEXR => XLBEXR
-!--th--
-USE MODD_PRECIP_n
-USE MODI_AER_VELGRAV
-USE MODI_AER_EFFIC
-USE MODI_GAMMA
-!++th++ 10/05/17
-USE MODD_PARAM_LIMA, ONLY : XCTMIN, WRTMIN => XRTMIN, WCEXVT => XCEXVT
-USE MODD_PARAM_LIMA_WARM, ONLY : WLBR => XLBR, WLBEXR => XLBEXR, & ! for
- XFSEDRR, XDR, XBR, & ! sedim.
- XAUTO1, XAUTO2, XCAUTR, XITAUTR, XLAUTR, & ! for
- XLAUTR_THRESHOLD, XITAUTR_THRESHOLD, & ! autoconv.
- WLBC => XLBC, &
- XACCR1, XACCR2, XACCR3, XACCR4, XACCR5, & ! for
- XACCR_RLARGE1, XACCR_RLARGE2, & ! accr.
- XACCR_RSMALL1, XACCR_RSMALL2
-USE MODD_PARAM_n, ONLY: CCLOUD
-!--th--
-
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
- ! integration for rain sedimendation
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference [kg/m3] air density
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Tracer m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS ! Cloud water m.r. from source term
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rain water m.r. from source term
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEVAP3D ! Instantaneous 3D Rain Evaporation flux (KG/KG/S)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Potential temp
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! [Pa] pressure
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRGAER ! Aerosols radius (um)
-INTEGER, INTENT(IN) :: KMODE ! Nb aerosols mode
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PDENSITY_AER ! Begin Index for aerosol in cloud
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PMASSMIN ! Aerosol mass minimum value
-REAL, DIMENSION(:,:),OPTIONAL, INTENT(IN) :: PSEA ! Sea mask
-REAL, DIMENSION(:,:),OPTIONAL, INTENT(IN) :: PTOWN ! Town mask
-REAL, DIMENSION(:,:,:),OPTIONAL, INTENT(IN) :: PCCT ! Cloud water concentration
-REAL, DIMENSION(:,:,:),OPTIONAL, INTENT(IN) :: PCRT ! Rain water concentration
-
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: JK ! Vertical loop index for the rain sedimentation
-INTEGER :: JN ! Temporal loop index for the rain sedimentation
-INTEGER :: JJ ! Loop index for the interpolation
-!
-REAL :: ZTSPLITR ! Small time step for rain sedimentation
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZEFC !efficiency factor [unitless]
-!
-!Declaration of Dust Variables
-!
-INTEGER :: ICLOUD, IRAIN
-! Case number of sedimentation, T>0 (for HEN)
- ! and r_x>0 locations
-LOGICAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) &
- :: GRAIN, GCLOUD ! Test where to compute all processes
- ! Test where to compute the SED/EVAP processes
-!++cb++ 15/05/17
-!REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) &
-! :: ZW, ZZW1, ZZW2, ZZW4 ! work array
-REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) &
- :: ZW, ZZW1, ZZW2, ZZW4, & ! work array
- ZZW3, ZZW5
-REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) &
- :: ZDIM, &
- ZLBDC3, ZLBDC, &
- ZLBDR3, ZLBDR
-!--cb--
-REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) &
- :: ZWEVAP ! sedimentation fluxes
-REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)+1) &
- :: ZWSED ! sedimentation fluxes
-REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) :: ZLBDAR
-! Slope parameter of the raindrop distribution
-REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) &
- :: ZZRCT, ZZEVAP, ZMASK
-REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) &
- :: ZRAY, & ! Mean radius
- ZNRT, & ! Number of rain droplets
- ZLBC , & ! XLBC weighted by sea fraction
- ZFSEDC
-REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2)) :: ZCONC_TMP
-REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) :: ZCONC
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSVT ! Tracer m.r. concentration
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZVGG, ZDPG !aerosol velocity [m/s], diffusivity [m2/s]
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZRG !Dust R[\b5m]
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOR !Cunningham correction factor [unitless]
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZMASSMIN ! Aerosol mass minimum value
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZDENSITY_AER ! Aerosol density
-!
-REAL, DIMENSION(:), ALLOCATABLE &
- :: ZRHODREF, & ! RHO Dry REFerence
- ZTHT, & ! Potential temp
- ZPABST, & ! Pressure [Pa]
- ZZW, & ! Work array
- ZTEMP, & ! Air Temp [K]
- ZRC, & ! Cloud radius [m]
- ZRCT, & ! Cloud water
- ZRR, & ! Rain radius [m]
- ZNT, & ! Rain droplets number
- ZRRT, & ! Rain water
- ZMU,ZMUW, & ! viscosity aerosol, water [Pa s]
- ZFLUX, & ! Effective precipitation flux (kg.m-2.s-1)
- ZCONC1D, & ! Weighted droplets concentration
- ZWLBDC, & ! Slope parameter of the droplet distribution
- ZGAMMA, & ! scavenging coefficient
- ZLBDA ! lambda parameter for lima distribution
-REAL, DIMENSION(:), ALLOCATABLE :: ZW1 ! Work arrays
-
-INTEGER :: JL ! and PACK intrinsics
-!
-INTEGER :: JKAQ, JSV
-!
-REAL :: A0, A1, A2, A3 ! Constants for computing viscocity
-INTEGER :: IKE
-!
-REAL, DIMENSION(:), ALLOCATABLE :: KRTMIN
-REAL :: KCEXVT, KLBR, KLBEXR, KLBC, ZLBEXC
-REAL, DIMENSION(2) :: ZXLBC
-REAL :: ZEXSEDR, ZDR
-!
-!-------------------------------------------------------------------------------
-!
-!* 0. Initialize work array
-! ---------------------
-!
-!++cb++ 15/05/17 gestion des parametres redondants entre lima et ice3
-! ATTENTION : pour le moment, les autres schemas microphysiques ne sont pas geres
-! NOTE : les noms sont changes dans toute la routine X... --> K...
-SELECT CASE(CCLOUD)
-CASE('ICE3')
- ALLOCATE(KRTMIN(SIZE(YRTMIN)))
- KRTMIN(:) = YRTMIN(:)
- KCEXVT = YCEXVT
- KLBR = YLBR
- KLBEXR = YLBEXR
- ZXLBC(:) = YLBC(:)
- ZLBEXC = XLBEXC
-CASE('LIMA')
- ALLOCATE(KRTMIN(SIZE(WRTMIN)))
- KRTMIN = WRTMIN
- KCEXVT = WCEXVT
- KLBR = WLBR
- KLBEXR = WLBEXR
- KLBC = WLBC
- ZLBEXC = 1.0 / 3.0
- ZDR = 0.8
-END SELECT
-!--cb--
-!
-! Compute Effective cloud radius
-ZRAY(:,:,:) = 0.
-ZLBC(:,:,:) = 0.
-!
-!++th++ 05/05/17 test thomas
-IF (PRESENT(PCCT)) THEN ! case KHKO, C2R2, C3R5, LIMA (two moments schemes)
-!
- WHERE (PCCT(:,:,:) .GT. 0. .AND. PRCT(:,:,:) .GT. 0.)
- ZRAY(:,:,:) = 3. * PRCT(:,:,:) / (4. * XPI * XRHOLW * PCCT(:,:,:))
- ZRAY(:,:,:) = ZRAY(:,:,:)**(1./3.) ! Cloud mean radius in m
- ELSEWHERE
- ZRAY(:,:,:) = 30. ! Cloud mean radius in m
- ENDWHERE
-!--th--
-!
-ELSE IF (PRESENT(PSEA)) THEN ! Case ICE3, REVE, KESS, ..
- ZLBC(:,:,:) = ZXLBC(1)
- ZFSEDC(:,:,:) = XFSEDC(1)
- ZCONC(:,:,:) = XCONC_LAND
- ZCONC_TMP(:,:) = PSEA(:,:) * XCONC_SEA + (1. - PSEA(:,:)) * XCONC_LAND
-!
- DO JK = 1, SIZE(PRHODREF,3)
- ZLBC(:,:,JK) = PSEA(:,:) * ZXLBC(2) + (1. - PSEA(:,:)) * ZXLBC(1)
- ZFSEDC(:,:,JK) = (PSEA(:,:) * XFSEDC(2) + (1. - PSEA(:,:)) * XFSEDC(1))
- ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK))
- ZCONC(:,:,JK) = (1. - PTOWN(:,:)) * ZCONC_TMP(:,:) + PTOWN(:,:) * XCONC_URBAN
- ZRAY(:,:,JK) = 0.5 * ((1. - PSEA(:,:)) * GAMMA(XNUC+1.0/XALPHAC) / (GAMMA(XNUC)) + &
- PSEA(:,:) * GAMMA(XNUC2+1.0/XALPHAC2) / (GAMMA(XNUC2)))
- END DO
- ZRAY(:,:,:) = MAX(1., ZRAY(:,:,:))
- ZLBC(:,:,:) = MAX(MIN(ZXLBC(1),ZXLBC(2)), ZLBC(:,:,:))
-ELSE
- ZRAY(:,:,:) = 30. ! default value for cloud radius
-END IF
-!
-ZNRT(:,:,:) = 0.
-IF (PRESENT(PCRT)) THEN ! case KHKO, C2R2, C3R5, LIMA
-! Transfert Number of rain droplets
- ZNRT(:,:,:) = PCRT(:,:,:)
-END IF
-!-------------------------------------------------------------------------------
-!
-!* 1. COMPUTE THE AEROSOL/CLOUD-RAIN MASS TRANSFER
-! ----------------------------------------------
-!
-CALL AER_WET_MASS_TRANSFER
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. COMPUTE THE SEDIMENTATION (RS) SOURCE
-! -------------------------------------
-!
-CALL AER_WET_DEP_KMT_WARM_SEDIMENT
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. COMPUTES THE SLOW WARM PROCESS SOURCES
-! --------------------------------------
-!
-CALL AER_WET_DEP_KMT_ICE_WARM
-!
-!-------------------------------------------------------------------------------
-!* 4. COMPUTES EVAPORATION PROCESS
-! ----------------------------
-!
-CALL AER_WET_DEP_KMT_EVAP
-!
-!++cb++
-DEALLOCATE(KRTMIN)
-!--cb--
-!
-!-------------------------------------------------------------------------------
-!
-!
-CONTAINS
-!
-!
-!-------------------------------------------------------------------------------
-!
-SUBROUTINE AER_WET_MASS_TRANSFER
-!
-!* 0. DECLARATIONS
-! ------------
-!
-use mode_tools, only: Countjv
-
-IMPLICIT NONE
-!
-!* 0.2 declaration of local variables
-!
-!
-INTEGER , DIMENSION(SIZE(GCLOUD)) :: I1C,I2C,I3C! Used to replace the COUNT
-INTEGER , DIMENSION(SIZE(GRAIN)) :: I1R,I2R,I3R ! Used to replace the COUNT
-INTEGER :: JL ! and PACK intrinsics
-INTEGER :: JKAQ ! counter for chemistry
-!
-!
-! 1 Mass transfer Aerosol to cloud (Tost et al., 2006)
-!
-GCLOUD(:,:,:) = .FALSE.
-!
-IF (PRESENT(PCCT)) THEN ! case KHKO, C2R2, C3R5, LIMA (2-moment schemes)
- GCLOUD(:,:,:) = PRCS(:,:,:) > KRTMIN(2) .AND. PCCT(:,:,:) > XCTMIN(2)
-ELSE ! Case ICE3, REVE, KESS, ... (1-moment schemes)
- GCLOUD(:,:,:) = PRCS(:,:,:) > KRTMIN(2)
-END IF
-!--cb--
-!--th--
-
-ICLOUD = COUNTJV( GCLOUD(:,:,:),I1C(:),I2C(:),I3C(:))
-IF( ICLOUD >= 1 ) THEN
- ALLOCATE(ZSVT(ICLOUD,KMODE*3))
- ALLOCATE(ZRHODREF(ICLOUD))
- ALLOCATE(ZTHT(ICLOUD))
- ALLOCATE(ZRC(ICLOUD))
- ALLOCATE(ZPABST(ICLOUD))
- ALLOCATE(ZRG(ICLOUD,KMODE))
- ALLOCATE(ZTEMP(ICLOUD))
- ALLOCATE(ZMU(ICLOUD))
- ALLOCATE(ZRCT(ICLOUD))
- ALLOCATE(ZVGG(ICLOUD,KMODE))
- ALLOCATE(ZDPG(ICLOUD,KMODE))
- ALLOCATE(ZGAMMA(ICLOUD))
- ALLOCATE(ZW1(ICLOUD))
- ALLOCATE(ZCOR(ICLOUD,KMODE))
- ALLOCATE(ZMASSMIN(ICLOUD,KMODE))
- ALLOCATE(ZWLBDC(ICLOUD))
- ALLOCATE(ZCONC1D(ICLOUD))
- ALLOCATE(ZDENSITY_AER(ICLOUD,KMODE))
-!
- ZSVT(:,:) = 0.
-!
- DO JL = 1, ICLOUD
- DO JKAQ = 1, KMODE
- ZRG(JL,JKAQ) = PRGAER(I1C(JL),I2C(JL),I3C(JL),JKAQ)
- ENDDO
- DO JKAQ = 1, KMODE*3
- ZSVT(JL,JKAQ) = PSVT(I1C(JL),I2C(JL),I3C(JL),JKAQ)
- END DO
- !
- ZTHT(JL) = PTHT(I1C(JL),I2C(JL),I3C(JL))
- ZRC(JL) = ZRAY(I1C(JL),I2C(JL),I3C(JL))
- ZPABST(JL) = PPABST(I1C(JL),I2C(JL),I3C(JL))
- ZRCT(JL) = PRCS(I1C(JL),I2C(JL),I3C(JL))
- ZRHODREF(JL) = PRHODREF(I1C(JL),I2C(JL),I3C(JL))
- ZMASSMIN(JL,:) = PMASSMIN(I1C(JL),I2C(JL),I3C(JL),:)
- ZWLBDC(JL) = ZLBC(I1C(JL),I2C(JL),I3C(JL))
- ZCONC1D(JL) = ZCONC(I1C(JL),I2C(JL),I3C(JL))
- ZDENSITY_AER(JL,:) = PDENSITY_AER(I1C(JL),I2C(JL),I3C(JL),:)
- END DO
-!
- IF (ANY(ZWLBDC(:) /= 0.)) THEN ! case one moments
- ! On calcule Rc a partir de M(3) car c'est le seul moment indt de alpha et nu
- ! Rho_air * Rc / (Pi/6 * Rho_eau * Nc) = M(3) = 1/ (Lambda**3 * rapport des
- ! gamma)
- ZWLBDC(:) = ZWLBDC(:) * ZCONC1D(:) / (ZRHODREF(:) * ZRCT(:))
- ZWLBDC(:) = ZWLBDC(:)**ZLBEXC
- ZRC(:) = ZRC(:) / ZWLBDC(:)
- END IF
-!
-! initialize temperature
- ZTEMP(:) = ZTHT(:) * (ZPABST(:) / XP00)**(XRD/XCPD)
-!
-! compute diffusion and gravitation velocity
- CALL AER_VELGRAV(ZRG(:,:), ZPABST(:), &
- KMODE, ZMU(:), ZVGG(:,:), &
- ZDPG(:,:),ZTEMP(:),ZCOR(:,:), &
- ZDENSITY_AER(:,:))
-
- DO JKAQ = 1, KMODE
-! Browninan nucleation scavenging (Pruppacher and Klett, 2000, p723)
- ZGAMMA(:) = 1.35 * ZRCT(:) * ZRHODREF(:) * 1.E-3 * ZDPG(:,JKAQ) / &
- (ZRC(:) * ZRC(:))
-!
- ZW1(:) = ZSVT(:,JKAQ) * EXP(-ZGAMMA(:) * PTSTEP)
- ZW1(:) = MAX(ZW1(:), ZMASSMIN(:,JKAQ))
-! ZW1(:) = MIN(ZW1(:), ZSVT(:,JKAQ))
-! Aerosol mass in cloud
- ZSVT(:,KMODE+JKAQ) = ZSVT(:,KMODE+JKAQ) + ZSVT(:,JKAQ) - ZW1(:)
-! New aerosol mass
- ZSVT(:,JKAQ) = ZW1(:)
-! Return in 3D
- PSVT(:,:,:,JKAQ) = &
- UNPACK(ZSVT(:,JKAQ),MASK=GCLOUD(:,:,:),FIELD=PSVT(:,:,:,JKAQ))
- PSVT(:,:,:,KMODE+JKAQ) = &
- UNPACK(ZSVT(:,KMODE+JKAQ),MASK=GCLOUD(:,:,:),FIELD=PSVT(:,:,:,KMODE+JKAQ))
- ENDDO
-!
- DEALLOCATE(ZSVT)
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(ZTHT)
- DEALLOCATE(ZRC)
- DEALLOCATE(ZPABST)
- DEALLOCATE(ZRG)
- DEALLOCATE(ZTEMP)
- DEALLOCATE(ZMU)
- DEALLOCATE(ZRCT)
- DEALLOCATE(ZVGG)
- DEALLOCATE(ZDPG)
- DEALLOCATE(ZGAMMA)
- DEALLOCATE(ZW1)
- DEALLOCATE(ZCOR)
- DEALLOCATE(ZMASSMIN)
- DEALLOCATE(ZWLBDC)
- DEALLOCATE(ZCONC1D)
- DEALLOCATE(ZDENSITY_AER)
-END IF
-!
-! 2 Mass transfer Aerosol to Rain (Seinfeld and Pandis, 1998, Tost et al., 2006)
-!
-GRAIN(:,:,:) = .FALSE.
-!
-IF (PRESENT(PCRT)) THEN ! case KHKO, C2R2, C3R5, LIMA (2-moment schemes)
- GRAIN(:,:,:) = PRRT(:,:,:) > KRTMIN(3) .AND. PCRT(:,:,:) > XCTMIN(3)
-ELSE ! Case ICE3, REVE, KESS, ... (1-moment schemes)
- GRAIN(:,:,:) = PRRT(:,:,:) > KRTMIN(3)
-END IF
-
-IRAIN = COUNTJV( GRAIN(:,:,:),I1R(:),I2R(:),I3R(:))
-IF( IRAIN >= 1 ) THEN
-!
- ALLOCATE(ZRRT(IRAIN))
- ALLOCATE(ZSVT(IRAIN,3*KMODE))
- ALLOCATE(ZRHODREF(IRAIN))
- ALLOCATE(ZTHT(IRAIN))
- ALLOCATE(ZRR(IRAIN))
- ALLOCATE(ZNT(IRAIN))
- ALLOCATE(ZPABST(IRAIN))
- ALLOCATE(ZRG(IRAIN,KMODE))
- ALLOCATE(ZCOR(IRAIN,KMODE))
- ALLOCATE(ZTEMP(IRAIN))
- ALLOCATE(ZMU(IRAIN))
- ALLOCATE(ZVGG(IRAIN,KMODE))
- ALLOCATE(ZDPG(IRAIN,KMODE))
- ALLOCATE(ZMUW(IRAIN))
- ALLOCATE(ZEFC(IRAIN,KMODE))
- ALLOCATE(ZW1(IRAIN))
- ALLOCATE(ZFLUX(IRAIN))
- ALLOCATE(ZGAMMA(IRAIN))
- ALLOCATE(ZMASSMIN(IRAIN,KMODE))
- ALLOCATE(ZDENSITY_AER(IRAIN,KMODE))
- ALLOCATE(ZLBDA(IRAIN))
-!
- ZSVT(:,:) = 0.
-!
- DO JL = 1, IRAIN
- DO JKAQ = 1, KMODE
- ZRG(JL,JKAQ) = PRGAER(I1R(JL),I2R(JL),I3R(JL),JKAQ )
- ZSVT(JL,JKAQ) = PSVT(I1R(JL),I2R(JL),I3R(JL),JKAQ)
- ZSVT(JL,KMODE*2+JKAQ) = PSVT(I1R(JL),I2R(JL),I3R(JL),KMODE*2+JKAQ)
- END DO
-!
- ZTHT(JL) = PTHT(I1R(JL),I2R(JL),I3R(JL))
- ZPABST(JL) = PPABST(I1R(JL),I2R(JL),I3R(JL))
- ZRRT(JL) = PRRT(I1R(JL),I2R(JL),I3R(JL))
- ZRHODREF(JL) = PRHODREF(I1R(JL),I2R(JL),I3R(JL))
- ZMASSMIN(JL,:) = PMASSMIN(I1R(JL),I2R(JL),I3R(JL),:)
- ZNT(JL) = ZNRT(I1R(JL),I2R(JL),I3R(JL))
- ZDENSITY_AER(JL,:) = PDENSITY_AER(I1R(JL),I2R(JL),I3R(JL),:)
- ENDDO
-
-! Compute scavenging coefficient
- ZFLUX(:) = 0.
- ZRRT(:) = MAX(ZRRT(:), 0.)
-!
-! Effective precipitation flux (kg.m-2.s-1)
- IF (PRESENT(PCRT)) THEN ! cf lima_precip_scavenging.f90 (l. 751)
- ZEXSEDR = (XBR + XDR + 1.0) / (XBR + 1.0)
-
- ZLBDA(:) = (KLBR * ZNT(:) / ZRRT(:))**KLBEXR
- ZFLUX(:) = XFSEDRR * ZRRT(:) * ZRHODREF(:)**(1.-KCEXVT) * ZLBDA(:)**(-ZDR)
-
- ELSE ! cf ZWSED dans rain_ice.f90 (l. 1077)
- ZFLUX(:) = XFSEDR * ZRRT(:)**(XEXSEDR) * ZRHODREF(:)**(XEXSEDR-KCEXVT)
- END IF
- ZFLUX(:) = MAX(ZFLUX(:), 0.)
-
- IF (ALL(ZNT(:) == 0.)) THEN ! case one moments
-! Number concentration NT=No/lbda p. 415 Jacobson
-! 4/3 *pi *r\b3*NT*rho_eau(kg/m3) =rho(lwc)=rho(air)* qc(kg/kg)
- ZNT(:) = XCCR / (KLBR * (ZRHODREF(:) * ZRRT(:))**KLBEXR)
- END IF
-!
- ZRR(:) = (ZRRT(:) * ZRHODREF(:) / &
- (XRHOLW * ZNT(:) * 4. / 3. * XPI))**(1./3.)
-
- CALL AER_WET_DEP_KMT_EFFIC
-
- DO JKAQ = 1, KMODE
- ! Tost et al, 2006
- ZGAMMA(:) = 0.75 * ZEFC(:,JKAQ) * ZFLUX(:) / (ZRR(:) * 1.E3)
-
- ZW1(:) = ZSVT(:,JKAQ) * EXP(-ZGAMMA(:)*PTSTEP)
- ZW1(:) = MAX(ZW1(:), ZMASSMIN(:,JKAQ))
-
- ! Aerosol mass in rain
- ZSVT(:,KMODE*2+JKAQ) = ZSVT(:,KMODE*2+JKAQ) + ZSVT(:,JKAQ) - ZW1(:)
-
- ! New aerosol mass
- ZSVT(:,JKAQ) = ZW1(:)
-
- ! Return to 3D
- PSVT(:,:,:,JKAQ) = &
- UNPACK(ZSVT(:,JKAQ),MASK=GRAIN(:,:,:),FIELD=PSVT(:,:,:,JKAQ))
- PSVT(:,:,:,KMODE*2+JKAQ) = &
- UNPACK(ZSVT(:,KMODE*2+JKAQ),MASK=GRAIN(:,:,:),FIELD=PSVT(:,:,:,KMODE*2+JKAQ))
- ENDDO
-!
- DEALLOCATE(ZRRT)
- DEALLOCATE(ZSVT)
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(ZTHT)
- DEALLOCATE(ZRR)
- DEALLOCATE(ZNT)
- DEALLOCATE(ZPABST)
- DEALLOCATE(ZRG)
- DEALLOCATE(ZCOR)
- DEALLOCATE(ZTEMP)
- DEALLOCATE(ZMU)
- DEALLOCATE(ZVGG)
- DEALLOCATE(ZDPG)
- DEALLOCATE(ZMUW)
- DEALLOCATE(ZEFC)
- DEALLOCATE(ZW1)
- DEALLOCATE(ZFLUX)
- DEALLOCATE(ZGAMMA)
- DEALLOCATE(ZMASSMIN)
- DEALLOCATE(ZDENSITY_AER)
- DEALLOCATE(ZLBDA)
-END IF
-!
-END SUBROUTINE AER_WET_MASS_TRANSFER
-!
-!-------------------------------------------------------------------------------
-!
-SUBROUTINE AER_WET_DEP_KMT_WARM_SEDIMENT
-!
-!* Sedimentation of aerosol in rain droplets
-!
-!* 0. DECLARATIONS
-! ------------
-!
-use mode_tools, only: Countjv
-!
-IMPLICIT NONE
-!
-!* declaration of local variables
-!
-INTEGER :: JL ! and PACK intrinsics
-INTEGER :: JKAQ ! counter for acquous aerosols
-INTEGER :: IRAIN, ILISTLENR
-INTEGER :: ILENALLOCR
-INTEGER, SAVE :: IOLDALLOCR = 6000
-INTEGER, DIMENSION(SIZE(PZZ)) :: IR1,IR2,IR3 ! Used to replace the COUNT
-INTEGER, DIMENSION(:), ALLOCATABLE :: ILISTR
-REAL, DIMENSION(:), ALLOCATABLE :: ZLAMBDA, ZRHODREF, ZCRT, ZRRT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSVT
-!
-!-------------------------------------------------------------------------------
-!
-!* Time splitting initialization
-!
-ZTSPLITR = PTSTEP / REAL(KSPLITR)
-!
-ZW(:,:,:)=0.
-ZWSED(:,:,:) = 0.
-IKE = SIZE(PRCT,3)
-ILENALLOCR = 0
-
-DO JK = 1 , SIZE(PZZ,3)-1
- ZW(:,:,JK) = ZTSPLITR / ((PZZ(:,:,JK+1) - PZZ(:,:,JK)))
-END DO
-
-IF (PRESENT(PCRT)) THEN !two moments
- WHERE (PRRT(:,:,:) > KRTMIN(3) .AND. PCRT(:,:,:) > XCTMIN(3))
- ZW(:,:,:) = 0.
- END WHERE
-ELSE ! one moment
- WHERE (PRRT(:,:,:) <= KRTMIN(3))
- ZW(:,:,:) = 0.
- END WHERE
-END IF
-
-GRAIN(:,:,:) = .FALSE.
-
-IF (PRESENT(PCRT)) THEN ! case KHKO, C2R2, C3R5, LIMA (2-moment schemes)
- GRAIN(:,:,:) = PRRT(:,:,:) > KRTMIN(3) .AND. PCRT(:,:,:) > XCTMIN(3)
-ELSE ! Case ICE3, REVE, KESS, ... (1-moment schemes)
- GRAIN(:,:,:) = PRRT(:,:,:) > KRTMIN(3)
-END IF
-
-IRAIN = COUNTJV( GRAIN(:,:,:),IR1(:),IR2(:),IR3(:))
-
-IF( IRAIN >= 1 ) THEN
-DO JN = 1 , KSPLITR
- IF( JN==1 ) THEN
- DO JKAQ = 1,KMODE
- DO JK = 1, IKE
- PSVT(:,:,JK,KMODE*2+JKAQ) = PSVT(:,:,JK,KMODE*2+JKAQ) / FLOAT(KSPLITR)
- END DO
- END DO
- END IF
- IF ( IRAIN .GT. ILENALLOCR ) THEN
- IF ( ILENALLOCR .GT. 0 ) THEN
- DEALLOCATE (ILISTR,ZSVT,ZRHODREF,ZCRT,ZRRT,ZLAMBDA)
- END IF
- ILENALLOCR = MAX (IOLDALLOCR, 2*IRAIN )
- IOLDALLOCR = ILENALLOCR
- ALLOCATE(ILISTR(ILENALLOCR), ZRHODREF(ILENALLOCR), ZSVT(ILENALLOCR,3*KMODE),&
- ZCRT(ILENALLOCR), ZRRT(ILENALLOCR), ZLAMBDA(ILENALLOCR))
- END IF
-
- DO JL = 1, IRAIN
- DO JKAQ = 1, KMODE
- ZSVT(JL,KMODE*2+JKAQ) = PSVT(IR1(JL),IR2(JL),IR3(JL),KMODE*2+JKAQ)
- END DO
-!
- IF (PRESENT(PCRT)) ZCRT(JL) = PCRT(IR1(JL),IR2(JL),IR2(JL))
- ZRRT(JL) = PRRT(IR1(JL),IR2(JL),IR3(JL))
- ZRHODREF(JL) = PRHODREF(IR1(JL),IR2(JL),IR3(JL))
- ENDDO
-
- ILISTLENR = 0
- DO JL=1,IRAIN
- IF (PRESENT(PCRT)) THEN !two moments
- IF (ZRRT(JL) > KRTMIN(3) .AND. ZCRT(JL) > XCTMIN(3)) THEN
- ILISTLENR = ILISTLENR + 1
- ILISTR(ILISTLENR) = JL
- END IF
- ELSE ! one moment
- IF (ZRRT(JL) > KRTMIN(3)) THEN
- ILISTLENR = ILISTLENR + 1
- ILISTR(ILISTLENR) = JL
- END IF
- END IF
- END DO
-
-!
-! Flux mass aerosol in rain droplets =
-! Flux mass rain water * Mass aerosol in rain / Mass rain water
- DO JKAQ = 1,KMODE
- DO JJ = 1, ILISTLENR
- JL = ILISTR(JJ)
- IF (PRESENT(PCRT)) THEN !two moments
- IF (ZRRT(JL) > KRTMIN(3) .AND. ZCRT(JL) > XCTMIN(3)) THEN
- ZLAMBDA(JL) = (KLBR * ZCRT(JL) / ZRRT(JL))**KLBEXR
-
- ZWSED(IR1(JL),IR2(JL),IR3(JL)) = XFSEDRR * ZRHODREF(JL)**(1.-KCEXVT) &
- * ZLAMBDA(JL)**(-ZDR) &
- * ZSVT(JL,KMODE*2+JKAQ)
- END IF
- ELSE ! one moments
-! cf rain_ice.f90 : l. 1077 (zwsed * psvt(kmode+2+jkaq) / zrrs)
- IF (ZRRT(JL) > KRTMIN(3)) THEN
-
- ZWSED(IR1(JL),IR2(JL),IR3(JL)) = XFSEDR &
- * ZRRT(JL)**(XEXSEDR-1.) &
- * ZRHODREF(JL)**(XEXSEDR-KCEXVT) &
- * ZSVT(JL,KMODE*2+JKAQ)
- END IF
- END IF ! moments
- END DO ! JJ
-
- DO JK = 1, IKE
- PSVT(:,:,JK,KMODE*2+JKAQ) = PSVT(:,:,JK,KMODE*2+JKAQ) + &
- ZW(:,:,JK)*(ZWSED(:,:,JK+1)-ZWSED(:,:,JK))
- END DO
- END DO ! JKAQ
-
-END DO ! JN - time splitting
-
- DO JKAQ = 1,KMODE
-! Aerosol mass in rain droplets need to be positive
- PSVT(:,:,:,KMODE*2+JKAQ) = MAX(PSVT(:,:,:,KMODE*2+JKAQ), 0.)
- END DO ! KKAQ
-END IF !(IRAIN)
-!
-IF (ALLOCATED(ILISTR)) DEALLOCATE(ILISTR)
-IF (ALLOCATED(ZSVT)) DEALLOCATE(ZSVT)
-IF (ALLOCATED(ZRHODREF)) DEALLOCATE(ZRHODREF)
-IF (ALLOCATED(ZCRT)) DEALLOCATE(ZCRT)
-IF (ALLOCATED(ZRRT)) DEALLOCATE(ZRRT)
-IF (ALLOCATED(ZLAMBDA)) DEALLOCATE(ZLAMBDA)
-
-!
-END SUBROUTINE AER_WET_DEP_KMT_WARM_SEDIMENT
-!
-!-------------------------------------------------------------------------------
-!
- SUBROUTINE AER_WET_DEP_KMT_ICE_WARM
-!
-!* 0. DECLARATIONS
-!
-USE MODD_CST, ONLY: XMNH_HUGE
-
-IMPLICIT NONE
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. compute the autoconversion of r_c for r_r production: RCAUTR
-!
-ZZW4(:,:,:) = 0.0
-! to be sure no division by zero in case of ZZRCT = 0.
-ZZRCT(:,:,:) = PRCT(:,:,:)
-ZZRCT(:,:,:) = MAX(ZZRCT(:,:,:), KRTMIN(2)/2.)
-!
-IF (PRESENT(PCRT)) THEN ! 2-moment schemes
-!
-! from lima_warm_coal.f90 (AUTO)
- ZLBDC3(:,:,:) = XMNH_HUGE
- ZLBDC(:,:,:) = 1.E15
- WHERE (ZZRCT(:,:,:) > KRTMIN(2) .AND. PCCT(:,:,:) > XCTMIN(2))
- ZLBDC3(:,:,:) = KLBC * PCCT(:,:,:) / PRCT(:,:,:)
- ZLBDC(:,:,:) = ZLBDC3(:,:,:)**ZLBEXC
- END WHERE
-!
- ZZW3(:,:,:) = 0.
- WHERE (ZZRCT(:,:,:) > KRTMIN(2))
- ZZW3(:,:,:) = MAX(0.0, XLAUTR*PRHODREF(:,:,:)*ZZRCT(:,:,:)* &
- (XAUTO1/ZLBDC3(:,:,:)**4-XLAUTR_THRESHOLD)) ! L
- ZZW4(:,:,:) = MIN(PRCS(:,:,:), MAX(0.0, XITAUTR*ZZW3(:,:,:)*ZZRCT(:,:,:)* &
- (XAUTO2/ZLBDC3(:,:,:)-XITAUTR_THRESHOLD))) ! L/tau
- END WHERE
-!
-ELSE ! 1-moment scheme
-!
- WHERE ((ZZRCT(:,:,:) > KRTMIN(2)) .AND. (PRCS(:,:,:) > 0.0))
- ZZW4(:,:,:) = MIN(PRCS(:,:,:), XTIMAUTC* &
- MAX((ZZRCT(:,:,:)-XCRIAUTC/PRHODREF(:,:,:)), 0.0))
- END WHERE
-!
-END IF
-!--cb--
-
-DO JKAQ = 1,KMODE
- ZZW2(:,:,:) = 0.0
- ZZW2(:,:,:) = ZZW4(:,:,:) * PSVT(:,:,:,KMODE+JKAQ) / ZZRCT(:,:,:) * PTSTEP
- ZZW2(:,:,:) = MAX(MIN(ZZW2(:,:,:), PSVT(:,:,:,KMODE+JKAQ)), 0.0)
-
-! For rain - Increase the aerosol conc in rain
- PSVT(:,:,:,KMODE*2+JKAQ) = PSVT(:,:,:,KMODE*2+JKAQ) + ZZW2(:,:,:)
-! For Cloud Decrease the aerosol conc in cloud
- PSVT(:,:,:,KMODE+JKAQ) = PSVT(:,:,:,KMODE+JKAQ) - ZZW2(:,:,:)
-ENDDO
-!
-!
-!* 2. compute the accretion of r_c for r_r production: RCACCR
-!
-ZZW4(:,:,:) = 0.0
-ZZW5(:,:,:) = 0.
-ZDIM(:,:,:) = 0.
-ZLBDAR(:,:,:)=0.
-
-!
-IF (PRESENT(PCRT)) THEN ! 2-moment schemes
-!
-! from lima_warm_coal.f90 (ACCR)
- ZLBDR3(:,:,:) = 1.E30
- ZLBDR(:,:,:) = 1.E10
- WHERE (PRRT(:,:,:) > KRTMIN(3) .AND. PCRT(:,:,:) > XCTMIN(3))
- ZLBDAR(:,:,:) = KLBR * (PRHODREF(:,:,:) * PRRT(:,:,:))**KLBEXR
- ZLBDR3(:,:,:) = KLBR * PCRT(:,:,:) / PRRT(:,:,:)
- ZLBDR(:,:,:) = ZLBDR3(:,:,:)**KLBEXR
- ZZW4(:,:,:) = MIN(PRCS(:,:,:), XFCACCR * ZZRCT(:,:,:) &
- * ZLBDAR(:,:,:)**XEXCACCR &
- * PRHODREF(:,:,:)**(-KCEXVT) )
- ZDIM(:,:,:) = XACCR1 / ZLBDAR(:,:,:)
- END WHERE
-!
-! Accretion for D > 100 10-6 m
- WHERE (PRRT(:,:,:) > KRTMIN(3) .AND. PCRT(:,:,:) > XCTMIN(3) .AND. &
- ZZRCT(:,:,:) > KRTMIN(2) .AND. ZZW4(:,:,:) > 1.E-4 .AND. &
- (PRRT(:,:,:) > 1.2*ZZW3(:,:,:)/PRHODREF(:,:,:) .OR. &
- ZDIM(:,:,:) >= MAX(XACCR2,XACCR3/(XACCR4/ZLBDC(:,:,:)-XACCR5))))
- ZZW5(:,:,:) = ZLBDC3(:,:,:) / ZLBDR3(:,:,:)
- ZZW1(:,:,:) = (PCCT(:,:,:) * PCRT(:,:,:) / ZLBDC3(:,:,:)**2) * PRHODREF(:,:,:)
- ZZW4(:,:,:) = MIN(ZZW1(:,:,:)*(XACCR_RLARGE1+XACCR_RLARGE2*ZZW5(:,:,:)), &
- PRCS(:,:,:))
- END WHERE
-! Accretion for D < 100 10-6 m
- WHERE (PRRT(:,:,:) > KRTMIN(3) .AND. PCRT(:,:,:) > XCTMIN(3) .AND. &
- ZZRCT(:,:,:) > KRTMIN(2) .AND. ZZW4(:,:,:) <= 1.E-4 .AND. &
- (PRRT(:,:,:) > (1.2*ZZW2(:,:,:)/PRHODREF(:,:,:)) .OR. &
- ZDIM(:,:,:) >= MAX(XACCR2,XACCR3/(XACCR4/ZLBDC(:,:,:)-XACCR5))))
- ZZW5(:,:,:) = (ZLBDC3(:,:,:) / ZLBDR3(:,:,:))**2
- ZZW1(:,:,:) = (PCCT(:,:,:) * PCRT(:,:,:) / ZLBDC3(:,:,:)**3) * PRHODREF(:,:,:)
- ZZW4(:,:,:) = MIN(ZZW1(:,:,:)*(XACCR_RSMALL1+XACCR_RSMALL2*ZZW5(:,:,:)), &
- PRCS(:,:,:))
- END WHERE
-!
-ELSE ! 1-moment schemes
-!
- ZLBDR(:,:,:) = 0.0
- WHERE ((ZZRCT(:,:,:) > KRTMIN(2)) .AND. (PRRT(:,:,:) > KRTMIN(3)) &
- .AND. (PRCS(:,:,:) > 0.0))
- ZLBDR(:,:,:) = KLBR * (PRHODREF(:,:,:) * PRRT(:,:,:))**KLBEXR
- ZZW4(:,:,:) = MIN(PRCS(:,:,:), XFCACCR * ZZRCT(:,:,:) &
- * ZLBDR(:,:,:)**XEXCACCR &
- * PRHODREF(:,:,:)**(-KCEXVT) )
- END WHERE
-END IF
-!--cb--
-!
-DO JKAQ = 1, KMODE
- ZZW2(:,:,:) = 0.0
- ZZW2(:,:,:) = ZZW4(:,:,:) * PSVT(:,:,:,KMODE+JKAQ) / ZZRCT(:,:,:) * PTSTEP
- ZZW2(:,:,:) = MAX(MIN(ZZW2(:,:,:), PSVT(:,:,:,KMODE+JKAQ)), 0.0)
-!
-!
-!* 3. compute the new acqueous aerosol mass
-!
-! For rain - Increase the aerosol conc in rain
- PSVT(:,:,:,KMODE*2+JKAQ) = PSVT(:,:,:,KMODE*2+JKAQ) + ZZW2(:,:,:)
-! For Cloud Decrease the aerosol conc in cloud
- PSVT(:,:,:,KMODE+JKAQ) = PSVT(:,:,:,KMODE+JKAQ) - ZZW2(:,:,:)
-ENDDO
-!
-END SUBROUTINE AER_WET_DEP_KMT_ICE_WARM
-!
-!---------------------------------------------------------------------------------------
-!
- SUBROUTINE AER_WET_DEP_KMT_EVAP
-!
-!* COMPUTES THE EVAPORATION OF CLOUD-RAIN FOR THE
-!* RE-RELEASE OF AER INTO THE ENVIRONMENT
-! --------------------------------------
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* declaration of local variables
-!
-INTEGER :: JKAQ ! counter for aerosols
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. compute the evaporation of r_r: RREVAV
-!
-!When partial reevaporation of precip takes place, the fraction of
-!tracer precipitating form above is reevaporated is equal to
-!half of the evaporation rate of water
-!
-! Rain water evaporated during PTSTEP in kg/kg
-ZZEVAP(:,:,:) = PEVAP3D(:,:,:) * PTSTEP
-!
-! Fraction of rain water evaporated
-! at this stage (bulk), we consider that the flux of evaporated aerosol
-! is a ratio of the evaporated rain water.
-! It will interested to calculate with a two moment scheme (C2R2 or C3R5)
-! the complete evaporation of rain droplet to use it for the compuation
-! of the evaporated aerosol flux.
-ZWEVAP(:,:,:) = 0.0
-WHERE(PRRT(:,:,:) .GT. KRTMIN(3))
- ZWEVAP(:,:,:) = ZZEVAP(:,:,:) / (PRRT(:,:,:))
-END WHERE
-ZWEVAP(:,:,:) = MIN(ZWEVAP(:,:,:), 1.0)
-ZWEVAP(:,:,:) = MAX(ZWEVAP(:,:,:), 0.0)
-!
-!
-!* 2. compute the mask of r_c evaporation : all cloud is evaporated
-! no partial cloud evaporation at this stage
-!
-ZMASK(:,:,:) = 0.
-WHERE(PRCS(:,:,:) .LT. KRTMIN(2))
- ZMASK(:,:,:) = 1.
-END WHERE
-!
-DO JKAQ = 1, KMODE
- ZZW1(:,:,:) = ZMASK(:,:,:) * PSVT(:,:,:,KMODE+JKAQ)
- ZZW2(:,:,:) = ZWEVAP(:,:,:) * PSVT(:,:,:,KMODE*2+JKAQ)
-!
- ZZW1(:,:,:) = MIN(ZZW1(:,:,:),PSVT(:,:,:,KMODE+JKAQ))
- ZZW2(:,:,:) = MIN(ZZW2(:,:,:),PSVT(:,:,:,KMODE*2+JKAQ))
-!
-! 3. New dry aerosol mass
-!
- PSVT(:,:,:,JKAQ) = PSVT(:,:,:,JKAQ) + ZZW2(:,:,:) + ZZW1(:,:,:)
-!
-!
-! 4. New cloud aerosol mass
-!
- PSVT(:,:,:,KMODE+JKAQ) = PSVT(:,:,:,KMODE+JKAQ) - ZZW1(:,:,:)
-!
-!
-! 5. New rain aerosol mass
-!
- PSVT(:,:,:,KMODE*2+JKAQ) = PSVT(:,:,:,KMODE*2+JKAQ) - ZZW2(:,:,:)
-END DO
-!
-END SUBROUTINE AER_WET_DEP_KMT_EVAP
-!
-!---------------------------------------------------------------------------------------
-!
- SUBROUTINE AER_WET_DEP_KMT_EFFIC
-!
-!* COMPUTES THE EFFICIENCY FACTOR
-! ------------------------------
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. COMPUTES THE EFFICIENCY FACTOR
-! --------------------------------------
-!
-!* 1.1 compute gravitational velocities
-!
-!initialize
-ZTEMP(:) = ZTHT(:) * (ZPABST(:) / XP00)**(XRD/XCPD)
-ZTEMP(:) = MAX(ZTEMP(:), 1.e-12)
-!
-CALL AER_VELGRAV(ZRG(:,:), ZPABST(:), KMODE, &
- ZMU(:), ZVGG(:,:), &
- ZDPG(:,:),ZTEMP(:), &
- ZCOR(:,:), ZDENSITY_AER(:,:))
-
-! Above gives mu (ZMU), v(aerosol)(PVGG, m/s), diffusion (ZDPG, m2/s)
-!
-!* 1.2 Compute Water Viscocity in kg/m/s Prup. & Klett, p.95
-!
-A0 = 1.76
-A1 = -5.5721e-2
-A2 = -1.3943e-3
-A3 = -4.3015e-5
-ZMUW(:) = A0 * EXP(A1*(ZTEMP(:)-273.15) &
- + A2*(ZTEMP(:)-273.15) + A3*(ZTEMP(:)-273.15)) * 1.e-3
-!
-A1 = -3.5254e-2
-A2 = 4.7163e-4
-A3 = -6.0667e-6
-WHERE (ZTEMP(:) > 273.15)
- ZMUW(:) = A0 * EXP(A1*(ZTEMP(:)-273.15) &
- + A2*(ZTEMP(:)-273.15) + A3*(ZTEMP(:)-273.15)) * 1.e-3
-END WHERE
-ZMUW(:) = MAX(ZMUW(:), 1.e-12)
-!
-!* 1.3 compute efficiency factor
-!
-! This gives aerosol collection efficiency by calculating Reynolds number
-! schmidt number, stokes number, etc
-CALL AER_EFFIC(ZRG(:,:), ZVGG(:,:), & !aerosol radius/velocity
- ZRHODREF(:), & !Air density
- ZMUW(:), ZMU(:), & !mu water/air
- ZDPG(:,:), ZEFC(:,:), & !diffusivity, efficiency
- ZRRT(:), KMODE, & !Rain water, nb aerosols modes
- ZTEMP(:),ZCOR(:,:), & ! Temperature, Cunnimgham coeff
- ZDENSITY_AER(:,:), & ! aerosol density
- ZRR, ZNT ) ! radius and number of rain drops
-!
-END SUBROUTINE AER_WET_DEP_KMT_EFFIC
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE AER_WET_DEP_KMT_WARM
diff --git a/src/mesonh/ext/aero_effic3D.f90 b/src/mesonh/ext/aero_effic3D.f90
deleted file mode 100644
index 05d5e2ce113b62c25577b3a085670c1e4766cc38..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/aero_effic3D.f90
+++ /dev/null
@@ -1,247 +0,0 @@
-!MNH_LIC Copyright 1994-2018 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.
-!
-! ######spll
- MODULE MODI_AERO_EFFIC3D
-!! ########################
-!!
-!
-INTERFACE
-!!
-SUBROUTINE AERO_EFFIC3D(PRG,PVGG, & !aerosol radius/fall speed (m/s)
- PRHODREF, & !Air density
- PMUW, PMU, & !mu water/air
- PDPG, & !diffusivity
- PURR, & ! Rain water m.r. at time t
- KMODE, & ! Number of aerosol modes
- PTEMP, PCOR, & ! air temp, cunningham corr factor
- PDENSITY_AER, & ! aerosol density
- PEFFIC_AER ) ! scavenging efficiency for aerosol
-!
-IMPLICIT NONE
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRG, PVGG
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PDPG
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMU, PMUW
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PURR
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTEMP
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PCOR
-INTEGER, INTENT(IN) :: KMODE
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PDENSITY_AER
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PEFFIC_AER
-
-
-
-END SUBROUTINE AERO_EFFIC3D
-!!
-END INTERFACE
-END MODULE MODI_AERO_EFFIC3D
-! ######spll
-SUBROUTINE AERO_EFFIC3D(PRG,PVGG, & !aerosol radius/fall speed (m/s)
- PRHODREF, & !Air density
- PMUW, PMU, & !mu water/air
- PDPG, & !diffusivity
- PURR, & ! Rain water m.r. at time t
- KMODE, & ! Number of aerosol modes
- PTEMP, PCOR, & ! air temp, cunningham corr factor
- PDENSITY_AER, & ! aerosol density
- PEFFIC_AER ) ! scavenging efficiency for aerosol
-!! #######################################
-!!**********AERO_EFFIC3D**********
-!! PURPOSE
-!! -------
-!! Calculate the collection efficiency of
-! a falling drop interacting with a dust aerosol
-! for use with aer_wet_dep_kmt_warm.f90
-!!
-!!** METHOD
-!! ------
-!! Using basic theory, and the one dimensional variables sent
-!! from aer_wet_dep_kmt_warm.f90, calculation of the average
-!! fall speed calculations, chapter 17.3.4, MESONH Handbook
-!! droplet number based on the Marshall_Palmer distribution
-!! and Stokes number, Reynolds number, etc. based on theory
-!! (S&P, p.1019)
-!!
-!! REFERENCE
-!! ---------
-!! Seinfeld and Pandis p.1019
-!! MESONH Handbook chapter 17.3.4
-!!
-!! AUTHOR
-!! ------
-!! K. Crahan Kaku / P. Tulet (CNRM/GMEI)
-!!
-!! MODIFICATIONS
-!! -------------
-!! Philippe Wautelet 28/05/2018: corrected truncated integer division (1/12 -> 1./12.)
-!!
-!-----------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_RAIN_ICE_PARAM_n
-USE MODD_RAIN_ICE_DESCR_n
-USE MODD_CST, ONLY : XPI, XRHOLW, XP00, XRD
-USE MODD_PARAMETERS , ONLY : JPVEXT
-USE MODD_REF, ONLY : XTHVREFZ
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRG, PVGG
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PDPG
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMU, PMUW
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PURR
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTEMP
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PCOR
-INTEGER, INTENT(IN) :: KMODE
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PDENSITY_AER
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PEFFIC_AER
-!
-!* 0.2 declaration of local variables
-!
-INTEGER :: IKB ! Coordinates of the first physical
- ! points along z
-REAL :: ZRHO00 ! Surface reference air density
-!viscosity ratio, Reynolds number
-REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3)) :: ZOMG, ZREY
-!rain radius, m, and rain fall speed, m/s; aerosol radius (m),
-REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3)) :: ZRR, ZVR
-!lambda, number concentration according to marshall palmer,
-REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3)) :: ZNT, ZLBDA
-! Rain water m.r. source
-REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3)) :: ZRRS
-!RHO_dref*r_r, Rain LWC
-REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3)) :: ZRLWC
-! schmidts number
-REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3),KMODE) :: ZSCH
-!
-!Stokes number, ratio of diameters,aerosol radius
-REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3),KMODE) :: ZSTO, ZPHI, ZRG
-! S Star Term
-REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3)) :: ZSTA, ZDIFF, ZTAU
-!
-!Term 1, Term 2, Term 3, Term 4 such that
-! E = Term1 * Term 2 + Term 3 + Term 4
-REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3),KMODE) :: ZT1, ZT2
-REAL, DIMENSION(SIZE(PRG,1),SIZE(PRG,2),SIZE(PRG,3),KMODE) :: ZT3, ZT4
-!
-INTEGER :: JI,JK
-!
-!-----------------------------------------------------------------
-ZLBDA = 1E20
-ZNT = 1E-20
-ZRR = 10E-6
-ZRRS(:,:,:)=PURR(:,:,:)
-IKB = 1 + JPVEXT
-ZRHO00 = XP00/(XRD*XTHVREFZ(IKB))
-ZRG(:,:,:,:)=PRG(:,:,:,:)*1.E-6 !change units to meters
-!
-!Fall Speed calculations
-!similar to rain_ice.f90, chapter 17.3.4, MESONH Handbook
-!
-ZVR (:,:,:)= XFSEDR * ZRRS(:,:,:)**(XEXSEDR-1) * &
- PRHODREF(:,:,:)**(XEXSEDR-XCEXVT-1)
-
-! Drop Radius calculation in m
-!lbda = pi*No*rho(lwc)/(rho(dref)*rain rate) p.212 MESONH Handbook
-! compute the slope parameter Lbda_r
-
-WHERE((ZRRS(:,:,:).GT. 0.).AND.(PRHODREF(:,:,:) .GT. 0.))
-
-ZLBDA(:,:,:) = XLBR*(PRHODREF(:,:,:)*ZRRS(:,:,:))**XLBEXR
-!Number concentration NT=No/lbda p. 415 Jacobson
-ZNT(:,:,:) = XCCR/ZLBDA(:,:,:)
-!rain lwc (kg/m3) = rain m.r.(kg/kg) * rho_air(kg/m3)
-ZRLWC(:,:,:)=ZRRS(:,:,:)*PRHODREF(:,:,:)
-!4/3 *pi *r**3*NT*rho_eau(kg/m3) =rho(lwc)=rho(air)* qc(kg/kg)
-ZRR(:,:,:) = (ZRLWC(:,:,:)/(XRHOLW*ZNT(:,:,:)*4./3.*XPI))**(1./3.)
-END WHERE
-
-ZRR(:,:,:) = MIN(ZRR(:,:,:), 100.E-6)
-
-
-!Fall speed cannot be faster than 7 m/s
-ZVR (:,:,:)=MIN(ZVR (:,:,:),7.)
-
-
-!Ref SEINFELD AND PANDIS p.1019
-! Viscosity Ratio
-ZOMG(:,:,:)=PMUW(:,:,:)/PMU(:,:,:)
-!!Reynolds number
-ZREY(:,:,:)=ZRR(:,:,:)*ZVR(:,:,:)*PRHODREF(:,:,:)/PMU(:,:,:)
-ZREY(:,:,:)= MAX(ZREY(:,:,:), 1E-2)
-
-
-!S Star
-ZSTA(:,:,:)=(1.2+(1./12.)*LOG(1.+ZREY(:,:,:)))/(1.+LOG(1.+ZREY(:,:,:)))
-
-PEFFIC_AER(:,:,:,:)=0.0
-
-DO JI=1,KMODE
-
-!
-!Scmidts number
- ZSCH(:,:,:,JI)=PMU(:,:,:)/PRHODREF(:,:,:)/PDPG(:,:,:,JI)
-! Rain-Aerosol relative velocity
- ZDIFF(:,:,:) = MAX(ZVR(:,:,:)-PVGG(:,:,:,JI),0.)
-
-
-! Relaxation time
- ZTAU(:,:,:) = (ZRG(:,:,:,JI)*2.)**2. * PDENSITY_AER(:,:,:,JI) * PCOR(:,:,:,JI) / (18.*PMU(:,:,:))
-
-
-! Stockes number
- ZSTO(:,:,:,JI)= ZTAU(:,:,:) * ZDIFF(:,:,:) / ZRR(:,:,:)
-
-
-
-!Ratio of diameters
- ZPHI(:,:,:,JI)=ZRG(:,:,:,JI)/ZRR(:,:,:)
- ZPHI(:,:,:,JI)=MIN(ZPHI(:,:,:,JI), 1.)
-!Term 1
- ZT1(:,:,:,JI)=4.0/ZREY(:,:,:)/ZSCH(:,:,:,JI)
-
-!Term 2
- ZT2(:,:,:,JI)=1.0+(0.4*ZREY(:,:,:)**(0.5)*ZSCH(:,:,:,JI)**(1./3.))+ &
- (0.16*ZREY(:,:,:)**(0.5)*ZSCH(:,:,:,JI)**(0.5))
-
-!Brownian diffusion
- ZT1(:,:,:,JI)= ZT1(:,:,:,JI)*ZT2(:,:,:,JI)
-
-!Term 3 - interception
- ZT3(:,:,:,JI)=4.*ZPHI(:,:,:,JI)*(1./ZOMG(:,:,:)+ &
- (1.0+(2.0*ZREY(:,:,:)**0.5))*ZPHI(:,:,:,JI))
-
- ZT4(:,:,:,JI)=0.0
- WHERE(ZSTO(:,:,:,JI).GT.ZSTA(:,:,:))
-!Term 4 - impaction
- ZT4(:,:,:,JI)=((ZSTO(:,:,:,JI)-ZSTA(:,:,:))/ &
- (ZSTO(:,:,:,JI)-ZSTA(:,:,:)+2./3.))**(3./2.) &
- *((XRHOLW/PDENSITY_AER(:,:,:,JI))**(1./2.))
-
- END WHERE
-
-!Collision Efficiancy
-
-
- PEFFIC_AER(:,:,:,JI)=ZT1(:,:,:,JI)+ ZT3(:,:,:,JI)+ZT4(:,:,:,JI)
-
-! Physical radius of a rain collector droplet up than 20 um
-
-WHERE (ZRR(:,:,:) .LE. 9.9E-6)
- PEFFIC_AER(:,:,:,JI)= 0.
-END WHERE
-
-ENDDO
-
-PEFFIC_AER(:,:,:,:)=MIN(PEFFIC_AER(:,:,:,:),1.0)
-PEFFIC_AER(:,:,:,:)=MAX(PEFFIC_AER(:,:,:,:),0.0)
-
-END SUBROUTINE AERO_EFFIC3D
diff --git a/src/mesonh/ext/aircraft_balloon_evol.f90 b/src/mesonh/ext/aircraft_balloon_evol.f90
deleted file mode 100644
index 34e4aeb15b940fc1ed14750ff8701e0b51300ae7..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/aircraft_balloon_evol.f90
+++ /dev/null
@@ -1,1620 +0,0 @@
-!MNH_LIC Copyright 2000-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.
-!-----------------------------------------------------------------
-! Author: Valery Masson (Meteo-France *)
-! Original 15/05/2000
-! Modifications:
-! G. Jaubert 19/04/2001: add CVBALL type
-! P. Lacarrere 03/2008: add 3D fluxes
-! M. Leriche 12/12/2008: move ZTDIST out from if.not.(tpflyer%fly)
-! V. Masson 15/12/2008: correct do while aircraft move
-! O. Caumont 03/2013: add radar reflectivities
-! C. Lac 04/2014: allow RARE calculation only if CCLOUD=ICE3
-! O. Caumont 05/2014: modify RARE for hydrometeors containing ice + add bright band calculation for RARE
-! C. Lac 02/2015: correction to prevent aircraft crash
-! O. Nuissier/F. Duffourg 07/2015: add microphysics diagnostic for aircraft, ballon and profiler
-! G. Delautier 10/2016: LIMA
-! P. Wautelet 28/03/2018: replace TEMPORAL_DIST by DATETIME_DISTANCE
-! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
-! P. Wautelet 01/10/2020: bugfix: initialize GSTORE
-! P. Wautelet 14/01/2021: bugfixes: -ZXCOEF and ZYCOEF were not computed if CVBALL
-! -PCIT was used if CCLOUD/=ICEx (not allocated)
-! -PSEA was always used even if not allocated (CSURF/=EXTE)
-! -do not use PMAP if cartesian domain
-! P. Wautelet 06/2022: reorganize flyers
-!-----------------------------------------------------------------
-! ##########################
-MODULE MODE_AIRCRAFT_BALLOON_EVOL
-! ##########################
-
-USE MODE_MSG
-
-IMPLICIT NONE
-
-PRIVATE
-
-PUBLIC :: AIRCRAFT_BALLOON_EVOL
-
-PUBLIC :: AIRCRAFT_COMPUTE_POSITION
-
-PUBLIC :: FLYER_GET_RANK_MODEL_ISCRASHED
-
-CONTAINS
-! ########################################################
- SUBROUTINE AIRCRAFT_BALLOON_EVOL(PTSTEP, &
- PZ, PMAP, PLONOR, PLATOR, &
- PU, PV, PW, PP, PTH, PR, PSV, PTKE, &
- PTS, PRHODREF, PCIT, TPFLYER, &
- KRANK_CUR, KRANK_NXT, PSEA )
-! ########################################################
-!
-!
-!!**** *AIRCRAFT_BALLOON_EVOL* - (advects and) stores
-!! balloons/aircrafts in the model
-!!
-!! PURPOSE
-!! -------
-!
-!
-!!** METHOD
-!! ------
-!!
-!! 1) All the balloons are tested. If the current balloon is
-!! a) in the current model
-!! b) not crashed
-!! the following computations are done.
-!!
-!! 2) The balloon position is computed.
-!! Interpolations at balloon positions are performed according to mass
-!! points (because density is computed here for iso-density balloons).
-!! Therefore, all model variables are used at mass points. Shuman averaging
-!! are performed on X, Y, Z, U, V, W.
-!!
-!! 3) Storage of balloon data
-!! If storage is asked for this time-step, the data are recorded in the
-!! balloon time-series.
-!!
-!! 4) Balloon advection
-!! If the balloon is launched, it is advected according its type
-!! a) iso-density balloons are advected following horizontal wind.
-!! the slope of the iso-density surfaces is neglected.
-!! b) radio-sounding balloons are advected according to all wind velocities.
-!! the vertical ascent speed is added to the vertical wind speed.
-!! c) Constant Volume balloons are advected according to all wind velocities.
-!! the vertical ascent speed is computed using the balloon equation
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_AIRCRAFT_BALLOON
-USE MODD_CST, ONLY: XCPD, XLVTT
-USE MODD_IO, ONLY: ISP
-USE MODD_TIME_n, ONLY: TDTCUR
-USE MODD_TURB_FLUX_AIRCRAFT_BALLOON, ONLY: XRCW_FLUX, XSVW_FLUX, XTHW_FLUX
-!
-USE MODE_DATETIME
-USE MODE_NEST_ll, ONLY: GET_MODEL_NUMBER_ll
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-!
-REAL, INTENT(IN) :: PTSTEP ! time step
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZ ! z array
-REAL, DIMENSION(:,:), INTENT(IN) :: PMAP ! map factor
-REAL, INTENT(IN) :: PLONOR ! origine longitude
-REAL, INTENT(IN) :: PLATOR ! origine latitude
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PU ! horizontal wind X component
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PV ! horizontal wind Y component
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW ! vertical wind
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PP ! pressure
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTH ! potential temperature
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PR ! water mixing ratios
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSV ! Scalar variables
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE ! turbulent kinetic energy
-REAL, DIMENSION(:,:), INTENT(IN) :: PTS ! surface temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! dry air density of the reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! pristine ice concentration
-!
-CLASS(TFLYERDATA), INTENT(INOUT) :: TPFLYER ! balloon/aircraft
-INTEGER, INTENT(IN) :: KRANK_CUR
-INTEGER, INTENT(OUT) :: KRANK_NXT
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA
-!
-!-------------------------------------------------------------------------------
-!
-! 0.2 declaration of local variables
-!
-!
-INTEGER :: IMI ! model index
-INTEGER :: IKB ! vertical domain sizes
-INTEGER :: IKE
-INTEGER :: IKU
-!
-REAL, DIMENSION(2,2,SIZE(PZ,3)) :: ZZM ! mass point coordinates
-REAL, DIMENSION(2,2,SIZE(PZ,3)) :: ZZU ! U points z coordinates
-REAL, DIMENSION(2,2,SIZE(PZ,3)) :: ZZV ! V points z coordinates
-REAL, DIMENSION(2,2,SIZE(PZ,3)) :: ZWM ! mass point wind
-!
-REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZEXN ! Exner function
-REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZRHO ! air density
-REAL :: ZFLYER_EXN ! balloon/aircraft Exner func.
-REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZTHW_FLUX !
-REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZRCW_FLUX !
-REAL, DIMENSION(2,2,SIZE(PSV,3),SIZE(PSV,4)) :: ZSVW_FLUX
-!
-LOGICAL :: GLAUNCH ! launch/takeoff is effective at this time-step (if true)
-LOGICAL :: GSTORE ! storage occurs at this time step
-LOGICAL :: GOWNER_CUR ! The process is the current owner of the flyer
-!
-INTEGER :: II_M ! mass balloon position (x index)
-INTEGER :: IJ_M ! mass balloon position (y index)
-INTEGER :: II_U ! U flux point balloon position (x index)
-INTEGER :: IJ_V ! V flux point balloon position (y index)
-!
-INTEGER :: IK00 ! balloon position for II_M , IJ_M
-INTEGER :: IK01 ! balloon position for II_M , IJ_M+1
-INTEGER :: IK10 ! balloon position for II_M+1, IJ_M
-INTEGER :: IK11 ! balloon position for II_M+1, IJ_M+1
-INTEGER :: IU00 ! balloon position for II_U , IJ_M
-INTEGER :: IU01 ! balloon position for II_U , IJ_M+1
-INTEGER :: IU10 ! balloon position for II_U+1, IJ_M
-INTEGER :: IU11 ! balloon position for II_U+1, IJ_M+1
-INTEGER :: IV00 ! balloon position for II_M , IJ_V
-INTEGER :: IV01 ! balloon position for II_M , IJ_V+1
-INTEGER :: IV10 ! balloon position for II_M+1, IJ_V
-INTEGER :: IV11 ! balloon position for II_M+1, IJ_V+1
-!
-REAL :: ZXCOEF ! X direction interpolation coefficient
-REAL :: ZUCOEF ! X direction interpolation coefficient (for U)
-REAL :: ZYCOEF ! Y direction interpolation coefficient
-REAL :: ZVCOEF ! Y direction interpolation coefficient (for V)
-!
-REAL :: ZZCOEF00 ! Z direction interpolation coefficient for II_M , IJ_M
-REAL :: ZZCOEF01 ! Z direction interpolation coefficient for II_M , IJ_M+1
-REAL :: ZZCOEF10 ! Z direction interpolation coefficient for II_M+1, IJ_M
-REAL :: ZZCOEF11 ! Z direction interpolation coefficient for II_M+1, IJ_M+1
-REAL :: ZUCOEF00 ! Z direction interpolation coefficient for II_U , IJ_M
-REAL :: ZUCOEF01 ! Z direction interpolation coefficient for II_U , IJ_M+1
-REAL :: ZUCOEF10 ! Z direction interpolation coefficient for II_U+1, IJ_M
-REAL :: ZUCOEF11 ! Z direction interpolation coefficient for II_U+1, IJ_M+1
-REAL :: ZVCOEF00 ! Z direction interpolation coefficient for II_M , IJ_V
-REAL :: ZVCOEF01 ! Z direction interpolation coefficient for II_M , IJ_V+1
-REAL :: ZVCOEF10 ! Z direction interpolation coefficient for II_M+1, IJ_V
-REAL :: ZVCOEF11 ! Z direction interpolation coefficient for II_M+1, IJ_V+1
-!
-INTEGER :: ISTORE ! time index for storage
-!
-REAL :: ZTSTEP
-TYPE(DATE_TIME) :: TZNEXT ! Time for next position
-!----------------------------------------------------------------------------
-IKU = SIZE(PZ,3)
-
-CALL GET_MODEL_NUMBER_ll(IMI)
-
-! Set initial value for KRANK_NXT
-! It needs to be 0 on all processes except the one where it is when this subroutine is called
-! If the flyer flies to an other process, KRANK_NXT will be set accordingly by the current owner
-IF ( TPFLYER%NRANK_CUR == ISP ) THEN
- GOWNER_CUR = .TRUE. ! This variable is set and used because NRANK_CUR could change in this subroutine
- KRANK_NXT = ISP
-ELSE
- GOWNER_CUR = .FALSE.
- KRANK_NXT = 0
-END IF
-
-SELECT TYPE ( TPFLYER )
- CLASS IS ( TAIRCRAFTDATA)
- ! Take-off?
- TAKEOFF: IF ( .NOT. TPFLYER%LTOOKOFF ) THEN
- ! Do the take-off positioning only once
- ! (on model 1 for 'MOB', if aircraft is on an other model, data will be available on the right one anyway)
- IF ( ( TPFLYER%CMODEL == 'MOB' .AND. IMI == 1 ) &
- .OR. ( TPFLYER%CMODEL == 'FIX' .AND. IMI == TPFLYER%NMODEL ) ) THEN
- ! Is the aircraft in flight ?
- IF ( TDTCUR >= TPFLYER%TLAUNCH .AND. TDTCUR <= TPFLYER%TLAND ) THEN
- TPFLYER%LFLY = .TRUE.
- TPFLYER%LTOOKOFF = .TRUE.
- END IF
- END IF
- END IF TAKEOFF
-
- !Do we have to store aircraft data?
- IF ( IMI == TPFLYER%NMODEL ) CALL FLYER_CHECK_STORESTEP( TPFLYER )
-
- ! For aircrafts, data has only to be computed at store moments
- ISTORE = TPFLYER%TFLYER_TIME%N_CUR
- IF ( IMI == TPFLYER%NMODEL .AND. TPFLYER%LFLY .AND. TPFLYER%LSTORE ) THEN
- ! Check if it is the right moment to store data
- IF ( ABS( TDTCUR - TPFLYER%TFLYER_TIME%TPDATES(ISTORE) ) < 1e-10 ) THEN
- ISOWNERAIR: IF ( TPFLYER%NRANK_CUR == ISP ) THEN
- CALL FLYER_INTERP_TO_MASSPOINTS()
-
- ZEXN(:,:,:) = FLYER_COMPUTE_EXNER( )
- ZRHO(:,:,:) = FLYER_COMPUTE_RHO( )
-
- ZTHW_FLUX(:,:,:) = ZRHO(:,:,:)*XCPD *XTHW_FLUX(II_M:II_M+1,IJ_M:IJ_M+1,:)
- ZRCW_FLUX(:,:,:) = ZRHO(:,:,:)*XLVTT*XRCW_FLUX(II_M:II_M+1,IJ_M:IJ_M+1,:)
- ZSVW_FLUX(:,:,:,:) = XSVW_FLUX(II_M:II_M+1,IJ_M:IJ_M+1,:,:)
-
- ! Compute coefficents for horizontal interpolations
- CALL FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE1( )
- ! Compute coefficents for vertical interpolations
- CALL FLYER_COMPUTE_INTERP_COEFF_VER( )
- ! Compute coefficents for horizontal interpolations
- CALL FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE2( )
-
- CALL FLYER_RECORD_DATA( )
- END IF ISOWNERAIR
-
- ! Store has been done
- TPFLYER%LSTORE = .FALSE.
- END IF
- END IF
-
- ! Compute next position if the previous store has just been done (right moment on right model)
- IF ( IMI == TPFLYER%NMODEL .AND. ISTORE > 0 ) THEN
- ! This condition may only be tested if ISTORE > 0
- IF (ABS( TDTCUR - TPFLYER%TFLYER_TIME%TPDATES(ISTORE) ) < 1e-10 ) THEN
- ! Next store moment
- TZNEXT = TDTCUR + TPFLYER%TFLYER_TIME%XTSTEP
-
- ! Is the aircraft in flight ?
- IF ( TZNEXT >= TPFLYER%TLAUNCH .AND. TZNEXT <= TPFLYER%TLAND ) THEN
- TPFLYER%LFLY = .TRUE.
- ! Force LTOOKOFF to prevent to do it again (at a next timestep)
- TPFLYER%LTOOKOFF = .TRUE.
-
- ! Compute next position
- CALL AIRCRAFT_COMPUTE_POSITION( TZNEXT, TPFLYER )
-
- ! Get rank of the process where the aircraft is and the model number
- CALL FLYER_GET_RANK_MODEL_ISCRASHED( TPFLYER )
- ELSE
- TPFLYER%LFLY = .FALSE.
- END IF
- END IF
- END IF
-
- IF ( GOWNER_CUR ) KRANK_NXT = TPFLYER%NRANK_CUR
-
- CLASS IS ( TBALLOONDATA)
- GLAUNCH = .FALSE. !Set to true only at the launch instant (set to false in flight after launch)
-
- ! Launch?
- LAUNCH: IF ( .NOT. TPFLYER%LFLY .AND. .NOT. TPFLYER%LCRASH .AND. TPFLYER%NMODEL == IMI ) THEN
- ! Check if it is launchtime
- LAUNCHTIME: IF ( ( TDTCUR - TPFLYER%TLAUNCH ) >= -1.e-10 ) THEN
- TPFLYER%LFLY = .TRUE.
- GLAUNCH = .TRUE.
-
- TPFLYER%XX_CUR = TPFLYER%XXLAUNCH
- TPFLYER%XY_CUR = TPFLYER%XYLAUNCH
- TPFLYER%TPOS_CUR = TDTCUR
- END IF LAUNCHTIME
- END IF LAUNCH
-
- ! Check if it is time to store data. This has also to be checked if the balloon
- ! is not yet launched or is crashed (data is also written in these cases, but with default values)
- IF ( TPFLYER%NMODEL == IMI .AND. &
- ( .NOT. TPFLYER%LFLY .OR. TPFLYER%LCRASH .OR. ABS( TPFLYER%TPOS_CUR - TDTCUR ) < 1.e-8 ) ) THEN
- !Do we have to store balloon data?
- CALL FLYER_CHECK_STORESTEP( TPFLYER )
- END IF
-
- ! In flight
- INFLIGHTONMODEL: IF ( TPFLYER%LFLY .AND. .NOT. TPFLYER%LCRASH .AND. TPFLYER%NMODEL == IMI &
- .AND. ABS( TPFLYER%TPOS_CUR - TDTCUR ) < 1.e-8 ) THEN
- ISOWNERBAL: IF ( TPFLYER%NRANK_CUR == ISP ) THEN
- CALL FLYER_INTERP_TO_MASSPOINTS()
-
- ZEXN(:,:,:) = FLYER_COMPUTE_EXNER( )
- ZRHO(:,:,:) = FLYER_COMPUTE_RHO( )
-
- ZTHW_FLUX(:,:,:) = ZRHO(:,:,:)*XCPD *XTHW_FLUX(II_M:II_M+1,IJ_M:IJ_M+1,:)
- ZRCW_FLUX(:,:,:) = ZRHO(:,:,:)*XLVTT*XRCW_FLUX(II_M:II_M+1,IJ_M:IJ_M+1,:)
- ZSVW_FLUX(:,:,:,:) = XSVW_FLUX(II_M:II_M+1,IJ_M:IJ_M+1,:,:)
-
- ! Compute coefficents for horizontal interpolations
- CALL FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE1( )
-
- IF ( GLAUNCH ) CALL BALLOON_COMPUTE_INITIAL_VERTICAL_POSITION( TPFLYER )
-
- ! Compute coefficents for vertical interpolations
- CALL FLYER_COMPUTE_INTERP_COEFF_VER( )
-
- CRASH_VERT: IF ( TPFLYER%LCRASH ) THEN
- TPFLYER%LFLY = .FALSE.
- WRITE( CMNHMSG(1), "( 'Balloon ', A, ' crashed the ', I2, '/', I2, '/', I4, ' at ', F18.12, &
- 's (too low or too high)' )" ) &
- TRIM( TPFLYER%CTITLE ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
- CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
- ELSE CRASH_VERT
- !No vertical crash
-
- ! Compute coefficents for horizontal interpolations
- CALL FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE2( )
-
- ! Check if it is the right moment to store data
- IF ( TPFLYER%LSTORE ) THEN
- ISTORE = TPFLYER%TFLYER_TIME%N_CUR
- IF ( ABS( TDTCUR - TPFLYER%TFLYER_TIME%TPDATES(ISTORE) ) < 1e-10 ) THEN
- CALL FLYER_RECORD_DATA( )
- END IF
- END IF
-
- ! Compute next horizontal position (balloon advection)
- CALL BALLOON_ADVECTION_HOR( TPFLYER )
-
- ! Compute next vertical position (balloon advection)
- CALL BALLOON_ADVECTION_VER( TPFLYER )
-
- TPFLYER%TPOS_CUR = TDTCUR + ZTSTEP
- END IF CRASH_VERT !end of no vertical crash branch
- END IF ISOWNERBAL
- END IF INFLIGHTONMODEL
-
- IF ( GOWNER_CUR ) KRANK_NXT = TPFLYER%NRANK_CUR
-END SELECT
-
-CONTAINS
-
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-SUBROUTINE BALLOON_COMPUTE_INITIAL_VERTICAL_POSITION( TPBALLOON )
-
-USE MODD_CST, ONLY: XCPD, XP00, XRD
-
-IMPLICIT NONE
-
-CLASS(TBALLOONDATA), INTENT(INOUT) :: TPBALLOON
-
-SELECT CASE ( TPBALLOON%CTYPE )
- !
- ! Iso-density balloon
- !
- CASE ( 'ISODEN' )
- IF ( TPBALLOON%XALTLAUNCH /= XNEGUNDEF ) THEN
- IK00 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(1,1,:)), 1)
- IK01 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(1,2,:)), 1)
- IK10 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(2,1,:)), 1)
- IK11 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(2,2,:)), 1)
- ZZCOEF00 = (TPBALLOON%XALTLAUNCH - ZZM(1,1,IK00)) / ( ZZM(1,1,IK00+1) - ZZM(1,1,IK00))
- ZZCOEF01 = (TPBALLOON%XALTLAUNCH - ZZM(1,2,IK01)) / ( ZZM(1,2,IK01+1) - ZZM(1,2,IK01))
- ZZCOEF10 = (TPBALLOON%XALTLAUNCH - ZZM(2,1,IK10)) / ( ZZM(2,1,IK10+1) - ZZM(2,1,IK10))
- ZZCOEF11 = (TPBALLOON%XALTLAUNCH - ZZM(2,2,IK11)) / ( ZZM(2,2,IK11+1) - ZZM(2,2,IK11))
- TPBALLOON%XRHO = FLYER_INTERP(ZRHO)
- ELSE IF ( TPBALLOON%XPRES /= XNEGUNDEF ) THEN
- ZFLYER_EXN = (TPBALLOON%XPRES/XP00)**(XRD/XCPD)
- IK00 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(1,1,:)), 1)
- IK01 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(1,2,:)), 1)
- IK10 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(2,1,:)), 1)
- IK11 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(2,2,:)), 1)
- ZZCOEF00 = (ZFLYER_EXN - ZEXN(1,1,IK00)) / ( ZEXN(1,1,IK00+1) - ZEXN(1,1,IK00))
- ZZCOEF01 = (ZFLYER_EXN - ZEXN(1,2,IK01)) / ( ZEXN(1,2,IK01+1) - ZEXN(1,2,IK01))
- ZZCOEF10 = (ZFLYER_EXN - ZEXN(2,1,IK10)) / ( ZEXN(2,1,IK10+1) - ZEXN(2,1,IK10))
- ZZCOEF11 = (ZFLYER_EXN - ZEXN(2,2,IK11)) / ( ZEXN(2,2,IK11+1) - ZEXN(2,2,IK11))
- TPBALLOON%XRHO = FLYER_INTERP(ZRHO)
- ELSE
- CMNHMSG(1) = 'Error in balloon initial position (balloon ' // TRIM(TPBALLOON%CTITLE) // ' )'
- CMNHMSG(2) = 'neither initial ALTITUDE or PRESsure is given'
- CMNHMSG(3) = 'Check your INI_BALLOON routine'
- CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
- END IF
- !
- ! Radiosounding balloon
- !
- CASE ( 'RADIOS' )
- TPBALLOON%XZ_CUR = TPBALLOON%XALTLAUNCH
- TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(1,1,IKB) )
- TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,1,IKB) )
- TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(1,2,IKB) )
- TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,2,IKB) )
- !
- ! Constant Volume Balloon
- !
- CASE ( 'CVBALL' )
- IF ( TPBALLOON%XALTLAUNCH /= XNEGUNDEF ) THEN
- IK00 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(1,1,:)), 1)
- IK01 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(1,2,:)), 1)
- IK10 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(2,1,:)), 1)
- IK11 = MAX ( COUNT (TPBALLOON%XALTLAUNCH >= ZZM(2,2,:)), 1)
- IF (IK00*IK01*IK10*IK11 .EQ. 0) THEN
- TPBALLOON%XZ_CUR = TPBALLOON%XALTLAUNCH
- TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(1,1,IKB) )
- TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,1,IKB) )
- TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(1,2,IKB) )
- TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,2,IKB) )
- ELSE
- ZZCOEF00 = (TPBALLOON%XALTLAUNCH - ZZM(1,1,IK00)) / ( ZZM(1,1,IK00+1) - ZZM(1,1,IK00))
- ZZCOEF01 = (TPBALLOON%XALTLAUNCH - ZZM(1,2,IK01)) / ( ZZM(1,2,IK01+1) - ZZM(1,2,IK01))
- ZZCOEF10 = (TPBALLOON%XALTLAUNCH - ZZM(2,1,IK10)) / ( ZZM(2,1,IK10+1) - ZZM(2,1,IK10))
- ZZCOEF11 = (TPBALLOON%XALTLAUNCH - ZZM(2,2,IK11)) / ( ZZM(2,2,IK11+1) - ZZM(2,2,IK11))
- TPBALLOON%XRHO = FLYER_INTERP(ZRHO)
- TPBALLOON%XZ_CUR = FLYER_INTERP(ZZM)
- END IF
- ELSE IF ( TPBALLOON%XPRES /= XNEGUNDEF ) THEN
- ZFLYER_EXN = (TPBALLOON%XPRES/XP00)**(XRD/XCPD)
- IK00 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(1,1,:)), 1)
- IK01 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(1,2,:)), 1)
- IK10 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(2,1,:)), 1)
- IK11 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(2,2,:)), 1)
- IF (IK00*IK01*IK10*IK11 .EQ. 0) THEN
- TPBALLOON%XZ_CUR = ZZM(1,1,IKB)
- TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,1,IKB) )
- TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(1,2,IKB) )
- TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,2,IKB) )
- ELSE
- ZZCOEF00 = (ZFLYER_EXN - ZEXN(1,1,IK00)) / ( ZEXN(1,1,IK00+1) - ZEXN(1,1,IK00))
- ZZCOEF01 = (ZFLYER_EXN - ZEXN(1,2,IK01)) / ( ZEXN(1,2,IK01+1) - ZEXN(1,2,IK01))
- ZZCOEF10 = (ZFLYER_EXN - ZEXN(2,1,IK10)) / ( ZEXN(2,1,IK10+1) - ZEXN(2,1,IK10))
- ZZCOEF11 = (ZFLYER_EXN - ZEXN(2,2,IK11)) / ( ZEXN(2,2,IK11+1) - ZEXN(2,2,IK11))
- TPBALLOON%XRHO = FLYER_INTERP(ZRHO)
- TPBALLOON%XZ_CUR = FLYER_INTERP(ZZM)
- END IF
- ELSE
- TPBALLOON%XRHO = TPBALLOON%XMASS / TPBALLOON%XVOLUME
- IK00 = MAX ( COUNT (TPBALLOON%XRHO <= ZRHO(1,1,:)), 1)
- IK01 = MAX ( COUNT (TPBALLOON%XRHO <= ZRHO(1,2,:)), 1)
- IK10 = MAX ( COUNT (TPBALLOON%XRHO <= ZRHO(2,1,:)), 1)
- IK11 = MAX ( COUNT (TPBALLOON%XRHO <= ZRHO(2,2,:)), 1)
- IF (IK00*IK01*IK10*IK11 .EQ. 0) THEN
- TPBALLOON%XZ_CUR = ZZM(1,1,IKB)
- TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,1,IKB) )
- TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(1,2,IKB) )
- TPBALLOON%XZ_CUR = MAX ( TPBALLOON%XZ_CUR , ZZM(2,2,IKB) )
- ELSE
- ZZCOEF00 = (TPBALLOON%XRHO - ZRHO(1,1,IK00)) / ( ZRHO(1,1,IK00+1) - ZRHO(1,1,IK00))
- ZZCOEF01 = (TPBALLOON%XRHO - ZRHO(1,2,IK01)) / ( ZRHO(1,2,IK01+1) - ZRHO(1,2,IK01))
- ZZCOEF10 = (TPBALLOON%XRHO - ZRHO(2,1,IK10)) / ( ZRHO(2,1,IK10+1) - ZRHO(2,1,IK10))
- ZZCOEF11 = (TPBALLOON%XRHO - ZRHO(2,2,IK11)) / ( ZRHO(2,2,IK11+1) - ZRHO(2,2,IK11))
- TPBALLOON%XZ_CUR = FLYER_INTERP(ZZM)
- END IF
- END IF
-END SELECT
-
-END SUBROUTINE BALLOON_COMPUTE_INITIAL_VERTICAL_POSITION
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-SUBROUTINE BALLOON_ADVECTION_HOR( TPBALLOON )
-
-USE MODD_AIRCRAFT_BALLOON, ONLY: TBALLOONDATA
-USE MODD_CONF, ONLY: LCARTESIAN
-USE MODD_NESTING, ONLY: NDAD, NDTRATIO
-USE MODD_TIME, only: TDTSEG
-USE MODD_TIME_n, ONLY: TDTCUR
-
-IMPLICIT NONE
-
-CLASS(TBALLOONDATA), INTENT(INOUT) :: TPBALLOON
-
-INTEGER :: IMODEL
-INTEGER :: IMODEL_OLD
-REAL :: ZX_OLD, ZY_OLD
-REAL :: ZDELTATIME
-REAL :: ZDIVTMP
-REAL :: ZMAP ! map factor at balloon location
-REAL :: ZU_BAL ! horizontal wind speed at balloon location (along x)
-REAL :: ZV_BAL ! horizontal wind speed at balloon location (along y)
-
-ZTSTEP = PTSTEP
-
-ZU_BAL = FLYER_INTERP_U(PU)
-ZV_BAL = FLYER_INTERP_V(PV)
-if ( .not. lcartesian ) then
- ZMAP = FLYER_INTERP_2D(PMAP)
-else
- ZMAP = 1.
-end if
-!
-ZX_OLD = TPBALLOON%XX_CUR
-ZY_OLD = TPBALLOON%XY_CUR
-
-TPBALLOON%XX_CUR = TPBALLOON%XX_CUR + ZU_BAL * ZTSTEP * ZMAP
-TPBALLOON%XY_CUR = TPBALLOON%XY_CUR + ZV_BAL * ZTSTEP * ZMAP
-
-! Compute rank and model for next position
-! This is done here because we need to check if there is a change of model (for 'MOB' balloons)
-! because position has to be adapted to the timestep of a coarser model (if necessary)
-IMODEL_OLD = TPBALLOON%NMODEL
-
-! Get rank of the process where the balloon is and the model number
-CALL FLYER_GET_RANK_MODEL_ISCRASHED( TPBALLOON )
-
-IF ( TPBALLOON%LCRASH ) THEN
- WRITE( CMNHMSG(1), "( 'Balloon ', A, ' crashed the ', I2, '/', I2, '/', I4, ' at ', F18.12, &
- 's (out of the horizontal boundaries)' )" ) &
- TRIM( TPBALLOON%CTITLE ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
- CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
-END IF
-
-IF ( TPBALLOON%NMODEL /= IMODEL_OLD .AND. .NOT. TPBALLOON%LCRASH ) THEN
- ! Balloon has changed of model
- IF ( NDAD(TPBALLOON%NMODEL ) == IMODEL_OLD ) THEN
- ! Nothing special to do when going to child model
- ELSE IF ( TPBALLOON%NMODEL == NDAD(IMODEL_OLD) ) THEN
- ! Balloon go to parent model
- ! Recompute position to be compatible with parent timestep
- ! Parent timestep could be bigger (factor NDTRATIO) and therefore next position is not the one computed just before
-
- ! Determine step compatible with parent model at next parent timestep
- ZDELTATIME = TDTCUR - TDTSEG
- ZDIVTMP = ZDELTATIME / ( PTSTEP * NDTRATIO(IMODEL_OLD) )
- IF ( ABS( ZDIVTMP - NINT( ZDIVTMP ) ) < 1E-6 * PTSTEP * NDTRATIO(IMODEL_OLD) ) THEN
- ! Current time is a multiple of parent timestep => next position is parent timestep
- ZTSTEP = ZTSTEP * NDTRATIO(IMODEL_OLD)
- ELSE
- ! Current time is not a multiple of parent timestep
- ! Next position must be a multiple of parent timestep
- ! NINT( NDTRATIO(IMODEL_OLD) * ( 1 - ( ZDIVTMP - INT( ZDIVTMP ) ) ) ) corresponds to the number
- ! of child timesteps to go to the next parent timestep
- ! We skip one timestep (+NDTRATIO(IMODEL_OLD)) because it has already been computed for the parent model
- ZTSTEP = ZTSTEP * ( NINT( NDTRATIO(IMODEL_OLD) * ( 1 - ( ZDIVTMP - INT( ZDIVTMP ) ) ) ) + NDTRATIO(IMODEL_OLD) )
-
- ! Detect if we need to skip a store (if time of next position is after time of next store)
- ! This can happen when a ballon goes to its parent model
- IF ( TDTCUR + ZTSTEP > TPBALLOON%TFLYER_TIME%TPDATES(TPBALLOON%TFLYER_TIME%N_CUR) + TPBALLOON%TFLYER_TIME%XTSTEP + 1e-6 ) THEN
- !Force a dummy store (nothing is computed, therefore default/initial values will be stored)
- TPBALLOON%LSTORE = .TRUE.
-
- TPBALLOON%TFLYER_TIME%N_CUR = TPBALLOON%TFLYER_TIME%N_CUR + 1
- ISTORE = TPBALLOON%TFLYER_TIME%N_CUR
-
- !Remark: by construction here, ISTORE is always > 1 => no risk with ISTORE-1 value
- TPBALLOON%TFLYER_TIME%TPDATES(ISTORE) = TPBALLOON%TFLYER_TIME%TPDATES(ISTORE-1) + TPBALLOON%TFLYER_TIME%XTSTEP
-
- WRITE( CMNHMSG(1), "( 'Balloon ', A, ': store skipped at ', I2, '/', I2, '/', I4, ' at ', F18.12, 's' )" ) &
- TRIM( TPBALLOON%CTITLE ), &
- TPBALLOON%TFLYER_TIME%TPDATES(ISTORE)%NDAY, TPBALLOON%TFLYER_TIME%TPDATES(ISTORE)%NMONTH, &
- TPBALLOON%TFLYER_TIME%TPDATES(ISTORE)%NYEAR, TPBALLOON%TFLYER_TIME%TPDATES(ISTORE)%XTIME
- CMNHMSG(2) = 'due to change of model (child to its parent)'
- CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
- END IF
- END IF
-
- ! Compute new horizontal position
- TPBALLOON%XX_CUR = TPBALLOON%XX_CUR + ZU_BAL * ZTSTEP * ZMAP
- TPBALLOON%XY_CUR = TPBALLOON%XY_CUR + ZV_BAL * ZTSTEP * ZMAP
-
- ! Get rank of the process where the balloon is and the model number
- ! Model number is now imposed
- IMODEL = TPBALLOON%NMODEL
- CALL FLYER_GET_RANK_MODEL_ISCRASHED( TPBALLOON, KMODEL = IMODEL )
- IF ( TPBALLOON%LCRASH ) THEN
- WRITE( CMNHMSG(1), "( 'Balloon ', A, ' crashed the ', I2, '/', I2, '/', I4, ' at ', F18.12, &
- 's (out of the horizontal boundaries)' )" ) &
- TRIM( TPBALLOON%CTITLE ), TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
- CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
- END IF
- ELSE
- ! Special case not-managed (different dads, change of several models in 1 step (going to grand parent/grand children)...)
- ! This situation should be very infrequent => reasonable risk, error on the trajectory should be relatively small in most cases
- CMNHMSG(1) = 'unmanaged change of model for ballon ' // TPBALLOON%CTITLE
- CMNHMSG(2) = 'its trajectory might be wrong'
- CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_EVOL', OLOCAL = .TRUE. )
- END IF
-END IF
-
-END SUBROUTINE BALLOON_ADVECTION_HOR
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-SUBROUTINE BALLOON_ADVECTION_VER( TPBALLOON )
-
-USE MODD_AIRCRAFT_BALLOON, ONLY: TBALLOONDATA
-USE MODD_CST, ONLY: XG
-
-IMPLICIT NONE
-
-CLASS(TBALLOONDATA), INTENT(INOUT) :: TPBALLOON
-
-INTEGER :: JK ! loop index
-REAL :: ZRO_BAL ! air density at balloon location
-REAL :: ZW_BAL ! vertical wind speed at balloon location (along z)
-
-IF ( TPBALLOON%CTYPE == 'RADIOS' ) THEN
- ZW_BAL = FLYER_INTERP(ZWM)
- TPBALLOON%XZ_CUR = TPBALLOON%XZ_CUR + ( ZW_BAL + TPBALLOON%XWASCENT ) * ZTSTEP
-END IF
-
-IF ( TPBALLOON%CTYPE == 'CVBALL' ) THEN
- ZW_BAL = FLYER_INTERP(ZWM)
- ZRO_BAL = FLYER_INTERP(ZRHO)
- ! calculation with a time step of 1 second or less
- IF (INT(ZTSTEP) .GT. 1 ) THEN
- DO JK=1,INT(ZTSTEP)
- TPBALLOON%XWASCENT = TPBALLOON%XWASCENT &
- - ( 1. / (1. + TPBALLOON%XINDDRAG ) ) * 1. * &
- ( XG * ( ( TPBALLOON%XMASS / TPBALLOON%XVOLUME ) - ZRO_BAL ) / ( TPBALLOON%XMASS / TPBALLOON%XVOLUME ) &
- + TPBALLOON%XWASCENT * ABS ( TPBALLOON%XWASCENT ) * &
- TPBALLOON%XDIAMETER * TPBALLOON%XAERODRAG / ( 2. * TPBALLOON%XVOLUME ) &
- )
- TPBALLOON%XZ_CUR = TPBALLOON%XZ_CUR + ( ZW_BAL + TPBALLOON%XWASCENT ) * 1.
- END DO
- END IF
- IF (ZTSTEP .GT. INT(ZTSTEP)) THEN
- TPBALLOON%XWASCENT = TPBALLOON%XWASCENT &
- - ( 1. / (1. + TPBALLOON%XINDDRAG ) ) * (ZTSTEP-INT(ZTSTEP)) * &
- ( XG * ( ( TPBALLOON%XMASS / TPBALLOON%XVOLUME ) - ZRO_BAL ) / ( TPBALLOON%XMASS / TPBALLOON%XVOLUME ) &
- + TPBALLOON%XWASCENT * ABS ( TPBALLOON%XWASCENT ) * &
- TPBALLOON%XDIAMETER * TPBALLOON%XAERODRAG / ( 2. * TPBALLOON%XVOLUME ) &
- )
- TPBALLOON%XZ_CUR = TPBALLOON%XZ_CUR + ( ZW_BAL + TPBALLOON%XWASCENT ) * (ZTSTEP-INT(ZTSTEP))
- END IF
-END IF
-
-END SUBROUTINE BALLOON_ADVECTION_VER
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-SUBROUTINE FLYER_INTERP_TO_MASSPOINTS()
-
-USE MODD_GRID_n, ONLY: XXHAT, XXHATM, XYHAT, XYHATM
-USE MODD_PARAMETERS, ONLY: JPVEXT
-
-IMPLICIT NONE
-
-INTEGER :: IDU ! difference between II_U and II_M
-INTEGER :: IDV ! difference between IJ_V and IJ_M
-
-! Indices
-IKB = 1 + JPVEXT
-IKE = SIZE(PZ,3) - JPVEXT
-
-! Interpolations of model variables to mass points
-! ------------------------------------------------
-
-! X position
-II_U = COUNT( XXHAT (:) <= TPFLYER%XX_CUR )
-II_M = COUNT( XXHATM(:) <= TPFLYER%XX_CUR )
-
-! Y position
-IJ_V=COUNT( XYHAT (:)<=TPFLYER%XY_CUR )
-IJ_M=COUNT( XYHATM(:)<=TPFLYER%XY_CUR )
-ZZM(:,:,1:IKU-1)=0.5 *PZ(II_M :II_M+1,IJ_M :IJ_M+1,1:IKU-1)+0.5 *PZ(II_M :II_M+1,IJ_M :IJ_M+1,2:IKU )
-ZZM(:,:, IKU )=1.5 *PZ(II_M :II_M+1,IJ_M :IJ_M+1, IKU-1)-0.5 *PZ(II_M :II_M+1,IJ_M :IJ_M+1, IKU-2)
-
-IDU = II_U - II_M
-ZZU(:,:,1:IKU-1)=0.25*PZ(IDU+II_M-1:IDU+II_M, IJ_M :IJ_M+1,1:IKU-1)+0.25*PZ(IDU+II_M-1:IDU+II_M ,IJ_M :IJ_M+1,2:IKU ) &
- +0.25*PZ(IDU+II_M :IDU+II_M+1,IJ_M :IJ_M+1,1:IKU-1)+0.25*PZ(IDU+II_M :IDU+II_M+1,IJ_M :IJ_M+1,2:IKU )
-ZZU(:,:, IKU )=0.75*PZ(IDU+II_M-1:IDU+II_M ,IJ_M :IJ_M+1, IKU-1)-0.25*PZ(IDU+II_M-1:IDU+II_M ,IJ_M :IJ_M+1, IKU-2) &
- +0.75*PZ(IDU+II_M :IDU+II_M+1,IJ_M :IJ_M+1, IKU-1)-0.25*PZ(IDU+II_M :IDU+II_M+1,IJ_M :IJ_M+1, IKU-2)
-
-IDV = IJ_V - IJ_M
-ZZV(:,:,1:IKU-1)=0.25*PZ(II_M :II_M+1,IDV+IJ_M-1:IDV+IJ_M ,1:IKU-1)+0.25*PZ(II_M :II_M+1,IDV+IJ_M-1:IDV+IJ_M ,2:IKU ) &
- +0.25*PZ(II_M :II_M+1,IDV+IJ_M :IDV+IJ_M+1,1:IKU-1)+0.25*PZ(II_M :II_M+1,IDV+IJ_M :IDV+IJ_M+1,2:IKU )
-ZZV(:,:, IKU )=0.75*PZ(II_M :II_M+1,IDV+IJ_M-1:IDV+IJ_M , IKU-1)-0.25*PZ(II_M :II_M+1,IDV+IJ_M-1:IDV+IJ_M , IKU-2) &
- +0.75*PZ(II_M :II_M+1,IDV+IJ_M :IDV+IJ_M+1, IKU-1)-0.25*PZ(II_M :II_M+1,IDV+IJ_M :IDV+IJ_M+1, IKU-2)
-
-ZWM(:,:,1:IKU-1)=0.5*PW(II_M:II_M+1,IJ_M:IJ_M+1,1:IKU-1)+0.5*PW(II_M:II_M+1,IJ_M:IJ_M+1,2:IKU )
-ZWM(:,:, IKU )=1.5*PW(II_M:II_M+1,IJ_M:IJ_M+1, IKU-1)-0.5*PW(II_M:II_M+1,IJ_M:IJ_M+1, IKU-2)
-
-END SUBROUTINE FLYER_INTERP_TO_MASSPOINTS
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-PURE FUNCTION FLYER_COMPUTE_EXNER( ) RESULT( PEXN )
-
-USE MODD_CST, ONLY: XCPD, XP00, XRD
-
-IMPLICIT NONE
-
-REAL, DIMENSION(2,2,SIZE(PTH,3)) :: PEXN
-
-INTEGER :: JK
-
-PEXN(:,:,:) = ( PP(II_M:II_M+1, IJ_M:IJ_M+1, :) / XP00) ** ( XRD / XCPD )
-DO JK = IKB-1, 1, -1
- PEXN(:,:,JK) = 1.5 * PEXN(:,:,JK+1) - 0.5 * PEXN(:,:,JK+2)
-END DO
-DO JK = IKE+1, IKU
- PEXN(:,:,JK) = 1.5 * PEXN(:,:,JK-1) - 0.5 * PEXN(:,:,JK-2)
-END DO
-
-END FUNCTION FLYER_COMPUTE_EXNER
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-PURE FUNCTION FLYER_COMPUTE_RHO( ) RESULT( PRHO )
-
-USE MODD_CST, ONLY: XRD, XRV
-
-USE MODI_WATER_SUM
-
-IMPLICIT NONE
-
-REAL, DIMENSION(2,2,SIZE(PTH,3)) :: PRHO
-
-INTEGER :: JK
-REAL, DIMENSION(2,2,SIZE(PTH,3)) :: ZTHV ! virtual potential temperature
-
-ZTHV(:,:,:) = PTH(II_M:II_M+1, IJ_M:IJ_M+1, :)
-IF ( SIZE( PR, 4 ) > 0 ) &
- ZTHV(:,:,:) = ZTHV(:,:,:) * ( 1. + XRV / XRD * PR(II_M:II_M+1, IJ_M:IJ_M+1, :, 1) ) &
- / ( 1. + WATER_SUM( PR(II_M:II_M+1, IJ_M:IJ_M+1, :, :)) )
-!
-PRHO(:,:,:) = PP(II_M:II_M+1, IJ_M:IJ_M+1, :) / ( XRD * ZTHV(:,:,:) * ZEXN(:,:,:) )
-DO JK = IKB-1, 1, -1
- PRHO(:,:,JK) = 1.5 * PRHO(:,:,JK+1) - 0.5 * PRHO(:,:,JK+2)
-END DO
-DO JK = IKE+1, IKU
- PRHO(:,:,JK) = 1.5 * PRHO(:,:,JK-1) - 0.5 * PRHO(:,:,JK-2)
-END DO
-
-END FUNCTION FLYER_COMPUTE_RHO
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-SUBROUTINE FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE1( )
-! Compute coefficents for horizontal interpolations (1st stage)
-
-USE MODD_GRID_n, ONLY: XXHAT, XXHATM, XYHAT, XYHATM
-
-IMPLICIT NONE
-
-! Interpolation coefficient for X
-ZXCOEF = (TPFLYER%XX_CUR - XXHATM(II_M)) / (XXHATM(II_M+1) - XXHATM(II_M))
-ZXCOEF = MAX (0.,MIN(ZXCOEF,1.))
-
-! Interpolation coefficient for y
-ZYCOEF = (TPFLYER%XY_CUR - XYHATM(IJ_M)) / (XYHATM(IJ_M+1) - XYHATM(IJ_M))
-ZYCOEF = MAX (0.,MIN(ZYCOEF,1.))
-
-! Interpolation coefficient for X (for U)
-ZUCOEF = (TPFLYER%XX_CUR - XXHAT(II_U)) / (XXHAT(II_U+1) - XXHAT(II_U))
-ZUCOEF = MAX(0.,MIN(ZUCOEF,1.))
-
-! Interpolation coefficient for y (for V)
-ZVCOEF = (TPFLYER%XY_CUR - XYHAT(IJ_V)) / (XYHAT(IJ_V+1) - XYHAT(IJ_V))
-ZVCOEF = MAX(0.,MIN(ZVCOEF,1.))
-
-END SUBROUTINE FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE1
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-SUBROUTINE FLYER_COMPUTE_INTERP_COEFF_VER( )
-! Compute coefficent for vertical interpolations
-
-USE MODD_CST, ONLY: XCPD, XP00, XRD
-USE MODD_TIME_n, ONLY: TDTCUR
-
-IMPLICIT NONE
-
-! Find indices surrounding the vertical box where the flyer is
-SELECT TYPE ( TPFLYER )
- CLASS IS ( TAIRCRAFTDATA)
- IF ( TPFLYER%LALTDEF ) THEN
- ZFLYER_EXN = (TPFLYER%XP_CUR/XP00)**(XRD/XCPD)
- IK00 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(1,1,:)), 1)
- IK01 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(1,2,:)), 1)
- IK10 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(2,1,:)), 1)
- IK11 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(2,2,:)), 1)
- ELSE
- IK00 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(1,1,:)), 1)
- IK01 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(1,2,:)), 1)
- IK10 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(2,1,:)), 1)
- IK11 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(2,2,:)), 1)
- END IF
-
- CLASS IS ( TBALLOONDATA)
- IF ( TPFLYER%CTYPE == 'ISODEN' ) THEN
- IK00 = MAX ( COUNT (TPFLYER%XRHO <= ZRHO(1,1,:)), 1)
- IK01 = MAX ( COUNT (TPFLYER%XRHO <= ZRHO(1,2,:)), 1)
- IK10 = MAX ( COUNT (TPFLYER%XRHO <= ZRHO(2,1,:)), 1)
- IK11 = MAX ( COUNT (TPFLYER%XRHO <= ZRHO(2,2,:)), 1)
- ELSE IF ( TPFLYER%CTYPE == 'RADIOS' .OR. TPFLYER%CTYPE == 'CVBALL' ) THEN
- IK00 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(1,1,:)), 1)
- IK01 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(1,2,:)), 1)
- IK10 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(2,1,:)), 1)
- IK11 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZM(2,2,:)), 1)
- END IF
-
-END SELECT
-
-! Do not allow crash on the ground: set position on the ground if too low
-IF ( ANY( [ IK00, IK01, IK10, IK11 ] < IKB ) ) THEN
- !Minimum altitude is on the ground at IKB (no crash if too low)
- IK00 = MAX ( IK00, IKB )
- IK01 = MAX ( IK01, IKB )
- IK10 = MAX ( IK10, IKB )
- IK11 = MAX ( IK11, IKB )
-
- CMNHMSG(1) = 'flyer ' // TRIM( TPFLYER%CTITLE ) // ' is near the ground'
- WRITE( CMNHMSG(2), "( 'at ', I2, '/', I2, '/', I4, ' ', F18.12, 's' )" ) &
- TDTCUR%NDAY, TDTCUR%NMONTH, TDTCUR%NYEAR, TDTCUR%XTIME
- CALL PRINT_MSG( NVERB_INFO, 'GEN', 'FLYER_COMPUTE_INTERP_COEFF_VER', OLOCAL = .TRUE. )
-END IF
-
-! ! Check if the flyer crashed vertically (lower bound)
-! IF (IK00 < IKB .OR. IK01 < IKB .OR. IK10 < IKB .OR. IK11 < IKB ) THEN
-! TPFLYER%LCRASH = .TRUE.
-! TPFLYER%NCRASH = NCRASH_OUT_LOW
-! END IF
-
-! Check if the flyer crashed vertically (higher bound)
-IF (IK00 >= IKE .OR. IK01 >= IKE .OR. IK10 >= IKE .OR. IK11 >= IKE ) THEN
- TPFLYER%LCRASH = .TRUE.
- TPFLYER%NCRASH = NCRASH_OUT_HIGH
-END IF
-
-SELECT TYPE ( TPFLYER )
- CLASS IS ( TBALLOONDATA)
- IF ( TPFLYER%LCRASH ) RETURN
-END SELECT
-
-! Interpolation coefficients for the 4 suroundings verticals
-SELECT TYPE ( TPFLYER )
- CLASS IS ( TAIRCRAFTDATA)
- IF ( TPFLYER%LALTDEF ) THEN
- ZZCOEF00 = (ZFLYER_EXN - ZEXN(1,1,IK00)) / ( ZEXN(1,1,IK00+1) - ZEXN(1,1,IK00) )
- ZZCOEF01 = (ZFLYER_EXN - ZEXN(1,2,IK01)) / ( ZEXN(1,2,IK01+1) - ZEXN(1,2,IK01) )
- ZZCOEF10 = (ZFLYER_EXN - ZEXN(2,1,IK10)) / ( ZEXN(2,1,IK10+1) - ZEXN(2,1,IK10) )
- ZZCOEF11 = (ZFLYER_EXN - ZEXN(2,2,IK11)) / ( ZEXN(2,2,IK11+1) - ZEXN(2,2,IK11) )
- TPFLYER%XZ_CUR = FLYER_INTERP(ZZM)
- ELSE
- ZZCOEF00 = (TPFLYER%XZ_CUR - ZZM(1,1,IK00)) / ( ZZM(1,1,IK00+1) - ZZM(1,1,IK00) )
- ZZCOEF01 = (TPFLYER%XZ_CUR - ZZM(1,2,IK01)) / ( ZZM(1,2,IK01+1) - ZZM(1,2,IK01) )
- ZZCOEF10 = (TPFLYER%XZ_CUR - ZZM(2,1,IK10)) / ( ZZM(2,1,IK10+1) - ZZM(2,1,IK10) )
- ZZCOEF11 = (TPFLYER%XZ_CUR - ZZM(2,2,IK11)) / ( ZZM(2,2,IK11+1) - ZZM(2,2,IK11) )
- TPFLYER%XP_CUR = FLYER_INTERP(PP)
- END IF
-
- CLASS IS ( TBALLOONDATA)
- IF ( TPFLYER%CTYPE == 'ISODEN' ) THEN
- ZZCOEF00 = (TPFLYER%XRHO - ZRHO(1,1,IK00)) / ( ZRHO(1,1,IK00+1) - ZRHO(1,1,IK00) )
- ZZCOEF01 = (TPFLYER%XRHO - ZRHO(1,2,IK01)) / ( ZRHO(1,2,IK01+1) - ZRHO(1,2,IK01) )
- ZZCOEF10 = (TPFLYER%XRHO - ZRHO(2,1,IK10)) / ( ZRHO(2,1,IK10+1) - ZRHO(2,1,IK10) )
- ZZCOEF11 = (TPFLYER%XRHO - ZRHO(2,2,IK11)) / ( ZRHO(2,2,IK11+1) - ZRHO(2,2,IK11) )
- TPFLYER%XZ_CUR = FLYER_INTERP(ZZM)
- ELSE IF ( TPFLYER%CTYPE == 'RADIOS' .OR. TPFLYER%CTYPE == 'CVBALL' ) THEN
- ZZCOEF00 = (TPFLYER%XZ_CUR - ZZM(1,1,IK00)) / ( ZZM(1,1,IK00+1) - ZZM(1,1,IK00) )
- ZZCOEF01 = (TPFLYER%XZ_CUR - ZZM(1,2,IK01)) / ( ZZM(1,2,IK01+1) - ZZM(1,2,IK01) )
- ZZCOEF10 = (TPFLYER%XZ_CUR - ZZM(2,1,IK10)) / ( ZZM(2,1,IK10+1) - ZZM(2,1,IK10) )
- ZZCOEF11 = (TPFLYER%XZ_CUR - ZZM(2,2,IK11)) / ( ZZM(2,2,IK11+1) - ZZM(2,2,IK11) )
- END IF
-
-END SELECT
-
-END SUBROUTINE FLYER_COMPUTE_INTERP_COEFF_VER
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-SUBROUTINE FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE2( )
-! Compute coefficents for horizontal interpolations (2nd stage)
-! This stage must be done after FLYER_COMPUTE_INTERP_COEFF_VER because we should need XZ_CUR computed in it
-
-IMPLICIT NONE
-
-! Interpolation coefficients for the 4 suroundings verticals (for U)
-IU00 = MAX( COUNT (TPFLYER%XZ_CUR >= ZZU(1,1,:)), 1)
-IU01 = MAX( COUNT (TPFLYER%XZ_CUR >= ZZU(1,2,:)), 1)
-IU10 = MAX( COUNT (TPFLYER%XZ_CUR >= ZZU(2,1,:)), 1)
-IU11 = MAX( COUNT (TPFLYER%XZ_CUR >= ZZU(2,2,:)), 1)
-ZUCOEF00 = (TPFLYER%XZ_CUR - ZZU(1,1,IU00)) / ( ZZU(1,1,IU00+1) - ZZU(1,1,IU00) )
-ZUCOEF01 = (TPFLYER%XZ_CUR - ZZU(1,2,IU01)) / ( ZZU(1,2,IU01+1) - ZZU(1,2,IU01) )
-ZUCOEF10 = (TPFLYER%XZ_CUR - ZZU(2,1,IU10)) / ( ZZU(2,1,IU10+1) - ZZU(2,1,IU10) )
-ZUCOEF11 = (TPFLYER%XZ_CUR - ZZU(2,2,IU11)) / ( ZZU(2,2,IU11+1) - ZZU(2,2,IU11) )
-
-! Interpolation coefficients for the 4 suroundings verticals (for V)
-IV00 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZV(1,1,:)), 1)
-IV01 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZV(1,2,:)), 1)
-IV10 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZV(2,1,:)), 1)
-IV11 = MAX ( COUNT (TPFLYER%XZ_CUR >= ZZV(2,2,:)), 1)
-ZVCOEF00 = (TPFLYER%XZ_CUR - ZZV(1,1,IV00)) / ( ZZV(1,1,IV00+1) - ZZV(1,1,IV00) )
-ZVCOEF01 = (TPFLYER%XZ_CUR - ZZV(1,2,IV01)) / ( ZZV(1,2,IV01+1) - ZZV(1,2,IV01) )
-ZVCOEF10 = (TPFLYER%XZ_CUR - ZZV(2,1,IV10)) / ( ZZV(2,1,IV10+1) - ZZV(2,1,IV10) )
-ZVCOEF11 = (TPFLYER%XZ_CUR - ZZV(2,2,IV11)) / ( ZZV(2,2,IV11+1) - ZZV(2,2,IV11) )
-
-END SUBROUTINE FLYER_COMPUTE_INTERP_COEFF_HOR_STAGE2
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-SUBROUTINE FLYER_RECORD_DATA( )
-
-USE MODD_CST, ONLY: XCPD, XLAM_CRAD, XLIGHTSPEED, XP00, XPI, XRD, XRHOLW, XTT
-USE MODD_DIAG_IN_RUN, ONLY: LDIAG_IN_RUN, XCURRENT_TKE_DISS
-USE MODD_GRID, ONLY: XBETA, XLON0, XRPK
-USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_NI
-USE MODD_PARAMETERS, ONLY: JPVEXT
-USE MODD_PARAM_ICE_n, ONLY: LSNOW_T_I => LSNOW_T
-USE MODD_PARAM_LIMA, ONLY: LSNOW_T_L => LSNOW_T, &
- XALPHAR_L => XALPHAR, XNUR_L => XNUR, XALPHAS_L => XALPHAS, XNUS_L => XNUS, &
- XALPHAG_L => XALPHAG, XNUG_L => XNUG, XALPHAI_L => XALPHAI, XNUI_L => XNUI, &
- XRTMIN_L => XRTMIN, XALPHAC_L => XALPHAC, XNUC_L => XNUC
-USE MODD_PARAM_LIMA_COLD, ONLY: XAI_L => XAI, XBI_L => XBI, XLBEXS_L => XLBEXS,XLBS_L => XLBS,XCCS_L => XCCS, &
- XAS_L => XAS, XBS_L => XBS, XCXS_L => XCXS, &
- XLBDAS_MAX_L => XLBDAS_MAX, XLBDAS_MIN_L => XLBDAS_MIN, &
- XNS_L => XNS, XTRANS_MP_GAMMAS_L=>XTRANS_MP_GAMMAS
-USE MODD_PARAM_LIMA_MIXED, ONLY: XLBEXG_L => XLBEXG, XLBG_L => XLBG, XCCG_L => XCCG, XAG_L => XAG, XBG_L => XBG, XCXG_L => XCXG
-USE MODD_PARAM_LIMA_WARM, ONLY: XAC_L => XAC, XAR_L => XAR, XBC_L => XBC, XBR_L => XBR
-USE MODD_PARAM_n, ONLY: CCLOUD, CSURF
-USE MODD_RAIN_ICE_DESCR_n, ONLY: XALPHAR_I => XALPHAR, XNUR_I => XNUR, XLBEXR_I => XLBEXR, &
- XLBR_I => XLBR, XCCR_I => XCCR, XBR_I => XBR, XAR_I => XAR, &
- XALPHAC_I => XALPHAC, XNUC_I => XNUC, XBC_I => XBC, XAC_I => XAC, &
- XALPHAC2_I => XALPHAC2, XNUC2_I => XNUC2, &
- XALPHAS_I => XALPHAS, XNUS_I => XNUS, XLBEXS_I => XLBEXS, &
- XLBS_I => XLBS, XCCS_I => XCCS, XAS_I => XAS, XBS_I => XBS, XCXS_I => XCXS, &
- XALPHAG_I => XALPHAG, XNUG_I => XNUG, XLBEXG_I => XLBEXG, &
- XLBG_I => XLBG, XCCG_I => XCCG, XAG_I => XAG, XBG_I => XBG, XCXG_I => XCXG, &
- XALPHAI_I => XALPHAI, XNUI_I => XNUI, XLBEXI_I => XLBEXI, &
- XLBI_I => XLBI, XAI_I => XAI, XBI_I => XBI, &
- XNS_I => XNS, XRTMIN_I => XRTMIN, XCONC_LAND, XCONC_SEA, &
- XLBDAS_MAX_I => XLBDAS_MAX, XLBDAS_MIN_I => XLBDAS_MIN, &
- XTRANS_MP_GAMMAS_I => XTRANS_MP_GAMMAS
-
-USE MODE_FGAU, ONLY: GAULAG
-USE MODE_FSCATTER, ONLY: BHMIE, MOMG, MG, QEPSI, QEPSW
-USE MODE_GRIDPROJ, ONLY: SM_LATLON
-
-USE MODI_GAMMA, ONLY: GAMMA
-
-IMPLICIT NONE
-
-INTEGER, PARAMETER :: JPTS_GAULAG = 7 ! number of points for Gauss-Laguerre quadrature
-
-INTEGER :: JK ! loop index
-INTEGER :: JLOOP ! loop counter
-REAL, DIMENSION(SIZE(PR,3)) :: ZTEMPZ! vertical profile of temperature
-REAL, DIMENSION(SIZE(PR,3)) :: ZRHODREFZ ! vertical profile of dry air density of the reference state
-REAL, DIMENSION(SIZE(PR,3)) :: ZCIT ! pristine ice concentration
-REAL, DIMENSION(SIZE(PR,3)) :: ZCCI,ZCCR,ZCCC ! ICE,RAIN CLOUD concentration (LIMA)
-REAL, DIMENSION(SIZE(PR,1),SIZE(PR,2),SIZE(PR,3)) :: ZR
-REAL, DIMENSION(SIZE(PR,3),SIZE(PR,4)+1) :: ZRZ ! vertical profile of hydrometeor mixing ratios
-REAL :: ZA, ZB, ZCC, ZCX, ZALPHA, ZNS, ZNU, ZLB, ZLBEX, ZRHOHYD ! generic microphysical parameters
-INTEGER :: JJ ! loop counter for quadrature
-COMPLEX :: QMW,QMI,QM,QEPSIW,QEPSWI ! dielectric parameter
-REAL :: ZAETOT,ZAETMP,ZREFLOC,ZQSCA,ZQBACK,ZQEXT ! temporary scattering parameters
-REAL,DIMENSION(:),ALLOCATABLE :: ZAELOC,ZZMZ ! temporary arrays
-REAL :: ZLBDA ! slope distribution parameter
-REAL :: ZDELTA_EQUIV ! mass-equivalent Gauss-Laguerre point
-REAL :: ZFW ! liquid fraction
-REAL :: ZFPW ! weight for mixed-phase reflectivity
-REAL :: ZN ! number concentration
-REAL,DIMENSION(:),ALLOCATABLE :: ZX,ZW ! Gauss-Laguerre points and weights
-REAL,DIMENSION(:),ALLOCATABLE :: ZRTMIN ! local values for XRTMIN
-LOGICAL :: GCALC
-REAL :: ZGAM ! rotation between meso-nh base and spherical lat-lon base.
-REAL :: ZU_BAL ! horizontal wind speed at balloon location (along x)
-REAL :: ZV_BAL ! horizontal wind speed at balloon location (along y)
-
-TPFLYER%NMODELHIST(ISTORE) = TPFLYER%NMODEL
-
-TPFLYER%XX(ISTORE) = TPFLYER%XX_CUR
-TPFLYER%XY(ISTORE) = TPFLYER%XY_CUR
-TPFLYER%XZ(ISTORE) = TPFLYER%XZ_CUR
-!
-CALL SM_LATLON(PLATOR,PLONOR, &
- TPFLYER%XX_CUR, TPFLYER%XY_CUR, &
- TPFLYER%XLAT(ISTORE), TPFLYER%XLON(ISTORE) )
-!
-ZU_BAL = FLYER_INTERP_U(PU)
-ZV_BAL = FLYER_INTERP_V(PV)
-ZGAM = (XRPK * (TPFLYER%XLON(ISTORE) - XLON0) - XBETA)*(XPI/180.)
-TPFLYER%XZON (ISTORE) = ZU_BAL * COS(ZGAM) + ZV_BAL * SIN(ZGAM)
-TPFLYER%XMER (ISTORE) = - ZU_BAL * SIN(ZGAM) + ZV_BAL * COS(ZGAM)
-!
-TPFLYER%XW (ISTORE) = FLYER_INTERP(ZWM)
-TPFLYER%XTH (ISTORE) = FLYER_INTERP(PTH)
-!
-ZFLYER_EXN = FLYER_INTERP(ZEXN)
-TPFLYER%XP (ISTORE) = XP00 * ZFLYER_EXN**(XCPD/XRD)
-
-ZR(:,:,:) = 0.
-DO JLOOP=1,SIZE(PR,4)
- TPFLYER%XR (ISTORE,JLOOP) = FLYER_INTERP(PR(:,:,:,JLOOP))
- IF (JLOOP>=2) ZR(:,:,:) = ZR(:,:,:) + PR(:,:,:,JLOOP)
-END DO
-DO JLOOP=1,SIZE(PSV,4)
- TPFLYER%XSV (ISTORE,JLOOP) = FLYER_INTERP(PSV(:,:,:,JLOOP))
-END DO
-TPFLYER%XRTZ (ISTORE,:) = FLYER_INTERPZ(ZR(:,:,:))
-DO JLOOP=1,SIZE(PR,4)
- TPFLYER%XRZ (ISTORE,:,JLOOP) = FLYER_INTERPZ(PR(:,:,:,JLOOP))
-END DO
-
-TPFLYER%XFFZ (ISTORE,:) = FLYER_INTERPZ(SQRT(PU**2+PV**2))
-
-IF (CCLOUD=="LIMA") THEN
- TPFLYER%XCIZ (ISTORE,:) = FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NI))
- TPFLYER%XCCZ (ISTORE,:) = FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NC))
- TPFLYER%XCRZ (ISTORE,:) = FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NR))
-ELSE IF ( CCLOUD=="ICE3" .OR. CCLOUD=="ICE4" ) THEN
- TPFLYER%XCIZ (ISTORE,:) = FLYER_INTERPZ(PCIT(:,:,:))
-END IF
-! initialization CRARE and CRARE_ATT + LWC and IWC
-TPFLYER%XCRARE(ISTORE,:) = 0.
-TPFLYER%XCRARE_ATT(ISTORE,:) = 0.
-TPFLYER%XLWCZ (ISTORE,:) = 0.
-TPFLYER%XIWCZ (ISTORE,:) = 0.
-IF (CCLOUD=="LIMA" .OR. CCLOUD=="ICE3" ) THEN ! only for ICE3 and LIMA
- TPFLYER%XLWCZ (ISTORE,:) = FLYER_INTERPZ((PR(:,:,:,2)+PR(:,:,:,3))*PRHODREF(:,:,:))
- TPFLYER%XIWCZ (ISTORE,:) = FLYER_INTERPZ((PR(:,:,:,4)+PR(:,:,:,5)+PR(:,:,:,6))*PRHODREF(:,:,:))
- ZTEMPZ(:)=FLYER_INTERPZ(PTH(II_M:II_M+1,IJ_M:IJ_M+1,:) * ZEXN(:,:,:))
- ZRHODREFZ(:)=FLYER_INTERPZ(PRHODREF(:,:,:))
- IF (CCLOUD=="LIMA") THEN
- ZCCI(:)=FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NI))
- ZCCR(:)=FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NR))
- ZCCC(:)=FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NC))
- ELSE
- ZCIT(:)=FLYER_INTERPZ(PCIT(:,:,:))
- ENDIF
- DO JLOOP=3,6
- ZRZ(:,JLOOP)=FLYER_INTERPZ(PR(:,:,:,JLOOP))
- END DO
- if ( csurf == 'EXTE' ) then
- DO JK=1,IKU
- ZRZ(JK,2)=FLYER_INTERP_2D(PR(:,:,JK,2)*PSEA(:,:)) ! becomes cloud mixing ratio over sea
- ZRZ(JK,7)=FLYER_INTERP_2D(PR(:,:,JK,2)*(1.-PSEA(:,:))) ! becomes cloud mixing ratio over land
- END DO
- else
- !if csurf/='EXTE', psea is not allocated
- DO JK=1,IKU
- ZRZ(JK,2)=FLYER_INTERP_2D(PR(:,:,JK,2))
- ZRZ(JK,7) = 0.
- END DO
- end if
- ALLOCATE(ZAELOC(IKU))
- !
- ZAELOC(:)=0.
- ! initialization of quadrature points and weights
- ALLOCATE(ZX(JPTS_GAULAG),ZW(JPTS_GAULAG))
- CALL GAULAG(JPTS_GAULAG,ZX,ZW) ! for integration over diameters
- ! initialize minimum values
- ALLOCATE(ZRTMIN(SIZE(PR,4)+1))
- IF (CCLOUD == 'LIMA') THEN
- ZRTMIN(2)=XRTMIN_L(2) ! cloud water over sea
- ZRTMIN(3)=XRTMIN_L(3)
- ZRTMIN(4)=XRTMIN_L(4)
- ZRTMIN(5)=1E-10
- ZRTMIN(6)=XRTMIN_L(6)
- ZRTMIN(7)=XRTMIN_L(2) ! cloud water over land
- ELSE
- ZRTMIN(2)=XRTMIN_I(2) ! cloud water over sea
- ZRTMIN(3)=XRTMIN_I(3)
- ZRTMIN(4)=XRTMIN_I(4)
- ZRTMIN(5)=1E-10
- ZRTMIN(6)=XRTMIN_I(6)
- ZRTMIN(7)=XRTMIN_I(2) ! cloud water over land
- ENDIF
- ! compute cloud radar reflectivity from vertical profiles of temperature and mixing ratios
- DO JK=1,IKU
- QMW=SQRT(QEPSW(ZTEMPZ(JK),XLIGHTSPEED/XLAM_CRAD))
- QMI=SQRT(QEPSI(ZTEMPZ(JK),XLIGHTSPEED/XLAM_CRAD))
- DO JLOOP=2,7
- IF (CCLOUD == 'LIMA') THEN
- GCALC=(ZRZ(JK,JLOOP)>ZRTMIN(JLOOP).AND.(JLOOP.NE.4.OR.ZCCI(JK)>0.).AND.&
- (JLOOP.NE.3.OR.ZCCR(JK)>0.).AND.((JLOOP.NE.2.AND. JLOOP.NE.7).OR.ZCCC(JK)>0.))
- ELSE
- GCALC=(ZRZ(JK,JLOOP)>ZRTMIN(JLOOP).AND.(JLOOP.NE.4.OR.ZCIT(JK)>0.))
- ENDIF
- IF(GCALC) THEN
- SELECT CASE(JLOOP)
- CASE(2) ! cloud water over sea
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAC_L
- ZB=XBC_L
- ZCC=ZCCC(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAC_L
- ZNU=XNUC_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ELSE
- ZA=XAC_I
- ZB=XBC_I
- ZCC=XCONC_SEA
- ZCX=0.
- ZALPHA=XALPHAC2_I
- ZNU=XNUC2_I
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ENDIF
- CASE(3) ! rain water
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAR_L
- ZB=XBR_L
- ZCC=ZCCR(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAR_L
- ZNU=XNUR_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ELSE
- ZA=XAR_I
- ZB=XBR_I
- ZCC=XCCR_I
- ZCX=-1.
- ZALPHA=XALPHAR_I
- ZNU=XNUR_I
- ZLB=XLBR_I
- ZLBEX=XLBEXR_I
- ENDIF
- CASE(4) ! pristine ice
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAI_L
- ZB=XBI_L
- ZCC=ZCCI(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAI_L
- ZNU=XNUI_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX) ! because ZCC not included in XLBI
- ZFW=0
- ELSE
- ZA=XAI_I
- ZB=XBI_I
- ZCC=ZCIT(JK)
- ZCX=0.
- ZALPHA=XALPHAI_I
- ZNU=XNUI_I
- ZLBEX=XLBEXI_I
- ZLB=XLBI_I*ZCC**(-ZLBEX) ! because ZCC not included in XLBI
- ZFW=0
- ENDIF
- CASE(5) ! snow
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAS_L
- ZB=XBS_L
- ZCC=XCCS_L
- ZCX=XCXS_L
- ZALPHA=XALPHAS_L
- ZNU=XNUS_L
- ZNS=XNS_L
- ZLB=XLBS_L
- ZLBEX=XLBEXS_L
- ZFW=0
- ELSE
- ZA=XAS_I
- ZB=XBS_I
- ZCC=XCCS_I
- ZCX=XCXS_I
- ZALPHA=XALPHAS_I
- ZNU=XNUS_I
- ZNS=XNS_I
- ZLB=XLBS_I
- ZLBEX=XLBEXS_I
- ZFW=0
- ENDIF
- CASE(6) ! graupel
- !If temperature between -10 and 10°C and Mr and Mg over min threshold: melting graupel
- ! with liquid water fraction Fw=Mr/(Mr+Mg) else dry graupel (Fw=0)
- IF( ZTEMPZ(JK) > XTT-10 .AND. ZTEMPZ(JK) < XTT+10 &
- .AND. ZRZ(JK,3) > ZRTMIN(3) ) THEN
- ZFW=ZRZ(JK,3)/(ZRZ(JK,3)+ZRZ(JK,JLOOP))
- ELSE
- ZFW=0
- ENDIF
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAG_L
- ZB=XBG_L
- ZCC=XCCG_L
- ZCX=XCXG_L
- ZALPHA=XALPHAG_L
- ZNU=XNUG_L
- ZLB=XLBG_L
- ZLBEX=XLBEXG_L
- ELSE
- ZA=XAG_I
- ZB=XBG_I
- ZCC=XCCG_I
- ZCX=XCXG_I
- ZALPHA=XALPHAG_I
- ZNU=XNUG_I
- ZLB=XLBG_I
- ZLBEX=XLBEXG_I
- ENDIF
- CASE(7) ! cloud water over land
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAC_L
- ZB=XBC_L
- ZCC=ZCCC(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAC_L
- ZNU=XNUC_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ELSE
- ZA=XAC_I
- ZB=XBC_I
- ZCC=XCONC_LAND
- ZCX=0.
- ZALPHA=XALPHAC_I
- ZNU=XNUC_I
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ENDIF
- END SELECT
- IF ( JLOOP == 5 .AND. CCLOUD=='LIMA'.AND.LSNOW_T_L ) THEN
- IF (ZTEMPZ(JK)>XTT-10.) THEN
- ZLBDA = MAX(MIN(XLBDAS_MAX_L, 10**(14.554-0.0423*ZTEMPZ(JK))),XLBDAS_MIN_L)*XTRANS_MP_GAMMAS_L
- ELSE
- ZLBDA = MAX(MIN(XLBDAS_MAX_L, 10**(6.226-0.0106*ZTEMPZ(JK))),XLBDAS_MIN_L)*XTRANS_MP_GAMMAS_L
- END IF
- ZN=ZNS*ZRHODREFZ(JK)*ZRZ(JK,JLOOP)*ZLBDA**ZB
- ELSE IF (JLOOP.EQ.5 .AND. (CCLOUD=='ICE3'.AND.LSNOW_T_I) ) THEN
- IF (ZTEMPZ(JK)>XTT-10.) THEN
- ZLBDA = MAX(MIN(XLBDAS_MAX_I, 10**(14.554-0.0423*ZTEMPZ(JK))),XLBDAS_MIN_I)*XTRANS_MP_GAMMAS_I
- ELSE
- ZLBDA = MAX(MIN(XLBDAS_MAX_I, 10**(6.226-0.0106*ZTEMPZ(JK))),XLBDAS_MIN_I)*XTRANS_MP_GAMMAS_I
- END IF
- ZN=ZNS*ZRHODREFZ(JK)*ZRZ(JK,JLOOP)*ZLBDA**ZB
- ELSE
- ZLBDA=ZLB*(ZRHODREFZ(JK)*ZRZ(JK,JLOOP))**ZLBEX
- ZN=ZCC*ZLBDA**ZCX
- END IF
- ZREFLOC=0.
- ZAETMP=0.
- DO JJ=1,JPTS_GAULAG ! Gauss-Laguerre quadrature
- ZDELTA_EQUIV=ZX(JJ)**(1./ZALPHA)/ZLBDA
- SELECT CASE(JLOOP)
- CASE(2,3,7)
- QM=QMW
- CASE(4,5,6)
- ! pristine ice, snow, dry graupel
- ZRHOHYD=MIN(6.*ZA*ZDELTA_EQUIV**(ZB-3.)/XPI,.92*XRHOLW)
- QM=sqrt(MG(QMI**2,CMPLX(1,0),ZRHOHYD/.92/XRHOLW))
-
- ! water inclusions in ice in air
- QEPSWI=MG(QMW**2,QM**2,ZFW)
- ! ice in air inclusions in water
- QEPSIW=MG(QM**2,QMW**2,1.-ZFW)
-
- !MG weighted rule (Matrosov 2008)
- IF(ZFW .LT. 0.37) THEN
- ZFPW=0
- ELSE IF(ZFW .GT. 0.63) THEN
- ZFPW=1
- ELSE
- ZFPW=(ZFW-0.37)/(0.63-0.37)
- ENDIF
- QM=sqrt(QEPSWI*(1.-ZFPW)+QEPSIW*ZFPW)
- END SELECT
- CALL BHMIE(XPI/XLAM_CRAD*ZDELTA_EQUIV,QM,ZQEXT,ZQSCA,ZQBACK)
- ZREFLOC=ZREFLOC+ZQBACK*ZX(JJ)**(ZNU-1)*ZDELTA_EQUIV**2*ZW(JJ)
- ZAETMP =ZAETMP +ZQEXT *ZX(JJ)**(ZNU-1)*ZDELTA_EQUIV**2*ZW(JJ)
- END DO
- ZREFLOC=ZREFLOC*(XLAM_CRAD/XPI)**4*ZN/(4.*GAMMA(ZNU)*.93)
- ZAETMP=ZAETMP * XPI *ZN/(4.*GAMMA(ZNU))
- TPFLYER%XCRARE(ISTORE,JK)=TPFLYER%XCRARE(ISTORE,JK)+ZREFLOC
- ZAELOC(JK)=ZAELOC(JK)+ZAETMP
- END IF
- END DO
- END DO
-
- ! apply attenuation
- ALLOCATE(ZZMZ(IKU))
- ZZMZ(:)=FLYER_INTERPZ(ZZM(:,:,:))
- ! nadir
- ZAETOT=1.
- DO JK=COUNT(TPFLYER%XZ_CUR >= ZZMZ(:)),1,-1
- IF(JK.EQ.COUNT(TPFLYER%XZ_CUR >= ZZMZ(:))) THEN
- IF(TPFLYER%XZ_CUR<=ZZMZ(JK)+.5*(ZZMZ(JK+1)-ZZMZ(JK))) THEN
- ! only attenuation from ZAELOC(JK)
- ZAETOT=ZAETOT*EXP(-2.*(ZAELOC(JK)*(TPFLYER%XZ_CUR-ZZMZ(JK))))
- ELSE
- ! attenuation from ZAELOC(JK) and ZAELOC(JK+1)
- ZAETOT=ZAETOT*EXP(-2.*(ZAELOC(JK+1)*(TPFLYER%XZ_CUR-.5*(ZZMZ(JK+1)+ZZMZ(JK))) &
- +ZAELOC(JK)*.5*(ZZMZ(JK+1)-ZZMZ(JK))))
- END IF
- ELSE
- ! attenuation from ZAELOC(JK) and ZAELOC(JK+1)
- ZAETOT=ZAETOT*EXP(-(ZAELOC(JK+1)+ZAELOC(JK))*(ZZMZ(JK+1)-ZZMZ(JK)))
- END IF
- TPFLYER%XCRARE_ATT(ISTORE,JK)=TPFLYER%XCRARE(ISTORE,JK)*ZAETOT
- END DO
- ! zenith
- ZAETOT=1.
- DO JK = MAX(COUNT(TPFLYER%XZ_CUR >= ZZMZ(:)),1)+1,IKU
- IF ( JK .EQ. (MAX(COUNT(TPFLYER%XZ_CUR >= ZZMZ(:)),1)+1) ) THEN
- IF(TPFLYER%XZ_CUR>=ZZMZ(JK)-.5*(ZZMZ(JK)-ZZMZ(JK-1))) THEN
- ! only attenuation from ZAELOC(JK)
- ZAETOT=ZAETOT*EXP(-2.*(ZAELOC(JK)*(ZZMZ(JK)-TPFLYER%XZ_CUR)))
- ELSE
- ! attenuation from ZAELOC(JK) and ZAELOC(JK-1)
- ZAETOT=ZAETOT*EXP(-2.*(ZAELOC(JK-1)*(.5*(ZZMZ(JK)+ZZMZ(JK-1))-TPFLYER%XZ_CUR) &
- +ZAELOC(JK)*.5*(ZZMZ(JK)-ZZMZ(JK-1))))
- END IF
- ELSE
- ! attenuation from ZAELOC(JK) and ZAELOC(JK-1)
- ZAETOT=ZAETOT*EXP(-(ZAELOC(JK-1)+ZAELOC(JK))*(ZZMZ(JK)-ZZMZ(JK-1)))
- END IF
- TPFLYER%XCRARE_ATT(ISTORE,JK)=TPFLYER%XCRARE(ISTORE,JK)*ZAETOT
- END DO
-
- TPFLYER%XZZ (ISTORE,:) = ZZMZ(:)
- DEALLOCATE(ZZMZ,ZAELOC)
- ! m^3 → mm^6/m^3 → dBZ
- WHERE(TPFLYER%XCRARE(ISTORE,:)>0)
- TPFLYER%XCRARE(ISTORE,:)=10.*LOG10(1.E18*TPFLYER%XCRARE(ISTORE,:))
- ELSEWHERE
- TPFLYER%XCRARE(ISTORE,:)=XUNDEF
- END WHERE
- WHERE(TPFLYER%XCRARE_ATT(ISTORE,:)>0)
- TPFLYER%XCRARE_ATT(ISTORE,:)=10.*LOG10(1.E18*TPFLYER%XCRARE_ATT(ISTORE,:))
- ELSEWHERE
- TPFLYER%XCRARE_ATT(ISTORE,:)=XUNDEF
- END WHERE
- DEALLOCATE(ZX,ZW,ZRTMIN)
-END IF ! end LOOP ICE3
-! vertical wind
-TPFLYER%XWZ (ISTORE,:) = FLYER_INTERPZ(ZWM(:,:,:))
-IF (SIZE(PTKE)>0) TPFLYER%XTKE (ISTORE) = FLYER_INTERP(PTKE)
-IF (SIZE(PTS) >0) TPFLYER%XTSRAD(ISTORE) = FLYER_INTERP_2D(PTS)
-IF (LDIAG_IN_RUN) TPFLYER%XTKE_DISS(ISTORE) = FLYER_INTERP(XCURRENT_TKE_DISS)
-TPFLYER%XZS(ISTORE) = FLYER_INTERP_2D(PZ(:,:,1+JPVEXT))
-TPFLYER%XTHW_FLUX(ISTORE) = FLYER_INTERP(ZTHW_FLUX)
-TPFLYER%XRCW_FLUX(ISTORE) = FLYER_INTERP(ZRCW_FLUX)
-DO JLOOP=1,SIZE(PSV,4)
-TPFLYER%XSVW_FLUX(ISTORE,JLOOP) = FLYER_INTERP(ZSVW_FLUX(:,:,:,JLOOP))
-END DO
-
-END SUBROUTINE FLYER_RECORD_DATA
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-FUNCTION FLYER_INTERP(PA) RESULT(PB)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
-REAL :: PB
-!
-INTEGER :: JI, JJ
-!
-IF (SIZE(PA,1)==2) THEN
- JI=1
- JJ=1
-ELSE
- JI=II_M
- JJ=IJ_M
-END IF
-!
-PB = (1.- ZYCOEF) * (1.-ZXCOEF) * ( (1.-ZZCOEF00) * PA(JI ,JJ ,IK00) + ZZCOEF00 * PA(JI ,JJ ,IK00+1)) &
- + (1.- ZYCOEF) * ( ZXCOEF) * ( (1.-ZZCOEF10) * PA(JI+1,JJ ,IK10) + ZZCOEF10 * PA(JI+1,JJ ,IK10+1)) &
- + ( ZYCOEF) * (1.-ZXCOEF) * ( (1.-ZZCOEF01) * PA(JI ,JJ+1,IK01) + ZZCOEF01 * PA(JI ,JJ+1,IK01+1)) &
- + ( ZYCOEF) * ( ZXCOEF) * ( (1.-ZZCOEF11) * PA(JI+1,JJ+1,IK11) + ZZCOEF11 * PA(JI+1,JJ+1,IK11+1))
-!
-END FUNCTION FLYER_INTERP
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-FUNCTION FLYER_INTERPZ(PA) RESULT(PB)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
-REAL, DIMENSION(SIZE(PA,3)) :: PB
-!
-INTEGER :: JI, JJ, JK
-!
-IF (SIZE(PA,1)==2) THEN
- JI=1
- JJ=1
-ELSE
- JI=II_M
- JJ=IJ_M
-END IF
-!
-!
-DO JK=1,SIZE(PA,3)
- IF ( (PA(JI,JJ,JK) /= XUNDEF) .AND. (PA(JI+1,JJ,JK) /= XUNDEF) .AND. &
- (PA(JI,JJ+1,JK) /= XUNDEF) .AND. (PA(JI+1,JJ+1,JK) /= XUNDEF) ) THEN
- PB(JK) = (1.-ZYCOEF) * (1.-ZXCOEF) * PA(JI,JJ,JK) + &
- (1.-ZYCOEF) * (ZXCOEF) * PA(JI+1,JJ,JK) + &
- (ZYCOEF) * (1.-ZXCOEF) * PA(JI,JJ+1,JK) + &
- (ZYCOEF) * (ZXCOEF) * PA(JI+1,JJ+1,JK)
- ELSE
- PB(JK) = XUNDEF
- END IF
-END DO
-!
-END FUNCTION FLYER_INTERPZ
-!----------------------------------------------------------------------------
-FUNCTION FLYER_INTERP_U(PA) RESULT(PB)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
-REAL :: PB
-!
-INTEGER :: JI, JJ
-!
-IF (SIZE(PA,1)==2) THEN
- JI=1
- JJ=1
-ELSE
- JI=II_U
- JJ=IJ_M
-END IF
-!
-PB = (1.- ZYCOEF) * (1.-ZUCOEF) * ( (1.-ZUCOEF00) * PA(JI ,JJ ,IU00) + ZUCOEF00 * PA(JI ,JJ ,IU00+1)) &
- + (1.- ZYCOEF) * ( ZUCOEF) * ( (1.-ZUCOEF10) * PA(JI+1,JJ ,IU10) + ZUCOEF10 * PA(JI+1,JJ ,IU10+1)) &
- + ( ZYCOEF) * (1.-ZUCOEF) * ( (1.-ZUCOEF01) * PA(JI ,JJ+1,IU01) + ZUCOEF01 * PA(JI ,JJ+1,IU01+1)) &
- + ( ZYCOEF) * ( ZUCOEF) * ( (1.-ZUCOEF11) * PA(JI+1,JJ+1,IU11) + ZUCOEF11 * PA(JI+1,JJ+1,IU11+1))
-!
-END FUNCTION FLYER_INTERP_U
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-FUNCTION FLYER_INTERP_V(PA) RESULT(PB)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
-REAL :: PB
-!
-INTEGER :: JI, JJ
-!
-IF (SIZE(PA,1)==2) THEN
- JI=1
- JJ=1
-ELSE
- JI=II_M
- JJ=IJ_V
-END IF
-!
-PB = (1.- ZVCOEF) * (1.-ZXCOEF) * ( (1.-ZVCOEF00) * PA(JI ,JJ ,IV00) + ZVCOEF00 * PA(JI ,JJ ,IV00+1)) &
- + (1.- ZVCOEF) * ( ZXCOEF) * ( (1.-ZVCOEF10) * PA(JI+1,JJ ,IV10) + ZVCOEF10 * PA(JI+1,JJ ,IV10+1)) &
- + ( ZVCOEF) * (1.-ZXCOEF) * ( (1.-ZVCOEF01) * PA(JI ,JJ+1,IV01) + ZVCOEF01 * PA(JI ,JJ+1,IV01+1)) &
- + ( ZVCOEF) * ( ZXCOEF) * ( (1.-ZVCOEF11) * PA(JI+1,JJ+1,IV11) + ZVCOEF11 * PA(JI+1,JJ+1,IV11+1))
-!
-END FUNCTION FLYER_INTERP_V
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-FUNCTION FLYER_INTERP_2D(PA) RESULT(PB)
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PA
-REAL :: PB
-!
-INTEGER :: JI, JJ
-!
-IF (SIZE(PA,1)==2) THEN
- JI=1
- JJ=1
-ELSE
- JI=II_M
- JJ=IJ_M
-END IF
-!
-PB = (1.- ZYCOEF) * (1.-ZXCOEF) * PA(JI ,JJ ) &
- + (1.- ZYCOEF) * ( ZXCOEF) * PA(JI+1,JJ ) &
- + ( ZYCOEF) * (1.-ZXCOEF) * PA(JI ,JJ+1) &
- + ( ZYCOEF) * ( ZXCOEF) * PA(JI+1,JJ+1)
-!
-END FUNCTION FLYER_INTERP_2D
-!----------------------------------------------------------------------------
-
-END SUBROUTINE AIRCRAFT_BALLOON_EVOL
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-SUBROUTINE AIRCRAFT_COMPUTE_POSITION( TPDATE, TPAIRCRAFT )
-
-USE MODD_AIRCRAFT_BALLOON, ONLY: TAIRCRAFTDATA
-USE MODD_TYPE_DATE, ONLY: DATE_TIME
-
-USE MODE_DATETIME
-USE MODE_POSITION_TOOLS, ONLY: FIND_PROCESS_AND_MODEL_FROM_XY_POS
-
-IMPLICIT NONE
-
-TYPE(DATE_TIME), INTENT(IN) :: TPDATE
-CLASS(TAIRCRAFTDATA), INTENT(INOUT) :: TPAIRCRAFT !aircraft
-
-INTEGER :: IL ! flight segment index
-REAL :: ZTDIST ! time since launch (sec)
-REAL :: ZSEG_FRAC ! fraction of flight in the current segment
-
-! Find the flight segment
-ZTDIST = TPDATE - TPAIRCRAFT%TLAUNCH
-IL = TPAIRCRAFT%NPOSCUR
-DO WHILE ( ZTDIST > TPAIRCRAFT%XPOSTIME(IL+1) )
- IL = IL + 1
- IF ( IL > TPAIRCRAFT%NPOS-1 ) THEN
- !Security (should not happen)
- IL = TPAIRCRAFT%NPOS-1
- EXIT
- END IF
-END DO
-TPAIRCRAFT%NPOSCUR = IL
-
-! Compute the current position
-ZSEG_FRAC = ( ZTDIST - TPAIRCRAFT%XPOSTIME(IL) ) / ( TPAIRCRAFT%XPOSTIME(IL+1) - TPAIRCRAFT%XPOSTIME(IL) )
-
-TPAIRCRAFT%XX_CUR = (1.-ZSEG_FRAC) * TPAIRCRAFT%XPOSX(IL ) &
- + ZSEG_FRAC * TPAIRCRAFT%XPOSX(IL+1)
-TPAIRCRAFT%XY_CUR = (1.-ZSEG_FRAC) * TPAIRCRAFT%XPOSY(IL ) &
- + ZSEG_FRAC * TPAIRCRAFT%XPOSY(IL+1)
-
-IF (TPAIRCRAFT%LALTDEF) THEN
- TPAIRCRAFT%XP_CUR = (1.-ZSEG_FRAC) * TPAIRCRAFT%XPOSP(IL ) &
- + ZSEG_FRAC * TPAIRCRAFT%XPOSP(IL+1)
-ELSE
- TPAIRCRAFT%XZ_CUR = (1.-ZSEG_FRAC) * TPAIRCRAFT%XPOSZ(IL ) &
- + ZSEG_FRAC * TPAIRCRAFT%XPOSZ(IL +1)
-END IF
-
-END SUBROUTINE AIRCRAFT_COMPUTE_POSITION
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-SUBROUTINE FLYER_GET_RANK_MODEL_ISCRASHED( TPFLYER, PX, PY, KMODEL )
-
-USE MODD_AIRCRAFT_BALLOON, ONLY: NCRASH_NO, NCRASH_OUT_HORIZ, TFLYERDATA
-
-USE MODE_POSITION_TOOLS, ONLY: FIND_PROCESS_AND_MODEL_FROM_XY_POS
-
-IMPLICIT NONE
-
-CLASS(TFLYERDATA), INTENT(INOUT) :: TPFLYER ! balloon/aircraft
-REAL, OPTIONAL, INTENT(IN) :: PX ! X position (if not provided, takes current flyer position)
-REAL, OPTIONAL, INTENT(IN) :: PY ! Y position (if not provided, takes current flyer position)
-INTEGER, OPTIONAL, INTENT(IN) :: KMODEL ! if provided, model number is imposed (if not 0)
-
-INTEGER :: IMODEL
-INTEGER :: IRANK
-REAL :: ZX, ZY
-
-IF ( PRESENT( KMODEL ) ) THEN
- IMODEL = KMODEL
-ELSE
- IF ( TPFLYER%CMODEL == 'FIX' ) THEN
- IMODEL = TPFLYER%NMODEL
- ELSE
- IMODEL = 0
- END IF
-END IF
-
-IF ( PRESENT( PX ) ) THEN
- ZX = PX
-ELSE
- ZX = TPFLYER%XX_CUR
-END IF
-
-IF ( PRESENT( PY ) ) THEN
- ZY = PY
-ELSE
- ZY = TPFLYER%XY_CUR
-END IF
-
-CALL FIND_PROCESS_AND_MODEL_FROM_XY_POS( ZX, ZY, IRANK, IMODEL )
-
-IF ( IRANK < 1 ) THEN
- ! Flyer is outside of horizontal domain
- ! TPFLYER%NMODEL !Do not change to keep a valid value
- TPFLYER%LCRASH = .TRUE.
- TPFLYER%NCRASH = NCRASH_OUT_HORIZ
- TPFLYER%LFLY = .FALSE.
-ELSE
- TPFLYER%NMODEL = IMODEL
- TPFLYER%LCRASH = .FALSE.
- TPFLYER%NCRASH = NCRASH_NO
- !TPFLYER%LFLY = !Do not touch LFLY (flyer could be in flight or not)
- TPFLYER%NRANK_CUR = IRANK
-END IF
-
-END SUBROUTINE FLYER_GET_RANK_MODEL_ISCRASHED
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-SUBROUTINE FLYER_CHECK_STORESTEP( TPFLYER )
-
-USE MODD_AIRCRAFT_BALLOON, ONLY: TFLYERDATA
-
-USE MODE_STATPROF_TOOLS, ONLY: STATPROF_INSTANT
-
-IMPLICIT NONE
-
-CLASS(TFLYERDATA), INTENT(INOUT) :: TPFLYER ! balloon/aircraft
-
-INTEGER :: ISTORE
-
-!Remark: TPFLYER%TFLYER_TIME%N_CUR and %TPDATES are updated in STATPROF_INSTANT
-CALL STATPROF_INSTANT( TPFLYER%TFLYER_TIME, ISTORE )
-
-IF ( ISTORE < 1 ) THEN
- !No profiler storage at this time step
- TPFLYER%LSTORE = .FALSE.
-ELSE
- TPFLYER%LSTORE = .TRUE.
-END IF
-
-END SUBROUTINE FLYER_CHECK_STORESTEP
-!----------------------------------------------------------------------------
-
-END MODULE MODE_AIRCRAFT_BALLOON_EVOL
diff --git a/src/mesonh/ext/boundaries.f90 b/src/mesonh/ext/boundaries.f90
deleted file mode 100644
index 04860f27e0b15748eb3c9d075427d97f3dc803b9..0000000000000000000000000000000000000000
--- 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_TURB_n, ONLY : XTKEMIN
-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
-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/ch_aqueous_sedim1mom.f90 b/src/mesonh/ext/ch_aqueous_sedim1mom.f90
deleted file mode 100644
index ba0b6ffd5418befa08bfb5c44cdb761c3856a448..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/ch_aqueous_sedim1mom.f90
+++ /dev/null
@@ -1,382 +0,0 @@
-!MNH_LIC Copyright 2007-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-------------------------------------------------------------------------------
-! ################################
- MODULE MODI_CH_AQUEOUS_SEDIM1MOM
-! ################################
-!
-INTERFACE
- SUBROUTINE CH_AQUEOUS_SEDIM1MOM (KSPLITR, HCLOUD, OUSECHIC, PTSTEP, &
- PZZ, PRHODREF, PRHODJ, PRRS, &
- PRSS, PRGS, PRRSVS, PSGRSVS, PINPRR )
-!
-CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Cloud parameterization
-INTEGER, INTENT(IN) :: KSPLITR ! Current time
-REAL, INTENT(IN) :: PTSTEP ! Time step
-LOGICAL, INTENT(IN) :: OUSECHIC ! flag for ice chem.
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rainwater m.r. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRSS ! Snow m.r. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS ! Graupel m.r. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRSVS ! Rainwater aq. species source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSGRSVS ! Precip. ice species source
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRR ! instantaneaous precip.
-!
-END SUBROUTINE CH_AQUEOUS_SEDIM1MOM
-END INTERFACE
-END MODULE MODI_CH_AQUEOUS_SEDIM1MOM
-!
-! ######################################################################
- SUBROUTINE CH_AQUEOUS_SEDIM1MOM (KSPLITR, HCLOUD, OUSECHIC, PTSTEP, &
- PZZ, PRHODREF, PRHODJ, PRRS, &
- PRSS, PRGS, PRRSVS, PSGRSVS, PINPRR )
-! ######################################################################
-!
-!!**** * - compute the explicit microphysical sources
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the sedimentation
-!! of chemical species in the raindrops for the Kessler, ICE2, ICE3 and
-!! ICE4 cloud microphysical scheme
-!! The sedimentation rates are computed with a time spliting technique:
-!! an upstream scheme, written as a difference of non-advective fluxes.
-!! This source term is added to the next coming time step (split-implicit
-!! process). see rain_ice.f90
-!!
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!! None
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_PARAMETERS
-!! JPHEXT : Horizontal external points number
-!! JPVEXT : Vertical external points number
-!! Module MODD_CONF :
-!! CCONF configuration of the model for the first time step
-!!
-!! REFERENCE
-!! ---------
-!! Book1 of the documentation ( routine CH_AQUEOUS_SEDIM1MOM )
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 22/07/07
-!! 04/11/08 (M Leriche) add ICE3
-!! 17/09/10 (M Leriche) add LUSECHIC flag
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! 16/12/15 (M Leriche) compute instantaneous rain at the surface
-! P. Wautelet 12/02/2019: bugfix: ZRR_SEDIM was not initialized everywhere
-! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODD_CONF
-USE MODD_CST, ONLY : XRHOLW
-USE MODD_CLOUDPAR, ONLY : VCEXVT=>XCEXVT, XCRS, XCEXRS
-USE MODD_RAIN_ICE_DESCR_n, ONLY : WCEXVT=>XCEXVT, WRTMIN=>XRTMIN
-USE MODD_RAIN_ICE_PARAM_n, ONLY : XFSEDR, XEXSEDR, &
- XFSEDS, XEXSEDS, &
- XFSEDG, XEXSEDG
-
-use mode_tools, only: Countjv
-use mode_tools_ll, only: GET_INDICE_ll
-
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-!
-CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Cloud parameterization
-INTEGER, INTENT(IN) :: KSPLITR ! Current time
-REAL, INTENT(IN) :: PTSTEP ! Time step
-LOGICAL, INTENT(IN) :: OUSECHIC ! flag for ice chem.
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rainwater m.r. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRSS ! Snow m.r. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS ! Graupel m.r. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRSVS ! Rainwater aq. species source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSGRSVS ! Precip. ice species source
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRR ! instantaneaous precip.
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: JK,JI,JJ ! Vertical loop index for the rain sedimentation
-INTEGER :: JN ! Temporal loop index for the rain sedimentation
-INTEGER :: IIB ! Define the domain where is
-INTEGER :: IIE ! the microphysical sources have to be computed
-INTEGER :: IJB !
-INTEGER :: IJE !
-INTEGER :: IKB !
-INTEGER :: IKE !
-!
-REAL :: ZTSPLITR ! Small time step for rain sedimentation
-!
-INTEGER :: ISEDIMR, ISEDIMS, ISEDIMG ! Case number of sedimentation
-LOGICAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: GSEDIMR ! where to compute the SED processes
-LOGICAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: GSEDIMS ! where to compute the SED processes
-LOGICAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: GSEDIMG ! where to compute the SED processes
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZRRS ! rainwater m.r.source phys.tendency
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZRSS ! snow m.r.source phys.tendency
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZRGS ! graupel m.r.source phys.tendency
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZW ! work array
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZWSED ! sedimentation fluxes
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZZRRS ! Rainwater m.r. source phys.tendency *dt
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZZRSS ! Snow m.r. source phys.tendency *dt
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZZRGS ! Graupel m.r. source phys.tendency *dt
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZRR_SEDIM ! Drain/Dt sur ZTSPLIT
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZSV_SEDIM_FACTR ! Cumul des Dsv/DT
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZSV_SEDIM_FACTS ! Cumul des Dsv/DT
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZSV_SEDIM_FACTG ! Cumul des Dsv/DT
-REAL, DIMENSION(:), ALLOCATABLE :: ZZZRRS ! Rainwater m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZZZRSS ! Snow m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZZZRGS ! Graupel m.r. source
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZRHODREF, & ! RHO Dry REFerence
- ZZW ! Work array
-REAL, DIMENSION(7), SAVE :: Z_XRTMIN
-!
-REAL :: ZVTRMAX, ZT
-LOGICAL, SAVE :: GSFIRSTCALL = .TRUE.
-REAL, SAVE :: ZFSEDR, ZEXSEDR, ZCEXVT
-!
-INTEGER , DIMENSION(SIZE(GSEDIMR)) :: IR1,IR2,IR3 ! Used to replace the COUNT
-INTEGER , DIMENSION(SIZE(GSEDIMS)) :: IS1,IS2,IS3 ! Used to replace the COUNT
-INTEGER , DIMENSION(SIZE(GSEDIMG)) :: IG1,IG2,IG3 ! Used to replace the COUNT
-INTEGER :: JL ! and PACK intrinsics
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. COMPUTE THE LOOP BOUNDS
-! -----------------------
-!
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IKB=1+JPVEXT
-IKE=SIZE(PZZ,3) - JPVEXT
-PINPRR(:,:) = 0. ! initialize instantaneous precip.
-!
-!-------------------------------------------------------------------------------
-!
-!!* 2. TRANSFORMATION INTO PHYSICAL TENDENCIES
-! ---------------------------------------
-!
-ZRRS(:,:,:) = PRRS(:,:,:) / PRHODJ(:,:,:)
-IF (HCLOUD(1:3) == 'ICE') THEN
- ZRSS(:,:,:) = PRSS(:,:,:) / PRHODJ(:,:,:)
- ZRGS(:,:,:) = PRGS(:,:,:) / PRHODJ(:,:,:)
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. COMPUTE THE SEDIMENTATION (RS) SOURCE
-! -------------------------------------
-!
-!* 3.1 Initialize some constants
-!
-firstcall : IF (GSFIRSTCALL) THEN
- GSFIRSTCALL = .FALSE.
- SELECT CASE ( HCLOUD)
- CASE('KESS')
- ZVTRMAX = 20.
- CASE('ICE3')
- ZVTRMAX = 10.
- CASE('ICE4')
- ZVTRMAX = 40.
- END SELECT
-!
- SELECT CASE ( HCLOUD ) ! constants for rain sedimentation
- CASE('KESS')
- Z_XRTMIN(2:3) = 1.0E-20 ! Default values
- ZFSEDR = XCRS
- ZEXSEDR = XCEXRS
- ZCEXVT = VCEXVT
- CASE('ICE3','ICE4')
- Z_XRTMIN(1:SIZE(WRTMIN)) = WRTMIN ! Values given in ICEx schemes
- ZFSEDR = XFSEDR
- ZEXSEDR = XEXSEDR
- ZCEXVT = WCEXVT
- END SELECT
-END IF firstcall
-!
-!* 3.2 time splitting loop initialization
-!
-ZTSPLITR = PTSTEP / REAL(KSPLITR) ! Small time step
-!
-!* 3.3 compute the fluxes
-!
-ZSV_SEDIM_FACTR(:,:,:) = 1.0
-ZZRRS(:,:,:) = ZRRS(:,:,:) * PTSTEP
-IF (HCLOUD(1:3) == 'ICE') THEN
- ZZRSS(:,:,:) = ZRSS(:,:,:) * PTSTEP
- ZZRGS(:,:,:) = ZRGS(:,:,:) * PTSTEP
- ZSV_SEDIM_FACTS(:,:,:) = 1.0
- ZSV_SEDIM_FACTG(:,:,:) = 1.0
-ENDIF
-DO JN = 1 , KSPLITR
- IF( JN==1 ) THEN
- ZW(:,:,:) = 0.0
- DO JK = IKB , IKE-1
- ZW(:,:,JK) =ZTSPLITR*2./(PRHODREF(:,:,JK)*(PZZ(:,:,JK+2)-PZZ(:,:,JK)))
- END DO
- ZW(:,:,IKE) =ZTSPLITR/(PRHODREF(:,:,IKE)*(PZZ(:,:,IKE+1)-PZZ(:,:,IKE)))
- END IF
-!
-!* 3.3.1 for rain
-!
- GSEDIMR(:,:,:) = .FALSE.
- GSEDIMR(IIB:IIE,IJB:IJE,IKB:IKE) = ZZRRS(IIB:IIE,IJB:IJE,IKB:IKE) > Z_XRTMIN(3)
- ISEDIMR = COUNTJV( GSEDIMR(:,:,:),IR1(:),IR2(:),IR3(:))
-!
- IF ( ISEDIMR >= 1 ) THEN
- ALLOCATE(ZZZRRS(ISEDIMR))
- ALLOCATE(ZRHODREF(ISEDIMR))
- DO JL=1,ISEDIMR
- ZZZRRS(JL) = ZZRRS(IR1(JL),IR2(JL),IR3(JL))
- ZRHODREF(JL) = PRHODREF(IR1(JL),IR2(JL),IR3(JL))
- ENDDO
- ALLOCATE(ZZW(ISEDIMR)) ; ZZW(:) = 0.0
-!
- ZZW(:) = ZFSEDR * ZZZRRS(:)**(ZEXSEDR) * ZRHODREF(:)**(ZEXSEDR-ZCEXVT)
- ZWSED(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIMR(:,:,:),FIELD=0.0 )
- ZRR_SEDIM(:,:,:) = 0.0
- DO JK = IKB , IKE
- ZRR_SEDIM(:,:,JK) = ZW(:,:,JK)*(ZWSED(:,:,JK+1)-ZWSED(:,:,JK))
- END DO
- ZZRRS(:,:,:) = ZZRRS(:,:,:) + ZRR_SEDIM(:,:,:)
- PINPRR(:,:) = PINPRR(:,:) + ZWSED(:,:,IKB)/XRHOLW/KSPLITR
-!
- ZZW(:) = ZFSEDR * ZZZRRS(:)**(ZEXSEDR-1.0) * ZRHODREF(:)**(ZEXSEDR-ZCEXVT)
- ZWSED(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIMR(:,:,:),FIELD=0.0 )
- ZRR_SEDIM(:,:,:) = 0.0
- DO JK = IKB , IKE
- ZRR_SEDIM(:,:,JK) = ZW(:,:,JK)*(ZWSED(:,:,JK+1)-ZWSED(:,:,JK))
- END DO
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(ZZZRRS)
- DEALLOCATE(ZZW)
- ZSV_SEDIM_FACTR(:,:,:) = ZSV_SEDIM_FACTR(:,:,:) * (1.0 + ZRR_SEDIM(:,:,:))
-!! (1.0 + ZRR_SEDIM(:,:,:)/MAX(ZZRRS(:,:,:),XRTMIN_AQ))
- END IF
- IF (HCLOUD == 'KESS') EXIT
-!
-!* 3.3.1 for iced precip.hydrometeors
-!
- GSEDIMS(:,:,:) = .FALSE.
- GSEDIMG(:,:,:) = .FALSE.
- GSEDIMS(IIB:IIE,IJB:IJE,IKB:IKE) = ZZRSS(IIB:IIE,IJB:IJE,IKB:IKE) > Z_XRTMIN(5)
- GSEDIMG(IIB:IIE,IJB:IJE,IKB:IKE) = ZZRGS(IIB:IIE,IJB:IJE,IKB:IKE) > Z_XRTMIN(6)
- ISEDIMS = COUNTJV( GSEDIMS(:,:,:),IS1(:),IS2(:),IS3(:))
- ISEDIMG = COUNTJV( GSEDIMG(:,:,:),IG1(:),IG2(:),IG3(:))
-! for snow
- IF ( ISEDIMS >= 1) THEN
- ALLOCATE(ZZZRSS(ISEDIMS))
- ALLOCATE(ZRHODREF(ISEDIMS))
- DO JL=1,ISEDIMS
- ZZZRSS(JL) = ZZRSS(IS1(JL),IS2(JL),IS3(JL))
- ZRHODREF(JL) = PRHODREF(IS1(JL),IS2(JL),IS3(JL))
- ENDDO
- ALLOCATE(ZZW(ISEDIMS)) ; ZZW(:) = 0.0
-!
- ZZW(:) = XFSEDS * ZZZRSS(:)**(XEXSEDS) * ZRHODREF(:)**(XEXSEDS-ZCEXVT)
- ZWSED(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIMS(:,:,:),FIELD=0.0 )
- ZRR_SEDIM(:,:,:) = 0.0
- DO JK = IKB , IKE
- ZRR_SEDIM(:,:,JK) = ZW(:,:,JK)*(ZWSED(:,:,JK+1)-ZWSED(:,:,JK))
- END DO
- ZZRSS(:,:,:) = ZZRSS(:,:,:) + ZRR_SEDIM(:,:,:)
-!
- ZZW(:) = XFSEDS * ZZZRSS(:)**(XEXSEDS-1.0) * ZRHODREF(:)**(XEXSEDS-ZCEXVT)
- ZWSED(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIMS(:,:,:),FIELD=0.0 )
- ZRR_SEDIM(:,:,:) = 0.0
- DO JK = IKB , IKE
- ZRR_SEDIM(:,:,JK) = ZW(:,:,JK)*(ZWSED(:,:,JK+1)-ZWSED(:,:,JK))
- END DO
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(ZZZRSS)
- DEALLOCATE(ZZW)
- ZSV_SEDIM_FACTS(:,:,:) = ZSV_SEDIM_FACTS(:,:,:) * (1.0 + ZRR_SEDIM(:,:,:))
- ENDIF
-! for graupel
- IF ( ISEDIMG >= 1) THEN
- ALLOCATE(ZZZRGS(ISEDIMG))
- ALLOCATE(ZRHODREF(ISEDIMG))
- DO JL=1,ISEDIMG
- ZZZRGS(JL) = ZZRGS(IG1(JL),IG2(JL),IG3(JL))
- ZRHODREF(JL) = PRHODREF(IG1(JL),IG2(JL),IG3(JL))
- ENDDO
- ALLOCATE(ZZW(ISEDIMG)) ; ZZW(:) = 0.0
-!
- ZZW(:) = XFSEDG * ZZZRGS(:)**(XEXSEDG) * ZRHODREF(:)**(XEXSEDG-ZCEXVT)
- ZWSED(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIMG(:,:,:),FIELD=0.0 )
- ZRR_SEDIM(:,:,:) = 0.0
- DO JK = IKB , IKE
- ZRR_SEDIM(:,:,JK) = ZW(:,:,JK)*(ZWSED(:,:,JK+1)-ZWSED(:,:,JK))
- END DO
- ZZRGS(:,:,:) = ZZRGS(:,:,:) + ZRR_SEDIM(:,:,:)
-!
- ZZW(:) = XFSEDG * ZZZRGS(:)**(XEXSEDG-1.0) * ZRHODREF(:)**(XEXSEDG-ZCEXVT)
- ZWSED(:,:,:) = UNPACK( ZZW(:),MASK=GSEDIMG(:,:,:),FIELD=0.0 )
- ZRR_SEDIM(:,:,:) = 0.0
- DO JK = IKB , IKE
- ZRR_SEDIM(:,:,JK) = ZW(:,:,JK)*(ZWSED(:,:,JK+1)-ZWSED(:,:,JK))
- END DO
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(ZZZRGS)
- DEALLOCATE(ZZW)
- ZSV_SEDIM_FACTG(:,:,:) = ZSV_SEDIM_FACTG(:,:,:) * (1.0 + ZRR_SEDIM(:,:,:))
- ENDIF
-END DO
-!
-! Apply the rain sedimentation rate to the WR_xxx aqueous species
-DO JL= 1, SIZE(PRRSVS,4)
- PRRSVS(:,:,:,JL) = MAX( 0.0,ZSV_SEDIM_FACTR(:,:,:)*PRRSVS(:,:,:,JL) )
-ENDDO
-!ice phase
-IF (OUSECHIC) THEN
- DO JL= 1, SIZE(PSGRSVS,4)
- PSGRSVS(:,:,:,JL) = MAX( 0.0, &
- ((ZSV_SEDIM_FACTS(:,:,:)+ZSV_SEDIM_FACTG(:,:,:))/2.) &
- *PSGRSVS(:,:,:,JL) )
- ENDDO
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE CH_AQUEOUS_SEDIM1MOM
diff --git a/src/mesonh/ext/ch_aqueous_tmicice.f90 b/src/mesonh/ext/ch_aqueous_tmicice.f90
deleted file mode 100644
index 51255f6fd86cc99c6db1de25b0a21483f0edde7f..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/ch_aqueous_tmicice.f90
+++ /dev/null
@@ -1,1304 +0,0 @@
-!MNH_LIC Copyright 2008-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ####################################
- MODULE MODI_CH_AQUEOUS_TMICICE
-! ####################################
-!
-INTERFACE
- SUBROUTINE CH_AQUEOUS_TMICICE( PTSTEP, PRHODREF, PRHODJ, PTHT, PPABST, &
- PRTMIN_AQ, OUSECHIC, OCH_RET_ICE, HNAMES, &
- HICNAMES, KEQ, KEQAQ, PRVT, PRCT, PRRT, PRIT,&
- PRST, PRGT, PCIT, PRCS, PRRS, PRIS, PRSS, &
- PRGS, PGSVT, PGRSVS, PCSVT, PCRSVS, PRSVT, &
- PRRSVS, PSGSVT, PSGRSVS )
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-REAL, INTENT(IN) :: PRTMIN_AQ ! LWC threshold liq. chem.
-INTEGER, INTENT(IN) :: KEQ ! Number of chem. spec.
-INTEGER, INTENT(IN) :: KEQAQ ! Number of liq. chem. spec.
-LOGICAL, INTENT(IN) :: OUSECHIC ! flag for ice chem.
-LOGICAL, INTENT(IN) :: OCH_RET_ICE ! flag for retention in ice
-!
-CHARACTER(LEN=32), DIMENSION(:), INTENT(IN) :: HNAMES ! name of chem. species
-CHARACTER(LEN=32), DIMENSION(:), INTENT(IN) :: HICNAMES ! name of ice chem. species
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rainwater m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Pristine m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Pristine conc. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS ! cloud water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rainwater m.r. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIS ! Pristine m.r. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRSS ! Snow m.r. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS ! graupel m.r. source
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PGSVT ! gas species at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PGRSVS ! gas species source
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PCSVT ! cloud water aq. species at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PCRSVS ! cloud water aq. species source
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRSVT ! Rainwater aq. species at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRSVS ! Rainwater aq. species source
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSGSVT ! ice species at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSGRSVS ! ice species source
-!
-END SUBROUTINE CH_AQUEOUS_TMICICE
-END INTERFACE
-END MODULE MODI_CH_AQUEOUS_TMICICE
-!
-! ################################################################################
- SUBROUTINE CH_AQUEOUS_TMICICE( PTSTEP, PRHODREF, PRHODJ, PTHT, PPABST, &
- PRTMIN_AQ, OUSECHIC, OCH_RET_ICE, HNAMES, &
- HICNAMES, KEQ, KEQAQ, PRVT, PRCT, PRRT, PRIT,&
- PRST, PRGT, PCIT, PRCS, PRRS, PRIS, PRSS, &
- PRGS, PGSVT, PGRSVS, PCSVT, PCRSVS, PRSVT, &
- PRRSVS, PSGSVT, PSGRSVS )
-! ################################################################################
-!
-!!**** * - compute the explicit microphysical sources
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the microphysical sources
-!! corresponding to collision/coalescence processes (autoconversion + accretion)
-!! and to the freezing, rimin and melting processes for snow and graupel
-!! for the ICE3(4) cloud microphysics parameterization (see rain_ice)
-!!
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!! None
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_PARAMETERS
-!! JPHEXT : Horizontal external points number
-!! JPVEXT : Vertical external points number
-!!
-!! REFERENCE
-!! ---------
-!! Book1 of the documentation ( routine CH_AQUEOUS_TMICICE )
-!!
-!! AUTHOR
-!! ------
-!! C. Mari J.P. Pinty M. Leriche * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 26/03/08
-!! M. Leriche 19/07/2010 add riming, freezing and melting for ice phase(ICE3)
-!! M. Leriche 17/09/2010 add OUSECHIC flag
-!! Juan 24/09/2012: for BUG Pgi rewrite PACK function on mode_pack_pgi
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! M.Leriche 2015 correction bug
-! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS, ONLY : JPHEXT, &! number of horizontal External points
- JPVEXT ! number of vertical External points
-USE MODD_CST, ONLY : XP00, XRD, XRV, XCPD, XTT, XLMTT, XLVTT, XCPV, &
- XCL, XCI, XESTT, XMV, XMD
-USE MODD_RAIN_ICE_DESCR_n, ONLY : XLBR, XLBEXR, XCEXVT, XLBDAS_MAX, XLBS, XLBEXS, &
- XLBG, XLBEXG, XCXS, XCXG, XDG, XBS
-USE MODD_RAIN_ICE_PARAM_n, ONLY : XTIMAUTC, XCRIAUTC, XFCACCR, XEXCACCR, &
- XRIMINTP1, XRIMINTP2, XCRIMSS, XCRIMSG,&
- XEXCRIMSS, XEXCRIMSG, NGAMINC, XGAMINC_RIM1, &
- XFRACCSS, XLBRACCS1, XLBRACCS2, XLBRACCS3, &
- XACCINTP1S, XACCINTP2S, XACCINTP1R, XACCINTP2R, &
- NACCLBDAS, NACCLBDAR, XKER_RACCSS, XKER_RACCS, &
- XEXRCFRI, XRCFRI, X0DEPG, XEX0DEPG, X1DEPG, &
- XEX1DEPG, XSCFAC, XFCDRYG, XFIDRYG, XCOLEXIG, &
- XCOLEXSG, XFSDRYG, NDRYLBDAG, XDRYINTP1G, &
- XDRYINTP2G, NDRYLBDAS, XDRYINTP1S, XDRYINTP2S, &
- XKER_SDRYG, XLBSDRYG1, XLBSDRYG2, XLBSDRYG3, &
- XFRDRYG, NDRYLBDAR, XDRYINTP1R, XDRYINTP2R, &
- XKER_RDRYG, XLBRDRYG1, XLBRDRYG2, XLBRDRYG3, &
- XCOLIG, XCOLEXIG, XCOLSG, XCOLEXSG
-USE MODD_CH_ICE ! value of retention coefficient
-USE MODD_CH_ICE_n ! index for ice phase chemistry with IC3/4
-!
-#ifdef MNH_PGI
-USE MODE_PACK_PGI
-#endif
-use mode_tools, only: Countjv
-use mode_tools_ll, only: GET_INDICE_ll
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-REAL, INTENT(IN) :: PRTMIN_AQ ! LWC threshold liq. chem.
-INTEGER, INTENT(IN) :: KEQ ! Number of chem. spec.
-INTEGER, INTENT(IN) :: KEQAQ ! Number of liq. chem. spec.
-LOGICAL, INTENT(IN) :: OUSECHIC ! flag for ice chem.
-LOGICAL, INTENT(IN) :: OCH_RET_ICE ! flag for retention in ice
-!
-CHARACTER(LEN=32), DIMENSION(:), INTENT(IN) :: HNAMES ! name of chem. species
-CHARACTER(LEN=32), DIMENSION(:), INTENT(IN) :: HICNAMES ! name of ice chem. species
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rainwater m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Pristine m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Pristine conc. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS ! cloud water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rainwater m.r. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIS ! Pristine m.r. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRSS ! Snow m.r. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS ! graupel m.r. source
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PGSVT ! gas species at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PGRSVS ! gas species source
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PCSVT ! cloud water aq. species at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PCRSVS ! cloud water aq. species source
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRSVT ! Rainwater aq. species at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRSVS ! Rainwater aq. species source
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSGSVT ! ice species at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSGRSVS ! ice species source
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: JLC, JLR, JLI, JLG, JLW ! Loop index for cloud water, rainwater and ice species
-INTEGER :: JJ ! Loop index
-INTEGER :: IIB ! Define the domain where is
-INTEGER :: IIE ! the microphysical sources have to be computed
-INTEGER :: IJB
-INTEGER :: IJE
-INTEGER :: IKB
-INTEGER :: IKE
-!
-INTEGER :: IMICRO ! case number of r_x>0 locations
-LOGICAL, DIMENSION(SIZE(PRCT,1),SIZE(PRCT,2),SIZE(PRCT,3)) &
- :: GMICRO ! where to compute mic. processes
-REAL, DIMENSION(SIZE(PRCT,1),SIZE(PRCT,2),SIZE(PRCT,3)) &
- :: ZT ! Temperature
-REAL, DIMENSION(SIZE(PRCT,1),SIZE(PRCT,2),SIZE(PRCT,3)) &
- :: ZRCS ! Cloud water m.r. source phys.tendency
-REAL, DIMENSION(SIZE(PRCT,1),SIZE(PRCT,2),SIZE(PRCT,3)) &
- :: ZRRS ! Rain water m.r. source phys. tendency
-REAL, DIMENSION(SIZE(PRCT,1),SIZE(PRCT,2),SIZE(PRCT,3)) &
- :: ZRIS ! Pristine m.r. source phys. tendency
-REAL, DIMENSION(SIZE(PRCT,1),SIZE(PRCT,2),SIZE(PRCT,3)) &
- :: ZRSS ! Snow m.r. source phys. tendency
-REAL, DIMENSION(SIZE(PRCT,1),SIZE(PRCT,2),SIZE(PRCT,3)) &
- :: ZRGS ! Graupel m.r. source phys. tendency
-REAL, DIMENSION(SIZE(PGRSVS,1),SIZE(PGRSVS,2),SIZE(PGRSVS,3),SIZE(PGRSVS,4)) &
- :: ZZGRSVS ! Gas species source
-REAL, DIMENSION(SIZE(PCRSVS,1),SIZE(PCRSVS,2),SIZE(PCRSVS,3),SIZE(PCRSVS,4)) &
- :: ZZCRSVS ! Cloud water aq. species source
-REAL, DIMENSION(SIZE(PRRSVS,1),SIZE(PRRSVS,2),SIZE(PRRSVS,3),SIZE(PRRSVS,4)) &
- :: ZZRRSVS ! Rain water aq. species source
-REAL, DIMENSION(SIZE(PSGRSVS,1),SIZE(PSGRSVS,2),SIZE(PSGRSVS,3),SIZE(PSGRSVS,4)) &
- :: ZZSGRSVS ! Ice (snow+graupel) species source
-REAL, DIMENSION(SIZE(PRCT,1),SIZE(PRCT,2),SIZE(PRCT,3)) &
- :: ZCW ! work array
-REAL, DIMENSION(SIZE(PRCT,1),SIZE(PRCT,2),SIZE(PRCT,3)) &
- :: ZRW ! work array
-REAL, DIMENSION(SIZE(PRCT,1),SIZE(PRCT,2),SIZE(PRCT,3)) &
- :: ZSGW ! work array
-REAL, DIMENSION(SIZE(PRCT,1),SIZE(PRCT,2),SIZE(PRCT,3)) &
- :: ZGW ! work array
-REAL, DIMENSION(:), ALLOCATABLE :: ZZT ! Temperature
-REAL, DIMENSION(:), ALLOCATABLE :: ZPRES ! Pressure
-REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Vapor m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel m.r. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZCIT ! Pristine conc. at t
-REAL, DIMENSION(:), ALLOCATABLE :: ZZRCS ! Cloud water m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZZRRS ! Rain water m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZZRIS ! Pristine m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZZRSS ! snow m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZZRGS ! graupel m.r. source
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZCSVT ! Cloud water aq. species at t
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZRSVT ! Rain water aq. species at t
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSGSVT ! Ice (snow + graupel) species at t
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZGRSVS ! Gas species source
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZCRSVS ! Cloud water aq. species source
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZRRSVS ! Rain water aq. species source
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSGRSVS! Ice (snow+graupel) species source
-REAL, DIMENSION(:), ALLOCATABLE :: ZCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(:), ALLOCATABLE :: ZKA ! Thermal conductivity of the air
-REAL, DIMENSION(:), ALLOCATABLE :: ZDV ! Diffusivity of water vapor in the air
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZRHODREF, & ! RHO Dry REFerence
- ZZW, & ! Work array
- ZLBDAR, & ! Slope parameter of the raindrop distribution
- ZLBDAS, & ! Slope parameter of the snow distribution
- ZLBDAG, & ! Slope parameter of the graupel distribution
- ZRDRYG, & ! Dry growth rate of the graupel
- ZRWETG ! Wet growth rate of the graupel
-!
-INTEGER :: IGRIM, IGACC ! Case number of riming, accretion
-INTEGER :: IGDRY
-!, IGWET ! dry growth and wet growth locations for graupels
-LOGICAL, DIMENSION(:), ALLOCATABLE :: GRIM ! Test where to compute riming
-LOGICAL, DIMENSION(:), ALLOCATABLE :: GACC ! Test where to compute accretion
-LOGICAL, DIMENSION(:), ALLOCATABLE :: GDRY ! Test where to compute dry growth
-!LOGICAL, DIMENSION(:), ALLOCATABLE :: GWET ! Test where to compute wet growt
-INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1,IVEC2 ! Vectors of indices for
- ! interpolations
-REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors for
- ! interpolations
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4 ! Work arrays
-!
-INTEGER , DIMENSION(SIZE(GMICRO)) :: I1,I2,I3 ! Used to replace the COUNT
-INTEGER :: JL ! and PACK intrinsics
-!
-!
-! compute the temperature
-!
-ZT(:,:,:) = PTHT(:,:,:) * ( PPABST(:,:,:) / XP00 ) ** (XRD/XCPD)
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. COMPUTE THE LOOP BOUNDS
-! -----------------------
-!
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IKB=1+JPVEXT
-IKE=SIZE(PRCT,3) - JPVEXT
-!
-!-------------------------------------------------------------------------------
-!
-!!* 2. TRANSFORMATION INTO PHYSICAL TENDENCIES
-! ---------------------------------------
-!
-ZRCS(:,:,:) = PRCS(:,:,:) / PRHODJ(:,:,:)
-ZRRS(:,:,:) = PRRS(:,:,:) / PRHODJ(:,:,:)
-ZRSS(:,:,:) = PRSS(:,:,:) / PRHODJ(:,:,:)
-ZRIS(:,:,:) = PRIS(:,:,:) / PRHODJ(:,:,:)
-ZRGS(:,:,:) = PRGS(:,:,:) / PRHODJ(:,:,:)
-!
-DO JLC= 1, SIZE(PCRSVS,4)
- ZZCRSVS(:,:,:,JLC) = PCRSVS(:,:,:,JLC) / PRHODJ(:,:,:)
-ENDDO
-DO JLR= 1, SIZE(PRRSVS,4)
- ZZRRSVS(:,:,:,JLR) = PRRSVS(:,:,:,JLR) / PRHODJ(:,:,:)
-ENDDO
-IF (OUSECHIC) THEN
- DO JLG= 1, SIZE(PGRSVS,4)
- ZZGRSVS(:,:,:,JLG) = PGRSVS(:,:,:,JLG) / PRHODJ(:,:,:)
- ENDDO
- DO JLI= 1, SIZE(PSGRSVS,4)
- ZZSGRSVS(:,:,:,JLI) = PSGRSVS(:,:,:,JLI) / PRHODJ(:,:,:)
- ENDDO
-ELSE
- IF (.NOT.(OCH_RET_ICE)) THEN
- DO JLG= 1, SIZE(PGRSVS,4)
- ZZGRSVS(:,:,:,JLG) = PGRSVS(:,:,:,JLG) / PRHODJ(:,:,:)
- ENDDO
- ENDIF
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. OPTIMIZATION: looking for locations where m.r. hydro. > min value
-! -----------------------------------------------------------------
-!
-GMICRO(:,:,:) = .FALSE.
-GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = &
- (PRCT(IIB:IIE,IJB:IJE,IKB:IKE)>PRTMIN_AQ*1.e3/PRHODREF(IIB:IIE,IJB:IJE,IKB:IKE)) .OR. &
- (PRRT(IIB:IIE,IJB:IJE,IKB:IKE)>PRTMIN_AQ*1.e3/PRHODREF(IIB:IIE,IJB:IJE,IKB:IKE)) .OR. &
- (PRST(IIB:IIE,IJB:IJE,IKB:IKE)>PRTMIN_AQ*1.e3/PRHODREF(IIB:IIE,IJB:IJE,IKB:IKE)) .OR. &
- (PRGT(IIB:IIE,IJB:IJE,IKB:IKE)>PRTMIN_AQ*1.e3/PRHODREF(IIB:IIE,IJB:IJE,IKB:IKE))
-!
-IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
-IF( IMICRO >= 1 ) THEN
- ALLOCATE(ZZT(IMICRO))
- ALLOCATE(ZPRES(IMICRO))
- ALLOCATE(ZRVT(IMICRO))
- ALLOCATE(ZRCT(IMICRO))
- ALLOCATE(ZRRT(IMICRO))
- ALLOCATE(ZRIT(IMICRO))
- ALLOCATE(ZRST(IMICRO))
- ALLOCATE(ZRGT(IMICRO))
- ALLOCATE(ZCIT(IMICRO))
- ALLOCATE(ZCSVT(IMICRO,SIZE(PCSVT,4)))
- ALLOCATE(ZRSVT(IMICRO,SIZE(PRSVT,4)))
- ALLOCATE(ZZRCS(IMICRO))
- ALLOCATE(ZZRRS(IMICRO))
- ALLOCATE(ZZRIS(IMICRO))
- ALLOCATE(ZZRSS(IMICRO))
- ALLOCATE(ZZRGS(IMICRO))
- ALLOCATE(ZCRSVS(IMICRO,SIZE(PCRSVS,4)))
- ALLOCATE(ZRRSVS(IMICRO,SIZE(PRRSVS,4)))
- ALLOCATE(ZRHODREF(IMICRO))
- ALLOCATE(ZZW(IMICRO))
- ALLOCATE(ZZW2(IMICRO,SIZE(PCSVT,4)))
- ALLOCATE(ZZW4(IMICRO,SIZE(PCSVT,4)))
- ALLOCATE(ZZW1(IMICRO,6))
- ALLOCATE(ZLBDAR(IMICRO))
- ALLOCATE(ZLBDAS(IMICRO))
- ALLOCATE(ZLBDAG(IMICRO))
- ALLOCATE(ZRDRYG(IMICRO))
- ALLOCATE(ZRWETG(IMICRO))
- ALLOCATE(ZKA(IMICRO))
- ALLOCATE(ZDV(IMICRO))
- ALLOCATE(ZCJ(IMICRO))
- DO JL=1,IMICRO
- ZCSVT(JL,:) = PCSVT(I1(JL),I2(JL),I3(JL),:)
- ZCRSVS(JL,:) = ZZCRSVS(I1(JL),I2(JL),I3(JL),:)
- ZRSVT(JL,:) = PRSVT(I1(JL),I2(JL),I3(JL),:)
- ZRRSVS(JL,:) = ZZRRSVS(I1(JL),I2(JL),I3(JL),:)
-!
- ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
- ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
- ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL))
- ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL))
- ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL))
- ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL))
- ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL))
-!
- ZZRCS(JL) = ZRCS(I1(JL),I2(JL),I3(JL))
- ZZRRS(JL) = ZRRS(I1(JL),I2(JL),I3(JL))
- ZZRIS(JL) = ZRIS(I1(JL),I2(JL),I3(JL))
- ZZRSS(JL) = ZRSS(I1(JL),I2(JL),I3(JL))
- ZZRGS(JL) = ZRGS(I1(JL),I2(JL),I3(JL))
-!
- ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
- ENDDO
- IF (OUSECHIC) THEN
- ALLOCATE(ZSGSVT(IMICRO,SIZE(PSGSVT,4)))
- ALLOCATE(ZGRSVS(IMICRO,SIZE(PGRSVS,4)))
- ALLOCATE(ZSGRSVS(IMICRO,SIZE(PSGRSVS,4)))
- ALLOCATE(ZZW3(IMICRO,SIZE(PSGSVT,4)))
- DO JL=1,IMICRO
- ZGRSVS(JL,:) = ZZGRSVS(I1(JL),I2(JL),I3(JL),:)
- ZSGSVT(JL,:) = PSGSVT(I1(JL),I2(JL),I3(JL),:)
- ZSGRSVS(JL,:) = ZZSGRSVS(I1(JL),I2(JL),I3(JL),:)
- ENDDO
- ELSE
- IF (.NOT.(OCH_RET_ICE)) THEN
- ALLOCATE(ZGRSVS(IMICRO,SIZE(PGRSVS,4)))
- DO JL=1,IMICRO
- ZGRSVS(JL,:) = ZZGRSVS(I1(JL),I2(JL),I3(JL),:)
- ENDDO
- ENDIF
- ENDIF
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. COMPUTES THE SLOW WARM PROCESS SOURCES
-! --------------------------------------
-!
-!* 4.1 compute the slope parameter Lbda_r
-!
- WHERE( ZRRT(:)>0.0 )
- ZLBDAR(:) = XLBR*( ZRHODREF(:)*MAX( ZRRT(:),PRTMIN_AQ*1.e3/ZRHODREF(:)) )**XLBEXR
- END WHERE
-!
-!* 4.2 compute the autoconversion of r_c for r_r production: RCAUTR
-!
- ZZW(:) = 0.0
- ZZW2(:,:) = 0.0
-!
- DO JL=1,IMICRO
- IF ( (ZRCT(JL)>0.0) .AND. (ZZRCS(JL)>0.0) ) THEN
- ZZW(JL) = MIN( ZZRCS(JL),XTIMAUTC*MAX( ZRCT(JL)-XCRIAUTC/ZRHODREF(JL),0.0))
-!
- ZZW2(JL,:) = ZZW(JL) * ZCSVT(JL,:)/ZRCT(JL)
- ZZW2(JL,:) = MAX(MIN(ZZW2(JL,:),(ZCSVT(JL,:)/PTSTEP)),0.0)
- ZCRSVS(JL,:) = ZCRSVS(JL,:) - ZZW2(JL,:)
- ZRRSVS(JL,:) = ZRRSVS(JL,:) + ZZW2(JL,:)
- END IF
- END DO
-!
-!* 4.3 compute the accretion of r_c for r_r production: RCACCR
-!
- ZZW(:) = 0.0
- ZZW2(:,:) = 0.0
-!
- DO JL = 1,IMICRO
- IF( (ZRCT(JL)>0.0) .AND. (ZRRT(JL)>0.0) .AND. (ZZRCS(JL)>0.0) ) THEN
- ZZW(JL) = MIN( ZZRCS(JL),XFCACCR * ZRCT(JL) &
- * ZLBDAR(JL)**XEXCACCR &
- * ZRHODREF(JL)**(-XCEXVT) )
-!
- ZZW2(JL,:) = ZZW(JL) * ZCSVT(JL,:)/ZRCT(JL)
- ZZW2(JL,:) = MAX(MIN(ZZW2(JL,:),(ZCSVT(JL,:)/PTSTEP)),0.0)
- ZCRSVS(JL,:) = ZCRSVS(JL,:) - ZZW2(JL,:)
- ZRRSVS(JL,:) = ZRRSVS(JL,:) + ZZW2(JL,:)
- END IF
- END DO
-!
-!
-!* 4.4 compute the evaporation of r_r: RREVAV
-!
-! calculated by the kinetic mass transfer equation (BASIC.f90)
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 5. COMPUTES THE SLOW COLD PROCESS SOURCES
-! --------------------------------------
-!
-!* 5.1 compute the spontaneous freezing source: RRHONG
-!
- ZZW(:) = 0.0
- ZZW2(:,:) = 0.0
-!
- DO JL = 1,IMICRO
- IF( (ZZT(JL)<XTT-35.0) .AND. (ZRRT(JL)>0.) .AND. (ZZRRS(JL)>0.) ) THEN
- ZZW(JL) = MIN( ZZRRS(JL),ZRRT(JL)/PTSTEP )
- ZZW2(JL,:) = ZZW(JL) * ZRSVT(JL,:)/ZRRT(JL)
- ZZW2(JL,:) = MAX(MIN(ZZW2(JL,:),(ZRSVT(JL,:)/PTSTEP)),0.0)
- ZRRSVS(JL,:) = ZRRSVS(JL,:) - ZZW2(JL,:)
- IF (OUSECHIC) THEN
- DO JLI = 1, SIZE(PSGRSVS,4)
- IF (TRIM(HICNAMES(JLI)) == 'IC_HNO3' .OR. TRIM(HICNAMES(JLI)) == 'IC_SULF' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_H2SO4' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_NH3' .OR. TRIM(HICNAMES(JLI)) == 'IC_HCL' &
- .OR. HICNAMES(JLI)(1:4) == 'IC_A' .OR. HICNAMES(JLI)(1:4) == 'IC_B' &
- .OR. NINDEXGI(JLI).EQ.0) THEN
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETNA * ZZW2(JL,NINDEXWI(JLI))
- ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_H2O2' .OR. TRIM(HICNAMES(JLI)) == 'IC_HO2' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_HONO' .OR. TRIM(HICNAMES(JLI)) == 'IC_HNO4'&
- .OR. TRIM(HICNAMES(JLI)) == 'IC_HCHO' .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA1'&
- .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA2') THEN
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETHP * ZZW2(JL,NINDEXWI(JLI))
- ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
- (1. - XRETHP) * ZZW2(JL,NINDEXWI(JLI))
- ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_SO2' .OR. TRIM(HICNAMES(JLI)) == 'IC_OH' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_MO2' .OR. &
- TRIM(HICNAMES(JLI)) == 'IC_OP1') THEN
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETSU * ZZW2(JL,NINDEXWI(JLI))
- ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
- (1. - XRETSU) * ZZW2(JL,NINDEXWI(JLI))
- ELSE
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETDF * ZZW2(JL,NINDEXWI(JLI))
- ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
- (1. - XRETDF) * ZZW2(JL,NINDEXWI(JLI))
- ENDIF
- ENDDO
- ELSE
- IF (.NOT.(OCH_RET_ICE)) THEN
- DO JLW = 1, SIZE(PRRSVS,4)
- IF (.NOT.(NINDEXWG(JLW).EQ.0)) THEN
- ZGRSVS(JL,NINDEXWG(JLW)) = ZGRSVS(JL,NINDEXWG(JLW)) + ZZW2(JL,JLW)
- ENDIF
- ENDDO
- ENDIF
- ENDIF
- ENDIF
- ENDDO
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 6. COMPUTES THE FAST COLD PROCESS SOURCES
-! --------------------------------------
-!
-!* 6.1 compute the slope parameter Lbda_s and Lbda_g
-!
- WHERE ( ZRST(:)>0.0 )
- ZLBDAS(:) = MIN( XLBDAS_MAX, &
- XLBS*( ZRHODREF(:)*MAX( ZRST(:),PRTMIN_AQ*1.e3/ZRHODREF(:)) )**XLBEXS )
- END WHERE
-!
- WHERE ( ZRGT(:)>0.0 )
- ZLBDAG(:) = XLBG*( ZRHODREF(:)*MAX( ZRGT(:),PRTMIN_AQ*1.e3/ZRHODREF(:)))**XLBEXG
- END WHERE
-!
-!* 6.2 cloud droplet riming of the aggregates
-!
- ZZW1(:,:) = 0.0
- ZZW(:) = 0.0
-
- ALLOCATE(GRIM(IMICRO))
- GRIM(:) = (ZRCT(:)>PRTMIN_AQ*1.e3/ZRHODREF(:)) .AND. &
- (ZRST(:)>PRTMIN_AQ*1.e3/ZRHODREF(:)) .AND. &
- (ZZRCS(:)>0.0) .AND. (ZZT(:)<XTT)
- IGRIM = COUNT( GRIM(:) )
-!
- IF( IGRIM>0 ) THEN
-!
-! 6.2.0 allocations
-!
- ALLOCATE(ZVEC1(IGRIM))
- ALLOCATE(ZVEC2(IGRIM))
- ALLOCATE(IVEC1(IGRIM))
- ALLOCATE(IVEC2(IGRIM))
-!
-! 6.2.1 select the ZLBDAS
-!
- ZVEC1(:) = PACK( ZLBDAS(:),MASK=GRIM(:) )
-!
-! 6.2.2 find the next lower indice for the ZLBDAS in the geometrical
-! set of Lbda_s used to tabulate some moments of the incomplete
-! gamma function
-!
- ZVEC2(1:IGRIM) = MAX( 1.00001, MIN( REAL(NGAMINC)-0.00001, &
- XRIMINTP1 * LOG( ZVEC1(1:IGRIM) ) + XRIMINTP2 ) )
- IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) )
- ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - REAL( IVEC2(1:IGRIM) )
-!
-! 6.2.3 perform the linear interpolation of the normalized
-! "2+XDS"-moment of the incomplete gamma function
-!
- ZVEC1(1:IGRIM) = XGAMINC_RIM1( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) &
- - XGAMINC_RIM1( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0)
- ZZW(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GRIM,FIELD=0.0 )
-!
-! 6.2.4 riming of the small sized aggregates
-!
- ZZW2(:,:) = 0.0
- DO JL = 1,IMICRO
- IF ( GRIM(JL) ) THEN
- ZZW1(JL,1) = MIN( ZZRCS(JL), XCRIMSS * ZZW(JL) * ZRCT(JL) * ZRST(JL) & ! RCRIMSS
- * ZLBDAS(JL)**(XBS+XEXCRIMSS) * ZRHODREF(JL)**(-XCEXVT+1) )
- ZZW2(JL,:) = ZZW1(JL,1) * ZCSVT(JL,:)/ZRCT(JL)
- ZZW2(JL,:) = MAX(MIN(ZZW2(JL,:),(ZCSVT(JL,:)/PTSTEP)),0.0)
- ZCRSVS(JL,:) = ZCRSVS(JL,:) - ZZW2(JL,:)
- IF (OUSECHIC) THEN
- DO JLI = 1, SIZE(PSGRSVS,4)
- IF (TRIM(HICNAMES(JLI)) == 'IC_HNO3' .OR. TRIM(HICNAMES(JLI)) == 'IC_SULF' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_H2SO4' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_NH3' .OR. TRIM(HICNAMES(JLI)) == 'IC_HCL' &
- .OR. HICNAMES(JLI)(1:4) == 'IC_A' .OR. HICNAMES(JLI)(1:4) == 'IC_B' &
- .OR. NINDEXGI(JLI).EQ.0) THEN
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETNA * ZZW2(JL,NINDEXWI(JLI))
- ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_H2O2' .OR. TRIM(HICNAMES(JLI)) == 'IC_HO2' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_HONO' .OR. TRIM(HICNAMES(JLI)) == 'IC_HNO4'&
- .OR. TRIM(HICNAMES(JLI)) == 'IC_HCHO' .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA1'&
- .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA2') THEN
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETHP * ZZW2(JL,NINDEXWI(JLI))
- ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
- (1. - XRETHP) * ZZW2(JL,NINDEXWI(JLI))
- ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_SO2' .OR. TRIM(HICNAMES(JLI)) == 'IC_OH' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_MO2' .OR. &
- TRIM(HICNAMES(JLI)) == 'IC_OP1') THEN
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETSU * ZZW2(JL,NINDEXWI(JLI))
- ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
- (1. - XRETSU) * ZZW2(JL,NINDEXWI(JLI))
- ELSE
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETDF * ZZW2(JL,NINDEXWI(JLI))
- ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
- (1. - XRETDF) * ZZW2(JL,NINDEXWI(JLI))
- ENDIF
- ENDDO
- ELSE
- IF (.NOT.(OCH_RET_ICE)) THEN
- DO JLW = 1, SIZE(PCRSVS,4)
- IF (.NOT.(NINDEXWG(JLW).EQ.0)) THEN
- ZGRSVS(JL,NINDEXWG(JLW)) = ZGRSVS(JL,NINDEXWG(JLW)) + ZZW2(JL,JLW)
- ENDIF
- ENDDO
- ENDIF
- ENDIF
- ENDIF
- ENDDO
-!
-! 6.2.5 riming-conversion of the large sized aggregates into graupel
-!
- ZZW2(:,:) = 0.0
- DO JL = 1,IMICRO
- IF ( GRIM(JL) .AND. (ZZRSS(JL)>0.0) ) THEN
- ZZW1(JL,2) = MIN( ZZRCS(JL), XCRIMSG * ZRCT(JL) * ZRST(JL) * ZLBDAS(JL)**(XBS+XEXCRIMSG) & ! RCRIMSG
- * ZRHODREF(JL)**(-XCEXVT+1) - ZZW1(JL,1) )
- ZZW2(JL,:) = ZZW1(JL,2) * ZCSVT(JL,:)/ZRCT(JL)
- ZZW2(JL,:) = MAX(MIN(ZZW2(JL,:),(ZCSVT(JL,:)/PTSTEP)),0.0)
- ZCRSVS(JL,:) = ZCRSVS(JL,:) - ZZW2(JL,:)
- IF (OUSECHIC) THEN
- DO JLI = 1, SIZE(PSGRSVS,4)
- IF (TRIM(HICNAMES(JLI)) == 'IC_HNO3' .OR. TRIM(HICNAMES(JLI)) == 'IC_SULF' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_H2SO4' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_NH3' .OR. TRIM(HICNAMES(JLI)) == 'IC_HCL' &
- .OR. HICNAMES(JLI)(1:4) == 'IC_A' .OR. HICNAMES(JLI)(1:4) == 'IC_B' &
- .OR. NINDEXGI(JLI).EQ.0) THEN
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETNA * ZZW2(JL,NINDEXWI(JLI))
- ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_H2O2' .OR. TRIM(HICNAMES(JLI)) == 'IC_HO2' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_HONO' .OR. TRIM(HICNAMES(JLI)) == 'IC_HNO4'&
- .OR. TRIM(HICNAMES(JLI)) == 'IC_HCHO' .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA1'&
- .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA2') THEN
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETHP * ZZW2(JL,NINDEXWI(JLI))
- ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
- (1. - XRETHP) * ZZW2(JL,NINDEXWI(JLI))
- ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_SO2' .OR. TRIM(HICNAMES(JLI)) == 'IC_OH' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_MO2' .OR. &
- TRIM(HICNAMES(JLI)) == 'IC_OP1') THEN
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETSU * ZZW2(JL,NINDEXWI(JLI))
- ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
- (1. - XRETSU) * ZZW2(JL,NINDEXWI(JLI))
- ELSE
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETDF * ZZW2(JL,NINDEXWI(JLI))
- ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
- (1. - XRETDF) * ZZW2(JL,NINDEXWI(JLI))
- ENDIF
- ENDDO
- ELSE
- IF (.NOT.(OCH_RET_ICE)) THEN
- DO JLW = 1, SIZE(PCRSVS,4)
- IF (.NOT.(NINDEXWG(JLW).EQ.0)) THEN
- ZGRSVS(JL,NINDEXWG(JLW)) = ZGRSVS(JL,NINDEXWG(JLW)) + ZZW2(JL,JLW)
- ENDIF
- ENDDO
- ENDIF
- ENDIF
- ENDIF
- ENDDO
-
- DEALLOCATE(IVEC2)
- DEALLOCATE(IVEC1)
- DEALLOCATE(ZVEC2)
- DEALLOCATE(ZVEC1)
- END IF
- DEALLOCATE(GRIM)
-!
-!* 6.3 rain accretion onto the aggregates
-!
- ZZW(:) = 0.0
- ZZW1(:,2:3) = 0.0
- ALLOCATE(GACC(IMICRO))
- GACC(:) = (ZRRT(:)>PRTMIN_AQ*1.e3/ZRHODREF(:)) .AND. &
- (ZRST(:)>PRTMIN_AQ*1.e3/ZRHODREF(:)) .AND. &
- (ZZRRS(:)>0.0) .AND. (ZZT(:)<XTT)
- IGACC = COUNT( GACC(:) )
-!
- IF( IGACC>0 ) THEN
-!
-! 6.3.0 allocations
-!
- ALLOCATE(ZVEC1(IGACC))
- ALLOCATE(ZVEC2(IGACC))
- ALLOCATE(ZVEC3(IGACC))
- ALLOCATE(IVEC1(IGACC))
- ALLOCATE(IVEC2(IGACC))
-!
-! 6.3.1 select the (ZLBDAS,ZLBDAR) couplet
-!
- ZVEC1(:) = PACK( ZLBDAS(:),MASK=GACC(:) )
- ZVEC2(:) = PACK( ZLBDAR(:),MASK=GACC(:) )
-!
-! 6.3.2 find the next lower indice for the ZLBDAS and for the ZLBDAR
-! in the geometrical set of (Lbda_s,Lbda_r) couplet use to
-! tabulate the RACCSS-kernel
-!
- ZVEC1(1:IGACC) = MAX( 1.00001, MIN( REAL(NACCLBDAS)-0.00001, &
- XACCINTP1S * LOG( ZVEC1(1:IGACC) ) + XACCINTP2S ) )
- IVEC1(1:IGACC) = INT( ZVEC1(1:IGACC) )
- ZVEC1(1:IGACC) = ZVEC1(1:IGACC) - REAL( IVEC1(1:IGACC) )
-!
- ZVEC2(1:IGACC) = MAX( 1.00001, MIN( REAL(NACCLBDAR)-0.00001, &
- XACCINTP1R * LOG( ZVEC2(1:IGACC) ) + XACCINTP2R ) )
- IVEC2(1:IGACC) = INT( ZVEC2(1:IGACC) )
- ZVEC2(1:IGACC) = ZVEC2(1:IGACC) - REAL( IVEC2(1:IGACC) )
-!
-! 6.3.3 perform the bilinear interpolation of the normalized
-! RACCSS-kernel
-!
- DO JJ = 1,IGACC
- ZVEC3(JJ) = ( XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * (ZVEC1(JJ) - 1.0)
- END DO
- ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GACC,FIELD=0.0 )
-!
-! 6.3.4 raindrop accretion on the small sized aggregates
-!
- ZZW2(:,:) = 0.0
- DO JL = 1,IMICRO
- IF ( GACC(JL) ) THEN
- ZZW1(JL,2) = & !! coef of RRACCS
- XFRACCSS*( ZRST(JL)*ZLBDAS(JL)**XBS )*( ZRHODREF(JL)**(-XCEXVT) ) &
- *( XLBRACCS1/((ZLBDAS(JL)**2) ) + &
- XLBRACCS2/( ZLBDAS(JL) * ZLBDAR(JL) ) + &
- XLBRACCS3/( (ZLBDAR(JL)**2)) )/ZLBDAR(JL)**4
- ZZW1(JL,4) = MIN( ZZRRS(JL),ZZW1(JL,2)*ZZW(JL) ) ! RRACCSS
- ZZW2(JL,:) = ZZW1(JL,4) * ZRSVT(JL,:)/ZRRT(JL)
- ZZW2(JL,:) = MAX(MIN(ZZW2(JL,:),(ZRSVT(JL,:)/PTSTEP)),0.0)
- ZRRSVS(JL,:) = ZRRSVS(JL,:) - ZZW2(JL,:)
- IF (OUSECHIC) THEN
- DO JLI = 1, SIZE(PSGRSVS,4)
- IF (TRIM(HICNAMES(JLI)) == 'IC_HNO3' .OR. TRIM(HICNAMES(JLI)) == 'IC_SULF' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_H2SO4' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_NH3' .OR. TRIM(HICNAMES(JLI)) == 'IC_HCL' &
- .OR. HICNAMES(JLI)(1:4) == 'IC_A' .OR. HICNAMES(JLI)(1:4) == 'IC_B' &
- .OR. NINDEXGI(JLI).EQ.0) THEN
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETNA * ZZW2(JL,NINDEXWI(JLI))
- ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_H2O2' .OR. TRIM(HICNAMES(JLI)) == 'IC_HO2' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_HONO' .OR. TRIM(HICNAMES(JLI)) == 'IC_HNO4'&
- .OR. TRIM(HICNAMES(JLI)) == 'IC_HCHO' .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA1'&
- .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA2') THEN
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETHP * ZZW2(JL,NINDEXWI(JLI))
- ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
- (1. - XRETHP) * ZZW2(JL,NINDEXWI(JLI))
- ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_SO2' .OR. TRIM(HICNAMES(JLI)) == 'IC_OH' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_MO2' .OR. &
- TRIM(HICNAMES(JLI)) == 'IC_OP1') THEN
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETSU * ZZW2(JL,NINDEXWI(JLI))
- ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
- (1. - XRETSU) * ZZW2(JL,NINDEXWI(JLI))
- ELSE
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETDF * ZZW2(JL,NINDEXWI(JLI))
- ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
- (1. - XRETDF) * ZZW2(JL,NINDEXWI(JLI))
- ENDIF
- ENDDO
- ELSE
- IF (.NOT.(OCH_RET_ICE)) THEN
- DO JLW = 1, SIZE(PRRSVS,4)
- IF (.NOT.(NINDEXWG(JLW).EQ.0)) THEN
- ZGRSVS(JL,NINDEXWG(JLW)) = ZGRSVS(JL,NINDEXWG(JLW)) + ZZW2(JL,JLW)
- ENDIF
- ENDDO
- ENDIF
- ENDIF
- ENDIF
- ENDDO
-!
-! 6.3.4b perform the bilinear interpolation of the normalized
-! RACCS-kernel
-!
- DO JJ = 1,IGACC
- ZVEC3(JJ) = ( XKER_RACCS(IVEC2(JJ)+1,IVEC1(JJ)+1)* ZVEC1(JJ) &
- - XKER_RACCS(IVEC2(JJ)+1,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
- * ZVEC2(JJ) &
- - ( XKER_RACCS(IVEC2(JJ) ,IVEC1(JJ)+1)* ZVEC1(JJ) &
- - XKER_RACCS(IVEC2(JJ) ,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) &
- * (ZVEC2(JJ) - 1.0)
- END DO
- ZZW1(:,2) = ZZW1(:,2)*UNPACK( VECTOR=ZVEC3(:),MASK=GACC(:),FIELD=0.0 )
-!
-! 6.3.5 raindrop accretion-conversion of the large sized aggregates
-! into graupeln
-!
- ZZW2(:,:) = 0.0
- WHERE ( GACC(:) .AND. (ZZRSS(:)>0.0) )
- ZZW1(:,2) = MAX( MIN( ZZRRS(:),ZZW1(:,2)-ZZW1(:,4) ),0.0 ) ! RRACCSG
- END WHERE
- DO JL = 1,IMICRO
- IF ( GACC(JL) .AND. (ZZRSS(JL)>0.0) .AND. ZZW1(JL,2)>0.0 ) THEN
- ZZW2(JL,:) = ZZW1(JL,2) * ZRSVT(JL,:)/ZRRT(JL)
- ZZW2(JL,:) = MAX(MIN(ZZW2(JL,:),(ZRSVT(JL,:)/PTSTEP)),0.0)
- ZRRSVS(JL,:) = ZRRSVS(JL,:) - ZZW2(JL,:)
- IF (OUSECHIC) THEN
- DO JLI = 1, SIZE(PSGRSVS,4)
- IF (TRIM(HICNAMES(JLI)) == 'IC_HNO3' .OR. TRIM(HICNAMES(JLI)) == 'IC_SULF' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_H2SO4' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_NH3' .OR. TRIM(HICNAMES(JLI)) == 'IC_HCL' &
- .OR. HICNAMES(JLI)(1:4) == 'IC_A' .OR. HICNAMES(JLI)(1:4) == 'IC_B' &
- .OR. NINDEXGI(JLI).EQ.0) THEN
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETNA * ZZW2(JL,NINDEXWI(JLI))
- ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_H2O2' .OR. TRIM(HICNAMES(JLI)) == 'IC_HO2' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_HONO' .OR. TRIM(HICNAMES(JLI)) == 'IC_HNO4'&
- .OR. TRIM(HICNAMES(JLI)) == 'IC_HCHO' .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA1'&
- .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA2') THEN
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETHP * ZZW2(JL,NINDEXWI(JLI))
- ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
- (1. - XRETHP) * ZZW2(JL,NINDEXWI(JLI))
- ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_SO2' .OR. TRIM(HICNAMES(JLI)) == 'IC_OH' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_MO2' .OR. &
- TRIM(HICNAMES(JLI)) == 'IC_OP1') THEN
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETSU * ZZW2(JL,NINDEXWI(JLI))
- ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
- (1. - XRETSU) * ZZW2(JL,NINDEXWI(JLI))
- ELSE
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETDF * ZZW2(JL,NINDEXWI(JLI))
- ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
- (1. - XRETDF) * ZZW2(JL,NINDEXWI(JLI))
- ENDIF
- ENDDO
- ELSE
- IF (.NOT.(OCH_RET_ICE)) THEN
- DO JLW = 1, SIZE(PRRSVS,4)
- IF (.NOT.(NINDEXWG(JLW).EQ.0)) THEN
- ZGRSVS(JL,NINDEXWG(JLW)) = ZGRSVS(JL,NINDEXWG(JLW)) + ZZW2(JL,JLW)
- ENDIF
- ENDDO
- ENDIF
- ENDIF
- ENDIF
- ENDDO
-!
- DEALLOCATE(IVEC2)
- DEALLOCATE(IVEC1)
- DEALLOCATE(ZVEC3)
- DEALLOCATE(ZVEC2)
- DEALLOCATE(ZVEC1)
- END IF
- DEALLOCATE(GACC)
-!
-!* 6.4 rain contact freezing
-!
- ZZW1(:,4) = 0.0
- ZZW2(:,:) = 0.0
- DO JL = 1,IMICRO
- IF ( (ZRIT(JL)>PRTMIN_AQ*1.e3/ZRHODREF(JL)) .AND. &
- (ZRRT(JL)>PRTMIN_AQ*1.e3/ZRHODREF(JL)) .AND. &
- (ZZRIS(JL)>0.0) .AND. (ZZRRS(JL)>0.0) ) THEN
- ZZW1(JL,4) = MIN( ZZRRS(JL), XRCFRI * ZCIT(JL) & ! RRCFRIG
- * ZLBDAR(JL)**XEXRCFRI &
- * ZRHODREF(JL)**(-XCEXVT-1.) )
- ZZW2(JL,:) = ZZW1(JL,4) * ZRSVT(JL,:)/ZRRT(JL)
- ZZW2(JL,:) = MAX(MIN(ZZW2(JL,:),(ZRSVT(JL,:)/PTSTEP)),0.0)
- ZRRSVS(JL,:) = ZRRSVS(JL,:) - ZZW2(JL,:)
- IF (OUSECHIC) THEN
- DO JLI = 1, SIZE(PSGRSVS,4)
- IF (TRIM(HICNAMES(JLI)) == 'IC_HNO3' .OR. TRIM(HICNAMES(JLI)) == 'IC_SULF' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_H2SO4' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_NH3' .OR. TRIM(HICNAMES(JLI)) == 'IC_HCL' &
- .OR. HICNAMES(JLI)(1:4) == 'IC_A' .OR. HICNAMES(JLI)(1:4) == 'IC_B' &
- .OR. NINDEXGI(JLI).EQ.0) THEN
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETNA * ZZW2(JL,NINDEXWI(JLI))
- ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_H2O2' .OR. TRIM(HICNAMES(JLI)) == 'IC_HO2' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_HONO' .OR. TRIM(HICNAMES(JLI)) == 'IC_HNO4'&
- .OR. TRIM(HICNAMES(JLI)) == 'IC_HCHO' .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA1'&
- .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA2') THEN
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETHP * ZZW2(JL,NINDEXWI(JLI))
- ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
- (1. - XRETHP) * ZZW2(JL,NINDEXWI(JLI))
- ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_SO2' .OR. TRIM(HICNAMES(JLI)) == 'IC_OH' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_MO2' .OR. &
- TRIM(HICNAMES(JLI)) == 'IC_OP1') THEN
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETSU * ZZW2(JL,NINDEXWI(JLI))
- ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
- (1. - XRETSU) * ZZW2(JL,NINDEXWI(JLI))
- ELSE
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETDF * ZZW2(JL,NINDEXWI(JLI))
- ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
- (1. - XRETDF) * ZZW2(JL,NINDEXWI(JLI))
- ENDIF
- ENDDO
- ELSE
- IF (.NOT.(OCH_RET_ICE)) THEN
- DO JLW = 1, SIZE(PRRSVS,4)
- IF (.NOT.(NINDEXWG(JLW).EQ.0)) THEN
- ZGRSVS(JL,NINDEXWG(JLW)) = ZGRSVS(JL,NINDEXWG(JLW)) + ZZW2(JL,JLW)
- ENDIF
- ENDDO
- ENDIF
- ENDIF
- ENDIF
- ENDDO
-!
-!* 6.5 compute the Dry growth case of graupel
-!
- ZZW(:) = 0.0
- ZZW1(:,:) = 0.0
- WHERE( (ZRGT(:)>PRTMIN_AQ*1.e3/ZRHODREF(:)) .AND. &
- ((ZRCT(:)>PRTMIN_AQ*1.e3/ZRHODREF(:) .AND. ZZRCS(:)>0.0)) )
- ZZW(:) = ZLBDAG(:)**(XCXG-XDG-2.0) * ZRHODREF(:)**(-XCEXVT)
- ZZW1(:,1) = MIN( ZZRCS(:),XFCDRYG * ZRCT(:) * ZZW(:) ) ! RCDRYG
- END WHERE
- WHERE( (ZRGT(:)>PRTMIN_AQ*1.e3/ZRHODREF(:)) .AND. &
- ((ZRIT(:)>PRTMIN_AQ*1.e3/ZRHODREF(:) .AND. ZZRIS(:)>0.0)) )
- ZZW(:) = ZLBDAG(:)**(XCXG-XDG-2.0) * ZRHODREF(:)**(-XCEXVT)
- ZZW1(:,2) = MIN( ZZRIS(:),XFIDRYG * EXP( XCOLEXIG*(ZZT(:)-XTT) ) &
- * ZRIT(:) * ZZW(:) ) ! RIDRYG
- END WHERE
-!
-! 6.5.1 accretion of aggregates on the graupeln
-!
- ALLOCATE(GDRY(IMICRO))
- GDRY(:) = (ZRST(:)>PRTMIN_AQ*1.e3/ZRHODREF(:)) .AND. &
- (ZRGT(:)>PRTMIN_AQ*1.e3/ZRHODREF(:)) .AND. (ZZRSS(:)>0.0)
- IGDRY = COUNT( GDRY(:) )
-!
- IF( IGDRY>0 ) THEN
-!
-! 6.5.2 allocations
-!
- ALLOCATE(ZVEC1(IGDRY))
- ALLOCATE(ZVEC2(IGDRY))
- ALLOCATE(ZVEC3(IGDRY))
- ALLOCATE(IVEC1(IGDRY))
- ALLOCATE(IVEC2(IGDRY))
-!
-! 6.5.3 select the (ZLBDAG,ZLBDAS) couplet
-!
- ZVEC1(:) = PACK( ZLBDAG(:),MASK=GDRY(:) )
- ZVEC2(:) = PACK( ZLBDAS(:),MASK=GDRY(:) )
-!
-! 6.5.4 find the next lower indice for the ZLBDAG and for the ZLBDAS
-! in the geometrical set of (Lbda_g,Lbda_s) couplet use to
-! tabulate the SDRYG-kernel
-!
- ZVEC1(1:IGDRY) = MAX( 1.00001, MIN( REAL(NDRYLBDAG)-0.00001, &
- XDRYINTP1G * LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) )
- IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) )
- ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - REAL( IVEC1(1:IGDRY) )
-!
- ZVEC2(1:IGDRY) = MAX( 1.00001, MIN( REAL(NDRYLBDAS)-0.00001, &
- XDRYINTP1S * LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2S ) )
- IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
- ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) )
-!
-! 6.5.5 perform the bilinear interpolation of the normalized
-! SDRYG-kernel
-!
- DO JJ = 1,IGDRY
- ZVEC3(JJ) = ( XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * (ZVEC1(JJ) - 1.0)
- END DO
- ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 )
-!
- WHERE( GDRY(:) )
- ZZW1(:,3) = MIN( ZZRSS(:),XFSDRYG*ZZW(:) & ! RSDRYG
- * EXP( XCOLEXSG*(ZZT(:)-XTT) ) &
- *ZRST(:)*( ZLBDAG(:)**XCXG ) &
- *( ZRHODREF(:)**(-XCEXVT) ) &
- *( XLBSDRYG1/( ZLBDAG(:)**2 ) + &
- XLBSDRYG2/( ZLBDAG(:) * ZLBDAS(:) ) + &
- XLBSDRYG3/( ZLBDAS(:)**2) ) )
- END WHERE
- DEALLOCATE(IVEC2)
- DEALLOCATE(IVEC1)
- DEALLOCATE(ZVEC3)
- DEALLOCATE(ZVEC2)
- DEALLOCATE(ZVEC1)
- END IF
-!
-! 6.5.6 accretion of raindrops on the graupeln
-!
- GDRY(:) = (ZRRT(:)>PRTMIN_AQ*1.e3/ZRHODREF(:)) .AND. &
- (ZRGT(:)>PRTMIN_AQ*1.e3/ZRHODREF(:)) .AND. (ZZRRS(:)>0.0)
- IGDRY = COUNT( GDRY(:) )
-!
- IF( IGDRY>0 ) THEN
-!
-! 6.5.7 allocations
-!
- ALLOCATE(ZVEC1(IGDRY))
- ALLOCATE(ZVEC2(IGDRY))
- ALLOCATE(ZVEC3(IGDRY))
- ALLOCATE(IVEC1(IGDRY))
- ALLOCATE(IVEC2(IGDRY))
-!
-! 6.5.8 select the (ZLBDAG,ZLBDAR) couplet
-!
- ZVEC1(:) = PACK( ZLBDAG(:),MASK=GDRY(:) )
- ZVEC2(:) = PACK( ZLBDAR(:),MASK=GDRY(:) )
-!
-! 6.5.9 find the next lower indice for the ZLBDAG and for the ZLBDAR
-! in the geometrical set of (Lbda_g,Lbda_r) couplet use to
-! tabulate the RDRYG-kernel
-!
- ZVEC1(1:IGDRY) = MAX( 1.00001, MIN( REAL(NDRYLBDAG)-0.00001, &
- XDRYINTP1G * LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) )
- IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) )
- ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - REAL( IVEC1(1:IGDRY) )
-!
- ZVEC2(1:IGDRY) = MAX( 1.00001, MIN( REAL(NDRYLBDAR)-0.00001, &
- XDRYINTP1R * LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2R ) )
- IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) )
- ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) )
-!
-! 6.5.10 perform the bilinear interpolation of the normalized
-! RDRYG-kernel
-!
- DO JJ = 1,IGDRY
- ZVEC3(JJ) = ( XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * ZVEC1(JJ) &
- - ( XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) &
- - XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) &
- * (ZVEC1(JJ) - 1.0)
- END DO
- ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 )
-!
- WHERE( GDRY(:) )
- ZZW1(:,4) = MIN( ZZRRS(:), XFRDRYG*ZZW(:) & ! RRDRYG
- *( ZLBDAR(:)**(-4) )*( ZLBDAG(:)**XCXG ) &
- *( ZRHODREF(:)**(-XCEXVT-1.) ) &
- *( XLBRDRYG1/( ZLBDAG(:)**2 ) + &
- XLBRDRYG2/( ZLBDAG(:) * ZLBDAR(:) ) + &
- XLBRDRYG3/( ZLBDAR(:)**2) ) )
- END WHERE
- DEALLOCATE(IVEC2)
- DEALLOCATE(IVEC1)
- DEALLOCATE(ZVEC3)
- DEALLOCATE(ZVEC2)
- DEALLOCATE(ZVEC1)
- END IF
-!
- ZRDRYG(:) = ZZW1(:,1) + ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,4)
- DEALLOCATE(GDRY)
-!
-!* 6.6 compute the Wet growth case of the graupel
-!
- ZZW(:) = 0.0
- ZRWETG(:) = 0.0
-!
- ZKA(:) = 2.38E-2 + 0.0071E-2 * ( ZZT(:) - XTT ) ! k_a
- ZDV(:) = 0.211E-4 * (ZZT(:)/XTT)**1.94 * (XP00/ZPRES(:)) ! D_v
- ZCJ(:) = XSCFAC * ZRHODREF(:)**0.3 / SQRT( 1.718E-5+0.0049E-5*(ZZT(:)-XTT) )
- !c^prime_j (in the ventilation factor)
- WHERE( ZRGT(:)>PRTMIN_AQ*1.e3/ZRHODREF(:) )
- ZZW1(:,5) = MIN( ZZRIS(:), &
- ZZW1(:,2) / (XCOLIG*EXP(XCOLEXIG*(ZZT(:)-XTT)) ) ) ! RIWETG
- ZZW1(:,6) = MIN( ZZRSS(:), &
- ZZW1(:,3) / (XCOLSG*EXP(XCOLEXSG*(ZZT(:)-XTT)) ) ) ! RSWETG
-!
- ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
- ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + &
- ( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) &
- *(XESTT-ZZW(:))/(XRV*ZZT(:)) )
-! compute RWETG
-!
- ZRWETG(:)=MAX( 0.0, &
- ( ZZW(:) * ( X0DEPG* ZLBDAG(:)**XEX0DEPG + &
- X1DEPG*ZCJ(:)*ZLBDAG(:)**XEX1DEPG ) + &
- ( ZZW1(:,5)+ZZW1(:,6) ) * &
- ( ZRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-ZZT(:))) ) ) / &
- ( ZRHODREF(:)*(XLMTT-XCL*(XTT-ZZT(:))) ) )
- END WHERE
-!
-!* 6.7 Select Wet or Dry case for the growth of the graupel
-!
- ZZW(:) = 0.0
- ZZW2(:,:) = 0.0
- ZZW4(:,:) = 0.0
- DO JL = 1,IMICRO
- IF ( (ZRGT(JL)>PRTMIN_AQ*1.e3/ZRHODREF(JL)) .AND. & ! wet case
- ZZT(JL)<XTT .AND. ZRDRYG(JL)>=ZRWETG(JL) .AND. &
- ZRWETG(JL)>0.0 .AND. ZRCT(JL)>0.0 .AND. ZRRT(JL)>0.0) THEN
- ZZW(JL) = ZRWETG(JL)
- ZZW2(JL,:) = ZZW(JL) * ZRSVT(JL,:)/ZRRT(JL)
- ZZW2(JL,:) = MAX(MIN(ZZW2(JL,:),(ZRSVT(JL,:)/PTSTEP)),0.0)
- ZRRSVS(JL,:) = ZRRSVS(JL,:) - ZZW2(JL,:) ! rain -> graupel
- IF (OUSECHIC) THEN
- ZZW3(:,:) = 0.0
- DO JLI = 1, SIZE(PSGRSVS,4)
- IF (TRIM(HICNAMES(JLI)) == 'IC_HNO3' .OR. TRIM(HICNAMES(JLI)) == 'IC_SULF' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_H2SO4' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_NH3' .OR. TRIM(HICNAMES(JLI)) == 'IC_HCL' &
- .OR. HICNAMES(JLI)(1:4) == 'IC_A' .OR. HICNAMES(JLI)(1:4) == 'IC_B' &
- .OR. NINDEXGI(JLI).EQ.0) THEN
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETNA * ZZW2(JL,NINDEXWI(JLI))
- ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_H2O2' .OR. TRIM(HICNAMES(JLI)) == 'IC_HO2' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_HONO' .OR. TRIM(HICNAMES(JLI)) == 'IC_HNO4'&
- .OR. TRIM(HICNAMES(JLI)) == 'IC_HCHO' .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA1'&
- .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA2') THEN
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETHP * ZZW2(JL,NINDEXWI(JLI))
- ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
- (1. - XRETHP) * ZZW2(JL,NINDEXWI(JLI))
- ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_SO2' .OR. TRIM(HICNAMES(JLI)) == 'IC_OH' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_MO2' .OR. &
- TRIM(HICNAMES(JLI)) == 'IC_OP1') THEN
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETSU * ZZW2(JL,NINDEXWI(JLI))
- ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
- (1. - XRETSU) * ZZW2(JL,NINDEXWI(JLI))
- ELSE
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETDF * ZZW2(JL,NINDEXWI(JLI))
- ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + &
- (1. - XRETDF) * ZZW2(JL,NINDEXWI(JLI))
- ENDIF
- ENDDO
- IF (ZRST(JL)>0.0) THEN
- ZZW3(JL,:) = ZZW1(JL,6) * ZSGSVT(JL,:)/ZRST(JL)
- ZZW3(JL,:) = MAX(MIN(ZZW3(JL,:),(ZSGSVT(JL,:)/PTSTEP)),0.0)
- ZSGRSVS(JL,:) = ZSGRSVS(JL,:) - ZZW3(JL,:) !snow->rain
- DO JLI = 1, SIZE(PSGRSVS,4)
- ZRRSVS(JL,NINDEXWI(JLI)) = ZRRSVS(JL,NINDEXWI(JLI)) + ZZW3(JL,JLI)
- ENDDO
- ENDIF
- ELSE
- IF (.NOT.(OCH_RET_ICE)) THEN
- DO JLW = 1, SIZE(PRRSVS,4)
- IF (.NOT.(NINDEXWG(JLW).EQ.0)) THEN
- ZGRSVS(JL,NINDEXWG(JLW)) = ZGRSVS(JL,NINDEXWG(JLW)) + ZZW2(JL,JLW)
- ENDIF
- ENDDO
- ENDIF
- ENDIF
- ZZW4(JL,:) = ZZW1(JL,1) * ZCSVT(JL,:)/ZRCT(JL)
- ZZW4(JL,:) = MAX(MIN(ZZW4(JL,:),(ZCSVT(JL,:)/PTSTEP)),0.0)
- ZCRSVS(JL,:) = ZCRSVS(JL,:) - ZZW4(JL,:) !cloud->rain
- ZRRSVS(JL,:) = ZRRSVS(JL,:) + ZZW4(JL,:)
- ELSE IF ( (ZRGT(JL)>PRTMIN_AQ*1.e3/ZRHODREF(JL)) .AND. & ! dry case
- ZZT(JL)<XTT .AND. ZRDRYG(JL)<ZRWETG(JL) .AND. &
- ZRDRYG(JL)>0.0 .AND. ZRCT(JL)>0.0 .AND. ZRRT(JL)>0.0) THEN
- ZZW2(JL,:) = ZZW1(JL,1) * ZCSVT(JL,:)/ZRCT(JL)
- ZZW2(JL,:) = MAX(MIN(ZZW2(JL,:),(ZCSVT(JL,:)/PTSTEP)),0.0)
- ZZW4(JL,:) = ZZW1(JL,4) * ZRSVT(JL,:)/ZRRT(JL)
- ZZW4(JL,:) = MAX(MIN(ZZW4(JL,:),(ZRSVT(JL,:)/PTSTEP)),0.0)
- ZCRSVS(JL,:) = ZCRSVS(JL,:) - ZZW2(JL,:)
- ZRRSVS(JL,:) = ZRRSVS(JL,:) - ZZW4(JL,:)
- IF (OUSECHIC) THEN
- DO JLI = 1, SIZE(PSGRSVS,4)
- IF (TRIM(HICNAMES(JLI)) == 'IC_HNO3' .OR. TRIM(HICNAMES(JLI)) == 'IC_SULF' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_H2SO4' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_NH3' .OR. TRIM(HICNAMES(JLI)) == 'IC_HCL' &
- .OR. HICNAMES(JLI)(1:4) == 'IC_A' .OR. HICNAMES(JLI)(1:4) == 'IC_B' &
- .OR. NINDEXGI(JLI).EQ.0) THEN
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETNA * ( &
- ZZW2(JL,NINDEXWI(JLI)) + ZZW4(JL,NINDEXWI(JLI)) )
- ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_H2O2' .OR. TRIM(HICNAMES(JLI)) == 'IC_HO2' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_HONO' .OR. TRIM(HICNAMES(JLI)) == 'IC_HNO4'&
- .OR. TRIM(HICNAMES(JLI)) == 'IC_HCHO' .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA1'&
- .OR. TRIM(HICNAMES(JLI)) == 'IC_ORA2') THEN
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETHP * ( &
- ZZW2(JL,NINDEXWI(JLI)) + ZZW4(JL,NINDEXWI(JLI)) )
- ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + (1. - XRETHP) * ( &
- ZZW2(JL,NINDEXWI(JLI)) + ZZW4(JL,NINDEXWI(JLI)) )
- ELSE IF (TRIM(HICNAMES(JLI)) == 'IC_SO2' .OR. TRIM(HICNAMES(JLI)) == 'IC_OH' &
- .OR. TRIM(HICNAMES(JLI)) == 'IC_MO2' .OR. &
- TRIM(HICNAMES(JLI)) == 'IC_OP1') THEN
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETSU * ( &
- ZZW2(JL,NINDEXWI(JLI)) + ZZW4(JL,NINDEXWI(JLI)) )
- ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + (1. - XRETSU) * ( &
- ZZW2(JL,NINDEXWI(JLI)) + ZZW4(JL,NINDEXWI(JLI)) )
- ELSE
- ZSGRSVS(JL,JLI) = ZSGRSVS(JL,JLI) + XRETDF * ( &
- ZZW2(JL,NINDEXWI(JLI)) + ZZW4(JL,NINDEXWI(JLI)) )
- ZGRSVS(JL,NINDEXGI(JLI)) = ZGRSVS(JL,NINDEXGI(JLI)) + (1. - XRETDF) * ( &
- ZZW2(JL,NINDEXWI(JLI)) + ZZW4(JL,NINDEXWI(JLI)) )
- ENDIF
- ENDDO
- ELSE
- IF (.NOT.(OCH_RET_ICE)) THEN
- DO JLW = 1, SIZE(PRRSVS,4)
- IF (.NOT.(NINDEXWG(JLW).EQ.0)) THEN
- ZGRSVS(JL,NINDEXWG(JLW)) = ZGRSVS(JL,NINDEXWG(JLW)) + ZZW2(JL,JLW) &
- + ZZW4(JL,JLW)
- ENDIF
- ENDDO
- ENDIF
- ENDIF
- ENDIF
- ENDDO
-!
-!* 6.8 Melting of the graupel
-!
- IF (OUSECHIC) THEN
- ZZW(:) = 0.0
- ZZW3(:,:) = 0.0
- DO JL = 1,IMICRO
- IF ( (ZRGT(JL)>PRTMIN_AQ*1.e3/ZRHODREF(JL)) .AND. &
- (ZZRGS(JL)>0.0) .AND. (ZZT(JL)>XTT) ) THEN
- ZZW(JL) = ZRVT(JL)*ZPRES(JL)/((XMV/XMD)+ZRVT(JL)) ! Vapor pressure
- ZZW(JL) = ZKA(JL)*(XTT-ZZT(JL)) + &
- ( ZDV(JL)*(XLVTT + ( XCPV - XCL ) * ( ZZT(JL) - XTT )) &
- *(XESTT-ZZW(JL))/(XRV*ZZT(JL)) )
-! compute RGMLTR
- ZZW(JL) = MIN( ZZRGS(JL), MAX( 0.0,( -ZZW(JL) * &
- ( X0DEPG* ZLBDAG(JL)**XEX0DEPG + &
- X1DEPG*ZCJ(JL)*ZLBDAG(JL)**XEX1DEPG ) - &
- ( ZZW1(JL,1)+ZZW1(JL,4) ) * &
- ( ZRHODREF(JL)*XCL*(XTT-ZZT(JL))) ) / &
- ( ZRHODREF(JL)*XLMTT ) ) )
- ZZW3(JL,:) = ZZW(JL) * ZSGSVT(JL,:)/ZRGT(JL)
- ZZW3(JL,:) = MAX(MIN(ZZW3(JL,:),(ZSGSVT(JL,:)/PTSTEP)),0.0)
- ZSGRSVS(JL,:) = ZSGRSVS(JL,:) - ZZW3(JL,:) !graupel->rain
- DO JLI = 1, SIZE(PSGRSVS,4)
- ZRRSVS(JL,NINDEXWI(JLI)) = ZRRSVS(JL,NINDEXWI(JLI)) + ZZW3(JL,JLI)
- ENDDO
- ENDIF
- ENDDO
- ENDIF
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 7. UNPACK RESULTS AND DEALLOCATE ARRAYS
-! ------------------------------------
-
-
- DO JLC= 1, SIZE(PCRSVS,4)
- ZCW(:,:,:) = ZZCRSVS(:,:,:,JLC)
- ZZCRSVS(:,:,:,JLC) = UNPACK(ZCRSVS(:,JLC), MASK=GMICRO(:,:,:), FIELD=ZCW(:,:,:))
- PCRSVS(:,:,:,JLC) = ZZCRSVS(:,:,:,JLC) * PRHODJ(:,:,:)
- END DO
- DO JLR= 1, SIZE(PRRSVS,4)
- ZRW(:,:,:) = ZZRRSVS(:,:,:,JLR)
- ZZRRSVS(:,:,:,JLR) = UNPACK(ZRRSVS(:,JLR), MASK=GMICRO(:,:,:), FIELD=ZRW(:,:,:))
- PRRSVS(:,:,:,JLR) = ZZRRSVS(:,:,:,JLR) * PRHODJ(:,:,:)
- END DO
- IF (OUSECHIC) THEN
- DO JLI= 1, SIZE(PSGRSVS,4)
- ZSGW(:,:,:) = ZZSGRSVS(:,:,:,JLI)
- ZZSGRSVS(:,:,:,JLI) = UNPACK(ZSGRSVS(:,JLI), MASK=GMICRO(:,:,:), FIELD=ZSGW(:,:,:))
- PSGRSVS(:,:,:,JLI) = ZZSGRSVS(:,:,:,JLI) * PRHODJ(:,:,:)
- END DO
- DO JLG= 1, SIZE(PGRSVS,4)
- ZGW(:,:,:) = ZZGRSVS(:,:,:,JLG)
- ZZGRSVS(:,:,:,JLG) = UNPACK(ZGRSVS(:,JLG), MASK=GMICRO(:,:,:), FIELD=ZGW(:,:,:))
- PGRSVS(:,:,:,JLG) = ZZGRSVS(:,:,:,JLG) * PRHODJ(:,:,:)
- END DO
- DEALLOCATE(ZGRSVS)
- DEALLOCATE(ZSGRSVS)
- DEALLOCATE(ZSGSVT)
- DEALLOCATE(ZZW3)
- ELSE
- IF (.NOT.(OCH_RET_ICE)) THEN
- DO JLG= 1, SIZE(PGRSVS,4)
- ZGW(:,:,:) = ZZGRSVS(:,:,:,JLG)
- ZZGRSVS(:,:,:,JLG) = UNPACK(ZGRSVS(:,JLG), MASK=GMICRO(:,:,:), FIELD=ZGW(:,:,:))
- PGRSVS(:,:,:,JLG) = ZZGRSVS(:,:,:,JLG) * PRHODJ(:,:,:)
- END DO
- DEALLOCATE(ZGRSVS)
- ENDIF
- ENDIF
-
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(ZZT)
- DEALLOCATE(ZPRES)
- DEALLOCATE(ZKA)
- DEALLOCATE(ZDV)
- DEALLOCATE(ZCJ)
- DEALLOCATE(ZZW)
- DEALLOCATE(ZZW1)
- DEALLOCATE(ZZW2)
- DEALLOCATE(ZZW4)
- DEALLOCATE(ZZRCS)
- DEALLOCATE(ZZRRS)
- DEALLOCATE(ZZRIS)
- DEALLOCATE(ZZRSS)
- DEALLOCATE(ZZRGS)
- DEALLOCATE(ZCRSVS)
- DEALLOCATE(ZRRSVS)
- DEALLOCATE(ZRVT)
- DEALLOCATE(ZRCT)
- DEALLOCATE(ZRRT)
- DEALLOCATE(ZRIT)
- DEALLOCATE(ZRST)
- DEALLOCATE(ZRGT)
- DEALLOCATE(ZCIT)
- DEALLOCATE(ZCSVT)
- DEALLOCATE(ZRSVT)
- DEALLOCATE(ZLBDAR)
- DEALLOCATE(ZLBDAS)
- DEALLOCATE(ZLBDAG)
- DEALLOCATE(ZRDRYG)
-!
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE CH_AQUEOUS_TMICICE
diff --git a/src/mesonh/ext/ch_meteo_trans_kess.f90 b/src/mesonh/ext/ch_meteo_trans_kess.f90
deleted file mode 100644
index debd6ae61a8107d41da8ba5870e267cb73c5a0d1..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/ch_meteo_trans_kess.f90
+++ /dev/null
@@ -1,351 +0,0 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!! ###############################
- MODULE MODI_CH_METEO_TRANS_KESS
-!! ###############################
-!!
-!
-INTERFACE
-!!
-SUBROUTINE CH_METEO_TRANS_KESS(KL, PRHODJ, PRHODREF, PRTSM, PTHT, PABST, &
- KVECNPT, KVECMASK, TPM, KDAY, KMONTH, &
- KYEAR, PLAT, PLON, PLAT0, PLON0, OUSERV, &
- OUSERC, OUSERR, KLUOUT, HCLOUD, PTSTEP )
-!
-USE MODD_CH_M9_n, ONLY: METEOTRANSTYPE
-!
-IMPLICIT NONE
-REAL, INTENT(IN), OPTIONAL :: PTSTEP !timestep
-CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Cloud parameterization
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! air density
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRTSM ! moist variables at t or t-dt or water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PABST ! theta and pressure at t
-INTEGER, DIMENSION(:,:), INTENT(IN) :: KVECMASK
-!
-TYPE(METEOTRANSTYPE), DIMENSION(:), INTENT(INOUT) :: TPM
- ! meteo variable for CCS
-INTEGER, INTENT(IN) :: KYEAR ! Current Year
-INTEGER, INTENT(IN) :: KMONTH ! Current Month
-INTEGER, INTENT(IN) :: KDAY ! Current Day
-INTEGER, INTENT(IN) :: KLUOUT ! channel for output listing
-INTEGER, INTENT(IN) :: KL, KVECNPT
-REAL, DIMENSION(:,:), INTENT(IN) :: PLAT, PLON
-REAL, INTENT(IN) :: PLAT0, PLON0
-LOGICAL, INTENT(IN) :: OUSERV, OUSERC, OUSERR
-END SUBROUTINE CH_METEO_TRANS_KESS
-!!
-END INTERFACE
-!!
-END MODULE MODI_CH_METEO_TRANS_KESS
-!!
-!! ####################################################################
-SUBROUTINE CH_METEO_TRANS_KESS(KL, PRHODJ, PRHODREF, PRTSM, PTHT, PABST, &
- KVECNPT, KVECMASK, TPM, KDAY, KMONTH, &
- KYEAR, PLAT, PLON, PLAT0, PLON0, OUSERV, &
- OUSERC, OUSERR, KLUOUT, HCLOUD, PTSTEP )
-!! ####################################################################
-!!
-!!*** *CH_METEO_TRANS_KESS*
-!!
-!! PURPOSE
-!! -------
-! Transfer of meteorological data, such as temperature, pressure
-! and water vapor mixing ratio for one point into the variable TPM(JM+1)
-! here LWC, LWR and mean radius computed from Kessler or ICEx schemes
-!!
-!! METHOD
-!! ------
-!! For the given grid-point KI,KJ,KK, the meteorological parameters
-!! will be transfered for use by CH_SET_RATES and CH_SET_PHOTO_RATES.
-!! Presently, the variables altitude, air density, temperature,
-!! water vapor mixing ratio, cloud water, longitude, latitude and date
-!! will be transfered. In the chemical definition file (.chf)
-!! these variables have to be transfered into variables like O2, H2O etc.
-!! Also, consistency is checked between the number of
-!! variables expected by the CCS (as defined in the .chf file) and
-!! the number of variables to be transfered here. If you change
-!! the meaning of XMETEOVARS in your .chf file, make sure to modify
-!! this subroutine accordingly.
-!! If the model is run in 1D mode, the model level instead of altitude
-!! is passed. In 2D and 3D, altitude is passed with a negative sign
-!! so that the radiation scheme TUV can make the difference between
-!! model levels and altitude.
-!!
-!! AUTHOR
-!! ------
-!! K. Suhre *Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 24/05/95
-!! 04/08/96 (K. Suhre) restructured
-!! 21/02/97 (K. Suhre) add XLAT0 and XLON0 for LCARTESIAN=T case
-!! 27/08/98 (P. Tulet) add temperature at t for kinetic coefficient
-!! 09/03/99 (V. Crassier & K. Suhre) vectorization
-!! 09/03/99 (K. Suhre) modification for TUV
-!! 09/03/99 (C. Mari & J. Escobar) Code optimization
-!! 01/12/03 (D. Gazen) change Chemical scheme interface
-!! 01/12/03 (D. Gazen) change Chemical scheme interface
-!! 01/12/04 (P. Tulet) update ch_meteo_transn.f90 for Arome
-!! 01/12/07 (M. Leriche) include rain
-!! 14/05/08 (M. Leriche) include raindrops and cloud droplets mean radius
-!! 05/06/08 (M. Leriche) calculate LWC and LWR in coherence with time spliting scheme
-!! 05/11/08 (M. Leriche) split in two routines for 1-moment and 2-moment cloud schemes
-! 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
-!!
-!! EXTERNAL
-!! --------
-!! GAMMA : gamma function
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-USE MODD_CH_M9_n, ONLY: NMETEOVARS, & ! number of meteorological variables
- METEOTRANSTYPE !type for meteo . transfer
-!!
-USE MODD_CST, ONLY: XP00, & ! Surface pressure
- XRD, & ! R gas constant
- XCPD, & !specific heat for dry air
- XPI, & !pie
- XRHOLW !density of water
-!!
-USE MODD_CONF, ONLY: LCARTESIAN ! Logical for cartesian geometry
-!!
-USE MODD_RAIN_ICE_DESCR_n, ONLY: XNUC, XALPHAC, & !Cloud droplets distrib. param.
- XRTMIN, & ! min values of the water m. r.
- XLBC, XLBEXC, & !shape param. of the cloud droplets
- XLBR, XLBEXR, & !shape param. of the raindrops
- XCONC_LAND
-!!
-use mode_msg
-
-USE MODI_GAMMA
-!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-REAL, INTENT(IN), OPTIONAL :: PTSTEP ! Double timestep
-CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Cloud parameterization
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! air density
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRTSM ! moist variables at t or t-dt or water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PABST ! theta and pressure at t
-INTEGER, DIMENSION(:,:), INTENT(IN) :: KVECMASK
-!
-TYPE(METEOTRANSTYPE), DIMENSION(:), INTENT(INOUT) :: TPM
- ! meteo variable for CCS
-INTEGER, INTENT(IN) :: KYEAR ! Current Year
-INTEGER, INTENT(IN) :: KMONTH ! Current Month
-INTEGER, INTENT(IN) :: KDAY ! Current Day
-INTEGER, INTENT(IN) :: KLUOUT ! channel for output listing
-INTEGER, INTENT(IN) :: KL, KVECNPT
-REAL, DIMENSION(:,:), INTENT(IN) :: PLAT, PLON
-REAL, INTENT(IN) :: PLAT0, PLON0
-LOGICAL, INTENT(IN) :: OUSERV, OUSERC, OUSERR
-!
-!* 0.2 declarations of local variables
-!
-REAL,DIMENSION(SIZE(PRTSM,1),SIZE(PRTSM,2),SIZE(PRTSM,3),3) :: ZRTSM
-REAL,DIMENSION(SIZE(PRTSM,1),SIZE(PRTSM,2)) :: ZLAT, ZLON
-REAL,DIMENSION(SIZE(PRTSM,1),SIZE(PRTSM,2),SIZE(PRTSM,3)) :: ZRAYC, ZWLBDC, &
- ZWLBDC3, ZCONC
-REAL,DIMENSION(SIZE(PRTSM,1),SIZE(PRTSM,2),SIZE(PRTSM,3)) :: ZRAYR, ZWLBDR, ZWLBDR3
-LOGICAL, SAVE :: GSFIRSTCALL = .TRUE.
-INTEGER :: JI,JJ,JK,JM
-INTEGER :: IDTI,IDTJ,IDTK
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. INITIALIZE METEO VARIABLE TRANSFER
-! ----------------------------------
-!
-firstcall : IF (GSFIRSTCALL) THEN
-!
- GSFIRSTCALL = .FALSE.
-!
-!* 1.1 check if number of variables NMETEOVARS
-! corresponds to what the CCS expects
-!
- IF (NMETEOVARS /= 13) THEN
- WRITE(KLUOUT,*) "CH_METEO_TRANS ERROR: number of meteovars to transfer"
- WRITE(KLUOUT,*) "does not correspond to the number expected by the CCS:"
- WRITE(KLUOUT,*) " meteovars to transfer: ", 13
- WRITE(KLUOUT,*) " NMETEOVARS expected: ", NMETEOVARS
- WRITE(KLUOUT,*) "Check the definition of NMETEOVARS in your .chf file."
- WRITE(KLUOUT,*) "The program will be stopped now!"
- call Print_msg( NVERB_FATAL, 'GEN', 'CH_METEO_TRANS_KESS', &
- 'number of meteovars to transfer does not correspond to the expected number.' )
- END IF
-!
-!* 1.2 initialize names of meteo vars
-!
- TPM(:)%CMETEOVAR(1) = "Model level"
- TPM(:)%CMETEOVAR(2) = "Air density (kg/m3)"
- TPM(:)%CMETEOVAR(3) = "Temperature (K)"
- TPM(:)%CMETEOVAR(4) = "Water vapor (kg/kg)"
- TPM(:)%CMETEOVAR(5) = "Cloud water (kg/kg)"
- TPM(:)%CMETEOVAR(6) = "Latitude (rad)"
- TPM(:)%CMETEOVAR(7) = "Longitude (rad)"
- TPM(:)%CMETEOVAR(8) = "Current date (year)"
- TPM(:)%CMETEOVAR(9) = "Current date (month)"
- TPM(:)%CMETEOVAR(10)= "Current date (day)"
- TPM(:)%CMETEOVAR(11)= "Rain water (kg/kg)"
- TPM(:)%CMETEOVAR(12)= "Mean cloud droplets radius (m)"
- TPM(:)%CMETEOVAR(13)= "Mean raindrops radius (m)"
-!
-ENDIF firstcall
-!
-! "Water vapor (kg/kg)"
-!
-IF (OUSERV) THEN
-! if split option, use tendency
- IF (PRESENT(PTSTEP)) THEN
- ZRTSM(:,:,:,1) = (PRTSM(:,:,:, 1)/ PRHODJ(:,:,:))*PTSTEP
- ELSE
- ZRTSM(:,:,:,1) = PRTSM(:,:,:, 1)
- ENDIF
-ELSE
- ZRTSM(:,:,:,1) = 0.0
-ENDIF
-!
-! "Cloud water (kg/kg)" and "Mean cloud droplets radius (m)"
-!
-IF (OUSERC) THEN
- IF (PRESENT(PTSTEP)) THEN
- ZRTSM(:,:,:,2) = (PRTSM(:,:,:, 2)/ PRHODJ(:,:,:))*PTSTEP
- ELSE
- ZRTSM(:,:,:,2) = PRTSM(:,:,:, 2)
- ENDIF
- ZRAYC(:,:,:) = 10.e-6 ! avoid division by zero
- SELECT CASE (HCLOUD)
- CASE ('KESS')
- WHERE (ZRTSM(:,:,:, 2)>1.e-20) !default value for Kessler
- ZRAYC(:,:,:) = 10.e-6 ! assume a cloud droplet radius of 10 µm
- ENDWHERE
- CASE ('ICE3','ICE4')
- WHERE (ZRTSM(:,:,:, 2)>XRTMIN(2))
- ZCONC(:,:,:) = XCONC_LAND
- ZWLBDC3(:,:,:) = XLBC(1) * ZCONC(:,:,:) / (PRHODREF(:,:,:) * ZRTSM(:,:,:, 2))
- ZWLBDC(:,:,:) = ZWLBDC3(:,:,:)**XLBEXC
- ZRAYC(:,:,:) = 0.5*GAMMA(XNUC+1./XALPHAC)/(GAMMA(XNUC)*ZWLBDC(:,:,:))
-! ZRAYC(:,:,:) = 10.e-6 ! assume a cloud droplet radius of 10 µm
- ENDWHERE
- END SELECT
-ELSE
- ZRTSM(:,:,:,2) = 0.0
- ZRAYC(:,:,:) = 10.e-6 ! avoid division by zero
-ENDIF
-!
-! "Rain water (kg/kg)" and "Mean raindrops radius (m)"
-!
-IF (OUSERR) THEN
- IF (PRESENT(PTSTEP)) THEN
- ZRTSM(:,:,:,3) = (PRTSM(:,:,:, 3)/ PRHODJ(:,:,:))*PTSTEP
- ELSE
- ZRTSM(:,:,:,3) = PRTSM(:,:,:, 3)
- ENDIF
- ZRAYR(:,:,:) = 500.e-6 ! avoid division by zero
- SELECT CASE (HCLOUD)
- CASE ('KESS')
- WHERE (ZRTSM(:,:,:, 3)>1.e-20) !default value for Kessler
- ZRAYR(:,:,:) = 0.5*((XPI*XRHOLW*1.E7)/ &
- (PRHODREF(:,:,:)*ZRTSM(:,:,:,3)))**(-1./4.)
- ENDWHERE
- CASE ('ICE3','ICE4')
- WHERE (ZRTSM(:,:,:, 3)>XRTMIN(3))
- ZRAYR(:,:,:) = 0.5*(1./(XLBR*(PRHODREF(:,:,:)*ZRTSM(:,:,:,3))**XLBEXR))
- ENDWHERE
- END SELECT
-ELSE
- ZRTSM(:,:,:,3) = 0.0
- ZRAYR(:,:,:) = 500.e-6 ! avoid division by zero
-ENDIF
-
-IF(LCARTESIAN) THEN
-! "Latitude (rad)"
- ZLAT(:,:) = PLAT0
-! "Longitude (rad)"
- ZLON(:,:) = PLON0
-ELSE
-! "Latitude (rad)"
- ZLAT(:,:) = PLAT(:,:)
-! "Longitude (rad)"
- ZLON(:,:) = PLON(:,:)
-END IF
-!!
-!* 2. TRANSFER METEO VARIABLES
-! ------------------------
-!
-IDTI=KVECMASK(2,KL)-KVECMASK(1,KL)+1
-IDTJ=KVECMASK(4,KL)-KVECMASK(3,KL)+1
-IDTK=KVECMASK(6,KL)-KVECMASK(5,KL)+1
-!Vectorization:
-!ocl novrec
-!cdir nodep
-DO JM=0,KVECNPT-1
- JI=JM-IDTI*(JM/IDTI)+KVECMASK(1,KL)
- JJ=JM/IDTI-IDTJ*(JM/(IDTI*IDTJ))+KVECMASK(3,KL)
- JK=JM/(IDTI*IDTJ)-IDTK*(JM/(IDTI*IDTJ*IDTK))+KVECMASK(5,KL)
-!
-!"Model Altitude"
-!
- TPM(JM+1)%XMETEOVAR(1) = JK-1 ! assuming first model level is level 2
-! TPM(JM+1)%XMETEOVAR(1) = JK ! assuming first model level is level 1
-!
-! "Air density (kg/m3)"
-!
- TPM(JM+1)%XMETEOVAR(2) = PRHODREF(JI, JJ, JK)
-!
-! "Temperature (K)"
-!
- TPM(JM+1)%XMETEOVAR(3) = PTHT(JI,JJ,JK)*((PABST(JI,JJ,JK)/XP00)**(XRD/XCPD))
-!
-! "Water vapor (kg/kg)"
-!
- TPM(JM+1)%XMETEOVAR(4) = ZRTSM(JI, JJ, JK, 1)
-!
-! "Cloud water (kg/kg)"
-!
- TPM(JM+1)%XMETEOVAR(5) = ZRTSM(JI, JJ, JK, 2)
-!
-! "Latitude (rad)"
-!
- TPM(JM+1)%XMETEOVAR(6) = ZLAT(JI, JJ)
-!
-! "Longitude (rad)"
-!
- TPM(JM+1)%XMETEOVAR(7) = ZLON(JI, JJ)
-!
-! "Current date"
-!
- TPM(JM+1)%XMETEOVAR(8) = REAL(KYEAR)
- TPM(JM+1)%XMETEOVAR(9) = REAL(KMONTH)
- TPM(JM+1)%XMETEOVAR(10)= REAL(KDAY)
-!
-! "Rain water (kg/kg)"
-!
- TPM(JM+1)%XMETEOVAR(11) = ZRTSM(JI, JJ, JK, 3)
-!
-! "Mean cloud droplets radius (m)"
-!
- TPM(JM+1)%XMETEOVAR(12) = ZRAYC(JI, JJ, JK)
-!
-! "Mean raindrops radius (m)"
-!
- TPM(JM+1)%XMETEOVAR(13) = ZRAYR(JI, JJ, JK)
-!
-ENDDO
-!
-END SUBROUTINE CH_METEO_TRANS_KESS
diff --git a/src/mesonh/ext/cphase_profile.f90 b/src/mesonh/ext/cphase_profile.f90
deleted file mode 100644
index f403e5447f35bf807c2a92cf68c92885ae3d71d8..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/cphase_profile.f90
+++ /dev/null
@@ -1,140 +0,0 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!#########################
-MODULE MODI_CPHASE_PROFILE
-!#########################
-!
-INTERFACE
-!
- SUBROUTINE CPHASE_PROFILE (PZHAT,PCPHASE,PCPHASE_PBL,PCPHASE_PROFILE,PTKEM)
-!
-REAL, DIMENSION(:) , INTENT(IN) :: PZHAT ! height level without orography
-REAL , INTENT(IN) :: PCPHASE ! prescribed phase velocity
-REAL , INTENT(IN) :: PCPHASE_PBL ! prescribed phase velocity
-REAL, DIMENSION(:,:) , INTENT(OUT) :: PCPHASE_PROFILE ! profile of Cphase speed
-REAL, DIMENSION(:,:),OPTIONAL , INTENT(IN) :: PTKEM ! TKE at t-dt
-!
-END SUBROUTINE CPHASE_PROFILE
-!
-END INTERFACE
-!
-END MODULE MODI_CPHASE_PROFILE
-!
-! ##########################################################################
- SUBROUTINE CPHASE_PROFILE (PZHAT,PCPHASE,PCPHASE_PBL,PCPHASE_PROFILE,PTKEM)
-! ##########################################################################
-!
-!!**** *CPHASE_PROFILE* - defines a non-constant vertical profile for Cphase
-!! velocity
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson & C. Lac * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 08/2010
-!! Escobar 9/11/2010 : array bound problem if NO Turb => PTKEM optional
-!! C.Lac 06/2013 : correction and introduction of PCPHASE_PBL
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_TURB_n, ONLY: XTKEMIN
-USE MODD_PARAMETERS
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-REAL, DIMENSION(:) , INTENT(IN) :: PZHAT ! height level without orography
-REAL , INTENT(IN) :: PCPHASE ! prescribed phase velocity
-REAL , INTENT(IN) :: PCPHASE_PBL ! prescribed phase velocity
-REAL, DIMENSION(:,:) , INTENT(OUT) :: PCPHASE_PROFILE ! profile of Cphase speed
-REAL, DIMENSION(:,:),OPTIONAL , INTENT(IN) :: PTKEM ! TKE at t-dt
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: IKB ! indice K Beginning in z direction
-INTEGER :: IKE ! indice K End in z direction
-!
-REAL, DIMENSION(SIZE(PCPHASE_PROFILE,1)) :: ZTKE, ZTKEMIN
-INTEGER :: JL,JK,JKTKE
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. PROLOGUE
-! --------
-!
-!* 1.1 Compute dimensions of arrays and other indices
-!
-IKB = 1 + JPVEXT
-IKE = SIZE(PCPHASE_PROFILE,2) - JPVEXT
-!
-!
-!* 1.2 Initializations
-!
-!
-PCPHASE_PROFILE = 0.0
-ZTKEMIN = PZHAT(IKE)
-ZTKE = PZHAT(IKE-1)
-!-------------------------------------------------------------------------------
-!-------------------------------------------------------------------------------
-!
- IF (PRESENT(PTKEM)) THEN
-!
- DO JL = 1,SIZE(PCPHASE_PROFILE,1)
- JKTKE=IKE-1
- DO JK = IKB, IKE-1
- IF (PTKEM(JL,JK) < 5.*XTKEMIN ) THEN
- ZTKE (JL) = PZHAT (JK)
- JKTKE = JK
- EXIT
- END IF
- END DO
- DO JK = JKTKE+1,IKE
- IF (PTKEM(JL,JK) == XTKEMIN ) THEN
- ZTKEMIN (JL) = PZHAT (JK)
- EXIT
- END IF
- END DO
- END DO
-!
- ELSE
- ZTKE (:) = 1000.
- ZTKEMIN (:) = 2000.
- END IF
-!
- DO JL = 1,SIZE(PCPHASE_PROFILE,1)
- DO JK = IKB, IKE
- IF (PZHAT(JK) > ZTKEMIN (JL) ) THEN
- PCPHASE_PROFILE(JL,JK) = PCPHASE
- ELSE IF (PZHAT(JK) < ZTKE (JL) ) THEN
- PCPHASE_PROFILE(JL,JK) = PCPHASE_PBL
- ELSE
- PCPHASE_PROFILE(JL,JK) = 1./(ZTKEMIN (JL) - ZTKE (JL)) * &
- ((PZHAT(JK) - ZTKE(JL)) * PCPHASE + (ZTKEMIN (JL) - PZHAT(JK)) * PCPHASE_PBL )
- END IF
- END DO
- END DO
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE CPHASE_PROFILE
diff --git a/src/mesonh/ext/deallocate_model1.f90 b/src/mesonh/ext/deallocate_model1.f90
deleted file mode 100644
index 8b8f572144596c81b071b80cc4352ff347790191..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/deallocate_model1.f90
+++ /dev/null
@@ -1,705 +0,0 @@
-!MNH_LIC Copyright 1997-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_DEALLOCATE_MODEL1
-!############################
-!
-INTERFACE
-!
-SUBROUTINE DEALLOCATE_MODEL1 (KCALL)
-!
-INTEGER, INTENT(IN) :: KCALL
-!
-END SUBROUTINE DEALLOCATE_MODEL1
-!
-END INTERFACE
-!
-END MODULE MODI_DEALLOCATE_MODEL1
-!
-!
-! ####################################
- SUBROUTINE DEALLOCATE_MODEL1 (KCALL)
-! ####################################
-!
-!!**** *DEALLOCATE_MODEL1* - deallocate all model1 fields
-!!
-!! PURPOSE
-!! -------
-! deallocate all model #1 fields in order to spare memory in spawning
-!
-!!** METHOD
-!! ------
-!!
-!! KCALL = 1 --> deallocates all SOURCES, LES, FORCING and SOLVER variables
-!!
-!! KCALL = 2 --> deallocates all METRIC, RADIATION and CORIOLIS variables
-!!
-!! KCALL = 3 --> deallocates all other variables of model1
-!!
-!! KCALL = 4 --> deallocates all variables common to ALL models
-!!
-!! 1 + 2 --> all variables used in spawning
-!! 1 + 2 + 3 + 4 --> in diag after a file has been treated
-!!
-!! EXTERNAL
-!! --------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 08/12/97
-!!
-!! 20/05/98 use the LB fields
-!! 15/03/99 new PGD fields
-!! 08/03/01 D.Gazen add chemical emission field
-!! 01/2004 V. Masson surface externalization
-!! 06/2012 M.Tomasini add 2D nesting ADVFRC
-!! 10/2016 M.Mazoyer New KHKO output fields
-! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
-! C. Lac 02/2019: add rain fraction as an output field
-! P. Wautelet 07/06/2019: bugfix: deallocate XLSRVM only if allocated
-! S. Riette 04/2020: XHL* fields
-! A. Costes 12:2021: Blaze Fire model variables
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-USE MODD_REF
-!
-USE MODD_METRICS_n
-USE MODD_FIELD_n
-USE MODD_FIRE_n
-USE MODD_DUMMY_GR_FIELD_n
-USE MODD_LSFIELD_n
-USE MODD_GRID_n
-USE MODD_REF_n
-USE MODD_CURVCOR_n
-USE MODD_DYN_n
-USE MODD_DEEP_CONVECTION_n
-USE MODD_RADIATIONS_n
-USE MODD_FRC
-USE MODD_PRECIP_n
-USE MODD_ELEC_n
-USE MODD_PASPOL_n
-USE MODD_RAIN_ICE_PARAM_n
-USE MODD_RAIN_ICE_DESCR_n
-USE MODD_PARAM_n , ONLY : CCLOUD
-USE MODE_MODELN_HANDLER
-!
-! Modif 2D
-USE MODD_LATZ_EDFLX ! For ADVFRC and EDDY FLUXES
-USE MODD_DEF_EDDY_FLUX_n ! For EDDY FLUXES
-USE MODD_DEF_EDDYUV_FLUX_n ! For EDDY FLUXES
-!
-USE MODD_2D_FRC
-USE MODD_ADVFRC_n ! For ADVFRC and EDDY FLUXES
-USE MODD_RELFRC_n
-USE MODD_ADV_n
-USE MODD_PAST_FIELD_n
-USE MODD_TURB_n
-USE MODD_PARAM_C2R2, ONLY :LSUPSAT
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-INTEGER, INTENT(IN) :: KCALL ! number of times this routine has been called
-INTEGER :: IMI ! Current Model index
-!
-!* 0.2 declarations of local variables
-!
-!-------------------------------------------------------------------------------
-!
-! Save current Model index and switch to model 1 variables
-IMI = GET_CURRENT_MODEL_INDEX()
-CALL GOTO_MODEL(1)
-!* 1. Module MODD_FIELD$n
-!
-IF ( KCALL==3 ) THEN
- IF (CUVW_ADV_SCHEME(1:3)=='CEN'.AND. CTEMP_SCHEME=='LEFR') THEN
- DEALLOCATE(XUM)
- DEALLOCATE(XVM)
- DEALLOCATE(XWM)
- DEALLOCATE(XDUM)
- DEALLOCATE(XDVM)
- DEALLOCATE(XDWM)
- END IF
- DEALLOCATE(XUT)
- DEALLOCATE(XVT)
- DEALLOCATE(XWT)
- DEALLOCATE(XTHT)
- IF (L2D_ADV_FRC) THEN
- IF (ASSOCIATED(XDTHFRC)) DEALLOCATE(XDTHFRC)
- IF (ASSOCIATED(XDRVFRC)) DEALLOCATE(XDRVFRC)
- IF (ASSOCIATED(TDTADVFRC)) DEALLOCATE(TDTADVFRC)
- END IF
- IF (L2D_REL_FRC) THEN
- IF (ASSOCIATED(XTHREL)) DEALLOCATE(XTHREL)
- IF (ASSOCIATED(XRVREL)) DEALLOCATE(XRVREL)
- IF (ASSOCIATED(TDTRELFRC)) DEALLOCATE(TDTRELFRC)
- END IF
- ! DEALLOCATE EDDY FLUXES
- IF (LTH_FLX) THEN
- DEALLOCATE(XVTH_FLUX_M)
- DEALLOCATE(XWTH_FLUX_M)
- END IF
- IF (LUV_FLX) THEN
- DEALLOCATE(XVU_FLUX_M)
- END IF
-END IF
-IF ( KCALL==1 ) THEN
- DEALLOCATE(XRUS)
- DEALLOCATE(XRVS)
- DEALLOCATE(XRWS)
- DEALLOCATE(XRTHS)
- DEALLOCATE(XRUS_PRES, XRVS_PRES, XRWS_PRES )
- DEALLOCATE(XRTHS_CLD )
-END IF
-!
-IF ( KCALL==3 ) THEN
- IF (ASSOCIATED(XTKET)) DEALLOCATE(XTKET)
-END IF
-IF ( ASSOCIATED(XRTKES) .AND. KCALL==1 ) THEN
- DEALLOCATE(XRTKES)
-END IF
-!
-IF ( KCALL==3 ) THEN
- DEALLOCATE(XPABST)
-!
- DEALLOCATE(XRT)
-END IF
-!
-IF ( KCALL==1 ) THEN
- DEALLOCATE(XRRS)
- DEALLOCATE(XRRS_CLD)
-END IF
-!
-IF ( ASSOCIATED(XSRCT) .AND. KCALL==3 ) THEN
- DEALLOCATE(XSRCT)
- DEALLOCATE(XSIGS)
-END IF
-!
-IF ( ASSOCIATED(XHLC_HRC) .AND. KCALL==3 ) THEN
- DEALLOCATE(XHLC_HRC)
- DEALLOCATE(XHLC_HCF)
- DEALLOCATE(XHLI_HRI)
- DEALLOCATE(XHLI_HCF)
-END IF
-!
-IF ( ASSOCIATED(XCLDFR) .AND. KCALL==2 ) THEN
- DEALLOCATE(XCLDFR)
-END IF
-!
-IF ( ASSOCIATED(XICEFR) .AND. KCALL==2 ) THEN
- DEALLOCATE(XICEFR)
-END IF
-!
-IF ( ASSOCIATED(XRAINFR) .AND. KCALL==2 ) THEN
- DEALLOCATE(XRAINFR)
-END IF
-!
-IF ( KCALL == 3 ) THEN
- DEALLOCATE(XSVT)
-END IF
-IF ( KCALL == 1 ) THEN
- DEALLOCATE(XRSVS)
- DEALLOCATE(XRSVS_CLD)
-END IF
-!
-IF ((CCLOUD == 'KHKO') .AND. LSUPSAT) THEN
- DEALLOCATE(XSUPSAT)
- DEALLOCATE(XNACT)
- DEALLOCATE(XNPRO)
- DEALLOCATE(XSSPRO)
-END IF
-!
-IF (ASSOCIATED(XDUMMY_GR_FIELDS) .AND. KCALL==3 ) THEN
- DEALLOCATE(XDUMMY_GR_FIELDS)
-END IF
-
-IF (ASSOCIATED(XLSPHI)) THEN
- DEALLOCATE(XLSPHI)
-END IF
-
-IF (ASSOCIATED(XBMAP)) THEN
- DEALLOCATE(XBMAP)
-END IF
-
-IF (ASSOCIATED(XFMRFA)) THEN
- DEALLOCATE(XFMRFA)
-END IF
-
-IF (ASSOCIATED(XFMWF0)) THEN
- DEALLOCATE(XFMWF0)
-END IF
-
-IF (ASSOCIATED(XFMR0)) THEN
- DEALLOCATE(XFMR0)
-END IF
-
-IF (ASSOCIATED(XFMR00)) THEN
- DEALLOCATE(XFMR00)
-END IF
-
-IF (ASSOCIATED(XFMIGNITION)) THEN
- DEALLOCATE(XFMIGNITION)
-END IF
-
-IF (ASSOCIATED(XFMFUELTYPE)) THEN
- DEALLOCATE(XFMFUELTYPE)
-END IF
-
-IF (ASSOCIATED(XFIRETAU)) THEN
- DEALLOCATE(XFIRETAU)
-END IF
-
-IF (ASSOCIATED(XFLUXPARAMH)) THEN
- DEALLOCATE(XFLUXPARAMH)
-END IF
-
-IF (ASSOCIATED(XFLUXPARAMW)) THEN
- DEALLOCATE(XFLUXPARAMW)
-END IF
-
-IF (ASSOCIATED(XFIRERW)) THEN
- DEALLOCATE(XFIRERW)
-END IF
-
-IF (ASSOCIATED(XFMASE)) THEN
- DEALLOCATE(XFMASE)
-END IF
-
-IF (ASSOCIATED(XFMAWC)) THEN
- DEALLOCATE(XFMAWC)
-END IF
-
-IF (ASSOCIATED(XFMWALKIG)) THEN
- DEALLOCATE(XFMWALKIG)
-END IF
-
-IF (ASSOCIATED(XFMFLUXHDH)) THEN
- DEALLOCATE(XFMFLUXHDH)
-END IF
-
-IF (ASSOCIATED(XFMFLUXHDW)) THEN
- DEALLOCATE(XFMFLUXHDW)
-END IF
-
-IF (ASSOCIATED(XFMHWS)) THEN
- DEALLOCATE(XFMHWS)
-END IF
-
-IF (ASSOCIATED(XFMWINDU)) THEN
- DEALLOCATE(XFMWINDU)
-END IF
-
-IF (ASSOCIATED(XFMWINDV)) THEN
- DEALLOCATE(XFMWINDV)
-END IF
-
-IF (ASSOCIATED(XFMWINDW)) THEN
- DEALLOCATE(XFMWINDW)
-END IF
-
-IF (ASSOCIATED(XFMGRADOROX)) THEN
- DEALLOCATE(XFMGRADOROX)
-END IF
-
-IF (ASSOCIATED(XFMGRADOROY)) THEN
- DEALLOCATE(XFMGRADOROY)
-END IF
-
-IF (ASSOCIATED(XGRADLSPHIX)) THEN
- DEALLOCATE(XGRADLSPHIX)
-END IF
-
-IF (ASSOCIATED(XGRADLSPHIY)) THEN
- DEALLOCATE(XGRADLSPHIY)
-END IF
-
-IF (ASSOCIATED(XFIREWIND)) THEN
- DEALLOCATE(XFIREWIND)
-END IF
-
-IF (ASSOCIATED(XLSPHI2D)) THEN
- DEALLOCATE(XLSPHI2D)
-END IF
-
-IF (ASSOCIATED(XGRADLSPHIX2D)) THEN
- DEALLOCATE(XGRADLSPHIX2D)
-END IF
-
-IF (ASSOCIATED(XGRADLSPHIY2D)) THEN
- DEALLOCATE(XGRADLSPHIY2D)
-END IF
-
-IF (ASSOCIATED(XGRADMASKX)) THEN
- DEALLOCATE(XGRADMASKX)
-END IF
-
-IF (ASSOCIATED(XGRADMASKY)) THEN
- DEALLOCATE(XGRADMASKY)
-END IF
-
-IF (ASSOCIATED(XSURFRATIO2D)) THEN
- DEALLOCATE(XSURFRATIO2D)
-END IF
-
-IF (ASSOCIATED(XLSDIFFUX2D)) THEN
- DEALLOCATE(XLSDIFFUX2D)
-END IF
-
-IF (ASSOCIATED(XLSDIFFUY2D)) THEN
- DEALLOCATE(XLSDIFFUY2D)
-END IF
-
-IF (ASSOCIATED(XFIRERW2D)) THEN
- DEALLOCATE(XFIRERW2D)
-END IF
-!
-!* 3. Module MODD_GRID$n
-!
-IF ( ASSOCIATED(XLON) .AND. KCALL == 3 ) THEN
- DEALLOCATE(XLON)
- DEALLOCATE(XLAT)
- DEALLOCATE(XMAP)
-END IF
-!
-IF ( KCALL == 3 ) THEN
- !Philippe W.: do not deallocate XXHAT, XYHAT and XZHAT because they are needed later on
- !As they are 1D, their memory footprint is negligible
- ! DEALLOCATE(XXHAT)
- DEALLOCATE(XDXHAT)
- ! DEALLOCATE(XYHAT)
- DEALLOCATE(XDYHAT)
- DEALLOCATE(XZS)
- DEALLOCATE(XZSMT)
- DEALLOCATE(XZZ)
- ! DEALLOCATE(XZHAT)
-END IF
-!
-IF ( KCALL == 2 ) THEN
- DEALLOCATE(XDIRCOSZW)
- DEALLOCATE(XDIRCOSXW)
- DEALLOCATE(XDIRCOSYW)
- DEALLOCATE(XCOSSLOPE)
- DEALLOCATE(XSINSLOPE)
-END IF
-
-IF ( KCALL == 2 ) THEN
- DEALLOCATE(XDXX)
- DEALLOCATE(XDYY)
- DEALLOCATE(XDZX)
- DEALLOCATE(XDZY)
- DEALLOCATE(XDZZ)
-END IF
-!
-!* 4. Modules MODD_REF and MODD_REF$n
-!
-IF ( KCALL == 4 ) THEN
- DEALLOCATE(XRHODREFZ)
- DEALLOCATE(XTHVREFZ)
-END IF
-!
-IF ( KCALL == 3 ) THEN
- DEALLOCATE(XRHODREF)
- DEALLOCATE(XTHVREF)
- DEALLOCATE(XEXNREF)
- DEALLOCATE(XRHODJ)
- IF ( ASSOCIATED(XRVREF) ) THEN
- DEALLOCATE(XRVREF)
- END IF
-END IF
-!
-!* 5. Module MODD_CURVCOR$n
-!
-IF ( ASSOCIATED(XCORIOX) .AND. KCALL == 2 ) THEN
- DEALLOCATE(XCORIOX)
- DEALLOCATE(XCORIOY)
-END IF
-IF ( KCALL == 2 ) THEN
- DEALLOCATE(XCORIOZ)
-END IF
-IF ( ASSOCIATED(XCURVX) .AND. KCALL == 2) THEN
- DEALLOCATE(XCURVX)
- DEALLOCATE(XCURVY)
-END IF
-!
-!* 6. Module MODD_DYN$n
-!
-IF ( KCALL == 1 ) THEN
- DEALLOCATE(XBFY)
- DEALLOCATE(XAF,XCF)
- DEALLOCATE(XTRIGSX)
- DEALLOCATE(XTRIGSY)
- DEALLOCATE(XRHOM)
- DEALLOCATE(XALK)
- DEALLOCATE(XALKW)
- DEALLOCATE(XALKBAS)
- DEALLOCATE(XALKWBAS)
- IF ( ASSOCIATED(XKURELAX) ) THEN
- DEALLOCATE(XKURELAX)
- DEALLOCATE(XKVRELAX)
- DEALLOCATE(XKWRELAX)
- DEALLOCATE(LMASK_RELAX)
- END IF
-END IF
-!
-!* 7. Larger Scale variables (Module MODD_LSFIELD$n)
-!
-IF ( KCALL == 3 ) THEN
- DEALLOCATE(XLSUM)
- DEALLOCATE(XLSVM)
- DEALLOCATE(XLSWM)
- DEALLOCATE(XLSTHM)
- IF(ASSOCIATED(XLSRVM)) DEALLOCATE(XLSRVM)
- IF (ASSOCIATED(XLBXUM)) THEN
- DEALLOCATE(XLBXUM)
- DEALLOCATE(XLBYUM)
- DEALLOCATE(XLBXVM)
- DEALLOCATE(XLBYVM)
- DEALLOCATE(XLBXWM)
- DEALLOCATE(XLBYWM)
- DEALLOCATE(XLBXTHM)
- DEALLOCATE(XLBYTHM)
- END IF
- IF (ASSOCIATED(XLBXTKEM)) THEN
- DEALLOCATE(XLBXTKEM)
- DEALLOCATE(XLBYTKEM)
- END IF
- IF (ASSOCIATED(XLBXRM)) THEN
- DEALLOCATE(XLBXRM)
- DEALLOCATE(XLBYRM)
- END IF
- IF (ASSOCIATED(XLBXSVM)) THEN
- DEALLOCATE(XLBXSVM)
- DEALLOCATE(XLBYSVM)
- END IF
-END IF
-!
- ! steady LS fields only for model 1 or independent models
-!
-IF( ASSOCIATED(XLSUS) .AND. KCALL == 3 ) THEN
- DEALLOCATE(XLSUS)
- DEALLOCATE(XLSVS)
- DEALLOCATE(XLSWS)
- DEALLOCATE(XLSTHS)
- IF(ASSOCIATED(XLSRVS)) DEALLOCATE(XLSRVS)
-!
- IF ( ASSOCIATED(XLBXUS) ) THEN
- DEALLOCATE(XLBXUS)
- DEALLOCATE(XLBYUS)
- DEALLOCATE(XLBXVS)
- DEALLOCATE(XLBYVS)
- DEALLOCATE(XLBXWS)
- DEALLOCATE(XLBYWS)
- DEALLOCATE(XLBXTHS)
- DEALLOCATE(XLBYTHS)
- END IF
- IF ( ASSOCIATED(XLBXTKES) ) THEN
- DEALLOCATE(XLBXTKES)
- DEALLOCATE(XLBYTKES)
- END IF
-!
- IF ( ASSOCIATED(XLBXRS) ) THEN
- DEALLOCATE(XLBXRS)
- DEALLOCATE(XLBYRS)
- END IF
-!
- IF ( ASSOCIATED(XLBXSVS) ) THEN
- DEALLOCATE(XLBXSVS)
- DEALLOCATE(XLBYSVS)
- END IF
-!
- IF ( ASSOCIATED(XCOEFLIN_LBXM) ) THEN
- DEALLOCATE(XCOEFLIN_LBXM)
- DEALLOCATE(NKLIN_LBXM)
- END IF
-
- IF ( ASSOCIATED(XCOEFLIN_LBYM) ) THEN
- DEALLOCATE(XCOEFLIN_LBYM)
- DEALLOCATE(NKLIN_LBYM)
- END IF
-
- IF ( ASSOCIATED(XCOEFLIN_LBXU) ) THEN
- DEALLOCATE(XCOEFLIN_LBXU)
- DEALLOCATE(NKLIN_LBXU)
- DEALLOCATE(XCOEFLIN_LBYU)
- DEALLOCATE(NKLIN_LBYU)
- DEALLOCATE(XCOEFLIN_LBXV)
- DEALLOCATE(NKLIN_LBXV)
- DEALLOCATE(XCOEFLIN_LBYV)
- DEALLOCATE(NKLIN_LBYV)
- DEALLOCATE(XCOEFLIN_LBXW)
- DEALLOCATE(NKLIN_LBXW)
- DEALLOCATE(XCOEFLIN_LBYW)
- DEALLOCATE(NKLIN_LBYW)
- END IF
-END IF
-!
-!* 8. L.E.S. variables
-!
-
-!
-!* 9. Module MODD_RADIATIONS$n
-!
-!
-IF ( ASSOCIATED(XSLOPANG) .AND. KCALL == 2 ) THEN
- DEALLOCATE(XSLOPANG)
- DEALLOCATE(XSLOPAZI)
- DEALLOCATE(XDTHRAD)
- DEALLOCATE(XFLALWD)
- DEALLOCATE(XDIRFLASWD)
- DEALLOCATE(XSCAFLASWD)
- DEALLOCATE(XDIRSRFSWD)
- DEALLOCATE(XSWU)
- DEALLOCATE(XSWD)
- DEALLOCATE(XLWU)
- DEALLOCATE(XLWD)
- DEALLOCATE(XDTHRADSW)
- DEALLOCATE(XDTHRADLW)
- DEALLOCATE(XRADEFF)
- DEALLOCATE(NCLEARCOL_TM1)
-END IF
-IF (ASSOCIATED(XSTATM)) DEALLOCATE(XSTATM)
-!
-!* 10. Module MODD_DEEP_CONVECTION$n
-!
-IF ( ASSOCIATED(XDTHCONV) .AND. KCALL == 2 ) THEN
- DEALLOCATE(NCOUNTCONV)
- DEALLOCATE(XDTHCONV)
- DEALLOCATE(XDRVCONV)
- DEALLOCATE(XDRCCONV)
- DEALLOCATE(XDRICONV)
-END IF
-!
-IF ( ASSOCIATED(XPRCONV) .AND. KCALL == 2 ) THEN
- DEALLOCATE(XPRCONV)
- DEALLOCATE(XPACCONV)
-END IF
-IF ( ASSOCIATED(XPRSCONV) .AND. KCALL == 2 ) THEN
- DEALLOCATE(XPRSCONV)
-END IF
-!
-IF ( ASSOCIATED(XDSVCONV) .AND. KCALL == 2 ) THEN
- DEALLOCATE(XDSVCONV)
-END IF
-!
-!* 11. Forcing variables (Module MODD_FRC)
-!
-IF ( ALLOCATED(XUFRC) .AND. KCALL == 4 ) THEN
- DEALLOCATE(TDTFRC)
- DEALLOCATE(XUFRC)
- DEALLOCATE(XVFRC)
- DEALLOCATE(XWFRC)
- DEALLOCATE(XTHFRC)
- DEALLOCATE(XRVFRC)
- DEALLOCATE(XTENDTHFRC)
- DEALLOCATE(XTENDRVFRC)
- DEALLOCATE(XGXTHFRC)
- DEALLOCATE(XGYTHFRC)
- DEALLOCATE(XPGROUNDFRC)
-END IF
-!
-!* 12. Module MODD_ICE_CONC$n
-!
-IF ( ASSOCIATED(XCIT) .AND. KCALL == 2 ) THEN
- DEALLOCATE(XCIT)
-END IF
-!
-!* 13. Module MODD_PRECIP$n
-!
-IF ( ASSOCIATED(XINPRC) .AND. KCALL == 3 ) THEN
- DEALLOCATE(XINPRC)
- DEALLOCATE(XACPRC)
-END IF
-!
-IF ( ASSOCIATED(XINPRR) .AND. KCALL == 3 ) THEN
- DEALLOCATE(XINPRR)
- DEALLOCATE(XACPRR)
-END IF
-!
-IF ( ASSOCIATED(XINPRR3D) .AND. KCALL == 3 ) THEN
- DEALLOCATE(XINPRR3D)
- DEALLOCATE(XEVAP3D)
-END IF
-!
-IF ( ASSOCIATED(XINPRS) .AND. KCALL == 3 ) THEN
- DEALLOCATE(XINPRS)
- DEALLOCATE(XACPRS)
- DEALLOCATE(XINPRG)
- DEALLOCATE(XACPRG)
-END IF
-!
-IF ( ASSOCIATED(XINPRH) .AND. KCALL == 3 ) THEN
- DEALLOCATE(XINPRH)
- DEALLOCATE(XACPRH)
-END IF
-!
-!* 13b. Module MODD_ELEC$n
-!
-IF ( ASSOCIATED(XNI_SDRYG) .AND. KCALL == 3 ) THEN
- DEALLOCATE(XNI_SDRYG)
- DEALLOCATE(XNI_IDRYG)
- DEALLOCATE(XNI_IAGGS)
- DEALLOCATE(XEW)
- DEALLOCATE(XIND_RATE)
-END IF
-!
-IF ( ASSOCIATED(XEFIELDU) .AND. KCALL == 3 ) THEN
- DEALLOCATE(XEFIELDU)
- DEALLOCATE(XEFIELDV)
- DEALLOCATE(XEFIELDW)
- DEALLOCATE(XESOURCEFW)
- DEALLOCATE(XIONSOURCEFW)
- DEALLOCATE(XCION_POS_FW)
- DEALLOCATE(XCION_NEG_FW)
- DEALLOCATE(XMOBIL_POS)
- DEALLOCATE(XMOBIL_NEG)
-END IF
-!
-IF ( ASSOCIATED(XRHOM_E) .AND. KCALL == 3 ) THEN
- DEALLOCATE (XRHOM_E)
- DEALLOCATE (XAF_E)
- DEALLOCATE (XCF_E)
- DEALLOCATE (XBFY_E)
-END IF
-!
-!* 14. Modules RAIN_ICE_DESCR and MODD_RAIN_ICE_PARAM
-!
-IF ( ASSOCIATED(XRTMIN) .AND. KCALL == 4 ) THEN
- CALL RAIN_ICE_DESCR_DEALLOCATE()
- CALL RAIN_ICE_PARAM_DEALLOCATE()
-END IF
-!
-!* 15. Module PASPOLn
-!
-IF ( ASSOCIATED(XATC) .AND. KCALL == 3 ) THEN
- DEALLOCATE(XATC)
-END IF
-!
-!* 16. Module TURBn
-!
-IF ( KCALL==3 ) THEN
- IF (ASSOCIATED(XDYP)) DEALLOCATE(XDYP)
- IF (ASSOCIATED(XTHP)) DEALLOCATE(XTHP)
- IF (ASSOCIATED(XTR)) DEALLOCATE(XTR)
- IF (ASSOCIATED(XDISS)) DEALLOCATE(XDISS)
- IF (ASSOCIATED(XLEM)) DEALLOCATE(XLEM)
- IF (ASSOCIATED(XCEI)) DEALLOCATE(XCEI)
-END IF
-!-------------------------------------------------------------------------------
-!
-CALL GOTO_MODEL(IMI)
-!
-END SUBROUTINE DEALLOCATE_MODEL1
diff --git a/src/mesonh/ext/default_desfmn.f90 b/src/mesonh/ext/default_desfmn.f90
deleted file mode 100644
index 9218ccad73d8db5c0d5f36bc6fb81951ca1d8324..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/default_desfmn.f90
+++ /dev/null
@@ -1,1310 +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_LUNIT_n, ONLY: TLUOUT
-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, ONLY: TURBN_INIT
-USE MODD_NEB_n, ONLY: NEBN_INIT
-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_n, ONLY: PARAM_ICEN_INIT
-USE MODD_PARAM_LIMA, ONLY: PARAM_LIMA_INIT
-USE MODD_PARAM_C2R2
-USE MODD_PARAM_KAFR_n
-USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALLN_INIT
-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_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 :
-! ----------------------------------
-!
-CALL TURBN_INIT(CPROGRAM, 0, .FALSE., TLUOUT%NLU, &
- &LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0)
-!-------------------------------------------------------------------------------
-!
-!* 10a. SET DEFAULT VALUES FOR MODD_NEB_n :
-! ----------------------------------
-!
-CALL NEBN_INIT(CPROGRAM, 0, .FALSE., TLUOUT%NLU, &
- &LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=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 :
-! ---------------------------------------
-!
-CALL PARAM_ICEN_INIT(CPROGRAM, 0, .FALSE., TLUOUT%NLU, &
- &LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0)
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 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 :
-! --------------------------------------------
-!
-CALL PARAM_MFSHALLN_INIT(CPROGRAM, 0, .FALSE., TLUOUT%NLU, &
- &LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0)
-!
-!-------------------------------------------------------------------------------
-!
-!* 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
- CALL PARAM_LIMA_INIT(CPROGRAM, 0, .FALSE., TLUOUT%NLU, &
- &LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0)
-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_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/diagnos_les_mf.f90 b/src/mesonh/ext/diagnos_les_mf.f90
deleted file mode 100644
index 665d1ea7666f6047ab2a4d8e9343253fb2852446..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/diagnos_les_mf.f90
+++ /dev/null
@@ -1,244 +0,0 @@
-!MNH_LIC Copyright 2009-2020 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ###########################
- MODULE MODI_DIAGNOS_LES_MF
-! ###########################
-!
-INTERFACE
-!
-! #################################################################
- SUBROUTINE DIAGNOS_LES_MF(KIU,KJU,KKU,PTIME_LES, &
- PTHL_UP,PRT_UP,PRV_UP,PRC_UP,PRI_UP, &
- PU_UP, PV_UP, PTHV_UP, PW_UP, &
- PFRAC_UP,PEMF,PDETR,PENTR, &
- PWTHMF,PWTHVMF,PWRTMF, &
- PWUMF,PWVMF, &
- KKLCL,KKETL,KKCTL)
-! #################################################################
-!
-!* 1.1 Declaration of Arguments
-!
-use modd_precision, only: MNHTIME
-!
-INTEGER, INTENT(IN) :: KIU, KJU, KKU ! 3D grid size
-REAL(kind=MNHTIME), DIMENSION(2), INTENT(OUT) :: PTIME_LES
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHL_UP,PRT_UP,PRV_UP,&
- PRC_UP,PRI_UP ! updraft properties
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PU_UP, PV_UP
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHV_UP,PW_UP,&
- PFRAC_UP,PEMF,PDETR,PENTR
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWTHMF,PWTHVMF,PWRTMF, &
- PWUMF,PWVMF
-INTEGER, DIMENSION(:), INTENT(IN) :: KKLCL,KKETL,KKCTL
-
-
-END SUBROUTINE DIAGNOS_LES_MF
-
-END INTERFACE
-!
-END MODULE MODI_DIAGNOS_LES_MF
-!
-! #################################################################
- SUBROUTINE DIAGNOS_LES_MF(KIU,KJU,KKU,PTIME_LES, &
- PTHL_UP,PRT_UP,PRV_UP,PRC_UP,PRI_UP, &
- PU_UP, PV_UP, PTHV_UP, PW_UP, &
- PFRAC_UP,PEMF,PDETR,PENTR, &
- PWTHMF,PWTHVMF,PWRTMF, &
- PWUMF,PWVMF, &
- KKLCL,KKETL,KKCTL)
-! #################################################################
-!!
-!!**** *DIAGNOS_LES_MF* - Edit in File the updraft properties as
-!! LES diagnostics
-!!
-!! PURPOSE
-!! -------
-!!**** The purpose of this routine is to write updraft variable as
-!! LES diagnostics
-!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! J.pergaud
-!
-! Modifications:
-! V. Masson 09/2010: Optimization
-! P. Wautelet 28/03/2019: use MNHTIME for time measurement variables
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_LES
-use modd_precision, only: MNHTIME
-!
-USE MODE_MNH_TIMING
-!
-USE MODI_LES_VER_INT
-USE MODI_LES_MEAN_ll
-USE MODI_SHUMAN
-!
-IMPLICIT NONE
-
-!* 0.1 Declaration of Arguments
-!
-!
-INTEGER, INTENT(IN) :: KIU, KJU, KKU ! 3D grid size
-REAL(kind=MNHTIME), DIMENSION(2), INTENT(OUT) :: PTIME_LES
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHL_UP,PRT_UP,PRV_UP,&
- PRC_UP,PRI_UP ! updraft properties
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PU_UP, PV_UP
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHV_UP,PW_UP,&
- PFRAC_UP,PEMF,PDETR,PENTR
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWTHMF,PWTHVMF,PWRTMF, &
- PWUMF,PWVMF
-INTEGER, DIMENSION(:), INTENT(IN) :: KKLCL,KKETL,KKCTL
-
-!
-!
-! 0.2 Declaration of local variables
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHLMFFLX_LES,ZRTMFFLX_LES, &
- ZTHVMFFLX_LES,ZUMFFLX_LES, &
- ZVMFFLX_LES
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHLUP_MF_LES,ZRTUP_MF_LES, &
- ZRCUP_MF_LES,ZEMF_MF_LES, &
- ZDETR_MF_LES, ZENTR_MF_LES, &
- ZWUP_MF_LES,ZFRACUP_MF_LES, &
- ZTHVUP_MF_LES,ZRVUP_MF_LES, &
- ZRIUP_MF_LES
-REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME1, ZTIME2
-!------------------------------------------------------------------------
-!
-
-CALL SECOND_MNH2(ZTIME1)
-
- IF (LLES_CALL) THEN
-
- ALLOCATE( ZTHLUP_MF_LES(KIU,KJU,NLES_K) )
- ALLOCATE( ZRTUP_MF_LES(KIU,KJU,NLES_K) )
- ALLOCATE( ZRVUP_MF_LES(KIU,KJU,NLES_K) )
- ALLOCATE( ZRCUP_MF_LES(KIU,KJU,NLES_K) )
- ALLOCATE( ZRIUP_MF_LES(KIU,KJU,NLES_K) )
- ALLOCATE( ZEMF_MF_LES(KIU,KJU,NLES_K) )
- ALLOCATE( ZDETR_MF_LES(KIU,KJU,NLES_K) )
- ALLOCATE( ZENTR_MF_LES(KIU,KJU,NLES_K) )
- ALLOCATE( ZWUP_MF_LES(KIU,KJU,NLES_K) )
- ALLOCATE( ZFRACUP_MF_LES(KIU,KJU,NLES_K) )
- ALLOCATE( ZTHVUP_MF_LES(KIU,KJU,NLES_K) )
-
- ALLOCATE( ZTHLMFFLX_LES(KIU,KJU,NLES_K) )
- ALLOCATE( ZRTMFFLX_LES (KIU,KJU,NLES_K) )
- ALLOCATE( ZTHVMFFLX_LES(KIU,KJU,NLES_K) )
- ALLOCATE( ZUMFFLX_LES (KIU,KJU,NLES_K) )
- ALLOCATE( ZVMFFLX_LES (KIU,KJU,NLES_K) )
-
-
- CALL LES_VER_INT(MZF(PWTHMF) ,ZTHLMFFLX_LES )
- CALL LES_MEAN_ll(ZTHLMFFLX_LES,LLES_CURRENT_CART_MASK, &
- X_LES_SUBGRID_WTHLMF(:,NLES_CURRENT_TCOUNT,1))
-
- CALL LES_VER_INT( MZF(PWRTMF) ,ZRTMFFLX_LES )
- CALL LES_MEAN_ll (ZRTMFFLX_LES , LLES_CURRENT_CART_MASK, &
- X_LES_SUBGRID_WRTMF(:,NLES_CURRENT_TCOUNT,1) )
-
- CALL LES_VER_INT( MZF(PWUMF) ,ZUMFFLX_LES )
- CALL LES_MEAN_ll (ZUMFFLX_LES , LLES_CURRENT_CART_MASK, &
- X_LES_SUBGRID_WUMF(:,NLES_CURRENT_TCOUNT,1) )
-
- CALL LES_VER_INT( MZF(PWVMF) ,ZVMFFLX_LES )
- CALL LES_MEAN_ll (ZVMFFLX_LES , LLES_CURRENT_CART_MASK, &
- X_LES_SUBGRID_WVMF(:,NLES_CURRENT_TCOUNT,1) )
-
- CALL LES_VER_INT( MZF(PWTHVMF) ,ZTHVMFFLX_LES )
- CALL LES_MEAN_ll (ZTHVMFFLX_LES , LLES_CURRENT_CART_MASK, &
- X_LES_SUBGRID_WTHVMF(:,NLES_CURRENT_TCOUNT,1) )
-
-
- CALL LES_VER_INT( MZF(PTHL_UP) ,ZTHLUP_MF_LES )
- CALL LES_MEAN_ll (ZTHLUP_MF_LES , LLES_CURRENT_CART_MASK, &
- X_LES_SUBGRID_THLUP_MF(:,NLES_CURRENT_TCOUNT,1) )
-
- CALL LES_VER_INT( MZF(PRT_UP) ,ZRTUP_MF_LES )
- CALL LES_MEAN_ll (ZRTUP_MF_LES , LLES_CURRENT_CART_MASK, &
- X_LES_SUBGRID_RTUP_MF(:,NLES_CURRENT_TCOUNT,1) )
-
- CALL LES_VER_INT( MZF(PRV_UP) ,ZRVUP_MF_LES )
- CALL LES_MEAN_ll (ZRVUP_MF_LES , LLES_CURRENT_CART_MASK, &
- X_LES_SUBGRID_RVUP_MF(:,NLES_CURRENT_TCOUNT,1) )
-
- CALL LES_VER_INT( MZF(PRC_UP) ,ZRCUP_MF_LES )
- CALL LES_MEAN_ll (ZRCUP_MF_LES , LLES_CURRENT_CART_MASK, &
- X_LES_SUBGRID_RCUP_MF(:,NLES_CURRENT_TCOUNT,1) )
-
- CALL LES_VER_INT( MZF(PRI_UP) ,ZRIUP_MF_LES )
- CALL LES_MEAN_ll (ZRIUP_MF_LES , LLES_CURRENT_CART_MASK, &
- X_LES_SUBGRID_RIUP_MF(:,NLES_CURRENT_TCOUNT,1) )
-
- CALL LES_VER_INT( MZF(PEMF) ,ZEMF_MF_LES )
- CALL LES_MEAN_ll (ZEMF_MF_LES , LLES_CURRENT_CART_MASK, &
- X_LES_SUBGRID_MASSFLUX(:,NLES_CURRENT_TCOUNT,1) )
-
- CALL LES_VER_INT( MZF(PDETR) ,ZDETR_MF_LES )
- CALL LES_MEAN_ll (ZDETR_MF_LES , LLES_CURRENT_CART_MASK, &
- X_LES_SUBGRID_DETR(:,NLES_CURRENT_TCOUNT,1) )
-
- CALL LES_VER_INT( MZF(PENTR) ,ZENTR_MF_LES )
- CALL LES_MEAN_ll (ZENTR_MF_LES , LLES_CURRENT_CART_MASK, &
- X_LES_SUBGRID_ENTR(:,NLES_CURRENT_TCOUNT,1) )
-
- CALL LES_VER_INT( MZF(PW_UP) ,ZWUP_MF_LES )
- CALL LES_MEAN_ll (ZWUP_MF_LES , LLES_CURRENT_CART_MASK, &
- X_LES_SUBGRID_WUP_MF(:,NLES_CURRENT_TCOUNT,1) )
-
- CALL LES_VER_INT( MZF(PFRAC_UP) ,ZFRACUP_MF_LES )
- CALL LES_MEAN_ll (ZFRACUP_MF_LES , LLES_CURRENT_CART_MASK, &
- X_LES_SUBGRID_FRACUP(:,NLES_CURRENT_TCOUNT,1) )
-
- CALL LES_VER_INT( MZF(PTHV_UP) ,ZTHVUP_MF_LES )
- CALL LES_MEAN_ll (ZTHVUP_MF_LES , LLES_CURRENT_CART_MASK, &
- X_LES_SUBGRID_THVUP_MF(:,NLES_CURRENT_TCOUNT,1) )
-
-
-
- DEALLOCATE( ZTHLMFFLX_LES )
- DEALLOCATE( ZRTMFFLX_LES )
- DEALLOCATE( ZTHVMFFLX_LES )
- DEALLOCATE( ZUMFFLX_LES )
- DEALLOCATE( ZVMFFLX_LES )
-
-
- DEALLOCATE( ZTHLUP_MF_LES )
- DEALLOCATE( ZRTUP_MF_LES )
- DEALLOCATE( ZRVUP_MF_LES )
- DEALLOCATE( ZRCUP_MF_LES )
- DEALLOCATE( ZRIUP_MF_LES )
- DEALLOCATE( ZENTR_MF_LES )
- DEALLOCATE( ZDETR_MF_LES )
- DEALLOCATE( ZEMF_MF_LES )
- DEALLOCATE( ZWUP_MF_LES )
- DEALLOCATE( ZFRACUP_MF_LES )
- DEALLOCATE( ZTHVUP_MF_LES )
-
-ENDIF
-
-CALL SECOND_MNH2(ZTIME2)
-PTIME_LES = ZTIME2 - ZTIME1
-XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
-
-END SUBROUTINE DIAGNOS_LES_MF
diff --git a/src/mesonh/ext/endstep.f90 b/src/mesonh/ext/endstep.f90
deleted file mode 100644
index 97734d72bd8ecad1aa8e4163c203fbfe7ab5fe57..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/endstep.f90
+++ /dev/null
@@ -1,668 +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_ENDSTEP
-! ###################
-!
-INTERFACE
-!
- SUBROUTINE ENDSTEP (PTSTEP,KRR,KSV,KTCOUNT,KMI, &
- HUVW_ADV_SCHEME,HTEMP_SCHEME, PRHODJ, &
- PUS,PVS,PWS,PDRYMASSS, &
- PTHS,PRS,PTKES,PSVS, &
- PLSUS,PLSVS,PLSWS, &
- PLSTHS,PLSRVS,PLSZWSS, &
- PLBXUS,PLBXVS,PLBXWS, &
- PLBXTHS,PLBXRS,PLBXTKES,PLBXSVS, &
- PLBYUS,PLBYVS,PLBYWS, &
- PLBYTHS,PLBYRS,PLBYTKES,PLBYSVS, &
- PUM,PVM,PWM,PZWS, &
- PUT,PVT,PWT,PPABST,PDRYMASST, &
- PTHT,PRT,PTHM,PRCM,PPABSM,PTKET,PSVT, &
- PLSUM,PLSVM,PLSWM, &
- PLSTHM,PLSRVM,PLSZWSM, &
- PLBXUM,PLBXVM,PLBXWM, &
- PLBXTHM,PLBXRM,PLBXTKEM,PLBXSVM, &
- PLBYUM,PLBYVM,PLBYWM, &
- PLBYTHM,PLBYRM,PLBYTKEM,PLBYSVM )
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-INTEGER, INTENT(IN) :: KRR ! Number of water var.
-INTEGER, INTENT(IN) :: KSV ! Number of scal. var.
-INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop COUNTer
-INTEGER, INTENT(IN) :: KMI ! Model index
-CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME ! advection scheme for wind
-CHARACTER(LEN=4), INTENT(IN) :: HTEMP_SCHEME ! Temporal scheme
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (Rho) dry * Jacobian
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUS,PVS,PWS, & !
- PTHS,PTKES ! variables at
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRS,PSVS ! t+dt
-!
-REAL, INTENT(IN) :: PDRYMASSS ! Md source
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSUS,PLSVS,PLSWS,& ! Large Scale
- PLSTHS,PLSRVS ! fields tendencies
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PLSZWSS ! Large Scale fields tendencies
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUS,PLBXVS,PLBXWS, & !
- PLBXTHS,PLBXTKES ! LBX tendancy
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBXRS,PLBXSVS !
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYUS,PLBYVS,PLBYWS,& !
- PLBYTHS,PLBYTKES ! LBY tendancy
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRS,PLBYSVS !
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUM,PVM,PWM! Variables at t-dt
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PPABST,PTHT,&!
- PTKET ! Variables at
-REAL, DIMENSION(:,:,:,:),INTENT(INOUT):: PRT,PSVT ! t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHM, PRCM,PPABSM ! Variables at t-Dt
-REAL, INTENT(INOUT):: PDRYMASST !
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLSUM,PLSVM,PLSWM,& ! Large Scale fields
- PLSTHM,PLSRVM ! at t-dt
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PLSZWSM ! Large Scale fields at t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLBXUM,PLBXVM,PLBXWM, & !
- PLBXTHM,PLBXTKEM ! LBX fields
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PLBXRM,PLBXSVM !
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLBYUM,PLBYVM,PLBYWM, & !
- PLBYTHM,PLBYTKEM ! LBY fields
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PLBYRM,PLBYSVM !
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PZWS ! significant wave height
-!
-END SUBROUTINE ENDSTEP
-!
-END INTERFACE
-!
-END MODULE MODI_ENDSTEP
-!
-!
-!
-! ######################################################################
- SUBROUTINE ENDSTEP (PTSTEP,KRR,KSV,KTCOUNT,KMI, &
- HUVW_ADV_SCHEME,HTEMP_SCHEME, PRHODJ, &
- PUS,PVS,PWS,PDRYMASSS, &
- PTHS,PRS,PTKES,PSVS, &
- PLSUS,PLSVS,PLSWS, &
- PLSTHS,PLSRVS,PLSZWSS, &
- PLBXUS,PLBXVS,PLBXWS, &
- PLBXTHS,PLBXRS,PLBXTKES,PLBXSVS, &
- PLBYUS,PLBYVS,PLBYWS, &
- PLBYTHS,PLBYRS,PLBYTKES,PLBYSVS, &
- PUM,PVM,PWM,PZWS, &
- PUT,PVT,PWT,PPABST,PDRYMASST, &
- PTHT,PRT,PTHM,PRCM,PPABSM,PTKET,PSVT, &
- PLSUM,PLSVM,PLSWM, &
- PLSTHM,PLSRVM,PLSZWSM, &
- PLBXUM,PLBXVM,PLBXWM, &
- PLBXTHM,PLBXRM,PLBXTKEM,PLBXSVM, &
- PLBYUM,PLBYVM,PLBYWM, &
- PLBYTHM,PLBYRM,PLBYTKEM,PLBYSVM )
-! ######################################################################
-!
-!!**** *ENDSTEP* - temporal advance and asselin filter for all variables
-!! (replaces the previous endstep_dyn and endstep_scalar subroutines)
-!!
-!! PURPOSE
-!! -------
-!!
-!! The purpose of ENDSTEP is to apply the asselin filter, perform
-!! the time advance and thereby finalize the time step.
-!
-!
-!!** METHOD
-!! ------
-!!
-!! The filtered values of the prognostic variables at t is obtained
-!! by linear combination of variables at t-dt, t, and t+dt.
-!! This value is put into the array containing the t-dt value.
-!! To perform the time swapping, the t+dt values are put into the arrays
-!! containing the t values.
-!!
-!! In case of cold start (first time step), indicated by the value 'START'
-!! of CCONF in module MODD_CONF, a simple time advance is performed.
-!!
-!! The swapping for the absolute pressure function is only a copy of time t in
-!! time (t-dt).
-!!
-!! Temporal advances of large scale, lateral boundarie and SST fields
-!! are also made in this subroutine.
-!!
-!! The different sources terms are stored for the budget computations.
-!!
-!! EXTERNAL
-!! --------
-!! BUDGET : Stores the different budget components
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! MODULE MODD_DYN containing XASSELIN
-!! MODULE MODD_CONF containing CCONF
-!! MODULE MODD_CTURB containing XTKEMIN, XEPSMIN
-!! MODULE MODD_BUDGET:
-!! NBUMOD : model in which budget is calculated
-!! NBUTSHIFT : temporal shift for budgets writing
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of documentation
-!!
-!! AUTHOR
-!! ------
-!! P. Bougeault Meteo France
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-!! original 22/06/94
-!! corrections 01/09/94 (J. P. Lafore)
-!! " 07/11/94 (J.Stein) pressure function swapping
-!! update 03/01/94 (J. P. Lafore) Total mass of dry air Md evolution
-!! 20/03/95 (J.Stein ) remove R from the historical variables
-!! + switch for TKE unused
-!! 01/04/95 (Ph. Hereil J. Nicolau) add the budget computation
-!! 30/08/95 (J.Stein) remove the positivity control and
-!! correct the bug for PRM and PSVM for the cold start
-!! 16/10/95 (J. Stein) change the budget calls
-!! 12/10/96 (J. Stein) add the SRC temporal evolution
-!! 20/12/96 (J.-P. Pinty) update the CALL BUDGET
-!! 03/09/96 (J. P. Lafore) temporal advance of LS scalar fields
-!! 22/06/97 (J. Stein) add the absolute pressure
-!! 13/03/97 (J. P. Lafore) add "surfacic" LS fields
-!! 24/09/97 (V. Masson) positive values for ls fields
-!! 10/01/98 (J. Stein) use the LB fields
-!! 20/04/98 (P. Josse) temporal evolution of SST
-!! 18/09/98 (P. Jabouille) merge endstep_dyn and endstep_scalar
-!! 08/12/00 (P. Jabouille) minimum values for hydrometeors
-!! 22/06/01 (P. Jabouille) use XSVMIN
-!! 06/11/02 (V. Masson) update the budget calls
-!! 01/2004 (V. Masson) surface externalization
-!! 05/2006 Remove KEPS
-!! 10/2006 (Maric, Lac) modification for PPM schemes
-!! 10/2009 (C.Lac) Correction on FIT temporal scheme for variables
-!! advected with PPM
-!! 04/2013 (C.Lac) FIT for all the variables
-!! 04/2014 (C.Lac) Check on the positivity of PSVT
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! 02/2019 (S. Bielli) Sea salt : significant sea wave height influences salt emission; 5 salt modes
-! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
-! P. Wautelet 02/2022: add sea salt
-!------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_BLOWSNOW
-USE MODD_BLOWSNOW_n
-use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudget_tke, lbudget_rv, lbudget_rc, &
- lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, lbu_enable, &
- 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, &
- nbustep, tbudgets
-USE MODD_CH_AEROSOL, ONLY: LORILAM
-USE MODD_CONF
-USE MODD_TURB_n, ONLY: XTKEMIN
-USE MODD_DUST, ONLY: LDUST
-USE MODD_SALT, ONLY: LSALT
-USE MODD_DYN
-USE MODD_GRID_n
-USE MODD_LBC_n, ONLY: CLBCX, CLBCY
-USE MODD_NSV, ONLY: XSVMIN, NSV_CHEMBEG, NSV_CHEMEND, &
- NSV_AERBEG, NSV_AEREND,&
- NSV_DSTBEG, NSV_DSTEND,&
- NSV_SLTBEG, NSV_SLTEND,&
- NSV_SNWBEG, NSV_SNWEND
-USE MODD_PARAM_C2R2, ONLY: LACTIT
-USE MODD_PARAM_LIMA, ONLY: LACTIT_LIMA=>LACTIT
-
-use mode_budget, only: Budget_store_end, Budget_store_init
-
-USE MODI_SHUMAN
-!
-USE MODE_ll
-!
-IMPLICIT NONE
-!
-!* 0.1 DECLARATIONS OF ARGUMENTS
-!
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-INTEGER, INTENT(IN) :: KRR ! Number of water var.
-INTEGER, INTENT(IN) :: KSV ! Number of scal. var.
-INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop COUNTer
-INTEGER, INTENT(IN) :: KMI ! Model index
-CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME ! advection scheme for wind
-CHARACTER(LEN=4), INTENT(IN) :: HTEMP_SCHEME ! Temporal scheme
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (Rho) dry * Jacobian
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUS,PVS,PWS, & !
- PTHS,PTKES ! variables at
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRS,PSVS ! t+dt
-!
-REAL, INTENT(IN) :: PDRYMASSS ! Md source
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSUS,PLSVS,PLSWS,& ! Large Scale
- PLSTHS,PLSRVS ! fields tendencies
-REAL, DIMENSION(:,:), INTENT(IN) :: PLSZWSS ! Large Scale fields tendencies
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUS,PLBXVS,PLBXWS, & !
- PLBXTHS,PLBXTKES ! LBX tendancy
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBXRS,PLBXSVS !
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYUS,PLBYVS,PLBYWS,& !
- PLBYTHS,PLBYTKES ! LBY tendancy
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRS,PLBYSVS !
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUM,PVM,PWM! Variables at t-dt
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PPABST,PTHT,&!
- PTKET ! Variables at
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHM, PRCM, PPABSM ! Variables at t-Dt
-REAL, DIMENSION(:,:,:,:),INTENT(INOUT):: PRT,PSVT ! t
-REAL, INTENT(INOUT):: PDRYMASST !
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLSUM,PLSVM,PLSWM,& ! Large Scale fields
- PLSTHM,PLSRVM ! at t-dt
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PLSZWSM ! Large Scale fields at t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLBXUM,PLBXVM,PLBXWM, & !
- PLBXTHM,PLBXTKEM ! LBX fields
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PLBXRM,PLBXSVM !
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLBYUM,PLBYVM,PLBYWM, & !
- PLBYTHM,PLBYTKEM ! LBY fields
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PLBYRM,PLBYSVM !
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PZWS ! significant wave height
-!
-!* 0.2 DECLARATIONS OF LOCAL VARIABLES
-!
-INTEGER:: JSV ! loop counters
-INTEGER :: IIB, IIE ! index of first and last inner mass points along x
-INTEGER :: IJB, IJE ! index of first and last inner mass points along y
-real, dimension(:,:,:), allocatable :: zrhodjontime
-real, dimension(:,:,:), allocatable :: zwork
-!
-!------------------------------------------------------------------------------
-!
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-!
-!* 1. ASSELIN FILTER
-!
-IF ((HUVW_ADV_SCHEME(1:3)=='CEN').AND. (HTEMP_SCHEME == 'LEFR')) THEN
- IF( KTCOUNT /= 1 .OR. CCONF /= 'START' ) THEN
- PUM(:,:,:)=(1.-XASSELIN)*PUT(:,:,:)+0.5*XASSELIN*(PUM(:,:,:)+PUS(:,:,:))
- PVM(:,:,:)=(1.-XASSELIN)*PVT(:,:,:)+0.5*XASSELIN*(PVM(:,:,:)+PVS(:,:,:))
- PWM(:,:,:)=(1.-XASSELIN)*PWT(:,:,:)+0.5*XASSELIN*(PWM(:,:,:)+PWS(:,:,:))
- END IF
-END IF
-
-!* 1. TEMPORAL ADVANCE OF PROGNOSTIC VARIABLES
-!
-PPABSM(:,:,:) = PPABST(:,:,:)
-!
-IF (LACTIT .OR. LACTIT_LIMA) THEN
- PTHM(:,:,:) = PTHT(:,:,:)
- PRCM(:,:,:) = PRT(:,:,:,2)
-END IF
-
-PUT(:,:,:)=PUS(:,:,:)
-PVT(:,:,:)=PVS(:,:,:)
-PWT(:,:,:)=PWS(:,:,:)
-!
-PDRYMASST = PDRYMASST + PTSTEP * PDRYMASSS
-!
-PTHT(:,:,:)=PTHS(:,:,:)
-!
-! Moisture
-!
-PRT(:,:,:,1:KRR)=PRS(:,:,:,1:KRR)
-!
-! Turbulence
-!
-IF (SIZE(PTKET,1) /= 0) PTKET(:,:,:)=PTKES(:,:,:)
-!
-! Other scalars
-!
-PSVT(:,:,:,1:KSV)=PSVS(:,:,:,1:KSV)
-!
-IF(LBLOWSNOW) THEN
- DO JSV=1,(NBLOWSNOW_2D)
- XSNWCANO(:,:,JSV) = XRSNWCANOS(:,:,JSV)
- END DO
-!* MINIMUM VALUE FOR BLOWING SNOW
-!
- WHERE(XSNWCANO(:,:,:)<1.E-20)
- XSNWCANO(:,:,:)=0.
- END WHERE
-
- IF (SIZE(PSVT,4) > 1) THEN
- WHERE(PSVT(:,:,:,NSV_SNWBEG:NSV_SNWEND)<1.E-20)
- PSVT(:,:,:,NSV_SNWBEG:NSV_SNWEND)=0.
- END WHERE
- END IF
-!
-END IF
-!
-IF (LWEST_ll( ) .AND. CLBCX(1)=='OPEN') THEN
- DO JSV=1,KSV
- PSVT(IIB,:,:,JSV)=MAX(PSVT(IIB,:,:,JSV),XSVMIN(JSV))
- PSVT(IIB-1,:,:,JSV)=MAX(PSVT(IIB-1,:,:,JSV),XSVMIN(JSV))
- END DO
-END IF
-!
-IF (LEAST_ll( ) .AND. CLBCX(2)=='OPEN') THEN
- DO JSV=1,KSV
- PSVT(IIE,:,:,JSV)=MAX(PSVT(IIE,:,:,JSV),XSVMIN(JSV))
- PSVT(IIE+1,:,:,JSV)=MAX(PSVT(IIE+1,:,:,JSV),XSVMIN(JSV))
- END DO
-END IF
-!
-IF (LSOUTH_ll( ) .AND. CLBCY(1)=='OPEN') THEN
- DO JSV=1,KSV
- PSVT(:,IJB,:,JSV)=MAX(PSVT(:,IJB,:,JSV),XSVMIN(JSV))
- PSVT(:,IJB-1,:,JSV)=MAX(PSVT(:,IJB-1,:,JSV),XSVMIN(JSV))
- END DO
-END IF
-!
-IF (LNORTH_ll( ) .AND. CLBCY(2)=='OPEN') THEN
- DO JSV=1,KSV
- PSVT(:,IJE,:,JSV)=MAX(PSVT(:,IJE,:,JSV),XSVMIN(JSV))
- PSVT(:,IJE+1,:,JSV)=MAX(PSVT(:,IJE+1,:,JSV),XSVMIN(JSV))
- END DO
-END IF
-!------------------------------------------------------------------------------
-!
-!* 4. TEMPORAL ADVANCE OF THE LARGE SCALE FIELDS
-!
-!
-IF (SIZE(PLSUS,1) /= 0) THEN
- PLSUM(:,:,:) = PLSUM(:,:,:) + PTSTEP * PLSUS(:,:,:)
- PLSVM(:,:,:) = PLSVM(:,:,:) + PTSTEP * PLSVS(:,:,:)
- PLSWM(:,:,:) = PLSWM(:,:,:) + PTSTEP * PLSWS(:,:,:)
-END IF
-!
-IF (SIZE(PLSTHS,1) /= 0) THEN
- PLSTHM(:,:,:) = PLSTHM(:,:,:) + PTSTEP * PLSTHS(:,:,:)
-ENDIF
-!
-IF (SIZE(PLSRVS,1) /= 0) THEN
- PLSRVM(:,:,:) = MAX( PLSRVM(:,:,:) + PTSTEP * PLSRVS(:,:,:) , 0.)
-ENDIF
-
-IF (SIZE(PLSZWSS,1) /= 0) THEN
- PLSZWSM(:,:) = MAX( PLSZWSM(:,:) + PTSTEP * PLSZWSS(:,:) , 0.)
- PZWS(:,:) = PLSZWSM(:,:)
-ENDIF
-!
-!------------------------------------------------------------------------------
-!
-!* 5. TEMPORAL ADVANCE OF THE LATERAL BOUNDARIES FIELDS
-!
-IF (SIZE(PLBXUS,1) /= 0) THEN
- PLBXUM(:,:,:) = PLBXUM(:,:,:) + PTSTEP * PLBXUS(:,:,:)
- PLBXVM(:,:,:) = PLBXVM(:,:,:) + PTSTEP * PLBXVS(:,:,:)
- PLBXWM(:,:,:) = PLBXWM(:,:,:) + PTSTEP * PLBXWS(:,:,:)
-ENDIF
-IF (SIZE(PLBYUS,1) /= 0) THEN
- PLBYUM(:,:,:) = PLBYUM(:,:,:) + PTSTEP * PLBYUS(:,:,:)
- PLBYVM(:,:,:) = PLBYVM(:,:,:) + PTSTEP * PLBYVS(:,:,:)
- PLBYWM(:,:,:) = PLBYWM(:,:,:) + PTSTEP * PLBYWS(:,:,:)
-ENDIF
-!
-IF (SIZE(PLBXTHS,1) /= 0) THEN
- PLBXTHM(:,:,:) = PLBXTHM(:,:,:) + PTSTEP * PLBXTHS(:,:,:)
-END IF
-IF (SIZE(PLBYTHS,1) /= 0) THEN
- PLBYTHM(:,:,:) = PLBYTHM(:,:,:) + PTSTEP * PLBYTHS(:,:,:)
-END IF
-!
-IF (SIZE(PLBXTKES,1) /= 0) THEN
- PLBXTKEM(:,:,:) = MAX( PLBXTKEM(:,:,:) + PTSTEP * PLBXTKES(:,:,:), XTKEMIN)
-END IF
-IF (SIZE(PLBYTKES,1) /= 0) THEN
- PLBYTKEM(:,:,:) = MAX( PLBYTKEM(:,:,:) + PTSTEP * PLBYTKES(:,:,:), XTKEMIN)
-END IF
-!
-IF (SIZE(PLBXRS,1) /= 0) THEN
- PLBXRM(:,:,:,:) = MAX( PLBXRM(:,:,:,:) + PTSTEP * PLBXRS(:,:,:,:), 0.)
-END IF
-IF (SIZE(PLBYRS,1) /= 0) THEN
- PLBYRM(:,:,:,:) = MAX( PLBYRM(:,:,:,:) + PTSTEP * PLBYRS(:,:,:,:), 0.)
-END IF
-!
-IF (SIZE(PLBXSVS,1) /= 0) THEN
- DO JSV = 1,KSV
- PLBXSVM(:,:,:,JSV) = MAX( PLBXSVM(:,:,:,JSV) + PTSTEP * PLBXSVS(:,:,:,JSV),XSVMIN(JSV))
- ENDDO
-ENDIF
-IF (SIZE(PLBYSVS,1) /= 0) THEN
- DO JSV = 1,KSV
- PLBYSVM(:,:,:,JSV) = MAX( PLBYSVM(:,:,:,JSV) + PTSTEP * PLBYSVS(:,:,:,JSV),XSVMIN(JSV))
- ENDDO
-END IF
-!
-!------------------------------------------------------------------------------
-!
-!* 6. MINIMUM VALUE FOR HYDROMETEORS
-!
-IF (SIZE(PRT,4) > 1) THEN
- WHERE(PRT(:,:,:,2:)<1.E-20)
- PRT(:,:,:,2:)=0.
- END WHERE
-END IF
-IF (SIZE(PLBXRM,4) > 1) THEN
- WHERE(PLBXRM(:,:,:,2:)<1.E-20)
- PLBXRM(:,:,:,2:)=0.
- END WHERE
-END IF
-IF (SIZE(PLBYRM,4) > 1) THEN
- WHERE(PLBYRM(:,:,:,2:)<1.E-20)
- PLBYRM(:,:,:,2:)=0.
- END WHERE
-END IF
-!
-!------------------------------------------------------------------------------
-!
-!* 7. MINIMUM VALUE FOR CHEMISTRY
-!
-IF ((SIZE(PLBXSVM,4) > NSV_CHEMEND-1).AND.(SIZE(PLBXSVM,1) /= 0)) THEN
- DO JSV=NSV_CHEMBEG, NSV_CHEMEND
- PLBXSVM(:,:,:,JSV) = MAX(PLBXSVM(:,:,:,JSV), XSVMIN(JSV))
- END DO
-END IF
-IF ((SIZE(PLBYSVM,4) > NSV_CHEMEND-1).AND.(SIZE(PLBYSVM,1) /= 0)) THEN
- DO JSV=NSV_CHEMBEG, NSV_CHEMEND
- PLBYSVM(:,:,:,JSV) = MAX(PLBYSVM(:,:,:,JSV), XSVMIN(JSV))
- END DO
-END IF
-!
-!------------------------------------------------------------------------------
-!
-!* 8. MINIMUM VALUE FOR AEROSOLS
-!
-IF (LORILAM) THEN
- IF ((SIZE(PLBXSVM,4) > NSV_AEREND-1).AND.(SIZE(PLBXSVM,1) /= 0)) THEN
- DO JSV=NSV_AERBEG, NSV_AEREND
- PLBXSVM(:,:,:,JSV) = MAX(PLBXSVM(:,:,:,JSV), XSVMIN(JSV))
- END DO
- END IF
- IF ((SIZE(PLBYSVM,4) > NSV_AEREND-1).AND.(SIZE(PLBYSVM,1) /= 0)) THEN
- DO JSV=NSV_AERBEG, NSV_AEREND
- PLBYSVM(:,:,:,JSV) = MAX(PLBYSVM(:,:,:,JSV), XSVMIN(JSV))
- END DO
- END IF
-END IF
-!
-!------------------------------------------------------------------------------
-!
-!* 9. MINIMUM VALUE FOR DUSTS
-!
-IF (LDUST) THEN
- IF ((SIZE(PLBXSVM,4) > NSV_DSTEND-1).AND.(SIZE(PLBXSVM,1) /= 0)) THEN
- DO JSV=NSV_DSTBEG, NSV_DSTEND
- PLBXSVM(:,:,:,JSV) = MAX(PLBXSVM(:,:,:,JSV), XSVMIN(JSV))
- END DO
- END IF
- IF ((SIZE(PLBYSVM,4) > NSV_DSTEND-1).AND.(SIZE(PLBYSVM,1) /= 0)) THEN
- DO JSV=NSV_DSTBEG, NSV_DSTEND
- PLBYSVM(:,:,:,JSV) = MAX(PLBYSVM(:,:,:,JSV), XSVMIN(JSV))
- END DO
- END IF
-END IF
-!
-!------------------------------------------------------------------------------
-!
-!* 9. MINIMUM VALUE FOR SEA SALTS
-!
-IF (LSALT) THEN
- IF ((SIZE(PLBXSVM,4) > NSV_SLTEND-1).AND.(SIZE(PLBXSVM,1) /= 0)) THEN
- DO JSV=NSV_SLTBEG, NSV_SLTEND
- PLBXSVM(:,:,:,JSV) = MAX(PLBXSVM(:,:,:,JSV), XSVMIN(JSV))
- END DO
- END IF
- IF ((SIZE(PLBYSVM,4) > NSV_SLTEND-1).AND.(SIZE(PLBYSVM,1) /= 0)) THEN
- DO JSV=NSV_SLTBEG, NSV_SLTEND
- PLBYSVM(:,:,:,JSV) = MAX(PLBYSVM(:,:,:,JSV), XSVMIN(JSV))
- END DO
- END IF
-END IF
-!
-!------------------------------------------------------------------------------
-!
-!* 11. STORAGE IN BUDGET ARRAYS
-!
-IF (LBU_ENABLE) THEN
- !Division by nbustep to compute average on the selected time period
- if ( lbudget_u .or. lbudget_v .or. lbudget_w .or. lbudget_th &
- .or. lbudget_tke .or. lbudget_rv .or. lbudget_rc .or. lbudget_rr .or. lbudget_ri &
- .or. lbudget_rs .or. lbudget_rg .or. lbudget_rh .or. lbudget_sv ) then
- Allocate( zrhodjontime, mold = prhodj )
- Allocate( zwork, mold = prhodj )
- zrhodjontime(:, :, :) = prhodj(:, :, :) / ( ptstep * nbustep )
- end if
-
- if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'AVEF', put (:, :, :) * zrhodjontime(:, :, :) )
- if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'AVEF', pvt (:, :, :) * zrhodjontime(:, :, :) )
- if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W ), 'AVEF', pwt (:, :, :) * zrhodjontime(:, :, :) )
- if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH ), 'AVEF', ptht (:, :, :) * zrhodjontime(:, :, :) )
- if ( lbudget_tke ) call Budget_store_end( tbudgets(NBUDGET_TKE), 'AVEF', ptket(:, :, :) * zrhodjontime(:, :, :) )
- if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV ), 'AVEF', prt (:, :, :, 1) * zrhodjontime(:, :, :) )
- if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC ), 'AVEF', prt (:, :, :, 2) * zrhodjontime(:, :, :) )
- if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR ), 'AVEF', prt (:, :, :, 3) * zrhodjontime(:, :, :) )
- if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI ), 'AVEF', prt (:, :, :, 4) * zrhodjontime(:, :, :) )
- if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS ), 'AVEF', prt (:, :, :, 5) * zrhodjontime(:, :, :) )
- if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG ), 'AVEF', prt (:, :, :, 6) * zrhodjontime(:, :, :) )
- if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH ), 'AVEF', prt (:, :, :, 7) * zrhodjontime(:, :, :) )
- if ( lbudget_sv ) then
- do jsv = 1, ksv
- call Budget_store_end( tbudgets(jsv + NBUDGET_SV1 - 1), 'AVEF', psvt(:, :, :, jsv) * zrhodjontime(:, :, :) )
- end do
- end if
-
- if ( lbudget_u ) then
- zwork(:, :, :) = pus (:, :, :) * Mxm( prhodj(:, :, :) ) / ptstep
- call Budget_store_end( tbudgets(NBUDGET_U ), 'ENDF', zwork )
- call Budget_store_init( tbudgets(NBUDGET_U ), 'ASSE', zwork )
- end if
-
- if ( lbudget_v ) then
- zwork(:, :, :) = pvs (:, :, :) * Mym( prhodj(:, :, :) ) / ptstep
- call Budget_store_end( tbudgets(NBUDGET_V ), 'ENDF', zwork )
- call Budget_store_init( tbudgets(NBUDGET_V ), 'ASSE', zwork )
- end if
-
- if ( lbudget_w ) then
- zwork(:, :, :) = pws (:, :, :) * Mzm( prhodj(:, :, :) ) / ptstep
- call Budget_store_end( tbudgets(NBUDGET_W ), 'ENDF', zwork )
- call Budget_store_init( tbudgets(NBUDGET_W ), 'ASSE', zwork )
- end if
-
- if ( lbudget_th .or. lbudget_tke .or. lbudget_rv .or. lbudget_rc .or. lbudget_rr &
- .or. lbudget_ri .or. lbudget_rs .or. lbudget_rg .or. lbudget_rh .or. lbudget_sv ) then
- zrhodjontime(:, :, :) = prhodj(:, :, :) / ptstep
- end if
-
- if ( lbudget_th ) then
- zwork(:, :, :) = pths (:, :, :) * zrhodjontime(:, :, :)
- call Budget_store_end( tbudgets(NBUDGET_TH ), 'ENDF', zwork )
- call Budget_store_init( tbudgets(NBUDGET_TH ), 'ASSE', zwork )
- end if
-
- if ( lbudget_tke ) then
- zwork(:, :, :) = ptkes(:, :, :) * zrhodjontime(:, :, :)
- call Budget_store_end( tbudgets(NBUDGET_TKE), 'ENDF', zwork )
- call Budget_store_init( tbudgets(NBUDGET_TKE), 'ASSE', zwork )
- end if
-
- if ( lbudget_rv ) then
- zwork(:, :, :) = prs (:, :, :, 1) * zrhodjontime(:, :, :)
- call Budget_store_end( tbudgets(NBUDGET_RV ), 'ENDF', zwork )
- call Budget_store_init( tbudgets(NBUDGET_RV ), 'ASSE', zwork )
- end if
-
- if ( lbudget_rc ) then
- zwork(:, :, :) = prs (:, :, :, 2) * zrhodjontime(:, :, :)
- call Budget_store_end( tbudgets(NBUDGET_RC ), 'ENDF', zwork )
- call Budget_store_init( tbudgets(NBUDGET_RC ), 'ASSE', zwork )
- end if
-
- if ( lbudget_rr ) then
- zwork(:, :, :) = prs (:, :, :, 3) * zrhodjontime(:, :, :)
- call Budget_store_end( tbudgets(NBUDGET_RR ), 'ENDF', zwork )
- call Budget_store_init( tbudgets(NBUDGET_RR ), 'ASSE', zwork )
- end if
-
- if ( lbudget_ri ) then
- zwork(:, :, :) = prs (:, :, :, 4) * zrhodjontime(:, :, :)
- call Budget_store_end( tbudgets(NBUDGET_RI ), 'ENDF', zwork )
- call Budget_store_init( tbudgets(NBUDGET_RI ), 'ASSE', zwork )
- end if
-
- if ( lbudget_rs ) then
- zwork(:, :, :) = prs (:, :, :, 5) * zrhodjontime(:, :, :)
- call Budget_store_end( tbudgets(NBUDGET_RS ), 'ENDF', zwork )
- call Budget_store_init( tbudgets(NBUDGET_RS ), 'ASSE', zwork )
- end if
-
- if ( lbudget_rg ) then
- zwork(:, :, :) = prs (:, :, :, 6) * zrhodjontime(:, :, :)
- call Budget_store_end( tbudgets(NBUDGET_RG ), 'ENDF', zwork )
- call Budget_store_init( tbudgets(NBUDGET_RG ), 'ASSE', zwork )
- end if
-
- if ( lbudget_rh ) then
- zwork(:, :, :) = prs (:, :, :, 7) * zrhodjontime(:, :, :)
- call Budget_store_end( tbudgets(NBUDGET_RH ), 'ENDF', zwork )
- call Budget_store_init( tbudgets(NBUDGET_RH ), 'ASSE', zwork )
- end if
-
- if ( lbudget_sv ) then
- do jsv = 1, ksv
- zwork(:, :, :) = psvs(:, :, :, jsv) * zrhodjontime(:, :, :)
- call Budget_store_end( tbudgets(jsv + NBUDGET_SV1 - 1), 'ENDF', zwork )
- call Budget_store_init( tbudgets(jsv + NBUDGET_SV1 - 1), 'ASSE', zwork )
- end do
- end if
-
- if ( Allocated( zwork ) ) Deallocate( zwork )
- if ( Allocated( zrhodjontime ) ) Deallocate( zrhodjontime )
-END IF
-!
-!------------------------------------------------------------------------------
-!
-!* 12. COMPUTATION OF PHASE VELOCITY
-! -----------------------------
-!
-! It is temporarily set to a constant value
-!
-!------------------------------------------------------------------------------
-!
-!
-END SUBROUTINE ENDSTEP
diff --git a/src/mesonh/ext/flash_geom_elec.f90 b/src/mesonh/ext/flash_geom_elec.f90
deleted file mode 100644
index e6eea2d03c113ae02451da51869d6ce8c6da983f..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/flash_geom_elec.f90
+++ /dev/null
@@ -1,2873 +0,0 @@
-!MNH_LIC Copyright 2010-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_FLASH_GEOM_ELEC_n
-! #############################
-!
-INTERFACE
- SUBROUTINE FLASH_GEOM_ELEC_n (KTCOUNT, KMI, KRR, PTSTEP, OEXIT, &
- PRHODJ, PRHODREF, PRT, PCIT, PRSVS, PRS, PTHT, PPABST, &
- PEFIELDU, PEFIELDV, PEFIELDW, PZZ, PSVS_LINOX, &
- TPFILE_FGEOM_DIAG, TPFILE_FGEOM_COORD, TPFILE_LMA, &
- PTOWN, PSEA )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
-INTEGER, INTENT(IN) :: KMI ! current model index
-INTEGER, INTENT(IN) :: KRR ! number of moist variables
-REAL, INTENT(IN) :: PTSTEP ! Double time step except for
- ! cold start
-LOGICAL, INTENT(IN) :: OEXIT ! switch for the end of the temporal loop
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference dry air density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Moist variables at time t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Scalar variables source term
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDU ! x-component of the electric field
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDV ! y-component of the electric field
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDW ! z-component of the electric field
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variables vol. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta (K) at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSVS_LINOX ! NOx source term
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE_FGEOM_DIAG
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE_FGEOM_COORD
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE_LMA
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! town fraction
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land-sea mask
-!
-END SUBROUTINE FLASH_GEOM_ELEC_n
-END INTERFACE
-END MODULE MODI_FLASH_GEOM_ELEC_n
-!
-!
-! ######################################################################################
- SUBROUTINE FLASH_GEOM_ELEC_n (KTCOUNT, KMI, KRR, PTSTEP, OEXIT, &
- PRHODJ, PRHODREF, PRT, PCIT, PRSVS, PRS, PTHT, PPABST, &
- PEFIELDU, PEFIELDV, PEFIELDW, PZZ, PSVS_LINOX, &
- TPFILE_FGEOM_DIAG, TPFILE_FGEOM_COORD, TPFILE_LMA, &
- PTOWN, PSEA )
-! ######################################################################################
-!
-!!**** * -
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the lightning flash path,
-!! and to neutralize the electric charge along the lightning channel.
-!!
-!!
-!! METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! C. Barthe * LACy *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original : Jan. 2010
-!! Modifications:
-!! M. Chong * LA * Juin 2010 : add small ions
-!! J-P Pinty * LA * Feb. 2013 : add LMA storage
-!! J-P Pinty * LA * Nov. 2013 : add flash map storage
-!! M. Chong * LA * Juin 2010 : add LiNOx
-!! C. Barthe * LACy * Jan. 2015 : convert trig. pt into lat,lon in ascii file
-!! J.Escobar : 18/12/2015 : Correction of bug in bound in // for NHALO <>1
-!! J.Escobar : 28/03/2018 : Correction of multiple // bug & compiler indepedent mnh_random_number
-!! J.Escobar : 20/06/2018 : Correction of computation of global index I8VECT
-!! J.Escobar : 10/12/2018 : // Correction , mpi_bcast CG & CG_POS parameter
-!! & initialize INBLIGHT on all proc for filling/saving AREA* arrays
-! P. Wautelet 10/01/2019: use NEWUNIT argument of OPEN
-! P. Wautelet 22/01/2019: use standard FLUSH statement instead of non standard intrinsics!!
-! P. Wautelet 22/02/2019: use MOD intrinsics with same kind for all arguments (to respect Fortran standard)
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-! P. Wautelet 19/04/2019: use modd_precision kinds
-! P. Wautelet 26/04/2019: use modd_precision parameters for datatypes of MPI communications
-! 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
-! P. Wautelet 18/09/2019: correct support of 64bit integers (MNH_INT=8)
-! P. Wautelet 31/08/2022: remove ZXMASS and ZYMASS (use XXHATM and XYHATM instead)
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_ARGSLIST_ll, ONLY: LIST_ll
-USE MODD_CONF, ONLY: CEXP, LCARTESIAN
-USE MODD_CST, ONLY: XAVOGADRO, XMD
-USE MODD_DYN_n, ONLY: XDXHATM, XDYHATM, NSTOP
-USE MODD_ELEC_DESCR
-USE MODD_ELEC_FLASH
-USE MODD_ELEC_PARAM, ONLY: XFQLIGHTR, XEXQLIGHTR, &
- XFQLIGHTI, XEXQLIGHTI, &
- XFQLIGHTS, XEXQLIGHTS, &
- XFQLIGHTG, XEXQLIGHTG, &
- XFQLIGHTH, XEXQLIGHTH, &
- XFQLIGHTC
-USE MODD_GRID, ONLY: XLATORI,XLONORI
-USE MODD_GRID_n, ONLY: XXHATM, XYHATM, XZHAT
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LMA_SIMULATOR
-USE MODD_METRICS_n, ONLY: XDXX, XDYY, XDZZ ! in linox_production
-USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELECEND, NSV_ELEC
-USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
-use MODD_PRECISION, only: MNHINT_MPI, MNHLOG_MPI, MNHREAL_MPI
-USE MODD_RAIN_ICE_DESCR_n, ONLY: XLBR, XLBEXR, XLBS, XLBEXS, &
- XLBG, XLBEXG, XLBH, XLBEXH, &
- XRTMIN
-USE MODD_SUB_ELEC_n
-USE MODD_TIME_n
-USE MODD_VAR_ll, ONLY: NPROC,NMNH_COMM_WORLD
-!
-USE MODE_ELEC_ll
-USE MODE_GRIDPROJ
-USE MODE_ll
-USE MODE_MPPDB
-#ifdef MNH_PGI
-USE MODE_PACK_PGI
-#endif
-!
-USE MODI_ION_ATTACH_ELEC
-USE MODI_SHUMAN
-USE MODI_TO_ELEC_FIELD_n
-!
-IMPLICIT NONE
-!
-!
-! 0.1 Declaration of arguments
-!
-INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
-INTEGER, INTENT(IN) :: KMI ! current model index
-INTEGER, INTENT(IN) :: KRR ! number of moist variables
-REAL, INTENT(IN) :: PTSTEP ! Double time step except for
- ! cold start
-LOGICAL, INTENT(IN) :: OEXIT ! switch for the end of the temporal loop
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference dry air density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Moist variables at time t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Scalar variables source term
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDU ! x-component of the electric field
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDV ! y-component of the electric field
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDW ! z-component of the electric field
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variables vol. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta (K) at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSVS_LINOX ! NOx source term
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE_FGEOM_DIAG
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE_FGEOM_COORD
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE_LMA
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! town fraction
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land-sea mask
-!
-!
-! 0.2 Declaration of local variables
-!
-INTEGER :: IIB, IIE ! index values of the first and last inner mass points along x
-INTEGER :: IJB, IJE ! index values of the first and last inner mass points along y
-INTEGER :: IKB, IKE ! index values of the first and last inner mass points along z
-INTEGER :: II, IJ, IK, IL, IM, IPOINT ! loop indexes
-INTEGER :: IX, IY, IZ
-INTEGER :: IXOR, IYOR ! origin of the extended subdomain
-INTEGER :: INB_CELL ! Number of detected electrified cells
-INTEGER :: IPROC_CELL ! Proc with the center of the cell
-INTEGER :: IICOORD, IJCOORD, IKCOORD ! local indexes of the cell center / max electric field
-INTEGER :: IPROC ! my proc number
-INTEGER :: IINFO_ll ! return code of parallel routine
-INTEGER :: COUNT_BEF ! nb of pts in zcell before testing neighbour pts
-INTEGER :: COUNT_AFT ! nb of pts in zcell after testing neighbour pts
-INTEGER :: INBFTS_MAX ! Max number of flashes per time step / cell
-INTEGER :: IIBL_LOC ! local i index of the ongoing bi-leader segment
-INTEGER :: IJBL_LOC ! local j index of the ongoing bi-leader segment
-INTEGER :: IKBL ! k index of the ongoing bi-leader segment
-INTEGER :: II_TRIG_LOC ! local i index of the triggering point
-INTEGER :: IJ_TRIG_LOC ! local j index of the triggering point
-INTEGER :: II_TRIG_GLOB ! global i index of the potential triggering pt
-INTEGER :: IJ_TRIG_GLOB ! global j index of the potential triggering pt
-INTEGER :: IK_TRIG ! k index of the triggering point
-INTEGER :: ISIGN_LEADER ! sign of the leader
-INTEGER :: IPROC_AUX ! proc number for max_ll and min_ll
-INTEGER :: IIND_MAX ! max nb of indexes between the trig. pt and the possible branches
-INTEGER :: IIND_MIN ! min nb of indexes between the trig. pt and the possible branches
-INTEGER :: IDELTA_IND ! number of indexes between iind_max and iind_min
-INTEGER :: IPT_DIST ! nb of possible pts for branching on each proc
-INTEGER :: IPT_DIST_GLOB ! global nb of possible pts for branching
-INTEGER :: IFOUND ! if =1, then the random selection is successful
-INTEGER :: ICHOICE_LOCX ! local i indice for random choice
-INTEGER :: ICHOICE_LOCY ! local j indice for random choice
-INTEGER :: ICHOICE_Z ! k indice for random choice
-INTEGER :: INB_PROP ! nb of pts where the flash can propagate
-INTEGER :: INB_NEUT ! nb of pts to neutralize
-INTEGER :: INB_NEUT_OK ! nb of effective flash neutralization
-INTEGER :: ISTOP
-INTEGER :: IERR ! error status
-INTEGER :: IWORK
-INTEGER :: ICHOICE
-INTEGER :: IIMIN, IIMAX, IJMIN, IJMAX, IKMIN, IKMAX
-INTEGER :: IPOS_LEADER, INEG_LEADER
-INTEGER :: INBLIGHT
-INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: ITYPE ! flash type (IC, CGN or CGP)
-INTEGER, DIMENSION(:), ALLOCATABLE :: INBSEG_LEADER ! number of segments in the leader
-INTEGER, DIMENSION(:), ALLOCATABLE :: ISIGNE_EZ ! sign of the vertical electric field
- ! component at the trig. pt
-INTEGER, DIMENSION(:), ALLOCATABLE :: IPROC_TRIG ! proc that contains the triggering point
-INTEGER, DIMENSION(:), ALLOCATABLE :: INBSEG ! Number of segments per flash
-INTEGER, DIMENSION(:), ALLOCATABLE :: INBSEG_ALL ! Number of segments, all processes
-INTEGER, DIMENSION(NPROC) :: INBSEG_PROC ! ------------------ per process
-INTEGER, DIMENSION(:), ALLOCATABLE :: INB_FLASH ! Number of flashes per time step / cell
-INTEGER, DIMENSION(:), ALLOCATABLE :: INB_FL_REAL ! Effective Number of flashes per timestep/cell
-INTEGER, DIMENSION(:), ALLOCATABLE :: IHIST_LOC ! local nb of possible branches at [r,r+dr]
-INTEGER, DIMENSION(:), ALLOCATABLE :: IHIST_GLOB ! global nb of possible branches at [r,r+dr]
- ! at [r,r+dr] on each proc
-INTEGER, DIMENSION(:), ALLOCATABLE :: IMAX_BRANCH ! max nb of branches at [r,r+dr]
- ! proportional to the percentage of
- ! available pts / proc at this distance
-INTEGER, DIMENSION(:,:), ALLOCATABLE :: ISEG_LOC ! Local indexes of the flash segments
-INTEGER, DIMENSION(:,:), ALLOCATABLE :: ICELL_LOC ! local indexes + proc of the cell 'center'
-INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: IMASKQ_DIST ! contains the distance/indice
- ! from the triggering pt
-!
-LOGICAL :: GPOSITIVE ! if T, positive charge regions where the negative part
- ! of the leader propagates
-LOGICAL :: GEND_DOMAIN ! no more points with E > E_threshold
-LOGICAL :: GEND_CELL ! if T, end of the cell
-LOGICAL :: GCG ! if true, the flash is a CG
-LOGICAL :: GCG_POS ! if true, the flash is a +CG
-LOGICAL :: GNEUTRALIZATION
-LOGICAL :: GNEW_FLASH_GLOB
-LOGICAL, DIMENSION(:), ALLOCATABLE :: GNEW_FLASH
-LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: GATTACH ! if T, ion recombination and
- ! attachment
-LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: GPOSS ! if T, new cell possible at this pt
-LOGICAL, DIMENSION(:,:,:,:), ALLOCATABLE :: GPROP ! if T, propagation possible at this pt
-!
-REAL :: ZE_TRIG_THRES ! Triggering Electric field threshold corrected for
- ! pressure
-REAL :: ZMAXE ! Max electric field module (V/m)
-REAL :: ZEMOD_BL ! E module at the tip of the last segment of the leader (V/m)
-REAL :: ZMEAN_GRID ! mean grid size
-REAL :: ZMAX_DIST ! max distance between the triggering pt and the possible branches
-REAL :: ZMIN_DIST ! min distance between the triggering pt and the possible branches
-REAL :: ZRANDOM ! random number
-REAL :: ZQNET ! net charge carried by the flash (C/kg)
-REAL :: ZCLOUDLIM ! cloud limit
-REAL :: ZSIGMIN ! min efficient cross section
-REAL :: ZLAT, ZLON ! lat,lon coordinates of the triggering points if not lcartesian
-!
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZQMT ! mass charge density (C/kg)
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCELL ! define the electrified cells
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSIGMA ! efficient cross section of hydrometeors
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZDQDT ! charge to neutralize at each pt (C/kg)
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZFLASH ! = 1 if the flash leader reaches this pt
- ! = 2 if the flash branch is concerned
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBDAR ! Lambda for rain
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBDAS ! Lambda for snow
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBDAG ! Lambda for graupel
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBDAH ! Lambda for hail
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZQMTOT ! total mass charge density (C/kg)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCLOUD ! total mixing ratio (kg/kg)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEMODULE ! Electric field module (V/m)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDIST ! distance between the trig. pt and the cell pts (m)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSIGLOB ! sum of the cross sections
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZQFLASH ! total charge in excess of xqexcess (C/kg)
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOORD_TRIG ! Global coordinates of triggering point
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOORD_SEG ! Global coordinates of segments
-REAL, DIMENSION(:), ALLOCATABLE :: ZEM_TRIG ! Electric field module at the triggering pt
-REAL, DIMENSION(:), ALLOCATABLE :: ZNEUT_POS ! Positive charge neutralized at each segment
-REAL, DIMENSION(:), ALLOCATABLE :: ZNEUT_NEG ! Negative charge neutralized at each segment
-INTEGER, DIMENSION(:,:), ALLOCATABLE :: ISEG_GLOB ! Global indexes of LMA segments
-INTEGER, DIMENSION(:,:), ALLOCATABLE :: ILMA_SEG_ALL ! Global indexes of LMA segments
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZLMA_QMT ! Particle charge at neutralization point
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZLMA_PRT ! Particle mixing ratio at neutralization point
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZLMA_NEUT_POS
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZLMA_NEUT_NEG
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOORD_SEG_ALL
-REAL, DIMENSION(:), ALLOCATABLE :: ZEMAX ! Max electric field in each cell
-REAL, DIMENSION(:), ALLOCATABLE :: ZHIST_PERCENT ! percentage of possible branches at [r,r+dr] on each proc
-REAL, DIMENSION(:), ALLOCATABLE :: ZMAX_BRANCH ! max nb of branches at [r,r+dr]
-REAL, DIMENSION(:), ALLOCATABLE :: ZVECT
-!
-! Storage for nflash_write flashes before writing output files (denoted xSxxx)
-INTEGER, SAVE :: ISAVE_STATUS ! 0: print and save
- ! 1: save only
- ! 2: print only
-!
-TYPE(LIST_ll), POINTER :: TZFIELDS_ll=> NULL() ! list of fields to exchange
-!
-! Storage for the localization of the flashes
-LOGICAL :: GFIRSTFLASH
-INTEGER,DIMENSION(SIZE(PRT,1),SIZE(PRT,2)) :: IMAP2D
-!
-! Storage for the NOx production terms
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLNOX
-REAL :: ZLGHTLENGTH, ZCOEF
-INTEGER :: IFLASH_COUNT, IFLASH_COUNT_GLOB ! Total number of flashes within the timestep
-!
-REAL,DIMENSION(SIZE(PRT,1),SIZE(PRT,2)) :: ZCELL_NEW
-!
-INTEGER :: ILJ
-INTEGER :: NIMAX_ll, NJMAX_ll,IIU_ll,IJU_ll ! dimensions of global domain
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. INITIALIZATION
-! --------------
-CALL MYPROC_ELEC_ll(IPROC)
-!
-!* 1.1 subdomains indexes
-!
-! beginning and end indexes of the physical subdomain
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IKB = 1 + JPVEXT
-IKE = SIZE(PRT,3) - JPVEXT
-!
-! global indexes of the local subdomains origin
-CALL GET_GLOBALDIMS_ll (NIMAX_ll,NJMAX_ll)
-CALL GET_OR_ll('B',IXOR,IYOR)
-IIU_ll = NIMAX_ll + 2*JPHEXT
-IJU_ll = NJMAX_ll + 2*JPHEXT
-!
-!
-!* 1.2 allocations and initializations
-!
-!
-! from the litterature, the max number of flash per minute is ~ 1000
-! this value is used here as the max number of flash per minute per cell
-INBFTS_MAX = ANINT(1000 * PTSTEP / 60)
-!
-IF (GEFIRSTCALL) THEN
- GEFIRSTCALL = .FALSE.
- ALLOCATE (ZZMASS(SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3)))
- ALLOCATE (ZPRES_COEF(SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3)))
- IF(LLMA) THEN
- ALLOCATE (ZLMA_LAT(NFLASH_WRITE, NBRANCH_MAX))
- ALLOCATE (ZLMA_LON(NFLASH_WRITE, NBRANCH_MAX))
- ALLOCATE (ZSLMA_NEUT_POS(NFLASH_WRITE, NBRANCH_MAX))
- ALLOCATE (ZSLMA_NEUT_NEG(NFLASH_WRITE, NBRANCH_MAX))
- ALLOCATE (ISLMA_SEG_GLOB(NFLASH_WRITE, NBRANCH_MAX, 3))
- ALLOCATE (ZSLMA_QMT(NFLASH_WRITE, NBRANCH_MAX, SIZE(PRSVS,4)))
- ALLOCATE (ZSLMA_PRT(NFLASH_WRITE, NBRANCH_MAX, SIZE(PRSVS,4)))
- ISLMA_SEG_GLOB(:,:,:) = 0
- END IF
- ALLOCATE (ZSCOORD_SEG(NFLASH_WRITE, NBRANCH_MAX, 3)) ! NFLASH_WRITE nb of flash to be stored
- ! before writing in files
- ! NBRANCH_MAX=5000 default
- ALLOCATE (ISFLASH_NUMBER(0:NFLASH_WRITE))
- ALLOCATE (ISNB_FLASH(NFLASH_WRITE))
- ALLOCATE (ISCELL_NUMBER(NFLASH_WRITE))
- ALLOCATE (ISNBSEG(NFLASH_WRITE))
- ALLOCATE (ISTCOUNT_NUMBER(NFLASH_WRITE))
- ALLOCATE (ISTYPE(NFLASH_WRITE))
- ALLOCATE (ZSEM_TRIG(NFLASH_WRITE))
- ALLOCATE (ZSNEUT_POS(NFLASH_WRITE))
- ALLOCATE (ZSNEUT_NEG(NFLASH_WRITE))
-!
- ZZMASS = MZF(PZZ)
- ZPRES_COEF = EXP(ZZMASS/8400.)
- ZSCOORD_SEG(:,:,:) = 0.0
- ISAVE_STATUS = 1
- ISFLASH_NUMBER(:) = 0
-END IF
-!
-ALLOCATE (ZQMT(SIZE(PRSVS,1),SIZE(PRSVS,2),SIZE(PRSVS,3),SIZE(PRSVS,4)))
-ALLOCATE (ZQMTOT(SIZE(PRSVS,1),SIZE(PRSVS,2),SIZE(PRSVS,3)))
-ALLOCATE (ZCLOUD(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
-ALLOCATE (GPOSS(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
-ALLOCATE (ZEMODULE(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
-ALLOCATE (ZCELL(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),NMAX_CELL))
-
-!
-ZQMT(:,:,:,:) = 0.
-ZQMTOT(:,:,:) = 0.
-ZCLOUD(:,:,:) = 0.
-GPOSS(:,:,:) = .FALSE.
-GPOSS(IIB:IIE,IJB:IJE,IKB:IKE) = .TRUE.
-ZEMODULE(:,:,:) = 0.
-ZCELL(:,:,:,:) = 0.
-!
-!
-!* 1.3 point discharge (Corona)
-!
-PRSVS(:,:,:,1) = XECHARGE * PRSVS(:,:,:,1) ! C /(m3 s)
-PRSVS(:,:,:,NSV_ELEC) = -1. * XECHARGE * PRSVS(:,:,:,NSV_ELEC) ! C /(m3 s)
-!
-CALL PT_DISCHARGE
-!
-!
-!* 1.4 total charge density and mixing ratio
-!
-DO II = 1, NSV_ELEC
-! transform the source term (C/s) into the updated charge density (C/kg)
- ZQMT(:,:,:,II) = PRSVS(:,:,:,II) * PTSTEP / PRHODJ(:,:,:)
-!
-! total mass charge density (C/kg)
- ZQMTOT(:,:,:) = ZQMTOT(:,:,:) + PRSVS(:,:,:,II) * PTSTEP / PRHODJ(:,:,:)
-END DO
-!
-! total mixing ratio (g/kg)
-DO II = 2, KRR
- ZCLOUD(:,:,:) = ZCLOUD(:,:,:) + PRT(:,:,:,II)
-END DO
-!
-!
-!* 1.5 constants
-!
-ZCLOUDLIM = 1.E-5
-ZSIGMIN = 1.E-12
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. FIND AND COUNT THE ELECTRIFIED CELLS
-! ------------------------------------
-!
-ALLOCATE (ZEMAX(NMAX_CELL))
-ALLOCATE (ICELL_LOC(4,NMAX_CELL))
-!
-ZEMAX(:) = 0.
-ICELL_LOC(:,:) = 0
-!
-WHERE (ZCLOUD(IIB:IIE,IJB:IJE,IKB:IKE) .LE. ZCLOUDLIM)
- GPOSS(IIB:IIE,IJB:IJE,IKB:IKE) = .FALSE.
-END WHERE
-!
-!
-!* 2.1 find the maximum electric field
-!
-GEND_DOMAIN = .FALSE.
-GEND_CELL = .FALSE.
-INB_CELL = 0
-ZE_TRIG_THRES = XETRIG * (1. - XEBALANCE)
-!
-CALL MPPDB_CHECK3DM("flash:: PRHODJ,PRT",PRECISION,&
- PRHODJ,PRT(:,:,:,1),PRT(:,:,:,2),PRT(:,:,:,3),PRT(:,:,:,4),&
- PRT(:,:,:,5),PRT(:,:,:,6))
-CALL MPPDB_CHECK3DM("flash:: ZQMT",PRECISION,&
- ZQMT(:,:,:,1),ZQMT(:,:,:,2),ZQMT(:,:,:,3),ZQMT(:,:,:,4),&
- ZQMT(:,:,:,5),ZQMT(:,:,:,6),ZQMT(:,:,:,7))
-
-CALL TO_ELEC_FIELD_n (PRT, ZQMT, PRHODJ, KTCOUNT, KRR, &
- PEFIELDU, PEFIELDV, PEFIELDW)
-CALL MPPDB_CHECK3DM("flash:: PEFIELDU, PEFIELDV, PEFIELDW",PRECISION,&
- PEFIELDU, PEFIELDV, PEFIELDW)
-!
-! electric field module including pressure effect
-ZEMODULE(IIB:IIE,IJB:IJE,IKB:IKE) = ZPRES_COEF(IIB:IIE,IJB:IJE,IKB:IKE)* &
- (PEFIELDU(IIB:IIE,IJB:IJE,IKB:IKE)**2 + &
- PEFIELDV(IIB:IIE,IJB:IJE,IKB:IKE)**2 + &
- PEFIELDW(IIB:IIE,IJB:IJE,IKB:IKE)**2)**0.5
-!
-DO WHILE (.NOT. GEND_DOMAIN .AND. INB_CELL .LT. NMAX_CELL)
-!
-! find the maximum electric field on each proc
- IF (COUNT(GPOSS(IIB:IIE,IJB:IJE,IKB:IKE)) .GT. 0) THEN
- ZMAXE = MAXVAL(ZEMODULE(IIB:IIE,IJB:IJE,IKB:IKE), MASK=GPOSS(IIB:IIE,IJB:IJE,IKB:IKE))
- ELSE
- ZMAXE = 0.
- END IF
-!
-! find the max electric field on the whole domain + the proc that contains this value
- CALL MAX_ELEC_ll (ZMAXE, IPROC_CELL)
-!
- IF (ZMAXE .GT. ZE_TRIG_THRES) THEN
- INB_CELL = INB_CELL + 1 ! one cell is detected
- ZEMAX(INB_CELL) = ZMAXE
-! local coordinates of the maximum electric field
- ICELL_LOC(1:3,INB_CELL) = MAXLOC(ZEMODULE, MASK=GPOSS )
- IICOORD = ICELL_LOC(1,INB_CELL)
- IJCOORD = ICELL_LOC(2,INB_CELL)
- ICELL_LOC(1,INB_CELL) = IICOORD + IXOR -1
- ICELL_LOC(2,INB_CELL) = IJCOORD + IYOR -1
- IKCOORD = ICELL_LOC(3,INB_CELL)
- ICELL_LOC(4,INB_CELL) = IPROC_CELL
-!
-! Broadcast the center of the cell to all procs
- CALL MPI_BCAST (ICELL_LOC(:,INB_CELL), 4, MNHINT_MPI, IPROC_CELL, &
- NMNH_COMM_WORLD, IERR)
-!
-!
-!* 2.2 horizontal extension of the cell
-!
- DO IK = IKB, IKE
- IF (IPROC_CELL .EQ. IPROC) THEN
- IF (GPOSS(IICOORD,IJCOORD,IK)) THEN
- ZCELL(IICOORD,IJCOORD,IK,INB_CELL) = 1.
- GPOSS(IICOORD,IJCOORD,IK) = .FALSE.
- END IF
- END IF
-!
-!* 2.2.1 do the neighbour points have q_tot > q_thresh?
-!
- GEND_CELL = .FALSE.
- DO WHILE (.NOT. GEND_CELL)
-!
- CALL ADD2DFIELD_ll ( TZFIELDS_ll, ZCELL(:,:,IK,INB_CELL), 'FLASH_GEOM_ELEC_n::ZCELL(:,:,IK,INB_CELL)' )
- CALL UPDATE_HALO_ll ( TZFIELDS_ll, IINFO_ll )
- CALL CLEANLIST_ll ( TZFIELDS_ll )
-!
- COUNT_BEF = COUNT(ZCELL(IIB:IIE,IJB:IJE,IK,INB_CELL) .EQ. 1.)
- CALL SUM_ELEC_ll (COUNT_BEF)
-!
- ZCELL_NEW = ZCELL(:,:,IK,INB_CELL)
- DO II = IIB, IIE
- DO IJ = IJB, IJE
- IF ((ZCELL(II,IJ,IK,INB_CELL) .EQ. 0.) .AND. &
- (GPOSS(II,IJ,IK)) .AND. &
- (ZCLOUD(II,IJ,IK) .GT. 1.E-5) .AND. &
- ((ABS(ZQMT(II,IJ,IK,2)) * PRHODREF(II,IJ,IK) .GT. XQEXCES).OR. &
- (ABS(ZQMT(II,IJ,IK,3)) * PRHODREF(II,IJ,IK) .GT. XQEXCES).OR. &
- (ABS(ZQMT(II,IJ,IK,4)) * PRHODREF(II,IJ,IK) .GT. XQEXCES).OR. &
- (ABS(ZQMT(II,IJ,IK,5)) * PRHODREF(II,IJ,IK) .GT. XQEXCES).OR. &
- (ABS(ZQMT(II,IJ,IK,6)) * PRHODREF(II,IJ,IK) .GT. XQEXCES)) )THEN
-!
- IF ((ZCELL(II-1,IJ, IK,INB_CELL) .EQ. 1.) .OR. &
- (ZCELL(II+1,IJ, IK,INB_CELL) .EQ. 1.) .OR. &
- (ZCELL(II, IJ-1,IK,INB_CELL) .EQ. 1.) .OR. &
- (ZCELL(II, IJ+1,IK,INB_CELL) .EQ. 1.) .OR. &
- (ZCELL(II-1,IJ-1,IK,INB_CELL) .EQ. 1.) .OR. &
- (ZCELL(II-1,IJ+1,IK,INB_CELL) .EQ. 1.) .OR. &
- (ZCELL(II+1,IJ+1,IK,INB_CELL) .EQ. 1.) .OR. &
- (ZCELL(II+1,IJ-1,IK,INB_CELL) .EQ. 1.)) THEN
- GPOSS(II,IJ,IK) = .FALSE.
- ZCELL_NEW(II,IJ) = 1.
- END IF
- END IF
- END DO
- END DO
- ZCELL(:,:,IK,INB_CELL) = ZCELL_NEW
-!
- COUNT_AFT = COUNT(ZCELL(IIB:IIE,IJB:IJE,IK,INB_CELL) .EQ. 1.)
- CALL SUM_ELEC_ll(COUNT_AFT)
-!
- IF (COUNT_BEF .EQ. COUNT_AFT) THEN
- GEND_CELL = .TRUE. ! no more point in the cell at this level
- ELSE
- GEND_CELL = .FALSE.
- END IF
- END DO ! end loop gend_cell
- END DO ! end loop ik
-!
-! avoid cell detection in the colums where a previous cell is already present
- DO II = IIB, IIE
- DO IJ = IJB, IJE
- DO IK = IKB, IKE
- IF (ZCELL(II,IJ,IK,INB_CELL) .EQ. 1.) GPOSS(II,IJ,:) = .FALSE.
- END DO
- END DO
- END DO
- ELSE
- GEND_DOMAIN = .TRUE. ! no more points with E > E_threshold
- END IF ! max E
-END DO ! end loop gend_domain
-!
-DEALLOCATE (GPOSS)
-DEALLOCATE (ZEMAX)
-!
-!
-!* 2.3 if at least 1 cell, allocate arrays
-!
-IF (INB_CELL .GE. 1) THEN
-!
-! mean mesh size
- ZMEAN_GRID = (XDXHATM**2 + XDYHATM**2 + &
- ( ( XZHAT(UBOUND(XZHAT,1)) - XZHAT(1) ) / (SIZE(PRT,3)-1.) )**2 )**0.5
-! chaque proc calcule son propre zmean_grid
-! mais cette valeur peut etre differente sur chaque proc (ex: relief)
-! laisse tel quel pour le moment
-!
- ALLOCATE (ISEG_LOC(3*SIZE(PRT,3), INB_CELL)) ! 3 coord indices of the leader
- ALLOCATE (ZCOORD_TRIG(3, INB_CELL))
- ALLOCATE (ZCOORD_SEG(NBRANCH_MAX*3, INB_CELL))
- ! NBRANCH_MAX=5000 default
- ! 3= 3 coord index
- ALLOCATE (ZCOORD_SEG_ALL(NBRANCH_MAX*3, INB_CELL))
- ALLOCATE (ISEG_GLOB(NBRANCH_MAX*3, INB_CELL))
- ISEG_GLOB(:,:) = 0
-!
- IF(LLMA) THEN
- ALLOCATE (ILMA_SEG_ALL (NBRANCH_MAX*3, INB_CELL))
- ALLOCATE (ZLMA_QMT(NBRANCH_MAX*NSV_ELEC, INB_CELL)) ! charge des part.
- ! a neutraliser
- ALLOCATE (ZLMA_PRT(NBRANCH_MAX*NSV_ELEC, INB_CELL)) ! mixing ratio
- ALLOCATE (ZLMA_NEUT_POS(NBRANCH_MAX, INB_CELL))
- ALLOCATE (ZLMA_NEUT_NEG(NBRANCH_MAX, INB_CELL))
- ZLMA_QMT(:,:) = 0.
- ZLMA_PRT(:,:) = 0.
- ZLMA_NEUT_POS(:,:) = 0.
- ZLMA_NEUT_NEG(:,:) = 0.
- END IF
-!
- IF (LLNOX_EXPLICIT) THEN
- ALLOCATE (ZLNOX(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
- ZLNOX(:,:,:) = 0.
- END IF
-!
- ALLOCATE (ZEM_TRIG(INB_CELL))
- ALLOCATE (INB_FLASH(INB_CELL))
- ALLOCATE (INB_FL_REAL(INB_CELL))
- ALLOCATE (INBSEG(INB_CELL))
- ALLOCATE (INBSEG_ALL(INB_CELL))
- ALLOCATE (ITYPE(INB_CELL))
- ALLOCATE (INBSEG_LEADER(INB_CELL))
- ALLOCATE (ZDQDT(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),SIZE(PRT,4)+1))
- ALLOCATE (ZSIGMA(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),SIZE(PRT,4)-1))
- ALLOCATE (ZLBDAR(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
- ALLOCATE (ZLBDAS(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
- ALLOCATE (ZLBDAG(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
- IF (KRR == 7) ALLOCATE (ZLBDAH(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
- ALLOCATE (ZSIGLOB(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
- ALLOCATE (ZFLASH(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),INB_CELL))
- ALLOCATE (ZDIST(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
- ALLOCATE (ZQFLASH(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
- ALLOCATE (GATTACH(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
-!
- ISEG_LOC(:,:) = 0
- ZCOORD_TRIG(:,:) = 0.
- ZCOORD_SEG(:,:) = 0.
- ZDQDT(:,:,:,:) = 0.
- ZSIGMA(:,:,:,:) = 0.
- ZLBDAR(:,:,:) = 0.
- ZLBDAS(:,:,:) = 0.
- ZLBDAG(:,:,:) = 0.
- ZSIGLOB(:,:,:) = 0.
- ZFLASH(:,:,:,:) = 0.
- ZDIST(:,:,:) = 0.
- ZQFLASH(:,:,:) = 0.
- ZEM_TRIG(:) = 0.
- INB_FLASH(:) = 0
- INB_FL_REAL(:) = 0
- INBSEG(:) = 0
- INBSEG_ALL(:) = 0
- INBSEG_PROC(:) = 0
- INBSEG_LEADER(:) = 0
- ITYPE(:) = 1 ! default = IC
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. COMPUTE THE EFFICIENT CROSS SECTIONS OF HYDROMETEORS
-! ----------------------------------------------------
-!
-!* 3.1 for cloud droplets
-!
- WHERE (PRT(:,:,:,2) > ZCLOUDLIM)
- ZSIGMA(:,:,:,1) = XFQLIGHTC * PRHODREF(:,:,:) * PRT(:,:,:,2)
- ENDWHERE
-!
-!
-!* 3.2 for raindrops
-!
- WHERE (PRT(:,:,:,3) > 0.0)
- ZLBDAR(:,:,:) = XLBR * (PRHODREF(:,:,:) * &
- MAX(PRT(:,:,:,3),XRTMIN(3)))**XLBEXR
- END WHERE
-!
- WHERE (PRT(:,:,:,3) > ZCLOUDLIM .AND. ZLBDAR(:,:,:) < XLBDAR_MAXE .AND. &
- ZLBDAR(:,:,:) > 0.)
- ZSIGMA(:,:,:,2) = XFQLIGHTR * ZLBDAR(:,:,:)**XEXQLIGHTR
- END WHERE
-!
-!
-!* 3.3 for ice crystals
-!
- WHERE (PRT(:,:,:,4) > ZCLOUDLIM .AND. PCIT(:,:,:) > 1.E4)
- ZSIGMA(:,:,:,3) = XFQLIGHTI * PCIT(:,:,:)**(1.-XEXQLIGHTI) * &
- ((PRHODREF(:,:,:) * PRT(:,:,:,4))**XEXQLIGHTI)
- ENDWHERE
-!
-!
-!* 3.4 for snow
-!
- WHERE (PRT(:,:,:,5) > 0.0)
- ZLBDAS(:,:,:) = MIN(XLBDAS_MAXE, &
- XLBS * (PRHODREF(:,:,:) * &
- MAX(PRT(:,:,:,5),XRTMIN(5)))**XLBEXS)
- END WHERE
-!
- WHERE (PRT(:,:,:,5) > ZCLOUDLIM .AND. ZLBDAS(:,:,:) < XLBDAS_MAXE .AND. &
- ZLBDAS(:,:,:) > 0.)
- ZSIGMA(:,:,:,4) = XFQLIGHTS * ZLBDAS(:,:,:)**XEXQLIGHTS
- ENDWHERE
-!
-!
-!* 3.5 for graupel
-!
- WHERE (PRT(:,:,:,6) > 0.0)
- ZLBDAG(:,:,:) = XLBG * (PRHODREF(:,:,:) * MAX(PRT(:,:,:,6),XRTMIN(6)))**XLBEXG
- END WHERE
-!
- WHERE (PRT(:,:,:,6) > ZCLOUDLIM .AND. ZLBDAG(:,:,:) < XLBDAG_MAXE .AND. &
- ZLBDAG(:,:,:) > 0.)
- ZSIGMA(:,:,:,5) = XFQLIGHTG * ZLBDAG(:,:,:)**XEXQLIGHTG
- ENDWHERE
-!
-!
-!* 3.6 for hail
-!
- IF (KRR == 7) THEN
- WHERE (PRT(:,:,:,7) > 0.0)
- ZLBDAH(:,:,:) = XLBH * (PRHODREF(:,:,:) * &
- MAX(PRT(:,:,:,7), XRTMIN(7)))**XLBEXH
- END WHERE
-!
- WHERE (PRT(:,:,:,7) > ZCLOUDLIM .AND. ZLBDAH(:,:,:) < XLBDAH_MAXE .AND. &
- ZLBDAH(:,:,:) > 0.)
- ZSIGMA(:,:,:,6) = XFQLIGHTH * ZLBDAH(:,:,:)**XEXQLIGHTH
- ENDWHERE
- END IF
-!
-!
-!* 3.7 sum of the efficient cross sections
-!
- ZSIGLOB(:,:,:) = ZSIGMA(:,:,:,1) + ZSIGMA(:,:,:,2) + ZSIGMA(:,:,:,3) + &
- ZSIGMA(:,:,:,4) + ZSIGMA(:,:,:,5)
-!
- IF (KRR == 7) ZSIGLOB(:,:,:) = ZSIGLOB(:,:,:) + ZSIGMA(:,:,:,6)
-!
-IF (KRR == 7) THEN
- CALL MPPDB_CHECK3DM("flash:: ZLBDAR,ZLBDAS,ZLBDAG,ZLBDAH",PRECISION,&
- ZLBDAR,ZLBDAS,ZLBDAG,ZLBDAH,&
- ZSIGMA(:,:,:,1),ZSIGMA(:,:,:,2),ZSIGMA(:,:,:,3),ZSIGMA(:,:,:,4),&
- ZSIGMA(:,:,:,5),ZSIGMA(:,:,:,6))
-ELSE
- CALL MPPDB_CHECK3DM("flash:: ZLBDAR,ZLBDAS,ZLBDAG",PRECISION,&
- ZLBDAR,ZLBDAS,ZLBDAG,&
- ZSIGMA(:,:,:,1),ZSIGMA(:,:,:,2),ZSIGMA(:,:,:,3),ZSIGMA(:,:,:,4),&
- ZSIGMA(:,:,:,5))
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. FIND THE TRIGGERING POINT IN EACH CELL
-! --------------------------------------
-!
- ALLOCATE (IPROC_TRIG(INB_CELL))
- ALLOCATE (ISIGNE_EZ(INB_CELL))
- ALLOCATE (GNEW_FLASH(INB_CELL))
- ALLOCATE (ZNEUT_POS(INB_CELL))
- ALLOCATE (ZNEUT_NEG(INB_CELL))
-!
- IPROC_TRIG(:) = 0
- ISIGNE_EZ(:) = 0
- GNEW_FLASH(:) = .FALSE.
- ZNEUT_POS(:) = 0.
- ZNEUT_NEG(:) = 0.
-!
- CALL TRIG_POINT
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. FLASH TRIGGERING
-! ----------------
-!
- IFLASH_COUNT = 0
- IFLASH_COUNT_GLOB = 0
-!
- DO WHILE (GNEW_FLASH_GLOB)
-!
- GATTACH(:,:,:) = .FALSE.
-!
- DO IL = 1, INB_CELL
- IF (GNEW_FLASH(IL)) THEN
- ZFLASH(:,:,:,IL) = 0.
-! update lightning informations
- INB_FLASH(IL) = INB_FLASH(IL) + 1 ! nb of flashes / cell / time step
- INB_FL_REAL(IL) = INB_FL_REAL(IL) + 1 ! nb of flashes / cell / time step
- INBSEG(IL) = 0 ! nb of segments / flash
- ITYPE(IL) = 1
-!
- IF (IPROC .EQ. IPROC_TRIG(IL)) THEN
- ZEMOD_BL = ZEM_TRIG(IL)
- IIBL_LOC = ISEG_LOC(1,IL)
- IJBL_LOC = ISEG_LOC(2,IL)
- IKBL = ISEG_LOC(3,IL)
-!
- INBSEG(IL) = 1 ! nb of segments / flash
- ZFLASH(IIBL_LOC,IJBL_LOC,IKBL,IL) = 1.
- ENDIF
-!
- GCG = .FALSE.
- GCG_POS = .FALSE.
-
- CALL MPPDB_CHECK3DM("flash:: 4. ZFLASH(IL)",PRECISION,&
- ZFLASH(:,:,:,IL))
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 5. PROPAGATE THE BIDIRECTIONAL LEADER
-! ----------------------------------
-!
-! it is assumed that the leader propagates only along the vertical
-!
-!* 5.1 positive segments
-!
-! the positive leader propagates parallel to the electric field
- ISIGN_LEADER = 1
- CALL ONE_LEADER
- IPOS_LEADER = INBSEG(IL) -1
-!
-!
-!* 5.2 negative segments
-!
-! the negative leader propagates anti-parallel to the electric field
- ZEMOD_BL = ZEM_TRIG(IL)
- IKBL = ISEG_LOC(3,IL)
- ISIGN_LEADER = -1
- CALL ONE_LEADER
-!
- INBSEG_LEADER(IL) = INBSEG(IL)
- INEG_LEADER = INBSEG_LEADER(IL) - IPOS_LEADER - 1
-!
-! Eliminate this flash if only positive or negative leader exists
- IF (IPROC .EQ. IPROC_TRIG(IL)) THEN
- IF (IPOS_LEADER .EQ. 0 .OR. INEG_LEADER .EQ. 0) THEN
- ZFLASH(IIBL_LOC,IJBL_LOC,IKB:IKE,IL) = 0.
- INB_FL_REAL(IL) = INB_FL_REAL(IL) - 1
- GNEW_FLASH(IL) = .FALSE.
- ELSE ! return to actual Triggering electrical field
- IIBL_LOC = ISEG_LOC(1,IL)
- IJBL_LOC = ISEG_LOC(2,IL)
- IKBL = ISEG_LOC(3,IL)
- ZEM_TRIG(IL) = ZEM_TRIG(IL)/ZPRES_COEF(IIBL_LOC,IJBL_LOC,IKBL)
- ENDIF
- ENDIF
-
- CALL MPPDB_CHECK3DM("flash:: 5. ZFLASH(IL)",PRECISION,&
- ZFLASH(:,:,:,IL))
-!
- CALL MPI_BCAST (GNEW_FLASH(IL),1, MNHLOG_MPI, IPROC_TRIG(IL), &
- NMNH_COMM_WORLD, IERR)
- CALL MPI_BCAST (ZEM_TRIG(IL), 1, MNHREAL_MPI, IPROC_TRIG(IL), &
- NMNH_COMM_WORLD, IERR)
- CALL MPI_BCAST (INB_FL_REAL(IL), 1, MNHINT_MPI, IPROC_TRIG(IL), &
- NMNH_COMM_WORLD, IERR)
- END IF
- END DO ! end loop il
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 6. POSITIVE AND NEGATIVE REGIONS WHERE THE FLASH CAN PROPAGATE
-! -----------------------------------------------------------
-!
-! Note: this is done to avoid branching in a third charge region:
-! the branches 'stay' in the 2 charge regions where the bileader started to propagate
-!
-!* 6.1 positive charge region associated to the negative leader
-!
- ALLOCATE (GPROP(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),INB_CELL))
- GPROP(:,:,:,:) = .FALSE.
-!
- GPOSITIVE = .TRUE.
- CALL CHARGE_POCKET
-!
-!
-!* 6.2 negative charge region associated to the positive leader
-!
- GPOSITIVE = .FALSE.
- CALL CHARGE_POCKET
-!
-! => a point can be added to the flash only if gprop = true
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 7. NUMBER OF POINTS TO REDISTRIBUTE AT DISTANCE D
-! ----------------------------------------------
-!
-!* 7.1 distance between the triggering point and each point of the mask
-!* global coordinates: only points possibly contributing to branches
-!
- INB_NEUT_OK = 0
-!
- DO IL = 1, INB_CELL
- IF (GNEW_FLASH(IL)) THEN
- INB_PROP = COUNT(GPROP(IIB:IIE,IJB:IJE,IKB:IKE,IL))
- CALL SUM_ELEC_ll(INB_PROP)
-!
- IF (INB_PROP .GT. 0) THEN
- ZDIST(:,:,:) = 0.
- DO II = IIB, IIE
- DO IJ = IJB, IJE
- DO IK = IKB, IKE
- IF (GPROP(II,IJ,IK,IL)) THEN
- ZDIST(II,IJ,IK) = ((XXHATM(II) - ZCOORD_TRIG(1,IL))**2 + &
- (XYHATM(IJ) - ZCOORD_TRIG(2,IL))**2 + &
- (ZZMASS(II,IJ,IK) - ZCOORD_TRIG(3,IL))**2)**0.5
- END IF
- END DO
- END DO
- END DO
-!
-!
-!* 7.3 compute the min and max distance from the triggering point - global
-!
- ZMIN_DIST = 0.0
- ZMAX_DIST = MAX_ll(ZDIST,IPROC_AUX)
-!
-! transform the min and max distances into min and max increments
- IIND_MIN = 1
- IIND_MAX = MAX(1, INT((ZMAX_DIST-ZMIN_DIST)/ZMEAN_GRID +1.))
- IDELTA_IND = IIND_MAX + 1
-!
- ALLOCATE (IHIST_LOC(IDELTA_IND))
- ALLOCATE (ZHIST_PERCENT(IDELTA_IND))
- ALLOCATE (IHIST_GLOB(IDELTA_IND))
- ALLOCATE (ZMAX_BRANCH(IDELTA_IND))
- ALLOCATE (IMAX_BRANCH(IDELTA_IND))
- ALLOCATE (IMASKQ_DIST(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
-!
- IHIST_LOC(:) = 0
- ZHIST_PERCENT(:) = 0.
- IHIST_GLOB(:) = 0
- ZMAX_BRANCH(:) = 0.
- IMAX_BRANCH(:) = 0
- IMASKQ_DIST(:,:,:) = 0
-!
-!
-!* 7.4 histogram: number of points between r and r+dr
-!* for each proc
-!
-! build an array with the possible points: IMASKQ_DIST contains the distance
-! rank of points contributing to branches, excluding the leader points
-!
- DO II = IIB, IIE
- DO IJ = IJB, IJE
- DO IK = IKB, IKE
- IF (ZDIST(II,IJ,IK) .NE. 0.) THEN
- IM = INT( (ZDIST(II,IJ,IK)-ZMIN_DIST)/ZMEAN_GRID + 1.)
- IHIST_LOC(IM) = IHIST_LOC(IM) + 1
- IMASKQ_DIST(II,IJ,IK) = IM
- ENDIF
- END DO
- END DO
- END DO
-!
-!
-!* 7.5 global histogram
-!
- IHIST_GLOB(:) = IHIST_LOC(:)
- CALL SUM_ELEC_ll(IHIST_GLOB)
-!
-!
-!* 7.6 normalization
-!
- ZHIST_PERCENT(:) = 0.
- ZMAX_BRANCH(:) = 0.
- IMAX_BRANCH(:) = 0
-!
- DO IM = 1, IDELTA_IND
- IF (IHIST_GLOB(IM) .GT. 0) THEN
- ZHIST_PERCENT(IM) = REAL(IHIST_LOC(IM)) / REAL(IHIST_GLOB(IM))
- END IF
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 8. BRANCHES
-! --------
-!
-!* 8.1 max number of branches at distance d from the triggering point
-!
- ZMAX_BRANCH(IM) = (XDFRAC_L / ZMEAN_GRID) * &
- REAL(IIND_MIN+IM-1)**(XDFRAC_ECLAIR - 1.)
- ZMAX_BRANCH(IM) = ANINT(ZMAX_BRANCH(IM))
-! all procs know the max total number of branches at distance d
-! => the max number of branches / proc is proportional to the percentage of
-! available points / proc at this distance
-!
- IMAX_BRANCH(IM) = INT(ANINT(ZMAX_BRANCH(IM)))
- END DO
-!
- DEALLOCATE (IHIST_LOC)
- DEALLOCATE (ZHIST_PERCENT)
- DEALLOCATE (IHIST_GLOB)
- DEALLOCATE (ZMAX_BRANCH)
-!
-!
-!* 8.3 distribute the branches
-!
-!
- CALL BRANCH_GEOM(IKB, IKE)
-!
- DEALLOCATE (IMAX_BRANCH)
- DEALLOCATE (IMASKQ_DIST)
- END IF ! end if count(gprop)
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 9. NEUTRALIZATION
-! --------------
- CALL MPPDB_CHECK3DM("flash:: 9. ZQMTOT",PRECISION,ZQMTOT)
- CALL MPPDB_CHECK3DM("flash:: 9. ZFLASH",PRECISION,ZFLASH(:,:,:,IL))
-!
-!* 9.1 charge carried by the lightning flash
-!
- ZQFLASH(:,:,:) = 0.
- WHERE (ZFLASH(IIB:IIE,IJB:IJE,IKB:IKE,IL) .GT. 0. .AND. &
- ABS(ZQMTOT(IIB:IIE,IJB:IJE,IKB:IKE) * &
- PRHODREF(IIB:IIE,IJB:IJE,IKB:IKE)) .GT. XQNEUT .AND. &
- ZSIGLOB(IIB:IIE,IJB:IJE,IKB:IKE) .GE. ZSIGMIN)
- ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE) = -1. * &
- (ABS(ZQMTOT(IIB:IIE,IJB:IJE,IKB:IKE)) / &
- ZQMTOT(IIB:IIE,IJB:IJE,IKB:IKE)) * &
- (ABS(ZQMTOT(IIB:IIE,IJB:IJE,IKB:IKE)) - &
- (XQNEUT / PRHODREF(IIB:IIE,IJB:IJE,IKB:IKE)))
- GATTACH(IIB:IIE,IJB:IJE,IKB:IKE) = .TRUE.
-
- END WHERE
-!
-! net charge carried by the flash (for charge conservation / IC)
- ZQNET = SUM3D_ll(ZQFLASH*PRHODJ, IINFO_ll)
-!
-!
-!* 9.2 number of points to neutralize
-!
- INB_NEUT = COUNT(ZSIGLOB(IIB:IIE,IJB:IJE,IKB:IKE) .GE. ZSIGMIN .AND. &
- ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE) .NE. 0.)
- CALL SUM_ELEC_ll(INB_NEUT)
-
-!
-!
-!* 9.3 ensure total charge conservation for IC
-!
- IF (INB_NEUT .GE. 3) THEN
- GNEUTRALIZATION = .TRUE.
- ELSE
- GNEUTRALIZATION = .FALSE.
- GNEW_FLASH(IL) = .FALSE.
- INB_FL_REAL(IL) = INB_FL_REAL(IL) - 1
- END IF
-!
- IF (GNEUTRALIZATION .AND. (.NOT. GCG) .AND. ZQNET .NE. 0.) THEN
- ZQNET = ZQNET / REAL(INB_NEUT)
- WHERE (ZSIGLOB(IIB:IIE,IJB:IJE,IKB:IKE) .GE. ZSIGMIN .AND. &
- ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE) .NE. 0.)
- ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE) = ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE) - &
- ZQNET / PRHODJ(IIB:IIE,IJB:IJE,IKB:IKE)
- ENDWHERE
- END IF
-!
-!
-!* 9.4 charge neutralization
-!
- CALL MPPDB_CHECK3DM("flash:: 9.4 ZQFLASH,ZSIGLOB",PRECISION,&
- ZQFLASH,ZSIGLOB)
-
- ZDQDT(:,:,:,:) = 0.
-!
- IF (GNEUTRALIZATION) THEN
- IF (ITYPE(IL) .EQ. 1.) THEN
- WHERE (ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE) < 0.)
- ! increase negative ion charge
- ZDQDT(IIB:IIE,IJB:IJE,IKB:IKE,NSV_ELEC) = &
- ZDQDT(IIB:IIE,IJB:IJE,IKB:IKE,NSV_ELEC) + &
- ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE)
- ENDWHERE
-!
- WHERE (ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE) > 0.)
- ! Increase positive ion charge
- ZDQDT(IIB:IIE,IJB:IJE,IKB:IKE,1) = &
- ZDQDT(IIB:IIE,IJB:IJE,IKB:IKE,1) + &
- ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE)
- ENDWHERE
-!
-!
-!* 9.4.2 cloud-to-ground flashes
-!
- ELSE
-!
-! Neutralization of the charge on positive CG flashes
- IF (ITYPE(IL) .EQ. 3) THEN
- DO II = 1, NSV_ELEC
- WHERE (ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE) > 0.)
- ZDQDT(IIB:IIE,IJB:IJE,IKB:IKE,II) = &
- ZDQDT(IIB:IIE,IJB:IJE,IKB:IKE,II) - &
- ZQMT(IIB:IIE,IJB:IJE,IKB:IKE,II)
- END WHERE
- ENDDO
-!
- WHERE (ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE) > 0.)
- ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE)=0.
- END WHERE
-!
- WHERE (ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE) < 0.)
-! Increase negative ion charge
- ZDQDT(IIB:IIE,IJB:IJE,IKB:IKE,NSV_ELEC) = &
- ZDQDT(IIB:IIE,IJB:IJE,IKB:IKE,NSV_ELEC) + &
- ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE)
- ENDWHERE
- ELSE
-!
-! Neutralization of the charge on negative CG flashes
-!
- DO II = 1, NSV_ELEC
- WHERE (ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE) < 0.)
- ZDQDT(IIB:IIE,IJB:IJE,IKB:IKE,II) = &
- ZDQDT(IIB:IIE,IJB:IJE,IKB:IKE,II) - &
- ZQMT(IIB:IIE,IJB:IJE,IKB:IKE,II)
- END WHERE
- ENDDO
-!
- WHERE (ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE) < 0.)
- ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE)=0.
- END WHERE
-!
- WHERE (ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE) > 0.)
- ! Increase positive ion charge
- ZDQDT(IIB:IIE,IJB:IJE,IKB:IKE,1) = &
- ZDQDT(IIB:IIE,IJB:IJE,IKB:IKE,1) + &
- ZQFLASH(IIB:IIE,IJB:IJE,IKB:IKE)
- ENDWHERE
- END IF ! GCG_POS
- END IF ! NOT(GCG)
-!
-! Counting the total number of points neutralized in the cell
- IF (IPROC .EQ. IPROC_TRIG(IL)) THEN
- INB_NEUT_OK = INB_NEUT_OK + INB_NEUT
- END IF
-!
- CALL MPI_BCAST (INB_NEUT_OK,1, MNHINT_MPI, IPROC_TRIG(IL), &
- NMNH_COMM_WORLD, IERR)
-!
-!* 9.5 Gather lightning information from all processes
-!* Save the particule charge and total pos/neg charge neutralization points.
-!* the coordinates of all flash branch points
-!
- CALL MPI_ALLGATHER(INBSEG(IL), 1, MNHINT_MPI, &
- INBSEG_PROC, 1, MNHINT_MPI, NMNH_COMM_WORLD, IERR)
-
- INBSEG_ALL(IL) = INBSEG(IL)
- CALL SUM_ELEC_ll(INBSEG_ALL(IL))
-
- CALL GATHER_ALL_BRANCH
-!
-!* 9.6 update the source term
-!
- CALL MPPDB_CHECK3DM("flash:: 9.6 PRSVS",PRECISION,&
- PRSVS(:,:,:,1),PRSVS(:,:,:,2),PRSVS(:,:,:,3),PRSVS(:,:,:,4),&
- PRSVS(:,:,:,5),PRSVS(:,:,:,6),PRSVS(:,:,:,7))
- CALL MPPDB_CHECK3DM("flash:: 9.6 ZDQDT",PRECISION,&
- ZDQDT(:,:,:,1),ZDQDT(:,:,:,2),ZDQDT(:,:,:,3),ZDQDT(:,:,:,4),&
- ZDQDT(:,:,:,5),ZDQDT(:,:,:,6),ZDQDT(:,:,:,7))
-
- DO II = IIB, IIE
- DO IJ = IJB, IJE
- DO IK = IKB, IKE
- DO IM = 1, NSV_ELEC
- IF (ZDQDT(II,IJ,IK,IM) .NE. 0.) THEN
- PRSVS(II,IJ,IK,IM) = PRSVS(II,IJ,IK,IM) + &
- ZDQDT(II,IJ,IK,IM) * &
- PRHODJ(II,IJ,IK) / PTSTEP
- END IF
-!
-!
-!* 9.7 update the positive and negative charge neutralized
-!
- IF (ZDQDT(II,IJ,IK,IM) .LT. 0.) THEN
- ZNEUT_NEG(IL) = ZNEUT_NEG(IL) + ZDQDT(II,IJ,IK,IM) * &
- PRHODJ(II,IJ,IK)
- ELSE IF (ZDQDT(II,IJ,IK,IM) .GT. 0.) THEN
- ZNEUT_POS(IL) = ZNEUT_POS(IL) + ZDQDT(II,IJ,IK,IM) * &
- PRHODJ(II,IJ,IK)
- END IF
- END DO
- END DO
- END DO
- END DO
-!
- CALL SUM_ELEC_ll(ZNEUT_POS(IL))
- CALL SUM_ELEC_ll(ZNEUT_NEG(IL))
-!
-!
-!* 9.8 compute the NOx production
-!
-!! The lightning length is first computed. The number of NOx molecules per
-!! meter of lightning flash is taken from Wang et al. (1998). It is a linear
-!! function of the pressure. No distinction is made between ICs and CGs.
-
- IF (LLNOX_EXPLICIT) THEN
- IFLASH_COUNT_GLOB = IFLASH_COUNT_GLOB + 1
- IF (INBSEG(IL) .NE. 0) THEN
- DO II = 0, INBSEG(IL)-1
- IM = 3 * II
- IX = ISEG_GLOB(IM+1,IL) - IXOR + 1
- IY = ISEG_GLOB(IM+2,IL) - IYOR + 1
- IZ = ISEG_GLOB(IM+3,IL)
- ZLGHTLENGTH = (XDXX(IX,IY,IZ) * XDYY(IX,IY,IZ) * &
- XDZZ(IX,IY,IZ))**(1./3.)
- ZLNOX(IX, IY, IZ) = ZLNOX(IX, IY, IZ) + &
- (XWANG_A + XWANG_B * PPABST(IX,IY,IZ)) * &
- ZLGHTLENGTH
- ENDDO
- IFLASH_COUNT = IFLASH_COUNT + 1
- END IF
- END IF
- END IF ! GNEUTRALIZATION
- END IF ! end if gnew_flash
- END DO ! end loop il
-!
- DEALLOCATE (GPROP)
-!
-!
-!----------------------------------------------------------------------------
-!
-!* 10. PRINT OR SAVE (before print) LIGHTNING INFORMATIONS
-! ---------------------------------------------------
-!
-! Synchronizing all processes
-! CALL MPI_BARRIER(NMNH_COMM_WORLD, IERR) ! A ACTIVER SI PB.
-!
- INBLIGHT = COUNT(GNEW_FLASH(1:INB_CELL))
- IF (IPROC .EQ. 0) THEN
- IF (INBLIGHT .NE. 0) THEN
- IF ((NNBLIGHT+INBLIGHT) .LE. NFLASH_WRITE) THEN ! SAVE
- ISAVE_STATUS = 1
- DO IL = 1, INB_CELL
- IF (GNEW_FLASH(IL)) THEN
- NNBLIGHT = NNBLIGHT + 1
- ISFLASH_NUMBER(NNBLIGHT) = ISFLASH_NUMBER(NNBLIGHT-1) + 1
- ISNB_FLASH(NNBLIGHT) = INB_FL_REAL(IL)
- ISNBSEG(NNBLIGHT) = INBSEG_ALL(IL)
- ISCELL_NUMBER(NNBLIGHT) = IL
- ISTCOUNT_NUMBER(NNBLIGHT) = KTCOUNT
- ISTYPE(NNBLIGHT) = ITYPE(IL)
- ZSEM_TRIG(NNBLIGHT) = ZEM_TRIG(IL) / 1000.
- ZSNEUT_POS(NNBLIGHT) = ZNEUT_POS(IL)
- ZSNEUT_NEG(NNBLIGHT) = ZNEUT_NEG(IL)
-!
- DO II = 1, INBSEG_ALL(IL)
- IM = 3 * (II - 1)
- ZSCOORD_SEG(NNBLIGHT,II,1:3) = ZCOORD_SEG_ALL(IM+1:IM+3,IL)
- ENDDO
-!
- IF(LLMA) THEN
- DO II = 1, INBSEG_ALL(IL)
- IM = 3 * (II - 1)
- ISLMA_SEG_GLOB(NNBLIGHT,II,1:3) = ILMA_SEG_ALL(IM+1:IM+3,IL)
- IM = NSV_ELEC * (II - 1)
- ZSLMA_QMT(NNBLIGHT,II,2:6) = ZLMA_QMT(IM+2:IM+6,IL)
- ZSLMA_PRT(NNBLIGHT,II,2:6) = ZLMA_PRT(IM+2:IM+6,IL)
- ZSLMA_NEUT_POS(NNBLIGHT,II) = ZLMA_NEUT_POS(II,IL)
- ZSLMA_NEUT_NEG(NNBLIGHT,II) = ZLMA_NEUT_NEG(II,IL)
- END DO
- END IF ! llma
- END IF ! gnew_flash
- END DO ! end loop il
-!
- IF (NNBLIGHT .EQ. NFLASH_WRITE) ISAVE_STATUS = 0
-!
- ELSE ! Print in output files
- ISAVE_STATUS = 2
- END IF
-!
- IF (ISAVE_STATUS .EQ. 0 .OR. ISAVE_STATUS .EQ. 2) THEN
- CALL WRITE_OUT_ASCII
- IF(LLMA) THEN
- CALL WRITE_OUT_LMA
- END IF
- ISFLASH_NUMBER(0) = ISFLASH_NUMBER(NNBLIGHT)
- END IF
-!
- IF (ISAVE_STATUS .EQ. 2) THEN ! Save flashes of the temporal loop
- NNBLIGHT = 0
- DO IL = 1, INB_CELL
- IF (GNEW_FLASH(IL)) THEN
- NNBLIGHT = NNBLIGHT + 1
- ISFLASH_NUMBER(NNBLIGHT) = ISFLASH_NUMBER(NNBLIGHT-1) + 1
- ISNB_FLASH(NNBLIGHT) = INB_FL_REAL(IL)
- ISNBSEG(NNBLIGHT) = INBSEG_ALL(IL)
- ISCELL_NUMBER(NNBLIGHT) = IL
- ISTCOUNT_NUMBER(NNBLIGHT) = KTCOUNT
- ISTYPE(NNBLIGHT) = ITYPE(IL)
- ZSEM_TRIG(NNBLIGHT) = ZEM_TRIG(IL) / 1000.
- ZSNEUT_POS(NNBLIGHT) = ZNEUT_POS(IL)
- ZSNEUT_NEG(NNBLIGHT) = ZNEUT_NEG(IL)
-!
- DO II = 1, INBSEG_ALL(IL)
- IM = 3 * (II - 1)
- ZSCOORD_SEG(NNBLIGHT, II, 1:3) = ZCOORD_SEG_ALL(IM+1:IM+3, IL)
- ENDDO
-!
- IF(LLMA) THEN
- DO II = 1, INBSEG_ALL(IL)
- IM = 3 * (II - 1)
- ISLMA_SEG_GLOB(NNBLIGHT,II,1:3) = ILMA_SEG_ALL(IM+1:IM+3,IL)
- IM = NSV_ELEC*(II-1)
- ZSLMA_QMT(NNBLIGHT,II,2:6) = ZLMA_QMT(IM+2:IM+6,IL)
- ZSLMA_PRT(NNBLIGHT,II,2:6) = ZLMA_PRT(IM+2:IM+6,IL)
- ZSLMA_NEUT_POS(NNBLIGHT,II) = ZLMA_NEUT_POS(II,IL)
- ZSLMA_NEUT_NEG(NNBLIGHT,II) = ZLMA_NEUT_NEG(II,IL)
- END DO
- END IF
- END IF
- ENDDO
- END IF
-!
- IF (ISAVE_STATUS .EQ. 0) THEN
- NNBLIGHT = 0
- END IF
- END IF ! INBLIGHT
- END IF ! IPROC
-!
-! Save flash location statistics in all processes
- IF (INBLIGHT .NE. 0) THEN
- DO IL = 1, INB_CELL
- IF (GNEW_FLASH(IL)) THEN
- IMAP2D(:,:) = 0
- DO IK = IKB, IKE
- IMAP2D(:,:) = IMAP2D(:,:) + ZFLASH(:,:,IK,IL)
- END DO
-!
-! Detect Trig/Impact X,Y location
- IX = 0
- IY = 0
- GFIRSTFLASH = .FALSE.
- DO II = IIB, IIE
- DO IJ = IJB, IJE
- DO IK = IKB, IKE
- IF (GFIRSTFLASH) EXIT
- IF (ZFLASH(II,IJ,IK,IL)==1.) THEN
- IX = II
- IY = IJ
- GFIRSTFLASH = .TRUE.
- END IF
- END DO
- END DO
- END DO
-!
-! Store
- IF (ITYPE(IL)==1) THEN ! IC
- IF (IX*IY/=0) NMAP_TRIG_IC(IX,IY) = NMAP_TRIG_IC(IX,IY) + 1
- NMAP_2DAREA_IC(:,:) = NMAP_2DAREA_IC(:,:) + MIN(1,IMAP2D(:,:))
- NMAP_3DIC(:,:,:) = NMAP_3DIC(:,:,:) + ZFLASH(:,:,:,IL)
- ELSE ! CGN & CGP
- IF (IX*IY/=0) NMAP_IMPACT_CG(IX,IY) = NMAP_IMPACT_CG(IX,IY) + 1
- NMAP_2DAREA_CG(:,:) = NMAP_2DAREA_CG(:,:) + MIN(1,IMAP2D(:,:))
- NMAP_3DCG(:,:,:) = NMAP_3DCG(:,:,:) + ZFLASH(:,:,:,IL)
- END IF
- END IF
- ENDDO
- END IF ! INBLIGHT
-!
-!------------------------------------------------------------------------------
-!
-!* 11. ATTACHMENT AFTER CHARGE NEUTRALIZATION
-! --------------------------------------
-!
-!* 11.1 ion attachment
-!
- IF (INB_NEUT_OK .NE. 0) THEN
-
- CALL MPPDB_CHECK3DM("flash:: PRSVS",PRECISION,&
- PRSVS(:,:,:,1),PRSVS(:,:,:,2),PRSVS(:,:,:,3),PRSVS(:,:,:,4),&
- PRSVS(:,:,:,5),PRSVS(:,:,:,6),PRSVS(:,:,:,7))
-
- PRSVS(:,:,:,1) = PRSVS(:,:,:,1) / XECHARGE
- PRSVS(:,:,:,NSV_ELEC) = - PRSVS(:,:,:,NSV_ELEC) / XECHARGE
-!
- CALL ION_ATTACH_ELEC(KTCOUNT, KRR, PTSTEP, PRHODREF, &
- PRHODJ, PRSVS, PRS, PTHT, PCIT, PPABST, PEFIELDU, &
- PEFIELDV, PEFIELDW, GATTACH, PTOWN, PSEA )
-!
- PRSVS(:,:,:,1) = PRSVS(:,:,:,1) * XECHARGE
- PRSVS(:,:,:,NSV_ELEC) = - PRSVS(:,:,:,NSV_ELEC) * XECHARGE
-
- CALL MPPDB_CHECK3DM("flash:: after ION PRSVS",PRECISION,&
- PRSVS(:,:,:,1),PRSVS(:,:,:,2),PRSVS(:,:,:,3),PRSVS(:,:,:,4),&
- PRSVS(:,:,:,5),PRSVS(:,:,:,6),PRSVS(:,:,:,7))
- ENDIF
-!
-!
-!* 11.2 update the charge density to check if another flash can be triggered
-!
- ZQMTOT(:,:,:) = 0.
- DO II = 1, NSV_ELEC
-! transform the source term (C/s) into the updated charge density (C/kg)
- ZQMT(:,:,:,II) = PRSVS(:,:,:,II) * PTSTEP / PRHODJ(:,:,:)
-!
-! total charge density (C/kg)
- ZQMTOT(:,:,:) = ZQMTOT(:,:,:) + PRSVS(:,:,:,II) * PTSTEP / PRHODJ(:,:,:)
- END DO
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 12. CHECK IF ANOTHER FLASH CAN BE TRIGGERED
-! ---------------------------------------
-!
-
- IF ((MAXVAL(INB_FLASH(:))+1) < INBFTS_MAX) THEN
- IF (INB_NEUT_OK .NE. 0) THEN
- CALL MPPDB_CHECK3DM("flash:: PRHODJ,PRT",PRECISION,&
- PRHODJ,PRT(:,:,:,1),PRT(:,:,:,2),PRT(:,:,:,3),PRT(:,:,:,4),&
- PRT(:,:,:,5),PRT(:,:,:,6))
- CALL MPPDB_CHECK3DM("flash:: ZQMT",PRECISION,&
- ZQMT(:,:,:,1),ZQMT(:,:,:,2),ZQMT(:,:,:,3),ZQMT(:,:,:,4),&
- ZQMT(:,:,:,5),ZQMT(:,:,:,6),ZQMT(:,:,:,7))
- CALL TO_ELEC_FIELD_n (PRT, ZQMT, PRHODJ, KTCOUNT, KRR, &
- PEFIELDU, PEFIELDV, PEFIELDW)
- CALL MPPDB_CHECK3DM("flash:: PEFIELDU, PEFIELDV, PEFIELDW",PRECISION,&
- PEFIELDU, PEFIELDV, PEFIELDW)
-! electric field module including pressure effect
- ZEMODULE(IIB:IIE,IJB:IJE,IKB:IKE) = ZPRES_COEF(IIB:IIE,IJB:IJE,IKB:IKE)* &
- (PEFIELDU(IIB:IIE,IJB:IJE,IKB:IKE)**2 + &
- PEFIELDV(IIB:IIE,IJB:IJE,IKB:IKE)**2 + &
- PEFIELDW(IIB:IIE,IJB:IJE,IKB:IKE)**2)**0.5
- ENDIF
-!
- ISEG_LOC(:,:) = 0
- ZCOORD_TRIG(:,:) = 0.
- ZCOORD_SEG(:,:) = 0.
- IPROC_TRIG(:) = 0
- ISIGNE_EZ(:) = 0
-!
- CALL TRIG_POINT
- ELSE
- GNEW_FLASH_GLOB = .FALSE.
- END IF
-!
- ZNEUT_POS(:) = 0.
- ZNEUT_NEG(:) = 0.
-!
- IF (LLMA) THEN
- ZLMA_NEUT_POS(:,:) = 0.
- ZLMA_NEUT_NEG(:,:) = 0.
- END IF
- END DO ! end loop do while
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 13. COMPUTE THE NOX SOURCE TERM
-! ---------------------------
-!
- IF (LLNOX_EXPLICIT) THEN
- IF (IFLASH_COUNT_GLOB .NE. 0) THEN
- ZCOEF = XMD / XAVOGADRO
- XLNOX_ECLAIR = 0.
- IF (IFLASH_COUNT .NE. 0) THEN
- XLNOX_ECLAIR = SUM(ZLNOX(:,:,:))
- PSVS_LINOX(:,:,:) = PSVS_LINOX(:,:,:) + ZLNOX(:,:,:) * ZCOEF ! PRHODJ is
- ! implicit
- END IF
- CALL SUM_ELEC_ll (XLNOX_ECLAIR)
- XLNOX_ECLAIR = XLNOX_ECLAIR / (XAVOGADRO * REAL(IFLASH_COUNT_GLOB))
- END IF
- DEALLOCATE (ZLNOX)
- END IF
-!
- DEALLOCATE (ZNEUT_POS)
- DEALLOCATE (ZNEUT_NEG)
- DEALLOCATE (ZSIGMA)
- DEALLOCATE (ZLBDAR)
- DEALLOCATE (ZLBDAS)
- DEALLOCATE (ZLBDAG)
- IF (KRR == 7) DEALLOCATE (ZLBDAH)
- DEALLOCATE (ZSIGLOB)
- DEALLOCATE (ZDQDT)
- DEALLOCATE (ZDIST)
- DEALLOCATE (ZFLASH)
- DEALLOCATE (ZQFLASH)
- DEALLOCATE (IPROC_TRIG)
- DEALLOCATE (ISIGNE_EZ)
- DEALLOCATE (GNEW_FLASH)
- DEALLOCATE (INBSEG)
- DEALLOCATE (INBSEG_ALL)
- DEALLOCATE (INBSEG_LEADER)
- DEALLOCATE (INB_FLASH)
- DEALLOCATE (INB_FL_REAL)
- DEALLOCATE (ZEM_TRIG)
- DEALLOCATE (ITYPE)
- DEALLOCATE (ISEG_LOC)
- DEALLOCATE (ZCOORD_TRIG)
- DEALLOCATE (ZCOORD_SEG)
- DEALLOCATE (ZCOORD_SEG_ALL)
- DEALLOCATE (ISEG_GLOB)
- DEALLOCATE (GATTACH)
- IF(LLMA) THEN
- DEALLOCATE (ILMA_SEG_ALL)
- DEALLOCATE (ZLMA_QMT)
- DEALLOCATE (ZLMA_PRT)
- DEALLOCATE (ZLMA_NEUT_POS)
- DEALLOCATE (ZLMA_NEUT_NEG)
- END IF
-END IF ! (inb_cell .ge. 1)
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 13. PRINT LIGHTNING INFORMATIONS FOR THE LAST TIMESTEP
-! OR LMA_TIME_SAVE IS REACHED IF LLMA OPTION IS USED
-! --------------------------------------------------
-!
-IF (LLMA) THEN
- IF( IPROC .EQ. 0 .AND. TDTCUR%xtime >= TDTLMA%xtime - PTSTEP ) THEN
- CALL WRITE_OUT_ASCII
- CALL WRITE_OUT_LMA
- ISFLASH_NUMBER(0) = ISFLASH_NUMBER(NNBLIGHT)
- NNBLIGHT = 0
- END IF
-END IF
-!
-IF (NNBLIGHT .NE. 0 .AND. ((IPROC .EQ. 0 .AND. OEXIT) .OR. &
- (KTCOUNT == NSTOP .AND. KMI==1))) THEN
- CALL WRITE_OUT_ASCII
- IF(LLMA) CALL WRITE_OUT_LMA
-END IF
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 14. DEALLOCATE
-! ----------
-!
-DEALLOCATE (ICELL_LOC)
-DEALLOCATE (ZQMT)
-DEALLOCATE (ZQMTOT)
-DEALLOCATE (ZCLOUD)
-DEALLOCATE (ZCELL)
-DEALLOCATE (ZEMODULE)
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 14. BACK TO INPUT UNITS (per kg and per (m3 s)) FOR IONS
-! ----------------------------------------------------
-!
-PRSVS(:,:,:,1) = PRSVS(:,:,:,1) / XECHARGE ! 1 /(m3 s)
-PRSVS(:,:,:,NSV_ELEC) = -PRSVS(:,:,:,NSV_ELEC) / XECHARGE ! 1 /(m3 s)
-!
-!
-!-------------------------------------------------------------------------------
-!
-CONTAINS
-!
-!-------------------------------------------------------------------------------
-!
- SUBROUTINE TRIG_POINT ()
-!
-! Goal : find randomly a triggering point where E > E_trig
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* 0.1 declaration of dummy arguments
-!
-!* 0.2 declaration of local variables
-!
-LOGICAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),INB_CELL) :: &
- GTRIG ! mask for the triggering pts
-INTEGER :: INB_TRIG ! Nb of pts where triggering is possible
-INTEGER :: IWEST_GLOB_TRIG ! western global limit of possible triggering
-INTEGER :: IEAST_GLOB_TRIG ! eastern global limit of possible triggering
-INTEGER :: ISOUTH_GLOB_TRIG ! southern global limit of possible triggering
-INTEGER :: INORTH_GLOB_TRIG ! northern global limit of possible triggering
-INTEGER :: IUP_TRIG ! upper limit of possible triggering
-INTEGER :: IDOWN_TRIG ! down limit of possible triggering
-!
-!
-!* 1. INITIALIZATIONS
-! -----------
-!
-GTRIG(:,:,:,:) = .FALSE.
-GNEW_FLASH(:) = .FALSE.
-GNEW_FLASH_GLOB = .FALSE.
-!
-!
-!* 2. FIND THE POSSIBLE TRIGGERING POINTS
-! -----------------------------------
-!
-DO IL = 1, INB_CELL
- WHERE (ZEMODULE(IIB:IIE,IJB:IJE,IKB:IKE) > ZE_TRIG_THRES .AND. &
- ZCELL(IIB:IIE,IJB:IJE,IKB:IKE,IL) .GT. 0.)
- GTRIG(IIB:IIE,IJB:IJE,IKB:IKE,IL) = .TRUE.
- ENDWHERE
-END DO
-!
-!
-!* 3. CHOICE OF THE TRIGGERING POINT
-! ------------------------------
-!
-!* 3.1 number and coordinates of the possible triggering points
-!
-INB_TRIG = 0
-DO IL = 1, INB_CELL
- INB_TRIG = COUNT(GTRIG(IIB:IIE,IJB:IJE,IKB:IKE,IL))
- CALL SUM_ELEC_ll(INB_TRIG)
-!
-!
-!* 3.2 random choice of the triggering point
-!
- IF (INB_TRIG .GT. 0) THEN
- IFOUND = 0
-!
-! find the global limits where GTRIG = T
- CALL EXTREMA_ELEC_ll(GTRIG(:,:,:,IL), IWEST_GLOB_TRIG, IEAST_GLOB_TRIG, &
- ISOUTH_GLOB_TRIG, INORTH_GLOB_TRIG, &
- IDOWN_TRIG, IUP_TRIG)
-!
- DO WHILE (IFOUND .NE. 1)
-!
-! random choice of the 3 global ind.
- CALL MNH_RANDOM_NUMBER(ZRANDOM)
- II_TRIG_GLOB = IWEST_GLOB_TRIG + &
- INT(ANINT(ZRANDOM * (IEAST_GLOB_TRIG - IWEST_GLOB_TRIG)))
- CALL MNH_RANDOM_NUMBER(ZRANDOM)
- IJ_TRIG_GLOB = ISOUTH_GLOB_TRIG + &
- INT(ANINT(ZRANDOM * (INORTH_GLOB_TRIG - ISOUTH_GLOB_TRIG)))
- CALL MNH_RANDOM_NUMBER(ZRANDOM)
- IK_TRIG = IDOWN_TRIG + INT(ANINT(ZRANDOM * (IUP_TRIG - IDOWN_TRIG)))
-!
-! global ind. --> local ind. of the potential triggering pt
- II_TRIG_LOC = II_TRIG_GLOB - IXOR + 1
- IJ_TRIG_LOC = IJ_TRIG_GLOB - IYOR + 1
-!
-! test if the randomly chosen pt meets all conditions for triggering
- IF ((II_TRIG_LOC .LE. IIE) .AND. (II_TRIG_LOC .GE. IIB) .AND. &
- (IJ_TRIG_LOC .LE. IJE) .AND. (IJ_TRIG_LOC .GE. IJB) .AND. &
- (IK_TRIG .LE. IKE) .AND. (IK_TRIG .GE. IKB)) THEN
- IF (GTRIG(II_TRIG_LOC,IJ_TRIG_LOC,IK_TRIG,IL)) THEN
- IFOUND = 1
-!
-! update the local coordinates of the flash segments
- ISEG_LOC(1,IL) = II_TRIG_LOC
- ISEG_LOC(2,IL) = IJ_TRIG_LOC
- ISEG_LOC(3,IL) = IK_TRIG
-!
- ISEG_GLOB(1,IL) = II_TRIG_GLOB
- ISEG_GLOB(2,IL) = IJ_TRIG_GLOB
- ISEG_GLOB(3,IL) = IK_TRIG
-!
- ZCOORD_TRIG(1,IL) = XXHATM(II_TRIG_LOC)
- ZCOORD_TRIG(2,IL) = XYHATM(IJ_TRIG_LOC)
- ZCOORD_TRIG(3,IL) = ZZMASS(II_TRIG_LOC, IJ_TRIG_LOC, IK_TRIG)
-!
- ZCOORD_SEG(1:3,IL) = ZCOORD_TRIG(1:3,IL)
-!
-! electric field module at the triggering point
- ZEM_TRIG(IL) = ZEMODULE(II_TRIG_LOC,IJ_TRIG_LOC,IK_TRIG)
-!
-! sign of Ez at the triggering point
- ISIGNE_EZ(IL) = 0
- IF (PEFIELDW(II_TRIG_LOC,IJ_TRIG_LOC,IK_TRIG) .GT. 0.) THEN
- ISIGNE_EZ(IL) = 1
- ELSE IF (PEFIELDW(II_TRIG_LOC,IJ_TRIG_LOC,IK_TRIG) .LT. 0.) THEN
- ISIGNE_EZ(IL) = -1
- END IF
- END IF
- END IF
-!
-! broadcast IFOUND and find the proc where IFOUND = 1
- CALL MAX_ELEC_ll (IFOUND, IPROC_TRIG(IL))
-!
- END DO
-!
-!
-!
-!* 4. BROADCAST USEFULL PARAMETERS
-! ----------------------------
-!
- CALL MPI_BCAST (ZEM_TRIG(IL), 1, &
- MNHREAL_MPI, IPROC_TRIG(IL), NMNH_COMM_WORLD, IERR)
- CALL MPI_BCAST (ISEG_LOC(:,IL), 3*SIZE(PRT,3), &
- MNHINT_MPI, IPROC_TRIG(IL), NMNH_COMM_WORLD, IERR)
- CALL MPI_BCAST (ZCOORD_TRIG(:,IL), 3, &
- MNHREAL_MPI, IPROC_TRIG(IL), NMNH_COMM_WORLD, IERR)
- CALL MPI_BCAST (ISIGNE_EZ(IL), 1, &
- MNHINT_MPI, IPROC_TRIG(IL), NMNH_COMM_WORLD, IERR)
-!
-!
-!* 5. CHECK IF THE FLASH CAN DEVELOP
-! ------------------------------
-!
- IF (INB_FLASH(IL) < INBFTS_MAX) THEN
- IF (IPROC.EQ.IPROC_TRIG(IL)) THEN
- ZCELL(II_TRIG_LOC,IJ_TRIG_LOC,IK_TRIG,IL) = 0.
- END IF
-!
- GNEW_FLASH(IL) = .TRUE.
- GNEW_FLASH_GLOB = .TRUE.
- CALL MPI_BCAST (GNEW_FLASH(IL),1, MNHLOG_MPI, IPROC_TRIG(IL), &
- NMNH_COMM_WORLD, IERR)
- CALL MPI_BCAST (GNEW_FLASH_GLOB,1, MNHLOG_MPI, IPROC_TRIG(IL), &
- NMNH_COMM_WORLD, IERR)
- END IF
- END IF
-END DO
-!
-!
-END SUBROUTINE TRIG_POINT
-!
-!-------------------------------------------------------------------------------
-!
- SUBROUTINE ONE_LEADER ()
-!
-!! Purpose: propagates the bidirectional leader along the vertical
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-INTEGER :: IKSTEP, IIDECAL
-!
-!* 1. BUILD THE POSITIVE/NEGATIVE LEADER
-! ----------------------------------
-CALL MPPDB_CHECK3DM("flash:: one_leader ZFLASH",PRECISION,ZFLASH(:,:,:,IL))
-!
-IKSTEP = ISIGN_LEADER * ISIGNE_EZ(IL)
- ! the positive leader propagates parallel to the electric field
- ! while the negative leader propagates anti// to the electric field
-ISTOP = 0
-!
-!
-IF (IPROC .EQ. IPROC_TRIG(IL)) THEN
-
- DO WHILE (ZEMOD_BL > XEPROP .AND. IKBL > IKB .AND. &
- IKBL < IKE .AND. ISTOP .EQ. 0 .AND. &
- INBSEG(IL) .LE. (NLEADER_MAX-1))
-!
-! local coordinates of the new segment
- IIBL_LOC = ISEG_LOC(1,IL)
- IJBL_LOC = ISEG_LOC(2,IL)
- IKBL = IKBL + IKSTEP
- IIDECAL = INBSEG(IL) * 3
-!
- ISEG_LOC(IIDECAL+1,IL) = IIBL_LOC
- ISEG_LOC(IIDECAL+2,IL) = IJBL_LOC
- ISEG_LOC(IIDECAL+3,IL) = IKBL
-!
- ISEG_GLOB(IIDECAL+1,IL) = IIBL_LOC + IXOR - 1
- ISEG_GLOB(IIDECAL+2,IL) = IJBL_LOC + IYOR - 1
- ISEG_GLOB(IIDECAL+3,IL) = IKBL
-!
- ZCOORD_SEG(IIDECAL+1,IL) = XXHATM(IIBL_LOC)
- ZCOORD_SEG(IIDECAL+2,IL) = XYHATM(IJBL_LOC)
- ZCOORD_SEG(IIDECAL+3,IL) = ZZMASS(IIBL_LOC, IJBL_LOC, IKBL)
-!
- INBSEG(IL) = INBSEG(IL) + 1
-!
-!
-!* 1.3 test if Ez keeps the same sign
-!
- IF (PEFIELDW(IIBL_LOC,IJBL_LOC,IKBL) .EQ. 0. .OR. &
- INT(ABS(PEFIELDW(IIBL_LOC,IJBL_LOC,IKBL)) / &
- PEFIELDW(IIBL_LOC,IJBL_LOC,IKBL)) /= ISIGNE_EZ(IL) .OR. &
- ZCELL(IIBL_LOC,IJBL_LOC,IKBL,IL) .EQ. 0.) THEN
- ISTOP = 1
-! then this segment is not part of the leader
- INBSEG(IL) = INBSEG(IL) - 1
- END IF
-!
-!
-!* 1.4 sign of the induced charge
-!
- IF (ISTOP .EQ. 0) THEN
- ZFLASH(IIBL_LOC,IJBL_LOC,IKBL,IL) = 1.
- ZCELL(IIBL_LOC,IJBL_LOC,IKBL,IL) = 0.
-!
-!
-!* 1.6 electric field module at the tip of the leader
-!
- ZEMOD_BL = ZEMODULE(IIBL_LOC,IJBL_LOC,IKBL)
-!
-!
-!* 1.7 test if the domain boundaries are reached
-!
- IF ((IIBL_LOC < IIB .AND. LWEST_ll()) .OR. &
- (IIBL_LOC > IIE .AND. LEAST_ll()) .OR. &
- (IJBL_LOC < IJB .AND. LSOUTH_ll()) .OR. &
- (IJBL_LOC > IJE .AND. LNORTH_ll())) THEN
- PRINT*,'DOMAIN BOUNDARIES REACHED BY THE LIGHTNING '
- ISTOP = 1
- ENDIF
-!
- IF (IKBL .LE. IKB) THEN
- PRINT*,'THE LIGHTNING FLASH HAS REACHED THE GROUND '
- ISTOP = 1
- GCG = .TRUE.
- NNB_CG = NNB_CG + 1
- IF (ISIGN_LEADER > 0) THEN
- GCG_POS = .TRUE.
- ITYPE(IL) = 3 ! CGP
- NNB_CG_POS = NNB_CG_POS + 1
- ELSE
- ITYPE(IL) = 2 ! CGN
- END IF
- ENDIF
-!
- IF (IKBL .GE. IKE) THEN
- PRINT*,'THE LIGHTNING FLASH HAS REACHED THE TOP OF THE DOMAIN '
- ISTOP = 1
- ENDIF
-!
-!
-!* 2. TEST IF THE FLASH IS A CG
-! -------------------------
-!
- IF (.NOT. GCG) THEN
- IF ( (ZZMASS(IIBL_LOC,IJBL_LOC,IKBL)-PZZ(IIBL_LOC,IJBL_LOC,IKB)) <= &
- XALT_CG .AND. INBSEG(IL) .GT. 1 .AND. IKSTEP .LT. 0) THEN
-!
-!
-!* 2.1 the channel is prolongated to the ground if
-!* one segment reaches the altitude XALT_CG
-!
- DO WHILE (IKBL > IKB)
- IKBL = IKBL - 1
-!
-! local coordinates of the new segment
- IIDECAL = INBSEG(IL) * 3
-!
- ISEG_LOC(IIDECAL+1,IL) = IIBL_LOC
- ISEG_LOC(IIDECAL+2,IL) = IJBL_LOC
- ISEG_LOC(IIDECAL+3,IL) = IKBL
-!
- ISEG_GLOB(IIDECAL+1:IIDECAL+2,IL) = ISEG_GLOB(IIDECAL-2:IIDECAL-1,IL)
- ISEG_GLOB(IIDECAL+3,IL) = IKBL
-!
- ZCOORD_SEG(IIDECAL+1:IIDECAL+2,IL) = ZCOORD_SEG(IIDECAL-2:IIDECAL-1,IL)
- ZCOORD_SEG(IIDECAL+3,IL) = ZZMASS(IIBL_LOC, IJBL_LOC, IKBL)
-!
-! Increment number of segments
- INBSEG(IL) = INBSEG(IL) + 1 ! Nb of segments
- ZFLASH(IIBL_LOC,IJBL_LOC,IKBL,IL) = 1.
- ZCELL(IIBL_LOC,IJBL_LOC,IKBL,IL) = 0.
- END DO
-!
-!
-!* 2.2 update the number of CG flashes
-!
- GCG = .TRUE.
- NNB_CG = NNB_CG + 1
- ISTOP = 1
-!
- IF (ISIGN_LEADER > 0) THEN
- GCG_POS = .TRUE.
- NNB_CG_POS = NNB_CG_POS + 1
- ITYPE(IL) = 3
- ELSE
- ITYPE(IL) = 2
- END IF
- END IF
- END IF
- END IF ! end if ISTOP=0
- END DO ! end loop leader
-END IF ! only iproc_trig was working
-!
-!
-!* 3. BROADCAST THE INFORMATIONS TO ALL PROCS
-! ---------------------------------------
-!
-CALL MPI_BCAST (ISEG_LOC(:,IL), 3*SIZE(PRT,3), &
- MNHINT_MPI, IPROC_TRIG(IL), NMNH_COMM_WORLD, IERR)
-CALL MPI_BCAST (ITYPE(IL), 1, &
- MNHINT_MPI, IPROC_TRIG(IL), NMNH_COMM_WORLD, IERR)
-
-CALL MPI_BCAST (GCG, 1, &
- MNHLOG_MPI, IPROC_TRIG(IL), NMNH_COMM_WORLD, IERR)
-CALL MPI_BCAST (GCG_POS, 1, &
- MNHLOG_MPI, IPROC_TRIG(IL), NMNH_COMM_WORLD, IERR)
-CALL MPI_BCAST (NNB_CG, 1, &
- MNHINT_MPI, IPROC_TRIG(IL), NMNH_COMM_WORLD, IERR)
-CALL MPI_BCAST (NNB_CG_POS, 1, &
- MNHINT_MPI, IPROC_TRIG(IL), NMNH_COMM_WORLD, IERR)
-
-!
-CALL MPPDB_CHECK3DM("flash:: one_leader end ZFLASH",PRECISION,ZFLASH(:,:,:,IL))
-!
-END SUBROUTINE ONE_LEADER
-!
-!-------------------------------------------------------------------------------
-!
- SUBROUTINE CHARGE_POCKET
-!
-!!
-!! Purpose: limit flash propagation into the positive and negative charge layers
-!! located immediatly above and below the triggering point
-!!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZSIGN_AREA,ZSIGN_AREA_NEW
-
-REAL, DIMENSION(INB_CELL) :: ZSIGN ! sign of the charge immediatly below/above the triggering pt
-!
-INTEGER, DIMENSION(INB_CELL) :: IEND ! if 1, no more neighbour pts meeting the conditions
-INTEGER, DIMENSION(INB_CELL) :: COUNT_BEF2
-INTEGER, DIMENSION(INB_CELL) :: COUNT_AFT2
-INTEGER :: IPROC_END
-INTEGER :: IEND_GLOB
-INTEGER :: IIDECAL, IKMIN, IKMAX
-REAL :: ZFACT
-!
-!
-!* 1. SEARCH THE POINTS BELONGING TO THE LAYERS
-! -----------------------------------------
-!
-ZFACT = -1.
-IF(GPOSITIVE) ZFACT = 1.
-
-ZSIGN_AREA(:,:,:) = 0.
-ZSIGN(:) = 0.
-IEND(:) = 0
-IEND_GLOB = 0
-!
-!
-DO IL = 1, INB_CELL
- IF (.NOT. GNEW_FLASH(IL)) THEN
- IEND(IL) = 1
- IEND_GLOB = IEND_GLOB + IEND(IL)
- END IF
- IF (GNEW_FLASH(IL) .AND. IPROC .EQ. IPROC_TRIG(IL)) THEN
- DO II = 1, INBSEG(IL)
- IIDECAL = 3 * (II - 1)
- IIBL_LOC = ISEG_LOC(IIDECAL+1,IL)
- IJBL_LOC = ISEG_LOC(IIDECAL+2,IL)
- IKBL = ISEG_LOC(IIDECAL+3,IL)
-!
- IF (ZQMTOT(IIBL_LOC,IJBL_LOC,IKBL) .GT. 0. .AND. GPOSITIVE) THEN
- ZSIGN_AREA(IIBL_LOC,IJBL_LOC,IKBL) = 1. * REAL(IL)
- ZSIGN(IL) = ZSIGN_AREA(IIBL_LOC,IJBL_LOC,IKBL)
- ELSE IF (ZQMTOT(IIBL_LOC,IJBL_LOC,IKBL) .LT. 0. .AND. .NOT.GPOSITIVE) THEN
- ZSIGN_AREA(IIBL_LOC,IJBL_LOC,IKBL) = -1. * REAL(IL)
- ZSIGN(IL) = ZSIGN_AREA(IIBL_LOC,IJBL_LOC,IKBL)
- END IF
- END DO
- END IF
-!
- CALL MPI_BCAST (ZSIGN(IL), 1, MNHREAL_MPI, IPROC_TRIG(IL), &
- NMNH_COMM_WORLD, IERR)
-END DO
-!
-DO WHILE (IEND_GLOB .NE. INB_CELL)
- DO IL = 1, INB_CELL
- CALL ADD3DFIELD_ll ( TZFIELDS_ll, ZSIGN_AREA, 'FLASH_GEOM_ELEC_n::ZSIGN_AREA' )
- CALL UPDATE_HALO_ll ( TZFIELDS_ll, IINFO_ll)
- CALL CLEANLIST_ll ( TZFIELDS_ll)
-!
- IF (GNEW_FLASH(IL) .AND. (IEND(IL) .NE. 1)) THEN
- COUNT_BEF2(IL) = COUNT(ZSIGN_AREA(IIB:IIE,IJB:IJE,IKB:IKE) .EQ. ZSIGN(IL))
- CALL SUM_ELEC_ll (COUNT_BEF2(IL))
-!
- IF (ISIGNE_EZ(IL).EQ.1) THEN
- IF (GPOSITIVE) THEN
- IKMIN = IKB
- IKMAX = ISEG_LOC(3, IL)
- ELSE
- IKMIN = ISEG_LOC(3, IL)
- IKMAX = IKE
- ENDIF
- ENDIF
-!
- IF (ISIGNE_EZ(IL).EQ.-1) THEN
- IF (GPOSITIVE) THEN
- IKMIN = ISEG_LOC(3, IL)
- IKMAX = IKE
- ELSE
- IKMIN = IKB
- IKMAX = ISEG_LOC(3, IL)
- ENDIF
- ENDIF
-!
- ZSIGN_AREA_NEW(:,:,IKMIN:IKMAX) = ZSIGN_AREA (:,:,IKMIN:IKMAX)
- DO II = IIB, IIE
- DO IJ = IJB, IJE
- DO IK = IKMIN, IKMAX
- IF ((ZSIGN_AREA(II, IJ, IK) .EQ. 0.) .AND. &
- (ZCELL(II,IJ,IK,IL) .EQ. 1.) .AND. &
- (.NOT. GPROP(II,IJ,IK,IL)) .AND. &
- (ZQMTOT(II,IJ,IK)*ZFACT .GT. 0.) .AND. &
- (ABS(ZQMTOT(II,IJ,IK) * &
- PRHODREF(II,IJ,IK)) .GT. XQNEUT)) THEN
-!
- IF ((ZSIGN_AREA(II-1,IJ, IK) .EQ. ZSIGN(IL)) .OR. &
- (ZSIGN_AREA(II+1,IJ, IK) .EQ. ZSIGN(IL)) .OR. &
- (ZSIGN_AREA(II, IJ-1,IK) .EQ. ZSIGN(IL)) .OR. &
- (ZSIGN_AREA(II, IJ+1,IK) .EQ. ZSIGN(IL)) .OR. &
- (ZSIGN_AREA(II-1,IJ-1,IK) .EQ. ZSIGN(IL)) .OR. &
- (ZSIGN_AREA(II-1,IJ+1,IK) .EQ. ZSIGN(IL)) .OR. &
- (ZSIGN_AREA(II+1,IJ+1,IK) .EQ. ZSIGN(IL)) .OR. &
- (ZSIGN_AREA(II+1,IJ-1,IK) .EQ. ZSIGN(IL)) .OR. &
- (ZSIGN_AREA(II, IJ, IK+1) .EQ. ZSIGN(IL)) .OR. &
- (ZSIGN_AREA(II-1,IJ, IK+1) .EQ. ZSIGN(IL)) .OR. &
- (ZSIGN_AREA(II+1,IJ, IK+1) .EQ. ZSIGN(IL)) .OR. &
- (ZSIGN_AREA(II, IJ-1,IK+1) .EQ. ZSIGN(IL)) .OR. &
- (ZSIGN_AREA(II, IJ+1,IK+1) .EQ. ZSIGN(IL)) .OR. &
- (ZSIGN_AREA(II-1,IJ-1,IK+1) .EQ. ZSIGN(IL)) .OR. &
- (ZSIGN_AREA(II-1,IJ+1,IK+1) .EQ. ZSIGN(IL)) .OR. &
- (ZSIGN_AREA(II+1,IJ+1,IK+1) .EQ. ZSIGN(IL)) .OR. &
- (ZSIGN_AREA(II+1,IJ-1,IK+1) .EQ. ZSIGN(IL)) .OR. &
- (ZSIGN_AREA(II, IJ, IK-1) .EQ. ZSIGN(IL)) .OR. &
- (ZSIGN_AREA(II-1,IJ, IK-1) .EQ. ZSIGN(IL)) .OR. &
- (ZSIGN_AREA(II+1,IJ, IK-1) .EQ. ZSIGN(IL)) .OR. &
- (ZSIGN_AREA(II, IJ-1,IK-1) .EQ. ZSIGN(IL)) .OR. &
- (ZSIGN_AREA(II, IJ+1,IK-1) .EQ. ZSIGN(IL)) .OR. &
- (ZSIGN_AREA(II-1,IJ-1,IK-1) .EQ. ZSIGN(IL)) .OR. &
- (ZSIGN_AREA(II-1,IJ+1,IK-1) .EQ. ZSIGN(IL)) .OR. &
- (ZSIGN_AREA(II+1,IJ+1,IK-1) .EQ. ZSIGN(IL)) .OR. &
- (ZSIGN_AREA(II+1,IJ-1,IK-1) .EQ. ZSIGN(IL))) THEN
- ZSIGN_AREA_NEW(II,IJ,IK) = ZSIGN(IL)
- GPROP(II,IJ,IK,IL) = .TRUE.
- END IF
- END IF
- END DO
- END DO
- END DO
- ZSIGN_AREA (:,:,IKMIN:IKMAX) = ZSIGN_AREA_NEW(:,:,IKMIN:IKMAX)
-!
- COUNT_AFT2(IL) = COUNT(ZSIGN_AREA(IIB:IIE,IJB:IJE,IKB:IKE) .EQ. ZSIGN(IL))
- CALL SUM_ELEC_ll(COUNT_AFT2(IL))
-!
- IF (COUNT_BEF2(IL) .EQ. COUNT_AFT2(IL)) THEN
- IEND(IL) = 1
- ELSE
- IEND(IL) = 0
- END IF
-! broadcast IEND and find the proc where IEND = 1
- CALL MAX_ELEC_ll (IEND(IL), IPROC_END)
- IEND_GLOB = IEND_GLOB + IEND(IL)
- END IF
- END DO
-END DO ! end do while
-!
-END SUBROUTINE CHARGE_POCKET
-!
-!-------------------------------------------------------------------------------
-!
- SUBROUTINE BRANCH_GEOM (IKMIN, IKMAX)
-!
-! Goal : find randomly flash branch points
-!
-!* 0. DECLARATIONS
-! ------------
-!
-use modd_precision, only: MNHINT64, MNHINT64_MPI
-
-IMPLICIT NONE
-!
-!* 0.1 declaration of dummy arguments
-!
-INTEGER, INTENT(IN) :: IKMIN, IKMAX
-!
-!* 0.2 declaration of local variables
-!
-INTEGER :: IIDECALB
-INTEGER :: IPLOOP ! loop index for the proc number
-INTEGER :: IMIN, IMAX
-INTEGER :: IAUX
-INTEGER :: INB_SEG_BEF ! nb of segments before branching
-INTEGER :: INB_SEG_AFT ! nb of segments after branching
-INTEGER :: INB_SEG_TO_BRANCH ! = NBRANCH_MAX-INB_SEG_BEF
-LOGICAL :: GRANDOM ! T = the gridpoints are chosen randomly
-INTEGER, DIMENSION(NPROC) :: INBPT_PROC
-REAL, DIMENSION(:), ALLOCATABLE :: ZAUX
-!
-INTEGER :: JI,JJ,JK,JIL , ICHOICE,IPOINT
-INTEGER, DIMENSION(NPROC+1) :: IDISPL
-INTEGER(kind=MNHINT64), DIMENSION(:), ALLOCATABLE :: I8VECT , I8VECT_LL
-INTEGER, DIMENSION(:), ALLOCATABLE :: IRANK , IRANK_LL , IORDER_LL
-!
-!
-!
-!* 1. ON EACH PROC, COUNT THE NUMBER OF POINTS AT DISTANCE D
-!* THAT CAN RECEIVE A BRANCH
-! ------------------------------------------------------
-CALL MPPDB_CHECK3DM("flash:: branch ZFLASH,IMASKQ_DIST",PRECISION,&
- ZFLASH(:,:,:,IL),IMASKQ_DIST*1.0)
-!
-IM = 1
-ISTOP = 0
-INB_SEG_BEF = COUNT(ZFLASH(IIB:IIE,IJB:IJE,IKB:IKE,IL) .NE. 0.)
-CALL SUM_ELEC_ll(INB_SEG_BEF)
-!
-INB_SEG_TO_BRANCH = NBRANCH_MAX - INB_SEG_BEF
-!
-DO WHILE (IM .LE. IDELTA_IND .AND. ISTOP .NE. 1)
-! number of points that can receive a branch in each proc
- IPT_DIST = COUNT(IMASKQ_DIST(IIB:IIE,IJB:IJE,IKB:IKE) .EQ. IM)
-! global number of points that can receive a branch
- IPT_DIST_GLOB = IPT_DIST
- CALL SUM_ELEC_ll (IPT_DIST_GLOB)
-!
- IF (IPT_DIST_GLOB .LE. INB_SEG_TO_BRANCH) THEN
- IF (IPT_DIST_GLOB .LE. IMAX_BRANCH(IM)) THEN
- GRANDOM = .FALSE.
- ELSE
- GRANDOM = .TRUE.
- END IF
- ELSE
- GRANDOM = .TRUE.
- END IF
-!
-!
-!* 2. DISTRIBUTE THE BRANCHES
-! -----------------------
-!
- IF (IPT_DIST_GLOB .GT. 0 .AND. INB_SEG_TO_BRANCH .NE. 0) THEN
- IF (.NOT. GRANDOM) THEN
- INB_SEG_TO_BRANCH = INB_SEG_TO_BRANCH - IPT_DIST_GLOB
-!
-!* 2.1 all points are selected
-!
- IF(IPT_DIST .GT. 0) THEN
- WHERE (IMASKQ_DIST(IIB:IIE,IJB:IJE,IKB:IKE) .EQ. IM)
- ZFLASH(IIB:IIE,IJB:IJE,IKB:IKE,IL) = 2.
- ZCELL(IIB:IIE,IJB:IJE,IKB:IKE,IL) = 0.
- END WHERE
- END IF
- ELSE
-!
-!* 2.2 the gridpoints are chosen randomly
-!
- IF (IMAX_BRANCH(IM) .GT. 0) THEN
- INBPT_PROC(:) = 0
- CALL MPI_ALLGATHER(IPT_DIST, 1, MNHINT_MPI, &
- INBPT_PROC, 1, MNHINT_MPI, NMNH_COMM_WORLD, IERR)
-!
- IDISPL(1) = 0
- DO JI=2, NPROC+1
- IDISPL(JI) = IDISPL(JI-1)+INBPT_PROC(JI-1)
- ENDDO
-!
- ALLOCATE (I8VECT(IPT_DIST))
- ALLOCATE (IRANK(IPT_DIST))
- IF (IPT_DIST .GT. 0) THEN
- JIL=0
- DO JK=IKB,IKE
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IF (IMASKQ_DIST(JI,JJ,JK) .EQ. IM) THEN
- JIL = JIL + 1
- I8VECT(JIL) = IJU_ll*IIU_ll*(JK-1) + IIU_ll*(JJ-1 +IYOR-1) + (JI +IXOR-1)
- !print*,"IN => I8VECT(JIL )=",I8VECT(JIL),JI,JJ,JK,JIL
- END IF
- END DO
- END DO
- END DO
- !
- IRANK(:) = IPROC
- END IF
-!
- ALLOCATE(I8VECT_LL(IPT_DIST_GLOB))
- ALLOCATE(IRANK_LL(IPT_DIST_GLOB))
- ALLOCATE(IORDER_LL(IPT_DIST_GLOB))
- CALL MPI_ALLGATHERV(I8VECT,IPT_DIST, MNHINT64_MPI,I8VECT_LL , &
- INBPT_PROC, IDISPL, MNHINT64_MPI, NMNH_COMM_WORLD, IERR)
- CALL MPI_ALLGATHERV(IRANK,IPT_DIST, MNHINT_MPI,IRANK_LL , &
- INBPT_PROC, IDISPL, MNHINT_MPI, NMNH_COMM_WORLD, IERR)
- CALL N8QUICK_SORT(I8VECT_LL, IORDER_LL)
-!
- DO IPOINT = 1, MIN(IMAX_BRANCH(IM), INB_SEG_TO_BRANCH)
- IFOUND = 0
- DO WHILE (IFOUND .NE. 1)
- ! randomly chose points in zvect
- CALL MNH_RANDOM_NUMBER(ZRANDOM)
- ICHOICE = INT(ANINT(ZRANDOM * IPT_DIST_GLOB))
- IF (ICHOICE .EQ. 0) ICHOICE = 1
- IF (I8VECT_LL(ICHOICE) .NE. 0 ) THEN
- IFOUND = 1
- ! The points is in this processors , get is coord and set it
- IF (IRANK_LL(IORDER_LL(ICHOICE)) .EQ. IPROC) THEN
- JK = 1 + (I8VECT_LL(ICHOICE)-1) / ( IJU_ll*IIU_ll )
- JJ = 1 + ( (I8VECT_LL(ICHOICE)-1) - IJU_ll*IIU_ll*(JK-1) ) / IIU_ll - IYOR +1
- JI = 1 + MOD((I8VECT_LL(ICHOICE)-1) , int(IIU_ll,kind(I8VECT_LL(1)))) - IXOR +1
- !print*,"OUT => I8VECT_LL(ICHOICE)=",I8VECT_ll(ICHOICE),JI,JJ,JK,ICHOICE
- ZFLASH(JI,JJ,JK,IL) = 2.
- END IF
- I8VECT_LL(ICHOICE) = 0
- ENDIF
- END DO
- END DO
-!
- INB_SEG_TO_BRANCH = INB_SEG_TO_BRANCH - MIN(IMAX_BRANCH(IM), INB_SEG_TO_BRANCH)
-!
- DEALLOCATE(I8VECT,I8VECT_LL,IRANK,IRANK_LL,IORDER_LL)
- CALL MPPDB_CHECK3DM("flash:: branch IPT_DIST ZFLASH",PRECISION,&
- ZFLASH(:,:,:,IL))
- END IF
- END IF !IPT_DIST .LE. IMAX_BRANCH(IM)
- ELSE
-! if no pt available at r, then no branching possible at r+dr !
- ISTOP = 1
- END IF ! end if ipt_dist > 0
-!
-! next distance
- CALL MPPDB_CHECK3DM("flash:: branch IM+1 ZFLASH",PRECISION,ZFLASH(:,:,:,IL))
- IM = IM + 1
-END DO ! end loop / do while / radius IM
-!
-INB_SEG_AFT = COUNT (ZFLASH(IIB:IIE,IJB:IJE,IKB:IKE,IL) .NE. 0.)
-CALL SUM_ELEC_ll(INB_SEG_AFT)
-!
-IF (INB_SEG_AFT .GT. INB_SEG_BEF) THEN
- DO II = IIB, IIE
- DO IJ = IJB, IJE
- DO IK = IKB, IKE
- IF (ZFLASH(II,IJ,IK,IL) .EQ. 2.) THEN
- IIDECALB = INBSEG(IL) * 3
-!
- ISEG_GLOB(IIDECALB+1,IL) = II + IXOR - 1
- ISEG_GLOB(IIDECALB+2,IL) = IJ + IYOR - 1
- ISEG_GLOB(IIDECALB+3,IL) = IK
-!
- ZCOORD_SEG(IIDECALB+1,IL) = XXHATM(II)
- ZCOORD_SEG(IIDECALB+2,IL) = XYHATM(IJ)
- ZCOORD_SEG(IIDECALB+3,IL) = ZZMASS(II,IJ,IK)
- INBSEG(IL) = INBSEG(IL) + 1
- END IF
- END DO
- END DO
- END DO
-END IF
-!
-CALL MPPDB_CHECK3DM("flash:: end branch ZFLASH",PRECISION,ZFLASH(:,:,:,IL))
-!
-END SUBROUTINE BRANCH_GEOM
-!
-!--------------------------------------------------------------------------------
-!
- SUBROUTINE GATHER_ALL_BRANCH
-!
-!!
-!! Purpose:
-!!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-INTEGER :: INSEGPROC, INSEGCELL ! number of segments in the process,
- ! and number of segments in the cell
-INTEGER :: ISAVEDECAL
-INTEGER :: INSEGTRIG, IPROCTRIG
-REAL, DIMENSION(:), ALLOCATABLE :: ZLMAQMT, ZLMAPRT, ZLMAPOS, ZLMANEG
-REAL, DIMENSION(:), ALLOCATABLE :: ZSEND, ZRECV
-INTEGER, DIMENSION(:), ALLOCATABLE :: ISEND, IRECV
-INTEGER, DIMENSION(NPROC) :: IDECAL, IDECAL3, IDECALN
-INTEGER, DIMENSION(NPROC) :: INBSEG_PROC_X3, INBSEG_PROC_XNSV
-!
-!
-IPROCTRIG = IPROC_TRIG(IL)
-INSEGCELL = INBSEG_ALL(IL)
-INSEGPROC = INBSEG_PROC(IPROC+1)
-INSEGTRIG = INBSEG_PROC(IPROCTRIG+1)
-!
-IDECAL(1) = INSEGTRIG
-DO IK = 2, NPROC
- IDECAL(IK) = IDECAL(IK-1) + INBSEG_PROC(IK-1)
-END DO
-!
-IF(IPROCTRIG .EQ. 0) ISAVEDECAL = IDECAL(IPROCTRIG+1)
-!
-IDECAL(IPROCTRIG+1) = 0
-DO IK = IPROCTRIG+2, NPROC
- IF(IPROCTRIG .EQ. 0) THEN
- IDECAL(IK) = IDECAL(IK) - ISAVEDECAL
- ELSE
- IDECAL(IK) = IDECAL(IK) - IDECAL(1)
- END IF
-END DO
-!
-IDECAL3(:) = 3 * IDECAL(:)
-!
-!
-!* 1. BRANCH COORDINATES
-!
-ALLOCATE (ZRECV(INSEGCELL*3))
-ALLOCATE (ZSEND(INSEGPROC*3))
-!
-IF (INSEGPROC .NE. 0) THEN
- ZSEND(1:3*INSEGPROC) = ZCOORD_SEG(1:3*INSEGPROC,IL)
-END IF
-!
-IF (IPROC .EQ. 0) THEN
- INBSEG_PROC_X3(:) = 3 * INBSEG_PROC(:)
-END IF
-!
-CALL MPI_GATHERV (ZSEND, 3*INSEGPROC, MNHREAL_MPI, ZRECV, INBSEG_PROC_X3, &
- IDECAL3, MNHREAL_MPI, 0, NMNH_COMM_WORLD, IERR)
-!
-IF (IPROC .EQ. 0) THEN
- ZCOORD_SEG_ALL(1:3*INSEGCELL,IL) = ZRECV(1:3*INSEGCELL)
-END IF
-!
-DEALLOCATE (ZRECV)
-DEALLOCATE (ZSEND)
-!
-!
-!* 2. FOR LMA-LIKE RESULTS: Charge, mixing ratio,
-!* neutralized positive/negative charge
-!* and grid index
-!
-IF (LLMA) THEN
- ALLOCATE (ISEND(3*INSEGPROC))
- ALLOCATE (ZLMAQMT(INSEGPROC*NSV_ELEC))
- ALLOCATE (ZLMAPRT(INSEGPROC*NSV_ELEC))
- ALLOCATE (ZLMAPOS(INSEGPROC))
- ALLOCATE (ZLMANEG(INSEGPROC))
-!
- ISEND (:) = 0
- ZLMAPOS(:) = 0.
- ZLMANEG(:) = 0.
- ZLMAQMT(:) = 0.
- ZLMAPRT(:) = 0.
-!
- IF (INSEGPROC .NE. 0) THEN
- DO II = 1, INSEGPROC
- IM = 3 * (II - 1)
- IX = ISEG_GLOB(IM+1,IL) - IXOR + 1
- IY = ISEG_GLOB(IM+2,IL) - IYOR + 1
- IZ = ISEG_GLOB(IM+3,IL)
-!
- IM = NSV_ELEC * (II - 1)
- IF (IX .LE. IIE .AND. IX .GE. IIB .AND. &
- IY .LE. IJE .AND. IY .GE. IJB) THEN
- ZLMAQMT(IM+2:IM+6) = ZQMT(IX,IY,IZ,2:6)
- ZLMAPRT(IM+2:IM+6) = PRT(IX,IY,IZ,2:6)
- DO IJ = 1, NSV_ELEC
- IF (ZDQDT(IX,IY,IZ,IJ) .GT. 0.) THEN
- ZLMAPOS(II) = ZLMAPOS(II) + &
- ZDQDT(IX,IY,IZ,IJ) * PRHODJ(IX,IY,IZ)
- ELSE IF (ZDQDT(IX,IY,IZ,IJ) .LT. 0.) THEN
- ZLMANEG(II) = ZLMANEG(II) + &
- ZDQDT(IX,IY,IZ,IJ) * PRHODJ(IX,IY,IZ)
- END IF
- END DO
- END IF
- END DO
-!
- ISEND(1:3*INSEGPROC) = ISEG_GLOB(1:3*INSEGPROC, IL)
- END IF
-!
-! Grid Indexes
-!
- ALLOCATE (IRECV(3*INSEGCELL))
-!
- CALL MPI_GATHERV (ISEND, 3*INSEGPROC, MNHINT_MPI, IRECV, INBSEG_PROC_X3, &
- IDECAL3, MNHINT_MPI, 0, NMNH_COMM_WORLD, IERR)
-!
- IF (IPROC .EQ. 0) THEN
- ILMA_SEG_ALL(1:3*INSEGCELL,IL) = IRECV(1:3*INSEGCELL)
- END IF
-!
- DEALLOCATE (IRECV)
- DEALLOCATE (ISEND)
-!
-! Neutralized charge at grid points
-!
- ALLOCATE (ZRECV(INSEGCELL))
-!
- CALL MPI_GATHERV (ZLMAPOS, INSEGPROC, MNHREAL_MPI, ZRECV, INBSEG_PROC, &
- IDECAL, MNHREAL_MPI, 0, NMNH_COMM_WORLD, IERR)
-!
- IF (IPROC .EQ. 0) THEN
- ZLMA_NEUT_POS(1:INSEGCELL,IL) = ZRECV(1:INSEGCELL)
- END IF
-!
- CALL MPI_GATHERV (ZLMANEG, INSEGPROC, MNHREAL_MPI, ZRECV, INBSEG_PROC, &
- IDECAL, MNHREAL_MPI, 0, NMNH_COMM_WORLD, IERR)
-!
- IF (IPROC .EQ. 0) THEN
- ZLMA_NEUT_NEG(1:INSEGCELL,IL) = ZRECV(1:INSEGCELL)
- END IF
-!
- DEALLOCATE (ZLMAPOS)
- DEALLOCATE (ZLMANEG)
- DEALLOCATE (ZRECV)
-!
-! Charge and mixing ratios at neutralized points
-!
- ALLOCATE (ZRECV(NSV_ELEC*INSEGCELL))
-!
- IDECALN(:) = IDECAL(:) * NSV_ELEC
-!
- IF (IPROC .EQ. 0) THEN
- INBSEG_PROC_XNSV(:) = NSV_ELEC * INBSEG_PROC(:)
- END IF
-!
- CALL MPI_GATHERV (ZLMAQMT, NSV_ELEC*INSEGPROC, MNHREAL_MPI, ZRECV, &
- INBSEG_PROC_XNSV, &
- IDECALN, MNHREAL_MPI, 0, NMNH_COMM_WORLD, IERR )
-!
- IF (IPROC .EQ. 0) THEN
- ZLMA_QMT(1:NSV_ELEC*INSEGCELL,IL) = ZRECV(1:NSV_ELEC*INSEGCELL)
- END IF
-!
- CALL MPI_GATHERV (ZLMAPRT, NSV_ELEC*INSEGPROC, MNHREAL_MPI, ZRECV, &
- INBSEG_PROC_XNSV, &
- IDECALN, MNHREAL_MPI, 0, NMNH_COMM_WORLD, IERR )
-!
- IF (IPROC .EQ. 0) THEN
- ZLMA_PRT(1:NSV_ELEC*INSEGCELL,IL) = ZRECV(1:NSV_ELEC*INSEGCELL)
- END IF
-!
- DEALLOCATE (ZLMAQMT)
- DEALLOCATE (ZLMAPRT)
- DEALLOCATE (ZRECV)
-!
-END IF
-!
-END SUBROUTINE GATHER_ALL_BRANCH
-!
-!--------------------------------------------------------------------------------
-!
- SUBROUTINE PT_DISCHARGE
-!
-!!
-!! Purpose:
-!!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!
-WHERE (ABS(PEFIELDW(:,:,IKB)) > XECORONA .AND. PEFIELDW(:,:,IKB) > 0.)
- PRSVS(:,:,IKB,1) = PRSVS(:,:,IKB,1) + &
- XFCORONA * PEFIELDW(:,:,IKB) * (ABS(PEFIELDW(:,:,IKB)) - &
- XECORONA)**2 / (PZZ(:,:,IKB+1) - PZZ(:,:,IKB))
-ENDWHERE
-!
-WHERE (ABS(PEFIELDW(:,:,IKB)) > XECORONA .AND. PEFIELDW(:,:,IKB) < 0.)
- PRSVS(:,:,IKB,NSV_ELEC) = PRSVS(:,:,IKB,NSV_ELEC) + &
- XFCORONA * PEFIELDW(:,:,IKB) * (ABS(PEFIELDW(:,:,IKB)) - &
- XECORONA)**2 / (PZZ(:,:,IKB+1) - PZZ(:,:,IKB))
-ENDWHERE
-!
-END SUBROUTINE PT_DISCHARGE
-!
-!----------------------------------------------------------------------------------
-!
- SUBROUTINE WRITE_OUT_ASCII
-!
-!!
-!! Purpose:
-!!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-INTEGER :: I1, I2
-INTEGER :: ILU ! unit number for IO
-!
-!
-!* 1. FLASH PARAMETERS
-! ----------------
-!
-ILU = TPFILE_FGEOM_DIAG%NLU
-!
-! Ecriture ascii dans CEXP//'_fgeom_diag.asc" defini dans RESOLVED_ELEC
-!
-IF (LCARTESIAN) THEN
- DO I1 = 1, NNBLIGHT
- WRITE (UNIT=ILU,FMT='(I8,F9.1,I4,I6,I4,I6,F9.3,F12.3,F12.3,F9.3,F8.2,F9.2,f9.4)') &
- ISFLASH_NUMBER(I1), &
- ISTCOUNT_NUMBER(I1) * PTSTEP, &
- ISCELL_NUMBER(I1), &
- ISNB_FLASH(I1), &
- ISTYPE(I1), &
- ISNBSEG(I1), &
- ZSEM_TRIG(I1), &
- ZSCOORD_SEG(I1,1,1)*1.E-3, &
- ZSCOORD_SEG(I1,1,2)*1.E-3, &
- ZSCOORD_SEG(I1,1,3)*1.E-3, &
- ZSNEUT_POS(I1), &
- ZSNEUT_NEG(I1), ZSNEUT_POS(I1)+ZSNEUT_NEG(I1)
- END DO
-ELSE
- DO I1 = 1, NNBLIGHT
-! compute latitude and longitude of the triggering point
- CALL SM_LATLON(XLATORI,XLONORI,ZSCOORD_SEG(I1,1,1),&
- ZSCOORD_SEG(I1,1,2),&
- ZLAT,ZLON)
-!
- WRITE (UNIT=ILU,FMT='(I8,F9.1,I4,I6,I4,I6,F9.3,F12.3,F12.3,F9.3,F8.2,F9.2,f9.4)') &
- ISFLASH_NUMBER(I1), &
- ISTCOUNT_NUMBER(I1) * PTSTEP, &
- ISCELL_NUMBER(I1), &
- ISNB_FLASH(I1), &
- ISTYPE(I1), &
- ISNBSEG(I1), &
- ZSEM_TRIG(I1), &
- ZLAT, &
- ZLON, &
- ZSCOORD_SEG(I1,1,3)*1.E-3, &
- ZSNEUT_POS(I1), &
- ZSNEUT_NEG(I1), ZSNEUT_POS(I1)+ZSNEUT_NEG(I1)
- END DO
-END IF
-!
-FLUSH(UNIT=ILU)
-!
-!
-!* 2. FLASH SEGMENT COORDINATES
-! -------------------------
-!
-IF (LSAVE_COORD) THEN
-!
-! Ecriture ascii dans CEXP//'_fgeom_coord.asc" defini dans RESOLVED_ELEC
-!
- ILU = TPFILE_FGEOM_COORD%NLU
-!
- DO I1 = 1, NNBLIGHT
- DO I2 = 1, ISNBSEG(I1)
- WRITE (ILU, FMT='(I4,F9.1,I4,F12.3,F12.3,F12.3)') &
- ISFLASH_NUMBER(I1), &
- ISTCOUNT_NUMBER(I1) * PTSTEP, &
- ISTYPE(I1), &
- ZSCOORD_SEG(I1,I2,1)*1.E-3, &
- ZSCOORD_SEG(I1,I2,2)*1.E-3, &
- ZSCOORD_SEG(I1,I2,3)*1.E-3
- END DO
- END DO
-!
- FLUSH(UNIT=ILU)
-END IF
-!
-END SUBROUTINE WRITE_OUT_ASCII
-!
-!-------------------------------------------------------------------------------
-!
-SUBROUTINE WRITE_OUT_LMA
-!
-!!
-!! Purpose:
-!!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-INTEGER :: I1, I2
-INTEGER :: ILU ! unit number for IO
-!
-!
-!* 1. LMA SIMULATOR
-! -------------
-!
-CALL SM_LATLON(XLATORI,XLONORI,ZSCOORD_SEG(:,:,1),ZSCOORD_SEG(:,:,2), &
- ZLMA_LAT(:,:),ZLMA_LON(:,:))
-!
-ILU = TPFILE_LMA%NLU
-!
-DO I1 = 1, NNBLIGHT
- DO I2 = 1, ISNBSEG(I1)
- WRITE (UNIT=ILU,FMT='(I6,F12.1,I6,2(F15.6),3(F15.3),3(I6),12(E15.4))') &
- ISFLASH_NUMBER(I1), &
- ISTCOUNT_NUMBER(I1) * PTSTEP, &
- ISTYPE(I1), &
- ZLMA_LAT(I1,I2), &
- ZLMA_LON(I1,I2), &
- ZSCOORD_SEG(I1,I2,1)*1.E-3, &
- ZSCOORD_SEG(I1,I2,2)*1.E-3, &
- ZSCOORD_SEG(I1,I2,3)*1.E-3, &
- ISLMA_SEG_GLOB(I1,I2,1), &
- ISLMA_SEG_GLOB(I1,I2,2), &
- ISLMA_SEG_GLOB(I1,I2,3), &
- ZSLMA_PRT(I1,I2,2), &
- ZSLMA_PRT(I1,I2,3), &
- ZSLMA_PRT(I1,I2,4), &
- ZSLMA_PRT(I1,I2,5), &
- ZSLMA_PRT(I1,I2,6), &
- ZSLMA_QMT(I1,I2,2), &
- ZSLMA_QMT(I1,I2,3), &
- ZSLMA_QMT(I1,I2,4), &
- ZSLMA_QMT(I1,I2,5), &
- ZSLMA_QMT(I1,I2,6), &
- ZSLMA_NEUT_POS(I1,I2), &
- ZSLMA_NEUT_NEG(I1,I2)
- END DO
-END DO
-!
-FLUSH(UNIT=ILU)
-!
-END SUBROUTINE WRITE_OUT_LMA
-!
-!-------------------------------------------------------------------------------
-!
-RECURSIVE SUBROUTINE N8QUICK_SORT(PLIST, KORDER)
-
-! Quick sort routine from:
-! Brainerd, W.S., Goldberg, C.H. & Adams, J.C. (1990) "Programmer's Guide to
-! Fortran 90", McGraw-Hill ISBN 0-07-000248-7, pages 149-150.
-! Modified by Alan Miller to include an associated integer array which gives
-! the positions of the elements in the original order.
-!
-use modd_precision, only: MNHINT64
-
-IMPLICIT NONE
-!
-INTEGER(kind=MNHINT64), DIMENSION (:), INTENT(INOUT) :: PLIST
-INTEGER, DIMENSION (:), INTENT(OUT) :: KORDER
-!
-! Local variable
-INTEGER :: JI
-
-DO JI = 1, SIZE(PLIST)
- KORDER(JI) = JI
-END DO
-
-CALL N8QUICK_SORT_1(1, SIZE(PLIST), PLIST, KORDER)
-
-END SUBROUTINE N8QUICK_SORT
-!
-!-------------------------------------------------------------------------------
-!
-RECURSIVE SUBROUTINE N8QUICK_SORT_1(KLEFT_END, KRIGHT_END, PLIST1, KORDER1)
-
-use modd_precision, only: MNHINT64
-
-implicit none
-
-INTEGER, INTENT(IN) :: KLEFT_END, KRIGHT_END
-INTEGER(kind=MNHINT64), DIMENSION (:), INTENT(INOUT) :: PLIST1
-INTEGER, DIMENSION (:), INTENT(INOUT) :: KORDER1
-! Local variables
-INTEGER, PARAMETER :: IMAX_SIMPLE_SORT_SIZE = 6
-
-INTEGER :: JI, JJ, ITEMP
-INTEGER(kind=MNHINT64) :: ZREF, ZTEMP
-
-IF (KRIGHT_END < KLEFT_END + IMAX_SIMPLE_SORT_SIZE) THEN
- ! Use interchange sort for small PLISTs
- CALL N8INTERCHANGE_SORT(KLEFT_END, KRIGHT_END, PLIST1, KORDER1)
- !
-ELSE
- !
- ! Use partition ("quick") sort
- ! valeur au centre du tableau
- ZREF = PLIST1((KLEFT_END + KRIGHT_END)/2)
- JI = KLEFT_END - 1
- JJ = KRIGHT_END + 1
-
- DO
- ! Scan PLIST from left end until element >= ZREF is found
- DO
- JI = JI + 1
- IF (PLIST1(JI) >= ZREF) EXIT
- END DO
- ! Scan PLIST from right end until element <= ZREF is found
- DO
- JJ = JJ - 1
- IF (PLIST1(JJ) <= ZREF) EXIT
- END DO
-
-
- IF (JI < JJ) THEN
- ! Swap two out-of-order elements
- ZTEMP = PLIST1(JI)
- PLIST1(JI) = PLIST1(JJ)
- PLIST1(JJ) = ZTEMP
- ITEMP = KORDER1(JI)
- KORDER1(JI) = KORDER1(JJ)
- KORDER1(JJ) = ITEMP
- ELSE IF (JI == JJ) THEN
- JI = JI + 1
- EXIT
- ELSE
- EXIT
- END IF
- END DO
-
- IF ( KLEFT_END < JJ ) CALL N8QUICK_SORT_1( KLEFT_END, JJ, PLIST1, KORDER1 )
- IF ( JI < KRIGHT_END ) CALL N8QUICK_SORT_1( JI, KRIGHT_END, PLIST1, KORDER1 )
-END IF
-
-END SUBROUTINE N8QUICK_SORT_1
-!
-!-------------------------------------------------------------------------------
-!
-SUBROUTINE N8INTERCHANGE_SORT(KLEFT_END, KRIGHT_END, PLIST2, KORDER2)
-
-use modd_precision, only: MNHINT64
-
-implicit none
-
-INTEGER, INTENT(IN) :: KLEFT_END, KRIGHT_END
-INTEGER(kind=MNHINT64), DIMENSION(:), INTENT(INOUT) :: PLIST2
-INTEGER, DIMENSION(:), INTENT(INOUT) :: KORDER2
-! Local variables
-INTEGER :: JI, JJ, ITEMP
-INTEGER(kind=MNHINT64) :: ZTEMP
-
-! boucle sur tous les points
-DO JI = KLEFT_END, KRIGHT_END - 1
- !
- ! boucle sur les points suivants le point JI
- DO JJ = JI+1, KRIGHT_END
- !
- ! si la distance de JI au point est plus grande que celle de JJ
- IF (PLIST2(JI) > PLIST2(JJ)) THEN
- ! distance de JI au point (la plus grande)
- ZTEMP = PLIST2(JI)
- ! le point JJ est déplacé à l'indice JI dans le tableau
- PLIST2(JI) = PLIST2(JJ)
- ! le point JI est déplacé à l'indice JJ dans le tableau
- PLIST2(JJ) = ZTEMP
- ! indice du point JI dans le tableau
- ITEMP = KORDER2(JI)
- ! l'indice du point JJ est mis à la place JI
- KORDER2(JI) = KORDER2(JJ)
- ! l'indice du point JI est mis à la place JJ
- KORDER2(JJ) = ITEMP
- END IF
- !
- END DO
- !
-END DO
-
-END SUBROUTINE N8INTERCHANGE_SORT
-!-------------------------------------------------------------------------------
- SUBROUTINE MNH_RANDOM_NUMBER(ZRANDOM)
-
- use modd_precision, only: MNHINT32
-
- REAL, INTENT(OUT) :: ZRANDOM
- INTEGER(kind=MNHINT32), SAVE :: NSEED_MNH = 26032012_MNHINT32
-
- ZRANDOM = real( r8_uniform_01( NSEED_MNH ), kind(ZRANDOM) )
-
- END SUBROUTINE MNH_RANDOM_NUMBER
-
-!------------------------------------------------------------------------------------------
-
- FUNCTION r8_uniform_01 ( seed )
-
- !*****************************************************************************80
- !
- !! R8_UNIFORM_01 returns a unit pseudorandom R8.
- !
- ! Discussion:
- !
- ! An R8 is a real ( kind = 8 ) value.
- !
- ! For now, the input quantity SEED is an integer variable.
- !
- ! This routine implements the recursion
- !
- ! seed = ( 16807 * seed ) mod ( 2^31 - 1 )
- ! r8_uniform_01 = seed / ( 2^31 - 1 )
- !
- ! The integer arithmetic never requires more than 32 bits,
- ! including a sign bit.
- !
- ! If the initial seed is 12345, then the first three computations are
- !
- ! Input Output R8_UNIFORM_01
- ! SEED SEED
- !
- ! 12345 207482415 0.096616
- ! 207482415 1790989824 0.833995
- ! 1790989824 2035175616 0.947702
- !
- ! Licensing:
- !
- ! This code is distributed under the GNU LGPL license.
- ! Souce here : https://people.sc.fsu.edu/~jburkardt/f_src/uniform/uniform.f90
- !
- ! Modified:
- !
- ! 31 May 2007
- !
- ! Author:
- !
- ! John Burkardt
- !
- ! Reference:
- !
- ! Paul Bratley, Bennett Fox, Linus Schrage,
- ! A Guide to Simulation,
- ! Second Edition,
- ! Springer, 1987,
- ! ISBN: 0387964673,
- ! LC: QA76.9.C65.B73.
- !
- ! Bennett Fox,
- ! Algorithm 647:
- ! Implementation and Relative Efficiency of Quasirandom
- ! Sequence Generators,
- ! ACM Transactions on Mathematical Software,
- ! Volume 12, Number 4, December 1986, pages 362-376.
- !
- ! Pierre L'Ecuyer,
- ! Random Number Generation,
- ! in Handbook of Simulation,
- ! edited by Jerry Banks,
- ! Wiley, 1998,
- ! ISBN: 0471134031,
- ! LC: T57.62.H37.
- !
- ! Peter Lewis, Allen Goodman, James Miller,
- ! A Pseudo-Random Number Generator for the System/360,
- ! IBM Systems Journal,
- ! Volume 8, Number 2, 1969, pages 136-143.
- !
- ! Parameters:
- !
- ! Input/output, integer ( kind = MNHINT32 ) SEED, the "seed" value, which should
- ! NOT be 0. On output, SEED has been updated.
- !
- ! Output, real ( kind = MNHREAL64 ) R8_UNIFORM_01, a new pseudorandom variate,
- ! strictly between 0 and 1.
- !
- use modd_precision, only: MNHINT32, MNHREAL64
-
- implicit none
-
- integer(kind = MNHINT32), intent(inout) :: seed
- real(kind=MNHREAL64) :: r8_uniform_01
-
- integer(kind = MNHINT32), parameter :: i4_huge = 2147483647_MNHINT32
-
- integer(kind = MNHINT32) :: k
-
- if ( seed == 0_MNHINT32 ) THEN
- call Print_msg( NVERB_FATAL, 'GEN', 'r8_uniform_01', 'seed dummy argument must be different of 0' )
- end if
-
- k = seed / 127773_MNHINT32
-
- seed = 16807_MNHINT32 * ( seed - k * 127773_MNHINT32 ) - k * 2836_MNHINT32
-
- if ( seed < 0_MNHINT32 ) then
- seed = seed + i4_huge
- end if
-
- r8_uniform_01 = real(seed) * 4.656612875d-10
-
- return
- end function r8_uniform_01
-!
-END SUBROUTINE FLASH_GEOM_ELEC_n
-!
-!-------------------------------------------------------------------------------
diff --git a/src/mesonh/ext/goto_model_wrapper.f90 b/src/mesonh/ext/goto_model_wrapper.f90
deleted file mode 100644
index b09f1e3fd7c811b0676753fb95e6c8129548fb87..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/goto_model_wrapper.f90
+++ /dev/null
@@ -1,249 +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.
-!-----------------------------------------------------------------
-!! MODIFICATIONS
-!! -------------
-!! 06/12 (Tomasini) Grid-nesting of ADVFRC and EDDY_FLUX
-!! 07/13 (Bosseur & Filippi) adds Forefire
-!! 2014 (Faivre)
-!! 2016 (Leriche) Add MODD_CH_ICE Suppress MODD_CH_DEP_n
-!! Modification 01/2016 (JP Pinty) Add LIMA
-!! 10/2016 (F Brosse) Add prod/loss terms computation for chemistry
-!! 07/2017 (M.Leriche) Add DIAG chimical surface fluxes
-! 02/2018 Q.Libois ECRAD
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! 2017 V.Vionnet blow snow
-! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
-! F. Auguste 02/21: add IBM
-! T. Nagel 02/21: add turbulence recycling
-! P. Wautelet 27/04/2022: add namelist for profilers
-! P. Wautelet 10/02/2023: add Blaze variables
-!-----------------------------------------------------------------
-MODULE MODI_GOTO_MODEL_WRAPPER
-
-INTERFACE
-SUBROUTINE GOTO_MODEL_WRAPPER(KFROM, KTO, ONOFIELDLIST)
-INTEGER, INTENT(IN) :: KFROM, KTO
-LOGICAL, OPTIONAL, INTENT(IN) :: ONOFIELDLIST
-END SUBROUTINE GOTO_MODEL_WRAPPER
-END INTERFACE
-
-END MODULE MODI_GOTO_MODEL_WRAPPER
-
-SUBROUTINE GOTO_MODEL_WRAPPER(KFROM, KTO, ONOFIELDLIST)
-! all USE modd*_n modules
-USE MODD_ADVFRC_n
-USE MODD_ADV_n
-USE MODD_ALLPROFILER_n
-USE MODD_ALLSTATION_n
-USE MODD_BIKHARDT_n
-USE MODD_BLANK_n
-USE MODD_BLOWSNOW_n
-USE MODD_CH_AERO_n
-USE MODD_CH_BUDGET_n
-USE MODD_CH_FLX_n
-USE MODD_CH_ICE_n
-USE MODD_CH_JVALUES_n
-USE MODD_CH_M9_n
-USE MODD_CH_MNHC_n
-USE MODD_CH_PH_n
-USE MODD_CH_PRODLOSSTOT_n
-USE MODD_CH_ROSENBROCK_n
-USE MODD_CH_SOLVER_n
-USE MODD_CLOUDPAR_n
-USE MODD_PARAM_ICE_n
-USE MODD_PARAM_LIMA, ONLY: PARAM_LIMA_ASSOCIATE !not yet a '_n' module
-USE MODD_RAIN_ICE_PARAM_n
-USE MODD_RAIN_ICE_DESCR_n
-USE MODD_CLOUD_MF_n
-USE MODD_CONF_n
-USE MODD_CURVCOR_n
-USE MODD_DIM_n
-USE MODD_DRAG_n
-USE MODD_DRAGTREE_n
-USE MODD_DRAGBLDG_n
-USE MODD_DUMMY_GR_FIELD_n
-USE MODD_DYN_n
-USE MODD_DYNZD_n
-USE MODD_ELEC_n
-USE MODD_FIELD_n
-USE MODD_FIRE_n
-#ifdef MNH_FOREFIRE
-USE MODD_FOREFIRE_n
-#endif
-USE MODD_FRC_n
-USE MODD_GET_n
-USE MODD_GR_FIELD_n
-USE MODD_IBM_LSF
-USE MODD_IBM_PARAM_n
-USE MODD_IO_SURF_MNH
-USE MODD_LBC_n
-USE MODD_LES_n
-USE MODD_LSFIELD_n
-USE MODD_LUNIT_n
-USE MODD_MEAN_FIELD_n
-USE MODD_METRICS_n
-USE MODD_NEST_PGD_n
-USE MODD_NUDGING_n
-USE MODD_OUT_n
-USE MODD_PACK_GR_FIELD_n
-USE MODD_PARAM_KAFR_n
-USE MODD_PARAM_MFSHALL_n
-USE MODD_PARAM_n
-USE MODD_PARAM_RAD_n
-USE MODD_PARAM_ECRAD_n
-USE MODD_PASPOL_n
-USE MODD_PAST_FIELD_n
-USE MODD_PRECIP_n
-USE MODD_PROFILER_n
-USE MODD_RADIATIONS_n
-USE MODD_RBK90_Global_n
-USE MODD_RBK90_JacobianSP_n
-USE MODD_RBK90_Parameters_n
-USE MODD_RECYCL_PARAM_n
-USE MODD_REF_n
-USE MODD_RELFRC_n
-USE MODD_SECPGD_FIELD_n
-USE MODD_SERIES_n
-USE MODD_SHADOWS_n
-USE MODD_STATION_n
-USE MODD_SUB_CH_FIELD_VALUE_n
-USE MODD_SUB_CH_MONITOR_n
-USE MODD_SUB_ELEC_n
-USE MODD_SUB_MODEL_n
-USE MODD_SUB_PASPOL_n
-USE MODD_SUB_PHYS_PARAM_n
-USE MODD_TIMEZ
-USE MODD_TURB_n
-USE MODD_NEB_n, ONLY: NEB_GOTO_MODEL
-!
-!
-use mode_field, only: Fieldlist_goto_model
-use mode_msg
-!
-!
-IMPLICIT NONE
-!
-INTEGER, INTENT(IN) :: KFROM, KTO
-LOGICAL, OPTIONAL, INTENT(IN) :: ONOFIELDLIST
-!
-CHARACTER(LEN=64) :: YMSG
-LOGICAL :: GNOFIELDLIST
-!
-WRITE(YMSG,'( I4,"->",I4 )') KFROM,KTO
-CALL PRINT_MSG(NVERB_DEBUG,'GEN','GOTO_MODEL_WRAPPER',TRIM(YMSG))
-!
-IF (PRESENT(ONOFIELDLIST)) THEN
- GNOFIELDLIST = ONOFIELDLIST
-ELSE
- GNOFIELDLIST = .FALSE.
-END IF
-!
-! All calls to specific modd_*n goto_model routines
-!
-CALL ADV_GOTO_MODEL(KFROM, KTO)
-CALL BIKHARDT_GOTO_MODEL(KFROM, KTO)
-CALL BLANK_GOTO_MODEL(KFROM,KTO)
-CALL CH_AERO_GOTO_MODEL(KFROM,KTO)
-CALL CH_FLX_GOTO_MODEL(KFROM, KTO)
-CALL CH_JVALUES_GOTO_MODEL(KFROM, KTO)
-CALL CH_MNHC_GOTO_MODEL(KFROM, KTO)
-CALL CH_SOLVER_GOTO_MODEL(KFROM, KTO)
-CALL CLOUDPAR_GOTO_MODEL(KFROM, KTO)
-CALL PARAM_ICE_GOTO_MODEL(KFROM, KTO)
-CALL PARAM_LIMA_ASSOCIATE() !Not yet a goto_model but put here for simplicity and to prepare the transformation into a '_n' module
-CALL RAIN_ICE_PARAM_GOTO_MODEL(KFROM, KTO)
-CALL RAIN_ICE_DESCR_GOTO_MODEL(KFROM, KTO)
-CALL CLOUD_MF_GOTO_MODEL(KFROM, KTO)
-CALL CONF_GOTO_MODEL(KFROM, KTO)
-CALL CURVCOR_GOTO_MODEL(KFROM, KTO)
-!CALL DEEP_CONVECTION_GOTO_MODEL(KFROM, KTO)
-CALL DIM_GOTO_MODEL(KFROM, KTO)
-CALL DRAGTREE_GOTO_MODEL(KFROM, KTO)
-CALL DRAGBLDG_GOTO_MODEL(KFROM, KTO)
-CALL DUMMY_GR_FIELD_GOTO_MODEL(KFROM, KTO)
-CALL DYN_GOTO_MODEL(KFROM, KTO)
-CALL DYNZD_GOTO_MODEL(KFROM,KTO)
-CALL FIELD_GOTO_MODEL(KFROM, KTO)
-!CALL PAST_FIELD_GOTO_MODEL(KFROM, KTO)
-CALL GET_GOTO_MODEL(KFROM, KTO)
-!CALL GR_FIELD_GOTO_MODEL(KFROM, KTO)
-!$20140403 add grid_conf_proj_goto_model
-!CALL GRID_CONF_PROJ_GOTO_MODEL(KFROM,KTO)
-!$
-!CALL GRID_GOTO_MODEL(KFROM, KTO)
-!CALL HURR_FIELD_GOTO_MODEL(KFROM, KTO)
-!$20140403 add io_surf_mnh_goto_model!!
-CALL IO_SURF_MNH_GOTO_MODEL(KFROM, KTO)
-!$
-CALL LBC_GOTO_MODEL(KFROM, KTO)
-CALL LES_GOTO_MODEL(KFROM, KTO)
-CALL LSFIELD_GOTO_MODEL(KFROM, KTO)
-CALL LUNIT_GOTO_MODEL(KFROM, KTO)
-CALL MEAN_FIELD_GOTO_MODEL(KFROM, KTO)
-CALL METRICS_GOTO_MODEL(KFROM, KTO)
-CALL NEST_PGD_GOTO_MODEL(KFROM, KTO)
-CALL NUDGING_GOTO_MODEL(KFROM, KTO)
-CALL OUT_GOTO_MODEL(KFROM, KTO)
-CALL PACK_GR_FIELD_GOTO_MODEL(KFROM, KTO)
-CALL PARAM_KAFR_GOTO_MODEL(KFROM, KTO)
-CALL PARAM_MFSHALL_GOTO_MODEL(KFROM, KTO)
-CALL PARAM_GOTO_MODEL(KFROM, KTO)
-CALL PARAM_RAD_GOTO_MODEL(KFROM, KTO)
-#ifdef MNH_ECRAD
-CALL PARAM_ECRAD_GOTO_MODEL(KFROM, KTO)
-#endif
-CALL PASPOL_GOTO_MODEL(KFROM, KTO)
-#ifdef MNH_FOREFIRE
-CALL FOREFIRE_GOTO_MODEL(KFROM, KTO)
-#endif
-CALL FIRE_GOTO_MODEL( KFROM, KTO )
-!CALL PRECIP_GOTO_MODEL(KFROM, KTO)
-CALL ELEC_GOTO_MODEL(KFROM, KTO)
-CALL RADIATIONS_GOTO_MODEL(KFROM, KTO)
-CALL SHADOWS_GOTO_MODEL(KFROM, KTO)
-CALL REF_GOTO_MODEL(KFROM, KTO)
-CALL FRC_GOTO_MODEL(KFROM, KTO)
-CALL SECPGD_FIELD_GOTO_MODEL(KFROM, KTO)
-CALL SERIES_GOTO_MODEL(KFROM, KTO)
-CALL PROFILER_GOTO_MODEL(KFROM, KTO)
-CALL STATION_GOTO_MODEL(KFROM, KTO)
-CALL ALLPROFILER_GOTO_MODEL(KFROM, KTO)
-CALL ALLSTATION_GOTO_MODEL(KFROM, KTO)
-CALL SUB_CH_FIELD_VALUE_GOTO_MODEL(KFROM, KTO)
-CALL SUB_CH_MONITOR_GOTO_MODEL(KFROM, KTO)
-CALL SUB_MODEL_GOTO_MODEL(KFROM, KTO)
-CALL SUB_PHYS_PARAM_GOTO_MODEL(KFROM, KTO)
-CALL SUB_PASPOL_GOTO_MODEL(KFROM, KTO)
-CALL SUB_ELEC_GOTO_MODEL(KFROM, KTO)
-!CALL TIME_GOTO_MODEL(KFROM, KTO)
-CALL TURB_GOTO_MODEL(KFROM, KTO)
-CALL NEB_GOTO_MODEL(KFROM, KTO)
-CALL DRAG_GOTO_MODEL(KFROM, KTO)
-CALL TIMEZ_GOTO_MODEL(KFROM, KTO)
-CALL CH_PH_GOTO_MODEL(KFROM, KTO)
-CALL CH_ICE_GOTO_MODEL(KFROM, KTO)
-CALL CH_M9_GOTO_MODEL(KFROM, KTO)
-CALL CH_ROSENBROCK_GOTO_MODEL(KFROM, KTO)
-CALL RBK90_Global_GOTO_MODEL(KFROM, KTO)
-CALL RBK90_JacobianSP_GOTO_MODEL(KFROM, KTO)
-CALL RBK90_Parameters_GOTO_MODEL(KFROM, KTO)
-!
-!CALL LIMA_PRECIP_SCAVENGING_GOTO_MODEL(KFROM, KTO)
-!
-!CALL EDDY_FLUX_GOTO_MODEL(KFROM, KTO)
-!CALL EDDYUV_FLUX_GOTO_MODEL(KFROM, KTO)
-CALL ADVFRC_GOTO_MODEL(KFROM, KTO)
-CALL RELFRC_GOTO_MODEL(KFROM, KTO)
-CALL CH_PRODLOSSTOT_GOTO_MODEL(KFROM,KTO)
-CALL CH_BUDGET_GOTO_MODEL(KFROM,KTO)
-CALL BLOWSNOW_GOTO_MODEL(KFROM, KTO)
-CALL IBM_GOTO_MODEL(KFROM, KTO)
-CALL RECYCL_GOTO_MODEL(KFROM, KTO)
-CALL LSF_GOTO_MODEL(KFROM, KTO)
-!
-IF (.NOT.GNOFIELDLIST) CALL FIELDLIST_GOTO_MODEL(KFROM, KTO)
-!
-END SUBROUTINE GOTO_MODEL_WRAPPER
diff --git a/src/mesonh/ext/ground_paramn.f90 b/src/mesonh/ext/ground_paramn.f90
deleted file mode 100644
index 39b041f029d5530d188328c3dd9ae9518ba2271d..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/ground_paramn.f90
+++ /dev/null
@@ -1,1269 +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.
-!-----------------------------------------------------------------
-! ##########
-MODULE MODI_GROUND_PARAM_n
-! ##########
-!
-INTERFACE
-!
- SUBROUTINE GROUND_PARAM_n(D, PSFTH, PSFRV, PSFSV, PSFCO2, PSFU, PSFV, &
- PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD, KTCOUNT, TPFILE )
-!
-USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
-!* surface fluxes
-! --------------
-!
-USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
-USE MODD_IO, ONLY: TFILEDATA
-!
-TYPE(DIMPHYEX_t), INTENT(IN) :: D
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH ! surface flux of potential temperature (Km/s)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV ! surface flux of water vapor (m/s*kg/kg)
-REAL, DIMENSION(:,:,:),INTENT(OUT):: PSFSV ! surface flux of scalar (m/s*kg/kg)
- ! flux of chemical var. (ppv.m/s)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSFCO2! surface flux of CO2 (m/s*kg/kg)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSFU ! surface fluxes of horizontal
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSFV ! momentum in x and y directions (m2/s2)
-!
-!* Radiative parameters
-! --------------------
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDIR_ALB ! direct albedo for each spectral band (-)
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSCA_ALB ! diffuse albedo for each spectral band (-)
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEMIS ! surface emissivity (-)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTSRAD ! surface radiative temperature (K)
-!
-INTEGER, INTENT(IN) :: KTCOUNT ! temporal iteration count
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Synchronous output file
-END SUBROUTINE GROUND_PARAM_n
-!
-END INTERFACE
-!
-END MODULE MODI_GROUND_PARAM_n
-!
- SUBROUTINE GROUND_PARAM_n(D, PSFTH, PSFRV, PSFSV, PSFCO2, PSFU, PSFV, &
- PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD, KTCOUNT, TPFILE )
-! ###############################################################################
-!
-!
-!!**** *GROUND_PARAM*
-!!
-!! PURPOSE
-!! -------
-! Monitor to call the externalized surface
-!
-!!** METHOD
-!! ------
-!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Noilhan and Planton (1989)
-!!
-!! AUTHOR
-!! ------
-!! S. Belair * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 10/03/95
-!! (J.Stein) 25/10/95 add the rain flux computation at the ground
-!! and the lbc
-!! (J.Stein) 15/11/95 include the strong slopes cases
-!! (J.Stein) 06/02/96 bug correction for the precipitation flux writing
-!! (J.Stein) 20/05/96 set the right IGRID value for the rain rate
-!! (J.Viviand) 04/02/97 add cold and convective precipitation rate
-!! (J.Stein) 22/06/97 use the absolute pressure
-!! (V.Masson) 09/07/97 add directional z0 computations and RESA correction
-!! (V.Masson) 13/02/98 merge the ISBA and TSZ0 routines,
-!! rename the routine as a monitor, called by PHYS_PARAMn
-!! add the town parameterization
-!! recomputes z0 where snow is.
-!! pack and unpack of 2D fields into 1D fields
-!! (V.Masson) 04/01/00 removes the TSZ0 case
-! (F.Solmon/V.Masson) adapatation for patch approach
-! modification of internal subroutine pack/ allocation in function
-! of patch indices
-! calling of isba for each defined patch
-! averaging of patch fluxes to get nat fluxes
-! (P. Tulet/G.Guenais) 04/02/01 separation of vegetatives class
-! for friction velocity and
-! aerodynamical resistance
-! (S Donnier) 09/12/02 add specific humidity at 2m for diagnostic
-! (V.Masson) 01/03/03 externalisation of the surface schemes!
-! (P.Tulet ) 01/11/03 externalisation of the surface chemistry!
-!! (D.Gazen) 01/12/03 change emissions handling for surf. externalization
-!! (J.escobar) 18/10/2012 missing USE MODI_COUPLING_SURF_ATM_n & MODI_DIAG_SURF_ATM_n
-! (J.escobar) 02/2014 add Forefire coupling
-!! (G.Delautier) 06/2016 phasage surfex 8
-!! (B.Vie) 2016 LIMA
-!! (J.Pianezze) 08/2016 add send/recv oasis functions
-!! (M.Leriche) 24/03/16 remove flag for chemical surface fluxes
-!! (M.Leriche) 01/07/2017 Add DIAG chimical surface fluxes
-!! 01/2018 (G.Delautier) SURFEX 8.1
-!! 02/2018 Q.Libois ECRAD
-!! (P.Wautelet) 28/03/2018 replace TEMPORAL_DIST by DATETIME_DISTANCE
-
-!! (V. Vionnet) 18/07/2017 add coupling for blowing snow module
-!! (Bielli S.) 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
-! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
-! A. Costes 12/2021: Blaze Fire model
-! P. Wautelet 09/02/2022: bugfix: add missing XCURRENT_LEI computation
-! P. Wautelet 30/09/2022: bugfix: missing communications for SWDIFF, SWDIR and LEI
-! P. Wautelet 30/09/2022: bugfix: use XUNDEF from SURFEX for surface variables computed by SURFEX
-! P. Wautelet 21/10/2022: bugfix: communicate halo values between processes for OUT variables
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-#ifdef CPLOASIS
-USE MODI_GET_HALO
-USE MODI_MNH_OASIS_RECV
-USE MODI_MNH_OASIS_SEND
-USE MODD_SFX_OASIS, ONLY : LOASIS
-USE MODD_DYN, ONLY : XSEGLEN
-USE MODD_DYN_n, ONLY : DYN_MODEL
-#endif
-!
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_BUDGET, ONLY: LBUDGET_TH, LBUDGET_RV, NBUDGET_RV, NBUDGET_TH,TBUDGETS
-USE MODE_BUDGET, ONLY: BUDGET_STORE_INIT, BUDGET_STORE_END
-USE MODD_CST, ONLY : XP00, XCPD, XRD, XRV,XRHOLW, XDAY, XPI, XLVTT, XMD, XAVOGADRO
-USE MODD_DIMPHYEX, ONLY : DIMPHYEX_t
-USE MODD_PARAMETERS, ONLY : JPVEXT
-USE MODD_DYN_n, ONLY : XTSTEP
-USE MODD_CH_MNHC_n, ONLY : LUSECHEM
-USE MODD_FIELD_n, ONLY : XUT, XVT, XWT, XTHT, XRT, XPABST, XSVT, XTKET, XZWS, XRTHS, XRRS
-USE MODD_FIRE_n, ONLY : XLSPHI, XBMAP, XFMR0, XFMRFA, XFMWF0, XFMR00, XFMIGNITION, XFMFUELTYPE, &
- XFIRETAU, XFLUXPARAMH, XFLUXPARAMW, XFIRERW, XFMASE, XFMAWC, XFMWALKIG, &
- XFMFLUXHDH, XFMFLUXHDW, XFMHWS, XFMWINDU, XFMWINDV, XFMWINDW, XGRADLSPHIX, &
- XGRADLSPHIY, XFIREWIND, XFMGRADOROX, XFMGRADOROY
-USE MODD_METRICS_n, ONLY : XDXX, XDYY, XDZZ
-USE MODD_DIM_n, ONLY : NKMAX
-USE MODD_GRID_n, ONLY : XLON, XZZ, XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
- XCOSSLOPE, XSINSLOPE, XZS
-USE MODD_REF_n, ONLY : XEXNREF, XRHODREF, XRHODJ
-USE MODD_CONF_n, ONLY : NRR
-USE MODD_PARAM_n, ONLY : CDCONV,CCLOUD, CRAD
-USE MODD_PRECIP_n, ONLY : XINPRC, XINPRR, XINPRS, XINPRG, XINPRH
-USE MODD_DEEP_CONVECTION_n, ONLY : XPRCONV, XPRSCONV
-USE MODD_CONF, ONLY : LCARTESIAN, CPROGRAM
-USE MODD_TIME_n, ONLY : TDTCUR
-USE MODD_RADIATIONS_n, ONLY : XFLALWD, XCCO2, XTSIDER, &
- XSW_BANDS, XDIRSRFSWD, XSCAFLASWD, &
- XZENITH, XAZIM, XAER, XSWU, XLWU
-USE MODD_NSV
-USE MODD_GRID, ONLY : XLON0, XRPK, XBETA
-USE MODD_PARAM_ICE_n, ONLY : LSEDIC
-USE MODD_PARAM_C2R2, ONLY : LSEDC
-USE MODD_DIAG_IN_RUN
-USE MODD_DUST, ONLY : LDUST
-USE MODD_SALT, ONLY : LSALT
-USE MODD_BLOWSNOW
-USE MODD_BLOWSNOW_n
-USE MODD_CH_AEROSOL, ONLY : LORILAM
-USE MODD_CSTS_DUST, ONLY : XMOLARWEIGHT_DUST
-USE MODD_CSTS_SALT, ONLY : XMOLARWEIGHT_SALT
-USE MODD_CH_FLX_n, ONLY : XCHFLX
-USE MODD_DIAG_FLAG, ONLY : LCHEMDIAG
-USE MODD_SURF_PAR, ONLY: XUNDEF_SFX => XUNDEF
-USE MODD_PRECISION, ONLY: MNHTIME
-!
-USE MODI_NORMAL_INTERPOL
-USE MODE_ROTATE_WIND, ONLY: ROTATE_WIND
-USE MODI_SHUMAN
-USE MODI_MNHGET_SURF_PARAM_n
-USE MODI_COUPLING_SURF_ATM_n
-USE MODI_DIAG_SURF_ATM_n
-USE MODD_MNH_SURFEX_n
-!
-USE MODE_DATETIME
-USE MODE_ll
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-#ifdef MNH_FOREFIRE
-!** MODULES FOR FOREFIRE **!
-USE MODD_FOREFIRE
-USE MODD_FOREFIRE_n
-USE MODI_COUPLING_FOREFIRE_n
-#endif
-!
-USE MODD_TIME_n
-USE MODD_TIME
-!
-USE MODD_PARAM_LIMA, ONLY : MSEDC=>LSEDC
-!
-USE MODD_FIRE_n
-USE MODD_FIELD
-USE MODE_FIRE_MODEL
-USE MODD_CONF, ONLY : NVERB, NHALO
-USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
-USE MODE_MSG
-USE MODD_IO, ONLY: TFILEDATA
-!
-IMPLICIT NONE
-!
-!
-!
-!* 0.1 declarations of arguments
-!
-!* surface fluxes
-! --------------
-!
-TYPE(DIMPHYEX_t), INTENT(IN) :: D
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH ! surface flux of potential temperature (Km/s)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV ! surface flux of water vapor (m/s*kg/kg)
-REAL, DIMENSION(:,:,:),INTENT(OUT):: PSFSV ! surface flux of scalar (m/s*kg/kg)
- ! flux of chemical var. (ppv.m/s)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSFCO2! surface flux of CO2 (m/s*kg/kg)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSFU ! surface fluxes of horizontal
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSFV ! momentum in x and y directions (m2/s2)
-!
-!* Radiative parameters
-! --------------------
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDIR_ALB ! direct albedo for each spectral band (-)
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSCA_ALB ! diffuse albedo for each spectral band (-)
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEMIS ! surface emissivity (-)
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTSRAD ! surface radiative temperature (K)
-!
-INTEGER, INTENT(IN) :: KTCOUNT ! temporal iteration count
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Synchronous output file
-!
-!-------------------------------------------------------------------------------
-!
-!
-!
-!* 0.2 declarations of local variables
-! -------------------------------
-!
-!
-!* Atmospheric variables
-! ---------------------
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRV ! vapor mixing ratio
-!
-! suffix 'A' stands for atmospheric variable at first model level
-!
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZZREF ! Forcing height
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZTA ! Temperature
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZRVA ! vapor mixing ratio
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZQA ! humidity (kg/m3)
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZPA ! Pressure
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZPS ! Pressure
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZEXNA ! Exner function
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZEXNS ! Exner function
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZTHA ! potential temperature
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZRAIN ! liquid precipitation (kg/m2/s)
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSNOW ! solid precipitation (kg/m2/s)
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZTSUN ! solar time (s since midnight)
-!
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZUA ! u component of the wind
-! ! parallel to the orography
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZVA ! v component of the wind
-! ! parallel to the orography
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZU ! zonal wind
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZV ! meridian wind
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZWIND ! wind parallel to the orography
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZRHOA ! air density
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZDIR ! wind direction (rad from N clockwise)
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFU ! zonal momentum flux
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFV ! meridian momentum flux
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZCO2 ! CO2 concentration (kg/kg)
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZALFA ! angle between the wind
-! ! and the x axis
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2),1):: ZU2D ! u and v component of the
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2),1):: ZV2D ! wind at mass point
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTH ! Turbulent flux of heat
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTQ ! Turbulent flux of water
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFCO2 ! Turbulent flux of CO2
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2),NSV):: ZSFTS! Turbulent flux of scalar
-!
-REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2),NBLOWSNOW_2D) :: ZBLOWSNOW_2D ! 2D blowing snow variables
- ! after advection
- ! They refer to the 2D fields advected by MNH including:
- ! - total number concentration in Canopy
- ! - total mass concentration in Canopy
- ! - equivalent concentration in the saltation layer
-!
-!* Dimensions
-! ----------
-!
-INTEGER :: IIB ! physical boundary
-INTEGER :: IIE ! physical boundary
-INTEGER :: IJB ! physical boundary
-INTEGER :: IJE ! physical boundary
-INTEGER :: IKB ! physical boundary
-INTEGER :: IKE ! physical boundary
-INTEGER :: IKU ! vertical array sizes
-!
-INTEGER :: JLAYER ! loop counter
-INTEGER :: JSV ! loop counter
-INTEGER :: JI,JJ,JK ! loop index
-!
-INTEGER :: IDIM1 ! X physical dimension
-INTEGER :: IDIM2 ! Y physical dimension
-INTEGER :: IDIM1D! total physical dimension
-INTEGER :: IKRAD
-!
-INTEGER :: KSV_SURF ! Number of scalar variables sent to SURFEX
-!
-!* Arrays put in 1D vectors
-! ------------------------
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_TSUN ! solar time
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZENITH ! zenithal angle
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_AZIM ! azimuthal angle
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZREF ! forcing height
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZS ! orography
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_U ! zonal wind
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_V ! meridian wind
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_QA ! air humidity (kg/m3)
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_TA ! air temperature
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_RHOA ! air density
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SV ! scalar at first atmospheric level
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_CO2 ! air CO2 concentration
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_RAIN ! liquid precipitation
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_SNOW ! solid precipitation
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_LW ! incoming longwave
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_DIR_SW ! direct incoming shortwave
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SCA_SW ! diffuse incoming shortwave
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_PS ! surface pressure
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_PA ! pressure at first atmospheric level
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZWS ! significant wave height (m)
-
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTQ ! water vapor flux
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTH ! potential temperature flux
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SFTS ! scalar flux
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFCO2 ! CO2 flux
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFU ! zonal momentum flux
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFV ! meridian momentum flux
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_TSRAD ! radiative surface temperature
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_DIR_ALB ! direct albedo
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SCA_ALB ! diffuse albedo
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_EMIS ! emissivity
-
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_TSURF
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_Z0
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_Z0H
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_QSURF
-
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_PEW_A_COEF ! coefficients for
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_PEW_B_COEF ! implicit coupling
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_PET_A_COEF
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_PEQ_A_COEF
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_PET_B_COEF
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_PEQ_B_COEF
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_RN ! net radiation (W/m2)
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_H ! sensible heat flux (W/m2)
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_LE ! Total latent heat flux (W/m2)
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_LEI ! Solid Latent heat flux (W/m2)
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_GFLUX ! ground flux (W/m2)
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_T2M ! Air temperature at 2 meters (K)
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_Q2M ! Air humidity at 2 meters (kg/kg)
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_HU2M ! Air relative humidity at 2 meters (-)
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZON10M ! zonal Wind at 10 meters (m/s)
-REAL, DIMENSION(:), ALLOCATABLE :: ZP_MER10M ! meridian Wind at 10 meters (m/s)
-TYPE(LIST_ll), POINTER :: TZFIELDSURF_ll ! list of fields to exchange
-INTEGER :: IINFO_ll ! return code of parallel routine
-!
-!
-CHARACTER(LEN=6) :: YJSV
-CHARACTER(LEN=6), DIMENSION(:), ALLOCATABLE :: YSV_SURF ! name of the scalar variables
- ! sent to SURFEX
-!
-REAL :: ZTIMEC
-INTEGER :: ILUOUT ! logical unit
-!
-! Fire model
-REAL(KIND=MNHTIME), DIMENSION(2) :: ZFIRETIME1, ZFIRETIME2 ! CPU time for Blaze perf profiling
-REAL(KIND=MNHTIME), DIMENSION(2) :: ZGRADTIME1, ZGRADTIME2 ! CPU time for Blaze perf profiling
-REAL(KIND=MNHTIME), DIMENSION(2) :: ZPROPAGTIME1, ZPROPAGTIME2 ! CPU time for Blaze perf profiling
-REAL(KIND=MNHTIME), DIMENSION(2) :: ZFLUXTIME1, ZFLUXTIME2 ! CPU time for Blaze perf profiling
-REAL(KIND=MNHTIME), DIMENSION(2) :: ZROSWINDTIME1, ZROSWINDTIME2 ! CPU time for Blaze perf profiling
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZFIREFUELMAP ! Fuel map
-CHARACTER(LEN=7) :: YFUELMAPFILE ! Fuel Map file name
-TYPE(LIST_ll), POINTER :: TZFIELDFIRE_ll ! list of fields to exchange
-
-!-------------------------------------------------------------------------------
-!
-!
-ILUOUT=TLUOUT%NLU
-IKB= 1+JPVEXT
-IKU=NKMAX + 2* JPVEXT
-IKE=IKU-JPVEXT
-!
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-!
-PSFTH = XUNDEF_SFX
-PSFRV = XUNDEF_SFX
-PSFSV = XUNDEF_SFX
-PSFCO2 = XUNDEF_SFX
-PSFU = XUNDEF_SFX
-PSFV = XUNDEF_SFX
-PDIR_ALB = XUNDEF_SFX
-PSCA_ALB = XUNDEF_SFX
-PEMIS = XUNDEF_SFX
-PTSRAD = XUNDEF_SFX
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. CONVERSION OF THE ATMOSPHERIC VARIABLES
-! ---------------------------------------
-!
-! 1.1 water vapor
-! -----------
-
-!
-ALLOCATE(ZRV(SIZE(PSFTH,1),SIZE(PSFTH,2),IKU))
-!
-IF(NRR>0) THEN
- ZRV(:,:,:)=XRT(:,:,:,1)
-ELSE
- ZRV(:,:,:)=0.
-END IF
-!
-! 1.2 Horizontal wind direction (rad from N clockwise)
-! -------------------------
-!
-ZU2D(:,:,:)=MXF(XUT(:,:,IKB:IKB))
-ZV2D(:,:,:)=MYF(XVT(:,:,IKB:IKB))
-!
-!* angle between Y axis and wind (rad., clockwise)
-!
-ZALFA = 0.
-WHERE(ZU2D(:,:,1)/=0. .OR. ZV2D(:,:,1)/=0.)
- ZALFA(:,:)=ATAN2(ZU2D(:,:,1),ZV2D(:,:,1))
-END WHERE
-WHERE(ZALFA(:,:)<0.) ZALFA(:,:) = ZALFA(:,:) + 2. * XPI
-!
-!* angle between North and wind (rad., clockwise)
-!
-IF (.NOT. LCARTESIAN) THEN
- ZDIR = ( (XRPK*(XLON(:,:)-XLON0)) - XBETA ) * XPI/180. + ZALFA
-ELSE
- ZDIR = - XBETA * XPI/180. + ZALFA
-END IF
-!
-!
-! 1.3 Rotate the wind
-! ---------------
-!
-CALL ROTATE_WIND( D, XUT, XVT, XWT, &
- XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
- XCOSSLOPE, XSINSLOPE, &
- XDXX, XDYY, XDZZ, &
- ZUA, ZVA )
-!
-! 1.4 zonal and meridian components of the wind parallel to the slope
-! ---------------------------------------------------------------
-!
-ZWIND(:,:) = SQRT( ZUA**2 + ZVA**2 )
-!
-ZU(:,:) = ZWIND(:,:) * SIN(ZDIR)
-ZV(:,:) = ZWIND(:,:) * COS(ZDIR)
-!
-! 1.5 Horizontal interpolation the thermodynamic fields
-! -------------------------------------------------
-!
-CALL NORMAL_INTERPOL(XTHT,ZRV,XPABST, &
- XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
- XCOSSLOPE,XSINSLOPE, &
- XDXX,XDYY,XDZZ, &
- ZTHA,ZRVA,ZEXNA )
-!
-DEALLOCATE(ZRV)
-!
-!
-! 1.6 Pressure and Exner function
-! ---------------------------
-!
-!
-ZPA(:,:) = XP00 * ZEXNA(:,:) **(XCPD/XRD)
-!
-ZEXNS(:,:) = 0.5 * ( (XPABST(:,:,IKB-1)/XP00)**(XRD/XCPD) &
- +(XPABST(:,:,IKB )/XP00)**(XRD/XCPD) &
- )
-ZPS(:,:) = XP00 * ZEXNS(:,:) **(XCPD/XRD)
-!
-! 1.7 humidity in kg/m3 from the mixing ratio
-! ---------------------------------------
-!
-!
-ZQA(:,:) = ZRVA(:,:) * XRHODREF(:,:,IKB)
-!
-!
-! 1.8 Temperature from the potential temperature
-! ------------------------------------------
-!
-!
-ZTA(:,:) = ZTHA(:,:) * ZEXNA(:,:)
-!
-!
-! 1.9 Air density
-! -----------
-!
-ZRHOA(:,:) = ZPA(:,:)/(XRD * ZTA(:,:) * ((1. + (XRD/XRV)*ZRVA(:,:))/ &
- (1. + ZRVA(:,:))))
-!
-!
-! 1.10 Precipitations
-! --------------
-!
-ZRAIN=0.
-ZSNOW=0.
-IF (NRR>2 .AND. SIZE(XINPRR)>0 ) THEN
- IF (( CCLOUD(1:3) == 'ICE' .AND. LSEDIC) .OR. &
- ((CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO') .AND. LSEDC) .OR. &
- ( CCLOUD=='LIMA' .AND. MSEDC)) THEN
- ZRAIN = ZRAIN + XINPRR * XRHOLW + XINPRC * XRHOLW
- ELSE
- ZRAIN = ZRAIN + XINPRR * XRHOLW
- END IF
-END IF
-IF (CDCONV == 'KAFR') THEN
- ZRAIN = ZRAIN + (XPRCONV - XPRSCONV) * XRHOLW
- ZSNOW = ZSNOW + XPRSCONV * XRHOLW
-END IF
-IF( NRR >= 5 .AND. SIZE(XINPRS)>0 ) ZSNOW = ZSNOW + XINPRS * XRHOLW
-IF( NRR >= 6 .AND. SIZE(XINPRG)>0 ) ZSNOW = ZSNOW + XINPRG * XRHOLW
-IF( NRR >= 7 .AND. SIZE(XINPRH)>0 ) ZSNOW = ZSNOW + XINPRH * XRHOLW
-!
-!
-! 1.11 Solar time
-! ----------
-!
-IF (.NOT. LCARTESIAN) THEN
- ZTSUN(:,:) = MOD(TDTCUR%xtime -XTSIDER*3600. +XLON(:,:)*240., XDAY)
-ELSE
- ZTSUN(:,:) = MOD(TDTCUR%xtime -XTSIDER*3600. +XLON0 *240., XDAY)
-END IF
-!
-! 1.12 Forcing level
-! -------------
-!
-ZZREF(:,:) = 0.5*( XZZ(:,:,IKB+1)-XZZ(:,:,IKB) )*XDIRCOSZW(:,:)
-!
-!
-! 1.13 CO2 concentration (kg/m3)
-! -----------------
-!
-ZCO2(:,:) = XCCO2 * XRHODREF(:,:,IKB)
-!
-!
-!
-! 1.14 Blowing snow scheme (optional)
-! -----------------
-!
-ZBLOWSNOW_2D=0.
-
-IF(LBLOWSNOW) THEN
- KSV_SURF = NSV+NBLOWSNOW_2D ! When blowing snow scheme is used
- ! NBLOWSN0W_2D variables are sent to SURFEX through ZP_SV.
- ! They refer to the 2D fields advected by MNH including:
- ! - total number concentration in Canopy
- ! - total mass concentration in Canopy
- ! - equivalent concentration in the saltation layer
- ! Initialize array of scalar to be sent to SURFEX including 2D blowing snow fields
- ALLOCATE(YSV_SURF(KSV_SURF))
- YSV_SURF(1:NSV) = CSV(:)
- YSV_SURF(NSV+1:KSV_SURF) = YPBLOWSNOW_2D(:)
-
-
- DO JSV=1,NBLOWSNOW_2D
- ZBLOWSNOW_2D(:,:,JSV) = XRSNWCANOS(:,:,JSV)*XTSTEP/XRHODJ(:,:,IKB)
- END DO
-
-ELSE
- KSV_SURF = NSV
- ALLOCATE(YSV_SURF(KSV_SURF))
- YSV_SURF(:) = CSV(1:NSV)
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. Call to surface monitor with 2D variables
-! -----------------------------------------
-!
-!
-! initial values:
-!
-IDIM1 = IIE-IIB+1
-IDIM2 = IJE-IJB+1
-IDIM1D = IDIM1*IDIM2
-!
-!
-! Transform 2D input fields into 1D:
-!
-CALL RESHAPE_SURF(IDIM1D)
-!
-! call to have the cumulated time since beginning of simulation
-!
-CALL DATETIME_DISTANCE(TDTSEG,TDTCUR,ZTIMEC)
-
-#ifdef CPLOASIS
-IF (LOASIS) THEN
- IF ( MOD(ZTIMEC,1.0) .LE. 1E-2 .OR. (1.0 - MOD(ZTIMEC,1.0)) .LE. 1E-2 ) THEN
- IF ( NINT(ZTIMEC-(XSEGLEN-DYN_MODEL(1)%XTSTEP)) .LT. 0 ) THEN
- WRITE(ILUOUT,*) '----------------------------'
- WRITE(ILUOUT,*) ' Reception des champs avec OASIS'
- WRITE(ILUOUT,*) 'NINT(ZTIMEC)=', NINT(ZTIMEC)
- CALL MNH_OASIS_RECV(CPROGRAM,IDIM1D,SIZE(XSW_BANDS),ZTIMEC+XTSTEP,XTSTEP, &
- ZP_ZENITH,XSW_BANDS , &
- ZP_TSRAD,ZP_DIR_ALB,ZP_SCA_ALB,ZP_EMIS,ZP_TSURF)
- WRITE(ILUOUT,*) '----------------------------'
- END IF
- END IF
-END IF
-#endif
-!
-! Call to surface schemes
-!
-CALL COUPLING_SURF_ATM_n(YSURF_CUR,'MESONH', 'E',ZTIMEC, &
- XTSTEP, TDTCUR%nyear, TDTCUR%nmonth, TDTCUR%nday, TDTCUR%xtime, &
- IDIM1D,KSV_SURF,SIZE(XSW_BANDS), &
- ZP_TSUN, ZP_ZENITH,ZP_ZENITH, ZP_AZIM, &
- ZP_ZREF, ZP_ZREF, ZP_ZS, ZP_U, ZP_V, ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, ZP_CO2, YSV_SURF, &
- ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, XSW_BANDS, ZP_PS, ZP_PA, &
- ZP_SFTQ, ZP_SFTH, ZP_SFTS, ZP_SFCO2, ZP_SFU, ZP_SFV, &
- ZP_TSRAD, ZP_DIR_ALB, ZP_SCA_ALB, ZP_EMIS, ZP_TSURF, ZP_Z0, ZP_Z0H, ZP_QSURF, &
- ZP_PEW_A_COEF, ZP_PEW_B_COEF, &
- ZP_PET_A_COEF, ZP_PEQ_A_COEF, ZP_PET_B_COEF, ZP_PEQ_B_COEF,ZP_ZWS, &
- 'OK' )
-!
-#ifdef CPLOASIS
-IF (LOASIS) THEN
- IF ( MOD(ZTIMEC,1.0) .LE. 1E-2 .OR. (1.0 - MOD(ZTIMEC,1.0)) .LE. 1E-2 ) THEN
- IF (NINT(ZTIMEC-(XSEGLEN-DYN_MODEL(1)%XTSTEP)) .LT. 0) THEN
- WRITE(ILUOUT,*) '----------------------------'
- WRITE(ILUOUT,*) ' Envoi des champs avec OASIS'
- WRITE(ILUOUT,*) 'NINT(ZTIMEC)=', NINT(ZTIMEC)
- CALL MNH_OASIS_SEND(CPROGRAM,IDIM1D,ZTIMEC+XTSTEP,XTSTEP)
- WRITE(ILUOUT,*) '----------------------------'
- END IF
- END IF
-END IF
-#endif
-!
-IF (CPROGRAM=='DIAG ' .OR. LDIAG_IN_RUN) THEN
- CALL DIAG_SURF_ATM_n(YSURF_CUR,'MESONH')
- CALL MNHGET_SURF_PARAM_n( PRN = ZP_RN, PH = ZP_H, PLE = ZP_LE, PLEI = ZP_LEI, &
- PGFLUX = ZP_GFLUX, PT2M = ZP_T2M, PQ2M = ZP_Q2M, PHU2M = ZP_HU2M, &
- PZON10M = ZP_ZON10M, PMER10M = ZP_MER10M )
-END IF
-!
-! Transform 1D output fields into 2D:
-!
-CALL UNSHAPE_SURF(IDIM1,IDIM2)
-#ifdef MNH_FOREFIRE
-!------------------------!
-! COUPLING WITH FOREFIRE !
-!------------------------!
-
-IF ( LFOREFIRE ) THEN
- CALL FOREFIRE_DUMP_FIELDS_n(XUT, XVT, XWT, XSVT&
- , XTHT, XRT(:,:,:,1), XPABST, XTKET&
- , IDIM1+2, IDIM2+2, NKMAX+2)
-END IF
-
-IF ( FFCOUPLING ) THEN
-
- CALL SEND_GROUND_WIND_n(XUT, XVT, IKB, IINFO_ll)
-
- CALL FOREFIRE_RECEIVE_PARAL_n()
-
- CALL COUPLING_FOREFIRE_n(XTSTEP, ZSFTH, ZSFTQ, ZSFTS)
-
- CALL FOREFIRE_SEND_PARAL_n(IINFO_ll)
-
-END IF
-
-FF_TIME = FF_TIME + XTSTEP
-#endif
-!
-! Friction of components along slope axes (U: largest local slope axis, V: zero slope axis)
-!
-!
-PSFU(:,:) = 0.
-PSFV(:,:) = 0.
-!
-WHERE (ZSFU(:,:)/=XUNDEF_SFX .AND. ZWIND(:,:)>0.)
- PSFU(:,:) = - SQRT(ZSFU**2+ZSFV**2) * ZUA(:,:) / ZWIND(:,:) / XRHODREF(:,:,IKB)
- PSFV(:,:) = - SQRT(ZSFU**2+ZSFV**2) * ZVA(:,:) / ZWIND(:,:) / XRHODREF(:,:,IKB)
-END WHERE
-!
-
-!* 2.1 Blaze Fire Model
-! ----------------
-!
-IF (LBLAZE) THEN
- ! get start time
- CALL SECOND_MNH2( ZFIRETIME1 )
-
- !* 2.1.1 Local variables allocation
- ! --------------------------
- !
-
- ! Parallel fuel
- NULLIFY(TZFIELDFIRE_ll)
- IF (KTCOUNT <= 1) THEN
- ! fuelmap
- SELECT CASE (CPROPAG_MODEL)
- CASE('SANTONI2011')
- !
- ALLOCATE( ZFIREFUELMAP(SIZE(XLSPHI,1), SIZE(XLSPHI,2), SIZE(XLSPHI,3), 22) );
- ! Parallel fuel
- CALL ADD4DFIELD_ll( TZFIELDFIRE_ll, ZFIREFUELMAP(:,:,:,1::22), 'MODEL_n::ZFIREFUELMAP' )
- ! Default value
- ZFIREFUELMAP(:,:,:,:) = 0.
- END SELECT
-
- !* 2.1.2 Read fuel map file
- ! ------------------
- !
- ! Fuel map file name
- YFUELMAPFILE = 'FuelMap'
- !
- CALL FIRE_READFUEL( TPFILE, ZFIREFUELMAP, XFMIGNITION, XFMWALKIG )
-
- !* 2.1.3 Ignition LS function with ignition map
- ! --------------------------------------
- !
- SELECT CASE (CFIRE_CPL_MODE)
- CASE('2WAYCPL', 'ATM2FIR')
- ! force ignition
- WHERE (XFMIGNITION <= TDTCUR%XTIME ) XLSPHI = 1.
- ! walking ignition
- CALL FIRE_LS_RECONSTRUCTION_FROM_BMAP( XLSPHI, XFMWALKIG, 0.)
- !
- !* 2.1.4 Update BMAP
- ! -----------
- !
- WHERE (XLSPHI >= .5 .AND. XBMAP < 0) XBMAP = TDTCUR%XTIME
- !
- CASE('FIR2ATM')
- CALL FIRE_READBMAP(TPFILE,XBMAP)
-
- END SELECT
- !
- !* 2.1.5 Compute R0, A, Wf0, R00
- ! -----------------------
- !
- SELECT CASE (CPROPAG_MODEL)
- CASE('SANTONI2011')
- CALL FIRE_NOWINDROS( ZFIREFUELMAP, XFMR0, XFMRFA, XFMWF0, XFMR00, XFMFUELTYPE, XFIRETAU, XFLUXPARAMH, &
- XFLUXPARAMW, XFMASE, XFMAWC )
- END SELECT
- !
- !* 2.1.6 Compute orographic gradient
- ! ---------------------------
- CALL FIRE_GRAD_OROGRAPHY( XZS, XFMGRADOROX, XFMGRADOROY )
- !
- !* 2.1.7 Test halo size
- ! --------------
- IF (NHALO < 2 .AND. NFIRE_WENO_ORDER == 3) THEN
- CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'GROUND_PARAM_n', 'BLAZE-FIRE: WENO3 fire gradient calculation needs NHALO >= 2' )
- ELSE IF (NHALO < 3 .AND. NFIRE_WENO_ORDER == 5) THEN
- CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'GROUND_PARAM_n', 'BLAZE-FIRE: WENO5 fire gradient calculation needs NHALO >= 3' )
- END IF
- !
- END IF
- !
- !* 2.1.6 Compute grad of level set function phi
- ! --------------------------------------
- !
- SELECT CASE (CFIRE_CPL_MODE)
- CASE('2WAYCPL', 'ATM2FIR')
- ! get time 1
- CALL SECOND_MNH2( ZGRADTIME1 )
- CALL FIRE_GRADPHI( XLSPHI, XGRADLSPHIX, XGRADLSPHIY )
-
- ! get time 2
- CALL SECOND_MNH2( ZGRADTIME2 )
- XGRADPERF = XGRADPERF + ZGRADTIME2 - ZGRADTIME1
- !
- !* 2.1.7 Get horizontal wind speed projected on LS gradient direction
- ! ------------------------------------------------------------
- !
- CALL FIRE_GETWIND( XUT, XVT, XWT, XGRADLSPHIX, XGRADLSPHIY, XFIREWIND, KTCOUNT, XTSTEP, XFMGRADOROX, XFMGRADOROY )
- !
- !* 2.1.8 Compute ROS XFIRERW with wind
- ! -----------------------------
- !
- !
- SELECT CASE (CPROPAG_MODEL)
- CASE('SANTONI2011')
- CALL FIRE_RATEOFSPREAD( XFMFUELTYPE, XFMR0, XFMRFA, XFMWF0, XFMR00, XFIREWIND, XGRADLSPHIX, XGRADLSPHIY, &
- XFMGRADOROX, XFMGRADOROY, XFIRERW )
- END SELECT
- CALL SECOND_MNH2( ZROSWINDTIME2 )
- XROSWINDPERF = XROSWINDPERF + ZROSWINDTIME2 - ZGRADTIME2
- !
- !* 2.1.8 Integrate model on atm time step to propagate
- ! ---------------------------------------------
- !
- SELECT CASE (CPROPAG_MODEL)
- CASE('SANTONI2011')
- CALL FIRE_PROPAGATE( XLSPHI, XBMAP, XFMIGNITION, XFMWALKIG, XGRADLSPHIX, XGRADLSPHIY, XTSTEP, XFIRERW )
- END SELECT
- CALL SECOND_MNH2( ZPROPAGTIME2 )
- XPROPAGPERF = XPROPAGPERF + ZPROPAGTIME2 - ZROSWINDTIME2
- !
- CASE('FIR2ATM')
- !
- CALL SECOND_MNH2( ZPROPAGTIME1 )
- CALL FIRE_LS_RECONSTRUCTION_FROM_BMAP( XLSPHI, XBMAP, XTSTEP )
- CALL SECOND_MNH2( ZPROPAGTIME2 )
- XPROPAGPERF = XPROPAGPERF + ZPROPAGTIME2 - ZPROPAGTIME1
- XGRADPERF(:) = 0.
- !
- END SELECT
- !
- !* 2.1.8 Compute fluxes
- ! --------------
- !
- IF (LBUDGET_RV) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_RV), 'BLAZE', XRRS(:,:,:,1))
- IF (LBUDGET_TH) CALL BUDGET_STORE_INIT(TBUDGETS(NBUDGET_TH), 'BLAZE', XRTHS(:,:,:))
- !
- SELECT CASE (CFIRE_CPL_MODE)
- CASE('2WAYCPL','FIR2ATM')
- CALL SECOND_MNH2( ZFLUXTIME1 )
- ! 2 way coupling
- CALL FIRE_HEATFLUXES( XLSPHI, XBMAP, XFIRETAU, XTSTEP, XFLUXPARAMH, XFLUXPARAMW, XFMFLUXHDH, XFMFLUXHDW, XFMASE, XFMAWC )
- !
- ! vertical distribution of fire heat fluxes
- CALL FIRE_VERTICALFLUXDISTRIB( XFMFLUXHDH, XFMFLUXHDW, XRTHS, XRRS, ZSFTS, XEXNREF, XRHODJ, XRT, XRHODREF )
- !
- CALL SECOND_MNH2( ZFLUXTIME2 )
- XFLUXPERF = XFLUXPERF + ZFLUXTIME2 - ZFLUXTIME1
- CASE DEFAULT
- XFLUXPERF(:) = 0.
- END SELECT
- !
- IF (LBUDGET_RV) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_RV), 'BLAZE', XRRS(:,:,:,1))
- IF (LBUDGET_TH) CALL BUDGET_STORE_END(TBUDGETS(NBUDGET_TH), 'BLAZE', XRTHS(:,:,:))
- !
- ! get end time
- CALL SECOND_MNH2( ZFIRETIME2 )
- ! add to Blaze time
- XFIREPERF = XFIREPERF + ZFIRETIME2 - ZFIRETIME1
-END IF
-!* conversion from H (W/m2) to w'Theta'
-!
-PSFTH(:,:) = ZSFTH(:,:) / XCPD / XRHODREF(:,:,IKB)
-!
-!
-!* conversion from water flux (kg/m2/s) to w'rv'
-!
-PSFRV(:,:) = ZSFTQ(:,:) / XRHODREF(:,:,IKB)
-!
-!
-!* conversion from scalar flux (kg/m2/s) to w'rsv'
-!
-IF(NSV .GT. 0) THEN
- DO JSV=1,NSV
- PSFSV(:,:,JSV) = ZSFTS(:,:,JSV) / XRHODREF(:,:,IKB)
- END DO
-END IF
-!
-!* conversion from chemistry flux (molec/m2/s) to (ppv.m.s-1)
-!
-IF (LUSECHEM) THEN
- DO JSV=NSV_CHEMBEG,NSV_CHEMEND
- PSFSV(:,:,JSV) = ZSFTS(:,:,JSV) * XMD / ( XAVOGADRO * XRHODREF(:,:,IKB))
- IF ((LCHEMDIAG).AND.(CPROGRAM == 'DIAG ')) XCHFLX(:,:,JSV-NSV_CHEMBEG+1) = PSFSV(:,:,JSV)
- END DO
-ELSE
- PSFSV(:,:,NSV_CHEMBEG:NSV_CHEMEND) = 0.
-END IF
-!
-!* conversion from dust flux (kg/m2/s) to (ppv.m.s-1)
-!
-IF (LDUST) THEN
- DO JSV=NSV_DSTBEG,NSV_DSTEND
- PSFSV(:,:,JSV) = ZSFTS(:,:,JSV) * XMD / (XMOLARWEIGHT_DUST * XRHODREF(:,:,IKB))
- END DO
-ELSE
- PSFSV(:,:,NSV_DSTBEG:NSV_DSTEND) = 0.
-END IF
-!
-!* conversion from sea salt flux (kg/m2/s) to (ppv.m.s-1)
-!
-IF (LSALT) THEN
- DO JSV=NSV_SLTBEG,NSV_SLTEND
- PSFSV(:,:,JSV) = ZSFTS(:,:,JSV) * XMD / (XMOLARWEIGHT_SALT * XRHODREF(:,:,IKB))
- END DO
-ELSE
- PSFSV(:,:,NSV_SLTBEG:NSV_SLTEND) = 0.
-END IF
-!
-!* conversion from aerosol flux (molec/m2/s) to (ppv.m.s-1)
-!
-IF (LORILAM) THEN
- DO JSV=NSV_AERBEG,NSV_AEREND
- PSFSV(:,:,JSV) = ZSFTS(:,:,JSV) * XMD / ( XAVOGADRO * XRHODREF(:,:,IKB))
- END DO
-ELSE
- PSFSV(:,:,NSV_AERBEG:NSV_AEREND) = 0.
-END IF
-!
-!* conversion from blowing snow flux (kg/m2/s) to [kg(snow)/kg(dry air).m.s-1]
-!
-IF (LBLOWSNOW) THEN
- DO JSV=NSV_SNWBEG,NSV_SNWEND
- PSFSV(:,:,JSV) = ZSFTS(:,:,JSV)/ (ZRHOA(:,:))
- END DO
- !* Update tendency for blowing snow 2D fields
- DO JSV=1,(NBLOWSNOW_2D)
- XRSNWCANOS(:,:,JSV) = ZBLOWSNOW_2D(:,:,JSV)*XRHODJ(:,:,IKB)/(XTSTEP*ZRHOA(:,:))
- END DO
-
-ELSE
- PSFSV(:,:,NSV_SNWBEG:NSV_SNWEND) = 0.
-END IF
-!
-!* conversion from CO2 flux (kg/m2/s) to w'CO2'
-!
-PSFCO2(:,:) = ZSFCO2(:,:) / XRHODREF(:,:,IKB)
-!
-! Communicate halo values
-!
-NULLIFY(TZFIELDSURF_ll)
-!The commented communications are done in PHYS_PARAM_n
-! CALL ADD2DFIELD_ll( TZFIELDSURF_ll,PSFTH, 'GROUND_PARAM_n::PSFTH' )
-! CALL ADD2DFIELD_ll( TZFIELDSURF_ll,PSFRV, 'GROUND_PARAM_n::PSFRV' )
-! DO JSV = 1, NSV
-! WRITE( YJSV, '( I6.6 )' ) JSV
-! CALL ADD2DFIELD_ll( TZFIELDSURF_ll,PSFSV(:,:,JSV), 'GROUND_PARAM_n::PSFSV'//YJSV )
-! END DO
-! CALL ADD2DFIELD_ll( TZFIELDSURF_ll,PSFCO2, 'GROUND_PARAM_n::PSFCO2' )
-! CALL ADD2DFIELD_ll( TZFIELDSURF_ll,PSFU, 'GROUND_PARAM_n::PSFU' )
-! CALL ADD2DFIELD_ll( TZFIELDSURF_ll,PSFV, 'GROUND_PARAM_n::PSFV' )
-DO JLAYER = 1, SIZE( PDIR_ALB, 3 )
- WRITE( YJSV, '( I6.6 )' ) JLAYER
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,PDIR_ALB(:,:,JLAYER), 'GROUND_PARAM_n::PDIR_ALB'//YJSV )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,PSCA_ALB(:,:,JLAYER), 'GROUND_PARAM_n::PSCA_ALB'//YJSV )
-END DO
-DO JLAYER = 1, SIZE( PEMIS, 3 )
- WRITE( YJSV, '( I6.6 )' ) JLAYER
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,PEMIS(:,:,JLAYER), 'GROUND_PARAM_n::PEMIS'//YJSV )
-END DO
-CALL ADD2DFIELD_ll( TZFIELDSURF_ll,PTSRAD, 'GROUND_PARAM_n::PTSRAD' )
-
-CALL UPDATE_HALO_ll(TZFIELDSURF_ll,IINFO_ll)
-CALL CLEANLIST_ll(TZFIELDSURF_ll)
-!
-!* Diagnostics
-! -----------
-!
-!
-IF (LDIAG_IN_RUN) THEN
- !
- XCURRENT_SFCO2(:,:) = ZSFCO2(:,:)
- XCURRENT_DSTAOD(:,:)=0.0
- XCURRENT_SLTAOD(:,:)=0.0
- IF (CRAD/='NONE') THEN
- XCURRENT_LWD (:,:) = XFLALWD(:,:)
- XCURRENT_SWD (:,:) = SUM(XDIRSRFSWD(:,:,:)+XSCAFLASWD(:,:,:),DIM=3)
- XCURRENT_LWU (:,:) = XLWU(:,:,IKB)
- XCURRENT_SWU (:,:) = XSWU(:,:,IKB)
- XCURRENT_SWDIR(:,:) = SUM(XDIRSRFSWD,DIM=3)
- XCURRENT_SWDIFF(:,:) = SUM(XSCAFLASWD(:,:,:),DIM=3)
- DO JK=IKB,IKE
- IKRAD = JK - 1
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- XCURRENT_DSTAOD(JI,JJ)=XCURRENT_DSTAOD(JI,JJ)+XAER(JI,JJ,IKRAD,3)
- XCURRENT_SLTAOD(JI,JJ)=XCURRENT_SLTAOD(JI,JJ)+XAER(JI,JJ,IKRAD,2)
- ENDDO
- ENDDO
- ENDDO
- END IF
-!
- NULLIFY(TZFIELDSURF_ll)
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_RN, 'GROUND_PARAM_n::XCURRENT_RN' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_H, 'GROUND_PARAM_n::XCURRENT_H' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LE, 'GROUND_PARAM_n::XCURRENT_LE' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LEI, 'GROUND_PARAM_n::XCURRENT_LEI' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_GFLUX, 'GROUND_PARAM_n::XCURRENT_GFLUX' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWD, 'GROUND_PARAM_n::XCURRENT_SWD' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWU, 'GROUND_PARAM_n::XCURRENT_SWU' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LWD, 'GROUND_PARAM_n::XCURRENT_LWD' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LWU, 'GROUND_PARAM_n::XCURRENT_LWU' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWDIR, 'GROUND_PARAM_n::XCURRENT_SWDIR' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWDIFF, 'GROUND_PARAM_n::XCURRENT_SWDIFF' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_T2M, 'GROUND_PARAM_n::XCURRENT_T2M' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_Q2M, 'GROUND_PARAM_n::XCURRENT_Q2M' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_HU2M, 'GROUND_PARAM_n::XCURRENT_HU2M' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_ZON10M, 'GROUND_PARAM_n::XCURRENT_ZON10M' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_MER10M, 'GROUND_PARAM_n::XCURRENT_MER10M' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_DSTAOD, 'GROUND_PARAM_n::XCURRENT_DSTAOD' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SLTAOD, 'GROUND_PARAM_n::XCURRENT_SLTAOD' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_ZWS, 'GROUND_PARAM_n::XCURRENT_ZWS' )
- CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SFCO2, 'GROUND_PARAM_n::XCURRENT_SFCO2' )
-
- CALL UPDATE_HALO_ll(TZFIELDSURF_ll,IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDSURF_ll)
-END IF
-!
-IF (LBLAZE) THEN
- IF (KTCOUNT <= 1) THEN
- DEALLOCATE(ZFIREFUELMAP)
- END IF
- CALL CLEANLIST_ll(TZFIELDFIRE_ll)
-END IF
-!==================================================================================
-!
-CONTAINS
-!
-!==================================================================================
-!
-SUBROUTINE RESHAPE_SURF(KDIM1D)
-!
-INTEGER, INTENT(IN) :: KDIM1D
-INTEGER, DIMENSION(1) :: ISHAPE_1
-!
-ISHAPE_1 = (/KDIM1D/)
-!
-ALLOCATE(ZP_TSUN (KDIM1D))
-ALLOCATE(ZP_ZENITH (KDIM1D))
-ALLOCATE(ZP_AZIM (KDIM1D))
-ALLOCATE(ZP_ZREF (KDIM1D))
-ALLOCATE(ZP_ZS (KDIM1D))
-ALLOCATE(ZP_U (KDIM1D))
-ALLOCATE(ZP_V (KDIM1D))
-ALLOCATE(ZP_QA (KDIM1D))
-ALLOCATE(ZP_TA (KDIM1D))
-ALLOCATE(ZP_RHOA (KDIM1D))
-ALLOCATE(ZP_SV (KDIM1D,KSV_SURF))
-ALLOCATE(ZP_CO2 (KDIM1D))
-ALLOCATE(ZP_RAIN (KDIM1D))
-ALLOCATE(ZP_SNOW (KDIM1D))
-ALLOCATE(ZP_LW (KDIM1D))
-ALLOCATE(ZP_DIR_SW (KDIM1D,SIZE(XDIRSRFSWD,3)))
-ALLOCATE(ZP_SCA_SW (KDIM1D,SIZE(XSCAFLASWD,3)))
-ALLOCATE(ZP_PS (KDIM1D))
-ALLOCATE(ZP_PA (KDIM1D))
-ALLOCATE(ZP_ZWS (KDIM1D))
-
-ALLOCATE(ZP_SFTQ (KDIM1D))
-ALLOCATE(ZP_SFTH (KDIM1D))
-ALLOCATE(ZP_SFU (KDIM1D))
-ALLOCATE(ZP_SFV (KDIM1D))
-ALLOCATE(ZP_SFTS (KDIM1D,KSV_SURF))
-ALLOCATE(ZP_SFCO2 (KDIM1D))
-ALLOCATE(ZP_TSRAD (KDIM1D))
-ALLOCATE(ZP_DIR_ALB (KDIM1D,SIZE(PDIR_ALB,3)))
-ALLOCATE(ZP_SCA_ALB (KDIM1D,SIZE(PSCA_ALB,3)))
-ALLOCATE(ZP_EMIS (KDIM1D))
-ALLOCATE(ZP_TSURF (KDIM1D))
-ALLOCATE(ZP_Z0 (KDIM1D))
-ALLOCATE(ZP_Z0H (KDIM1D))
-ALLOCATE(ZP_QSURF (KDIM1D))
-ALLOCATE(ZP_RN (KDIM1D))
-ALLOCATE(ZP_H (KDIM1D))
-ALLOCATE(ZP_LE (KDIM1D))
-ALLOCATE(ZP_LEI (KDIM1D))
-ALLOCATE(ZP_GFLUX (KDIM1D))
-ALLOCATE(ZP_T2M (KDIM1D))
-ALLOCATE(ZP_Q2M (KDIM1D))
-ALLOCATE(ZP_HU2M (KDIM1D))
-ALLOCATE(ZP_ZON10M (KDIM1D))
-ALLOCATE(ZP_MER10M (KDIM1D))
-
-!* explicit coupling only
-ALLOCATE(ZP_PEW_A_COEF (KDIM1D))
-ALLOCATE(ZP_PEW_B_COEF (KDIM1D))
-ALLOCATE(ZP_PET_A_COEF (KDIM1D))
-ALLOCATE(ZP_PEQ_A_COEF (KDIM1D))
-ALLOCATE(ZP_PET_B_COEF (KDIM1D))
-ALLOCATE(ZP_PEQ_B_COEF (KDIM1D))
-
-ZP_TSUN(:) = RESHAPE(ZTSUN(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_TA(:) = RESHAPE(ZTA(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_QA(:) = RESHAPE(ZQA(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_RHOA(:) = RESHAPE(ZRHOA(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_U(:) = RESHAPE(ZU(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_V(:) = RESHAPE(ZV(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_PS(:) = RESHAPE(ZPS(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_PA(:) = RESHAPE(ZPA(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_ZS(:) = RESHAPE(XZS(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_CO2(:) = RESHAPE(ZCO2(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_SNOW(:) = RESHAPE(ZSNOW(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_RAIN(:) = RESHAPE(ZRAIN(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_ZREF(:) = RESHAPE(ZZREF(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_ZWS(:) = RESHAPE(XZWS(IIB:IIE,IJB:IJE), ISHAPE_1)
-
-DO JLAYER=1,NSV
- ZP_SV(:,JLAYER) = RESHAPE(XSVT(IIB:IIE,IJB:IJE,IKB,JLAYER), ISHAPE_1)
-END DO
-!
-IF(LBLOWSNOW) THEN
- DO JLAYER=1,NBLOWSNOW_2D
- ZP_SV(:,NSV+JLAYER) = RESHAPE(ZBLOWSNOW_2D(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
- END DO
-END IF
-!
-!chemical conversion : from part/part to molec./m3
-DO JLAYER=NSV_CHEMBEG,NSV_CHEMEND
- ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XAVOGADRO * ZP_RHOA(:) / XMD
-END DO
-DO JLAYER=NSV_AERBEG,NSV_AEREND
- ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XAVOGADRO * ZP_RHOA(:) / XMD
-END DO
-!dust conversion : from part/part to kg/m3
-DO JLAYER=NSV_DSTBEG,NSV_DSTEND
- ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XMOLARWEIGHT_DUST* ZP_RHOA(:) / XMD
-END DO
-!sea salt conversion : from part/part to kg/m3
-DO JLAYER=NSV_SLTBEG,NSV_SLTEND
- ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XMOLARWEIGHT_SALT* ZP_RHOA(:) / XMD
-END DO
-!
-!blowing snow conversion : from kg(snow)/kg(dry air) to kg(snow)/m3
-DO JLAYER=NSV_SNWBEG,NSV_SNWEND
- ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * ZP_RHOA(:)
-END DO
-
-IF(LBLOWSNOW) THEN ! Convert 2D blowing snow fields
- ! from kg(snow)/kg(dry air) to kg(snow)/m3
- DO JLAYER=(NSV+1),KSV_SURF
- ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * ZP_RHOA(:)
- END DO
-END IF
-!
-ZP_ZENITH(:) = RESHAPE(XZENITH(IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_AZIM (:) = RESHAPE(XAZIM (IIB:IIE,IJB:IJE), ISHAPE_1)
-ZP_LW(:) = RESHAPE(XFLALWD(IIB:IIE,IJB:IJE), ISHAPE_1)
-DO JLAYER=1,SIZE(XDIRSRFSWD,3)
- ZP_DIR_SW(:,JLAYER) = RESHAPE(XDIRSRFSWD(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
- ZP_SCA_SW(:,JLAYER) = RESHAPE(XSCAFLASWD(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1)
-END DO
-!
-ZP_PEW_A_COEF = 0.
-ZP_PEW_B_COEF = 0.
-ZP_PET_A_COEF = 0.
-ZP_PEQ_A_COEF = 0.
-ZP_PET_B_COEF = 0.
-ZP_PEQ_B_COEF = 0.
-!
-END SUBROUTINE RESHAPE_SURF
-!================================================i=================================
-SUBROUTINE UNSHAPE_SURF(KDIM1,KDIM2)
-!
-INTEGER, INTENT(IN) :: KDIM1, KDIM2
-INTEGER, DIMENSION(2) :: ISHAPE_2
-!
-ISHAPE_2 = (/KDIM1,KDIM2/)
-!
-! Arguments in call to surface:
-!
-ZSFTH = XUNDEF_SFX
-ZSFTQ = XUNDEF_SFX
-IF (NSV>0) ZSFTS = XUNDEF_SFX
-ZSFCO2 = XUNDEF_SFX
-ZSFU = XUNDEF_SFX
-ZSFV = XUNDEF_SFX
-!
-ZSFTH (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTH(:), ISHAPE_2)
-ZSFTQ (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTQ(:), ISHAPE_2)
-DO JLAYER=1,SIZE(PSFSV,3)
- ZSFTS (IIB:IIE,IJB:IJE,JLAYER) = RESHAPE(ZP_SFTS(:,JLAYER), ISHAPE_2)
-END DO
-ZSFCO2 (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFCO2(:), ISHAPE_2)
-ZSFU (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFU(:), ISHAPE_2)
-ZSFV (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFV(:), ISHAPE_2)
-DO JLAYER=1,SIZE(PEMIS,3)
- PEMIS (IIB:IIE,IJB:IJE,JLAYER) = RESHAPE(ZP_EMIS(:), ISHAPE_2)
-END DO
-PTSRAD (IIB:IIE,IJB:IJE) = RESHAPE(ZP_TSRAD(:), ISHAPE_2)
-IF(LBLOWSNOW) THEN
- DO JLAYER=1,NBLOWSNOW_2D
- ZBLOWSNOW_2D(IIB:IIE,IJB:IJE,JLAYER) = RESHAPE(ZP_SFTS(:,NSV+JLAYER), ISHAPE_2)
- END DO
-END IF
-!
-IF (LDIAG_IN_RUN) THEN
- XCURRENT_RN (IIB:IIE,IJB:IJE) = RESHAPE(ZP_RN(:), ISHAPE_2)
- XCURRENT_H (IIB:IIE,IJB:IJE) = RESHAPE(ZP_H (:), ISHAPE_2)
- XCURRENT_LE (IIB:IIE,IJB:IJE) = RESHAPE(ZP_LE(:), ISHAPE_2)
- XCURRENT_LEI (IIB:IIE,IJB:IJE) = RESHAPE(ZP_LEI(:), ISHAPE_2)
- XCURRENT_GFLUX (IIB:IIE,IJB:IJE) = RESHAPE(ZP_GFLUX(:), ISHAPE_2)
- XCURRENT_T2M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_T2M(:), ISHAPE_2)
- XCURRENT_Q2M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_Q2M(:), ISHAPE_2)
- XCURRENT_HU2M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_HU2M(:), ISHAPE_2)
- XCURRENT_ZON10M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_ZON10M(:), ISHAPE_2)
- XCURRENT_MER10M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_MER10M(:), ISHAPE_2)
- XCURRENT_ZWS (IIB:IIE,IJB:IJE) = RESHAPE(ZP_ZWS(:), ISHAPE_2)
-ENDIF
-!
-DO JLAYER=1,SIZE(PDIR_ALB,3)
- PDIR_ALB(IIB:IIE,IJB:IJE,JLAYER) = RESHAPE(ZP_DIR_ALB(:,JLAYER), ISHAPE_2)
- PSCA_ALB(IIB:IIE,IJB:IJE,JLAYER) = RESHAPE(ZP_SCA_ALB(:,JLAYER), ISHAPE_2)
-END DO
-!
-DEALLOCATE(ZP_TSUN )
-DEALLOCATE(ZP_ZENITH )
-DEALLOCATE(ZP_AZIM )
-DEALLOCATE(ZP_ZREF )
-DEALLOCATE(ZP_ZS )
-DEALLOCATE(ZP_U )
-DEALLOCATE(ZP_V )
-DEALLOCATE(ZP_QA )
-DEALLOCATE(ZP_TA )
-DEALLOCATE(ZP_RHOA )
-DEALLOCATE(ZP_SV )
-DEALLOCATE(ZP_CO2 )
-DEALLOCATE(ZP_RAIN )
-DEALLOCATE(ZP_SNOW )
-DEALLOCATE(ZP_LW )
-DEALLOCATE(ZP_DIR_SW )
-DEALLOCATE(ZP_SCA_SW )
-DEALLOCATE(ZP_PS )
-DEALLOCATE(ZP_PA )
-DEALLOCATE(ZP_ZWS )
-
-DEALLOCATE(ZP_SFTQ )
-DEALLOCATE(ZP_SFTH )
-DEALLOCATE(ZP_SFTS )
-DEALLOCATE(ZP_SFCO2 )
-DEALLOCATE(ZP_SFU )
-DEALLOCATE(ZP_SFV )
-DEALLOCATE(ZP_TSRAD )
-DEALLOCATE(ZP_DIR_ALB )
-DEALLOCATE(ZP_SCA_ALB )
-DEALLOCATE(ZP_EMIS )
-DEALLOCATE(ZP_RN )
-DEALLOCATE(ZP_H )
-DEALLOCATE(ZP_LE )
-DEALLOCATE(ZP_LEI )
-DEALLOCATE(ZP_GFLUX )
-DEALLOCATE(ZP_T2M )
-DEALLOCATE(ZP_Q2M )
-DEALLOCATE(ZP_HU2M )
-DEALLOCATE(ZP_ZON10M )
-DEALLOCATE(ZP_MER10M )
-
-DEALLOCATE(ZP_PEW_A_COEF )
-DEALLOCATE(ZP_PEW_B_COEF )
-DEALLOCATE(ZP_PET_A_COEF )
-DEALLOCATE(ZP_PEQ_A_COEF )
-DEALLOCATE(ZP_PET_B_COEF )
-DEALLOCATE(ZP_PEQ_B_COEF )
-!
-END SUBROUTINE UNSHAPE_SURF
-!==================================================================================
-!
-END SUBROUTINE GROUND_PARAM_n
diff --git a/src/mesonh/ext/ibm_affectv.f90 b/src/mesonh/ext/ibm_affectv.f90
deleted file mode 100644
index fee54c3e094d852b8eba6a7df25ce569c094b4f3..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/ibm_affectv.f90
+++ /dev/null
@@ -1,402 +0,0 @@
-!MNH_LIC Copyright 2019-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_IBM_AFFECTV
- ! #######################
- !
- INTERFACE
- !
- SUBROUTINE IBM_AFFECTV(PVAR,PVAR2,PVAR3,HVAR,KIBM_LAYER,HIBM_MODE_INTE3,&
- HIBM_FORC_BOUNR,PRADIUS,PPOWERS,&
- HIBM_MODE_INT1N,HIBM_TYPE_BOUNN,HIBM_MODE_BOUNN,HIBM_FORC_BOUNN,PIBM_FORC_BOUNN,&
- HIBM_MODE_INT1T,HIBM_TYPE_BOUNT,HIBM_MODE_BOUNT,HIBM_FORC_BOUNT,PIBM_FORC_BOUNT,&
- HIBM_MODE_INT1C,HIBM_TYPE_BOUNC,HIBM_MODE_BOUNC,HIBM_FORC_BOUNC,PIBM_FORC_BOUNC,PXMU,PDIV)
- !
- REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PVAR
- REAL, DIMENSION(:,:,:,:) ,INTENT(IN) :: PVAR2,PVAR3
- CHARACTER(LEN=1) ,INTENT(IN) :: HVAR
- INTEGER ,INTENT(IN) :: KIBM_LAYER
- REAL ,INTENT(IN) :: PRADIUS
- REAL ,INTENT(IN) :: PPOWERS
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNR
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INTE3
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1N
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNN
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNN
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNN
- REAL ,INTENT(IN) :: PIBM_FORC_BOUNN
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1T
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNT
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNT
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNT
- REAL ,INTENT(IN) :: PIBM_FORC_BOUNT
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1C
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNC
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNC
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNC
- REAL ,INTENT(IN) :: PIBM_FORC_BOUNC
- REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PXMU
- REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PDIV
- !
- END SUBROUTINE IBM_AFFECTV
- !
- END INTERFACE
- !
-END MODULE MODI_IBM_AFFECTV
-!
-! ########################################################
-SUBROUTINE IBM_AFFECTV(PVAR,PVAR2,PVAR3,HVAR,KIBM_LAYER,HIBM_MODE_INTE3,&
- HIBM_FORC_BOUNR,PRADIUS,PPOWERS,&
- HIBM_MODE_INT1N,HIBM_TYPE_BOUNN,HIBM_MODE_BOUNN,HIBM_FORC_BOUNN,PIBM_FORC_BOUNN,&
- HIBM_MODE_INT1T,HIBM_TYPE_BOUNT,HIBM_MODE_BOUNT,HIBM_FORC_BOUNT,PIBM_FORC_BOUNT,&
- HIBM_MODE_INT1C,HIBM_TYPE_BOUNC,HIBM_MODE_BOUNC,HIBM_FORC_BOUNC,PIBM_FORC_BOUNC,PXMU,PDIV)
- ! ########################################################
- !
- !
- !**** IBM_AFFECTV computes the variable PVAR on desired ghost points :
- ! - the V type of the ghost/image
- ! - the 3D interpolation mode (HIBM_MODE_INTE3)
- ! - the 1D interpolation mode (HIBM_MODE_INTE1)
- ! - the boundary condition (HIBM_TYPE_BOUND)
- ! - the symmetry character (HIBM_MODE_BOUND)
- ! - the forcing type (HIBM_FORC_BOUND)
- ! - the forcing term (HIBM_FORC_BOUND)
- ! Choice of forcing type is depending on
- ! the normal, binormal, tangent vectors (N,C,T)
- !
- !
- ! PURPOSE
- ! -------
- !**** Ghosts (resp. Images) locations are stored in KIBM_STOR_GHOST (resp. KIBM_STOR_IMAGE).
- ! Solutions are computed in regard of the symmetry character of the solution:
- ! HIBM_MODE_BOUND = 'SYM' (Symmetrical)
- ! HIBM_MODE_BOUND = 'ASY' (Anti-symmetrical)
- ! The ghost value is depending on the variable value at the interface:
- ! HIBM_TYPE_BOUND = "CST" (constant value)
- ! HIBM_TYPE_BOUND = "LAW" (wall models)
- ! HIBM_TYPE_BOUND = "LIN" (linear evolution, only IMAGE2 type)
- ! HIBM_TYPE_BOUND = "LOG" (logarithmic evol, only IMAGE2 type)
- ! Three 3D interpolations exists HIBM_MODE_INTE3 = "IDW" (Inverse Distance Weighting)
- ! HIBM_MODE_INTE3 = "MDW" (Modified Distance Weighting)
- ! HIBM_MODE_INTE3 = "LAG" (Trilinear Lagrange interp. )
- ! Three 1D interpolations exists HIBM_MODE_INTE1 = "CL0" (Lagrange Polynomials - 1 points - MIRROR)
- ! HIBM_MODE_INTE1 = "CL1" (Lagrange Polynomials - 2 points - IMAGE1)
- ! HIBM_MODE_INTE1 = "CL2" (Lagrange Polynomials - 3 points - IMAGE2)
- ! METHOD
- ! ------
- ! - loop on ghosts
- ! - functions storage
- ! - computations of the location of the corners cell containing MIRROR/IMAGE1/IMAGE2
- ! - 3D interpolation (IDW, MDW, CLI) to obtain the MIRROR/IMAGE1/IMAGE2 values
- ! - computation of the value at the interface
- ! - 1D interpolation (CLI1,CLI2,CLI3) to obtain the GHOSTS values
- ! - Affectation
- !
- ! EXTERNAL
- ! --------
- ! SUBROUTINE ?
- !
- ! IMPLICIT ARGUMENTS
- ! ------------------
- ! MODD_?
- !
- ! REFERENCE
- ! ---------
- !
- ! AUTHOR
- ! ------
- ! Franck Auguste (CERFACS-AE)
- !
- ! MODIFICATIONS
- ! -------------
- ! Original 01/01/2019
- !
- !------------------------------------------------------------------------------
- !
- !**** 0. DECLARATIONS
- ! ---------------
- ! module
- USE MODE_POS
- USE MODE_ll
- USE MODE_IO
- USE MODD_ARGSLIST_ll, ONLY : LIST_ll
- !
- ! declaration
- USE MODD_IBM_PARAM_n
- USE MODD_FIELD_n
- USE MODD_PARAM_n, ONLY: CTURB
- USE MODD_GRID_n, ONLY: XDXHAT, XDYHAT
- USE MODD_VAR_ll, ONLY: IP
- USE MODD_LBC_n
- USE MODD_REF_n, ONLY: XRHODJ,XRHODREF
- !
- ! interface
- USE MODI_IBM_VALUECORN
- USE MODI_IBM_LOCATCORN
- USE MODI_IBM_3DINT
- USE MODI_IBM_1DINT
- USE MODI_IBM_0DINT
- USE MODI_IBM_VALUEMAT1
- USE MODI_IBM_VALUEMAT2
- USE MODI_SHUMAN
- USE MODD_DYN_n
- USE MODD_FIELD_n
- USE MODD_CST
- USE MODD_CTURB
- USE MODD_RADIATIONS_n
- !
- IMPLICIT NONE
- !
- !------------------------------------------------------------------------------
- !
- ! 0.1 declarations of arguments
- !
- REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PVAR
- REAL, DIMENSION(:,:,:,:) ,INTENT(IN) :: PVAR2,PVAR3
- CHARACTER(LEN=1) ,INTENT(IN) :: HVAR
- INTEGER ,INTENT(IN) :: KIBM_LAYER
- REAL ,INTENT(IN) :: PRADIUS
- REAL ,INTENT(IN) :: PPOWERS
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNR
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INTE3
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1N
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNN
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNN
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNN
- REAL ,INTENT(IN) :: PIBM_FORC_BOUNN
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1T
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNT
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNT
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNT
- REAL ,INTENT(IN) :: PIBM_FORC_BOUNT
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1C
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNC
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNC
- CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNC
- REAL ,INTENT(IN) :: PIBM_FORC_BOUNC
- REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PXMU
- REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PDIV
- !
- !------------------------------------------------------------------------------
- !
- ! 0.2 declaration of local variables
- !
- INTEGER :: JI,JJ,JK,JL,JM,JMM,JN,JNN,JH,JLL ! loop index
- INTEGER, DIMENSION(:) , ALLOCATABLE :: I_INDEX_CORN ! reference corner index
- INTEGER :: I_GHOST_NUMB ! ghost number per layer
- REAL , DIMENSION(:,:), ALLOCATABLE :: Z_LOCAT_CORN,Z_LOCAT_IMAG ! corners coordinates
- REAL , DIMENSION(:) , ALLOCATABLE :: Z_TESTS_CORN ! interface distance dependence
- REAL , DIMENSION(:) , ALLOCATABLE :: Z_VALUE_CORN ! value variables at corners
- REAL , DIMENSION(:,:), ALLOCATABLE :: Z_VALUE_IMAG,Z_VALUE_TEMP,Z_VALUE_ZLKE ! value at mirror/image1/image2
- REAL , DIMENSION(:) , ALLOCATABLE :: Z_LOCAT_BOUN,Z_LOCAT_GHOS,Z_TEMP_ZLKE ! location of bound and ghost
- REAL :: Z_DELTA_IMAG,ZIBM_VISC,ZIBM_DIVK
- CHARACTER(LEN=3),DIMENSION(:), ALLOCATABLE :: Y_TYPE_BOUND,Y_FORC_BOUND,Y_MODE_BOUND,Y_MODE_INTE1
- REAL , DIMENSION(:) , ALLOCATABLE :: Z_FORC_BOUND,Z_VALUE_GHOS
- REAL , DIMENSION(:,:), ALLOCATABLE :: Z_VALUE_MAT1,Z_VALUE_MAT2
- REAL :: ZIBM_HALO
- !
- !------------------------------------------------------------------------------
- !
- ! 0.3 Allocation
- !
- ALLOCATE(I_INDEX_CORN(3))
- ALLOCATE(Z_LOCAT_CORN(8,3))
- ALLOCATE(Z_VALUE_CORN(8))
- ALLOCATE(Z_TESTS_CORN(8))
- ALLOCATE(Z_LOCAT_IMAG(3,3))
- ALLOCATE(Z_VALUE_IMAG(4,3))
- ALLOCATE(Z_VALUE_TEMP(4,3))
- ALLOCATE(Z_LOCAT_BOUN(3))
- ALLOCATE(Z_LOCAT_GHOS(3))
- ALLOCATE(Z_VALUE_GHOS(3))
- ALLOCATE(Y_TYPE_BOUND(3),Y_FORC_BOUND(3))
- ALLOCATE(Y_MODE_BOUND(3),Y_MODE_INTE1(3))
- ALLOCATE(Z_FORC_BOUND(3))
- ALLOCATE(Z_VALUE_MAT1(3,3))
- ALLOCATE(Z_VALUE_MAT2(3,3))
- !
- !------------------------------------------------------------------------------
- !
- !**** 1. PRELIMINARIES
- ! ----------------
- I_INDEX_CORN(:) = 0
- Z_LOCAT_CORN(:,:) = 0.
- Z_VALUE_CORN(:) = 0.
- Z_TESTS_CORN(:) = 0.
- Z_LOCAT_IMAG(:,:) = 0.
- Z_VALUE_IMAG(:,:) = 0.
- Z_VALUE_TEMP(:,:) = 0.
- Z_LOCAT_GHOS(:) = 0.
- Z_LOCAT_BOUN(:) = 0.
- Z_VALUE_GHOS(:) = 0.
- Z_VALUE_MAT1(:,:) = 0.
- Z_VALUE_MAT2(:,:) = 0.
- IF (HVAR=='U') JH = 1
- IF (HVAR=='V') JH = 2
- IF (HVAR=='W') JH = 3
- Y_TYPE_BOUND(1) = HIBM_TYPE_BOUNN
- Y_TYPE_BOUND(2) = HIBM_TYPE_BOUNT
- Y_TYPE_BOUND(3) = HIBM_TYPE_BOUNC
- Y_FORC_BOUND(1) = HIBM_FORC_BOUNN
- Y_FORC_BOUND(2) = HIBM_FORC_BOUNT
- Y_FORC_BOUND(3) = HIBM_FORC_BOUNC
- Y_MODE_BOUND(1) = HIBM_MODE_BOUNN
- Y_MODE_BOUND(2) = HIBM_MODE_BOUNT
- Y_MODE_BOUND(3) = HIBM_MODE_BOUNC
- Y_MODE_INTE1(1) = HIBM_MODE_INT1N
- Y_MODE_INTE1(2) = HIBM_MODE_INT1T
- Y_MODE_INTE1(3) = HIBM_MODE_INT1C
- Z_FORC_BOUND(1) = PIBM_FORC_BOUNN
- Z_FORC_BOUND(2) = PIBM_FORC_BOUNT
- Z_FORC_BOUND(3) = PIBM_FORC_BOUNC
- !
- ALLOCATE(Z_VALUE_ZLKE(4,3))
- ALLOCATE(Z_TEMP_ZLKE(3))
- Z_VALUE_ZLKE(:,:) = 0.
- Z_TEMP_ZLKE(:) = 0.
- !
- DO JMM=1,KIBM_LAYER
- !
- ! searching number of ghosts
- JM = size(NIBM_GHOST_V,1)
- JI = 0
- JJ = 0
- JK = 0
- DO WHILE ((JI==0.and.JJ==0.and.JK==0).and.JM>0)
- JI = NIBM_GHOST_V(JM,JMM,JH,1)
- JJ = NIBM_GHOST_V(JM,JMM,JH,2)
- JK = NIBM_GHOST_V(JM,JMM,JH,3)
- IF (JI==0.and.JJ==0.and.JK==0) JM = JM - 1
- ENDDO
- I_GHOST_NUMB = JM
- !
- ! Loop on each P Ghosts
- IF (I_GHOST_NUMB<=0) GO TO 666
- DO JM = 1,I_GHOST_NUMB
- !
- ! ghost index/ls
- JI = NIBM_GHOST_V(JM,JMM,JH,1)
- JJ = NIBM_GHOST_V(JM,JMM,JH,2)
- JK = NIBM_GHOST_V(JM,JMM,JH,3)
- IF (JI==0.or.JJ==0.or.JK==0) GO TO 777
- Z_LOCAT_GHOS(:) = XIBM_GHOST_V(JM,JMM,JH,:)
- Z_LOCAT_BOUN(:) = 2.0*XIBM_IMAGE_V(JM,JMM,JH,1,:)-1.0*XIBM_IMAGE_V(JM,JMM,JH,2,:)
- ZIBM_HALO = 1.
- !
- DO JN = 1,3
- !
- Z_LOCAT_IMAG(JN,:)= XIBM_IMAGE_V(JM,JMM,JH ,JN,:)
- Z_DELTA_IMAG = ( XDXHAT(JI) * XDYHAT(JJ) ) ** 0.5
- !
- DO JLL=1,3
- I_INDEX_CORN(:) = NIBM_IMAGE_V(JM,JMM,JH,JLL,JN,:)
- IF (I_INDEX_CORN(1)==0.AND.JN==2) ZIBM_HALO=0.
- IF (I_INDEX_CORN(2)==0.AND.JN==2) ZIBM_HALO=0.
- Z_LOCAT_CORN(:,:) = IBM_LOCATCORN(I_INDEX_CORN,JLL+1)
- Z_TESTS_CORN(:) = XIBM_TESTI_V(JM,JMM,JH,JLL,JN,:)
- Z_VALUE_CORN(:) = IBM_VALUECORN(PVAR2(:,:,:,JLL),I_INDEX_CORN)
- Z_VALUE_IMAG(JN,JLL) = IBM_3DINT(JN,Z_VALUE_IMAG(:,JLL),Z_LOCAT_BOUN,Z_TESTS_CORN,&
- Z_LOCAT_CORN,Z_VALUE_CORN,Z_LOCAT_IMAG(JN,:),&
- HIBM_MODE_INTE3,PRADIUS,PPOWERS)
- ENDDO
- !
- ENDDO
- ZIBM_VISC = PXMU(JI,JJ,JK)
- ZIBM_DIVK = PDIV(JI,JJ,JK)
- !
- ! projection step
- Z_VALUE_MAT1(:,:) = IBM_VALUEMAT1(Z_LOCAT_IMAG(1,:),Z_LOCAT_BOUN,Z_VALUE_IMAG,HIBM_FORC_BOUNR)
- DO JN=1,3
- Z_VALUE_TEMP(JN,:)= Z_VALUE_MAT1(:,1)*Z_VALUE_IMAG(JN,1) +&
- Z_VALUE_MAT1(:,2)*Z_VALUE_IMAG(JN,2) +&
- Z_VALUE_MAT1(:,3)*Z_VALUE_IMAG(JN,3)
- ENDDO
- !
- ! === BOUND computation ===
- !
- JN=4
- DO JLL=1,3
- Z_VALUE_TEMP(JN,JLL) = IBM_0DINT(Z_DELTA_IMAG,Z_VALUE_TEMP(:,JLL),Y_TYPE_BOUND(JLL),Y_FORC_BOUND(JLL), &
- Z_FORC_BOUND(JLL),ZIBM_VISC,ZIBM_DIVK)
- ENDDO
- !
- ! inverse projection step
- Z_VALUE_MAT2(:,:) = IBM_VALUEMAT2(Z_VALUE_MAT1)
- Z_VALUE_IMAG(JN,:)= Z_VALUE_MAT2(:,1)*Z_VALUE_TEMP(JN,1) +&
- Z_VALUE_MAT2(:,2)*Z_VALUE_TEMP(JN,2) +&
- Z_VALUE_MAT2(:,3)*Z_VALUE_TEMP(JN,3)
- !
- ! === GHOST computation ===
- !
- ! functions storage
- Z_LOCAT_IMAG(1,3) = ((XIBM_GHOST_V(JM,JMM,JH,1)-Z_LOCAT_BOUN(1))**2.+&
- (XIBM_GHOST_V(JM,JMM,JH,2)-Z_LOCAT_BOUN(2))**2.+&
- (XIBM_GHOST_V(JM,JMM,JH,3)-Z_LOCAT_BOUN(3))**2.)**0.5
- IF (Z_LOCAT_IMAG(1,3)>Z_DELTA_IMAG.AND.ZIBM_HALO>0.5) THEN
- Z_LOCAT_IMAG(1,1) = ((XIBM_IMAGE_V(JM,JMM,JH,1,1)-Z_LOCAT_BOUN(1))**2.+&
- (XIBM_IMAGE_V(JM,JMM,JH,1,2)-Z_LOCAT_BOUN(2))**2.+&
- (XIBM_IMAGE_V(JM,JMM,JH,1,3)-Z_LOCAT_BOUN(3))**2.)**0.5
- Z_LOCAT_IMAG(1,2) = ((XIBM_IMAGE_V(JM,JMM,JH,2,1)-Z_LOCAT_BOUN(1))**2.+&
- (XIBM_IMAGE_V(JM,JMM,JH,2,2)-Z_LOCAT_BOUN(2))**2.+&
- (XIBM_IMAGE_V(JM,JMM,JH,2,3)-Z_LOCAT_BOUN(3))**2.)**0.5
- ELSE
- Z_LOCAT_IMAG(1,1) = ((XIBM_IMAGE_V(JM,JMM,JH,3,1)-Z_LOCAT_BOUN(1))**2.+&
- (XIBM_IMAGE_V(JM,JMM,JH,3,2)-Z_LOCAT_BOUN(2))**2.+&
- (XIBM_IMAGE_V(JM,JMM,JH,3,3)-Z_LOCAT_BOUN(3))**2.)**0.5
- Z_LOCAT_IMAG(1,2) = ((XIBM_IMAGE_V(JM,JMM,JH,1,1)-Z_LOCAT_BOUN(1))**2.+&
- (XIBM_IMAGE_V(JM,JMM,JH,1,2)-Z_LOCAT_BOUN(2))**2.+&
- (XIBM_IMAGE_V(JM,JMM,JH,1,3)-Z_LOCAT_BOUN(3))**2.)**0.5
- Z_VALUE_TEMP(2,:) = Z_VALUE_TEMP(1,:)
- Z_VALUE_TEMP(1,:) = Z_VALUE_TEMP(3,:)
- ENDIF
- !
- DO JLL=1,3
- Z_VALUE_GHOS(JLL) = IBM_1DINT(Z_LOCAT_IMAG(1,:),Z_VALUE_TEMP(:,JLL),Y_MODE_INTE1(JLL))
- IF (Y_MODE_BOUND(JLL)=='SYM') Z_VALUE_GHOS(JLL) = +Z_VALUE_GHOS(JLL)
- IF (Y_MODE_BOUND(JLL)=='ASY') Z_VALUE_GHOS(JLL) = -Z_VALUE_GHOS(JLL) + 2.*Z_VALUE_TEMP(4,JLL)
- IF (Y_MODE_BOUND(JLL)=='CST') Z_VALUE_GHOS(JLL) = Z_VALUE_TEMP(4,JLL)
- ENDDO
- !
- PVAR(JI,JJ,JK) = Z_VALUE_MAT2(JH,1)*Z_VALUE_GHOS(1) +&
- Z_VALUE_MAT2(JH,2)*Z_VALUE_GHOS(2) +&
- Z_VALUE_MAT2(JH,3)*Z_VALUE_GHOS(3)
- !
- IF ((JH==3).AND.(JK==2)) THEN
- PVAR(JI,JJ,JK) = 0.
- ENDIF
- !
-777 CONTINUE
- !
- ENDDO
- ENDDO
- !
-666 CONTINUE
- !
- !**** X. DEALLOCATIONS/CLOSES
- ! -----------------------
- !
- DEALLOCATE(I_INDEX_CORN)
- DEALLOCATE(Z_LOCAT_CORN)
- DEALLOCATE(Z_VALUE_CORN)
- DEALLOCATE(Z_LOCAT_IMAG)
- DEALLOCATE(Z_VALUE_IMAG)
- DEALLOCATE(Z_VALUE_TEMP)
- DEALLOCATE(Z_LOCAT_BOUN)
- DEALLOCATE(Z_LOCAT_GHOS)
- DEALLOCATE(Z_VALUE_GHOS)
- DEALLOCATE(Z_TESTS_CORN)
- DEALLOCATE(Y_TYPE_BOUND,Y_FORC_BOUND)
- DEALLOCATE(Y_MODE_BOUND,Y_MODE_INTE1)
- DEALLOCATE(Z_FORC_BOUND)
- DEALLOCATE(Z_VALUE_MAT1)
- DEALLOCATE(Z_VALUE_MAT2)
- DEALLOCATE(Z_VALUE_ZLKE)
- DEALLOCATE(Z_TEMP_ZLKE)
- !
- RETURN
- !
-END SUBROUTINE IBM_AFFECTV
diff --git a/src/mesonh/ext/ibm_forcing.f90 b/src/mesonh/ext/ibm_forcing.f90
deleted file mode 100644
index aebf45609f2e854eaedb797480f641390f21738b..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/ibm_forcing.f90
+++ /dev/null
@@ -1,314 +0,0 @@
-!MNH_LIC Copyright 2019-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_IBM_FORCING
- ! #######################
- !
- INTERFACE
- !
- SUBROUTINE IBM_FORCING(PRUS,PRVS,PRWS,PTHS,PRRS,PSVS,PTKS)
- !
- REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS
- REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PTHS
- REAL, DIMENSION(:,:,:,:),INTENT(INOUT), OPTIONAL :: PRRS
- REAL, DIMENSION(:,:,:,:),INTENT(INOUT), OPTIONAL :: PSVS
- REAL, DIMENSION(:,:,:) ,INTENT(INOUT), OPTIONAL :: PTKS
- !
- END SUBROUTINE IBM_FORCING
- !
- END INTERFACE
- !
-END MODULE MODI_IBM_FORCING
-!
-! ##########################################################
-SUBROUTINE IBM_FORCING(PRUS,PRVS,PRWS,PTHS,PRRS,PSVS,PTKS)
- ! ##########################################################
- !
- !!**** *IBM_FORCING* - routine to force all desired fields
- !!
- !! PURPOSE
- !! -------
- ! The purpose of this routine is to compute variables in the virtual
- ! embedded solid region in regard of variables computed in the real
- ! fluid region
- !
- !! METHOD
- !! ------
- !!
- !! EXTERNAL
- !! --------
- !! NONE
- !!
- !! IMPLICIT ARGUMENTS
- !! ------------------
- !!
- !! REFERENCE
- !! ---------
- !!
- !! AUTHOR
- !! ------
- !! Franck Auguste * CERFACS(AE) *
- !!
- !! MODIFICATIONS
- !! -------------
- !! Original 01/01/2019
- !!
- !-----------------------------------------------------------------------------
- !
- !**** 0. DECLARATIONS
- ! ---------------
- !
- ! module
- USE MODE_POS
- USE MODE_ll
- USE MODE_IO
- USE MODD_ARGSLIST_ll, ONLY : LIST_ll
- !
- ! declaration
- USE MODD_CST
- USE MODD_FIELD_n
- USE MODD_REF
- USE MODD_REF_n, ONLY: XRHODJ,XRHODREF,XTHVREF,XEXNREF,XRVREF
- USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
- USE MODD_IBM_PARAM_n
- USE MODD_LBC_n
- USE MODD_CONF
- USE MODD_CONF_n
- USE MODD_NSV
- USE MODD_TURB_n, ONLY: XTKEMIN
- USE MODD_PARAM_n
- USE MODD_DYN_n, ONLY: XTSTEP
- !
- ! interface
- USE MODI_IBM_AFFECTV
- USE MODI_IBM_AFFECTP
- USE MODI_SHUMAN
- !
- IMPLICIT NONE
- !
- !-----------------------------------------------------------------------------
- !
- ! 0.1 declarations of arguments
- !
- REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS
- REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PTHS
- REAL, DIMENSION(:,:,:,:),INTENT(INOUT), OPTIONAL :: PRRS
- REAL, DIMENSION(:,:,:,:),INTENT(INOUT), OPTIONAL :: PSVS
- REAL, DIMENSION(:,:,:) ,INTENT(INOUT), OPTIONAL :: PTKS
- !
- !-----------------------------------------------------------------------------
- !
- ! 0.2 declaration of local variables
- REAL, DIMENSION(:,:,:) , ALLOCATABLE :: ZTMP,ZXMU,ZDIV,ZTKE
- REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTMU,ZTRY
- INTEGER :: IIU,IJU,IKU,IKB,IKE
- INTEGER :: JRR,JSV
- TYPE(LIST_ll), POINTER :: TZFIELDS_ll
- INTEGER :: IINFO_ll
- !
- !-----------------------------------------------------------------------------
- !
- !**** 0. ALLOCATIONS
- ! --------------
- !
- IIU = SIZE(PRUS,1)
- IJU = SIZE(PRVS,2)
- IKU = SIZE(PRWS,3)
- !
- ALLOCATE(ZTMU(IIU,IJU,IKU,3),ZTMP(IIU,IJU,IKU),ZTRY(IIU,IJU,IKU,3), &
- ZXMU(IIU,IJU,IKU),ZDIV(IIU,IJU,IKU),ZTKE(IIU,IJU,IKU))
- !
- ZTMU=0.
- ZXMU=0.
- ZDIV=0.
- ZTMP=0.
- ZTRY=0.
- !
- IKB = 1 + JPVEXT
- IKE = IKU - JPVEXT
- !
- !-----------------------------------------------------------------------------
- !
- !**** 1. PRELIMINARIES
- ! ----------------
- IF (NSV>=1) THEN
- !
- DO JSV=1,NSV
- WHERE (XIBM_LS(:,:,:,1).GT.XIBM_EPSI) PSVS(:,:,:,JSV) = XIBM_EPSI**1.5
- ENDDO
- !
- ENDIF
- !
- WHERE (XIBM_LS(:,:,:,1).GT.XIBM_EPSI) PTHS(:,:,:) = XTHVREF(:,:,:)
- !
- IF (NRR>=1) THEN
- WHERE (XIBM_LS(:,:,:,1).GT.XIBM_EPSI)
- PRRS(:,:,:,1) = XRVREF(:,:,:)
- PTHS(:,:,:) = XTHVREF(:,:,:)/(1.+XRD/XRV*XRVREF(:,:,:))
- ENDWHERE
- ENDIF
- IF (NRR>=2) THEN
- DO JRR=2,NRR
- WHERE (XIBM_LS(:,:,:,1).GT.XIBM_EPSI) PRRS(:,:,:,JRR) = XIBM_EPSI
- ENDDO
- ENDIF
- !
- WHERE (XIBM_LS(:,:,:,2).GT.XIBM_EPSI) PRUS(:,:,:) = XIBM_EPSI
- WHERE (XIBM_LS(:,:,:,3).GT.XIBM_EPSI) PRVS(:,:,:) = XIBM_EPSI
- WHERE (XIBM_LS(:,:,:,4).GT.XIBM_EPSI) PRWS(:,:,:) = XIBM_EPSI
- IF (CTURB/='NONE') WHERE (XIBM_LS(:,:,:,1).GT.XIBM_EPSI) PTKS(:,:,:) = XTKEMIN
- !
- !**** 2. EXECUTIONS
- ! -------------
- !
- ! ======================
- ! === SCALAR FORCING ===
- ! ======================
- !
- IF (CTURB/='NONE') THEN
- ZTMP(:,:,:) = PTKS(:,:,:)
- ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
- ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
- ZXMU(:,:,:) = XIBM_XMUT(:,:,:)
- ZDIV(:,:,:) = XIBM_CURV(:,:,:)
- CALL IBM_AFFECTP(ZTMP,NIBM_LAYER_E,XIBM_RADIUS_E,XIBM_POWERS_E,&
- CIBM_MODE_INTE1_E,CIBM_MODE_INTE3_E,&
- CIBM_TYPE_BOUND_E,CIBM_MODE_BOUND_E,&
- CIBM_FORC_BOUND_E,XIBM_FORC_BOUND_E,ZXMU,ZDIV)
- ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
- ZTMP(:,:,IKE+1)=XTKEMIN
- PTKS(:,:,:)=MAX(XTKEMIN,ZTMP(:,:,:))
- ENDIF
- !
- ZTMP(:,:,:) = PTHS(:,:,:)
- ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
- ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
- CALL IBM_AFFECTP(ZTMP,NIBM_LAYER_T,XIBM_RADIUS_T,XIBM_POWERS_T,&
- CIBM_MODE_INTE1_T,CIBM_MODE_INTE3_T,&
- CIBM_TYPE_BOUND_T,CIBM_MODE_BOUND_T,&
- CIBM_FORC_BOUND_T,XIBM_FORC_BOUND_T,ZXMU,ZDIV)
- ZTMP(:,:,:) = ZTMP(:,:,:)
- ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
- ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
- PTHS(:,:,:) = MAX(ZTMP(:,:,:),250.)
- !
- IF (NRR>=1) THEN
- DO JRR=1,NRR
- ZTMP(:,:,:) = PRRS(:,:,:,JRR)
- ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
- ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
- CALL IBM_AFFECTP(ZTMP,NIBM_LAYER_R,XIBM_RADIUS_R,XIBM_POWERS_R,&
- CIBM_MODE_INTE1_R,CIBM_MODE_INTE3_R,&
- CIBM_TYPE_BOUND_R,CIBM_MODE_BOUND_R,&
- CIBM_FORC_BOUND_R,XIBM_FORC_BOUND_R,ZXMU,ZDIV)
- ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
- ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
- PRRS(:,:,:,JRR) = ZTMP(:,:,:)
- ENDDO
- ENDIF
- !
- IF (NSV>=1) THEN
- DO JSV=1,NSV
- ZTMP(:,:,:) = PSVS(:,:,:,JSV)
- ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
- ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
- CALL IBM_AFFECTP(ZTMP,NIBM_LAYER_S,XIBM_RADIUS_S,XIBM_POWERS_S,&
- CIBM_MODE_INTE1_S,CIBM_MODE_INTE3_S,&
- CIBM_TYPE_BOUND_S,CIBM_MODE_BOUND_S,&
- CIBM_FORC_BOUND_S,XIBM_FORC_BOUND_S,ZXMU,ZDIV)
- ZTMP(:,:,:) = MAX(XIBM_EPSI**1.5,ZTMP(:,:,:))
- ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
- ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
- PSVS(:,:,:,JSV) = ZTMP(:,:,:)
- ENDDO
- ENDIF
- !
- !=======================
- ! === VECTOR FORCING ===
- ! ======================
- !
- PRUS(:,:,IKB-1)=PRUS(:,:,IKB)
- PRUS(:,:,IKE+1)=PRUS(:,:,IKE)
- PRVS(:,:,IKB-1)=PRVS(:,:,IKB)
- PRVS(:,:,IKE+1)=PRVS(:,:,IKE)
- PRWS(:,:,IKB-1)=0.
- PRWS(:,:,IKE+1)=0.
- !
- ZTMU(:,:,:,1) = PRUS(:,:,:)
- ZTMU(:,:,:,2) = PRVS(:,:,:)
- ZTMU(:,:,:,3) = PRWS(:,:,:)
- !
- ZTMP(:,:,:) = PRUS(:,:,:)
- ZXMU(:,:,:) = MXM(XIBM_XMUT(:,:,:))
- ZDIV(:,:,:) = MXM(XIBM_CURV(:,:,:))
- CALL IBM_AFFECTV(ZTMP,ZTMU,ZTRY,'U',NIBM_LAYER_V,CIBM_MODE_INTE3_V,&
- CIBM_FORC_BOUNR_V,XIBM_RADIUS_V,XIBM_POWERS_V,&
- CIBM_MODE_INTE1NV,CIBM_TYPE_BOUNN_V,CIBM_MODE_BOUNN_V,CIBM_FORC_BOUNN_V ,XIBM_FORC_BOUNN_V,&
- CIBM_MODE_INTE1TV,CIBM_TYPE_BOUNT_V,CIBM_MODE_BOUNT_V,CIBM_FORC_BOUNT_V ,XIBM_FORC_BOUNT_V,&
- CIBM_MODE_INTE1CV,CIBM_TYPE_BOUNC_V,CIBM_MODE_BOUNC_V,CIBM_FORC_BOUNC_V ,XIBM_FORC_BOUNC_V,ZXMU,ZDIV)
- PRUS(:,:,:) = ZTMP(:,:,:)
- ZTMP(:,:,:) = PRVS(:,:,:)
- ZXMU(:,:,:) = MYM(XIBM_XMUT(:,:,:))
- ZDIV(:,:,:) = MYM(XIBM_CURV(:,:,:))
- CALL IBM_AFFECTV(ZTMP,ZTMU,ZTRY,'V',NIBM_LAYER_V,CIBM_MODE_INTE3_V,&
- CIBM_FORC_BOUNR_V,XIBM_RADIUS_V,XIBM_POWERS_V,&
- CIBM_MODE_INTE1NV,CIBM_TYPE_BOUNN_V,CIBM_MODE_BOUNN_V,CIBM_FORC_BOUNN_V ,XIBM_FORC_BOUNN_V,&
- CIBM_MODE_INTE1TV,CIBM_TYPE_BOUNT_V,CIBM_MODE_BOUNT_V,CIBM_FORC_BOUNT_V ,XIBM_FORC_BOUNT_V,&
- CIBM_MODE_INTE1CV,CIBM_TYPE_BOUNC_V,CIBM_MODE_BOUNC_V,CIBM_FORC_BOUNC_V ,XIBM_FORC_BOUNC_V,ZXMU,ZDIV)
- PRVS(:,:,:) = ZTMP(:,:,:)
- ZTMP(:,:,:) = PRWS(:,:,:)
- ZXMU(:,:,:) = MZM(XIBM_XMUT(:,:,:))
- ZDIV(:,:,:) = MZM(XIBM_CURV(:,:,:))
- CALL IBM_AFFECTV(ZTMP,ZTMU,ZTRY,'W',NIBM_LAYER_V,CIBM_MODE_INTE3_V,&
- CIBM_FORC_BOUNR_V,XIBM_RADIUS_V,XIBM_POWERS_V,&
- CIBM_MODE_INTE1NV,CIBM_TYPE_BOUNN_V,CIBM_MODE_BOUNN_V,CIBM_FORC_BOUNN_V ,XIBM_FORC_BOUNN_V,&
- CIBM_MODE_INTE1TV,CIBM_TYPE_BOUNT_V,CIBM_MODE_BOUNT_V,CIBM_FORC_BOUNT_V ,XIBM_FORC_BOUNT_V,&
- CIBM_MODE_INTE1CV,CIBM_TYPE_BOUNC_V,CIBM_MODE_BOUNC_V,CIBM_FORC_BOUNC_V ,XIBM_FORC_BOUNC_V,ZXMU,ZDIV)
- PRWS(:,:,:) = ZTMP(:,:,:)
- PRUS(:,:,IKB-1)=PRUS(:,:,IKB)
- PRUS(:,:,IKE+1)=PRUS(:,:,IKE)
- PRVS(:,:,IKB-1)=PRVS(:,:,IKB)
- PRVS(:,:,IKE+1)=PRVS(:,:,IKE)
- PRWS(:,:,IKB-1)=0.
- PRWS(:,:,IKB) =0.
- PRWS(:,:,IKE+1)=0.
- !
- !**** 3. COMMUNICATIONS
- ! -----------------
- !
- IF (.NOT. LIBM_TROUBLE) THEN
- !
- NULLIFY(TZFIELDS_ll)
- CALL ADD3DFIELD_ll(TZFIELDS_ll,PTHS(:,:,:),'IBM_FORCING::PTHS')
- IF (CTURB/='NONE') CALL ADD3DFIELD_ll(TZFIELDS_ll,PTKS(:,:,:),'IBM_FORCING::PTKS')
- CALL ADD3DFIELD_ll(TZFIELDS_ll,PRUS(:,:,:),'IBM_FORCING::PRUS')
- CALL ADD3DFIELD_ll(TZFIELDS_ll,PRVS(:,:,:),'IBM_FORCING::PRVS')
- CALL ADD3DFIELD_ll(TZFIELDS_ll,PRWS(:,:,:),'IBM_FORCING::PRWS')
- IF (NRR>=1) THEN
- DO JRR=1,NRR
- CALL ADD3DFIELD_ll(TZFIELDS_ll,PRRS(:,:,:,JRR),'IBM_FORCING::PRRS')
- ENDDO
- ENDIF
- IF (NSV>=1) THEN
- DO JSV=1,NSV
- CALL ADD3DFIELD_ll(TZFIELDS_ll,PSVS(:,:,:,JSV),'IBM_FORCING::PSVS')
- ENDDO
- ENDIF
- !
- CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDS_ll)
- !
- ENDIF
- !
- !**** 4. DEALLOCATIONS
- ! ----------------
- !
- DEALLOCATE(ZTMP,ZTMU,ZTRY,ZXMU,ZDIV,ZTKE)
- !
- RETURN
- !
-END SUBROUTINE IBM_FORCING
diff --git a/src/mesonh/ext/ibm_forcing_tr.f90 b/src/mesonh/ext/ibm_forcing_tr.f90
deleted file mode 100644
index c14ac2aa61fadced5c1759f7043002c727492670..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/ibm_forcing_tr.f90
+++ /dev/null
@@ -1,410 +0,0 @@
-!MNH_LIC Copyright 2019-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_IBM_FORCING_TR
- ! ##########################
- !
- INTERFACE
- !
- SUBROUTINE IBM_FORCING_TR(PRUS,PRVS,PRWS,PTHS,PRRS,PSVS,PTKS)
- !
- REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS
- REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PTHS
- REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT),OPTIONAL :: PRRS
- REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT),OPTIONAL :: PSVS
- REAL, DIMENSION(:,:,:) ,INTENT(INOUT),OPTIONAL :: PTKS
- !
- END SUBROUTINE IBM_FORCING_TR
- !
- END INTERFACE
- !
-END MODULE MODI_IBM_FORCING_TR
-!
-!
-! #############################################################
-SUBROUTINE IBM_FORCING_TR(PRUS,PRVS,PRWS,PTHS,PRRS,PSVS,PTKS)
- ! #############################################################
- !
- !!**** *IBM_FORCING_TR* - routine to force all desired fields
- !!
- !! PURPOSE
- !! -------
- ! The purpose of this routine is to compute variables in the virtual
- ! embedded solid region in regard of variables computed in the real
- ! fluid region
- !
- !! METHOD
- !! ------
- !!
- !! EXTERNAL
- !! --------
- !! NONE
- !!
- !! IMPLICIT ARGUMENTS
- !! ------------------
- !!
- !! REFERENCE
- !! ---------
- !!
- !! AUTHOR
- !! ------
- !! Franck Auguste * CERFACS(AE) *
- !!
- !! MODIFICATIONS
- !! -------------
- !! Original 01/01/2019
- !!
- !------------------------------------------------------------------------------
- !
- !**** 0. DECLARATIONS
- ! ---------------
- !
- ! module
- USE MODE_POS
- USE MODE_ll
- USE MODE_IO
- USE MODD_ARGSLIST_ll, ONLY: LIST_ll
- !
- ! declaration
- USE MODD_CST, ONLY: XRD,XRV
- USE MODD_REF_n, ONLY: XRHODJ,XRHODREF,XTHVREF,XRVREF
- USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
- USE MODD_IBM_PARAM_n
- USE MODD_LBC_n
- USE MODD_CONF
- USE MODD_CONF_n
- USE MODD_NSV
- USE MODD_TURB_n, ONLY: XTKEMIN
- USE MODD_PARAM_n
- !
- ! interface
- !
- IMPLICIT NONE
- !
- !-----------------------------------------------------------------------------
- !
- ! 0.1 declarations of arguments
- !
- REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS
- REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PTHS
- REAL, DIMENSION(:,:,:,:),INTENT(INOUT),OPTIONAL :: PRRS
- REAL, DIMENSION(:,:,:,:),INTENT(INOUT),OPTIONAL :: PSVS
- REAL, DIMENSION(:,:,:) ,INTENT(INOUT),OPTIONAL :: PTKS
- !
- !-----------------------------------------------------------------------------
- !
- ! 0.2 declaration of local variables
- INTEGER :: JI,JJ,JK,JI2,JJ2,JK2,IIU,IJU,IKU,JL
- INTEGER :: JIM1,JJM1,JKM1,JIP1,JJP1,JKP1
- INTEGER :: IIE,IIB,IJE,IJB,IKB,IKE
- REAL :: ZSUM1,ZSUM2,ZSUM4
- REAL, DIMENSION(:), ALLOCATABLE :: ZSUM3,ZSUM5
- TYPE(LIST_ll), POINTER :: TZFIELDS_ll
- INTEGER :: IINFO_ll
- !
- !-----------------------------------------------------------------------------
- !
- !**** 0. ALLOCATIONS
- ! --------------
- CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
- IIU = SIZE(PRUS,1)
- IJU = SIZE(PRUS,2)
- IKU = SIZE(PRUS,3)
- IKB = 1 + JPVEXT
- IKE = SIZE(PRUS,3) - JPVEXT
- !
- !-----------------------------------------------------------------------------
- !
- ! Problems in GCT ? => imposition of the adjacent value
- DO JI=IIB,IIE
- DO JJ=IJB,IJE
- DO JK=IKB,IKE
- !
- IF (XIBM_SUTR(JI,JJ,JK,1).LT.0.5) THEN
- !
- JIM1 = JI-1
- JJM1 = JJ-1
- JKM1 = JK-1
- JIP1 = JI+1
- JJP1 = JJ+1
- JKP1 = JK+1
- ZSUM1 = 0.
- ZSUM2 = 0.
- IF (NSV>=1) ALLOCATE(ZSUM3(NSV))
- ZSUM3 = 0.
- ZSUM4 = 0.
- IF (NRR>=1) ALLOCATE(ZSUM5(NRR))
- ZSUM5 = 0.
- !
- DO JI2=JIM1,JIP1
- DO JJ2=JJM1,JJP1
- DO JK2=JKM1,JKP1
- !
- ZSUM1 = ZSUM1 + (XIBM_SUTR(JI2,JJ2,JK2,1))
- ZSUM2 = ZSUM2 + (XIBM_SUTR(JI2,JJ2,JK2,1))*PTHS(JI2,JJ2,JK2)
- IF (NRR>=1) THEN
- DO JL = 1,NRR
- ZSUM5(JL) = ZSUM5(JL) + (XIBM_SUTR(JI2,JJ2,JK2,1))*PRRS(JI2,JJ2,JK2,JL)
- ENDDO
- ENDIF
- IF (NSV>=1) THEN
- DO JL = 1,NSV
- ZSUM3(JL) = ZSUM3(JL) + (XIBM_SUTR(JI2,JJ2,JK2,1))*PSVS(JI2,JJ2,JK2,JL)
- ENDDO
- ENDIF
- IF (CTURB/='NONE') ZSUM4 = ZSUM4 + (XIBM_SUTR(JI2,JJ2,JK2,1))*PTKS(JI2,JJ2,JK2)
- !
- ENDDO
- ENDDO
- ENDDO
- !
- PTHS(JI,JJ,JK) = XTHVREF(JI,JJ,JK)
- IF (NRR>=1) PTHS(JI,JJ,JK) = XTHVREF(JI,JJ,JK)/(1.+XRD/XRV*XRVREF(JI,JJ,JK))
- IF (ZSUM1.GT.XIBM_EPSI) PTHS(JI,JJ,JK) = ZSUM2/ZSUM1
- IF (NRR>=1) THEN
- PRRS(JI,JJ,JK,1) = XRVREF(JI,JJ,JK)
- IF (ZSUM1.GT.XIBM_EPSI) PRRS(JI,JJ,JK,1) = ZSUM5(1)/ZSUM1
- IF (NRR>=2) THEN
- DO JL = 2,NRR
- PRRS(JI,JJ,JK,JL) = 0.
- IF (ZSUM1.GT.XIBM_EPSI) PRRS(JI,JJ,JK,JL) = ZSUM5(JL)/ZSUM1
- ENDDO
- ENDIF
- ENDIF
- !
- IF (NSV>=1) THEN
- DO JL = 1,NSV
- PSVS(JI,JJ,JK,JL) = 0.
- IF (ZSUM1.GT.XIBM_EPSI) PSVS(JI,JJ,JK,JL) = ZSUM3(JL)/ZSUM1
- ENDDO
- ENDIF
- !
- IF (CTURB/='NONE') PTKS(JI,JJ,JK) = XTKEMIN
- IF (ZSUM1.GT.XIBM_EPSI.AND.(CTURB/='NONE')) PTKS(JI,JJ,JK) = ZSUM4/ZSUM1
- IF (NSV>=1) DEALLOCATE(ZSUM3)
- IF (NRR>=1) DEALLOCATE(ZSUM5)
- !
- ENDIF
- !
- IF (XIBM_SUTR(JI,JJ,JK,2).LT.0.5) THEN
- !
- JIM1 = JI-1
- JJM1 = JJ-1
- JKM1 = JK-1
- JIP1 = JI+1
- JJP1 = JJ+1
- JKP1 = JK+1
- ZSUM1 = 0.
- ZSUM2 = 0.
- !
- DO JI2=JIM1,JIP1
- DO JJ2=JJM1,JJP1
- DO JK2=JKM1,JKP1
- ZSUM1 = ZSUM1 + (XIBM_SUTR(JI2,JJ2,JK2,2))
- ZSUM2 = ZSUM2 + (XIBM_SUTR(JI2,JJ2,JK2,2))*PRUS(JI2,JJ2,JK2)
- ENDDO
- ENDDO
- ENDDO
- !
- PRUS(JI,JJ,JK) = 0.
- IF (ZSUM1.GT.XIBM_EPSI) PRUS(JI,JJ,JK) = ZSUM2/ZSUM1
- !
- ENDIF
- !
- IF (XIBM_SUTR(JI,JJ,JK,3).LT.0.5) THEN
- !
- JIM1 = JI-1
- JJM1 = JJ-1
- JKM1 = JK-1
- JIP1 = JI+1
- JJP1 = JJ+1
- JKP1 = JK+1
- ZSUM1 = 0.
- ZSUM2 = 0.
- !
- DO JI2=JIM1,JIP1
- DO JJ2=JJM1,JJP1
- DO JK2=JKM1,JKP1
- ZSUM1 = ZSUM1 + (XIBM_SUTR(JI2,JJ2,JK2,3))
- ZSUM2 = ZSUM2 + (XIBM_SUTR(JI2,JJ2,JK2,3))*PRVS(JI2,JJ2,JK2)
- ENDDO
- ENDDO
- ENDDO
- !
- PRVS(JI,JJ,JK) = 0.
- IF (ZSUM1.GT.XIBM_EPSI) PRVS(JI,JJ,JK) = ZSUM2/ZSUM1
- !
- ENDIF
- !
- IF (XIBM_SUTR(JI,JJ,JK,4).LT.0.5) THEN
- !
- JIM1 = JI-1
- JJM1 = JJ-1
- JKM1 = JK-1
- JIP1 = JI+1
- JJP1 = JJ+1
- JKP1 = JK+1
- ZSUM1 = 0.
- ZSUM2 = 0.
- !
- DO JI2=JIM1,JIP1
- DO JJ2=JJM1,JJP1
- DO JK2=JKM1,JKP1
- ZSUM1 = ZSUM1 + (XIBM_SUTR(JI2,JJ2,JK2,4))
- ZSUM2 = ZSUM2 + (XIBM_SUTR(JI2,JJ2,JK2,4))*PRWS(JI2,JJ2,JK2)
- ENDDO
- ENDDO
- ENDDO
- !
- PRWS(JI,JJ,JK) = 0.
- IF (ZSUM1.GT.XIBM_EPSI) PRWS(JI,JJ,JK) = ZSUM2/ZSUM1
- !
- ENDIF
- ENDDO
- ENDDO
- ENDDO
- !
- PTHS(:,:,IKB-1)=PTHS(:,:,IKB)
- PTHS(:,:,IKE+1)=PTHS(:,:,IKE)
- IF (CTURB/='NONE') PTKS(:,:,IKB-1)=PTKS(:,:,IKB)
- IF (CTURB/='NONE') PTKS(:,:,IKE+1)=PTKS(:,:,IKE)
- IF (NSV>=1) PSVS(:,:,IKB-1,:)=PSVS(:,:,IKB,:)
- IF (NSV>=1) PSVS(:,:,IKE+1,:)=PSVS(:,:,IKE,:)
- IF (NRR>=1) PRRS(:,:,IKB-1,:)=PRRS(:,:,IKB,:)
- IF (NRR>=1) PRRS(:,:,IKE+1,:)=PRRS(:,:,IKE,:)
- PRUS(:,:,IKB-1)=PRUS(:,:,IKB)
- PRUS(:,:,IKE+1)=PRUS(:,:,IKE)
- PRVS(:,:,IKB-1)=PRVS(:,:,IKB)
- PRVS(:,:,IKE+1)=PRVS(:,:,IKE)
- PRWS(:,:,IKB-1)=0.
- PRWS(:,:,IKB) =0.
- PRWS(:,:,IKE+1)=0.
- !
- NULLIFY(TZFIELDS_ll)
- CALL ADD3DFIELD_ll(TZFIELDS_ll,PTHS(:,:,:),'IBM_FORCING_TR::PTHS')
- IF (CTURB/='NONE') CALL ADD3DFIELD_ll(TZFIELDS_ll,PTKS(:,:,:),'IBM_FORCING_TR::PTKS')
- CALL ADD3DFIELD_ll(TZFIELDS_ll,PRUS(:,:,:),'IBM_FORCING_TR::PRUS')
- CALL ADD3DFIELD_ll(TZFIELDS_ll,PRVS(:,:,:),'IBM_FORCING_TR::PRVS')
- CALL ADD3DFIELD_ll(TZFIELDS_ll,PRWS(:,:,:),'IBM_FORCING_TR::PRWS')
- IF (NSV>=1) THEN
- DO JL=1,NSV
- CALL ADD3DFIELD_ll(TZFIELDS_ll,PSVS(:,:,:,JL),'IBM_FORCING_TR::PSVS')
- ENDDO
- ENDIF
- IF (NRR>=1) THEN
- DO JL=1,NRR
- CALL ADD3DFIELD_ll(TZFIELDS_ll,PRRS(:,:,:,JL),'IBM_FORCING_TR::PRRS')
- ENDDO
- ENDIF
- CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDS_ll)
- !
- ! Problems on corners ? => imposition of the adjacent value
- !
- DO JI=IIB,IIE
- DO JJ=IJB,IJE
- DO JK=IKB,IKE
- !
- IF (XIBM_LS(JI,JJ,JK,2).GT.XIBM_EPSI) THEN
- !
- ZSUM1 = (XIBM_CURV(JI,JJ,JK)+XIBM_CURV(JI-1,JJ,JK))/2.
- ZSUM1 = ABS(ZSUM1)
- ZSUM1 = MIN(1.,ZSUM1)
- !
- JIM1 = JI-1
- JJM1 = JJ-1
- JKM1 = JK-1
- JIP1 = JI+1
- JJP1 = JJ+1
- JKP1 = JK+1
- ZSUM2 = 0.
- !
- DO JI2=JIM1,JIP1
- DO JJ2=JJM1,JJP1
- DO JK2=JKM1,JKP1
- ZSUM2 = ZSUM2 + PRUS(JI2,JJ2,JK2)
- ENDDO
- ENDDO
- ENDDO
- !
- PRUS(JI,JJ,JK) = (1.-ZSUM1)*PRUS(JI,JJ,JK)+ZSUM1*ZSUM2/27.
- !
- ENDIF
- !
- IF (XIBM_LS(JI,JJ,JK,3).GT.XIBM_EPSI) THEN
- !
- ZSUM1 = (XIBM_CURV(JI,JJ,JK)+XIBM_CURV(JI,JJ-1,JK))/2.
- ZSUM1 = ABS(ZSUM1)
- ZSUM1 = MIN(1.,ZSUM1)
- !
- JIM1 = JI-1
- JJM1 = JJ-1
- JKM1 = JK-1
- JIP1 = JI+1
- JJP1 = JJ+1
- JKP1 = JK+1
- ZSUM2 = 0.
- !
- DO JI2=JIM1,JIP1
- DO JJ2=JJM1,JJP1
- DO JK2=JKM1,JKP1
- ZSUM2 = ZSUM2 + PRVS(JI2,JJ2,JK2)
- ENDDO
- ENDDO
- ENDDO
- !
- PRVS(JI,JJ,JK) = (1.-ZSUM1)*PRVS(JI,JJ,JK)+ZSUM1*ZSUM2/27.
- !
- ENDIF
- !
- IF (XIBM_LS(JI,JJ,JK,4).GT.XIBM_EPSI) THEN
- !
- ZSUM1 = (XIBM_CURV(JI,JJ,JK)+XIBM_CURV(JI,JJ,JK-1))/2.
- ZSUM1 = ABS(ZSUM1)
- ZSUM1 = MIN(1.,ZSUM1)
- !
- JIM1 = JI-1
- JJM1 = JJ-1
- JKM1 = JK-1
- JIP1 = JI+1
- JJP1 = JJ+1
- JKP1 = JK+1
- ZSUM2 = 0.
- !
- DO JI2=JIM1,JIP1
- DO JJ2=JJM1,JJP1
- DO JK2=JKM1,JKP1
- ZSUM2 = ZSUM2 + PRWS(JI2,JJ2,JK2)
- ENDDO
- ENDDO
- ENDDO
- !
- PRWS(JI,JJ,JK) = (1.-ZSUM1)*PRWS(JI,JJ,JK)+ZSUM1*ZSUM2/27.
- !
- ENDIF
- ENDDO
- ENDDO
- ENDDO
- !
- PRUS(:,:,IKB-1)=PRUS(:,:,IKB)
- PRUS(:,:,IKE+1)=PRUS(:,:,IKE)
- PRVS(:,:,IKB-1)=PRVS(:,:,IKB)
- PRVS(:,:,IKE+1)=PRVS(:,:,IKE)
- PRWS(:,:,IKB-1)=0.
- PRWS(:,:,IKB) =0.
- PRWS(:,:,IKE+1)=0.
- !
- NULLIFY(TZFIELDS_ll)
- CALL ADD3DFIELD_ll(TZFIELDS_ll,PRUS(:,:,:),'IBM_FORCING_TR::PRUS')
- CALL ADD3DFIELD_ll(TZFIELDS_ll,PRVS(:,:,:),'IBM_FORCING_TR::PRVS')
- CALL ADD3DFIELD_ll(TZFIELDS_ll,PRWS(:,:,:),'IBM_FORCING_TR::PRWS')
- CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDS_ll)
- !
- RETURN
- !
-END SUBROUTINE IBM_FORCING_TR
diff --git a/src/mesonh/ext/ibm_generls.f90 b/src/mesonh/ext/ibm_generls.f90
deleted file mode 100644
index f8d7f9d7f079de236167627a7fc3add8c9152baf..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/ibm_generls.f90
+++ /dev/null
@@ -1,541 +0,0 @@
-!MNH_LIC Copyright 2021-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_IBM_GENERLS
- ! #######################
- !
- INTERFACE
- !
- SUBROUTINE IBM_GENERLS(PIBM_FACES,PNORM_FACES,PV1,PV2,PV3,PX_MIN,PY_MIN,PX_MAX,PY_MAX,PPHI)
- !
- REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PIBM_FACES
- REAL, DIMENSION(:,:) ,INTENT(IN) :: PNORM_FACES,PV1,PV2,PV3
- REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI
- REAL ,INTENT(IN) :: PX_MIN,PY_MIN,PX_MAX,PY_MAX
- !
- END SUBROUTINE IBM_GENERLS
- !
- END INTERFACE
- !
-END MODULE MODI_IBM_GENERLS
-!
-! #####################################
-SUBROUTINE IBM_GENERLS(PIBM_FACES,PNORM_FACES,PV1,PV2,PV3,PX_MIN,PY_MIN,PX_MAX,PY_MAX,PPHI)
- ! #####################################
- !
- !
- !**** IBM_GENERLS computes the Level Set function for any surface
- !
- ! PURPOSE
- ! -------
- !**** The purpose of this routine is to estimate the level set
- ! containing XYZ minimalisation interface locations
-
- ! METHOD
- ! ------
- !**** Iterative system and minimization of the interface distance
- !
- ! EXTERNAL
- ! --------
- ! SUBROUTINE ?
- !
- ! IMPLICIT ARGUMENTS
- ! ------------------
- ! MODD_?
- !
- ! REFERENCE
- ! ---------
- ! The method is based on '3D Distance from a Point to a Triangle'
- ! a technical report from Mark W. Jones, University of Wales Swansea
- !
- ! AUTHORS
- ! ------
- ! Tim Nagel, Valéry Masson & Robert Schoetter
- !
- ! MODIFICATIONS
- ! -------------
- ! Original 01/06/2021
- !
- !------------------------------------------------------------------------------
- !
- !**** 0. DECLARATIONS
- ! ---------------
- !
- ! module
- USE MODE_POS
- USE MODE_ll
- USE MODE_IO
- USE MODD_ARGSLIST_ll, ONLY : LIST_ll
- !
- ! declaration
- USE MODD_IBM_PARAM_n
- USE MODD_IBM_LSF
- USE MODD_DIM_n, ONLY: NIMAX,NJMAX,NKMAX
- USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT,XUNDEF
- USE MODD_METRICS_n, ONLY: XDXX,XDYY,XDZZ
- USE MODD_VAR_ll, ONLY: IP
- USE MODD_CST, ONLY: XMNH_EPSILON
- !
- ! interface
- USE MODI_SHUMAN
- USE MODI_IBM_INTERPOS
- USE MODI_IBM_DETECT
- !
- IMPLICIT NONE
- !
- ! 0.1 declarations of arguments
- !
- REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PIBM_FACES !faces coordinates
- REAL, DIMENSION(:,:) ,INTENT(IN) :: PNORM_FACES !normal
- REAL, DIMENSION(:,:) ,INTENT(IN) :: PV1,PV2,PV3
- REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI ! LS functions
- REAL ,INTENT(IN) :: PX_MIN,PY_MIN,PX_MAX,PY_MAX
- !
- !------------------------------------------------------------------------------
- !
- ! 0.2 declaration of local variables
- !
- INTEGER :: JI,JJ,JK,JN,JM,JI2,JJ2,JK2 ! loop index
- INTEGER :: JI_MIN,JI_MAX,JJ_MIN,JJ_MAX,JK_MIN,JK_MAX,IIU,IJU,IKU ! loop boundaries
- REAL :: Z_DIST_TEST1,Z_DIST_TEST2 ! saving distances
- REAL :: Z_DIST_TEST3,Z_DIST_TEST4,ZDIST_REF0
- INTEGER :: INUMB_FACES ! number of faces
- REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZXHATM,ZYHATM,ZZHATM,ZDP0PP0PAST
- CHARACTER(LEN=1) :: YPOS
- REAL, DIMENSION(3) :: ZP1P0,ZP1P2,ZP0PP0,ZP1PP0,ZP2PP0,ZP3PP0,ZPP0P1,ZPP0P2,ZPP0P3
- REAL, DIMENSION(3) :: ZPP0PPP0,ZPPP0P1,ZPPP0P2,ZP2P1,ZP2P0,ZP2P3,ZP3P2,ZP3P1
- REAL, DIMENSION(3) :: ZPP0,ZFT1,ZFT2,ZFT3,ZFT1B,ZFT2B,ZFT3B,ZR,ZPPP0,ZP3P0,ZP0P1
- REAL, DIMENSION(3) :: ZPPP0P3,ZP1P3,ZPCP0,ZR0
- REAL, DIMENSION(:), ALLOCATABLE :: ZSTEMP,ZRDIR,ZVECTDISTPLUS,ZVECTDISTMOINS,ZVECTDIST!,ZFACE
- REAL, DIMENSION(:,:), ALLOCATABLE :: ZC
- REAL :: ZF1,ZF2,ZF3,ZF1B,ZF2B,ZF3B,ZDPP0PPP0
- REAL :: ZT,ZSIGN,ZS,ZDIST,ZDP0PP0,ZNNORM,ZRN,ZPHI_OLD
- TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
- INTEGER :: IINFO_ll,IMI ! return code of parallel routine
- INTEGER :: IIE,IIB,IJB,IJE,IKE,IKB,ZBPLUS
- LOGICAL :: GABOVE_ROOF,LFACE,LDZ
- LOGICAL, DIMENSION(:), ALLOCATABLE :: ZFACE
- INTEGER :: ZCOUNT,ZIDX,ZII,ZCHANGE,ZCHANGE1
- REAL :: ZDIFF,ZMIN_DIFF,ZDX
- !
- !------------------------------------------------------------------------------
- !
- ! 0.3 allocation
- !
- NULLIFY(TZFIELDS_ll)
- IIU = SIZE(PPHI,1)
- IJU = SIZE(PPHI,2)
- IKU = SIZE(PPHI,3)
- IIB=1+JPHEXT
- IIE=IIU-JPHEXT
- IJB=1+JPHEXT
- IJE=IJU-JPHEXT
- IKB=1+JPVEXT
- IKE=IKU-JPVEXT
- !
- JK_MIN = 1 + JPVEXT
- JK_MAX = IKU - JPVEXT
- !
- CALL GET_INDICE_ll (JI_MIN,JJ_MIN,JI_MAX,JJ_MAX)
- !
- ALLOCATE(ZXHATM(IIU,IJU,IKU))
- ALLOCATE(ZYHATM(IIU,IJU,IKU))
- ALLOCATE(ZZHATM(IIU,IJU,IKU))
- !
- !-------------------------------------------------------------------------------
- !
- !**** 1. PRELIMINARIES
- ! ----------------
- !
- INUMB_FACES = SIZE(PIBM_FACES,1)
- ALLOCATE(ZC(INUMB_FACES,3))
- ALLOCATE(ZSTEMP(1))
- ALLOCATE(ZRDIR(1))
- PPHI = -XUNDEF
- ALLOCATE(ZDP0PP0PAST(IIU,IJU,IKU))
- ZDP0PP0PAST = 0.
- ALLOCATE(ZVECTDIST(10000))
- ALLOCATE(ZVECTDISTPLUS(10000))
- ALLOCATE(ZVECTDISTMOINS(10000))
- ALLOCATE(ZFACE(10000))
- ZFACE=.FALSE.
- !
- !-------------------------------------------------------------------------------
- !
- !**** 2. EXECUTIONS
- ! -------------
- !
- JM=1
- YPOS = 'P'
- !
- CALL IBM_INTERPOS(ZXHATM,ZYHATM,ZZHATM,YPOS)
- ZDX = ZXHATM(JI_MIN+1,JJ_MIN,JK_MIN)-ZXHATM(JI_MIN,JJ_MIN,JK_MIN)
- !
- DO JK = JK_MIN,JK_MAX
- DO JJ = JJ_MIN,JJ_MAX
- DO JI = JI_MIN,JI_MAX
- ZCOUNT = 1
- ZVECTDIST = -999.
- DO JN = 1,INUMB_FACES
- LFACE=.FALSE.
- !***Calcul of the face center
- ZC(JN,1)=(PIBM_FACES(JN,1,1)+PIBM_FACES(JN,2,1)+PIBM_FACES(JN,3,1))/3.
- ZC(JN,2)=(PIBM_FACES(JN,1,2)+PIBM_FACES(JN,2,2)+PIBM_FACES(JN,3,2))/3.
- ZC(JN,3)=(PIBM_FACES(JN,1,3)+PIBM_FACES(JN,2,3)+PIBM_FACES(JN,3,3))/3.
- !***Norm normalization
- ZNNORM = SQRT(PNORM_FACES(JN,1)**2+PNORM_FACES(JN,2)**2+PNORM_FACES(JN,3)**2)
- !***Vector between the face center and the current grid point
- ZPCP0(1) = ZXHATM(JI,JJ,JK)-ZC(JN,1)
- ZPCP0(2) = ZYHATM(JI,JJ,JK)-ZC(JN,2)
- ZPCP0(3) = ZZHATM(JI,JJ,JK)-ZC(JN,3)
- ZSIGN = ZPCP0(1)*PNORM_FACES(JN,1)+ &
- ZPCP0(2)*PNORM_FACES(JN,2)+ &
- ZPCP0(3)*PNORM_FACES(JN,3)
- !***Various vectors
- ZP1P0(1) = ZXHATM(JI,JJ,JK)-PIBM_FACES(JN,1,1)
- ZP1P0(2) = ZYHATM(JI,JJ,JK)-PIBM_FACES(JN,1,2)
- ZP1P0(3) = ZZHATM(JI,JJ,JK)-PIBM_FACES(JN,1,3)
- ZP3P0(1) = ZXHATM(JI,JJ,JK)-PIBM_FACES(JN,3,1)
- ZP3P0(2) = ZYHATM(JI,JJ,JK)-PIBM_FACES(JN,3,2)
- ZP3P0(3) = ZZHATM(JI,JJ,JK)-PIBM_FACES(JN,3,3)
- ZP0P1(1) = PIBM_FACES(JN,1,1)-ZXHATM(JI,JJ,JK)
- ZP0P1(2) = PIBM_FACES(JN,1,2)-ZYHATM(JI,JJ,JK)
- ZP0P1(3) = PIBM_FACES(JN,1,3)-ZZHATM(JI,JJ,JK)
- ZP2P0(1) = ZXHATM(JI,JJ,JK)-PIBM_FACES(JN,2,1)
- ZP2P0(2) = ZYHATM(JI,JJ,JK)-PIBM_FACES(JN,2,2)
- ZP2P0(3) = ZZHATM(JI,JJ,JK)-PIBM_FACES(JN,2,3)
- !***Equation (3) of Jones (1995)
- IF(ZP1P0(1)==0.AND.ZP1P0(2)==0.AND.ZP1P0(3)==0) THEN
- WRITE(*,*) 'ZP1P0(1,2,3)',ZP1P0(1),ZP1P0(2),ZP1P0(3)
- ZDP0PP0 = 0.
- ELSE
- ZDP0PP0 = SQRT(ZP0P1(1)**2+ZP0P1(2)**2+ZP0P1(3)**2)* &
- ((ZP1P0(1)*PNORM_FACES(JN,1)+ZP1P0(2)*PNORM_FACES(JN,2)+&
- ZP1P0(3)*PNORM_FACES(JN,3))/( &
- SQRT((ZP1P0(1))**2+(ZP1P0(2))**2+(ZP1P0(3))**2)*ZNNORM))
- END IF
- !***Equation (4) of Jones (1995)
- ZP0PP0(1) = -ZDP0PP0*(PNORM_FACES(JN,1)/ZNNORM)
- ZP0PP0(2) = -ZDP0PP0*(PNORM_FACES(JN,2)/ZNNORM)
- ZP0PP0(3) = -ZDP0PP0*(PNORM_FACES(JN,3)/ZNNORM)
- !***Equation (5) of Jones (1995)
- ZPP0(1) = ZXHATM(JI,JJ,JK)+ZP0PP0(1)
- ZPP0(2) = ZYHATM(JI,JJ,JK)+ZP0PP0(2)
- ZPP0(3) = ZZHATM(JI,JJ,JK)+ZP0PP0(3)
- !
- ZP1PP0(1)=ZPP0(1)-PIBM_FACES(JN,1,1)
- ZP1PP0(2)=ZPP0(2)-PIBM_FACES(JN,1,2)
- ZP1PP0(3)=ZPP0(3)-PIBM_FACES(JN,1,3)
- !
- ZP2PP0(1)=ZPP0(1)-PIBM_FACES(JN,2,1)
- ZP2PP0(2)=ZPP0(2)-PIBM_FACES(JN,2,2)
- ZP2PP0(3)=ZPP0(3)-PIBM_FACES(JN,2,3)
- !
- ZP3PP0(1)=ZPP0(1)-PIBM_FACES(JN,3,1)
- ZP3PP0(2)=ZPP0(2)-PIBM_FACES(JN,3,2)
- ZP3PP0(3)=ZPP0(3)-PIBM_FACES(JN,3,3)
- !
- ZPP0P1(1)=PIBM_FACES(JN,1,1)-ZPP0(1)
- ZPP0P1(2)=PIBM_FACES(JN,1,2)-ZPP0(2)
- ZPP0P1(3)=PIBM_FACES(JN,1,3)-ZPP0(3)
- !
- ZPP0P2(1)=PIBM_FACES(JN,2,1)-ZPP0(1)
- ZPP0P2(2)=PIBM_FACES(JN,2,2)-ZPP0(2)
- ZPP0P2(3)=PIBM_FACES(JN,2,3)-ZPP0(3)
- !
- ZPP0P3(1)=PIBM_FACES(JN,3,1)-ZPP0(1)
- ZPP0P3(2)=PIBM_FACES(JN,3,2)-ZPP0(2)
- ZPP0P3(3)=PIBM_FACES(JN,3,3)-ZPP0(3)
- !
- !***Calculation of f1,f2,f3 (Jones (1995))
- ZFT1= CROSSPRODUCT(PV1(JN,:),ZP1PP0)
- ZFT2= CROSSPRODUCT(PV2(JN,:),ZP2PP0)
- ZFT3= CROSSPRODUCT(PV3(JN,:),ZP3PP0)
-
- ZF1 =ZFT1(1)*PNORM_FACES(JN,1)+ &
- ZFT1(2)*PNORM_FACES(JN,2)+ &
- ZFT1(3)*PNORM_FACES(JN,3)
-
- ZF2 =ZFT2(1)*PNORM_FACES(JN,1)+ &
- ZFT2(2)*PNORM_FACES(JN,2)+ &
- ZFT2(3)*PNORM_FACES(JN,3)
-
- ZF3 =ZFT3(1)*PNORM_FACES(JN,1)+ &
- ZFT3(2)*PNORM_FACES(JN,2)+ &
- ZFT3(3)*PNORM_FACES(JN,3)
- !***Point anticlockwise of V1 and clockwise of V2
- IF (ZF1.GE.0.AND.ZF2.LE.0) THEN
- ZFT1B = CROSSPRODUCT(ZPP0P1,ZPP0P2)
- ZF1B = ZFT1B(1)*PNORM_FACES(JN,1)+ &
- ZFT1B(2)*PNORM_FACES(JN,2)+ &
- ZFT1B(3)*PNORM_FACES(JN,3)
- IF (ZF1B<0) THEN
- ZP1P2(:) = PIBM_FACES(JN,2,:)-PIBM_FACES(JN,1,:)
- ZR = CROSSPRODUCT(CROSSPRODUCT(ZPP0P2,ZPP0P1),ZP1P2)
- ZRN = SQRT(ZR(1)**2+ZR(2)**2+ZR(3)**2)
- !***Eq. (10) of Jones(1995)
- ZDPP0PPP0 = SQRT(ZPP0P1(1)**2+ZPP0P1(2)**2+ZPP0P1(3)**2)* &
- ((ZPP0P1(1)*ZR(1)+ZPP0P1(2)*ZR(2)+ZPP0P1(3)*ZR(3))/( &
- SQRT(ZPP0P1(1)**2+ZPP0P1(2)**2+ZPP0P1(3)**2)*ZRN))! &
- ZPP0PPP0 = ZDPP0PPP0*(ZR/ZRN)
- ZPPP0 = ZPP0+ZPP0PPP0
- ZPPP0P1 = PIBM_FACES(JN,1,:)-ZPPP0
- ZP2P1 = PIBM_FACES(JN,1,:)-PIBM_FACES(JN,2,:)
- ZRDIR = SIGN(1.,SCALPRODUCT(ZPPP0P1,ZP2P1))
- ZT = SQRT(ZPPP0P1(1)**2+ZPPP0P1(2)**2+ZPPP0P1(3)**2)/ &
- SQRT(ZP2P1(1)**2+ZP2P1(2)**2+ZP2P1(3)**2)*ZRDIR(1)
- IF (ZT.GE.0.AND.ZT.LE.1) THEN
- ZDIST =SQRT(ZDPP0PPP0**2+ZDP0PP0**2)
- ELSEIF (ZT<0.) THEN
- ZDIST = SQRT(ZP1P0(1)**2+ZP1P0(2)**2+ZP1P0(3)**2)
- ELSEIF (ZT>1.) THEN
- ZDIST = SQRT(ZP2P0(1)**2+ZP2P0(2)**2+ZP2P0(3)**2)
- ELSE
- call Print_msg( NVERB_FATAL, 'GEN', 'IBM_PREP_LS', 'Error in ZT calculation' )
- ENDIF
- ELSE
- ZDIST = ZDP0PP0
- LFACE = .TRUE.
- ENDIF
- !***Point anticlockwise of V2 and clockwise of V3
- ELSEIF (ZF2.GE.0.AND.ZF3.LE.0) THEN
- ZFT2B = CROSSPRODUCT(ZPP0P2,ZPP0P3)
- ZF2B = ZFT2B(1)*PNORM_FACES(JN,1)+ &
- ZFT2B(2)*PNORM_FACES(JN,2)+ &
- ZFT2B(3)*PNORM_FACES(JN,3)
- IF (ZF2B<0) THEN
- ZP2P3(:) = PIBM_FACES(JN,3,:)-PIBM_FACES(JN,2,:)
- ZR = CROSSPRODUCT(CROSSPRODUCT(ZPP0P3,ZPP0P2),ZP2P3)
- ZRN = SQRT(ZR(1)**2+ZR(2)**2+ZR(3)**2)
- ZDPP0PPP0 = SQRT(ZPP0P2(1)**2+ZPP0P2(2)**2+ZPP0P2(3)**2)* &
- ((ZPP0P2(1)*ZR(1)+ZPP0P2(2)*ZR(2)+ZPP0P2(3)*ZR(3))/( &
- SQRT(ZPP0P2(1)**2+ZPP0P2(2)**2+ZPP0P2(3)**2)*ZRN))! &
- ZPP0PPP0 = ZDPP0PPP0*(ZR/ZRN)
- ZPPP0 = ZPP0+ZPP0PPP0
- ZPPP0P2 = PIBM_FACES(JN,2,:)-ZPPP0
- ZP3P2 = PIBM_FACES(JN,2,:)-PIBM_FACES(JN,3,:)
- ZRDIR = SIGN(1.,SCALPRODUCT(ZPPP0P2,ZP3P2))
- ZT = SQRT(ZPPP0P2(1)**2+ZPPP0P2(2)**2+ZPPP0P2(3)**2)/ &
- SQRT(ZP3P2(1)**2+ZP3P2(2)**2+ZP3P2(3)**2)*ZRDIR(1)
- IF (ZT.GE.0.AND.ZT.LE.1) THEN
- ZDIST = SQRT(ZDPP0PPP0**2+ZDP0PP0**2)
- ELSEIF (ZT<0.) THEN
- ZDIST = SQRT(ZP2P0(1)**2+ZP2P0(2)**2+ZP2P0(3)**2)
- ELSEIF (ZT>1.) THEN
- ZDIST = SQRT(ZP3P0(1)**2+ZP3P0(2)**2+ZP3P0(3)**2)
- ELSE
- call Print_msg( NVERB_FATAL, 'GEN', 'IBM_PREP_LS', 'Error in ZT calculation' )
- ENDIF
- ELSE
- ZDIST = ZDP0PP0
- LFACE = .TRUE.
- ENDIF
- !***Point anticlockwise of V3 and clockwise of V1
- ELSEIF (ZF3.GE.0.AND.ZF1.LE.0) THEN
- ZFT3B = CROSSPRODUCT(ZPP0P3,ZPP0P1)
- ZF3B = ZFT3B(1)*PNORM_FACES(JN,1)+ &
- ZFT3B(2)*PNORM_FACES(JN,2)+ &
- ZFT3B(3)*PNORM_FACES(JN,3)
- IF (ZF3B<0) THEN
- ZP3P1(:) = PIBM_FACES(JN,1,:)-PIBM_FACES(JN,3,:)
- ZR = CROSSPRODUCT(CROSSPRODUCT(ZPP0P1,ZPP0P3),ZP3P1)
- ZRN = SQRT(ZR(1)**2+ZR(2)**2+ZR(3)**2)
- ZDPP0PPP0 = SQRT(ZPP0P3(1)**2+ZPP0P3(2)**2+ZPP0P3(3)**2)* &
- ((ZPP0P3(1)*ZR(1)+ZPP0P3(2)*ZR(2)+ZPP0P3(3)*ZR(3))/( &
- SQRT((ZPP0P3(1))**2+(ZPP0P3(2))**2+(ZPP0P3(3))**2)*ZRN))! &
- ZPP0PPP0 = ZDPP0PPP0*(ZR/ZRN)
- ZPPP0 = ZPP0+ZPP0PPP0
- ZPPP0P3 = PIBM_FACES(JN,3,:)-ZPPP0
- ZP1P3 = PIBM_FACES(JN,3,:)-PIBM_FACES(JN,1,:)
- ZRDIR = SIGN(1.,SCALPRODUCT(ZPPP0P3,ZP1P3))
- ZT = SQRT(ZPPP0P3(1)**2+ZPPP0P3(2)**2+ZPPP0P3(3)**2)/ &
- SQRT(ZP1P3(1)**2+ZP1P3(2)**2+ZP1P3(3)**2)*ZRDIR(1)
- IF (ZT.GE.0.AND.ZT.LE.1) THEN
- ZDIST = SQRT(ZDPP0PPP0**2+ZDP0PP0**2)
- ELSEIF (ZT<0.) THEN
- ZDIST = SQRT(ZP3P0(1)**2+ZP3P0(2)**2+ZP3P0(3)**2)
- ELSEIF (ZT>1.) THEN
- ZDIST = SQRT(ZP1P0(1)**2+ZP1P0(2)**2+ZP1P0(3)**2)
- ELSE
- call Print_msg( NVERB_FATAL, 'GEN', 'IBM_PREP_LS', 'Error in ZT calculation' )
- ENDIF
- ELSE
- ZDIST = ZDP0PP0
- LFACE = .TRUE.
- ENDIF
- ELSE
- call Print_msg( NVERB_FATAL, 'GEN', 'IBM_PREP_LS', 'Error in ZF instruction' )
- ENDIF
- ZDIST = SIGN(ZDIST,-ZSIGN)
- ZDIST = ANINT(ZDIST*10.E5) / 10.E5
- PPHI(JI,JJ,JK,JM) = ANINT(PPHI(JI,JJ,JK,JM)*10.E5) / 10.E5
- IF (ABS(ZDIST).LE.ABS(PPHI(JI,JJ,JK,JM))) THEN
- ZPHI_OLD = PPHI(JI,JJ,JK,JM)
- IF (ABS(ZDIST)==ABS(PPHI(JI,JJ,JK,JM))) THEN
- IF (ABS(ZDP0PP0).GT.ABS(ZDP0PP0PAST(JI,JJ,JK))) THEN
- PPHI(JI,JJ,JK,JM) = ZDIST
- ZDP0PP0PAST(JI,JJ,JK) = ZDP0PP0
- ENDIF
- ELSE
- PPHI(JI,JJ,JK,JM) = ZDIST
- ENDIF
- IF (ABS(ZDIST).LT.ABS(ZPHI_OLD)) THEN
- ZDP0PP0PAST(JI,JJ,JK) = ZDP0PP0
- ENDIF
- ENDIF
- IF (ABS(PPHI(JI,JJ,JK,JM)).GT.(SQRT(3.)*4.)) THEN
- PPHI(JI,JJ,JK,JM) = -999.
- ENDIF
- IF (ABS(ZDIST).LT.(SQRT(3.)*4.)) THEN
- ZVECTDIST(ZCOUNT)=ZDIST
- ZFACE(ZCOUNT)=LFACE
- ZCOUNT = ZCOUNT +1
- ENDIF
- ENDDO
- ZVECTDISTPLUS=ZVECTDIST
- ZVECTDISTMOINS=ZVECTDIST
- WHERE (ZVECTDIST.GT.0)
- ZVECTDISTMOINS=-999.
- ENDWHERE
- WHERE (ZVECTDIST.LT.0)
- ZVECTDISTPLUS=999.
- ENDWHERE
- IF (ANY(ZVECTDIST.GT.0.).AND.(ABS(ABS(MINVAL(ZVECTDISTPLUS))-ABS(MAXVAL(ZVECTDISTMOINS))).LT.10.E-6)) THEN
- ZMIN_DIFF = 1.
- ZIDX = 0
- DO ZII = 1, SIZE(ZVECTDIST)
- ZDIFF = ABS(ZVECTDIST(ZII)-MINVAL(ZVECTDISTPLUS))
- IF ( ZDIFF < ZMIN_DIFF) THEN
- ZIDX = ZII
- ZMIN_DIFF = ZDIFF
- ENDIF
- ENDDO
- IF (ZFACE(ZIDX)) THEN
- PPHI(JI,JJ,JK,JM) = MINVAL(ZVECTDISTPLUS)
- ENDIF
- ENDIF
- ENDDO
- ENDDO
- ENDDO
-
-DO JJ=JJ_MIN,JJ_MAX
-DO JI=JI_MIN,JI_MAX
-GABOVE_ROOF=.FALSE.
-DO JK=IKB, IKE
- ! check if point is flagged as not calculated
- IF (PPHI(JI,JJ,JK,JM)==-999.) THEN
- ! check if point is already above a point that encountered a point near the
- ! surface (that can be outside or inside a building)
- ! check if that point was inside (if outside, the value of the levelset
- ! stays at -999.)
- IF (GABOVE_ROOF .AND. PPHI(JI,JJ,JK-1,JM) > XIBM_EPSI) THEN
- PPHI(JI,JJ,JK,JM) = 999.
- CYCLE
- END IF
- ! check if the point of the column have not encoutered a near-building
- ! surface point with a physical value of the level set
- IF (.NOT. GABOVE_ROOF) THEN
- ! if the point above has a physical value for the level set, then the
- ! status inside (999) or outside (-999) is given to all points below,
- ! depending if this point above (that needs not to be the point at the top
- ! of the model!) is inside or outside
- ! checks if the point above has a physical value for the levelset
- IF (JK<IKE .AND. ABS (PPHI(JI,JJ,JK+1,JM)) < 900.) THEN
- ! if the point above is inside, all points below are set inside
- IF (PPHI(JI,JJ,JK+1,JM)>XIBM_EPSI) PPHI(JI,JJ,IKB:JK,JM) = 999.
- ! indicate for further processing of points above the current point
- ! that we have encountered a physical value of the level set, near the
- ! surface building
- GABOVE_ROOF = .TRUE.
- END IF
- CYCLE
- ENDIF
- END IF
- ! if we have never encoutered a roof or point near a building form above,
- ! then, we are outside, and nothing is changed (value -999 kept)
- END DO
- PPHI(JI,JJ,IKB-1,JM) = PPHI(JI,JJ,IKB,JM)
- PPHI(JI,JJ,IKE+1,JM) = PPHI(JI,JJ,IKE,JM)
-END DO
-END DO
-
-
-JN=1
-PPHI(:,:,IKB-1,JN)=2*PPHI(:,:,IKB,JN)-PPHI(:,:,IKB+1,JN)
-PPHI(:,:,IKE+1,JN)=2*PPHI(:,:,IKE,JN)-PPHI(:,:,IKE-1,JN)
-PPHI(IIB-1,:,:,JN) = PPHI( IIB ,:,:,JN)
-PPHI(IIE+1,:,:,JN) = PPHI( IIE ,:,:,JN)
-PPHI(:,IJB-1,:,JN) = PPHI(:, IJB ,:,JN)
-PPHI(:,IJE+1,:,JN) = PPHI(:, IJE ,:,JN)
-
-PPHI(:,:,:,2)=MXM(PPHI(:,:,:,1))
-PPHI(:,:,:,3)=MYM(PPHI(:,:,:,1))
-PPHI(:,:,:,4)=MZM(PPHI(:,:,:,1))
-
-NULLIFY(TZFIELDS_ll)
-DO JN=2,4
- PPHI(:,:,IKB-1,JN)=2*PPHI(:,:,IKB,JN)-PPHI(:,:,IKB+1,JN)
- PPHI(:,:,IKE+1,JN)=2*PPHI(:,:,IKE,JN)-PPHI(:,:,IKE-1,JN)
- PPHI(IIB-1,:,:,JN) = PPHI( IIB ,:,:,JN)
- PPHI(IIE+1,:,:,JN) = PPHI( IIE ,:,:,JN)
- PPHI(:,IJB-1,:,JN) = PPHI(:, IJB ,:,JN)
- PPHI(:,IJE+1,:,JN) = PPHI(:, IJE ,:,JN)
-ENDDO
-
-PPHI(:,:,:,5)=MYM(PPHI(:,:,:,2))
-PPHI(:,:,:,6)=MXM(PPHI(:,:,:,4))
-PPHI(:,:,:,7)=MYM(PPHI(:,:,:,4))
-NULLIFY(TZFIELDS_ll)
-DO JN=5,7
- PPHI(:,:,IKB-1,JN)=2*PPHI(:,:,IKB,JN)-PPHI(:,:,IKB+1,JN)
- PPHI(:,:,IKE+1,JN)=2*PPHI(:,:,IKE,JN)-PPHI(:,:,IKE-1,JN)
- PPHI(IIB-1,:,:,JN) = PPHI( IIB ,:,:,JN)
- PPHI(IIE+1,:,:,JN) = PPHI( IIE ,:,:,JN)
- PPHI(:,IJB-1,:,JN) = PPHI(:, IJB ,:,JN)
- PPHI(:,IJE+1,:,JN) = PPHI(:, IJE ,:,JN)
-ENDDO
-WHERE (ABS(PPHI(:,:,:,:)).LT.XIBM_EPSI) PPHI(:,:,:,:)=2.*XIBM_EPSI
-
-
- !COMPLETE PPHI ON THE HALO OF EACH SUBDOMAINS
- DO JN=1,7
- CALL ADD3DFIELD_ll(TZFIELDS_ll,PPHI(:,:,:,JN),'IBM_GENERLS::PPHI')
- ENDDO
- CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDS_ll)
-
- !
- !-------------------------------------------------------------------------------
- !
- !**** X. DEALLOCATIONS/CLOSES
- ! -----------------------
- !
- !DEALLOCATE(ZDP0PP0,ZDIST,ZC,ZSTEMP)
- DEALLOCATE(ZC,ZSTEMP)
- DEALLOCATE(ZXHATM,ZYHATM,ZZHATM)
- !
- RETURN
- !
-CONTAINS
- !
- FUNCTION CROSSPRODUCT(PA,PB) RESULT(CROSS)
- !
- REAL, DIMENSION(3) :: CROSS
- REAL, DIMENSION(3), INTENT(IN) :: PA, PB
- CROSS(1) = PA(2) * PB(3) - PA(3) * PB(2)
- CROSS(2) = PA(3) * PB(1) - PA(1) * PB(3)
- CROSS(3) = PA(1) * PB(2) - PA(2) * PB(1)
- END FUNCTION CROSSPRODUCT
-
- FUNCTION SCALPRODUCT(PA,PB) RESULT(SCAL)
- !
- REAL :: SCAL
- REAL, DIMENSION(3), INTENT(IN) :: PA, PB
- SCAL = PA(1)*PB(1)+PA(2)*PB(2)+PA(3)*PB(3)
- END FUNCTION SCALPRODUCT
-
-END SUBROUTINE IBM_GENERLS
diff --git a/src/mesonh/ext/ice4_sedimentation_split_momentum.f90 b/src/mesonh/ext/ice4_sedimentation_split_momentum.f90
deleted file mode 100644
index 8b137891791fe96927ad78e64b0aad7bded08bdc..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/ice4_sedimentation_split_momentum.f90
+++ /dev/null
@@ -1 +0,0 @@
-
diff --git a/src/mesonh/ext/ice_adjust_bis.f90 b/src/mesonh/ext/ice_adjust_bis.f90
deleted file mode 100644
index e530d5c21f91b7e143b2d7240f669e4df7c181bd..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/ice_adjust_bis.f90
+++ /dev/null
@@ -1,160 +0,0 @@
-!MNH_LIC Copyright 2012-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ######spl
- MODULE MODI_ICE_ADJUST_BIS
-! ###############################
-!
-INTERFACE
-!
-! #################################################################
- SUBROUTINE ICE_ADJUST_BIS(PP,PTH,PR)
-! #################################################################
-!
-!!
-!* 1.1 Declaration of Arguments
-!!
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PP ! Pressure
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTH ! thetal to transform into th
-REAL, DIMENSION(:,:,:,:),INTENT(INOUT) :: PR ! Total mixing ratios to transform into rv,rc and ri
-!
-END SUBROUTINE ICE_ADJUST_BIS
-
-END INTERFACE
-!
-END MODULE MODI_ICE_ADJUST_BIS
-! ######spl
- SUBROUTINE ICE_ADJUST_BIS(PP,PTH,PR)
-! #################################################################
-!
-!
-!!**** *ICE_ADJUST_BIS* - computes an adjusted state of thermodynamical variables
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! Valery Masson & C. Lac * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 09/2012
-!! M.Moge 08/2015 UPDATE_HALO_ll on PTH, ZRV, ZRC, ZRI
-! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
-!!
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY : XCPD, XRD, XP00, CST
-USE MODD_NEB_n, ONLY : NEBN
-!
-USE MODI_COMPUTE_FUNCTION_THERMO
-USE MODI_THLRT_FROM_THRVRCRI
-!
-USE MODE_ll
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PP ! Pressure
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTH ! thetal to transform into th
-REAL, DIMENSION(:,:,:,:),INTENT(INOUT) :: PR ! Total mixing ratios to transform into rv,rc and ri
-!
-!-------------------------------------------------------------------------------
-!
-! 0.2 declaration of local variables
-REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZTHL, ZRW, ZRV, ZRC, &
- ZRI, ZWORK
-REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZFRAC_ICE, ZRSATW, ZRSATI
-REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZT, ZEXN, ZLVOCPEXN,ZLSOCPEXN
-REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3), 16) :: ZBUF
-INTEGER :: IRR
-CHARACTER(LEN=1) :: YFRAC_ICE
-!
-INTEGER :: IINFO_ll
-TYPE(LIST_ll), POINTER :: TZFIELDS_ll=>NULL() ! list of fields to exchange
-!----------------------------------------------------------------------------
-!
-!* 1 Initialisation
-! --------------
-!
-IRR = SIZE(PR,4)
-!
-ZRV(:,:,:)=0.
-IF (IRR>=1) &
-ZRV(:,:,:)=PR(:,:,:,1)
-ZRC(:,:,:)=0.
-IF (IRR>=2) &
-ZRC(:,:,:)=PR(:,:,:,2)
-ZRI(:,:,:)=0.
-IF (IRR>=4) &
-ZRI(:,:,:)=PR(:,:,:,4)
-!
-YFRAC_ICE='T'
-ZFRAC_ICE(:,:,:) = 0.
-!
-!* 2 Computation
-! -----------
-!
-ZEXN(:,:,:)=(PP(:,:,:)/XP00)**(XRD/XCPD)
-!
-CALL COMPUTE_FUNCTION_THERMO( IRR, &
- PTH, PR, ZEXN, PP, &
- ZT,ZLVOCPEXN,ZLSOCPEXN )
-
-!
-CALL THLRT_FROM_THRVRCRI( IRR, PTH, PR, ZLVOCPEXN, ZLSOCPEXN,&
- ZTHL, ZRW )
-!
-CALL TH_R_FROM_THL_RT(CST, NEBN, SIZE(ZFRAC_ICE), YFRAC_ICE,ZFRAC_ICE(:,:,:),PP(:,:,:), &
- ZTHL(:,:,:), ZRW(:,:,:), PTH(:,:,:), &
- ZRV(:,:,:), ZRC(:,:,:), ZRI(:,:,:), &
- ZRSATW(:,:,:), ZRSATI(:,:,:),OOCEAN=.FALSE.,&
- PBUF=ZBUF)
-CALL ADD3DFIELD_ll( TZFIELDS_ll, PTH, 'ICE_ADJUST_BIS::PTH')
-IF (IRR>=1) THEN
- CALL ADD3DFIELD_ll( TZFIELDS_ll, ZRV, 'ICE_ADJUST_BIS::ZRV' )
-ENDIF
-IF (IRR>=2) THEN
- CALL ADD3DFIELD_ll( TZFIELDS_ll, ZRC, 'ICE_ADJUST_BIS::ZRC' )
-ENDIF
-IF (IRR>=4) THEN
- CALL ADD3DFIELD_ll( TZFIELDS_ll, ZRI, 'ICE_ADJUST_BIS::ZRI' )
-ENDIF
-CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
-CALL CLEANLIST_ll(TZFIELDS_ll)
-!
-
-IF (IRR>=1) &
-PR(:,:,:,1) = ZRV(:,:,:)
-IF (IRR>=2) &
-PR(:,:,:,2) = ZRC(:,:,:)
-IF (IRR>=4) &
-PR(:,:,:,4) = ZRI(:,:,:)
-!
-CONTAINS
-INCLUDE "th_r_from_thl_rt.func.h"
-INCLUDE "compute_frac_ice.func.h"
-END SUBROUTINE ICE_ADJUST_BIS
diff --git a/src/mesonh/ext/ini_budget.f90 b/src/mesonh/ext/ini_budget.f90
deleted file mode 100644
index 2e61b72bed99db11509810ea930150f476d25f4d..0000000000000000000000000000000000000000
--- 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_n, 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_neb_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 = ( nmom_s.ge.2 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'CNVI'
- tzsource%clongname = 'conversion of snow to cloud ice'
- tzsource%lavailable = ( nmom_s.ge.2 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'CNVS'
- tzsource%clongname = 'conversion of pristine ice to snow'
- tzsource%lavailable = ( nmom_s.ge.2 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'BRKU'
- tzsource%clongname = 'break up of snow'
- tzsource%lavailable = ( nmom_s.ge.2 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'RIM'
- tzsource%clongname = 'heavy riming of cloud droplet on snow'
- tzsource%lavailable = ( nmom_s.ge.2 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'ACC'
- tzsource%clongname = 'accretion of rain on snow'
- tzsource%lavailable = ( nmom_s.ge.2 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'CMEL'
- tzsource%clongname = 'conversion melting of snow'
- tzsource%lavailable = ( nmom_s.ge.2 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'WETG'
- tzsource%clongname = 'wet growth of graupel'
- tzsource%lavailable = ( nmom_s.ge.2 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'DRYG'
- tzsource%clongname = 'dry growth of graupel'
- tzsource%lavailable = ( nmom_s.ge.2 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'WETH'
- tzsource%clongname = 'wet growth of hail'
- tzsource%lavailable = nmom_s.ge.2
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'SSC'
- tzsource%clongname = 'snow self collection'
- tzsource%lavailable = ( nmom_s.ge.2 )
- 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_g.ge.2 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'RIM'
- tzsource%clongname = 'heavy riming of cloud droplet on snow'
- tzsource%lavailable = ( nmom_g.ge.2 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'ACC'
- tzsource%clongname = 'accretion of rain on snow'
- tzsource%lavailable = ( nmom_g.ge.2 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'CMEL'
- tzsource%clongname = 'conversion melting of snow'
- tzsource%lavailable = ( nmom_g.ge.2 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'CFRZ'
- tzsource%clongname = 'conversion freezing of raindrop'
- tzsource%lavailable = ( nmom_g.ge.2 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'WETG'
- tzsource%clongname = 'wet growth of graupel'
- tzsource%lavailable = ( nmom_g.ge.2 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'GMLT'
- tzsource%clongname = 'graupel melting'
- tzsource%lavailable = ( nmom_g.ge.2 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'WETH'
- tzsource%clongname = 'wet growth of hail'
- tzsource%lavailable = nmom_g.ge.2
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'COHG'
- tzsource%clongname = 'conversion hail graupel'
- tzsource%lavailable = nmom_g.ge.2
- 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_h.ge.2 )
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'WETG'
- tzsource%clongname = 'wet growth of graupel'
- tzsource%lavailable = nmom_h.ge.2
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'COHG'
- tzsource%clongname = 'conversion hail graupel'
- tzsource%lavailable = nmom_h.ge.2
- call Budget_source_add( tbudgets(ibudget), tzsource )
-
- tzsource%cmnhname = 'HMLT'
- tzsource%clongname = 'hail melting'
- tzsource%lavailable = nmom_h.ge.2
- 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_cturb.f90 b/src/mesonh/ext/ini_cturb.f90
deleted file mode 100644
index 8b137891791fe96927ad78e64b0aad7bded08bdc..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/ini_cturb.f90
+++ /dev/null
@@ -1 +0,0 @@
-
diff --git a/src/mesonh/ext/ini_elecn.f90 b/src/mesonh/ext/ini_elecn.f90
deleted file mode 100644
index e00ea14d3a6f0eff266625c09fc945a1c7805d80..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/ini_elecn.f90
+++ /dev/null
@@ -1,327 +0,0 @@
-!MNH_LIC Copyright 2009-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_ELEC_n
-! ######################
-!
-INTERFACE
- SUBROUTINE INI_ELEC_n (KLUOUT, HELEC, HCLOUD, TPINIFILE, &
- PTSTEP, PZZ, &
- PDXX, PDYY, PDZZ, PDZX, PDZY )
-!
-USE MODD_IO, ONLY : TFILEDATA
-!
-INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
-CHARACTER (LEN=4), INTENT(IN) :: HELEC ! atmospheric electricity scheme
-CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! microphysics scheme
-TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE! Initial file
-REAL, INTENT(IN) :: PTSTEP ! Time STEP
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height z
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDZX ! metric coefficient dzx
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDZY ! metric coefficient dzy
-!
-END SUBROUTINE INI_ELEC_n
-END INTERFACE
-END MODULE MODI_INI_ELEC_n
-!
-! #########################################################
- SUBROUTINE INI_ELEC_n(KLUOUT, HELEC, HCLOUD, TPINIFILE, &
- PTSTEP, PZZ, &
- PDXX, PDYY, PDZZ, PDZX, PDZY )
-! #########################################################
-!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to initialize the variables
-! of the atmospheric electricity scheme
-!
-!! METHOD
-!! ------
-!! The initialization of the scheme is performed as follows :
-!!
-!! EXTERNAL
-!! --------
-!! CLEANLIST_ll : deaalocate a list
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! C. Barthe * Laboratoire de l'Atmosphère et des Cyclones *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 09/11/09
-!! M. Chong 13/05/11 Add computation of specific parameters for solving
-!! the electric field equation (elements of tri-diag
-!! matrix)
-!! J.-P. Pinty 13/04/12 Add elec_trid to initialise the tridiagonal syst.
-!! J.-P. Pinty 01/07/12 Add a non-homogeneous Neuman fair-weather
-!! boundary condition at the top
-!! J.-P. Pinty 15/11/13 Initialize the flash maps
-!! 10/2016 (C.Lac) Add droplet deposition
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CLOUDPAR_n, ONLY : NSPLITR
-USE MODD_CONF, ONLY : CEQNSYS,CCONF,CPROGRAM
-USE MODD_CONF_n, ONLY : NRR
-USE MODD_CST
-USE MODD_DIM_n, ONLY : NIMAX_ll, NJMAX_ll
-USE MODD_DYN
-USE MODD_DYN_n, ONLY : XRHOM, XTRIGSX, XTRIGSY, XAF, XCF, XBFY, XBFB, XDXHATM, &
- XDYHATM, NIFAXX, NIFAXY, XBF_SXP2_YP1_Z
-USE MODD_ELEC_DESCR
-USE MODD_ELEC_FLASH
-USE MODD_ELEC_n, ONLY : XRHOM_E, XAF_E, XCF_E, XBFY_E, XBFB_E, XBF_SXP2_YP1_Z_E
-USE MODD_GET_n, ONLY : CGETINPRC, CGETINPRR, CGETINPRS, CGETINPRG, CGETINPRH, &
- CGETCLOUD, CGETSVT
-USE MODD_GRID_n, ONLY : XMAP, XDXHAT, XDYHAT
-USE MODD_IO, ONLY : TFILEDATA
-USE MODD_LBC_n, ONLY : CLBCX, CLBCY
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_PARAM_C2R2, ONLY : LDEPOC
-USE MODD_PARAMETERS, ONLY : JPVEXT, JPHEXT
-USE MODD_PARAM_ICE_n, ONLY : LDEPOSC
-USE MODD_PRECIP_n, ONLY : XINPRR, XACPRR, XINPRS, XACPRS, XINPRG, XACPRG, &
- XINPRH, XACPRH, XINPRC, XACPRC, XINPRR3D, XEVAP3D,&
- XINDEP,XACDEP
-USE MODD_REF
-USE MODD_REF_n, ONLY : XRHODJ, XTHVREF
-USE MODD_TIME
-!
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-USE MODE_ll
-use mode_msg
-!
-USE MODI_ELEC_TRIDZ
-USE MODI_INI_CLOUD
-USE MODI_INI_FIELD_ELEC
-USE MODI_INI_FLASH_GEOM_ELEC
-USE MODI_INI_PARAM_ELEC
-USE MODI_INI_RAIN_ICE_ELEC
-USE MODI_READ_PRECIP_FIELD
-!
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of dummy arguments
-!
-INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
-CHARACTER (LEN=4), INTENT(IN) :: HELEC ! atmospheric electricity scheme
-CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! microphysics scheme
-TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE! Initial file
-REAL, INTENT(IN) :: PTSTEP ! Time STEP
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height z
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDZX ! metric coefficient dzx
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDZY ! metric coefficient dzy
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: ILUOUT ! Logical unit number of output-listing
-!
-INTEGER :: IIU ! Upper dimension in x direction (local)
-INTEGER :: IJU ! Upper dimension in y direction (local)
-INTEGER :: IKU ! Upper dimension in z direction
-INTEGER :: IKB, IKE
-INTEGER :: JK ! Loop vertical index
-INTEGER :: IINFO_ll ! Return code of // routines
-INTEGER :: IINTVL ! Number of intervals to integrate the kernels
-REAL :: ZFDINFTY ! Factor used to define the "infinite" diameter
-!
-REAL :: ZRHO00 ! Surface reference air density
-REAL :: ZDZMIN
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDZ ! mesh size
-CHARACTER (LEN=3) :: YEQNSYS
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 0. PROLOGUE
-! --------
-!
-ILUOUT = TLUOUT%NLU
-!
-CALL GET_DIM_EXT_ll('B',IIU,IJU)
-IKU = SIZE(PZZ,3)
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. ALLOCATE Module MODD_PRECIP_n
-! -----------------------------
-!
-IF (HCLOUD(1:3) == 'ICE') THEN
- ALLOCATE( XINPRR(IIU,IJU) )
- ALLOCATE( XINPRR3D(IIU,IJU,IKU) )
- ALLOCATE( XEVAP3D(IIU,IJU,IKU) )
- ALLOCATE( XACPRR(IIU,IJU) )
- XINPRR(:,:) = 0.0
- XACPRR(:,:) = 0.0
- XINPRR3D(:,:,:) = 0.0
- XEVAP3D(:,:,:) = 0.0
- ALLOCATE( XINPRC(IIU,IJU) )
- ALLOCATE( XACPRC(IIU,IJU) )
- XINPRC(:,:) = 0.0
- XACPRC(:,:) = 0.0
- ALLOCATE( XINPRS(IIU,IJU) )
- ALLOCATE( XACPRS(IIU,IJU) )
- XINPRS(:,:) = 0.0
- XACPRS(:,:) = 0.0
- ALLOCATE( XINPRG(IIU,IJU) )
- ALLOCATE( XACPRG(IIU,IJU) )
- XINPRG(:,:) = 0.0
- XACPRG(:,:) = 0.0
-END IF
-!
-IF (HCLOUD == 'ICE4') THEN
- ALLOCATE( XINPRH(IIU,IJU) )
- ALLOCATE( XACPRH(IIU,IJU) )
- XINPRH(:,:) = 0.0
- XACPRH(:,:) = 0.0
-ELSE
- ALLOCATE( XINPRH(0,0) )
- ALLOCATE( XACPRH(0,0) )
-END IF
-!
-IF ( LDEPOSC) THEN
- ALLOCATE(XINDEP(IIU,IJU))
- ALLOCATE(XACDEP(IIU,IJU))
- XINDEP(:,:)=0.0
- XACDEP(:,:)=0.0
-ELSE
- ALLOCATE(XINDEP(0,0))
- ALLOCATE(XACDEP(0,0))
-END IF
-!
-IF(SIZE(XINPRR) == 0) RETURN
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. Initialize MODD_PRECIP_n variables
-! -----------------------------------
-!
-CALL READ_PRECIP_FIELD (TPINIFILE, CPROGRAM, CCONF, &
- CGETINPRC,CGETINPRR,CGETINPRS,CGETINPRG,CGETINPRH, &
- XINPRC,XACPRC,XINDEP,XACDEP,XINPRR,XINPRR3D,XEVAP3D, &
- XACPRR, XINPRS, XACPRS, XINPRG, XACPRG, XINPRH, XACPRH)
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. INITIALIZE THE PARAMETERS
-!* FOR THE MICROPHYSICS AND THE ELECTRICITY
-! ----------------------------------------
-!
-!* 3.1 Compute the minimun vertical mesh size
-!
-ALLOCATE( ZDZ(IIU,IJU,IKU) )
-ZDZ(:,:,:) = 0.
-!
-IKB = 1 + JPVEXT
-IKE = SIZE(PZZ,3) - JPVEXT
-!
-DO JK = IKB, IKE
- ZDZ(:,:,JK) = PZZ(:,:,JK+1) - PZZ(:,:,JK)
-END DO
-ZDZMIN = MIN_ll (ZDZ,IINFO_ll,1,1,IKB,NIMAX_ll+2*JPHEXT,NJMAX_ll+2*JPHEXT,IKE )
-!
-DEALLOCATE(ZDZ)
-!
-!
-IF (HELEC(1:3) == 'ELE') THEN
-!
-!
-!* 3.2 initialize the parameters for the mixed-phase microphysics
-!* and the electrification
-!
- CALL INI_RAIN_ICE_ELEC (KLUOUT, PTSTEP, ZDZMIN, NSPLITR, HCLOUD, &
- IINTVL, ZFDINFTY)
-!
-!
-!* 3.3 initialize the electrical parameters
-!
- ZRHO00 = XP00 / (XRD * XTHVREFZ(IKB))
-!
- CALL INI_PARAM_ELEC (TPINIFILE, CGETSVT, ZRHO00, NRR, IINTVL, &
- ZFDINFTY, IIU, IJU, IKU)
-!
-!
-!* 3.4 initialize the parameters for the electric field
-!
- IF (LINDUCTIVE .OR. ((.NOT. LOCG) .AND. LELEC_FIELD)) THEN
- CALL INI_FIELD_ELEC (PDXX, PDYY, PDZZ, PDZX, PDZY, PZZ)
- END IF
-!
-!
-!* 3.5 initialize the parameters for the lightning flashes
-!
- IF (.NOT. LOCG) THEN
- IF (LFLASH_GEOM) THEN
- CALL INI_FLASH_GEOM_ELEC
- ELSE
- call Print_msg( NVERB_FATAL, 'GEN', 'INI_ELEC_n', 'INI_LIGHTNING_ELEC not yet developed' )
- END IF
- END IF
-!
-ELSE IF (HELEC /= 'NONE') THEN
- call Print_msg( NVERB_FATAL, 'GEN', 'INI_ELEC_n', 'not yet developed for CELEC='//trim(HELEC) )
-END IF
-!
-!* 3.6 initialize the parameters for the resolution of the electric field
-!
-YEQNSYS = CEQNSYS
-CEQNSYS = 'LHE'
-! Force any CEQNSYS (DUR, MAE, LHE) to LHE to obtain a unique set of coefficients
-! for the flat laplacian operator and Return to the original CEQNSYS
-
-ALLOCATE (XRHOM_E(SIZE(XRHOM)))
-ALLOCATE (XAF_E(SIZE(XAF)))
-ALLOCATE (XCF_E(SIZE(XCF)))
-ALLOCATE (XBFY_E(SIZE(XBFY,1),SIZE(XBFY,2),SIZE(XBFY,3)))
-ALLOCATE (XBFB_E(SIZE(XBFB,1),SIZE(XBFB,2),SIZE(XBFB,3)))
-ALLOCATE (XBF_SXP2_YP1_Z_E(SIZE(XBF_SXP2_YP1_Z,1),SIZE(XBF_SXP2_YP1_Z,2),&
- SIZE(XBF_SXP2_YP1_Z,3)))
-!
-CALL ELEC_TRIDZ (CLBCX,CLBCY, &
- XMAP,XDXHAT,XDYHAT,XDXHATM,XDYHATM,XRHOM_E,XAF_E, &
- XCF_E,XTRIGSX,XTRIGSY,NIFAXX,NIFAXY, &
- XRHODJ,XTHVREF,PZZ,XBFY_E,XEPOTFW_TOP, &
- XBFB_E,XBF_SXP2_YP1_Z_E)
-!
-CEQNSYS=YEQNSYS
-!
-!* 3.7 initialize the flash maps
-!
-ALLOCATE( NMAP_TRIG_IC(IIU,IJU) ); NMAP_TRIG_IC(:,:) = 0
-ALLOCATE( NMAP_IMPACT_CG(IIU,IJU) ); NMAP_IMPACT_CG(:,:) = 0
-ALLOCATE( NMAP_2DAREA_IC(IIU,IJU) ); NMAP_2DAREA_IC(:,:) = 0
-ALLOCATE( NMAP_2DAREA_CG(IIU,IJU) ); NMAP_2DAREA_CG(:,:) = 0
-ALLOCATE( NMAP_3DIC(IIU,IJU,IKU) ); NMAP_3DIC(:,:,:) = 0
-ALLOCATE( NMAP_3DCG(IIU,IJU,IKU) ); NMAP_3DCG(:,:,:) = 0
-!
-!-------------------------------------------------------------------------------
-!
-!
-END SUBROUTINE INI_ELEC_n
diff --git a/src/mesonh/ext/ini_flash_geom_elec.f90 b/src/mesonh/ext/ini_flash_geom_elec.f90
deleted file mode 100644
index 3c5faece3492d78a958b5bfe54b815164611abde..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/ini_flash_geom_elec.f90
+++ /dev/null
@@ -1,148 +0,0 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-! ###############################
- MODULE MODI_INI_FLASH_GEOM_ELEC
-! ###############################
-!
-INTERFACE
-!
- SUBROUTINE INI_FLASH_GEOM_ELEC
-!
-END SUBROUTINE INI_FLASH_GEOM_ELEC
-END INTERFACE
-END MODULE MODI_INI_FLASH_GEOM_ELEC
-!
-! ##############################
- SUBROUTINE INI_FLASH_GEOM_ELEC
-! ##############################
-!
-!!**** *INI_FLASH_GEOM_ELEC* - routine to initialize the lightning flashes
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to initialize the variables
-! of the lightning flashes routine
-!
-!!** METHOD
-!! ------
-!! The initialization of the scheme is performed as follows :
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 29/11/02
-!!
-!! Modifications
-!! J.-P. Pinty jan 2015 : add LMA simulator
-!! J.Escobar 20/06/2018 : truly set NBRANCH_MAX = 5000 !
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY : XPI
-USE MODD_RAIN_ICE_DESCR_n
-USE MODD_ELEC_DESCR
-USE MODD_ELEC_PARAM
-USE MODD_DIM_n, ONLY : NKMAX
-USE MODD_TIME_n, ONLY : TDTCUR
-USE MODD_LMA_SIMULATOR, ONLY : LLMA, TDTLMA, LWRITE_LMA, XDTLMA, CLMA_FILE
-!
-USE MODI_MOMG
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of dummy arguments
-!
-!
-!* 0.2 Declaration of local variables
-!
-!
-!----------------------------------------------------------------------------
-!
-!* 1. SOME CONSTANTS FOR NEUTRALIZATION
-! ---------------------------------
-!
-XFQLIGHTC = 660. * MOMG(3.,3.,2.) / MOMG(3.,3.,3.) ! PI/A*lbda^(b-2) = 660.
-!
-XFQLIGHTR = XPI * XCCR * MOMG(XALPHAR,XNUR,2.)
-XEXQLIGHTR = XCXR - 2.
-!
-XEXQLIGHTI = 2. / XBI
-XFQLIGHTI = XPI / 4. * MOMG(XALPHAI,XNUI,2.) * &
- (XAI * MOMG(XALPHAI,XNUI,XBI))**(-XEXQLIGHTI)
-!
-XFQLIGHTS = XPI * XCCS * MOMG(XALPHAS,XNUS,2.)
-XEXQLIGHTS = XCXS - 2.
-!
-XFQLIGHTG = XPI * XCCG * MOMG(XALPHAG,XNUG,2.)
-XEXQLIGHTG = XCXG - 2.
-!
-!
-!----------------------------------------------------------------------------
-!
-!* 2. INITIALIZE SOME THRESHOLDS
-! --------------------------
-!
-! electric field threshold for cell detection
-! from Marshall et al. (1995) JGR, the breakeven electric field is
-! 200 kV/m at the ground, ~ 33 kV/m at 15 km, and ~ 18 kV/m at 20 km height.
-! To be sure all the electrified cells are detected, this threshold is set to
-! 20 kV/m
-XE_THRESH = 35.E3 ! (V/m)
-!
-! the maximum of segments in the bi-leader corresponds to the number of
-! altitude levels in the domain since the bi-leader is hypothesized to
-! propagate only along the vertical
-NLEADER_MAX = NKMAX
-!
-! the maximum number of branches is arbitriraly set to 5000
-NBRANCH_MAX = 5000
-!
-! the maximum number of electrified cells in the domain is arbitrarily
-! set to 10
-NMAX_CELL = 10
-!
-! the altitude for CG to be prolongated to the ground is set to 2 km
-! this threshold could be modified once ions will be taken into account
-XALT_CG = 2000. ! m
-!
-!
-!----------------------------------------------------------------------------
-!
-!* 3. INITIALIZATIONS
-! ---------------
-!
-NNBLIGHT = 0
-NNB_CG = 0
-NNB_CG_POS = 0
-!
-!
-!----------------------------------------------------------------------------
-!
-!* 4. INITIALIZE LMA RECORDS
-! ----------------------
-!
-! needs LLMA = .TRUE. to operate
-XDTLMA = 600.
-TDTLMA = TDTCUR
-LWRITE_LMA = .FALSE.
-CLMA_FILE(1:5) = "BEGIN"
-!
-!----------------------------------------------------------------------------
-!
-END SUBROUTINE INI_FLASH_GEOM_ELEC
diff --git a/src/mesonh/ext/ini_lb.f90 b/src/mesonh/ext/ini_lb.f90
deleted file mode 100644
index faa09698bf58497f08539e7305b5f0fc0d01487c..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/ini_lb.f90
+++ /dev/null
@@ -1,730 +0,0 @@
-!MNH_LIC Copyright 1998-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_LB
-! ######################
-!
-INTERFACE
-!
-SUBROUTINE INI_LB(TPINIFILE,OLSOURCE,KSV, &
- KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, &
- KSIZELBXTKE_ll,KSIZELBYTKE_ll, &
- KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, &
- HGETTKEM,HGETRVM,HGETRCM,HGETRRM,HGETRIM,HGETRSM, &
- HGETRGM,HGETRHM,HGETSVM, &
- PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
- PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
- PLBXUMM,PLBXVMM,PLBXWMM,PLBXTHMM,PLBXTKEMM,PLBXRMM,PLBXSVMM, &
- PLBYUMM,PLBYVMM,PLBYWMM,PLBYTHMM,PLBYTKEMM,PLBYRMM,PLBYSVMM, &
- PLENG )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
-LOGICAL, INTENT(IN) :: OLSOURCE ! switch for the source term
-! Larger Scale fields (source if OLSOURCE=T, fields at time t-dt if OLSOURCE=F) :
-INTEGER, INTENT(IN) :: KSV ! number of passive variables
-! sizes of the West-east total LB area
-INTEGER, INTENT(IN) :: KSIZELBX_ll,KSIZELBXU_ll ! for T,V,W and u
-INTEGER, INTENT(IN) :: KSIZELBXTKE_ll ! for TKE
-INTEGER, INTENT(IN) :: KSIZELBXR_ll,KSIZELBXSV_ll ! for Rx and SV
-! sizes of the North-south total LB area
-INTEGER, INTENT(IN) :: KSIZELBY_ll,KSIZELBYV_ll ! for T,U,W and v
-INTEGER, INTENT(IN) :: KSIZELBYTKE_ll ! for TKE
-INTEGER, INTENT(IN) :: KSIZELBYR_ll,KSIZELBYSV_ll ! for Rx and SV
-! Get indicators
-CHARACTER (LEN=*), INTENT(IN) :: HGETTKEM, &
- HGETRVM,HGETRCM,HGETRRM, &
- HGETRIM,HGETRSM,HGETRGM,HGETRHM
-CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVM
-! LB fields (source if OLSOURCE=T, fields at time t-dt if OLSOURCE=F) :
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXUM,PLBXVM,PLBXWM ! Wind
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXTHM ! Mass
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYUM,PLBYVM,PLBYWM ! Wind
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYTHM ! Mass
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXTKEM ! TKE
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYTKEM
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PLBXRM ,PLBXSVM ! Moisture and SV
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PLBYRM ,PLBYSVM ! in x and y-dir.
-! LB arrays at time t-dt (if OLSOURCE=T) :
-REAL, DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PLBXUMM,PLBXVMM,PLBXWMM ! Wind
-REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBXTHMM ! Mass
-REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBYUMM,PLBYVMM,PLBYWMM ! Wind
-REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBYTHMM ! Mass
-REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBXTKEMM ! TKE
-REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBYTKEMM
-REAL, DIMENSION(:,:,:,:),INTENT(IN), OPTIONAL :: PLBXRMM ,PLBXSVMM ! Moisture and SV
-REAL, DIMENSION(:,:,:,:),INTENT(IN), OPTIONAL :: PLBYRMM ,PLBYSVMM ! in x and y-dir.
-REAL, INTENT(IN), OPTIONAL :: PLENG ! Interpolation length
-!
-END SUBROUTINE INI_LB
-!
-END INTERFACE
-!
-END MODULE MODI_INI_LB
-! ############################################################
-SUBROUTINE INI_LB(TPINIFILE,OLSOURCE,KSV, &
- KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, &
- KSIZELBXTKE_ll,KSIZELBYTKE_ll, &
- KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, &
- HGETTKEM,HGETRVM,HGETRCM,HGETRRM,HGETRIM,HGETRSM, &
- HGETRGM,HGETRHM,HGETSVM, &
- PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
- PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
- PLBXUMM,PLBXVMM,PLBXWMM,PLBXTHMM,PLBXTKEMM,PLBXRMM,PLBXSVMM, &
- PLBYUMM,PLBYVMM,PLBYWMM,PLBYTHMM,PLBYTKEMM,PLBYRMM,PLBYSVMM, &
- PLENG )
-! ############################################################
-!
-!!**** *INI_LB* - routine to initialize LB fields
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to read the LB fields and to distribute
-! on subdomain which have a non-nul intersection with the LB areas.
-! In case of OLSOURCE=T, it initializes the LB sources instead of the
-! LB fields at time t-dt
-!
-!!** METHOD
-!! ------
-!! The LB fields are read in file and distributed by FMREAD_LB
-!!
-!! In case of OLSOURCE=T (INI_LB called by INI_CPL or LS_COUPLING), the LB sources
-!! are computed
-!!
-!!
-!! EXTERNAL
-!! --------
-!! FMREAD : to read data in LFIFM file
-!! FMREAD_LB : to read LB data in LFIFM file
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CONF : NVERB
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of the documentation (routine INI_LB)
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Ducrocq * Meteo France *
-!! D. Gazen L.A.
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 22/09/98 FMREAD_LB handle LBs fields
-!! J. Stein 18/09/99 problem with the dry case
-!! D. Gazen 22/01/01 treat NSV_* with floating indices
-!! F Gheusi 29/10/03 bug in LB sources for NSV
-!! J.-P. Pinty 06/05/04 treat NSV_* for C1R3 and ELEC
-!! 20/05/06 Remove KEPS
-!! C.Lac 20/03/08 Add passive pollutants
-!! M.Leriche 16/07/10 Add ice phase chemical species
-!! Pialat/tulet 15/02/12 Add ForeFire scalars
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! M.Leriche 09/02/16 Treat gas and aq. chemicals separately
-!! J.Escobar : 27/04/2016 : bug , test only on ANY(HGETSVM({{1:KSV}})=='READ'
-!! J.-P. Pinty 09/02/16 Add LIMA that is LBC for CCN and IFN
-!! M.Leriche 09/02/16 Treat gas and aq. chemicals separately
-! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 13/02/2019: initialize PLBXSVM and PLBYSVM in all cases
-! S. Bielli 02/2019: Sea salt: significant sea wave height influences salt emission; 5 salt modes
-! P. Wautelet 04/02/2022: use TSVLIST to manage metadata of scalar variables
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-!
-USE MODD_TURB_n, ONLY: XTKEMIN
-USE MODD_CONF, ONLY: LCPL_AROME
-use modd_field, only: NMNHDIM_UNKNOWN, tfieldmetadata, TYPELOG, TYPEREAL
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_NSV, ONLY: NSV, NSV_CS, NSV_CSBEG, NSV_CSEND, NSV_LIMA_BEG, NSV_LIMA_END, &
-#ifdef MNH_FOREFIRE
- NSV_FF, NSV_FFBEG, NSV_FFEND, &
-#endif
- NSV_LIMA_CCN_FREE, NSV_LIMA_IFN_FREE, NSV_PP, NSV_PPBEG, NSV_PPEND, &
- NSV_SNWBEG, NSV_SNWEND, NSV_USER, TSVLIST
-USE MODD_PARAMETERS, ONLY: JPHEXT, JPSVNAMELGTMAX, NLONGNAMELGTMAX, NMNHNAMELGTMAX
-USE MODD_PARAM_LIMA, ONLY: NMOD_CCN, NMOD_IFN
-!
-USE MODE_IO_FIELD_READ, only: IO_Field_read, IO_Field_read_lb
-USE MODE_MSG
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
-LOGICAL, INTENT(IN) :: OLSOURCE ! switch for the source term
-! Larger Scale fields (source if OLSOURCE=T, fields at time t-dt if OLSOURCE=F) :
-INTEGER, INTENT(IN) :: KSV ! number of passive variables
-! sizes of the West-east total LB area
-INTEGER, INTENT(IN) :: KSIZELBX_ll,KSIZELBXU_ll ! for T,V,W and u
-INTEGER, INTENT(IN) :: KSIZELBXTKE_ll ! for TKE
-INTEGER, INTENT(IN) :: KSIZELBXR_ll,KSIZELBXSV_ll ! for Rx and SV
-! sizes of the North-south total LB area
-INTEGER, INTENT(IN) :: KSIZELBY_ll,KSIZELBYV_ll ! for T,U,W and v
-INTEGER, INTENT(IN) :: KSIZELBYTKE_ll ! for TKE
-INTEGER, INTENT(IN) :: KSIZELBYR_ll,KSIZELBYSV_ll ! for Rx and SV
-! Get indicators
-CHARACTER (LEN=*), INTENT(IN) :: HGETTKEM, &
- HGETRVM,HGETRCM,HGETRRM, &
- HGETRIM,HGETRSM,HGETRGM,HGETRHM
-CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVM
-! LB fields (source if OLSOURCE=T, fields at time t-dt if OLSOURCE=F) :
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXUM,PLBXVM,PLBXWM ! Wind
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXTHM ! Mass
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYUM,PLBYVM,PLBYWM ! Wind
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYTHM ! Mass
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXTKEM ! TKE
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYTKEM !
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PLBXRM ,PLBXSVM ! Moisture and SV
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PLBYRM ,PLBYSVM ! in x and y-dir.
-! LB arrays at time t-dt (if OLSOURCE=T) :
-REAL, DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PLBXUMM,PLBXVMM,PLBXWMM ! Wind
-REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBXTHMM ! Mass
-REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBYUMM,PLBYVMM,PLBYWMM ! Wind
-REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBYTHMM ! Mass
-REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBXTKEMM ! TKE
-REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBYTKEMM
-REAL, DIMENSION(:,:,:,:),INTENT(IN), OPTIONAL :: PLBXRMM ,PLBXSVMM ! Moisture and SV
-REAL, DIMENSION(:,:,:,:),INTENT(IN), OPTIONAL :: PLBYRMM ,PLBYSVMM ! in x and y-dir.
-REAL, INTENT(IN), OPTIONAL :: PLENG ! Interpolation length
-!
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: ILBSIZEX,ILBSIZEY ! depth of the LB area in the RIM direction
- ! written in FM file
-INTEGER :: IL3DX,IL3DY ! Size of the LB arrays in FM file
- ! in the RIM direction
-INTEGER :: IL3DXU,IL3DYV ! Size of the LB arrays in FM file
- ! in the RIM direction for the normal wind
-INTEGER :: IRIMX,IRIMY ! Total size of the LB area (for the RIM direction)
-INTEGER :: IRIMXU,IRIMYV ! Total size of the LB area (for the RIM direction)
- ! for the normal wind (spatial gradient needed)
-
-INTEGER :: JSV,JRR ! Loop index for MOIST AND
- ! additional scalar variables
-INTEGER :: IRR ! counter for moist variables
-INTEGER :: IRESP
-LOGICAL :: GHORELAX_UVWTH ! switch for the horizontal relaxation for U,V,W,TH in the FM file
-LOGICAL :: GHORELAX_TKE ! switch for the horizontal relaxation for tke in the FM file
-LOGICAL :: GHORELAX_R, GHORELAX_SV ! switch for the horizontal relaxation
- ! for moist and scalar variables
-LOGICAL :: GIS551 ! True if file was written with MNH 5.5.1
-LOGICAL :: GOLDFILEFORMAT
-CHARACTER (LEN= LEN(HGETRVM)), DIMENSION (7) :: YGETRXM ! Arrays with the get indicators
- ! for the moist variables
-CHARACTER (LEN=1), DIMENSION (7) :: YC ! array with the prefix of the moist variables
-CHARACTER(LEN=NMNHNAMELGTMAX) :: YMNHNAME_BASE
-CHARACTER(LEN=NLONGNAMELGTMAX) :: YLONGNAME_BASE
-TYPE(TFIELDMETADATA) :: TZFIELD
-!-------------------------------------------------------------------------------
-!
-!
-!* 0. READ CPL_AROME to know which LB_fileds there are to read
-! --------------------
-IF ((TPINIFILE%NMNHVERSION(1)==4 .AND. TPINIFILE%NMNHVERSION(2)>8) .OR. TPINIFILE%NMNHVERSION(1)>4) THEN
- CALL IO_Field_read(TPINIFILE,'CPL_AROME',LCPL_AROME)
-ELSE
- LCPL_AROME=.FALSE.
-ENDIF
-!
-!
-!* 1. SOME INITIALIZATIONS
-! --------------------
-!
-!If TPINIFILE file was written with a MesoNH version < 5.6, some variables had different names or were not available
-GOLDFILEFORMAT = ( TPINIFILE%NMNHVERSION(1) < 5 &
- .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) < 6 ) )
-GIS551 = TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) == 5 .AND. TPINIFILE%NMNHVERSION(3) == 1
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. READ 2D "surfacic" LB fields
-! ----------------------------
-!
-!* 2.1 read the number of available points for the horizontal relaxation
-! for basic variables
-CALL IO_Field_read(TPINIFILE,'RIMX',ILBSIZEX)
-CALL IO_Field_read(TPINIFILE,'RIMY',ILBSIZEY)
-!
-!* 2.2 Basic variables
-!
-CALL IO_Field_read(TPINIFILE,'HORELAX_UVWTH',GHORELAX_UVWTH)
- !
-IF (GHORELAX_UVWTH) THEN
- IRIMX =(KSIZELBX_ll-2*JPHEXT)/2
- IRIMXU=(KSIZELBXU_ll-2*JPHEXT)/2
- IRIMY =(KSIZELBY_ll-2*JPHEXT)/2
- IRIMYV=(KSIZELBYV_ll-2*JPHEXT)/2
- IL3DX=2*ILBSIZEX+2*JPHEXT
- IL3DXU=IL3DX
- IL3DY=2*ILBSIZEY+2*JPHEXT
- IL3DYV=IL3DY
-ELSE
- IRIMX=0
- IRIMXU=1
- IRIMY=0
- IRIMYV=1
- IL3DX=2*JPHEXT ! 2
- IL3DY=2*JPHEXT ! 2
- IL3DXU=2 + 2*JPHEXT ! 4
- IL3DYV=2 + 2*JPHEXT ! 4
-ENDIF
-!
-IF ( KSIZELBXU_ll /= 0 ) CALL IO_Field_read_lb( TPINIFILE, 'LBXUM', IL3DXU, IRIMXU, PLBXUM )
-IF ( KSIZELBX_ll /= 0 ) CALL IO_Field_read_lb( TPINIFILE, 'LBXVM', IL3DX, IRIMX, PLBXVM )
-IF ( KSIZELBX_ll /= 0 ) CALL IO_Field_read_lb( TPINIFILE, 'LBXWM', IL3DX, IRIMX, PLBXWM )
-IF ( KSIZELBY_ll /= 0 ) CALL IO_Field_read_lb( TPINIFILE, 'LBYUM', IL3DY, IRIMY, PLBYUM )
-IF ( KSIZELBYV_ll /= 0 ) CALL IO_Field_read_lb( TPINIFILE, 'LBYVM', IL3DYV, IRIMYV, PLBYVM )
-IF ( KSIZELBY_ll /= 0 ) CALL IO_Field_read_lb( TPINIFILE, 'LBYWM', IL3DY, IRIMY, PLBYWM )
-IF ( KSIZELBX_ll /= 0 ) CALL IO_Field_read_lb( TPINIFILE, 'LBXTHM', IL3DX, IRIMX, PLBXTHM )
-IF ( KSIZELBY_ll /= 0 ) CALL IO_Field_read_lb( TPINIFILE, 'LBYTHM', IL3DY, IRIMY, PLBYTHM )
-!
-!* 2.3 LB-TKE
-!
-SELECT CASE(HGETTKEM)
-CASE('READ')
- IF (.NOT. LCPL_AROME .AND. OLSOURCE) THEN
- IF (PRESENT(PLBXTKEMM).AND.PRESENT(PLBYTKEMM)) THEN
- CALL PRINT_MSG( NVERB_INFO, 'IO', 'INI_LB', 'LBXTKES and LBYTKE are initialized to PLBXTKEMM and PLBYTKEMM' )
- PLBXTKEM(:,:,:) = PLBXTKEMM(:,:,:)
- PLBYTKEM(:,:,:) = PLBYTKEMM(:,:,:)
- ELSE
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize LBXTKES and LBYTKES')
- ENDIF
- ELSE
- CALL IO_Field_read(TPINIFILE,'HORELAX_TKE',GHORELAX_TKE)
- IF (GHORELAX_TKE) THEN
- IRIMX=(KSIZELBXTKE_ll-2*JPHEXT)/2
- IRIMY=(KSIZELBYTKE_ll-2*JPHEXT)/2
- IL3DX=2*ILBSIZEX+2*JPHEXT
- IL3DY=2*ILBSIZEY+2*JPHEXT
- ELSE
- IRIMX=0
- IRIMY=0
- IL3DX=2*JPHEXT ! 2
- IL3DY=2*JPHEXT ! 2
- ENDIF
-!
- IF (KSIZELBXTKE_ll /= 0) THEN
- CALL IO_Field_read_lb(TPINIFILE,'LBXTKEM',IL3DX,IRIMX,PLBXTKEM)
- END IF
-!
- IF (KSIZELBYTKE_ll /= 0) THEN
- CALL IO_Field_read_lb(TPINIFILE,'LBYTKEM',IL3DY,IRIMY,PLBYTKEM)
- END IF
- ENDIF
-CASE('INIT')
- IF (SIZE(PLBXTKEM,1) /= 0) PLBXTKEM(:,:,:) = XTKEMIN
- IF (SIZE(PLBYTKEM,1) /= 0) PLBYTKEM(:,:,:) = XTKEMIN
-END SELECT
-!
-!
-!* 2.5 LB-Rx
-!
-IF(KSIZELBXR_ll > 0 ) THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'HORELAX_R', &
- CSTDNAME = '', &
- CLONGNAME = 'HORELAX_R', &
- CUNITS = '', &
- CDIR = '--', &
- CCOMMENT = 'Switch to activate the HOrizontal RELAXation', &
- CLBTYPE = 'NONE', &
- NGRID = 1, &
- NTYPE = TYPELOG, &
- NDIMS = 0, &
- LTIMEDEP = .FALSE. )
- !
- CALL IO_Field_read(TPINIFILE,TZFIELD,GHORELAX_R)
- !
- YGETRXM(:)=(/HGETRVM,HGETRCM,HGETRRM,HGETRIM,HGETRSM,HGETRGM,HGETRHM/)
- YC(:)=(/"V","C","R","I","S","G","H"/)
- IF (GHORELAX_R) THEN
- IRIMX=(KSIZELBXR_ll-2*JPHEXT)/2
- IRIMY= (KSIZELBYR_ll-2*JPHEXT)/2
- IL3DX=2*ILBSIZEX+2*JPHEXT
- IL3DY=2*ILBSIZEY+2*JPHEXT
- ELSE
- IRIMX=0
- IRIMY=0
- IL3DX=2*JPHEXT ! 2
- IL3DY=2*JPHEXT ! 2
- END IF
- !
- TZFIELD = TFIELDMETADATA( &
- CUNITS = 'kg kg-1', &
- CDIR = '', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- !
- IRR=0
- JRR=1
- SELECT CASE(YGETRXM(1))
- CASE('READ')
- IRR=IRR+1
- IF ( KSIZELBXR_ll /= 0 ) THEN
- TZFIELD%CMNHNAME = 'LBXR'//YC(JRR)//'M'
- TZFIELD%CLONGNAME = 'LBXR'//YC(JRR)//'M'
- TZFIELD%CLBTYPE = 'LBX'
- TZFIELD%CCOMMENT = '2_Y_Z_LBXR'//YC(JRR)//'M'
- CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXRM(:,:,:,IRR))
- END IF
- !
- IF ( KSIZELBYR_ll /= 0 ) THEN
- TZFIELD%CMNHNAME = 'LBYR'//YC(JRR)//'M'
- TZFIELD%CLONGNAME = 'LBYR'//YC(JRR)//'M'
- TZFIELD%CLBTYPE = 'LBY'
- TZFIELD%CCOMMENT = '2_Y_Z_LBYR'//YC(JRR)//'M'
- CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYRM(:,:,:,IRR))
- END IF
- CASE('INIT')
- IRR=IRR+1
- IF ( SIZE(PLBXRM,1) /= 0 ) PLBXRM(:,:,:,IRR) = 0.
- IF ( SIZE(PLBYRM,1) /= 0 ) PLBYRM(:,:,:,IRR) = 0.
- END SELECT
- !
- !
- DO JRR=2,7
- SELECT CASE(YGETRXM(JRR))
- CASE('READ')
- IRR=IRR+1
- IF ( KSIZELBXR_ll /= 0 ) THEN
- IF (.NOT. LCPL_AROME .AND. OLSOURCE) THEN
- IF (PRESENT(PLBXRMM)) THEN
- PLBXRM(:,:,:,IRR)=PLBXRMM(:,:,:,IRR)
- CALL PRINT_MSG( NVERB_INFO, 'IO', 'INI_LB', 'PLBXRM is initialized to PLBXRMM for LBXR'//YC(JRR)//'M' )
- ELSE
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize PLBXRM for LBXR'//YC(JRR)//'M')
- ENDIF
- ELSE
- TZFIELD%CMNHNAME = 'LBXR'//YC(JRR)//'M'
- TZFIELD%CLONGNAME = 'LBXR'//YC(JRR)//'M'
- TZFIELD%CLBTYPE = 'LBX'
- TZFIELD%CCOMMENT = '2_Y_Z_LBXR'//YC(JRR)//'M'
- CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXRM(:,:,:,IRR))
- ENDIF
- END IF
- !
- IF ( KSIZELBYR_ll /= 0 ) THEN
- IF (.NOT. LCPL_AROME .AND. OLSOURCE) THEN
- IF (PRESENT(PLBYRMM)) THEN
- PLBYRM(:,:,:,IRR)=PLBYRMM(:,:,:,IRR)
- CALL PRINT_MSG( NVERB_INFO, 'IO', 'INI_LB', 'PLBYRM is initialized to PLBYRMM for LBYR'//YC(JRR)//'M' )
- ELSE
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize PLBYRM for LBYR'//YC(JRR)//'M')
- ENDIF
- ELSE
- TZFIELD%CMNHNAME = 'LBYR'//YC(JRR)//'M'
- TZFIELD%CLONGNAME = 'LBYR'//YC(JRR)//'M'
- TZFIELD%CLBTYPE = 'LBY'
- TZFIELD%CCOMMENT = '2_Y_Z_LBYR'//YC(JRR)//'M'
- CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYRM(:,:,:,IRR))
- ENDIF
- END IF
- CASE('INIT')
- IRR=IRR+1
- IF ( SIZE(PLBXRM,1) /= 0 ) PLBXRM(:,:,:,IRR) = 0.
- IF ( SIZE(PLBYRM,1) /= 0 ) PLBYRM(:,:,:,IRR) = 0.
- END SELECT
- END DO
-END IF
-!
-!* 2.6 LB-Scalar Variables
-!
-IF (KSV > 0) THEN
- IF (ANY(HGETSVM(1:KSV)=='READ')) THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'HORELAX_SV', &
- CSTDNAME = '', &
- CLONGNAME = 'HORELAX_SV', &
- CUNITS = '', &
- CDIR = '--', &
- CCOMMENT = '', &
- CLBTYPE = 'NONE', &
- NGRID = 0, &
- NTYPE = TYPELOG, &
- NDIMS = 0, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_read( TPINIFILE, TZFIELD, GHORELAX_SV )
-
- IF ( GHORELAX_SV ) THEN
- IRIMX=(KSIZELBXSV_ll-2*JPHEXT)/2
- IRIMY=(KSIZELBYSV_ll-2*JPHEXT)/2
- IL3DX=2*ILBSIZEX+2*JPHEXT
- IL3DY=2*ILBSIZEY+2*JPHEXT
- ELSE
- IRIMX=0
- IRIMY=0
- IL3DX=2*JPHEXT
- IL3DY=2*JPHEXT
- END IF
- END IF
-END IF
-
-! Scalar variables
-DO JSV = 1, NSV
- SELECT CASE( HGETSVM(JSV) )
- CASE ( 'READ' )
- TZFIELD = TSVLIST(JSV)
- TZFIELD%CDIR = ''
- TZFIELD%NDIMLIST(:) = NMNHDIM_UNKNOWN
- YMNHNAME_BASE = TRIM( TZFIELD%CMNHNAME )
- YLONGNAME_BASE = TRIM( TZFIELD%CLONGNAME )
-
- IF ( KSIZELBXSV_ll /= 0 ) THEN
- TZFIELD%CMNHNAME = 'LBX_' // TRIM( YMNHNAME_BASE )
- TZFIELD%CLONGNAME = 'LBX_' // TRIM( YLONGNAME_BASE )
-
- !Some variables were written with an other name in MesoNH < 5.6
- IF ( GOLDFILEFORMAT ) THEN
- IF ( JSV >= 1 .AND. JSV <= NSV_USER ) THEN
- WRITE( TZFIELD%CMNHNAME, '( A6, I3.3 )' ) 'LBXSVM',JSV
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = TRIM( TZFIELD%CMNHNAME )
- ELSE IF ( JSV >= NSV_LIMA_BEG .AND. JSV <= NSV_LIMA_END ) THEN
- ! Name was corrected in MNH 5.5.1
- IF ( .NOT. GIS551 ) CALL OLD_CMNHNAME_GENERATE_INTERN( TZFIELD%CMNHNAME, TZFIELD%CLONGNAME )
- TZFIELD%CSTDNAME = ''
- ELSE IF ( JSV >= NSV_PPBEG .AND. JSV <= NSV_PPEND ) THEN
- TZFIELD%CMNHNAME = 'LBX_PP'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'LBX_PP'
- IF ( JSV == NSV_PPBEG .AND. NSV_PP > 1 ) THEN
- CMNHMSG(1) = 'reading older file (<5.6) for LBX_PP scalar variables'
- CMNHMSG(2) = 'they are bugged: there should be several LBX_PP variables'
- CMNHMSG(3) = 'but they were all written with the same name ''LBX_PP'''
- CALL PRINT_MSG( NVERB_WARNING, 'IO', 'INI_LB' )
- END IF
-#ifdef MNH_FOREFIRE
- ELSE IF ( JSV >= NSV_FFBEG .AND. JSV <= NSV_FFEND ) THEN
- TZFIELD%CMNHNAME = 'LBX_FF'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'LBX_FF'
- IF ( JSV == NSV_FFBEG .AND. NSV_FF > 1 ) THEN
- CMNHMSG(1) = 'reading older file (<5.6) for LBX_FF scalar variables'
- CMNHMSG(2) = 'they are bugged: there should be several LBX_FF variables'
- CMNHMSG(3) = 'but they were all written with the same name ''LBX_FF'''
- CALL PRINT_MSG( NVERB_WARNING, 'IO', 'INI_LB' )
- END IF
-#endif
- ELSE IF ( JSV >= NSV_CSBEG .AND. JSV <= NSV_CSEND ) THEN
- TZFIELD%CMNHNAME = 'LBX_CS'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'LBX_CS'
- IF ( JSV == NSV_CSBEG .AND. NSV_CS > 1 ) THEN
- CMNHMSG(1) = 'reading older file (<5.6) for LBX_CS scalar variables'
- CMNHMSG(2) = 'they are bugged: there should be several LBX_CS variables'
- CMNHMSG(3) = 'but they were all written with the same name ''LBX_CS'''
- CALL PRINT_MSG( NVERB_WARNING, 'IO', 'INI_LB' )
- END IF
- END IF
- END IF
-
- WRITE( TZFIELD%CCOMMENT, '( A6, A6, I3.3 )' ) '2_Y_Z_', 'LBXSVM', JSV
- TZFIELD%CLBTYPE = 'LBX'
-
- CALL IO_Field_read_lb( TPINIFILE, TZFIELD, IL3DX, IRIMX, PLBXSVM(:,:,:,JSV), IRESP )
-
- IF ( IRESP /= 0 ) THEN
- IF ( PRESENT( PLBXSVMM ) ) THEN
- PLBXSVM(:,:,:,JSV) = PLBXSVMM(:,:,:,JSV)
- CALL PRINT_MSG( NVERB_INFO, 'IO', 'INI_LB', 'PLBXSVM is initialized to PLBXSVMM for ' // TRIM( YMNHNAME_BASE ) )
- ELSE
- IF ( JSV >= NSV_LIMA_BEG .AND. JSV <= NSV_LIMA_END ) THEN
- PLBXSVM(:,:,:,JSV) = 0.
- CALL PRINT_MSG( NVERB_WARNING, 'IO', 'INI_LB', 'PLBXSVM is initialized to 0 for ' // TRIM( YMNHNAME_BASE ) )
- ELSE IF ( ( JSV >= NSV_PPBEG .AND. JSV <= NSV_PPEND ) .OR. &
-#ifdef MNH_FOREFIRE
- ( JSV >= NSV_FFBEG .AND. JSV <= NSV_FFEND ) .OR. &
-#endif
- ( JSV >= NSV_CSBEG .AND. JSV <= NSV_CSEND ) .OR. &
- ( JSV >= NSV_SNWBEG .AND. JSV <= NSV_SNWEND .AND. GOLDFILEFORMAT ) ) THEN !Snow was not written in <5.6
- PLBXSVM(:,:,:,JSV) = 0.
- CALL PRINT_MSG( NVERB_WARNING, 'IO', 'INI_LB', 'PLBXSVM is initialized to 0 for ' // TRIM( YMNHNAME_BASE ) )
- ELSE
- CALL PRINT_MSG( NVERB_FATAL, 'IO', 'INI_LB', 'problem to initialize PLBXSVM for ' // TRIM( YMNHNAME_BASE ) )
- END IF
- END IF
- END IF
- END IF
-
- IF ( KSIZELBYSV_ll /= 0 ) THEN
- TZFIELD%CMNHNAME = 'LBY_' // TRIM( YMNHNAME_BASE )
- TZFIELD%CLONGNAME = 'LBY_' // TRIM( YLONGNAME_BASE )
-
- !Some variables were written with an other name in MesoNH < 5.6
- IF ( GOLDFILEFORMAT ) THEN
- IF ( JSV >= 1 .AND. JSV <= NSV_USER ) THEN
- WRITE( TZFIELD%CMNHNAME, '( A6, I3.3 )' ) 'LBYSVM',JSV
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = TRIM( TZFIELD%CMNHNAME )
- ELSE IF ( JSV >= NSV_LIMA_BEG .AND. JSV <= NSV_LIMA_END ) THEN
- ! Name was corrected in MNH 5.5.1
- IF ( .NOT. GIS551 ) CALL OLD_CMNHNAME_GENERATE_INTERN( TZFIELD%CMNHNAME, TZFIELD%CLONGNAME )
- TZFIELD%CSTDNAME = ''
- ELSE IF ( JSV >= NSV_PPBEG .AND. JSV <= NSV_PPEND ) THEN
- TZFIELD%CMNHNAME = 'LBY_PP'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'LBY_PP'
- IF ( JSV == NSV_PPBEG .AND. NSV_PP > 1 ) THEN
- CMNHMSG(1) = 'reading older file (<5.6) for LBY_PP scalar variables'
- CMNHMSG(2) = 'they are bugged: there should be several LBY_PP variables'
- CMNHMSG(3) = 'but they were all written with the same name ''LBY_PP'''
- CALL PRINT_MSG( NVERB_WARNING, 'IO', 'INI_LB' )
- END IF
-#ifdef MNH_FOREFIRE
- ELSE IF ( JSV >= NSV_FFBEG .AND. JSV <= NSV_FFEND ) THEN
- TZFIELD%CMNHNAME = 'LBY_FF'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'LBY_FF'
- IF ( JSV == NSV_FFBEG .AND. NSV_FF > 1 ) THEN
- CMNHMSG(1) = 'reading older file (<5.6) for LBY_FF scalar variables'
- CMNHMSG(2) = 'they are bugged: there should be several LBY_FF variables'
- CMNHMSG(3) = 'but they were all written with the same name ''LBY_FF'''
- CALL PRINT_MSG( NVERB_WARNING, 'IO', 'INI_LB' )
- END IF
-#endif
- ELSE IF ( JSV >= NSV_CSBEG .AND. JSV <= NSV_CSEND ) THEN
- TZFIELD%CMNHNAME = 'LBY_CS'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'LBY_CS'
- IF ( JSV == NSV_CSBEG .AND. NSV_CS > 1 ) THEN
- CMNHMSG(1) = 'reading older file (<5.6) for LBY_CS scalar variables'
- CMNHMSG(2) = 'they are bugged: there should be several LBY_CS variables'
- CMNHMSG(3) = 'but they were all written with the same name ''LBY_CS'''
- CALL PRINT_MSG( NVERB_WARNING, 'IO', 'INI_LB' )
- END IF
- END IF
- END IF
- WRITE( TZFIELD%CCOMMENT, '( A6, A6, I3.3 )' ) 'X_2_Z_', 'LBYSVM', JSV
- TZFIELD%CLBTYPE = 'LBY'
-
- CALL IO_Field_read_lb( TPINIFILE, TZFIELD, IL3DY, IRIMY, PLBYSVM(:,:,:,JSV), IRESP )
-
- IF ( IRESP /= 0 ) THEN
- IF ( PRESENT( PLBYSVMM ) ) THEN
- PLBYSVM(:,:,:,JSV) = PLBYSVMM(:,:,:,JSV)
- CALL PRINT_MSG( NVERB_INFO, 'IO', 'INI_LB', 'PLBYSVM is initialized to PLBYSVMM for ' // TRIM( YMNHNAME_BASE ) )
- ELSE
- IF ( JSV >= NSV_LIMA_BEG .AND. JSV <= NSV_LIMA_END ) THEN
- PLBYSVM(:,:,:,JSV) = 0.
- CALL PRINT_MSG( NVERB_WARNING, 'IO', 'INI_LB', 'PLBYSVM is initialized to 0 for ' // TRIM( YMNHNAME_BASE ) )
- ELSE IF ( ( JSV >= NSV_PPBEG .AND. JSV <= NSV_PPEND ) .OR. &
-#ifdef MNH_FOREFIRE
- ( JSV >= NSV_FFBEG .AND. JSV <= NSV_FFEND ) .OR. &
-#endif
- ( JSV >= NSV_CSBEG .AND. JSV <= NSV_CSEND ) .OR. &
- ( JSV >= NSV_SNWBEG .AND. JSV <= NSV_SNWEND .AND. GOLDFILEFORMAT ) ) THEN !Snow was not written in <5.6
- PLBYSVM(:,:,:,JSV) = 0.
- CALL PRINT_MSG( NVERB_WARNING, 'IO', 'INI_LB', 'PLBYSVM is initialized to 0 for ' // TRIM( YMNHNAME_BASE ) )
- ELSE
- CALL PRINT_MSG( NVERB_FATAL, 'IO', 'INI_LB', 'problem to initialize PLBYSVM for ' // TRIM( YMNHNAME_BASE ) )
- END IF
- END IF
- END IF
- END IF
-
- CASE( 'INIT' )
- IF ( SIZE(PLBXSVM,1) /= 0 ) PLBXSVM(:,:,:,JSV) = 0.
- IF ( SIZE(PLBYSVM,1) /= 0 ) PLBYSVM(:,:,:,JSV) = 0.
- END SELECT
-END DO
-!-------------------------------------------------------------------------------
-!
-!* 3. COMPUTE THE LB SOURCES
-! -----------------------
-!
-! IN case of initialization of LB source terms (OLSOURCE=T) :
-! xxxM are LB source terms
-! xxxMM are LB fields at time t -dt
-IF (OLSOURCE) THEN
- IF (PRESENT(PLBXUMM).AND.PRESENT(PLBYUMM)) THEN
- PLBXUM(:,:,:) = (PLBXUM(:,:,:) - PLBXUMM(:,:,:)) / PLENG
- PLBYUM(:,:,:) = (PLBYUM(:,:,:) - PLBYUMM(:,:,:)) / PLENG
- ENDIF
- IF (PRESENT(PLBXVMM).AND.PRESENT(PLBYVMM)) THEN
- PLBXVM(:,:,:) = (PLBXVM(:,:,:) - PLBXVMM(:,:,:)) / PLENG
- PLBYVM(:,:,:) = (PLBYVM(:,:,:) - PLBYVMM(:,:,:)) / PLENG
- ENDIF
- IF (PRESENT(PLBXWMM).AND.PRESENT(PLBYWMM)) THEN
- PLBXWM(:,:,:) = (PLBXWM(:,:,:) - PLBXWMM(:,:,:)) / PLENG
- PLBYWM(:,:,:) = (PLBYWM(:,:,:) - PLBYWMM(:,:,:)) / PLENG
- ENDIF
- IF (PRESENT(PLBXTHMM).AND.PRESENT(PLBYTHMM)) THEN
- PLBXTHM(:,:,:) = (PLBXTHM(:,:,:) - PLBXTHMM(:,:,:)) / PLENG
- PLBYTHM(:,:,:) = (PLBYTHM(:,:,:) - PLBYTHMM(:,:,:)) / PLENG
- ENDIF
- IF (HGETTKEM =='READ') THEN
- IF (PRESENT(PLBXTKEMM).AND.PRESENT(PLBYTKEMM)) THEN
- PLBXTKEM(:,:,:) = (PLBXTKEM(:,:,:) - PLBXTKEMM(:,:,:)) / PLENG
- PLBYTKEM(:,:,:) = (PLBYTKEM(:,:,:) - PLBYTKEMM(:,:,:)) / PLENG
- ENDIF
- ENDIF
- IF (HGETTKEM =='INIT') THEN
- PLBXTKEM(:,:,:) = 0.
- PLBYTKEM(:,:,:) = 0.
- ENDIF
-! LB moist variables
- IRR=0
- IF (PRESENT(PLBXRMM).AND.PRESENT(PLBYRMM)) THEN
- DO JRR=1,7
- IF (YGETRXM(JRR) == 'READ') THEN
- IRR=IRR+1
- PLBXRM(:,:,:,IRR) = (PLBXRM(:,:,:,IRR) - PLBXRMM(:,:,:,IRR)) / PLENG
- PLBYRM(:,:,:,IRR) = (PLBYRM(:,:,:,IRR) - PLBYRMM(:,:,:,IRR)) / PLENG
- ENDIF
- END DO
- ENDIF
-! LB-scalar variables
- DO JSV=1,KSV
- IF (HGETSVM(JSV) == 'READ') THEN
- PLBXSVM(:,:,:,JSV) = (PLBXSVM(:,:,:,JSV) - PLBXSVMM(:,:,:,JSV)) / PLENG
- PLBYSVM(:,:,:,JSV) = (PLBYSVM(:,:,:,JSV) - PLBYSVMM(:,:,:,JSV)) / PLENG
- ENDIF
- END DO
-!
-ENDIF
-!
-CONTAINS
-
- SUBROUTINE OLD_CMNHNAME_GENERATE_INTERN( YMNHNAME, YLONGNAME )
-
- CHARACTER(LEN=*), INTENT(INOUT) :: YMNHNAME
- CHARACTER(LEN=*), INTENT(INOUT) :: YLONGNAME
-
- INTEGER :: IPOS
- INTEGER :: JI
-
- !Try to generate CMNHNAME with old format
- !In the old format, an indice of 2 numbers was written after the name but without trimming it
- IPOS = SCAN( YMNHNAME, '0123456789' )
-
- !Unmodified part YMNHNAME(1:IPOS-1) = YMNHNAME(1:IPOS-1)
-
- !Move number part at the new end
- IF ( 4+JPSVNAMELGTMAX+2 > LEN( YMNHNAME ) ) &
- CALL PRINT_MSG(NVERB_FATAL,'GEN','OLD_CMNHNAME_GENERATE_INTERN','CMNHNAME too small')
- YMNHNAME(4+JPSVNAMELGTMAX+1 : 4+JPSVNAMELGTMAX+2) = YMNHNAME(IPOS : IPOS+1)
- DO JI = IPOS, 4+JPSVNAMELGTMAX
- YMNHNAME(JI:JI) = ' '
- END DO
-
- YLONGNAME = TRIM( YMNHNAME )
-
- END SUBROUTINE OLD_CMNHNAME_GENERATE_INTERN
-
-END SUBROUTINE INI_LB
diff --git a/src/mesonh/ext/ini_lesn.f90 b/src/mesonh/ext/ini_lesn.f90
deleted file mode 100644
index 7caf12b44211de2f69700fbab021a42486aa40a7..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/ini_lesn.f90
+++ /dev/null
@@ -1,1995 +0,0 @@
-!MNH_LIC Copyright 2000-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.
-!-----------------------------------------------------------------
-! ####################
- SUBROUTINE INI_LES_n
-! ####################
-!
-!
-!!**** *INI_LES_n* initializes the LES variables for model _n
-!!
-!! PURPOSE
-!! -------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 07/02/00
-!! Modification 01/02/01 (D.Gazen) add module MODD_NSV for NSV variable
-!! 06/11/02 (V. Masson) add LES budgets
-!! 10/2016 (C.Lac) Add droplet deposition
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! 02/2019 (C. Lac) Add rain fraction as a LES diagnostic
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
-! P. Wautelet 12/08/2020: bugfix: use NUNDEF instead of XUNDEF for integer variables
-! P. Wautelet 04/01/2021: bugfix: nles_k was used instead of nspectra_k for a loop index
-! P. Wautelet 30/03/2021: budgets: LES cartesian subdomain limits are defined in the physical domain
-! P. Wautelet 09/07/2021: bugfix: altitude levels are on the correct grid position (mass point)
-! P. Wautelet 22/03/2022: LES averaging periods are more reliable (compute with integers instead of reals)
-! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODE_MSG
-USE MODE_MODELN_HANDLER
-!
-USE MODD_LES
-USE MODD_LES_BUDGET
-USE MODD_LES_n
-!
-USE MODD_CONF
-USE MODD_PARAMETERS
-USE MODD_NESTING
-!
-USE MODD_LUNIT_n
-USE MODD_GRID_n
-USE MODD_DYN_n
-USE MODD_TIME_n
-USE MODD_DIM_n
-USE MODD_TURB_n
-USE MODD_CONF_n
-USE MODD_LBC_n
-USE MODD_PARAM_n
-USE MODD_DYN
-USE MODD_NSV, ONLY: NSV ! update_nsv is done in INI_MODEL
-USE MODD_CONDSAMP, ONLY : LCONDSAMP
-!
-USE MODI_INI_LES_CART_MASKn
-USE MODI_COEF_VER_INTERP_LIN
-USE MODI_SHUMAN
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-!
-! 0.2 declaration of local variables
-!
-!
-!
-INTEGER :: ILUOUT, IRESP
-INTEGER :: JI,JJ, JK ! loop counters
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZZ_LES ! LES altitudes 3D array
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZZ_SPEC! " for spectra
-!
-!
-REAL, DIMENSION(:), POINTER :: ZXHAT_ll ! father model coordinates
-REAL, DIMENSION(:), POINTER :: ZYHAT_ll !
-INTEGER :: IMI
-!
-!-------------------------------------------------------------------------------
-IMI = GET_CURRENT_MODEL_INDEX()
-!
-ZXHAT_ll => NULL()
-ZYHAT_ll => NULL()
-!
-ILUOUT = TLUOUT%NLU
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. Does LES computations are used?
-! ------------------------------
-!
-LLES = LLES_MEAN .OR. LLES_RESOLVED .OR. LLES_SUBGRID .OR. LLES_UPDRAFT &
- .OR. LLES_DOWNDRAFT .OR. LLES_SPECTRA
-!
-!
-IF (.NOT. LLES) RETURN
-!
-IF (L1D) THEN
- LLES_RESOLVED = .FALSE.
- LLES_UPDRAFT = .FALSE.
- LLES_DOWNDRAFT = .FALSE.
- LLES_SPECTRA = .FALSE.
- LLES_NEB_MASK = .FALSE.
- LLES_CORE_MASK = .FALSE.
- LLES_CS_MASK = .FALSE.
- LLES_MY_MASK = .FALSE.
-END IF
-!
-IF (LLES_RESOLVED ) LLES_MEAN = .TRUE.
-IF (LLES_SUBGRID ) LLES_MEAN = .TRUE.
-IF (LLES_UPDRAFT ) LLES_MEAN = .TRUE.
-IF (LLES_DOWNDRAFT) LLES_MEAN = .TRUE.
-IF (LLES_SPECTRA ) LLES_MEAN = .TRUE.
-!
-IF (CTURB=='NONE') THEN
- WRITE(ILUOUT,FMT=*) 'LES diagnostics cannot be done without subgrid turbulence.'
- WRITE(ILUOUT,FMT=*) 'You have chosen CTURB="NONE". You must choose a turbulence scheme.'
- call Print_msg( NVERB_FATAL, 'GEN', 'WRITE_LB_n', 'LES diagnostics cannot be done without subgrid turbulence' )
-END IF
-!-------------------------------------------------------------------------------
-!
-!* 2. Number and definition of masks
-! ------------------------------
-!
-!-------------------------------------------------------------------------------
-!
-!* 2.1 Cartesian (sub-)domain
-! ----------------------
-!
-!* updates number of masks
-! -----------------------
-!
-NLES_MASKS = 1
-!
-!* For model 1, set default values of cartesian mask, and defines cartesian mask
-! -----------------------------------------------------------------------------
-!
-IF (IMI==1) THEN
- IF ( LLES_CART_MASK ) THEN
- !Compute LES diagnostics inside a cartesian mask
-
- !Set default values to physical domain boundaries
- IF ( NLES_IINF == NUNDEF ) NLES_IINF = 1
- IF ( NLES_JINF == NUNDEF ) NLES_JINF = 1
- IF ( NLES_ISUP == NUNDEF ) NLES_ISUP = NIMAX_ll
- IF ( NLES_JSUP == NUNDEF ) NLES_JSUP = NJMAX_ll
-
- !Check that selected indices are in physical domain
- IF ( NLES_IINF < 1 ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_IINF too small (<1)' )
- IF ( NLES_IINF > NIMAX_ll ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_IINF too large (>NIMAX)' )
- IF ( NLES_ISUP < 1 ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_ISUP too small (<1)' )
- IF ( NLES_ISUP > NIMAX_ll ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_ISUP too large (>NIMAX)' )
- IF ( NLES_ISUP < NLES_IINF ) CALL Print_msg( NVERB_ERROR, 'BUD', 'INI_LES_n', 'NLES_ISUP < NLES_IINF' )
-
- IF ( NLES_JINF < 1 ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_JINF too small (<1)' )
- IF ( NLES_JINF > NJMAX_ll ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_JINF too large (>NJMAX)' )
- IF ( NLES_JSUP < 1 ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_JSUP too small (<1)' )
- IF ( NLES_JSUP > NJMAX_ll ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_JSUP too large (>NJMAX)' )
- IF ( NLES_JSUP < NLES_JINF ) CALL Print_msg( NVERB_ERROR, 'BUD', 'INI_LES_n', 'NLES_JSUP < NLES_JINF' )
-
- !Set LLES_CART_MASK to false if whole domain is selected
- IF ( NLES_IINF == 1 .AND. NLES_JINF == 1 &
- .AND. NLES_ISUP == NIMAX_ll .AND. NLES_ISUP == NJMAX_ll ) THEN
- LLES_CART_MASK = .FALSE.
- END IF
- ELSE
- !Compute LES diagnostics on whole physical domain
- NLES_IINF = 1
- NLES_JINF = 1
- NLES_ISUP = NIMAX_ll
- NLES_JSUP = NJMAX_ll
- END IF
- !
- NLESn_IINF(1)= NLES_IINF
- NLESn_ISUP(1)= NLES_ISUP
- NLESn_JINF(1)= NLES_JINF
- NLESn_JSUP(1)= NLES_JSUP
-!
-!* For other models, fits cartesian mask on model 1 mask
-! -----------------------------------------------------
-!
-ELSE
- ZXHAT_ll => XXHAT_ll !Use current (IMI) model XXHAT_ll
- ZYHAT_ll => XYHAT_ll
-!
- CALL GOTO_MODEL(NDAD(IMI))
- CALL INI_LES_CART_MASK_n(IMI,ZXHAT_ll,ZYHAT_ll, &
- NLESn_IINF(IMI),NLESn_JINF(IMI), &
- NLESn_ISUP(IMI),NLESn_JSUP(IMI) )
- CALL GOTO_MODEL(IMI)
-END IF
-!
-!* in non cyclic boundary conditions, limitiation of masks due to u and v grids
-! ----------------------------------------------------------------------------
-!
-IF ( (.NOT. L1D) .AND. CLBCX(1)/='CYCL') THEN
- NLESn_IINF(IMI) = MAX(NLESn_IINF(IMI),2)
-END IF
-IF ( (.NOT. L1D) .AND. (.NOT. L2D) .AND. CLBCY(1)/='CYCL') THEN
- NLESn_JINF(IMI) = MAX(NLESn_JINF(IMI),2)
-END IF
-!
-!* X boundary conditions for 2points correlations computations
-! -----------------------------------------------------------
-!
-IF ( CLBCX(1) == 'CYCL' .AND. NLESn_IINF(IMI) == 1 .AND. NLESn_ISUP(IMI) == NIMAX_ll ) THEN
- CLES_LBCX(:,IMI) = 'CYCL'
-ELSE
- CLES_LBCX(:,IMI) = 'OPEN'
-END IF
-!
-!* Y boundary conditions for 2points correlations computations
-! -----------------------------------------------------------
-!
-IF ( CLBCY(1) == 'CYCL' .AND. NLESn_JINF(IMI) == 1 .AND. NLESn_JSUP(IMI) == NJMAX_ll ) THEN
- CLES_LBCY(:,IMI) = 'CYCL'
-ELSE
- CLES_LBCY(:,IMI) = 'OPEN'
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 2.2 Nebulosity mask
-! ---------------
-!
-IF (.NOT. LUSERC .AND. .NOT. LUSERI) LLES_NEB_MASK = .FALSE.
-!
-IF (LLES_NEB_MASK) NLES_MASKS = NLES_MASKS + 2
-!
-!-------------------------------------------------------------------------------
-!
-!* 2.3 Cloud core mask
-! ---------------
-!
-IF (.NOT. LUSERC .AND. .NOT. LUSERI) LLES_CORE_MASK = .FALSE.
-!
-IF (LLES_CORE_MASK) NLES_MASKS = NLES_MASKS + 2
-!
-!-------------------------------------------------------------------------------
-!
-!* 2.4 Conditional sampling mask
-! -------------------------
-!
-IF (.NOT. LUSERC .AND. .NOT. LCONDSAMP) LLES_CS_MASK = .FALSE.
-!
-IF (LLES_CS_MASK) NLES_MASKS = NLES_MASKS + 3
-!
-!-------------------------------------------------------------------------------
-!
-!* 2.5 User mask
-! ---------
-!
-IF (LLES_MY_MASK) NLES_MASKS = NLES_MASKS + NLES_MASKS_USER
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. Number of temporal LES samplings
-! --------------------------------
-!
-!* 3.1 Default value
-! -------------
-!
-IF (XLES_TEMP_SAMPLING == XUNDEF) THEN
- IF (CTURBDIM=='3DIM') THEN
- XLES_TEMP_SAMPLING = 60.
- ELSE
- XLES_TEMP_SAMPLING = 300.
- END IF
-END IF
-!
-!* 3.2 Number of time steps between two calls
-! --------------------------------------
-!
-NLES_DTCOUNT = MAX( NINT( XLES_TEMP_SAMPLING / XTSTEP ) , 1)
-
-!
-!* 3.3 Redefinition of the LES sampling time coherent with model time-step
-! -------------------------------------------------------------------
-!
-! Note that this modifies XLES_TEMP_SAMPLING only for father model (model number 1)
-! For nested models (for which integration time step is an integer part of father model)
-! the following operation does not change XLES_TEMP_SAMPLING. This way, LEs
-! sampling is done at the same instants for all models.
-!
-XLES_TEMP_SAMPLING = XTSTEP * NLES_DTCOUNT
-!
-!
-!* 3.4 number of temporal calls to LES routines
-! ----------------------------------------
-!
-!
-NLES_TIMES = ( NINT( ( XSEGLEN - DYN_MODEL(1)%XTSTEP ) / XTSTEP ) ) / NLES_DTCOUNT
-!
-!* 3.5 current LES time counter
-! ------------------------
-!
-NLES_TCOUNT = 0
-!
-!* 3.6 dates array for diachro
-! ----------------------
-!
-allocate( tles_dates( nles_times ) )
-allocate( xles_times( nles_times ) )
-!
-!* 3.7 No data
-! -------
-!
-IF (NLES_TIMES==0) THEN
- LLES=.FALSE.
- RETURN
-END IF
-!
-!* 3.8 Averaging
-! ---------
-IF ( XLES_TEMP_MEAN_END == XUNDEF &
- .OR. XLES_TEMP_MEAN_START == XUNDEF &
- .OR. XLES_TEMP_MEAN_STEP == XUNDEF ) THEN
- !No LES temporal averaging
- NLES_MEAN_TIMES = 0
- NLES_MEAN_STEP = NNEGUNDEF
- NLES_MEAN_START = NNEGUNDEF
- NLES_MEAN_END = NNEGUNDEF
-ELSE
- !LES temporal averaging is enabled
- !Ensure that XLES_TEMP_MEAN_END is not after segment end
- XLES_TEMP_MEAN_END = MIN( XLES_TEMP_MEAN_END, XSEGLEN - DYN_MODEL(1)%XTSTEP )
-
- NLES_MEAN_START = NINT( XLES_TEMP_MEAN_START / XTSTEP )
-
- IF ( MODULO( NLES_MEAN_START, NLES_DTCOUNT ) /= 0 ) THEN
- CMNHMSG(1) = 'XLES_TEMP_MEAN_START is not a multiple of XLES_TEMP_SAMPLING'
- CMNHMSG(2) = 'LES averaging periods could be wrong'
- CALL Print_msg( NVERB_WARNING, 'IO', 'INI_LES_n' )
- END IF
-
- NLES_MEAN_END = NINT( XLES_TEMP_MEAN_END / XTSTEP )
-
- NLES_MEAN_STEP = NINT( XLES_TEMP_MEAN_STEP / XTSTEP )
-
- IF ( NLES_MEAN_STEP < NLES_DTCOUNT ) &
- CALL Print_msg( NVERB_ERROR, 'IO', 'INI_LES_n', 'XLES_TEMP_MEAN_STEP < XLES_TEMP_SAMPLING not allowed' )
-
- IF ( MODULO( NLES_MEAN_STEP, NLES_DTCOUNT ) /= 0 ) THEN
- CMNHMSG(1) = 'XLES_TEMP_MEAN_STEP is not a multiple of XLES_TEMP_SAMPLING'
- CMNHMSG(2) = 'LES averaging periods could be wrong'
- CALL Print_msg( NVERB_WARNING, 'IO', 'INI_LES_n' )
- END IF
-
- NLES_MEAN_TIMES = ( NLES_MEAN_END - NLES_MEAN_START ) / NLES_MEAN_STEP
- !Add 1 averaging period if the last one is incomplete (for example: start=0., end=10., step=3.)
- IF ( MODULO( NLES_MEAN_END - NLES_MEAN_START, NLES_MEAN_STEP ) > 0 ) NLES_MEAN_TIMES = NLES_MEAN_TIMES + 1
-END IF
-!-------------------------------------------------------------------------------
-!
-!* 4. Number of vertical levels for local diagnostics
-! -----------------------------------------------
-!
-NLES_K = 0
-!
-!* 4.1 Case of altitude levels (lowest priority)
-! -----------------------
-!
-IF (ANY(XLES_ALTITUDES(:)/=XUNDEF)) THEN
- NLES_K = COUNT (XLES_ALTITUDES(:)/=XUNDEF)
- CLES_LEVEL_TYPE='Z'
- !
- ALLOCATE(XCOEFLIN_LES(SIZE(XZZ,1),SIZE(XZZ,2),NLES_K))
- ALLOCATE(NKLIN_LES (SIZE(XZZ,1),SIZE(XZZ,2),NLES_K))
- !
- ALLOCATE(ZZ_LES (SIZE(XZZ,1),SIZE(XZZ,2),NLES_K))
- DO JK=1,NLES_K
- DO JJ=1,SIZE(XZZ,2)
- DO JI=1,SIZE(XZZ,1)
- ZZ_LES(JI,JJ,JK) = XLES_ALTITUDES(JK)
- END DO
- END DO
- END DO
- CALL COEF_VER_INTERP_LIN(MZF(XZZ),ZZ_LES,NKLIN_LES,XCOEFLIN_LES)
- !
- DEALLOCATE(ZZ_LES)
-END IF
-!
-!
-!* 4.2 Case of model levels (highest priority)
-! --------------------
-!
-IF (ANY(NLES_LEVELS(:)/=NUNDEF)) THEN
- DO JK = 1, SIZE( NLES_LEVELS )
- IF ( NLES_LEVELS(JK) /= NUNDEF ) THEN
- IF ( NLES_LEVELS(JK) < 1 ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_LEVELS too small (<1)' )
- IF ( NLES_LEVELS(JK) > NKMAX ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_LEVELS too large (>NKMAX)' )
- END IF
- END DO
-
- NLES_K = COUNT (NLES_LEVELS(:)/=NUNDEF)
- CLES_LEVEL_TYPE='K'
-ELSE
- IF (NLES_K==0) THEN
- NLES_K = MIN(SIZE(NLES_LEVELS),NKMAX)
- CLES_LEVEL_TYPE='K'
- DO JK=1,NLES_K
- NLES_LEVELS(JK) = JK
- END DO
- END IF
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 5. Number of vertical levels for non-local diagnostics
-! ---------------------------------------------------
-!
-NSPECTRA_K = 0
-CSPECTRA_LEVEL_TYPE='N'
-!
-!
-!* 5.1 Case of altitude levels (medium priority)
-! -----------------------
-!
-IF (ANY(XSPECTRA_ALTITUDES(:)/=XUNDEF)) THEN
- NSPECTRA_K = COUNT (XSPECTRA_ALTITUDES(:)/=XUNDEF)
- CSPECTRA_LEVEL_TYPE='Z'
- !
- ALLOCATE(XCOEFLIN_SPEC(SIZE(XZZ,1),SIZE(XZZ,2),NSPECTRA_K))
- ALLOCATE(NKLIN_SPEC (SIZE(XZZ,1),SIZE(XZZ,2),NSPECTRA_K))
- !
- ALLOCATE(ZZ_SPEC (SIZE(XZZ,1),SIZE(XZZ,2),NSPECTRA_K))
- DO JK=1,NSPECTRA_K
- DO JJ=1,SIZE(XZZ,2)
- DO JI=1,SIZE(XZZ,1)
- ZZ_SPEC(JI,JJ,JK) = XSPECTRA_ALTITUDES(JK)
- END DO
- END DO
- END DO
- CALL COEF_VER_INTERP_LIN(XZZ,ZZ_SPEC,NKLIN_SPEC,XCOEFLIN_SPEC)
- !
- DEALLOCATE(ZZ_SPEC)
-END IF
-!
-!
-!* 5.2 Case of model levels (highest priority)
-! --------------------
-!
-IF (ANY(NSPECTRA_LEVELS(:)/=NUNDEF)) THEN
- DO JK = 1, SIZE( NSPECTRA_LEVELS )
- IF ( NSPECTRA_LEVELS(JK) /= NUNDEF ) THEN
- IF ( NSPECTRA_LEVELS(JK) < 1 ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NSPECTRA_LEVELS too small (<1)' )
- IF ( NSPECTRA_LEVELS(JK) > NKMAX ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NSPECTRA_LEVELS too large (>NKMAX)' )
- END IF
- END DO
-
- NSPECTRA_K = COUNT (NSPECTRA_LEVELS(:)/=NUNDEF)
- CSPECTRA_LEVEL_TYPE='K'
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 6. Number of horizontal wavelengths for non-local diagnostics
-! ----------------------------------------------------------
-!
-NSPECTRA_NI = NLESn_ISUP(IMI) - NLESn_IINF(IMI) + 1
-NSPECTRA_NJ = NLESn_JSUP(IMI) - NLESn_JINF(IMI) + 1
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 7. Allocations of temporal series of local diagnostics
-! ---------------------------------------------------
-!
-!* 7.0 Altitude levels
-! ---------------
-!
-ALLOCATE(XLES_Z (NLES_K))
-!
-!* 7.1 Averaging control variables
-! ---------------------------
-!
-ALLOCATE(NLES_AVG_PTS_ll (NLES_K,NLES_TIMES,NLES_MASKS))
-ALLOCATE(NLES_UND_PTS_ll (NLES_K,NLES_TIMES,NLES_MASKS))
-!
-NLES_AVG_PTS_ll = NUNDEF
-NLES_UND_PTS_ll = NUNDEF
-!
-!
-!* 7.2 Horizontally mean variables
-! ---------------------------
-!
-ALLOCATE(XLES_MEAN_U (NLES_K,NLES_TIMES,NLES_MASKS))
-ALLOCATE(XLES_MEAN_V (NLES_K,NLES_TIMES,NLES_MASKS))
-ALLOCATE(XLES_MEAN_W (NLES_K,NLES_TIMES,NLES_MASKS))
-ALLOCATE(XLES_MEAN_P (NLES_K,NLES_TIMES,NLES_MASKS))
-ALLOCATE(XLES_MEAN_DP (NLES_K,NLES_TIMES,NLES_MASKS))
-ALLOCATE(XLES_MEAN_TP (NLES_K,NLES_TIMES,NLES_MASKS))
-ALLOCATE(XLES_MEAN_TR (NLES_K,NLES_TIMES,NLES_MASKS))
-ALLOCATE(XLES_MEAN_DISS(NLES_K,NLES_TIMES,NLES_MASKS))
-ALLOCATE(XLES_MEAN_LM (NLES_K,NLES_TIMES,NLES_MASKS))
-ALLOCATE(XLES_MEAN_RHO(NLES_K,NLES_TIMES,NLES_MASKS))
-ALLOCATE(XLES_MEAN_Th (NLES_K,NLES_TIMES,NLES_MASKS))
-ALLOCATE(XLES_MEAN_Mf (NLES_K,NLES_TIMES,NLES_MASKS))
-IF (LUSERC ) THEN
- ALLOCATE(XLES_MEAN_Thl(NLES_K,NLES_TIMES,NLES_MASKS))
- ALLOCATE(XLES_MEAN_Rt (NLES_K,NLES_TIMES,NLES_MASKS))
- ALLOCATE(XLES_MEAN_KHt(NLES_K,NLES_TIMES,NLES_MASKS))
- ALLOCATE(XLES_MEAN_KHr(NLES_K,NLES_TIMES,NLES_MASKS))
-ELSE
- ALLOCATE(XLES_MEAN_Thl(0,0,0))
- ALLOCATE(XLES_MEAN_Rt (0,0,0))
- ALLOCATE(XLES_MEAN_KHt(0,0,0))
- ALLOCATE(XLES_MEAN_KHr(0,0,0))
-END IF
-IF (LUSERV) THEN
- ALLOCATE(XLES_MEAN_Thv(NLES_K,NLES_TIMES,NLES_MASKS))
-ELSE
- ALLOCATE(XLES_MEAN_Thv(0,0,0))
-END IF
-!
-IF (LUSERV ) THEN
- ALLOCATE(XLES_MEAN_Rv (NLES_K,NLES_TIMES,NLES_MASKS))
-ELSE
- ALLOCATE(XLES_MEAN_Rv (0,0,0))
-END IF
-IF (LUSERV ) THEN
- ALLOCATE(XLES_MEAN_Rehu (NLES_K,NLES_TIMES,NLES_MASKS))
-ELSE
- ALLOCATE(XLES_MEAN_Rehu (0,0,0))
-ENDIF
-IF (LUSERV ) THEN
- ALLOCATE(XLES_MEAN_Qs (NLES_K,NLES_TIMES,NLES_MASKS))
-ELSE
- ALLOCATE(XLES_MEAN_Qs (0,0,0))
-END IF
-IF (LUSERC ) THEN
- ALLOCATE(XLES_MEAN_Rc (NLES_K,NLES_TIMES,NLES_MASKS))
-ELSE
- ALLOCATE(XLES_MEAN_Rc (0,0,0))
-END IF
-IF (LUSERC ) THEN
- ALLOCATE(XLES_MEAN_Cf (NLES_K,NLES_TIMES,NLES_MASKS))
- ALLOCATE(XLES_MEAN_INDCf (NLES_K,NLES_TIMES,NLES_MASKS))
- ALLOCATE(XLES_MEAN_INDCf2 (NLES_K,NLES_TIMES,NLES_MASKS))
-ELSE
- ALLOCATE(XLES_MEAN_Cf (0,0,0))
- ALLOCATE(XLES_MEAN_INDCf (0,0,0))
- ALLOCATE(XLES_MEAN_INDCf2(0,0,0))
-END IF
-IF (LUSERR ) THEN
- ALLOCATE(XLES_MEAN_Rr (NLES_K,NLES_TIMES,NLES_MASKS))
- ALLOCATE(XLES_MEAN_RF (NLES_K,NLES_TIMES,NLES_MASKS))
-ELSE
- ALLOCATE(XLES_MEAN_Rr (0,0,0))
- ALLOCATE(XLES_MEAN_RF (0,0,0))
-END IF
-IF (LUSERI ) THEN
- ALLOCATE(XLES_MEAN_Ri (NLES_K,NLES_TIMES,NLES_MASKS))
- ALLOCATE(XLES_MEAN_If (NLES_K,NLES_TIMES,NLES_MASKS))
-ELSE
- ALLOCATE(XLES_MEAN_Ri (0,0,0))
- ALLOCATE(XLES_MEAN_If (0,0,0))
-END IF
-IF (LUSERS ) THEN
- ALLOCATE(XLES_MEAN_Rs (NLES_K,NLES_TIMES,NLES_MASKS))
-ELSE
- ALLOCATE(XLES_MEAN_Rs (0,0,0))
-END IF
-IF (LUSERG ) THEN
- ALLOCATE(XLES_MEAN_Rg (NLES_K,NLES_TIMES,NLES_MASKS))
-ELSE
- ALLOCATE(XLES_MEAN_Rg (0,0,0))
-END IF
-IF (LUSERH ) THEN
- ALLOCATE(XLES_MEAN_Rh (NLES_K,NLES_TIMES,NLES_MASKS))
-ELSE
- ALLOCATE(XLES_MEAN_Rh (0,0,0))
-END IF
-IF (NSV>0 ) THEN
- ALLOCATE(XLES_MEAN_Sv (NLES_K,NLES_TIMES,NLES_MASKS,NSV))
-ELSE
- ALLOCATE(XLES_MEAN_Sv (0,0,0,0))
-END IF
-ALLOCATE(XLES_MEAN_WIND (NLES_K,NLES_TIMES,NLES_MASKS))
-ALLOCATE(XLES_MEAN_dUdz (NLES_K,NLES_TIMES,NLES_MASKS))
-ALLOCATE(XLES_MEAN_dVdz (NLES_K,NLES_TIMES,NLES_MASKS))
-ALLOCATE(XLES_MEAN_dWdz (NLES_K,NLES_TIMES,NLES_MASKS))
-ALLOCATE(XLES_MEAN_dThldz(NLES_K,NLES_TIMES,NLES_MASKS))
-IF (LUSERV) THEN
- ALLOCATE(XLES_MEAN_dRtdz(NLES_K,NLES_TIMES,NLES_MASKS))
-ELSE
- ALLOCATE(XLES_MEAN_dRtdz(0,0,0))
-END IF
-IF (NSV>0) THEN
- ALLOCATE(XLES_MEAN_dSvdz(NLES_K,NLES_TIMES,NLES_MASKS,NSV))
-ELSE
- ALLOCATE(XLES_MEAN_dSvdz(0,0,0,0))
-END IF
-!
-IF (LLES_PDF) THEN
-!pdf distributions and jpdf distributions
- CALL LES_ALLOCATE('XLES_PDF_TH ',(/NLES_K,NLES_TIMES,NLES_MASKS,NPDF/))
- CALL LES_ALLOCATE('XLES_PDF_W ',(/NLES_K,NLES_TIMES,NLES_MASKS,NPDF/))
- CALL LES_ALLOCATE('XLES_PDF_THV ',(/NLES_K,NLES_TIMES,NLES_MASKS,NPDF/))
- IF (LUSERV) THEN
- CALL LES_ALLOCATE('XLES_PDF_RV ',(/NLES_K,NLES_TIMES,NLES_MASKS,NPDF/))
- ELSE
- CALL LES_ALLOCATE('XLES_PDF_RV ',(/0,0,0,0/))
- END IF
- IF (LUSERC) THEN
- CALL LES_ALLOCATE('XLES_PDF_RC ',(/NLES_K,NLES_TIMES,NLES_MASKS,NPDF/))
- CALL LES_ALLOCATE('XLES_PDF_RT ',(/NLES_K,NLES_TIMES,NLES_MASKS,NPDF/))
- CALL LES_ALLOCATE('XLES_PDF_THL',(/NLES_K,NLES_TIMES,NLES_MASKS,NPDF/))
- ELSE
- CALL LES_ALLOCATE('XLES_PDF_RC ',(/0,0,0,0/))
- CALL LES_ALLOCATE('XLES_PDF_RT ',(/0,0,0,0/))
- CALL LES_ALLOCATE('XLES_PDF_THL',(/0,0,0,0/))
- ENDIF
- IF (LUSERR) THEN
- CALL LES_ALLOCATE('XLES_PDF_RR ',(/NLES_K,NLES_TIMES,NLES_MASKS,NPDF/))
- ELSE
- CALL LES_ALLOCATE('XLES_PDF_RR ',(/0,0,0,0/))
- ENDIF
- IF (LUSERI) THEN
- CALL LES_ALLOCATE('XLES_PDF_RI ',(/NLES_K,NLES_TIMES,NLES_MASKS,NPDF/))
- ELSE
- CALL LES_ALLOCATE('XLES_PDF_RI ',(/0,0,0,0/))
- END IF
- IF (LUSERS) THEN
- CALL LES_ALLOCATE('XLES_PDF_RS ',(/NLES_K,NLES_TIMES,NLES_MASKS,NPDF/))
- ELSE
- CALL LES_ALLOCATE('XLES_PDF_RS ',(/0,0,0,0/))
- END IF
- IF (LUSERG) THEN
- CALL LES_ALLOCATE('XLES_PDF_RG ',(/NLES_K,NLES_TIMES,NLES_MASKS,NPDF/))
- ELSE
- CALL LES_ALLOCATE('XLES_PDF_RG ',(/0,0,0,0/))
- END IF
-ENDIF
-!
-XLES_MEAN_U = XUNDEF
-XLES_MEAN_V = XUNDEF
-XLES_MEAN_W = XUNDEF
-XLES_MEAN_P = XUNDEF
-XLES_MEAN_DP = XUNDEF
-XLES_MEAN_TP = XUNDEF
-XLES_MEAN_TR = XUNDEF
-XLES_MEAN_DISS= XUNDEF
-XLES_MEAN_LM = XUNDEF
-XLES_MEAN_RHO= XUNDEF
-XLES_MEAN_Th = XUNDEF
-XLES_MEAN_Mf = XUNDEF
-IF (LUSERC ) XLES_MEAN_Thl= XUNDEF
-IF (LUSERV ) XLES_MEAN_Thv= XUNDEF
-IF (LUSERV ) XLES_MEAN_Rv = XUNDEF
-IF (LUSERV ) XLES_MEAN_Rehu = XUNDEF
-IF (LUSERV ) XLES_MEAN_Qs = XUNDEF
-IF (LUSERC ) XLES_MEAN_KHr = XUNDEF
-IF (LUSERC ) XLES_MEAN_KHt = XUNDEF
-IF (LUSERC ) XLES_MEAN_Rt = XUNDEF
-IF (LUSERC ) XLES_MEAN_Rc = XUNDEF
-IF (LUSERC ) XLES_MEAN_Cf = XUNDEF
-IF (LUSERC ) XLES_MEAN_RF = XUNDEF
-IF (LUSERC ) XLES_MEAN_INDCf = XUNDEF
-IF (LUSERC ) XLES_MEAN_INDCf2 = XUNDEF
-IF (LUSERR ) XLES_MEAN_Rr = XUNDEF
-IF (LUSERI ) XLES_MEAN_Ri = XUNDEF
-IF (LUSERI ) XLES_MEAN_If = XUNDEF
-IF (LUSERS ) XLES_MEAN_Rs = XUNDEF
-IF (LUSERG ) XLES_MEAN_Rg = XUNDEF
-IF (LUSERH ) XLES_MEAN_Rh = XUNDEF
-IF (NSV>0 ) XLES_MEAN_Sv = XUNDEF
-XLES_MEAN_WIND = XUNDEF
-XLES_MEAN_WIND = XUNDEF
-XLES_MEAN_dUdz = XUNDEF
-XLES_MEAN_dVdz = XUNDEF
-XLES_MEAN_dWdz = XUNDEF
-XLES_MEAN_dThldz= XUNDEF
-IF (LUSERV) XLES_MEAN_dRtdz = XUNDEF
-IF (NSV>0) XLES_MEAN_dSvdz = XUNDEF
-!
-IF (LLES_PDF) THEN
- XLES_PDF_TH = XUNDEF
- XLES_PDF_W = XUNDEF
- XLES_PDF_THV = XUNDEF
- IF (LUSERV) THEN
- XLES_PDF_RV = XUNDEF
- END IF
- IF (LUSERC) THEN
- XLES_PDF_RC = XUNDEF
- XLES_PDF_RT = XUNDEF
- XLES_PDF_THL = XUNDEF
- END IF
- IF (LUSERR) THEN
- XLES_PDF_RR = XUNDEF
- END IF
- IF (LUSERI) THEN
- XLES_PDF_RI = XUNDEF
- END IF
- IF (LUSERS) THEN
- XLES_PDF_RS = XUNDEF
- END IF
- IF (LUSERG) THEN
- XLES_PDF_RG = XUNDEF
- END IF
-END IF
-!
-!
-!
-!* 7.3 Resolved quantities
-! -------------------
-!
-ALLOCATE(XLES_RESOLVED_U2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'2>
-ALLOCATE(XLES_RESOLVED_V2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'2>
-ALLOCATE(XLES_RESOLVED_W2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'2>
-ALLOCATE(XLES_RESOLVED_P2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <p'2>
-ALLOCATE(XLES_RESOLVED_Th2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Th'2>
-IF (LUSERV) THEN
- ALLOCATE(XLES_RESOLVED_ThThv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Th'Thv'>
-ELSE
- ALLOCATE(XLES_RESOLVED_ThThv (0,0,0))
-END IF
-IF (LUSERC) THEN
- ALLOCATE(XLES_RESOLVED_Thl2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Thl'2>
- ALLOCATE(XLES_RESOLVED_ThlThv(NLES_K,NLES_TIMES,NLES_MASKS)) ! <Thl'Thv'>
-ELSE
- ALLOCATE(XLES_RESOLVED_Thl2 (0,0,0))
- ALLOCATE(XLES_RESOLVED_ThlThv(0,0,0))
-END IF
-ALLOCATE(XLES_RESOLVED_Ke (NLES_K,NLES_TIMES,NLES_MASKS)) ! 0.5 <u'2+v'2+w'2>
-ALLOCATE(XLES_RESOLVED_UV (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'v'>
-ALLOCATE(XLES_RESOLVED_WU (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'u'>
-ALLOCATE(XLES_RESOLVED_WV (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'v'>
-ALLOCATE(XLES_RESOLVED_UP (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'p'>
-ALLOCATE(XLES_RESOLVED_VP (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'p'>
-ALLOCATE(XLES_RESOLVED_WP (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'p'>
-ALLOCATE(XLES_RESOLVED_UTh (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'Th'>
-ALLOCATE(XLES_RESOLVED_VTh (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'Th'>
-ALLOCATE(XLES_RESOLVED_WTh (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Th'>
-IF (LUSERC) THEN
- ALLOCATE(XLES_RESOLVED_UThl (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'Thl'>
- ALLOCATE(XLES_RESOLVED_VThl (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'Thl'>
- ALLOCATE(XLES_RESOLVED_WThl (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Thl'>
-ELSE
- ALLOCATE(XLES_RESOLVED_UThl(0,0,0))
- ALLOCATE(XLES_RESOLVED_VThl(0,0,0))
- ALLOCATE(XLES_RESOLVED_WThl(0,0,0))
-END IF
-IF (LUSERV) THEN
- ALLOCATE(XLES_RESOLVED_UThv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'Thv'>
- ALLOCATE(XLES_RESOLVED_VThv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'Thv'>
- ALLOCATE(XLES_RESOLVED_WThv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Thv'>
-ELSE
- ALLOCATE(XLES_RESOLVED_UThv(0,0,0))
- ALLOCATE(XLES_RESOLVED_VThv(0,0,0))
- ALLOCATE(XLES_RESOLVED_WThv(0,0,0))
-END IF
-ALLOCATE(XLES_RESOLVED_U3 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'3>
-ALLOCATE(XLES_RESOLVED_V3 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'3>
-ALLOCATE(XLES_RESOLVED_W3 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'3>
-ALLOCATE(XLES_RESOLVED_U4 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'4>
-ALLOCATE(XLES_RESOLVED_V4 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'4>
-ALLOCATE(XLES_RESOLVED_W4 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'4>
-ALLOCATE(XLES_RESOLVED_ThlPz (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Thv'dp'/dz>
-ALLOCATE(XLES_RESOLVED_WThl2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Thl'2>
-ALLOCATE(XLES_RESOLVED_W2Thl (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'2Thl'>
-ALLOCATE(XLES_RESOLVED_MASSFX(NLES_K,NLES_TIMES,NLES_MASKS)) ! <upward mass flux>
-ALLOCATE(XLES_RESOLVED_UKe (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'(u'2+v'2+w'2)>
-ALLOCATE(XLES_RESOLVED_VKe (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'(u'2+v'2+w'2)>
-ALLOCATE(XLES_RESOLVED_WKe (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'(u'2+v'2+w'2)>
-
-IF (LUSERV ) THEN
- ALLOCATE(XLES_RESOLVED_Rv2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Rv'2>
- ALLOCATE(XLES_RESOLVED_ThRv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Th'Rv'>
- ALLOCATE(XLES_RESOLVED_ThvRv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Thv'Rv'>
- ALLOCATE(XLES_RESOLVED_URv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'Rv'>
- ALLOCATE(XLES_RESOLVED_VRv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'Rv'>
- ALLOCATE(XLES_RESOLVED_WRv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Rv'>
- ALLOCATE(XLES_RESOLVED_WRv2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Rv'2>
- ALLOCATE(XLES_RESOLVED_W2Rv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'2Rv'>
- ALLOCATE(XLES_RESOLVED_W2Rt (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'2Rt'>
- ALLOCATE(XLES_RESOLVED_WRt2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Rt2'>
- ALLOCATE(XLES_RESOLVED_RvPz (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Rv'dp'/dz>
- ALLOCATE(XLES_RESOLVED_WThlRv(NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Thl'Rv'>
- ALLOCATE(XLES_RESOLVED_WThlRt(NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Thl'Rt'>
-ELSE
- ALLOCATE(XLES_RESOLVED_Rv2 (0,0,0))
- ALLOCATE(XLES_RESOLVED_ThRv (0,0,0))
- ALLOCATE(XLES_RESOLVED_ThvRv (0,0,0))
- ALLOCATE(XLES_RESOLVED_URv (0,0,0))
- ALLOCATE(XLES_RESOLVED_VRv (0,0,0))
- ALLOCATE(XLES_RESOLVED_WRv (0,0,0))
- ALLOCATE(XLES_RESOLVED_WRv2 (0,0,0))
- ALLOCATE(XLES_RESOLVED_W2Rv (0,0,0))
- ALLOCATE(XLES_RESOLVED_W2Rt (0,0,0))
- ALLOCATE(XLES_RESOLVED_WRt2 (0,0,0))
- ALLOCATE(XLES_RESOLVED_RvPz (0,0,0))
- ALLOCATE(XLES_RESOLVED_WThlRv(0,0,0))
- ALLOCATE(XLES_RESOLVED_WThlRt(0,0,0))
-END IF
-IF (LUSERC ) THEN
- ALLOCATE(XLES_RESOLVED_ThlRv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Thl'Rv'>
- !
- ALLOCATE(XLES_RESOLVED_Rc2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Rc'2>
- ALLOCATE(XLES_RESOLVED_ThRc (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Th'Rc'>
- ALLOCATE(XLES_RESOLVED_ThlRc (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Thl'Rc'>
- ALLOCATE(XLES_RESOLVED_ThvRc (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Thv'Rc'>
- ALLOCATE(XLES_RESOLVED_URc (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'Rc'>
- ALLOCATE(XLES_RESOLVED_VRc (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'Rc'>
- ALLOCATE(XLES_RESOLVED_WRc (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Rc'>
- ALLOCATE(XLES_RESOLVED_WRc2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Rc'2>
- ALLOCATE(XLES_RESOLVED_W2Rc (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'2Rc'>
- ALLOCATE(XLES_RESOLVED_RcPz (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Rc'dp'/dz>
- ALLOCATE(XLES_RESOLVED_WThlRc(NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Thl'Rc'>
- ALLOCATE(XLES_RESOLVED_WRvRc (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Rv'Rc'>
- ALLOCATE(XLES_RESOLVED_WRt (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Rt'>
- ALLOCATE(XLES_RESOLVED_Rt2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Rt'2>
- ALLOCATE(XLES_RESOLVED_RtPz (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Rv'dp'/dz>
-ELSE
- ALLOCATE(XLES_RESOLVED_ThlRv (0,0,0))
- !
- ALLOCATE(XLES_RESOLVED_Rc2 (0,0,0))
- ALLOCATE(XLES_RESOLVED_ThRc (0,0,0))
- ALLOCATE(XLES_RESOLVED_ThlRc (0,0,0))
- ALLOCATE(XLES_RESOLVED_ThvRc (0,0,0))
- ALLOCATE(XLES_RESOLVED_URc (0,0,0))
- ALLOCATE(XLES_RESOLVED_VRc (0,0,0))
- ALLOCATE(XLES_RESOLVED_WRc (0,0,0))
- ALLOCATE(XLES_RESOLVED_WRc2 (0,0,0))
- ALLOCATE(XLES_RESOLVED_W2Rc (0,0,0))
- ALLOCATE(XLES_RESOLVED_RcPz (0,0,0))
- ALLOCATE(XLES_RESOLVED_WThlRc(0,0,0))
- ALLOCATE(XLES_RESOLVED_WRvRc (0,0,0))
- ALLOCATE(XLES_RESOLVED_WRt (0,0,0))
- ALLOCATE(XLES_RESOLVED_Rt2 (0,0,0))
- ALLOCATE(XLES_RESOLVED_RtPz (0,0,0))
-END IF
-IF (LUSERI ) THEN
- ALLOCATE(XLES_RESOLVED_Ri2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Ri'2>
- ALLOCATE(XLES_RESOLVED_ThRi (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Th'Ri'>
- ALLOCATE(XLES_RESOLVED_ThlRi (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Thl'Ri'>
- ALLOCATE(XLES_RESOLVED_ThvRi (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Thv'Ri'>
- ALLOCATE(XLES_RESOLVED_URi (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'Ri'>
- ALLOCATE(XLES_RESOLVED_VRi (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'Ri'>
- ALLOCATE(XLES_RESOLVED_WRi (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Ri'>
- ALLOCATE(XLES_RESOLVED_WRi2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Ri'2>
- ALLOCATE(XLES_RESOLVED_W2Ri (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'2Ri'>
- ALLOCATE(XLES_RESOLVED_RiPz (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Ri'dp'/dz>
- ALLOCATE(XLES_RESOLVED_WThlRi(NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Thl'Ri'>
- ALLOCATE(XLES_RESOLVED_WRvRi (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Rv'Ri'>
-ELSE
- ALLOCATE(XLES_RESOLVED_Ri2 (0,0,0))
- ALLOCATE(XLES_RESOLVED_ThRi (0,0,0))
- ALLOCATE(XLES_RESOLVED_ThlRi (0,0,0))
- ALLOCATE(XLES_RESOLVED_ThvRi (0,0,0))
- ALLOCATE(XLES_RESOLVED_URi (0,0,0))
- ALLOCATE(XLES_RESOLVED_VRi (0,0,0))
- ALLOCATE(XLES_RESOLVED_WRi (0,0,0))
- ALLOCATE(XLES_RESOLVED_WRi2 (0,0,0))
- ALLOCATE(XLES_RESOLVED_W2Ri (0,0,0))
- ALLOCATE(XLES_RESOLVED_RiPz (0,0,0))
- ALLOCATE(XLES_RESOLVED_WThlRi(0,0,0))
- ALLOCATE(XLES_RESOLVED_WRvRi (0,0,0))
-END IF
-!
-IF (LUSERR) THEN
- ALLOCATE(XLES_RESOLVED_WRr (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Rr'>
- ALLOCATE(XLES_INPRR3D (NLES_K,NLES_TIMES,NLES_MASKS)) !precip flux
- ALLOCATE(XLES_MAX_INPRR3D (NLES_K,NLES_TIMES,NLES_MASKS)) !precip flux
- ALLOCATE(XLES_EVAP3D (NLES_K,NLES_TIMES,NLES_MASKS)) ! evap
-ELSE
- ALLOCATE(XLES_RESOLVED_WRr (0,0,0))
- ALLOCATE(XLES_INPRR3D (0,0,0))
- ALLOCATE(XLES_MAX_INPRR3D (0,0,0))
- ALLOCATE(XLES_EVAP3D (0,0,0))
-END IF
-IF (NSV>0 ) THEN
- ALLOCATE(XLES_RESOLVED_Sv2 (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <Sv'2>
- ALLOCATE(XLES_RESOLVED_ThSv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <Th'Sv>
- ALLOCATE(XLES_RESOLVED_USv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <u'Sv'>
- ALLOCATE(XLES_RESOLVED_VSv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <v'Sv'>
- ALLOCATE(XLES_RESOLVED_WSv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <w'Sv'>
- ALLOCATE(XLES_RESOLVED_WSv2 (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <w'Sv'2>
- ALLOCATE(XLES_RESOLVED_W2Sv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <w'2Sv'>
- ALLOCATE(XLES_RESOLVED_SvPz (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <Sv'dp'/dz>
- ALLOCATE(XLES_RESOLVED_WThlSv(NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <w'Thl'Sv'>
- IF (LUSERV) THEN
- ALLOCATE(XLES_RESOLVED_ThvSv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <Thv'Sv>
- ALLOCATE(XLES_RESOLVED_WRvSv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <w'Rv'Sv'>
- ELSE
- ALLOCATE(XLES_RESOLVED_ThvSv (0,0,0,0))
- ALLOCATE(XLES_RESOLVED_WRvSv (0,0,0,0))
- END IF
- IF (LUSERC) THEN
- ALLOCATE(XLES_RESOLVED_ThlSv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <Thl'Sv>
- ELSE
- ALLOCATE(XLES_RESOLVED_ThlSv (0,0,0,0))
- END IF
-ELSE
- ALLOCATE(XLES_RESOLVED_Sv2 (0,0,0,0))
- ALLOCATE(XLES_RESOLVED_ThSv (0,0,0,0))
- ALLOCATE(XLES_RESOLVED_USv (0,0,0,0))
- ALLOCATE(XLES_RESOLVED_VSv (0,0,0,0))
- ALLOCATE(XLES_RESOLVED_WSv (0,0,0,0))
- ALLOCATE(XLES_RESOLVED_WSv2 (0,0,0,0))
- ALLOCATE(XLES_RESOLVED_W2Sv (0,0,0,0))
- ALLOCATE(XLES_RESOLVED_SvPz (0,0,0,0))
- ALLOCATE(XLES_RESOLVED_ThvSv (0,0,0,0))
- ALLOCATE(XLES_RESOLVED_ThlSv (0,0,0,0))
- ALLOCATE(XLES_RESOLVED_WThlSv(0,0,0,0))
- ALLOCATE(XLES_RESOLVED_WRvSv (0,0,0,0))
-END IF
-!
-!
-XLES_RESOLVED_U2 = XUNDEF
-XLES_RESOLVED_V2 = XUNDEF
-XLES_RESOLVED_W2 = XUNDEF
-XLES_RESOLVED_P2 = XUNDEF
-XLES_RESOLVED_Th2 = XUNDEF
-IF( LUSERC) THEN
- XLES_RESOLVED_Thl2= XUNDEF
- XLES_RESOLVED_ThlThv= XUNDEF
-END IF
-IF (LUSERV) THEN
- XLES_RESOLVED_ThThv = XUNDEF
-END IF
-XLES_RESOLVED_Ke = XUNDEF
-XLES_RESOLVED_UV = XUNDEF
-XLES_RESOLVED_WU = XUNDEF
-XLES_RESOLVED_WV = XUNDEF
-XLES_RESOLVED_UP = XUNDEF
-XLES_RESOLVED_VP = XUNDEF
-XLES_RESOLVED_WP = XUNDEF
-XLES_RESOLVED_UTh = XUNDEF
-XLES_RESOLVED_VTh = XUNDEF
-XLES_RESOLVED_WTh = XUNDEF
-IF (LUSERC) THEN
- XLES_RESOLVED_UThl= XUNDEF
- XLES_RESOLVED_VThl= XUNDEF
- XLES_RESOLVED_WThl= XUNDEF
-END IF
-IF (LUSERV) THEN
- XLES_RESOLVED_UThv= XUNDEF
- XLES_RESOLVED_VThv= XUNDEF
- XLES_RESOLVED_WThv= XUNDEF
-END IF
-XLES_RESOLVED_U3 = XUNDEF
-XLES_RESOLVED_V3 = XUNDEF
-XLES_RESOLVED_W3 = XUNDEF
-XLES_RESOLVED_U4 = XUNDEF
-XLES_RESOLVED_V4 = XUNDEF
-XLES_RESOLVED_W4 = XUNDEF
-XLES_RESOLVED_WThl2 = XUNDEF
-XLES_RESOLVED_W2Thl = XUNDEF
-XLES_RESOLVED_ThlPz = XUNDEF
-!
-XLES_RESOLVED_MASSFX = XUNDEF
-XLES_RESOLVED_UKe = XUNDEF
-XLES_RESOLVED_VKe = XUNDEF
-XLES_RESOLVED_WKe = XUNDEF
-IF (LUSERV ) THEN
- XLES_RESOLVED_Rv2 = XUNDEF
- XLES_RESOLVED_ThRv = XUNDEF
- IF (LUSERC) XLES_RESOLVED_ThlRv= XUNDEF
- XLES_RESOLVED_ThvRv= XUNDEF
- XLES_RESOLVED_URv = XUNDEF
- XLES_RESOLVED_VRv = XUNDEF
- XLES_RESOLVED_WRv = XUNDEF
- XLES_RESOLVED_WRv2 = XUNDEF
- XLES_RESOLVED_W2Rv = XUNDEF
- XLES_RESOLVED_WRt2 = XUNDEF
- XLES_RESOLVED_W2Rt = XUNDEF
- XLES_RESOLVED_WThlRv= XUNDEF
- XLES_RESOLVED_WThlRt= XUNDEF
- XLES_RESOLVED_RvPz = XUNDEF
-END IF
-IF (LUSERC ) THEN
- XLES_RESOLVED_Rc2 = XUNDEF
- XLES_RESOLVED_ThRc = XUNDEF
- XLES_RESOLVED_ThlRc= XUNDEF
- XLES_RESOLVED_ThvRc= XUNDEF
- XLES_RESOLVED_URc = XUNDEF
- XLES_RESOLVED_VRc = XUNDEF
- XLES_RESOLVED_WRc = XUNDEF
- XLES_RESOLVED_WRc2 = XUNDEF
- XLES_RESOLVED_W2Rc = XUNDEF
- XLES_RESOLVED_WThlRc= XUNDEF
- XLES_RESOLVED_WRvRc = XUNDEF
- XLES_RESOLVED_RcPz = XUNDEF
- XLES_RESOLVED_RtPz = XUNDEF
- XLES_RESOLVED_WRt = XUNDEF
- XLES_RESOLVED_Rt2 = XUNDEF
-END IF
-IF (LUSERI ) THEN
- XLES_RESOLVED_Ri2 = XUNDEF
- XLES_RESOLVED_ThRi = XUNDEF
- XLES_RESOLVED_ThlRi= XUNDEF
- XLES_RESOLVED_ThvRi= XUNDEF
- XLES_RESOLVED_URi = XUNDEF
- XLES_RESOLVED_VRi = XUNDEF
- XLES_RESOLVED_WRi = XUNDEF
- XLES_RESOLVED_WRi2 = XUNDEF
- XLES_RESOLVED_W2Ri = XUNDEF
- XLES_RESOLVED_WThlRi= XUNDEF
- XLES_RESOLVED_WRvRi = XUNDEF
- XLES_RESOLVED_RiPz = XUNDEF
-END IF
-!
-IF (LUSERR) XLES_RESOLVED_WRr = XUNDEF
-IF (LUSERR) XLES_MAX_INPRR3D = XUNDEF
-IF (LUSERR) XLES_INPRR3D = XUNDEF
-IF (LUSERR) XLES_EVAP3D = XUNDEF
-IF (NSV>0 ) THEN
- XLES_RESOLVED_Sv2 = XUNDEF
- XLES_RESOLVED_ThSv = XUNDEF
- IF (LUSERC) XLES_RESOLVED_ThlSv= XUNDEF
- IF (LUSERV) XLES_RESOLVED_ThvSv= XUNDEF
- XLES_RESOLVED_USv = XUNDEF
- XLES_RESOLVED_VSv = XUNDEF
- XLES_RESOLVED_WSv = XUNDEF
- XLES_RESOLVED_WSv2 = XUNDEF
- XLES_RESOLVED_W2Sv = XUNDEF
- XLES_RESOLVED_WThlSv= XUNDEF
- IF (LUSERV) XLES_RESOLVED_WRvSv = XUNDEF
- XLES_RESOLVED_SvPz = XUNDEF
-END IF
-!
-!
-!* 7.4 interactions of resolved and subgrid quantities
-! -----------------------------------------------
-!
-ALLOCATE(XLES_RES_U_SBG_Tke (NLES_K,NLES_TIMES,NLES_MASKS))! <u'Tke>
-ALLOCATE(XLES_RES_V_SBG_Tke (NLES_K,NLES_TIMES,NLES_MASKS))! <v'Tke>
-ALLOCATE(XLES_RES_W_SBG_Tke (NLES_K,NLES_TIMES,NLES_MASKS))! <w'Tke>
-! ______
-ALLOCATE(XLES_RES_W_SBG_WThl (NLES_K,NLES_TIMES,NLES_MASKS))! <w'w'Thl'>
-! _____
-ALLOCATE(XLES_RES_W_SBG_Thl2 (NLES_K,NLES_TIMES,NLES_MASKS))! <w'Thl'2>
-! _____
-ALLOCATE(XLES_RES_ddxa_U_SBG_UaU (NLES_K,NLES_TIMES,NLES_MASKS))! <du'/dxa ua'u'>
-! _____
-ALLOCATE(XLES_RES_ddxa_V_SBG_UaV (NLES_K,NLES_TIMES,NLES_MASKS))! <dv'/dxa ua'v'>
-! _____
-ALLOCATE(XLES_RES_ddxa_W_SBG_UaW (NLES_K,NLES_TIMES,NLES_MASKS))! <dw'/dxa ua'w'>
-! _______
-ALLOCATE(XLES_RES_ddxa_W_SBG_UaThl (NLES_K,NLES_TIMES,NLES_MASKS))! <dw'/dxa ua'Thl'>
-! _____
-ALLOCATE(XLES_RES_ddxa_Thl_SBG_UaW (NLES_K,NLES_TIMES,NLES_MASKS))! <dThl'/dxa ua'w'>
-! ___
-ALLOCATE(XLES_RES_ddz_Thl_SBG_W2 (NLES_K,NLES_TIMES,NLES_MASKS))! <dThl'/dz w'2>
-! _______
-ALLOCATE(XLES_RES_ddxa_Thl_SBG_UaThl(NLES_K,NLES_TIMES,NLES_MASKS))! <dThl'/dxa ua'Thl'>
-!
-IF (LUSERV) THEN
-! _____
- ALLOCATE(XLES_RES_W_SBG_WRt (NLES_K,NLES_TIMES,NLES_MASKS))! <w'w'Rt'>
-! ____
- ALLOCATE(XLES_RES_W_SBG_Rt2 (NLES_K,NLES_TIMES,NLES_MASKS))! <w'Rt'2>
-! _______
- ALLOCATE(XLES_RES_W_SBG_ThlRt (NLES_K,NLES_TIMES,NLES_MASKS))! <w'Thl'Rt'>
-! ______
- ALLOCATE(XLES_RES_ddxa_W_SBG_UaRt (NLES_K,NLES_TIMES,NLES_MASKS))! <dw'/dxa ua'Rt'>
-! _____
- ALLOCATE(XLES_RES_ddxa_Rt_SBG_UaW (NLES_K,NLES_TIMES,NLES_MASKS))! <dRt'/dxa ua'w'>
-! ___
- ALLOCATE(XLES_RES_ddz_Rt_SBG_W2 (NLES_K,NLES_TIMES,NLES_MASKS))! <dRt'/dz w'2>
-! ______
- ALLOCATE(XLES_RES_ddxa_Thl_SBG_UaRt (NLES_K,NLES_TIMES,NLES_MASKS))! <dThl'/dxa ua'Rt'>
-! _______
- ALLOCATE(XLES_RES_ddxa_Rt_SBG_UaThl (NLES_K,NLES_TIMES,NLES_MASKS))! <dRt'/dxa ua'Thl'>
-! ______
- ALLOCATE(XLES_RES_ddxa_Rt_SBG_UaRt (NLES_K,NLES_TIMES,NLES_MASKS)) ! <dRt'/dxa ua'Rt'>
-ELSE
- ALLOCATE(XLES_RES_W_SBG_WRt (0,0,0))
- ALLOCATE(XLES_RES_W_SBG_Rt2 (0,0,0))
- ALLOCATE(XLES_RES_W_SBG_ThlRt (0,0,0))
- ALLOCATE(XLES_RES_ddxa_W_SBG_UaRt (0,0,0))
- ALLOCATE(XLES_RES_ddxa_Rt_SBG_UaW (0,0,0))
- ALLOCATE(XLES_RES_ddz_Rt_SBG_W2 (0,0,0))
- ALLOCATE(XLES_RES_ddxa_Thl_SBG_UaRt (0,0,0))
- ALLOCATE(XLES_RES_ddxa_Rt_SBG_UaThl (0,0,0))
- ALLOCATE(XLES_RES_ddxa_Rt_SBG_UaRt (0,0,0))
-END IF
-!
-! ______
-ALLOCATE(XLES_RES_ddxa_W_SBG_UaSv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <dw'/dxa ua'Sv'>
-! _____
-ALLOCATE(XLES_RES_ddxa_Sv_SBG_UaW (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <dSv'/dxa ua'w'>
-! ___
-ALLOCATE(XLES_RES_ddz_Sv_SBG_W2 (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <dSv'/dz w'2>
-! ______
-ALLOCATE(XLES_RES_ddxa_Sv_SBG_UaSv(NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <dSv'/dxa ua'Sv'>
-! _____
-ALLOCATE(XLES_RES_W_SBG_WSv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <w'w'Sv'>
-! ____
-ALLOCATE(XLES_RES_W_SBG_Sv2 (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <w'Sv'2>
-!
-XLES_RES_U_SBG_Tke= XUNDEF
-XLES_RES_V_SBG_Tke= XUNDEF
-XLES_RES_W_SBG_Tke= XUNDEF
-XLES_RES_W_SBG_WThl = XUNDEF
-XLES_RES_W_SBG_Thl2 = XUNDEF
-XLES_RES_ddxa_U_SBG_UaU = XUNDEF
-XLES_RES_ddxa_V_SBG_UaV = XUNDEF
-XLES_RES_ddxa_W_SBG_UaW = XUNDEF
-XLES_RES_ddxa_W_SBG_UaThl = XUNDEF
-XLES_RES_ddxa_Thl_SBG_UaW = XUNDEF
-XLES_RES_ddz_Thl_SBG_W2 = XUNDEF
-XLES_RES_ddxa_Thl_SBG_UaThl = XUNDEF
-IF (LUSERV) THEN
- XLES_RES_W_SBG_WRt = XUNDEF
- XLES_RES_W_SBG_Rt2 = XUNDEF
- XLES_RES_W_SBG_ThlRt = XUNDEF
- XLES_RES_ddxa_W_SBG_UaRt = XUNDEF
- XLES_RES_ddxa_Rt_SBG_UaW = XUNDEF
- XLES_RES_ddz_Rt_SBG_W2 = XUNDEF
- XLES_RES_ddxa_Thl_SBG_UaRt= XUNDEF
- XLES_RES_ddxa_Rt_SBG_UaThl= XUNDEF
- XLES_RES_ddxa_Rt_SBG_UaRt = XUNDEF
-END IF
-IF (NSV>0) THEN
- XLES_RES_ddxa_W_SBG_UaSv = XUNDEF
- XLES_RES_ddxa_Sv_SBG_UaW = XUNDEF
- XLES_RES_ddz_Sv_SBG_W2 = XUNDEF
- XLES_RES_ddxa_Sv_SBG_UaSv= XUNDEF
- XLES_RES_W_SBG_WSv = XUNDEF
- XLES_RES_W_SBG_Sv2 = XUNDEF
-END IF
-!
-!
-!* 7.5 subgrid quantities
-! ------------------
-!
-ALLOCATE(XLES_SUBGRID_U2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'2>
-ALLOCATE(XLES_SUBGRID_V2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'2>
-ALLOCATE(XLES_SUBGRID_W2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'2>
-ALLOCATE(XLES_SUBGRID_Tke (NLES_K,NLES_TIMES,NLES_MASKS)) ! <e>
-ALLOCATE(XLES_SUBGRID_Thl2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Thl'2>
-ALLOCATE(XLES_SUBGRID_UV (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'v'>
-ALLOCATE(XLES_SUBGRID_WU (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'u'>
-ALLOCATE(XLES_SUBGRID_WV (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'v'>
-ALLOCATE(XLES_SUBGRID_UThl (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'Thl'>
-ALLOCATE(XLES_SUBGRID_VThl (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'Thl'>
-ALLOCATE(XLES_SUBGRID_WThl (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Thl'>
-ALLOCATE(XLES_SUBGRID_WThv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Thv'>
-ALLOCATE(XLES_SUBGRID_ThlThv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Thl'Thv'>
-ALLOCATE(XLES_SUBGRID_W2Thl (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'2Thl>
-ALLOCATE(XLES_SUBGRID_WThl2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Thl'2>
-ALLOCATE(XLES_SUBGRID_DISS_Tke (NLES_K,NLES_TIMES,NLES_MASKS)) ! <epsilon>
-ALLOCATE(XLES_SUBGRID_DISS_Thl2(NLES_K,NLES_TIMES,NLES_MASKS)) ! <epsilon_Thl2>
-ALLOCATE(XLES_SUBGRID_WP (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'p'>
-ALLOCATE(XLES_SUBGRID_PHI3 (NLES_K,NLES_TIMES,NLES_MASKS)) ! phi3
-ALLOCATE(XLES_SUBGRID_LMix (NLES_K,NLES_TIMES,NLES_MASKS)) ! mixing length
-ALLOCATE(XLES_SUBGRID_LDiss (NLES_K,NLES_TIMES,NLES_MASKS)) ! dissipative length
-ALLOCATE(XLES_SUBGRID_Km (NLES_K,NLES_TIMES,NLES_MASKS)) ! Km
-ALLOCATE(XLES_SUBGRID_Kh (NLES_K,NLES_TIMES,NLES_MASKS)) ! Kh
-ALLOCATE(XLES_SUBGRID_ThlPz (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Thl'dp'/dz>
-ALLOCATE(XLES_SUBGRID_UTke (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'Tke>
-ALLOCATE(XLES_SUBGRID_VTke (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'Tke>
-ALLOCATE(XLES_SUBGRID_WTke (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Tke>
-ALLOCATE(XLES_SUBGRID_ddz_WTke (NLES_K,NLES_TIMES,NLES_MASKS)) ! <dw'Tke/dz>
-
-ALLOCATE(XLES_SUBGRID_THLUP_MF(NLES_K,NLES_TIMES,NLES_MASKS)) ! Thl of the Updraft
-ALLOCATE(XLES_SUBGRID_RTUP_MF (NLES_K,NLES_TIMES,NLES_MASKS)) ! Rt of the Updraft
-ALLOCATE(XLES_SUBGRID_RVUP_MF (NLES_K,NLES_TIMES,NLES_MASKS)) ! Rv of the Updraft
-ALLOCATE(XLES_SUBGRID_RCUP_MF (NLES_K,NLES_TIMES,NLES_MASKS)) ! Rc of the Updraft
-ALLOCATE(XLES_SUBGRID_RIUP_MF (NLES_K,NLES_TIMES,NLES_MASKS)) ! Ri of the Updraft
-ALLOCATE(XLES_SUBGRID_WUP_MF (NLES_K,NLES_TIMES,NLES_MASKS)) ! Thl of the Updraft
-ALLOCATE(XLES_SUBGRID_MASSFLUX(NLES_K,NLES_TIMES,NLES_MASKS)) ! Mass Flux
-ALLOCATE(XLES_SUBGRID_DETR (NLES_K,NLES_TIMES,NLES_MASKS)) ! Detrainment
-ALLOCATE(XLES_SUBGRID_ENTR (NLES_K,NLES_TIMES,NLES_MASKS)) ! Entrainment
-ALLOCATE(XLES_SUBGRID_FRACUP (NLES_K,NLES_TIMES,NLES_MASKS)) ! Updraft Fraction
-ALLOCATE(XLES_SUBGRID_THVUP_MF(NLES_K,NLES_TIMES,NLES_MASKS)) ! Thv of the Updraft
-ALLOCATE(XLES_SUBGRID_WTHLMF (NLES_K,NLES_TIMES,NLES_MASKS)) ! Flux of thl
-ALLOCATE(XLES_SUBGRID_WRTMF (NLES_K,NLES_TIMES,NLES_MASKS)) ! Flux of rt
-ALLOCATE(XLES_SUBGRID_WTHVMF (NLES_K,NLES_TIMES,NLES_MASKS)) ! Flux of thv
-ALLOCATE(XLES_SUBGRID_WUMF (NLES_K,NLES_TIMES,NLES_MASKS))! Flux of u
-ALLOCATE(XLES_SUBGRID_WVMF (NLES_K,NLES_TIMES,NLES_MASKS))! Flux of v
-
-IF (LUSERV ) THEN
- ALLOCATE(XLES_SUBGRID_Rt2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Rt'2>
- ALLOCATE(XLES_SUBGRID_ThlRt (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Thl'Rt'>
- ALLOCATE(XLES_SUBGRID_URt (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'Rt'>
- ALLOCATE(XLES_SUBGRID_VRt (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'Rt'>
- ALLOCATE(XLES_SUBGRID_WRt (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Rt'>
- ALLOCATE(XLES_SUBGRID_RtThv (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Rt'Thv'>
- ALLOCATE(XLES_SUBGRID_W2Rt (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'2Rt'>
- ALLOCATE(XLES_SUBGRID_WThlRt(NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Thl'Rt'>
- ALLOCATE(XLES_SUBGRID_WRt2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Rt'2>
- ALLOCATE(XLES_SUBGRID_DISS_Rt2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <epsilon_Rt2>
- ALLOCATE(XLES_SUBGRID_DISS_ThlRt(NLES_K,NLES_TIMES,NLES_MASKS)) ! <epsilon_ThlRt>
- ALLOCATE(XLES_SUBGRID_RtPz (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Rt'dp'/dz>
- ALLOCATE(XLES_SUBGRID_PSI3 (NLES_K,NLES_TIMES,NLES_MASKS)) ! psi3
-ELSE
- ALLOCATE(XLES_SUBGRID_Rt2 (0,0,0))
- ALLOCATE(XLES_SUBGRID_ThlRt (0,0,0))
- ALLOCATE(XLES_SUBGRID_URt (0,0,0))
- ALLOCATE(XLES_SUBGRID_VRt (0,0,0))
- ALLOCATE(XLES_SUBGRID_WRt (0,0,0))
- ALLOCATE(XLES_SUBGRID_RtThv (0,0,0))
- ALLOCATE(XLES_SUBGRID_W2Rt (0,0,0))
- ALLOCATE(XLES_SUBGRID_WThlRt(0,0,0))
- ALLOCATE(XLES_SUBGRID_WRt2 (0,0,0))
- ALLOCATE(XLES_SUBGRID_DISS_Rt2 (0,0,0))
- ALLOCATE(XLES_SUBGRID_DISS_ThlRt(0,0,0))
- ALLOCATE(XLES_SUBGRID_RtPz (0,0,0))
- ALLOCATE(XLES_SUBGRID_PSI3 (0,0,0))
-END IF
-IF (LUSERC ) THEN
- ALLOCATE(XLES_SUBGRID_Rc2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Rc'2>
- ALLOCATE(XLES_SUBGRID_URc (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'Rc'>
- ALLOCATE(XLES_SUBGRID_VRc (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'Rc'>
- ALLOCATE(XLES_SUBGRID_WRc (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Rc'>
-ELSE
- ALLOCATE(XLES_SUBGRID_Rc2 (0,0,0))
- ALLOCATE(XLES_SUBGRID_URc (0,0,0))
- ALLOCATE(XLES_SUBGRID_VRc (0,0,0))
- ALLOCATE(XLES_SUBGRID_WRc (0,0,0))
-END IF
-IF (LUSERI ) THEN
- ALLOCATE(XLES_SUBGRID_Ri2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Ri'2>
-ELSE
- ALLOCATE(XLES_SUBGRID_Ri2 (0,0,0))
-END IF
-IF (NSV>0 ) THEN
- ALLOCATE(XLES_SUBGRID_USv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <u'Sv'>
- ALLOCATE(XLES_SUBGRID_VSv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <v'Sv'>
- ALLOCATE(XLES_SUBGRID_WSv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <w'Sv'>
- ALLOCATE(XLES_SUBGRID_Sv2 (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <Sv'2>
- ALLOCATE(XLES_SUBGRID_SvThv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <Sv'Thv'>
- ALLOCATE(XLES_SUBGRID_W2Sv (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <w'2Sv'>
- ALLOCATE(XLES_SUBGRID_WSv2 (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <w'Sv'2>
- ALLOCATE(XLES_SUBGRID_DISS_Sv2 (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <epsilon_Sv2>
- ALLOCATE(XLES_SUBGRID_SvPz (NLES_K,NLES_TIMES,NLES_MASKS,NSV)) ! <Sv'dp'/dz>
-ELSE
- ALLOCATE(XLES_SUBGRID_USv (0,0,0,0))
- ALLOCATE(XLES_SUBGRID_VSv (0,0,0,0))
- ALLOCATE(XLES_SUBGRID_WSv (0,0,0,0))
- ALLOCATE(XLES_SUBGRID_Sv2 (0,0,0,0))
- ALLOCATE(XLES_SUBGRID_SvThv (0,0,0,0))
- ALLOCATE(XLES_SUBGRID_W2Sv (0,0,0,0))
- ALLOCATE(XLES_SUBGRID_WSv2 (0,0,0,0))
- ALLOCATE(XLES_SUBGRID_DISS_Sv2(0,0,0,0))
- ALLOCATE(XLES_SUBGRID_SvPz (0,0,0,0))
-END IF
-!
-XLES_SUBGRID_U2 = XUNDEF
-XLES_SUBGRID_V2 = XUNDEF
-XLES_SUBGRID_W2 = XUNDEF
-XLES_SUBGRID_Tke = XUNDEF
-XLES_SUBGRID_Thl2= XUNDEF
-XLES_SUBGRID_UV = XUNDEF
-XLES_SUBGRID_WU = XUNDEF
-XLES_SUBGRID_WV = XUNDEF
-XLES_SUBGRID_UThl= XUNDEF
-XLES_SUBGRID_VThl= XUNDEF
-XLES_SUBGRID_WThl= XUNDEF
-XLES_SUBGRID_WThv= XUNDEF
-XLES_SUBGRID_ThlThv= XUNDEF
-XLES_SUBGRID_W2Thl= XUNDEF
-XLES_SUBGRID_WThl2 = XUNDEF
-XLES_SUBGRID_DISS_Tke = XUNDEF
-XLES_SUBGRID_DISS_Thl2= XUNDEF
-XLES_SUBGRID_WP = XUNDEF
-XLES_SUBGRID_PHI3 = XUNDEF
-XLES_SUBGRID_LMix = XUNDEF
-XLES_SUBGRID_LDiss = XUNDEF
-XLES_SUBGRID_Km = XUNDEF
-XLES_SUBGRID_Kh = XUNDEF
-XLES_SUBGRID_ThlPz = XUNDEF
-XLES_SUBGRID_UTke= XUNDEF
-XLES_SUBGRID_VTke= XUNDEF
-XLES_SUBGRID_WTke= XUNDEF
-XLES_SUBGRID_ddz_WTke = XUNDEF
-
-XLES_SUBGRID_THLUP_MF = XUNDEF
-XLES_SUBGRID_RTUP_MF = XUNDEF
-XLES_SUBGRID_RVUP_MF = XUNDEF
-XLES_SUBGRID_RCUP_MF = XUNDEF
-XLES_SUBGRID_RIUP_MF = XUNDEF
-XLES_SUBGRID_WUP_MF = XUNDEF
-XLES_SUBGRID_MASSFLUX = XUNDEF
-XLES_SUBGRID_DETR = XUNDEF
-XLES_SUBGRID_ENTR = XUNDEF
-XLES_SUBGRID_FRACUP = XUNDEF
-XLES_SUBGRID_THVUP_MF = XUNDEF
-XLES_SUBGRID_WTHLMF = XUNDEF
-XLES_SUBGRID_WRTMF = XUNDEF
-XLES_SUBGRID_WTHVMF = XUNDEF
-XLES_SUBGRID_WUMF = XUNDEF
-XLES_SUBGRID_WVMF = XUNDEF
-
-IF (LUSERV ) THEN
- XLES_SUBGRID_Rt2 = XUNDEF
- XLES_SUBGRID_ThlRt= XUNDEF
- XLES_SUBGRID_URt = XUNDEF
- XLES_SUBGRID_VRt = XUNDEF
- XLES_SUBGRID_WRt = XUNDEF
- XLES_SUBGRID_RtThv = XUNDEF
- XLES_SUBGRID_W2Rt = XUNDEF
- XLES_SUBGRID_WThlRt = XUNDEF
- XLES_SUBGRID_WRt2 = XUNDEF
- XLES_SUBGRID_DISS_Rt2= XUNDEF
- XLES_SUBGRID_DISS_ThlRt= XUNDEF
- XLES_SUBGRID_RtPz = XUNDEF
- XLES_SUBGRID_PSI3 = XUNDEF
-END IF
-IF (LUSERC ) THEN
- XLES_SUBGRID_Rc2 = XUNDEF
- XLES_SUBGRID_URc = XUNDEF
- XLES_SUBGRID_VRc = XUNDEF
- XLES_SUBGRID_WRc = XUNDEF
-END IF
-IF (LUSERI ) THEN
- XLES_SUBGRID_Ri2 = XUNDEF
-END IF
-IF (NSV>0 ) THEN
- XLES_SUBGRID_USv = XUNDEF
- XLES_SUBGRID_VSv = XUNDEF
- XLES_SUBGRID_WSv = XUNDEF
- XLES_SUBGRID_Sv2 = XUNDEF
- XLES_SUBGRID_SvThv = XUNDEF
- XLES_SUBGRID_W2Sv = XUNDEF
- XLES_SUBGRID_WSv2 = XUNDEF
- XLES_SUBGRID_DISS_Sv2= XUNDEF
- XLES_SUBGRID_SvPz = XUNDEF
-END IF
-!
-!
-!* 7.6 updraft quantities (only on the cartesian mask)
-! ------------------
-!
-ALLOCATE(XLES_UPDRAFT (NLES_K,NLES_TIMES)) ! updraft fraction
-ALLOCATE(XLES_UPDRAFT_W (NLES_K,NLES_TIMES)) ! <w>
-ALLOCATE(XLES_UPDRAFT_Th (NLES_K,NLES_TIMES)) ! <theta>
-ALLOCATE(XLES_UPDRAFT_Ke (NLES_K,NLES_TIMES)) ! <E>
-ALLOCATE(XLES_UPDRAFT_WTh (NLES_K,NLES_TIMES)) ! <w'theta'>
-ALLOCATE(XLES_UPDRAFT_Th2 (NLES_K,NLES_TIMES)) ! <th'2>
-ALLOCATE(XLES_UPDRAFT_Tke (NLES_K,NLES_TIMES)) ! <e>
-
-IF (LUSERV) THEN
- ALLOCATE(XLES_UPDRAFT_Thv (NLES_K,NLES_TIMES)) ! <thetav>
- ALLOCATE(XLES_UPDRAFT_WThv (NLES_K,NLES_TIMES)) ! <w'thv'>
- ALLOCATE(XLES_UPDRAFT_ThThv (NLES_K,NLES_TIMES)) ! <th'thv'>
-ELSE
- ALLOCATE(XLES_UPDRAFT_Thv (0,0))
- ALLOCATE(XLES_UPDRAFT_WThv (0,0))
- ALLOCATE(XLES_UPDRAFT_ThThv (0,0))
-END IF
-!
-IF (LUSERC) THEN
- ALLOCATE(XLES_UPDRAFT_Thl (NLES_K,NLES_TIMES)) ! <thetal>
- ALLOCATE(XLES_UPDRAFT_WThl (NLES_K,NLES_TIMES)) ! <w'thetal'>
- ALLOCATE(XLES_UPDRAFT_Thl2 (NLES_K,NLES_TIMES)) ! <thl'2>
- ALLOCATE(XLES_UPDRAFT_ThlThv(NLES_K,NLES_TIMES)) ! <thl'thv'>
-ELSE
- ALLOCATE(XLES_UPDRAFT_Thl (0,0))
- ALLOCATE(XLES_UPDRAFT_WThl (0,0))
- ALLOCATE(XLES_UPDRAFT_Thl2 (0,0))
- ALLOCATE(XLES_UPDRAFT_ThlThv(0,0))
-END IF
-
-IF (LUSERV ) THEN
- ALLOCATE(XLES_UPDRAFT_Rv (NLES_K,NLES_TIMES)) ! <Rv>
- ALLOCATE(XLES_UPDRAFT_WRv (NLES_K,NLES_TIMES)) ! <w'Rv'>
- ALLOCATE(XLES_UPDRAFT_Rv2 (NLES_K,NLES_TIMES)) ! <Rv'2>
- ALLOCATE(XLES_UPDRAFT_ThRv (NLES_K,NLES_TIMES)) ! <Th'Rv'>
- ALLOCATE(XLES_UPDRAFT_ThvRv (NLES_K,NLES_TIMES)) ! <Thv'Rv'>
- IF (LUSERC) THEN
- ALLOCATE(XLES_UPDRAFT_ThlRv (NLES_K,NLES_TIMES)) ! <Thl'Rv'>
- ELSE
- ALLOCATE(XLES_UPDRAFT_ThlRv (0,0))
- END IF
-ELSE
- ALLOCATE(XLES_UPDRAFT_Rv (0,0))
- ALLOCATE(XLES_UPDRAFT_WRv (0,0))
- ALLOCATE(XLES_UPDRAFT_Rv2 (0,0))
- ALLOCATE(XLES_UPDRAFT_ThRv (0,0))
- ALLOCATE(XLES_UPDRAFT_ThvRv (0,0))
- ALLOCATE(XLES_UPDRAFT_ThlRv (0,0))
-END IF
-IF (LUSERC ) THEN
- ALLOCATE(XLES_UPDRAFT_Rc (NLES_K,NLES_TIMES)) ! <Rc>
- ALLOCATE(XLES_UPDRAFT_WRc (NLES_K,NLES_TIMES)) ! <w'Rc'>
- ALLOCATE(XLES_UPDRAFT_Rc2 (NLES_K,NLES_TIMES)) ! <Rc'2>
- ALLOCATE(XLES_UPDRAFT_ThRc (NLES_K,NLES_TIMES)) ! <Th'Rc'>
- ALLOCATE(XLES_UPDRAFT_ThvRc (NLES_K,NLES_TIMES)) ! <Thv'Rc'>
- ALLOCATE(XLES_UPDRAFT_ThlRc (NLES_K,NLES_TIMES)) ! <Thl'Rc'>
-ELSE
- ALLOCATE(XLES_UPDRAFT_Rc (0,0))
- ALLOCATE(XLES_UPDRAFT_WRc (0,0))
- ALLOCATE(XLES_UPDRAFT_Rc2 (0,0))
- ALLOCATE(XLES_UPDRAFT_ThRc (0,0))
- ALLOCATE(XLES_UPDRAFT_ThvRc (0,0))
- ALLOCATE(XLES_UPDRAFT_ThlRc (0,0))
-END IF
-IF (LUSERR ) THEN
- ALLOCATE(XLES_UPDRAFT_Rr (NLES_K,NLES_TIMES)) ! <Rr>
-ELSE
- ALLOCATE(XLES_UPDRAFT_Rr (0,0))
-END IF
-IF (LUSERI ) THEN
- ALLOCATE(XLES_UPDRAFT_Ri (NLES_K,NLES_TIMES)) ! <Ri>
- ALLOCATE(XLES_UPDRAFT_WRi (NLES_K,NLES_TIMES)) ! <w'Ri'>
- ALLOCATE(XLES_UPDRAFT_Ri2 (NLES_K,NLES_TIMES)) ! <Ri'2>
- ALLOCATE(XLES_UPDRAFT_ThRi (NLES_K,NLES_TIMES)) ! <Th'Ri'>
- ALLOCATE(XLES_UPDRAFT_ThvRi (NLES_K,NLES_TIMES)) ! <Thv'Ri'>
- ALLOCATE(XLES_UPDRAFT_ThlRi (NLES_K,NLES_TIMES)) ! <Thl'Ri'>
-ELSE
- ALLOCATE(XLES_UPDRAFT_Ri (0,0))
- ALLOCATE(XLES_UPDRAFT_WRi (0,0))
- ALLOCATE(XLES_UPDRAFT_Ri2 (0,0))
- ALLOCATE(XLES_UPDRAFT_ThRi (0,0))
- ALLOCATE(XLES_UPDRAFT_ThvRi (0,0))
- ALLOCATE(XLES_UPDRAFT_ThlRi (0,0))
-END IF
-IF (LUSERS ) THEN
- ALLOCATE(XLES_UPDRAFT_Rs (NLES_K,NLES_TIMES)) ! <Rs>
-ELSE
- ALLOCATE(XLES_UPDRAFT_Rs (0,0))
-END IF
-IF (LUSERG ) THEN
- ALLOCATE(XLES_UPDRAFT_Rg (NLES_K,NLES_TIMES)) ! <Rg>
-ELSE
- ALLOCATE(XLES_UPDRAFT_Rg (0,0))
-END IF
-IF (LUSERH ) THEN
- ALLOCATE(XLES_UPDRAFT_Rh (NLES_K,NLES_TIMES)) ! <Rh>
-ELSE
- ALLOCATE(XLES_UPDRAFT_Rh (0,0))
-END IF
-IF (NSV>0 ) THEN
- ALLOCATE(XLES_UPDRAFT_Sv (NLES_K,NLES_TIMES,NSV))! <Sv>
- ALLOCATE(XLES_UPDRAFT_WSv (NLES_K,NLES_TIMES,NSV))! <w'Sv'>
- ALLOCATE(XLES_UPDRAFT_Sv2 (NLES_K,NLES_TIMES,NSV))! <Sv'2>
- ALLOCATE(XLES_UPDRAFT_ThSv (NLES_K,NLES_TIMES,NSV))! <Th'Sv'>
- IF (LUSERV) THEN
- ALLOCATE(XLES_UPDRAFT_ThvSv (NLES_K,NLES_TIMES,NSV))! <Thv'Sv'>
- ELSE
- ALLOCATE(XLES_UPDRAFT_ThvSv (0,0,0))
- END IF
- IF (LUSERC) THEN
- ALLOCATE(XLES_UPDRAFT_ThlSv (NLES_K,NLES_TIMES,NSV))! <Thl'Sv'>
- ELSE
- ALLOCATE(XLES_UPDRAFT_ThlSv (0,0,0))
- END IF
-ELSE
- ALLOCATE(XLES_UPDRAFT_Sv (0,0,0))
- ALLOCATE(XLES_UPDRAFT_WSv (0,0,0))
- ALLOCATE(XLES_UPDRAFT_Sv2 (0,0,0))
- ALLOCATE(XLES_UPDRAFT_ThSv (0,0,0))
- ALLOCATE(XLES_UPDRAFT_ThvSv (0,0,0))
- ALLOCATE(XLES_UPDRAFT_ThlSv (0,0,0))
-END IF
-!
-!
-XLES_UPDRAFT = XUNDEF
-XLES_UPDRAFT_W = XUNDEF
-XLES_UPDRAFT_Th = XUNDEF
-XLES_UPDRAFT_Thl = XUNDEF
-XLES_UPDRAFT_Tke = XUNDEF
-IF (LUSERV ) XLES_UPDRAFT_Thv = XUNDEF
-IF (LUSERC ) XLES_UPDRAFT_Thl = XUNDEF
-IF (LUSERV ) XLES_UPDRAFT_Rv = XUNDEF
-IF (LUSERC ) XLES_UPDRAFT_Rc = XUNDEF
-IF (LUSERR ) XLES_UPDRAFT_Rr = XUNDEF
-IF (LUSERI ) XLES_UPDRAFT_Ri = XUNDEF
-IF (LUSERS ) XLES_UPDRAFT_Rs = XUNDEF
-IF (LUSERG ) XLES_UPDRAFT_Rg = XUNDEF
-IF (LUSERH ) XLES_UPDRAFT_Rh = XUNDEF
-IF (NSV>0 ) XLES_UPDRAFT_Sv = XUNDEF
-XLES_UPDRAFT_Ke = XUNDEF
-XLES_UPDRAFT_WTh = XUNDEF
-IF (LUSERV ) XLES_UPDRAFT_WThv = XUNDEF
-IF (LUSERC ) XLES_UPDRAFT_WThl = XUNDEF
-IF (LUSERV ) XLES_UPDRAFT_WRv = XUNDEF
-IF (LUSERC ) XLES_UPDRAFT_WRc = XUNDEF
-IF (LUSERI ) XLES_UPDRAFT_WRi = XUNDEF
-IF (NSV>0 ) XLES_UPDRAFT_WSv = XUNDEF
-XLES_UPDRAFT_Th2 = XUNDEF
-IF (LUSERV ) THEN
- XLES_UPDRAFT_ThThv = XUNDEF
-END IF
-IF (LUSERC ) THEN
- XLES_UPDRAFT_Thl2 = XUNDEF
- XLES_UPDRAFT_ThlThv = XUNDEF
-END IF
-IF (LUSERV ) XLES_UPDRAFT_Rv2 = XUNDEF
-IF (LUSERC ) XLES_UPDRAFT_Rc2 = XUNDEF
-IF (LUSERI ) XLES_UPDRAFT_Ri2 = XUNDEF
-IF (NSV>0 ) XLES_UPDRAFT_Sv2 = XUNDEF
-IF (LUSERV ) XLES_UPDRAFT_ThRv = XUNDEF
-IF (LUSERC ) XLES_UPDRAFT_ThRc = XUNDEF
-IF (LUSERI ) XLES_UPDRAFT_ThRi = XUNDEF
-IF (LUSERC ) XLES_UPDRAFT_ThlRv= XUNDEF
-IF (LUSERC ) XLES_UPDRAFT_ThlRc= XUNDEF
-IF (LUSERI ) XLES_UPDRAFT_ThlRi= XUNDEF
-IF (NSV>0 ) XLES_UPDRAFT_ThSv = XUNDEF
-IF (LUSERV ) XLES_UPDRAFT_ThvRv= XUNDEF
-IF (LUSERC ) XLES_UPDRAFT_ThvRc= XUNDEF
-IF (LUSERI ) XLES_UPDRAFT_ThvRi= XUNDEF
-IF (NSV>0 .AND. LUSERV) XLES_UPDRAFT_ThvSv = XUNDEF
-IF (NSV>0 .AND. LUSERC) XLES_UPDRAFT_ThlSv = XUNDEF
-!
-!
-!* 7.7 downdraft quantities (only on the cartesian mask)
-! --------------------
-!
-ALLOCATE(XLES_DOWNDRAFT (NLES_K,NLES_TIMES)) ! updraft fraction
-ALLOCATE(XLES_DOWNDRAFT_W (NLES_K,NLES_TIMES)) ! <w>
-ALLOCATE(XLES_DOWNDRAFT_Th (NLES_K,NLES_TIMES)) ! <theta>
-ALLOCATE(XLES_DOWNDRAFT_Ke (NLES_K,NLES_TIMES)) ! <E>
-ALLOCATE(XLES_DOWNDRAFT_WTh (NLES_K,NLES_TIMES)) ! <w'theta'>
-ALLOCATE(XLES_DOWNDRAFT_Th2 (NLES_K,NLES_TIMES)) ! <th'2>
-ALLOCATE(XLES_DOWNDRAFT_Tke (NLES_K,NLES_TIMES)) ! <e>
-
-IF (LUSERV) THEN
- ALLOCATE(XLES_DOWNDRAFT_Thv (NLES_K,NLES_TIMES)) ! <thetav>
- ALLOCATE(XLES_DOWNDRAFT_WThv (NLES_K,NLES_TIMES)) ! <w'thv'>
- ALLOCATE(XLES_DOWNDRAFT_ThThv (NLES_K,NLES_TIMES)) ! <th'thv'>
-ELSE
- ALLOCATE(XLES_DOWNDRAFT_Thv (0,0))
- ALLOCATE(XLES_DOWNDRAFT_WThv (0,0))
- ALLOCATE(XLES_DOWNDRAFT_ThThv (0,0))
-END IF
-!
-IF (LUSERC) THEN
- ALLOCATE(XLES_DOWNDRAFT_Thl (NLES_K,NLES_TIMES)) ! <thetal>
- ALLOCATE(XLES_DOWNDRAFT_WThl (NLES_K,NLES_TIMES)) ! <w'thetal'>
- ALLOCATE(XLES_DOWNDRAFT_Thl2 (NLES_K,NLES_TIMES)) ! <thl'2>
- ALLOCATE(XLES_DOWNDRAFT_ThlThv(NLES_K,NLES_TIMES)) ! <thl'thv'>
-ELSE
- ALLOCATE(XLES_DOWNDRAFT_Thl (0,0))
- ALLOCATE(XLES_DOWNDRAFT_WThl (0,0))
- ALLOCATE(XLES_DOWNDRAFT_Thl2 (0,0))
- ALLOCATE(XLES_DOWNDRAFT_ThlThv(0,0))
-END IF
-
-IF (LUSERV ) THEN
- ALLOCATE(XLES_DOWNDRAFT_Rv (NLES_K,NLES_TIMES)) ! <Rv>
- ALLOCATE(XLES_DOWNDRAFT_WRv (NLES_K,NLES_TIMES)) ! <w'Rv'>
- ALLOCATE(XLES_DOWNDRAFT_Rv2 (NLES_K,NLES_TIMES)) ! <Rv'2>
- ALLOCATE(XLES_DOWNDRAFT_ThRv (NLES_K,NLES_TIMES)) ! <Th'Rv'>
- ALLOCATE(XLES_DOWNDRAFT_ThvRv (NLES_K,NLES_TIMES)) ! <Thv'Rv'>
- IF (LUSERC) THEN
- ALLOCATE(XLES_DOWNDRAFT_ThlRv (NLES_K,NLES_TIMES)) ! <Thl'Rv'>
- ELSE
- ALLOCATE(XLES_DOWNDRAFT_ThlRv (0,0))
- END IF
-ELSE
- ALLOCATE(XLES_DOWNDRAFT_Rv (0,0))
- ALLOCATE(XLES_DOWNDRAFT_WRv (0,0))
- ALLOCATE(XLES_DOWNDRAFT_Rv2 (0,0))
- ALLOCATE(XLES_DOWNDRAFT_ThRv (0,0))
- ALLOCATE(XLES_DOWNDRAFT_ThvRv (0,0))
- ALLOCATE(XLES_DOWNDRAFT_ThlRv (0,0))
-END IF
-IF (LUSERC ) THEN
- ALLOCATE(XLES_DOWNDRAFT_Rc (NLES_K,NLES_TIMES)) ! <Rc>
- ALLOCATE(XLES_DOWNDRAFT_WRc (NLES_K,NLES_TIMES)) ! <w'Rc'>
- ALLOCATE(XLES_DOWNDRAFT_Rc2 (NLES_K,NLES_TIMES)) ! <Rc'2>
- ALLOCATE(XLES_DOWNDRAFT_ThRc (NLES_K,NLES_TIMES)) ! <Th'Rc'>
- ALLOCATE(XLES_DOWNDRAFT_ThvRc (NLES_K,NLES_TIMES)) ! <Thv'Rc'>
- ALLOCATE(XLES_DOWNDRAFT_ThlRc (NLES_K,NLES_TIMES)) ! <Thl'Rc'>
-ELSE
- ALLOCATE(XLES_DOWNDRAFT_Rc (0,0))
- ALLOCATE(XLES_DOWNDRAFT_WRc (0,0))
- ALLOCATE(XLES_DOWNDRAFT_Rc2 (0,0))
- ALLOCATE(XLES_DOWNDRAFT_ThRc (0,0))
- ALLOCATE(XLES_DOWNDRAFT_ThvRc (0,0))
- ALLOCATE(XLES_DOWNDRAFT_ThlRc (0,0))
-END IF
-IF (LUSERR ) THEN
- ALLOCATE(XLES_DOWNDRAFT_Rr (NLES_K,NLES_TIMES)) ! <Rr>
-ELSE
- ALLOCATE(XLES_DOWNDRAFT_Rr (0,0))
-END IF
-IF (LUSERI ) THEN
- ALLOCATE(XLES_DOWNDRAFT_Ri (NLES_K,NLES_TIMES)) ! <Ri>
- ALLOCATE(XLES_DOWNDRAFT_WRi (NLES_K,NLES_TIMES)) ! <w'Ri'>
- ALLOCATE(XLES_DOWNDRAFT_Ri2 (NLES_K,NLES_TIMES)) ! <Ri'2>
- ALLOCATE(XLES_DOWNDRAFT_ThRi (NLES_K,NLES_TIMES)) ! <Th'Ri'>
- ALLOCATE(XLES_DOWNDRAFT_ThvRi (NLES_K,NLES_TIMES)) ! <Thv'Ri'>
- ALLOCATE(XLES_DOWNDRAFT_ThlRi (NLES_K,NLES_TIMES)) ! <Thl'Ri'>
-ELSE
- ALLOCATE(XLES_DOWNDRAFT_Ri (0,0))
- ALLOCATE(XLES_DOWNDRAFT_WRi (0,0))
- ALLOCATE(XLES_DOWNDRAFT_Ri2 (0,0))
- ALLOCATE(XLES_DOWNDRAFT_ThRi (0,0))
- ALLOCATE(XLES_DOWNDRAFT_ThvRi (0,0))
- ALLOCATE(XLES_DOWNDRAFT_ThlRi (0,0))
-END IF
-IF (LUSERS ) THEN
- ALLOCATE(XLES_DOWNDRAFT_Rs (NLES_K,NLES_TIMES)) ! <Rs>
-ELSE
- ALLOCATE(XLES_DOWNDRAFT_Rs (0,0))
-END IF
-IF (LUSERG ) THEN
- ALLOCATE(XLES_DOWNDRAFT_Rg (NLES_K,NLES_TIMES)) ! <Rg>
-ELSE
- ALLOCATE(XLES_DOWNDRAFT_Rg (0,0))
-END IF
-IF (LUSERH ) THEN
- ALLOCATE(XLES_DOWNDRAFT_Rh (NLES_K,NLES_TIMES)) ! <Rh>
-ELSE
- ALLOCATE(XLES_DOWNDRAFT_Rh (0,0))
-END IF
-IF (NSV>0 ) THEN
- ALLOCATE(XLES_DOWNDRAFT_Sv (NLES_K,NLES_TIMES,NSV))! <Sv>
- ALLOCATE(XLES_DOWNDRAFT_WSv (NLES_K,NLES_TIMES,NSV))! <w'Sv'>
- ALLOCATE(XLES_DOWNDRAFT_Sv2 (NLES_K,NLES_TIMES,NSV))! <Sv'2>
- ALLOCATE(XLES_DOWNDRAFT_ThSv (NLES_K,NLES_TIMES,NSV))! <Th'Sv'>
- IF (LUSERV) THEN
- ALLOCATE(XLES_DOWNDRAFT_ThvSv (NLES_K,NLES_TIMES,NSV))! <Thv'Sv'>
- ELSE
- ALLOCATE(XLES_DOWNDRAFT_ThvSv (0,0,0))
- END IF
- IF (LUSERC) THEN
- ALLOCATE(XLES_DOWNDRAFT_ThlSv (NLES_K,NLES_TIMES,NSV))! <Thl'Sv'>
- ELSE
- ALLOCATE(XLES_DOWNDRAFT_ThlSv (0,0,0))
- END IF
-ELSE
- ALLOCATE(XLES_DOWNDRAFT_Sv (0,0,0))
- ALLOCATE(XLES_DOWNDRAFT_WSv (0,0,0))
- ALLOCATE(XLES_DOWNDRAFT_Sv2 (0,0,0))
- ALLOCATE(XLES_DOWNDRAFT_ThSv (0,0,0))
- ALLOCATE(XLES_DOWNDRAFT_ThvSv (0,0,0))
- ALLOCATE(XLES_DOWNDRAFT_ThlSv (0,0,0))
-END IF
-!
-!
-XLES_DOWNDRAFT = XUNDEF
-XLES_DOWNDRAFT_W = XUNDEF
-XLES_DOWNDRAFT_Th = XUNDEF
-XLES_DOWNDRAFT_Thl = XUNDEF
-XLES_DOWNDRAFT_Tke = XUNDEF
-IF (LUSERV ) XLES_DOWNDRAFT_Thv = XUNDEF
-IF (LUSERC ) XLES_DOWNDRAFT_Thl = XUNDEF
-IF (LUSERV ) XLES_DOWNDRAFT_Rv = XUNDEF
-IF (LUSERC ) XLES_DOWNDRAFT_Rc = XUNDEF
-IF (LUSERR ) XLES_DOWNDRAFT_Rr = XUNDEF
-IF (LUSERI ) XLES_DOWNDRAFT_Ri = XUNDEF
-IF (LUSERS ) XLES_DOWNDRAFT_Rs = XUNDEF
-IF (LUSERG ) XLES_DOWNDRAFT_Rg = XUNDEF
-IF (LUSERH ) XLES_DOWNDRAFT_Rh = XUNDEF
-IF (NSV>0 ) XLES_DOWNDRAFT_Sv = XUNDEF
-XLES_DOWNDRAFT_Ke = XUNDEF
-XLES_DOWNDRAFT_WTh = XUNDEF
-IF (LUSERV ) XLES_DOWNDRAFT_WThv = XUNDEF
-IF (LUSERC ) XLES_DOWNDRAFT_WThl = XUNDEF
-IF (LUSERV ) XLES_DOWNDRAFT_WRv = XUNDEF
-IF (LUSERC ) XLES_DOWNDRAFT_WRc = XUNDEF
-IF (LUSERI ) XLES_DOWNDRAFT_WRi = XUNDEF
-IF (NSV>0 ) XLES_DOWNDRAFT_WSv = XUNDEF
-XLES_DOWNDRAFT_Th2 = XUNDEF
-IF (LUSERV ) THEN
- XLES_DOWNDRAFT_ThThv = XUNDEF
-END IF
-IF (LUSERC ) THEN
- XLES_DOWNDRAFT_Thl2 = XUNDEF
- XLES_DOWNDRAFT_ThlThv = XUNDEF
-END IF
-IF (LUSERV ) XLES_DOWNDRAFT_Rv2 = XUNDEF
-IF (LUSERC ) XLES_DOWNDRAFT_Rc2 = XUNDEF
-IF (LUSERI ) XLES_DOWNDRAFT_Ri2 = XUNDEF
-IF (NSV>0 ) XLES_DOWNDRAFT_Sv2 = XUNDEF
-IF (LUSERV ) XLES_DOWNDRAFT_ThRv = XUNDEF
-IF (LUSERC ) XLES_DOWNDRAFT_ThRc = XUNDEF
-IF (LUSERI ) XLES_DOWNDRAFT_ThRi = XUNDEF
-IF (LUSERC ) XLES_DOWNDRAFT_ThlRv= XUNDEF
-IF (LUSERC ) XLES_DOWNDRAFT_ThlRc= XUNDEF
-IF (LUSERI ) XLES_DOWNDRAFT_ThlRi= XUNDEF
-IF (NSV>0 ) XLES_DOWNDRAFT_ThSv = XUNDEF
-IF (LUSERV ) XLES_DOWNDRAFT_ThvRv= XUNDEF
-IF (LUSERC ) XLES_DOWNDRAFT_ThvRc= XUNDEF
-IF (LUSERI ) XLES_DOWNDRAFT_ThvRi= XUNDEF
-IF (NSV>0 .AND. LUSERV) XLES_DOWNDRAFT_ThvSv = XUNDEF
-IF (NSV>0 .AND. LUSERC) XLES_DOWNDRAFT_ThlSv = XUNDEF
-!
-!* 7.8 production terms
-! ----------------
-!
-ALLOCATE(XLES_BU_RES_KE (NLES_K,NLES_TIMES,NLES_TOT))
-ALLOCATE(XLES_BU_RES_WThl (NLES_K,NLES_TIMES,NLES_TOT))
-ALLOCATE(XLES_BU_RES_Thl2 (NLES_K,NLES_TIMES,NLES_TOT))
-ALLOCATE(XLES_BU_SBG_TKE (NLES_K,NLES_TIMES,NLES_TOT))
-XLES_BU_RES_KE = 0.
-XLES_BU_RES_WThl = 0.
-XLES_BU_RES_Thl2 = 0.
-XLES_BU_SBG_TKE = 0.
-IF (LUSERV) THEN
- ALLOCATE(XLES_BU_RES_WRt (NLES_K,NLES_TIMES,NLES_TOT))
- ALLOCATE(XLES_BU_RES_Rt2 (NLES_K,NLES_TIMES,NLES_TOT))
- ALLOCATE(XLES_BU_RES_ThlRt(NLES_K,NLES_TIMES,NLES_TOT))
- XLES_BU_RES_WRt = 0.
- XLES_BU_RES_Rt2 = 0.
- XLES_BU_RES_ThlRt = 0.
-END IF
-ALLOCATE(XLES_BU_RES_WSv (NLES_K,NLES_TIMES,NLES_TOT,NSV))
-ALLOCATE(XLES_BU_RES_Sv2 (NLES_K,NLES_TIMES,NLES_TOT,NSV))
-IF (NSV>0) THEN
- XLES_BU_RES_WSv = 0.
- XLES_BU_RES_Sv2 = 0.
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 8. Allocations of the normalization variables temporal series
-! ----------------------------------------------------------
-!
-ALLOCATE(XLES_UW0 (NLES_TIMES))
-ALLOCATE(XLES_VW0 (NLES_TIMES))
-ALLOCATE(XLES_USTAR (NLES_TIMES))
-ALLOCATE(XLES_WSTAR (NLES_TIMES))
-ALLOCATE(XLES_Q0 (NLES_TIMES))
-ALLOCATE(XLES_E0 (NLES_TIMES))
-ALLOCATE(XLES_SV0 (NLES_TIMES,NSV))
-ALLOCATE(XLES_BL_HEIGHT (NLES_TIMES))
-ALLOCATE(XLES_MO_LENGTH (NLES_TIMES))
-ALLOCATE(XLES_ZCB (NLES_TIMES))
-ALLOCATE(XLES_CFtot (NLES_TIMES))
-ALLOCATE(XLES_CF2tot (NLES_TIMES))
-ALLOCATE(XLES_LWP (NLES_TIMES))
-ALLOCATE(XLES_LWPVAR (NLES_TIMES))
-ALLOCATE(XLES_RWP (NLES_TIMES))
-ALLOCATE(XLES_IWP (NLES_TIMES))
-ALLOCATE(XLES_SWP (NLES_TIMES))
-ALLOCATE(XLES_GWP (NLES_TIMES))
-ALLOCATE(XLES_HWP (NLES_TIMES))
-ALLOCATE(XLES_INT_TKE (NLES_TIMES))
-ALLOCATE(XLES_ZMAXCF (NLES_TIMES))
-ALLOCATE(XLES_ZMAXCF2 (NLES_TIMES))
-ALLOCATE(XLES_INPRR (NLES_TIMES))
-ALLOCATE(XLES_INPRC (NLES_TIMES))
-ALLOCATE(XLES_INDEP (NLES_TIMES))
-ALLOCATE(XLES_RAIN_INPRR(NLES_TIMES))
-ALLOCATE(XLES_ACPRR (NLES_TIMES))
-ALLOCATE(XLES_PRECFR (NLES_TIMES))
-ALLOCATE(XLES_SWU (NLES_K,NLES_TIMES))
-ALLOCATE(XLES_SWD (NLES_K,NLES_TIMES))
-ALLOCATE(XLES_LWU (NLES_K,NLES_TIMES))
-ALLOCATE(XLES_LWD (NLES_K,NLES_TIMES))
-ALLOCATE(XLES_DTHRADSW (NLES_K,NLES_TIMES))
-ALLOCATE(XLES_DTHRADLW (NLES_K,NLES_TIMES))
-ALLOCATE(XLES_RADEFF (NLES_K,NLES_TIMES))
-!
-XLES_UW0 = XUNDEF
-XLES_VW0 = XUNDEF
-XLES_USTAR = XUNDEF
-XLES_WSTAR = XUNDEF
-XLES_Q0 = XUNDEF
-XLES_E0 = XUNDEF
-XLES_SV0 = XUNDEF
-XLES_BL_HEIGHT = XUNDEF
-XLES_MO_LENGTH = XUNDEF
-XLES_ZCB = XUNDEF
-XLES_CFtot = XUNDEF
-XLES_CF2tot = XUNDEF
-XLES_LWP = XUNDEF
-XLES_LWPVAR = XUNDEF
-XLES_RWP = XUNDEF
-XLES_IWP = XUNDEF
-XLES_SWP = XUNDEF
-XLES_GWP = XUNDEF
-XLES_HWP = XUNDEF
-XLES_INT_TKE = XUNDEF
-XLES_ZMAXCF = XUNDEF
-XLES_ZMAXCF2 = XUNDEF
-XLES_PRECFR = XUNDEF
-XLES_ACPRR = XUNDEF
-XLES_INPRR = XUNDEF
-XLES_INPRC = XUNDEF
-XLES_INDEP = XUNDEF
-XLES_RAIN_INPRR = XUNDEF
-XLES_SWU = XUNDEF
-XLES_SWD = XUNDEF
-XLES_LWU = XUNDEF
-XLES_LWD = XUNDEF
-XLES_DTHRADSW = XUNDEF
-XLES_DTHRADLW = XUNDEF
-XLES_RADEFF = XUNDEF
-!
-!-------------------------------------------------------------------------------
-!
-!* 9. Allocations of the normalization variables temporal series
-! ----------------------------------------------------------
-!
-! 9.1 Two-points correlations in I direction
-! --------------------------------------
-!
-ALLOCATE(XCORRi_UU (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between u and u
-ALLOCATE(XCORRi_VV (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between v and v
-ALLOCATE(XCORRi_UV (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between u and v
-ALLOCATE(XCORRi_WU (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between w and u
-ALLOCATE(XCORRi_WV (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between w and v
-ALLOCATE(XCORRi_WW (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between w and w
-ALLOCATE(XCORRi_WTh (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between w and theta
-ALLOCATE(XCORRi_ThTh (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between theta and theta
-IF (LUSERC) THEN
- ALLOCATE(XCORRi_WThl (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between w and thetal
- ALLOCATE(XCORRi_ThlThl(NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between thetal and thetal
-ELSE
- ALLOCATE(XCORRi_WThl (0,0,0))
- ALLOCATE(XCORRi_ThlThl(0,0,0))
-END IF
-
-
-IF (LUSERV ) THEN
- ALLOCATE(XCORRi_WRv (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between w and Rv
- ALLOCATE(XCORRi_ThRv (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between theta and Rv
- IF (LUSERC) THEN
- ALLOCATE(XCORRi_ThlRv(NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between thetal and Rv
- ELSE
- ALLOCATE(XCORRi_ThlRv(0,0,0))
- END IF
- ALLOCATE(XCORRi_RvRv (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between Rv and Rv
-ELSE
- ALLOCATE(XCORRi_WRv (0,0,0))
- ALLOCATE(XCORRi_ThRv (0,0,0))
- ALLOCATE(XCORRi_ThlRv(0,0,0))
- ALLOCATE(XCORRi_RvRv (0,0,0))
-END IF
-
-IF (LUSERC ) THEN
- ALLOCATE(XCORRi_WRc (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between w and Rc
- ALLOCATE(XCORRi_ThRc (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between theta and Rc
- ALLOCATE(XCORRi_ThlRc(NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between thetal and Rc
- ALLOCATE(XCORRi_RcRc (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between Rc and Rc
-ELSE
- ALLOCATE(XCORRi_WRc (0,0,0))
- ALLOCATE(XCORRi_ThRc (0,0,0))
- ALLOCATE(XCORRi_ThlRc(0,0,0))
- ALLOCATE(XCORRi_RcRc (0,0,0))
-END IF
-
-IF (LUSERI ) THEN
- ALLOCATE(XCORRi_WRi (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between w and Ri
- ALLOCATE(XCORRi_ThRi (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between theta and Rc
- ALLOCATE(XCORRi_ThlRi(NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between thetal and Rc
- ALLOCATE(XCORRi_RiRi (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES)) ! between Rc and Rc
-ELSE
- ALLOCATE(XCORRi_WRi (0,0,0))
- ALLOCATE(XCORRi_ThRi (0,0,0))
- ALLOCATE(XCORRi_ThlRi(0,0,0))
- ALLOCATE(XCORRi_RiRi (0,0,0))
-END IF
-
-IF (NSV>0 ) THEN
- ALLOCATE(XCORRi_WSv (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES,NSV)) ! between w and Sv
- ALLOCATE(XCORRi_SvSv (NSPECTRA_NI,NSPECTRA_K,NLES_TIMES,NSV)) ! between Sv and Sv
-ELSE
- ALLOCATE(XCORRi_WSv (0,0,0,0))
- ALLOCATE(XCORRi_SvSv (0,0,0,0))
-END IF
-!
-!
-XCORRi_UU = XUNDEF
-XCORRi_VV = XUNDEF
-XCORRi_UV = XUNDEF
-XCORRi_WU = XUNDEF
-XCORRi_WV = XUNDEF
-XCORRi_WW = XUNDEF
-XCORRi_WTh = XUNDEF
-IF (LUSERC ) XCORRi_WThl= XUNDEF
-IF (LUSERV ) XCORRi_WRv = XUNDEF
-IF (LUSERC ) XCORRi_WRc = XUNDEF
-IF (LUSERI ) XCORRi_WRi = XUNDEF
-IF (NSV>0 ) XCORRi_WSv = XUNDEF
-XCORRi_ThTh = XUNDEF
-IF (LUSERC ) XCORRi_ThlThl= XUNDEF
-IF (LUSERV ) XCORRi_ThRv = XUNDEF
-IF (LUSERC ) XCORRi_ThRc = XUNDEF
-IF (LUSERI ) XCORRi_ThRi = XUNDEF
-IF (LUSERC ) XCORRi_ThlRv= XUNDEF
-IF (LUSERC ) XCORRi_ThlRc= XUNDEF
-IF (LUSERI ) XCORRi_ThlRi= XUNDEF
-IF (LUSERV ) XCORRi_RvRv = XUNDEF
-IF (LUSERC ) XCORRi_RcRc = XUNDEF
-IF (LUSERI ) XCORRi_RiRi = XUNDEF
-IF (NSV>0 ) XCORRi_SvSv = XUNDEF
-!
-!
-! 9.2 Two-points correlations in J direction
-! --------------------------------------
-!
-ALLOCATE(XCORRj_UU (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between u and u
-ALLOCATE(XCORRj_VV (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between v and v
-ALLOCATE(XCORRj_UV (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between u and v
-ALLOCATE(XCORRj_WU (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between w and u
-ALLOCATE(XCORRj_WV (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between w and v
-ALLOCATE(XCORRj_WW (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between w and w
-ALLOCATE(XCORRj_WTh (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between w and theta
-ALLOCATE(XCORRj_ThTh (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between theta and theta
-IF (LUSERC) THEN
- ALLOCATE(XCORRj_WThl (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between w and thetal
- ALLOCATE(XCORRj_ThlThl(NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between thetal and thetal
-ELSE
- ALLOCATE(XCORRj_WThl (0,0,0))
- ALLOCATE(XCORRj_ThlThl(0,0,0))
-END IF
-
-IF (LUSERV ) THEN
- ALLOCATE(XCORRj_WRv (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between w and Rv
- ALLOCATE(XCORRj_ThRv (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between theta and Rv
- IF (LUSERC) THEN
- ALLOCATE(XCORRj_ThlRv(NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between thetal and Rv
- ELSE
- ALLOCATE(XCORRj_ThlRv(0,0,0))
- END IF
- ALLOCATE(XCORRj_RvRv (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between Rv and Rv
-ELSE
- ALLOCATE(XCORRj_WRv (0,0,0))
- ALLOCATE(XCORRj_ThRv (0,0,0))
- ALLOCATE(XCORRj_ThlRv(0,0,0))
- ALLOCATE(XCORRj_RvRv (0,0,0))
-END IF
-
-IF (LUSERC ) THEN
- ALLOCATE(XCORRj_WRc (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between w and Rc
- ALLOCATE(XCORRj_ThRc (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between theta and Rc
- ALLOCATE(XCORRj_ThlRc(NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between thetal and Rc
- ALLOCATE(XCORRj_RcRc (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between Rc and Rc
-ELSE
- ALLOCATE(XCORRj_WRc (0,0,0))
- ALLOCATE(XCORRj_ThRc (0,0,0))
- ALLOCATE(XCORRj_ThlRc(0,0,0))
- ALLOCATE(XCORRj_RcRc (0,0,0))
-END IF
-
-IF (LUSERI ) THEN
- ALLOCATE(XCORRj_WRi (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between w and Ri
- ALLOCATE(XCORRj_ThRi (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between theta and Rc
- ALLOCATE(XCORRj_ThlRi(NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between thetal and Rc
- ALLOCATE(XCORRj_RiRi (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES)) ! between Rc and Rc
-ELSE
- ALLOCATE(XCORRj_WRi (0,0,0))
- ALLOCATE(XCORRj_ThRi (0,0,0))
- ALLOCATE(XCORRj_ThlRi(0,0,0))
- ALLOCATE(XCORRj_RiRi (0,0,0))
-END IF
-
-IF (NSV>0 ) THEN
- ALLOCATE(XCORRj_WSv (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES,NSV)) ! between w and Sv
- ALLOCATE(XCORRj_SvSv (NSPECTRA_NJ,NSPECTRA_K,NLES_TIMES,NSV)) ! between Sv and Sv
-ELSE
- ALLOCATE(XCORRj_WSv (0,0,0,0))
- ALLOCATE(XCORRj_SvSv (0,0,0,0))
-END IF
-!
-!
-XCORRj_UU = XUNDEF
-XCORRj_VV = XUNDEF
-XCORRj_UV = XUNDEF
-XCORRj_WU = XUNDEF
-XCORRj_WV = XUNDEF
-XCORRj_WW = XUNDEF
-XCORRj_WTh = XUNDEF
-IF (LUSERC ) XCORRj_WThl= XUNDEF
-IF (LUSERV ) XCORRj_WRv = XUNDEF
-IF (LUSERC ) XCORRj_WRc = XUNDEF
-IF (LUSERI ) XCORRj_WRi = XUNDEF
-IF (NSV>0 ) XCORRj_WSv = XUNDEF
-XCORRj_ThTh = XUNDEF
-IF (LUSERC ) XCORRj_ThlThl= XUNDEF
-IF (LUSERV ) XCORRj_ThRv = XUNDEF
-IF (LUSERC ) XCORRj_ThRc = XUNDEF
-IF (LUSERI ) XCORRj_ThRi = XUNDEF
-IF (LUSERC ) XCORRj_ThlRv= XUNDEF
-IF (LUSERC ) XCORRj_ThlRc= XUNDEF
-IF (LUSERI ) XCORRj_ThlRi= XUNDEF
-IF (LUSERV ) XCORRj_RvRv = XUNDEF
-IF (LUSERC ) XCORRj_RcRc = XUNDEF
-IF (LUSERI ) XCORRj_RiRi = XUNDEF
-IF (NSV>0 ) XCORRj_SvSv = XUNDEF
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE INI_LES_n
diff --git a/src/mesonh/ext/ini_micron.f90 b/src/mesonh/ext/ini_micron.f90
deleted file mode 100644
index a4934ed55d020c7cdee8d443fa663083e790f54d..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/ini_micron.f90
+++ /dev/null
@@ -1,327 +0,0 @@
-!MNH_LIC Copyright 2002-2021 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ########################
- MODULE MODI_INI_MICRO_n
-! ########################
-!
-INTERFACE
- SUBROUTINE INI_MICRO_n ( TPINIFILE,KLUOUT )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
-INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
-!
-END SUBROUTINE INI_MICRO_n
-!
-END INTERFACE
-!
-END MODULE MODI_INI_MICRO_n
-! ############################################
- SUBROUTINE INI_MICRO_n ( TPINIFILE,KLUOUT )
-! ############################################
-!
-!
-!!**** *INI_MICRO_n* allocates and fills MODD_PRECIP_n variables
-!! and initialize parameter for microphysical scheme
-!!
-!! PURPOSE
-!! -------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! P. Jabouille
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 27/11/02
-!! O.Geoffroy (03/2006) : Add KHKO scheme
-!! Modification 01/2016 (JP Pinty) Add LIMA
-!! C.LAc 10/2016 Add budget for droplet deposition
-! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 01/2019: bugfix: add missing allocations
-! C. Lac 02/2020: add missing allocation of INPRC and ACPRC with deposition
-! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
-! P. Wautelet 04/06/2020: bugfix: correct bounds of passed arrays
-! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE MODD_CONF, ONLY : CCONF,CPROGRAM
-USE MODD_IO, ONLY : TFILEDATA
-USE MODD_GET_n, ONLY : CGETRCT,CGETRRT, CGETRST, CGETRGT, CGETRHT, CGETCLOUD
-USE MODD_DIM_n, ONLY : NIMAX_ll, NJMAX_ll
-USE MODD_PARAMETERS, ONLY : JPVEXT, JPHEXT
-USE MODD_PARAM_n, ONLY : CCLOUD
-USE MODD_PRECIP_n, ONLY : XINPRR, XACPRR, XINPRS, XACPRS, XINPRG, XACPRG, &
- XINPRH, XACPRH, XINPRC, XACPRC, XINPRR3D, XEVAP3D,&
- XINDEP,XACDEP
-USE MODD_FIELD_n, ONLY : XRT, XSVT, XTHT, XPABST, XTHM, XRCM
-USE MODD_GRID_n, ONLY : XZZ
-USE MODD_METRICS_n, ONLY : XDXX,XDYY,XDZZ,XDZX,XDZY
-USE MODD_REF_n, ONLY : XRHODREF
-USE MODD_DYN_n, ONLY : XTSTEP
-USE MODD_CLOUDPAR_n, ONLY : NSPLITR, NSPLITG
-USE MODD_PARAM_n, ONLY : CELEC
-USE MODD_PARAM_ICE_n, ONLY : LSEDIC, LDEPOSC
-USE MODD_PARAM_C2R2, ONLY : LSEDC, LACTIT, LDEPOC
-USE MODD_BLOWSNOW
-USE MODD_BLOWSNOW_n
-!
-USE MODI_READ_PRECIP_FIELD
-USE MODI_INI_CLOUD
-USE MODE_INI_RAIN_ICE, ONLY: INI_RAIN_ICE
-USE MODI_INI_RAIN_C2R2
-USE MODI_INI_ICE_C1R3
-USE MODI_CLEAN_CONC_RAIN_C2R2
-USE MODI_SET_CONC_RAIN_C2R2
-USE MODI_CLEAN_CONC_ICE_C1R3
-USE MODI_SET_CONC_ICE_C1R3
-!
-USE MODE_ll
-USE MODE_MODELN_HANDLER
-USE MODE_BLOWSNOW_SEDIM_LKT
-USE MODE_SET_CONC_LIMA
-!
-USE MODD_NSV, ONLY : NSV,NSV_CHEM,NSV_C2R2BEG,NSV_C2R2END, &
- NSV_C1R3BEG,NSV_C1R3END, &
- NSV_LIMA_BEG, NSV_LIMA_END
-USE MODD_PARAM_LIMA, ONLY : LSCAV, MSEDC=>LSEDC, MACTIT=>LACTIT, MDEPOC=>LDEPOC
-USE MODD_LIMA_PRECIP_SCAVENGING_n
-!
-USE MODI_INIT_AEROSOL_CONCENTRATION
-USE MODE_INI_LIMA, ONLY: INI_LIMA
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
-INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
-!
-! 0.2 declaration of local variables
-!
-!
-!
-INTEGER :: IIU ! Upper dimension in x direction (local)
-INTEGER :: IJU ! Upper dimension in y direction (local)
-INTEGER :: IKU ! Upper dimension in z direction
-INTEGER :: JK ! loop vertical index
-INTEGER :: IINFO_ll! Return code of //routines
-INTEGER :: IKB,IKE
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDZ ! mesh size
-REAL :: ZDZMIN
-INTEGER :: IMI
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. PROLOGUE
-!
-!
-CALL GET_DIM_EXT_ll('B',IIU,IJU)
-IKU=SIZE(XZZ,3)
-IMI = GET_CURRENT_MODEL_INDEX()
-!
-!
-!* 2. ALLOCATE Module MODD_PRECIP_n
-! ------------------------------
-!
-IF (CCLOUD /= 'NONE' .AND. CCLOUD /= 'REVE') THEN
- ALLOCATE(XINPRR(IIU,IJU))
- ALLOCATE(XINPRR3D(IIU,IJU,IKU))
- ALLOCATE(XEVAP3D(IIU,IJU,IKU))
- ALLOCATE(XACPRR(IIU,IJU))
- XINPRR(:,:)=0.0
- XACPRR(:,:)=0.0
- XINPRR3D(:,:,:)=0.0
- XEVAP3D(:,:,:)=0.0
-ELSE
- ALLOCATE(XINPRR(0,0))
- ALLOCATE(XINPRR3D(0,0,0))
- ALLOCATE(XEVAP3D(0,0,0))
- ALLOCATE(XACPRR(0,0))
-END IF
-!
-IF (( CCLOUD(1:3) == 'ICE' .AND.(LSEDIC .OR. LDEPOSC)) .OR. &
- ((CCLOUD=='C2R2' .OR. CCLOUD=='C3R5' .OR. CCLOUD=='KHKO').AND.(LSEDC .OR. LDEPOC)) .OR. &
- ( CCLOUD=='LIMA' .AND.(MSEDC .OR. MDEPOC))) THEN
- ALLOCATE(XINPRC(IIU,IJU))
- ALLOCATE(XACPRC(IIU,IJU))
- XINPRC(:,:)=0.0
- XACPRC(:,:)=0.0
-ELSE
- ALLOCATE(XINPRC(0,0))
- ALLOCATE(XACPRC(0,0))
-END IF
-!
-IF (( CCLOUD(1:3) == 'ICE' .AND.LDEPOSC) .OR. &
- ((CCLOUD=='C2R2' .OR. CCLOUD=='KHKO').AND.LDEPOC) .OR. &
- ( CCLOUD=='LIMA' .AND.MDEPOC)) THEN
- ALLOCATE(XINDEP(IIU,IJU))
- ALLOCATE(XACDEP(IIU,IJU))
- XINDEP(:,:)=0.0
- XACDEP(:,:)=0.0
-ELSE
- ALLOCATE(XINDEP(0,0))
- ALLOCATE(XACDEP(0,0))
-END IF
-!
-IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'LIMA') THEN
- ALLOCATE(XINPRS(IIU,IJU))
- ALLOCATE(XACPRS(IIU,IJU))
- XINPRS(:,:)=0.0
- XACPRS(:,:)=0.0
-ELSE
- ALLOCATE(XINPRS(0,0))
- ALLOCATE(XACPRS(0,0))
- END IF
-!
-IF (CCLOUD == 'C3R5' .OR. CCLOUD(1:3) == 'ICE'.OR. CCLOUD == 'LIMA') THEN
- ALLOCATE(XINPRG(IIU,IJU))
- ALLOCATE(XACPRG(IIU,IJU))
- XINPRG(:,:)=0.0
- XACPRG(:,:)=0.0
-ELSE
- ALLOCATE(XINPRG(0,0))
- ALLOCATE(XACPRG(0,0))
-END IF
-!
-IF (CCLOUD =='ICE4' .OR. CCLOUD == 'LIMA') THEN
- ALLOCATE(XINPRH(IIU,IJU))
- ALLOCATE(XACPRH(IIU,IJU))
- XINPRH(:,:)=0.0
- XACPRH(:,:)=0.0
-ELSE
- ALLOCATE(XINPRH(0,0))
- ALLOCATE(XACPRH(0,0))
-END IF
-!
-IF(LBLOWSNOW) THEN
- ALLOCATE(XSNWSUBL3D(IIU,IJU,IKU))
- XSNWSUBL3D(:,:,:) = 0.0
- IF(CSNOWSEDIM=='TABC') THEN
-!Read in look up tables of snow particles properties
-!No arguments, all look up tables are defined in module
-!mode_snowdrift_sedim_lkt
- CALL BLOWSNOW_SEDIM_LKT_SET
- END IF
-ELSE
- ALLOCATE(XSNWSUBL3D(0,0,0))
-END IF
-!
-!* 2b. ALLOCATION for Radiative cooling
-! ------------------------------
-IF (LACTIT .OR. MACTIT) THEN
- ALLOCATE( XTHM(IIU,IJU,IKU) )
- ALLOCATE( XRCM(IIU,IJU,IKU) )
- XTHM = XTHT
- XRCM(:,:,:) = XRT(:,:,:,2)
-ELSE
- ALLOCATE( XTHM(0,0,0) )
- ALLOCATE( XRCM(0,0,0) )
-END IF
-!
-!* 2.bis ALLOCATE Module MODD_PRECIP_SCAVENGING_n
-! ------------------------------
-!
-IF ( (CCLOUD=='LIMA') .AND. LSCAV ) THEN
- ALLOCATE(XINPAP(IIU,IJU))
- ALLOCATE(XACPAP(IIU,IJU))
- XINPAP(:,:)=0.0
- XACPAP(:,:)=0.0
-ELSE
- ALLOCATE(XINPAP(0,0))
- ALLOCATE(XACPAP(0,0))
-END IF
-!
-IF(SIZE(XINPRR) == 0) RETURN
-!
-!* 3. INITIALIZE MODD_PRECIP_n variables
-! ----------------------------------
-!
-CALL READ_PRECIP_FIELD(TPINIFILE,CPROGRAM,CCONF, &
- CGETRCT,CGETRRT,CGETRST,CGETRGT,CGETRHT, &
- XINPRC,XACPRC,XINDEP,XACDEP,XINPRR,XINPRR3D,XEVAP3D,&
- XACPRR,XINPRS,XACPRS,XINPRG,XACPRG, XINPRH,XACPRH )
-!
-!
-!* 4. INITIALIZE THE PARAMETERS FOR THE MICROPHYSICS
-! ----------------------------------------------
-!
-!
-!* 4.1 Compute the minimun vertical mesh size
-!
-ALLOCATE(ZDZ(IIU,IJU,IKU))
-ZDZ=0.
-IKB = 1 + JPVEXT
-IKE = SIZE(XZZ,3)- JPVEXT
-DO JK = IKB,IKE
- ZDZ(:,:,JK) = XZZ(:,:,JK+1) - XZZ(:,:,JK)
-END DO
-ZDZMIN = MIN_ll (ZDZ,IINFO_ll,1,1,IKB,NIMAX_ll+2*JPHEXT,NJMAX_ll+2*JPHEXT,IKE )
-DEALLOCATE(ZDZ)
-!
-IF (CCLOUD(1:3) == 'KES') THEN
- CALL INI_CLOUD(XTSTEP,ZDZMIN,NSPLITR) ! Warm cloud only
-ELSE IF (CCLOUD(1:3) == 'ICE' ) THEN
- CALL INI_RAIN_ICE(KLUOUT,XTSTEP,ZDZMIN,NSPLITR,CCLOUD) ! Mixed phase cloud
- ! including hail
-ELSE IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO') THEN
- CALL INI_RAIN_C2R2(XTSTEP,ZDZMIN,NSPLITR,CCLOUD) ! 1/2 spectral warm cloud
- IF (CCLOUD == 'C3R5') THEN
- CALL INI_ICE_C1R3(XTSTEP,ZDZMIN,NSPLITG) ! 1/2 spectral cold cloud
- END IF
-ELSE IF (CCLOUD == 'LIMA') THEN
- IF (CGETCLOUD /= 'READ') CALL INIT_AEROSOL_CONCENTRATION( XRHODREF, XSVT(:, :, :, :), XZZ(:, :, :) )
- CALL INI_LIMA(XTSTEP,ZDZMIN,NSPLITR, NSPLITG) ! 1/2 spectral warm cloud
-END IF
-!
-IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO') THEN
- IF (CGETCLOUD=='READ') THEN
- CALL CLEAN_CONC_RAIN_C2R2 (XRT,XSVT(:,:,:,NSV_C2R2BEG:NSV_C2R2END))
- ELSE IF (CGETCLOUD=='INI1'.OR.CGETCLOUD=='INI2') THEN
- CALL SET_CONC_RAIN_C2R2 (CGETCLOUD,XRHODREF,&
- &XRT,XSVT(:,:,:,NSV_C2R2BEG:NSV_C2R2END))
- ENDIF
- IF (CCLOUD == 'C3R5' ) THEN
- IF (CGETCLOUD=='READ') THEN
- CALL CLEAN_CONC_ICE_C1R3 (XRT,XSVT(:,:,:,NSV_C2R2BEG:NSV_C1R3END))
- ELSE
- CALL SET_CONC_ICE_C1R3 (XRHODREF,XRT,XSVT(:,:,:,NSV_C2R2BEG:NSV_C1R3END))
- ENDIF
- ENDIF
-ENDIF
-!
-IF (CCLOUD == 'LIMA') THEN
- IF (CGETCLOUD/='READ') THEN
- CALL SET_CONC_LIMA(IMI,CGETCLOUD,XRHODREF,XRT,XSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END))
- END IF
-END IF
-!
-!
-!* 5. INITIALIZE ATMOSPHERIC ELECTRICITY
-! ----------------------------------
-!
-!
-!IF (CELEC /= 'NONE') THEN
-! CALL INI_ELEC(IMI,TPINIFILE,XTSTEP,ZDZMIN,NSPLITR, &
-! XDXX,XDYY,XDZZ,XDZX,XDZY )
-!END IF
-!
-!
-END SUBROUTINE INI_MICRO_n
diff --git a/src/mesonh/ext/ini_modeln.f90 b/src/mesonh/ext/ini_modeln.f90
deleted file mode 100644
index edbb56091a02f205040239abed144d7a789e5473..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/ini_modeln.f90
+++ /dev/null
@@ -1,2932 +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_INI_MODEL_n
-! #######################
-!
-INTERFACE
-!
- SUBROUTINE INI_MODEL_n(KMI,TPINIFILE)
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KMI ! Model Index
-TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
-!
-END SUBROUTINE INI_MODEL_n
-!
-END INTERFACE
-!
-END MODULE MODI_INI_MODEL_n
-! ############################################
- SUBROUTINE INI_MODEL_n(KMI,TPINIFILE)
-! ############################################
-!
-!!**** *INI_MODEL_n* - routine to initialize the nested model _n
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to initialize the variables
-! of the nested model _n.
-!
-!!** METHOD
-!! ------
-!! The initialization of the model _n is performed as follows :
-!! - Memory for arrays are then allocated :
-!! * If turbulence kinetic energy variable is not needed
-!! (CTURB='NONE'), XTKET, XTKEM and XTKES are zero-size arrays.
-!! * If dissipation of TKE variable is not needed
-!! (CTURBLEN /='KEPS'), XEPST, XEPSM and XREPSS are zero-size arrays.
-!! * Memory for mixing ratio arrays is allocated according to the
-!! value of logicals LUSERn (the number NRR of moist variables is deduced).
-!! * The latitude (XLAT), longitude (XLON) and map factor (XMAP)
-!! arrays are zero-size arrays if Cartesian geometry (LCARTESIAN=.TRUE.)
-!! * Memory for reference state without orography ( XRHODREFZ and
-!! XTHVREFZ) is only allocated in INI_MODEL1
-!! * The horizontal Coriolis parameters (XCORIOX and XCORIOY) arrays
-!! are zero-size arrays if thinshell approximation (LTHINSHELL=.TRUE.)
-!! * The Curvature coefficients (XCURVX and XCURVY) arrays
-!! are zero-size arrays if Cartesian geometry (LCARTESIAN=.TRUE.)
-!! * Memory for the Jacobian (ZJ) local array is allocated
-!! (This variable is computed in SET_GRID and used in SET_REF).
-!! - The spatial and temporal grid variables are initialized by SET_GRID.
-!! - The metric coefficients are computed by METRICS (they are using in
-!! the SET-REF call).
-!! - The prognostic variables and are read in initial
-!! LFIFM file (in READ_FIELD)
-!! - The reference state variables are initialized by SET_REF.
-!! - The temporal indexes of the outputs are computed by SET_OUTPUT_TIMES
-!! - The large scale sources are computed in case of coupling case by
-!! INI_CPL.
-!! - The initialization of the parameters needed for the dynamics
-!! of the model n is realized in INI_DYNAMICS.
-!! - Then the initial file (DESFM+LFIFM files) is closed by IO_File_close.
-!! - The initialization of the parameters needed for the ECMWF radiation
-!! code is realized in INI_RADIATIONS.
-!! - The contents of the scalar variables are overwritten by
-!! the chemistry initialization subroutine CH_INIT_FIELDn when
-!! the flags LUSECHEM and LCH_INIT_FIELD are set to TRUE.
-!! This allows easy initialization of the chemical fields at a
-!! restart of the model.
-!!
-!! EXTERNAL
-!! --------
-!! SET_DIM : to initialize dimensions
-!! SET_GRID : to initialize grid
-!! METRICS : to compute metric coefficients
-!! READ_FIELD : to initialize field
-!! FMCLOS : to close a FM-file
-!! SET_REF : to initialize reference state for anelastic approximation
-!! INI_DYNAMICS: to initialize parameters for the dynamics
-!! INI_TKE_EPS : to initialize the TKE
-!! SET_DIRCOS : to compute the director cosinus of the orography
-!! INI_RADIATIONS : to initialize radiation computations
-!! CH_INIT_CCS: to initialize the chemical core system
-!! CH_INIT_FIELDn: to (re)initialize the scalar variables
-!! INI_DEEP_CONVECTION : to initialize the deep convection scheme
-!! CLEANLIST_ll : deaalocate a list
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! Module MODD_PARAMETERS : contains declaration of parameter variables
-!! JPHEXT : Horizontal external points number
-!! JPVEXT : Vertical external points number
-!!
-!! Module MODD_MODD_DYN : contains declaration of parameters
-!! for the dynamics
-!! Module MODD_CONF : contains declaration of configuration variables
-!! for all models
-!! NMODEL : Number of nested models
-!! NVERB : Level of informations on output-listing
-!! 0 for minimum prints
-!! 5 for intermediate level of prints
-!! 10 for maximum prints
-!!
-!! Module MODD_REF : contains declaration of reference state
-!! variables for all models
-!! Module MODD_FIELD_n : contains declaration of prognostic fields
-!! Module MODD_LSFIELD_n : contains declaration of Larger Scale fields
-!! Module MODD_GRID_n : contains declaration of spatial grid variables
-!! Module MODD_TIME_n : contains declaration of temporal grid variables
-!! Module MODD_REF_n : contains declaration of reference state
-!! variables
-!! Module MODD_CURVCOR_n : contains declaration of curvature and Coriolis
-!! variables
-!! Module MODD_BUDGET : contains declarations of the budget parameters
-!! Module MODD_RADIATIONS_n:contains declaration of the variables of the
-!! radiation interface scheme
-!! Module MODD_STAND_ATM : contains declaration of the 5 standard
-!! atmospheres used for the ECMWF-radiation code
-!! Module MODD_FRC : contains declaration of the control variables
-!! and of the forcing fields
-!! Module MODD_CH_MNHC_n : contains the control parameters for chemistry
-!! Module MODD_DEEP_CONVECTION_n: contains declaration of the variables of
-!! the deep convection scheme
-!!
-!!
-!!
-!!
-!! Module MODN_CONF_n : contains declaration of namelist NAM_CONFn and
-!! uses module MODD_CONF_n (configuration variables)
-!! Module MODN_LUNIT_n : contains declaration of namelist NAM_LUNITn and
-!! uses module MODD_LUNIT_n (Logical units)
-!! Module MODN_DYN_n : contains declaration of namelist NAM_DYNn and
-!! uses module MODD_DYN_n (control of dynamics)
-!! Module MODN_PARAM_n : contains declaration of namelist NAM_PARAMn and
-!! uses module MODD_PARAM_n (control of physical
-!! parameterization)
-!! Module MODN_LBC_n : contains declaration of namelist NAM_LBCn and
-!! uses module MODD_LBC_n (lateral boundaries)
-!! Module MODN_TURB_n : contains declaration of namelist NAM_TURBn and
-!! uses module MODD_TURB_n (turbulence scheme)
-!! Module MODN_PARAM_RAD_n: contains declaration of namelist NAM_PARAM_RADn
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of documentation (routine INI_MODEL_n)
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Ducrocq * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 10/06/94
-!! Modification 17/10/94 (Stein) For LCORIO
-!! Modification 20/10/94 (Stein) For SET_GRID and NAMOUTN
-!! Modification 26/10/94 (Stein) Modifications of the namelist names
-!! Modification 10/11/94 (Lafore) allocatation of tke fields
-!! Modification 22/11/94 (Stein) change the READ_FIELDS call ( add
-!! pressure function
-!! Modification 06/12/94 (Stein) add the LS fields
-!! 12/12/94 (Stein) rename END_INI in INI_DYNAMICS
-!! Modification 09/01/95 (Stein) add the turbulence scheme
-!! Modification Jan 19, 1995 (J. Cuxart) add the TKE initialization
-!! Jan 23, 1995 (J. Stein ) remove the condition
-!! LTHINSHELL=T LCARTESIAN=T => stop
-!! Modification Feb 16, 1995 (I.Mallet) add the METRICS call and
-!! change the SET_REF call (add
-!! the lineic mass)
-!! Modification Mar 10, 1995 (I. Mallet) add the COUPLING initialization
-!! June 29,1995 (Ph. Hereil, J. Stein) add the budget init.
-!! Modification Sept. 1, 1995 (S. Belair) Reading of the surface variables
-!! and parameters for ISBA (i.e., add a
-!! CALL READ_GR_FIELD)
-!! Modification 18/08/95 (J.P.Lafore) time step change case
-!! 25/09/95 (J. Cuxart and J.Stein) add LES variables
-!! and the diachronic file initialization
-!! Modification Sept 20,1995 (Lafore) coupling for the dry mass Md
-!! Modification Sept. 12, 1995 (J.-P. Pinty) add the initialization of
-!! the ECMWF radiation code
-!! Modification Sept. 13, 1995 (J.-P. Pinty) control the allocation of the
-!! arrays of MODD_GR_FIELD_n
-!! Modification Nove. 17, 1995 (J.Stein) control of the control !!
-!! March 01, 1996 (J. Stein) add the cloud fraction
-!! April 03, 1996 (J. Stein) unify the ISBA and TSZ0 cases
-!! Modification 13/12/95 (M. Georgelin) add the forcing variables in
-!! the call read_field, and their
-!! allocation.
-!! Mai 23, 1996 (J. Stein) allocate XSEA in the TSZ0 case
-!! June 11, 1996 (V. Masson) add XSILT and XLAKE of
-!! MODD_GR_FIELD_n
-!! August 7, 1996 (K. Suhre) add (re)initialization of
-!! chemistry
-!! Octo. 11, 1996 (J. Stein ) add XSRCT and XSRCM
-!! October 8, 1996 (J. Cuxart, E. Sanchez) Moist LES diagnostics
-!! and control on TKE initialization.
-!! Modification 19/12/96 (J.-P. Pinty) add the ice parameterization and
-!! the precipitation fields
-!! Modification 11/01/97 (J.-P. Pinty) add the deep convection
-!! Nov. 1, 1996 (V. Masson) Read the vertical grid kind
-!! Nov. 20, 1996 (V. Masson) control of convection calling time
-!! July 16, 1996 (J.P.Lafore) update of EXSEG file reading
-!! Oct. 08, 1996 (J.P.Lafore, V.Masson)
-!! MY_NAME and DAD_NAME reading and check
-!! Oct. 30, 1996 (J.P.Lafore) resolution ratio reading for nesting
-!! and Bikhardt interpolation coef. initialization
-!! Nov. 22, 1996 (J.P.Lafore) allocation of LS sources for nesting
-!! Feb. 26, 1997 (J.P.Lafore) allocation of "surfacic" LS fields
-!! March 10, 1997 (J.P.Lafore) forcing only for model 1
-!! June 22, 1997 (J. Stein) add the absolute pressure
-!! July 09, 1997 (V. Masson) add directional z0 and SSO
-!! Aug. 18, 1997 (V. Masson) consistency between storage
-!! type and CCONF
-!! Dec. 22, 1997 (J. Stein) add the LS field spawning
-!! Jan. 24, 1998 (P.Bechtold) change MODD_FRC and MODD_DEEP_CONVECTION
-!! Dec. 24, 1997 (V.Masson) directional z0 parameters
-!! Aug. 13, 1998 (V. Ducrocq P Jabouille) //
-!! Mai. 26, 1998 (J. Stein) remove NXEND,NYEND
-!! Feb. 1, 1999 (J. Stein) compute the Bikhardt
-!! interpolation coeff. before the call to set_grid
-!! April 5, 1999 (V. Ducrocq) change the DXRATIO_ALL init.
-!! April 12, 1999 (J. Stein) cleaning + INI_SPAWN_LS
-!! Apr. 7, 1999 (P Jabouille) store the metric coefficients
-!! in modd_metrics_n
-!! Jui. 15,1999 (P Jabouille) split the routines in two parts
-!! Jan. 04,2000 (V. Masson) removes the TSZ0 case
-!! Apr. 15,2000 (P Jabouille) parallelization of grid nesting
-!! Aug. 20,2000 (J Stein ) tranpose XBFY
-!! Jui 01,2000 (F.solmon ) adapatation for patch approach
-!! Jun. 15,2000 (J.-P. Pinty) add C2R2 initialization
-!! Nov. 15,2000 (V.Masson) use of ini_modeln in prep_real_case
-!! Nov. 15,2000 (V.Masson) call of LES routines
-!! Nov. 15,2000 (V.Masson) aircraft and balloon initialization routines
-!! Jan. 22,2001 (D.Gazen) update_nsv set NSV_* var. for current model
-!! Mar. 04,2002 (V.Ducrocq) initialization to temporal series
-!! Mar. 15,2002 (F.Solmon) modification of ini_radiation interface
-!! Nov. 29,2002 (JP Pinty) add C3R5, ICE2, ICE4, ELEC
-!! Jan. 2004 (V.Masson) externalization of surface
-!! May 2006 Remove KEPS
-!! Apr. 2010 (M. Leriche) add pH for aqueous phase chemistry
-!! Jul. 2010 (M. Leriche) add Ice phase chemistry
-!! Oct. 2010 (J.Escobar) check if local domain not to small for NRIMX NRIMY
-!! Nov. 2010 (J.Escobar) PGI BUG , add SIZE(CSV) to init_ground routine
-!! Nov. 2009 (C. Barthe) add call to INI_ELEC_n
-!! Mar. 2010 (M. Chong) add small ions
-!! Apr. 2011 (M. Chong) correction of RESTART (ELEC)
-!! June 2011 (B.Aouizerats) Prognostic aerosols
-!! June 2011 (P.Aumond) Drag of the vegetation
-!! + Mean fields
-!! July 2013 (Bosseur & Filippi) Adds Forefire
-!! P. Tulet Nov 2014 accumulated moles of aqueous species that fall at the surface
-!! JAn. 2015 (F. Brosse) bug in allocate XACPRAQ
-!! Dec 2014 (C.Lac) : For reproducibility START/RESTA
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! V. Masson Feb 2015 replaces, for aerosols, cover fractions by sea, town, bare soil fractions
-!! J.Escobar : 19/04/2016 : Pb IOZ/NETCDF , missing OPARALLELIO=.FALSE. for PGD files
-!! J.Escobar : 01/06/2016 : correct check limit of NRIM versus local subdomain size IDIM
-!! 06/2016 (G.Delautier) phasage surfex 8
-!! Modification 01/2016 (JP Pinty) Add LIMA
-!! Aug. 2016 (J.Pianezze) Add SFX_OASIS_READ_NAM function from SurfEx
-!! M.Leriche 2016 Chemistry
-!! 10/2016 M.Mazoyer New KHKO output fields
-!! 10/2016 (C.Lac) Add max values
-!! F. Brosse Oct. 2016 add prod/loss terms computation for chemistry
-!! M.Leriche 2016 Chemistry
-!! M.Leriche 10/02/17 prevent negative values in LBX(Y)SVS
-!! M.Leriche 01/07/2017 Add DIAG chimical surface fluxes
-!! 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
-!! V. Vionnet : 18/07/2017 : add blowing snow scheme
-!! 01/18 J.Colin Add DRAG
-! P. Wautelet 29/01/2019: bug: add missing zero-size allocations
-! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
-! P. Wautelet 13/02/2019: initialize XALBUV even if no radiation (needed in CH_INTERP_JVALUES)
-! P. Wautelet 13/02/2019: removed PPABSM and PTSTEP dummy arguments of READ_FIELD
-! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
-! P. Wautelet 14/02/2019: remove HINIFILE dummy argument from INI_RADIATIONS_ECMWF/ECRAD
-!! 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 14/03/2019: correct ZWS when variable not present in file (set to XZWS_DEFAULT)
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-! P. Wautelet 19/04/2019: removed unused dummy arguments and variables
-! P. Wautelet 07/06/2019: allocate lookup tables for optical properties only when needed
-! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
-! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
-! S. Riette 04/2020: XHL* fields
-! F. Auguste 02/2021: add IBM
-! T.Nigel 02/2021: add turbulence recycling
-! J.L.Redelsperger 06/2011: OCEAN case
-! A. Costes 12/2021: Blaze fire model
-!---------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-#ifdef MNH_ECRAD
-USE YOERDI, only: RCCO2
-#endif
-
-USE MODD_2D_FRC
-USE MODD_ADVFRC_n
-USE MODD_ADV_n
-use MODD_AEROSET, only: POLYTAU, POLYSSA, POLYG
-USE MODD_ARGSLIST_ll, only: LIST_ll
-USE MODD_BIKHARDT_n
-USE MODD_BLOWSNOW
-USE MODD_BLOWSNOW_n
-USE MODD_BUDGET
-USE MODD_CH_AERO_n, only: XSOLORG,XMI
-USE MODD_CH_AEROSOL, only: LORILAM
-USE MODD_CH_BUDGET_n
-USE MODD_CH_FLX_n, only: XCHFLX
-USE MODD_CH_M9_n, only:NNONZEROTERMS
-USE MODD_CH_MNHC_n, only: LUSECHEM, LUSECHAQ, LUSECHIC, LCH_INIT_FIELD, &
- LCH_CONV_LINOX, XCH_TUV_DOBNEW, LCH_PH
-USE MODD_CH_PH_n
-USE MODD_CH_PRODLOSSTOT_n
-USE MODD_CLOUD_MF_n
-USE MODD_CONF
-USE MODD_CONF_n
-USE MODD_CST
-USE MODD_CTURB
-USE MODD_CURVCOR_n
-USE MODD_DEEP_CONVECTION_n
-USE MODD_DEF_EDDY_FLUX_n ! for VT and WT fluxes
-USE MODD_DEF_EDDYUV_FLUX_n ! FOR UV
-USE MODD_DIAG_FLAG, only: LCHEMDIAG, CSPEC_BU_DIAG
-USE MODD_DIM_n
-USE MODD_DRAG_n
-USE MODD_DRAGTREE_n
-USE MODD_DUST
-use MODD_DUST_OPT_LKT, only: NMAX_RADIUS_LKT_DUST=>NMAX_RADIUS_LKT, NMAX_SIGMA_LKT_DUST=>NMAX_SIGMA_LKT, &
- NMAX_WVL_SW_DUST=>NMAX_WVL_SW, &
- XEXT_COEFF_WVL_LKT_DUST=>XEXT_COEFF_WVL_LKT, XEXT_COEFF_550_LKT_DUST=>XEXT_COEFF_550_LKT, &
- XPIZA_LKT_DUST=>XPIZA_LKT, XCGA_LKT_DUST=>XCGA_LKT
-USE MODD_DYN
-USE MODD_DYN_n
-USE MODD_DYNZD
-USE MODD_DYNZD_n
-USE MODD_ELEC_n, only: XCION_POS_FW, XCION_NEG_FW
-USE MODD_EOL_MAIN
-USE MODD_FIELD_n
-#ifdef MNH_FOREFIRE
-USE MODD_FOREFIRE
-USE MODD_FOREFIRE_n
-#endif
-USE MODD_FRC
-USE MODD_FRC_n
-USE MODD_GET_n
-USE MODD_GRID_n
-USE MODD_GRID, only: XLONORI,XLATORI
-USE MODD_IBM_PARAM_n, only: LIBM, XIBM_IEPS, XIBM_LS, XIBM_XMUT
-USE MODD_IO, only: CIO_DIR, TFILEDATA, TFILE_DUMMY
-USE MODD_IO_SURF_MNH, only: IO_SURF_MNH_MODEL
-USE MODD_LATZ_EDFLX
-USE MODD_LBC_n, only: CLBCX, CLBCY
-use modd_les
-USE MODD_LSFIELD_n
-USE MODD_LUNIT_n
-USE MODD_MEAN_FIELD
-USE MODD_MEAN_FIELD_n
-USE MODD_METRICS_n
-USE MODD_MNH_SURFEX_n
-USE MODD_NESTING, only: CDAD_NAME, NDAD, NDT_2_WAY, NDTRATIO, NDXRATIO_ALL, NDYRATIO_ALL
-USE MODD_NSV
-USE MODD_NSV
-USE MODD_NUDGING_n, only: LNUDGING
-USE MODD_OCEANH
-USE MODD_OUT_n
-USE MODD_PARAMETERS
-USE MODD_PARAM_KAFR_n
-USE MODD_PARAM_MFSHALL_n
-USE MODD_PARAM_n
-USE MODD_PARAM_RAD_n, only: CAER, CAOP, CLW
-USE MODD_PASPOL
-USE MODD_PASPOL_n
-USE MODD_PAST_FIELD_n
-use modd_precision, only: LFIINT
-USE MODD_RADIATIONS_n
-USE MODD_RECYCL_PARAM_n
-USE MODD_REF
-USE MODD_REF_n
-USE MODD_RELFRC_n
-use MODD_SALT, only: LSALT
-use MODD_SALT_OPT_LKT, only: NMAX_RADIUS_LKT_SALT=>NMAX_RADIUS_LKT, NMAX_SIGMA_LKT_SALT=>NMAX_SIGMA_LKT, &
- NMAX_WVL_SW_SALT=>NMAX_WVL_SW, &
- XEXT_COEFF_WVL_LKT_SALT=>XEXT_COEFF_WVL_LKT, XEXT_COEFF_550_LKT_SALT=>XEXT_COEFF_550_LKT, &
- XPIZA_LKT_SALT=>XPIZA_LKT, XCGA_LKT_SALT=>XCGA_LKT
-USE MODD_SERIES, only: LSERIES
-USE MODD_SHADOWS_n
-USE MODD_STAND_ATM, only: XSTROATM, XSMLSATM, XSMLWATM, XSPOSATM, XSPOWATM
-USE MODD_SURF_PAR, only: XUNDEF_SFX => XUNDEF
-USE MODD_TIME
-USE MODD_TIME_n
-USE MODD_TURB_n
-USE MODD_NEB_n, only: LSUBG_COND, LSTATNW
-USE MODD_VAR_ll, only: IP
-
-USE MODE_GATHER_ll
-USE MODE_INI_AIRCRAFT_BALLOON, only: INI_AIRCRAFT_BALLOON
-use mode_ini_budget, only: Budget_preallocate, Ini_budget
-USE MODE_INI_ONE_WAY_n
-USE MODE_IO
-USE MODE_IO_FIELD_READ, only: IO_Field_read
-USE MODE_IO_FILE, only: IO_File_open
-USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
-USE MODE_ll
-USE MODE_MODELN_HANDLER
-USE MODE_MPPDB
-USE MODE_MSG
-USE MODE_SET_GRID
-USE MODE_SPLITTINGZ_ll, only: GET_DIM_EXTZ_ll
-USE MODE_TYPE_ZDIFFU
-USE MODE_FIELD, ONLY: INI_FIELD_LIST
-
-USE MODI_CH_AER_MOD_INIT
-USE MODI_CH_INIT_BUDGET_n
-USE MODI_CH_INIT_FIELD_n
-USE MODI_CH_INIT_JVALUES
-USE MODI_CH_INIT_PRODLOSSTOT_n
-USE MODI_GET_SIZEX_LB
-USE MODI_GET_SIZEY_LB
-USE MODI_INI_AEROSET1
-USE MODI_INI_AEROSET2
-USE MODI_INI_AEROSET3
-USE MODI_INI_AEROSET4
-USE MODI_INI_AEROSET5
-USE MODI_INI_AEROSET6
-USE MODI_INI_BIKHARDT_n
-USE MODI_INI_CPL
-USE MODI_INI_DEEP_CONVECTION
-USE MODI_INI_DRAG
-USE MODI_INI_DYNAMICS
-USE MODI_INI_ELEC_n
-USE MODI_INI_EOL_ADNR
-USE MODI_INI_EOL_ALM
-USE MODI_INI_LES_N
-USE MODI_INI_LG
-USE MODI_INI_LW_SETUP
-USE MODI_INI_MICRO_n
-USE MODE_INI_TURB, ONLY: INI_TURB
-USE MODE_INI_MFSHALL, ONLY: INI_MFSHALL
-USE MODI_INI_POSPROFILER_n
-USE MODI_INI_RADIATIONS
-USE MODI_INI_RADIATIONS_ECMWF
-USE MODI_INI_RADIATIONS_ECRAD
-USE MODI_INI_SERIES_N
-USE MODI_INI_SPAWN_LS_n
-USE MODI_INI_SURF_RAD
-USE MODI_INI_SURFSTATION_n
-USE MODI_INI_SW_SETUP
-USE MODE_INIT_AEROSOL_PROPERTIES, ONLY: INIT_AEROSOL_PROPERTIES
-#ifdef MNH_FOREFIRE
-USE MODI_INIT_FOREFIRE_n
-#endif
-USE MODI_INIT_GROUND_PARAM_n
-USE MODI_INI_TKE_EPS
-USE MODI_METRICS
-USE MODI_MNHGET_SURF_PARAM_n
-USE MODI_MNHREAD_ZS_DUMMY_n
-USE MODI_READ_FIELD
-USE MODI_SET_DIRCOS
-USE MODI_SET_REF
-#ifdef CPLOASIS
-USE MODI_SFX_OASIS_READ_NAM
-#endif
-USE MODI_SUNPOS_n
-USE MODI_SURF_SOLAR_GEOM
-USE MODI_UPDATE_METRICS
-USE MODI_UPDATE_NSV
-#ifdef MNH_ECRAD
-#if ( VER_ECRAD == 140 )
-USE YOERDI , ONLY :RCCO2
-#endif
-#endif
-!
-USE MODD_FIRE_n
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-INTEGER, INTENT(IN) :: KMI ! Model Index
-TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
-!
-!* 0.2 declarations of local variables
-!
-REAL, PARAMETER :: NALBUV_DEFAULT = 0.01 ! Arbitrary low value for XALBUV
-!
-INTEGER :: JSV ! Loop index
-INTEGER :: IRESP ! Return code of FM routines
-INTEGER :: ILUOUT ! Logical unit number of output-listing
-CHARACTER(LEN=28) :: YNAME
-INTEGER :: IIU ! Upper dimension in x direction (local)
-INTEGER :: IJU ! Upper dimension in y direction (local)
-INTEGER :: IIU_ll ! Upper dimension in x direction (global)
-INTEGER :: IJU_ll ! Upper dimension in y direction (global)
-INTEGER :: IKU ! Upper dimension in z direction
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZJ ! Jacobian
-LOGICAL :: GINIDCONV ! logical switch for the deep convection
- ! initialization
-LOGICAL :: GINIRAD ! logical switch for the radiation
- ! initialization
-logical :: gles ! Logical to determine if LES diagnostics are enabled
-!
-!
-TYPE(LIST_ll), POINTER :: TZINITHALO2D_ll ! pointer for the list of 2D fields
- ! which must be communicated in INIT
-TYPE(LIST_ll), POINTER :: TZINITHALO3D_ll ! pointer for the list of 3D fields
- ! which must be communicated in INIT
-!
-INTEGER :: IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU ! dimensions of the
-INTEGER :: IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2 ! West-east LB arrays
-INTEGER :: IISIZEYF,IJSIZEYF,IISIZEYFV,IJSIZEYFV ! dimensions of the
-INTEGER :: IISIZEY4,IJSIZEY4,IISIZEY2,IJSIZEY2 ! North-south LB arrays
-INTEGER :: IINFO_ll ! Return code of //routines
-INTEGER :: IIY,IJY
-INTEGER :: IIU_B,IJU_B
-INTEGER :: IIU_SXP2_YP1_Z_ll,IJU_SXP2_YP1_Z_ll,IKU_SXP2_YP1_Z_ll
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZCO2 ! CO2 concentration near the surface
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSEA ! sea fraction
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZTOWN ! town fraction
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZBARE ! bare soil fraction
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDIR_ALB ! direct albedo
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSCA_ALB ! diffuse albedo
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEMIS ! emissivity
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZTSRAD ! surface temperature
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZIBM_LS ! LevelSet IBM
-!
-!
-INTEGER, DIMENSION(:,:),ALLOCATABLE :: IINDEX ! indices of non-zero terms
-INTEGER, DIMENSION(:),ALLOCATABLE :: IIND
-INTEGER :: JM, JT
-!
-!------------------------------------------
-! 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
-!
-INTEGER :: IIB,IJB,IIE,IJE,IDIMX,IDIMY,IMI
-! Fire model
-INTEGER :: INBPARAMSENSIBLE, INBPARAMLATENT
-!-------------------------------------------------------------------------------
-!
-!* 0. PROLOGUE
-! --------
-! Compute relaxation coefficients without changing INI_DYNAMICS nor RELAXDEF
-!
-IF (CCLOUD == 'LIMA') THEN
- LHORELAX_SVC1R3=LHORELAX_SVLIMA
-END IF
-!
-! UPDATE CONSTANTS FOR OCEAN MODEL
-IF (LOCEAN) THEN
- XP00=XP00OCEAN
- XTH00=XTH00OCEAN
-END IF
-!
-!
-NULLIFY(TZINITHALO2D_ll)
-NULLIFY(TZINITHALO3D_ll)
-!
-!* 1. RETRIEVE LOGICAL UNIT NUMBER
-! ----------------------------
-!
-ILUOUT = TLUOUT%NLU
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. END OF READING
-! --------------
-!* 2.1 Read number of forcing fields
-!
-IF (LFORCING) THEN ! Retrieve the number of time-dependent forcings.
- CALL IO_Field_read(TPINIFILE,'FRC',NFRC,IRESP)
- IF ( (IRESP /= 0) .OR. (NFRC <=0) ) THEN
- WRITE(ILUOUT,'(A/A)') &
- "INI_MODEL_n ERROR: you want to read forcing variables from FMfile", &
- " but no fields have been found by IO_Field_read"
-!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_MODEL_n','')
- END IF
-END IF
-!
-! Modif PP for time evolving adv forcing
- IF ( L2D_ADV_FRC ) THEN ! Retrieve the number of time-dependent forcings.
- WRITE(ILUOUT,FMT=*) "INI_MODEL_n ENTER ADV_FORCING"
- CALL IO_Field_read(TPINIFILE,'NADVFRC1',NADVFRC,IRESP)
- IF ( (IRESP /= 0) .OR. (NADVFRC <=0) ) THEN
- WRITE(ILUOUT,'(A/A)') &
- "INI_MODELn ERROR: you want to read forcing ADV variables from FMfile", &
- " but no fields have been found by IO_Field_read"
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_MODEL_n','')
- END IF
- WRITE(ILUOUT,*) 'NADVFRC = ', NADVFRC
-END IF
-!
-IF ( L2D_REL_FRC ) THEN ! Retrieve the number of time-dependent forcings.
- WRITE(ILUOUT,FMT=*) "INI_MODEL_n ENTER REL_FORCING"
- CALL IO_Field_read(TPINIFILE,'NRELFRC1',NRELFRC,IRESP)
- IF ( (IRESP /= 0) .OR. (NRELFRC <=0) ) THEN
- WRITE(ILUOUT,'(A/A)') &
- "INI_MODELn ERROR: you want to read forcing REL variables from FMfile", &
- " but no fields have been found by IO_Field_read"
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_MODEL_n','')
- END IF
- WRITE(ILUOUT,*) 'NRELFRC = ', NRELFRC
-END IF
-!* 2.2 Checks the position of vertical absorbing layer
-!
-IKU=NKMAX+2*JPVEXT
-!
-ALLOCATE(XZHAT(IKU))
-CALL IO_Field_read(TPINIFILE,'ZHAT',XZHAT)
-CALL IO_Field_read(TPINIFILE,'ZTOP',XZTOP)
-IF (XALZBOT>=XZHAT(IKU) .AND. LVE_RELAX) THEN
- WRITE(ILUOUT,FMT=*) "INI_MODEL_n ERROR: you want to use vertical relaxation"
- WRITE(ILUOUT,FMT=*) " but bottom of layer XALZBOT(",XALZBOT,")"
- WRITE(ILUOUT,FMT=*) " is upper than model top (",XZHAT(IKU),")"
-!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_MODEL_n','')
-END IF
-IF (LVE_RELAX) THEN
- IF (XALZBOT>=XZHAT(IKU-4) ) THEN
- WRITE(ILUOUT,FMT=*) "INI_MODEL_n WARNING: you want to use vertical relaxation"
- WRITE(ILUOUT,FMT=*) " but the layer defined by XALZBOT(",XALZBOT,")"
- WRITE(ILUOUT,FMT=*) " contains less than 5 model levels"
- END IF
-END IF
-DEALLOCATE(XZHAT)
-!
-!* 2.3 Compute sizes of arrays of the extended sub-domain
-!
-CALL GET_DIM_EXT_ll('B',IIU,IJU)
-IIU_ll=NIMAX_ll + 2 * JPHEXT
-IJU_ll=NJMAX_ll + 2 * JPHEXT
-! initialize NIMAX and NJMAX for not updated versions regarding the parallelism
-! spawning,...
-CALL GET_DIM_PHYS_ll('B',NIMAX,NJMAX)
-!
-CALL GET_INDICE_ll( IIB,IJB,IIE,IJE)
-IDIMX = IIE - IIB + 1
-IDIMY = IJE - IJB + 1
-!
-NRR=0
-NRRL=0
-NRRI=0
-IF (CGETRVT /= 'SKIP' ) THEN
- NRR = NRR+1
- IDX_RVT = NRR
-END IF
-IF (CGETRCT /= 'SKIP' ) THEN
- NRR = NRR+1
- NRRL = NRRL+1
- IDX_RCT = NRR
-END IF
-IF (CGETRRT /= 'SKIP' ) THEN
- NRR = NRR+1
- NRRL = NRRL+1
- IDX_RRT = NRR
-END IF
-IF (CGETRIT /= 'SKIP' ) THEN
- NRR = NRR+1
- NRRI = NRRI+1
- IDX_RIT = NRR
-END IF
-IF (CGETRST /= 'SKIP' ) THEN
- NRR = NRR+1
- NRRI = NRRI+1
- IDX_RST = NRR
-END IF
-IF (CGETRGT /= 'SKIP' ) THEN
- NRR = NRR+1
- NRRI = NRRI+1
- IDX_RGT = NRR
-END IF
-IF (CGETRHT /= 'SKIP' ) THEN
- NRR = NRR+1
- NRRI = NRRI+1
- IDX_RHT = NRR
-END IF
-IF (NVERB >= 5) THEN
- WRITE (UNIT=ILUOUT,FMT='("THERE ARE ",I2," WATER VARIABLES")') NRR
- WRITE (UNIT=ILUOUT,FMT='("THERE ARE ",I2," LIQUID VARIABLES")') NRRL
- WRITE (UNIT=ILUOUT,FMT='("THERE ARE ",I2," SOLID VARIABLES")') NRRI
-END IF
-!
-!* 2.4 Update NSV and floating indices for the current model
-!
-!
-CALL UPDATE_NSV(KMI)
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. ALLOCATE MEMORY
-! -----------------
-! * Module RECYCL
-!
-IF (LRECYCL) THEN
-!
- NR_COUNT = 0
-!
- ALLOCATE(XUMEANW(IJU,IKU,NNUMBELT)) ; XUMEANW = 0.0
- ALLOCATE(XVMEANW(IJU,IKU,NNUMBELT)) ; XVMEANW = 0.0
- ALLOCATE(XWMEANW(IJU,IKU,NNUMBELT)) ; XWMEANW = 0.0
- ALLOCATE(XUMEANN(IIU,IKU,NNUMBELT)) ; XUMEANN = 0.0
- ALLOCATE(XVMEANN(IIU,IKU,NNUMBELT)) ; XVMEANN = 0.0
- ALLOCATE(XWMEANN(IIU,IKU,NNUMBELT)) ; XWMEANN = 0.0
- ALLOCATE(XUMEANE(IJU,IKU,NNUMBELT)) ; XUMEANE = 0.0
- ALLOCATE(XVMEANE(IJU,IKU,NNUMBELT)) ; XVMEANE = 0.0
- ALLOCATE(XWMEANE(IJU,IKU,NNUMBELT)) ; XWMEANE = 0.0
- ALLOCATE(XUMEANS(IIU,IKU,NNUMBELT)) ; XUMEANS = 0.0
- ALLOCATE(XVMEANS(IIU,IKU,NNUMBELT)) ; XVMEANS = 0.0
- ALLOCATE(XWMEANS(IIU,IKU,NNUMBELT)) ; XWMEANS = 0.0
- ALLOCATE(XTBV(IIU,IJU,IKU)) ; XTBV = 0.0
-ELSE
- ALLOCATE(XUMEANW(0,0,0))
- ALLOCATE(XVMEANW(0,0,0))
- ALLOCATE(XWMEANW(0,0,0))
- ALLOCATE(XUMEANN(0,0,0))
- ALLOCATE(XVMEANN(0,0,0))
- ALLOCATE(XWMEANN(0,0,0))
- ALLOCATE(XUMEANE(0,0,0))
- ALLOCATE(XVMEANE(0,0,0))
- ALLOCATE(XWMEANE(0,0,0))
- ALLOCATE(XUMEANS(0,0,0))
- ALLOCATE(XVMEANS(0,0,0))
- ALLOCATE(XWMEANS(0,0,0))
- ALLOCATE(XTBV (0,0,0))
-END IF
-!
-!
-!* 3.1 Module MODD_FIELD_n
-!
-IF (LMEAN_FIELD) THEN
-!
- MEAN_COUNT = 0
-!
- ALLOCATE(XUM_MEAN(IIU,IJU,IKU)) ; XUM_MEAN = 0.0
- ALLOCATE(XVM_MEAN(IIU,IJU,IKU)) ; XVM_MEAN = 0.0
- ALLOCATE(XWM_MEAN(IIU,IJU,IKU)) ; XWM_MEAN = 0.0
- ALLOCATE(XTHM_MEAN(IIU,IJU,IKU)) ; XTHM_MEAN = 0.0
- ALLOCATE(XTEMPM_MEAN(IIU,IJU,IKU)) ; XTEMPM_MEAN = 0.0
- ALLOCATE(XSVT_MEAN(IIU,IJU,IKU)) ; XSVT_MEAN = 0.0
- IF (CTURB/='NONE') THEN
- ALLOCATE(XTKEM_MEAN(IIU,IJU,IKU))
- XTKEM_MEAN = 0.0
- ELSE
- ALLOCATE(XTKEM_MEAN(0,0,0))
- END IF
- ALLOCATE(XPABSM_MEAN(IIU,IJU,IKU)) ; XPABSM_MEAN = 0.0
-!
- ALLOCATE(XU2_M2(IIU,IJU,IKU)) ; XU2_M2 = 0.0
-!
- ALLOCATE(XU2_M2(IIU,IJU,IKU)) ; XU2_M2 = 0.0
- ALLOCATE(XV2_M2(IIU,IJU,IKU)) ; XV2_M2 = 0.0
- ALLOCATE(XW2_M2(IIU,IJU,IKU)) ; XW2_M2 = 0.0
- ALLOCATE(XTH2_M2(IIU,IJU,IKU)) ; XTH2_M2 = 0.0
- ALLOCATE(XTEMP2_M2(IIU,IJU,IKU)) ; XTEMP2_M2 = 0.0
- ALLOCATE(XPABS2_M2(IIU,IJU,IKU)) ; XPABS2_M2 = 0.0
-!
- IF (LCOV_FIELD) THEN
- ALLOCATE(XUV_MEAN(IIU,IJU,IKU)) ; XUV_MEAN = 0.0
- ALLOCATE(XUW_MEAN(IIU,IJU,IKU)) ; XUW_MEAN = 0.0
- ALLOCATE(XVW_MEAN(IIU,IJU,IKU)) ; XVW_MEAN = 0.0
- ALLOCATE(XWTH_MEAN(IIU,IJU,IKU)) ; XWTH_MEAN = 0.0
- END IF
-!
- ALLOCATE(XUM_MAX(IIU,IJU,IKU)) ; XUM_MAX = -1.E20
- ALLOCATE(XVM_MAX(IIU,IJU,IKU)) ; XVM_MAX = -1.E20
- ALLOCATE(XWM_MAX(IIU,IJU,IKU)) ; XWM_MAX = -1.E20
- ALLOCATE(XTHM_MAX(IIU,IJU,IKU)) ; XTHM_MAX = 0.0
- ALLOCATE(XTEMPM_MAX(IIU,IJU,IKU)) ; XTEMPM_MAX = 0.0
- IF (CTURB/='NONE') THEN
- ALLOCATE(XTKEM_MAX(IIU,IJU,IKU))
- XTKEM_MAX = 0.0
- ELSE
- ALLOCATE(XTKEM_MAX(0,0,0))
- END IF
- ALLOCATE(XPABSM_MAX(IIU,IJU,IKU)) ; XPABSM_MAX = 0.0
-ELSE
-!
- ALLOCATE(XUM_MEAN(0,0,0))
- ALLOCATE(XVM_MEAN(0,0,0))
- ALLOCATE(XWM_MEAN(0,0,0))
- ALLOCATE(XTHM_MEAN(0,0,0))
- ALLOCATE(XTEMPM_MEAN(0,0,0))
- ALLOCATE(XSVT_MEAN(0,0,0))
- ALLOCATE(XTKEM_MEAN(0,0,0))
- ALLOCATE(XPABSM_MEAN(0,0,0))
-!
- ALLOCATE(XU2_M2(0,0,0))
- ALLOCATE(XV2_M2(0,0,0))
- ALLOCATE(XW2_M2(0,0,0))
- ALLOCATE(XTH2_M2(0,0,0))
- ALLOCATE(XTEMP2_M2(0,0,0))
- ALLOCATE(XPABS2_M2(0,0,0))
-!
- IF (LCOV_FIELD) THEN
- ALLOCATE(XUV_MEAN(0,0,0))
- ALLOCATE(XUW_MEAN(0,0,0))
- ALLOCATE(XVW_MEAN(0,0,0))
- ALLOCATE(XWTH_MEAN(0,0,0))
- END IF
-!
- ALLOCATE(XUM_MAX(0,0,0))
- ALLOCATE(XVM_MAX(0,0,0))
- ALLOCATE(XWM_MAX(0,0,0))
- ALLOCATE(XTHM_MAX(0,0,0))
- ALLOCATE(XTEMPM_MAX(0,0,0))
- ALLOCATE(XTKEM_MAX(0,0,0))
- ALLOCATE(XPABSM_MAX(0,0,0))
-END IF
-!
-IF ((CUVW_ADV_SCHEME(1:3)=='CEN') .AND. (CTEMP_SCHEME == 'LEFR') ) THEN
- ALLOCATE(XUM(IIU,IJU,IKU))
- ALLOCATE(XVM(IIU,IJU,IKU))
- ALLOCATE(XWM(IIU,IJU,IKU))
- ALLOCATE(XDUM(IIU,IJU,IKU))
- ALLOCATE(XDVM(IIU,IJU,IKU))
- ALLOCATE(XDWM(IIU,IJU,IKU))
- IF (CCONF == 'START') THEN
- XUM = 0.0
- XVM = 0.0
- XWM = 0.0
- XDUM = 0.0
- XDVM = 0.0
- XDWM = 0.0
- END IF
-ELSE
- ALLOCATE(XUM(0,0,0))
- ALLOCATE(XVM(0,0,0))
- ALLOCATE(XWM(0,0,0))
- ALLOCATE(XDUM(0,0,0))
- ALLOCATE(XDVM(0,0,0))
- ALLOCATE(XDWM(0,0,0))
-END IF
-!
-ALLOCATE(XUT(IIU,IJU,IKU)) ; XUT = 0.0
-ALLOCATE(XVT(IIU,IJU,IKU)) ; XVT = 0.0
-ALLOCATE(XWT(IIU,IJU,IKU)) ; XWT = 0.0
-ALLOCATE(XTHT(IIU,IJU,IKU)) ; XTHT = 0.0
-ALLOCATE(XRUS(IIU,IJU,IKU)) ; XRUS = 0.0
-ALLOCATE(XRVS(IIU,IJU,IKU)) ; XRVS = 0.0
-ALLOCATE(XRWS(IIU,IJU,IKU)) ; XRWS = 0.0
-ALLOCATE(XRUS_PRES(IIU,IJU,IKU)); XRUS_PRES = 0.0
-ALLOCATE(XRVS_PRES(IIU,IJU,IKU)); XRVS_PRES = 0.0
-ALLOCATE(XRWS_PRES(IIU,IJU,IKU)); XRWS_PRES = 0.0
-ALLOCATE(XRTHS(IIU,IJU,IKU)) ; XRTHS = 0.0
-ALLOCATE(XRTHS_CLD(IIU,IJU,IKU)); XRTHS_CLD = 0.0
-
-IF ( LIBM ) THEN
- ALLOCATE(ZIBM_LS(IIU,IJU,IKU)) ; ZIBM_LS = 0.0
- ALLOCATE(XIBM_XMUT(IIU,IJU,IKU)); XIBM_XMUT = 0.0
-ELSE
- ALLOCATE(ZIBM_LS (0,0,0))
- ALLOCATE(XIBM_XMUT(0,0,0))
-END IF
-
-IF ( LRECYCL ) THEN
- ALLOCATE(XFLUCTUNW(IJU,IKU)) ; XFLUCTUNW = 0.0
- ALLOCATE(XFLUCTVNN(IIU,IKU)) ; XFLUCTVNN = 0.0
- ALLOCATE(XFLUCTUTN(IIU,IKU)) ; XFLUCTUTN = 0.0
- ALLOCATE(XFLUCTVTW(IJU,IKU)) ; XFLUCTVTW = 0.0
- ALLOCATE(XFLUCTUNE(IJU,IKU)) ; XFLUCTUNE = 0.0
- ALLOCATE(XFLUCTVNS(IIU,IKU)) ; XFLUCTVNS = 0.0
- ALLOCATE(XFLUCTUTS(IIU,IKU)) ; XFLUCTUTS = 0.0
- ALLOCATE(XFLUCTVTE(IJU,IKU)) ; XFLUCTVTE = 0.0
- ALLOCATE(XFLUCTWTW(IJU,IKU)) ; XFLUCTWTW = 0.0
- ALLOCATE(XFLUCTWTN(IIU,IKU)) ; XFLUCTWTN = 0.0
- ALLOCATE(XFLUCTWTE(IJU,IKU)) ; XFLUCTWTE = 0.0
- ALLOCATE(XFLUCTWTS(IIU,IKU)) ; XFLUCTWTS = 0.0
-ELSE
- ALLOCATE(XFLUCTUNW(0,0))
- ALLOCATE(XFLUCTVNN(0,0))
- ALLOCATE(XFLUCTUTN(0,0))
- ALLOCATE(XFLUCTVTW(0,0))
- ALLOCATE(XFLUCTUNE(0,0))
- ALLOCATE(XFLUCTVNS(0,0))
- ALLOCATE(XFLUCTUTS(0,0))
- ALLOCATE(XFLUCTVTE(0,0))
- ALLOCATE(XFLUCTWTW(0,0))
- ALLOCATE(XFLUCTWTN(0,0))
- ALLOCATE(XFLUCTWTE(0,0))
- ALLOCATE(XFLUCTWTS(0,0))
-END IF
-!
-IF (CTURB /= 'NONE') THEN
- ALLOCATE(XTKET(IIU,IJU,IKU))
- ALLOCATE(XRTKES(IIU,IJU,IKU))
- ALLOCATE(XRTKEMS(IIU,IJU,IKU)); XRTKEMS = 0.0
- ALLOCATE(XWTHVMF(IIU,IJU,IKU))
- ALLOCATE(XDYP(IIU,IJU,IKU))
- ALLOCATE(XTHP(IIU,IJU,IKU))
- ALLOCATE(XTR(IIU,IJU,IKU))
- ALLOCATE(XDISS(IIU,IJU,IKU))
- ALLOCATE(XLEM(IIU,IJU,IKU))
-ELSE
- ALLOCATE(XTKET(0,0,0))
- ALLOCATE(XRTKES(0,0,0))
- ALLOCATE(XRTKEMS(0,0,0))
- ALLOCATE(XWTHVMF(0,0,0))
- ALLOCATE(XDYP(0,0,0))
- ALLOCATE(XTHP(0,0,0))
- ALLOCATE(XTR(0,0,0))
- ALLOCATE(XDISS(0,0,0))
- ALLOCATE(XLEM(0,0,0))
-END IF
-IF (CTOM == 'TM06') THEN
- ALLOCATE(XBL_DEPTH(IIU,IJU))
-ELSE
- ALLOCATE(XBL_DEPTH(0,0))
-END IF
-IF (LRMC01) THEN
- ALLOCATE(XSBL_DEPTH(IIU,IJU))
-ELSE
- ALLOCATE(XSBL_DEPTH(0,0))
-END IF
-!
-ALLOCATE(XPABSM(IIU,IJU,IKU)) ; XPABSM = 0.0
-ALLOCATE(XPABST(IIU,IJU,IKU)) ; XPABST = 0.0
-!
-ALLOCATE(XRT(IIU,IJU,IKU,NRR)) ; XRT = 0.0
-ALLOCATE(XRRS(IIU,IJU,IKU,NRR)) ; XRRS = 0.0
-ALLOCATE(XRRS_CLD(IIU,IJU,IKU,NRR)); XRRS_CLD = 0.0
-!
-IF (CTURB /= 'NONE' .AND. NRR>1) THEN
- ALLOCATE(XSRCT(IIU,IJU,IKU))
- ALLOCATE(XSIGS(IIU,IJU,IKU))
-ELSE
- ALLOCATE(XSRCT(0,0,0))
- ALLOCATE(XSIGS(0,0,0))
-END IF
-IF (CCLOUD == 'ICE3'.OR.CCLOUD == 'ICE4') THEN
- ALLOCATE(XHLC_HRC(IIU,IJU,IKU))
- ALLOCATE(XHLC_HCF(IIU,IJU,IKU))
- ALLOCATE(XHLI_HRI(IIU,IJU,IKU))
- ALLOCATE(XHLI_HCF(IIU,IJU,IKU))
- XHLC_HRC(:,:,:)=0.
- XHLC_HCF(:,:,:)=0.
- XHLI_HRI(:,:,:)=0.
- XHLI_HCF(:,:,:)=0.
-ELSE
- ALLOCATE(XHLC_HRC(0,0,0))
- ALLOCATE(XHLC_HCF(0,0,0))
- ALLOCATE(XHLI_HRI(0,0,0))
- ALLOCATE(XHLI_HCF(0,0,0))
-END IF
-!
-IF (NRR>1) THEN
- ALLOCATE(XCLDFR(IIU,IJU,IKU)); XCLDFR (:, :, :) = 0.
- ALLOCATE(XICEFR(IIU,IJU,IKU)); XICEFR (:, :, :) = 0.
- ALLOCATE(XRAINFR(IIU,IJU,IKU)); XRAINFR(:, :, :) = 0.
-ELSE
- ALLOCATE(XCLDFR(0,0,0))
- ALLOCATE(XICEFR(0,0,0))
- ALLOCATE(XRAINFR(0,0,0))
-END IF
-!
-ALLOCATE(XSVT(IIU,IJU,IKU,NSV)) ; XSVT = 0.
-ALLOCATE(XRSVS(IIU,IJU,IKU,NSV)); XRSVS = 0.
-ALLOCATE(XRSVS_CLD(IIU,IJU,IKU,NSV)); XRSVS_CLD = 0.0
-ALLOCATE(XZWS(IIU,IJU)) ; XZWS(:,:) = XZWS_DEFAULT
-!
-IF (LPASPOL) THEN
- ALLOCATE( XATC(IIU,IJU,IKU,NSV_PP) )
- XATC = 0.
-ELSE
- ALLOCATE( XATC(0,0,0,0))
-END IF
-!
-IF(LBLOWSNOW) THEN
- ALLOCATE(XSNWCANO(IIU,IJU,NBLOWSNOW_2D))
- ALLOCATE(XRSNWCANOS(IIU,IJU,NBLOWSNOW_2D))
- XSNWCANO(:,:,:) = 0.0
- XRSNWCANOS(:,:,:) = 0.0
-ELSE
- ALLOCATE(XSNWCANO(0,0,0))
- ALLOCATE(XRSNWCANOS(0,0,0))
-END IF
-!
-!* 3.2 Module MODD_GRID_n and MODD_METRICS_n
-!
-IF (LCARTESIAN) THEN
- ALLOCATE(XLON(0,0))
- ALLOCATE(XLAT(0,0))
- ALLOCATE(XMAP(0,0))
-ELSE
- ALLOCATE(XLON(IIU,IJU))
- ALLOCATE(XLAT(IIU,IJU))
- ALLOCATE(XMAP(IIU,IJU))
-END IF
-ALLOCATE(XXHAT(IIU))
-ALLOCATE(XDXHAT(IIU))
-ALLOCATE(XYHAT(IJU))
-ALLOCATE(XDYHAT(IJU))
-ALLOCATE(XXHATM(IIU))
-ALLOCATE(XYHATM(IJU))
-ALLOCATE(XZS(IIU,IJU))
-ALLOCATE(XZSMT(IIU,IJU))
-ALLOCATE(XZZ(IIU,IJU,IKU))
-ALLOCATE(XZHAT(IKU))
-ALLOCATE(XZHATM(IKU))
-ALLOCATE(XDIRCOSZW(IIU,IJU))
-ALLOCATE(XDIRCOSXW(IIU,IJU))
-ALLOCATE(XDIRCOSYW(IIU,IJU))
-ALLOCATE(XCOSSLOPE(IIU,IJU))
-ALLOCATE(XSINSLOPE(IIU,IJU))
-!
-ALLOCATE(XDXX(IIU,IJU,IKU))
-ALLOCATE(XDYY(IIU,IJU,IKU))
-ALLOCATE(XDZX(IIU,IJU,IKU))
-ALLOCATE(XDZY(IIU,IJU,IKU))
-ALLOCATE(XDZZ(IIU,IJU,IKU))
-!
-!* 3.3 Modules MODD_REF and MODD_REF_n
-!
-! Different reference states for Ocean and Atmosphere models
-! For the moment, same reference states for O and A
-!IF ((KMI == 1).OR.LCOUPLES) THEN
-IF (KMI==1) THEN
- ALLOCATE(XRHODREFZ(IKU),XTHVREFZ(IKU))
-ELSE IF (LCOUPLES) THEN
-! in coupled O-A case, need different variables for ocean
- ALLOCATE(XRHODREFZO(IKU),XTHVREFZO(IKU))
-ELSE
- !Do not allocate XRHODREFZ and XTHVREFZ because they are the same on all grids (not 'n' variables)
-END IF
-!
-ALLOCATE(XPHIT(IIU,IJU,IKU))
-ALLOCATE(XRHODREF(IIU,IJU,IKU))
-ALLOCATE(XTHVREF(IIU,IJU,IKU))
-ALLOCATE(XEXNREF(IIU,IJU,IKU))
-ALLOCATE(XRHODJ(IIU,IJU,IKU))
-IF (CEQNSYS=='DUR' .AND. LUSERV) THEN
- ALLOCATE(XRVREF(IIU,IJU,IKU))
-ELSE
- ALLOCATE(XRVREF(0,0,0))
-END IF
-!
-!* 3.4 Module MODD_CURVCOR_n
-!
-IF (LTHINSHELL) THEN
- ALLOCATE(XCORIOX(0,0))
- ALLOCATE(XCORIOY(0,0))
-ELSE
- ALLOCATE(XCORIOX(IIU,IJU))
- ALLOCATE(XCORIOY(IIU,IJU))
-END IF
- ALLOCATE(XCORIOZ(IIU,IJU))
-IF (LCARTESIAN) THEN
- ALLOCATE(XCURVX(0,0))
- ALLOCATE(XCURVY(0,0))
-ELSE
- ALLOCATE(XCURVX(IIU,IJU))
- ALLOCATE(XCURVY(IIU,IJU))
-END IF
-!
-!* 3.5 Module MODD_DYN_n
-!
-CALL GET_DIM_EXT_ll('Y',IIY,IJY)
-IF (L2D) THEN
- ALLOCATE(XBFY(IIY,IJY,IKU))
-ELSE
- ALLOCATE(XBFY(IJY,IIY,IKU)) ! transposition needed by the optimisation of the
- ! FFT solver
-END IF
-CALL GET_DIM_EXT_ll('B',IIU_B,IJU_B)
-ALLOCATE(XBFB(IIU_B,IJU_B,IKU))
-CALL GET_DIM_EXTZ_ll('SXP2_YP1_Z',IIU_SXP2_YP1_Z_ll,IJU_SXP2_YP1_Z_ll,IKU_SXP2_YP1_Z_ll)
-ALLOCATE(XBF_SXP2_YP1_Z(IIU_SXP2_YP1_Z_ll,IJU_SXP2_YP1_Z_ll,IKU_SXP2_YP1_Z_ll))
-ALLOCATE(XAF(IKU),XCF(IKU))
-ALLOCATE(XTRIGSX(3*IIU_ll))
-ALLOCATE(XTRIGSY(3*IJU_ll))
-ALLOCATE(XRHOM(IKU))
-ALLOCATE(XALK(IKU))
-ALLOCATE(XALKW(IKU))
-ALLOCATE(XALKBAS(IKU))
-ALLOCATE(XALKWBAS(IKU))
-!
-IF ( 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
- ALLOCATE(XKURELAX(IIU,IJU))
- ALLOCATE(XKVRELAX(IIU,IJU))
- ALLOCATE(XKWRELAX(IIU,IJU))
- ALLOCATE(LMASK_RELAX(IIU,IJU))
-ELSE
- ALLOCATE(XKURELAX(0,0))
- ALLOCATE(XKVRELAX(0,0))
- ALLOCATE(XKWRELAX(0,0))
- ALLOCATE(LMASK_RELAX(0,0))
-END IF
-!
-! Additional fields for truly horizontal diffusion (Module MODD_DYNZD$n)
-IF (LZDIFFU) THEN
- CALL INIT_TYPE_ZDIFFU_HALO2(XZDIFFU_HALO2)
-ELSE
- CALL INIT_TYPE_ZDIFFU_HALO2(XZDIFFU_HALO2,0)
-ENDIF
-!
-!* 3.6 Larger Scale variables (Module MODD_LSFIELD$n)
-!
-!
-! upper relaxation part
-!
-ALLOCATE(XLSUM(IIU,IJU,IKU)) ; XLSUM = 0.0
-ALLOCATE(XLSVM(IIU,IJU,IKU)) ; XLSVM = 0.0
-ALLOCATE(XLSWM(IIU,IJU,IKU)) ; XLSWM = 0.0
-ALLOCATE(XLSTHM(IIU,IJU,IKU)) ; XLSTHM = 0.0
-IF ( NRR > 0 ) THEN
- ALLOCATE(XLSRVM(IIU,IJU,IKU)) ; XLSRVM = 0.0
-ELSE
- ALLOCATE(XLSRVM(0,0,0))
-END IF
-ALLOCATE(XLSZWSM(IIU,IJU)) ; XLSZWSM = -1.
-!
-! lbc part
-!
-IF ( L1D) THEN ! 1D case
-!
- NSIZELBX_ll=0
- NSIZELBXU_ll=0
- NSIZELBY_ll=0
- NSIZELBYV_ll=0
- NSIZELBXTKE_ll=0
- NSIZELBXR_ll=0
- NSIZELBXSV_ll=0
- NSIZELBYTKE_ll=0
- NSIZELBYR_ll=0
- NSIZELBYSV_ll=0
- ALLOCATE(XLBXUM(0,0,0))
- ALLOCATE(XLBYUM(0,0,0))
- ALLOCATE(XLBXVM(0,0,0))
- ALLOCATE(XLBYVM(0,0,0))
- ALLOCATE(XLBXWM(0,0,0))
- ALLOCATE(XLBYWM(0,0,0))
- ALLOCATE(XLBXTHM(0,0,0))
- ALLOCATE(XLBYTHM(0,0,0))
- ALLOCATE(XLBXTKEM(0,0,0))
- ALLOCATE(XLBYTKEM(0,0,0))
- ALLOCATE(XLBXRM(0,0,0,0))
- ALLOCATE(XLBYRM(0,0,0,0))
- ALLOCATE(XLBXSVM(0,0,0,0))
- ALLOCATE(XLBYSVM(0,0,0,0))
-!
-ELSEIF( L2D ) THEN ! 2D case
-!
- NSIZELBY_ll=0
- NSIZELBYV_ll=0
- NSIZELBYTKE_ll=0
- NSIZELBYR_ll=0
- NSIZELBYSV_ll=0
- ALLOCATE(XLBYUM(0,0,0))
- ALLOCATE(XLBYVM(0,0,0))
- ALLOCATE(XLBYWM(0,0,0))
- ALLOCATE(XLBYTHM(0,0,0))
- ALLOCATE(XLBYTKEM(0,0,0))
- ALLOCATE(XLBYRM(0,0,0,0))
- ALLOCATE(XLBYSVM(0,0,0,0))
-!
- CALL GET_SIZEX_LB(NIMAX_ll,NJMAX_ll,NRIMX, &
- IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU, &
- IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2)
-!
- IF ( LHORELAX_UVWTH ) THEN
- NSIZELBX_ll=2*NRIMX+2*JPHEXT
- NSIZELBXU_ll=2*NRIMX+2*JPHEXT
- ALLOCATE(XLBXUM(IISIZEXFU,IJSIZEXFU,IKU))
- ALLOCATE(XLBXVM(IISIZEXF,IJSIZEXF,IKU))
- ALLOCATE(XLBXWM(IISIZEXF,IJSIZEXF,IKU))
- ALLOCATE(XLBXTHM(IISIZEXF,IJSIZEXF,IKU))
- ELSE
- NSIZELBX_ll=2*JPHEXT ! 2
- NSIZELBXU_ll=2*(JPHEXT+1) ! 4
- ALLOCATE(XLBXUM(IISIZEX4,IJSIZEX4,IKU))
- ALLOCATE(XLBXVM(IISIZEX2,IJSIZEX2,IKU))
- ALLOCATE(XLBXWM(IISIZEX2,IJSIZEX2,IKU))
- ALLOCATE(XLBXTHM(IISIZEX2,IJSIZEX2,IKU))
- END IF
-!
- IF (CTURB /= 'NONE') THEN
- IF ( LHORELAX_TKE) THEN
- NSIZELBXTKE_ll=2* NRIMX+2*JPHEXT
- ALLOCATE(XLBXTKEM(IISIZEXF,IJSIZEXF,IKU))
- ELSE
- NSIZELBXTKE_ll=2*JPHEXT ! 2
- ALLOCATE(XLBXTKEM(IISIZEX2,IJSIZEX2,IKU))
- END IF
- ELSE
- NSIZELBXTKE_ll=0
- ALLOCATE(XLBXTKEM(0,0,0))
- END IF
- !
- IF ( NRR > 0 ) THEN
- IF (LHORELAX_RV .OR. LHORELAX_RC .OR. LHORELAX_RR .OR. LHORELAX_RI &
- .OR. LHORELAX_RS .OR. LHORELAX_RG .OR. LHORELAX_RH &
- ) THEN
- NSIZELBXR_ll=2* NRIMX+2*JPHEXT
- ALLOCATE(XLBXRM(IISIZEXF,IJSIZEXF,IKU,NRR))
- ELSE
- NSIZELBXR_ll=2*JPHEXT ! 2
- ALLOCATE(XLBXRM(IISIZEX2,IJSIZEX2,IKU,NRR))
- ENDIF
- ELSE
- NSIZELBXR_ll=0
- ALLOCATE(XLBXRM(0,0,0,0))
- END IF
- !
- IF ( NSV > 0 ) THEN
- IF ( ANY( LHORELAX_SV(:)) ) THEN
- NSIZELBXSV_ll=2* NRIMX+2*JPHEXT
- ALLOCATE(XLBXSVM(IISIZEXF,IJSIZEXF,IKU,NSV))
- ELSE
- NSIZELBXSV_ll=2*JPHEXT ! 2
- ALLOCATE(XLBXSVM(IISIZEX2,IJSIZEX2,IKU,NSV))
- END IF
- ELSE
- NSIZELBXSV_ll=0
- ALLOCATE(XLBXSVM(0,0,0,0))
- END IF
-!
-ELSE ! 3D case
-!
-!
- CALL GET_SIZEX_LB(NIMAX_ll,NJMAX_ll,NRIMX, &
- IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU, &
- IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2)
- CALL GET_SIZEY_LB(NIMAX_ll,NJMAX_ll,NRIMY, &
- IISIZEYF,IJSIZEYF,IISIZEYFV,IJSIZEYFV, &
- IISIZEY4,IJSIZEY4,IISIZEY2,IJSIZEY2)
-!
-! check if local domain not to small for NRIMX NRIMY
-!
- IF ( CLBCX(1) /= 'CYCL' ) THEN
- IF ( NRIMX .GT. IDIMX ) THEN
- WRITE(*,'(A,I8,A/A,2I8,/A)') "Processor=", IP-1, &
- " :: INI_MODEL_n ERROR: ( NRIMX > IDIMX ) ", &
- " Local domain to small for relaxation NRIMX,IDIMX ", &
- NRIMX,IDIMX ,&
- " change relaxation parameters or number of processors "
- call Print_msg(NVERB_FATAL,'GEN','INI_MODEL_n','')
- END IF
- END IF
- IF ( CLBCY(1) /= 'CYCL' ) THEN
- IF ( NRIMY .GT. IDIMY ) THEN
- WRITE(*,'(A,I8,A/A,2I8,/A)') "Processor=", IP-1, &
- " :: INI_MODEL_n ERROR: ( NRIMY > IDIMY ) ", &
- " Local domain to small for relaxation NRIMY,IDIMY ", &
- NRIMY,IDIMY ,&
- " change relaxation parameters or number of processors "
- call Print_msg(NVERB_FATAL,'GEN','INI_MODEL_n','')
- END IF
- END IF
-IF ( LHORELAX_UVWTH ) THEN
- NSIZELBX_ll=2*NRIMX+2*JPHEXT
- NSIZELBXU_ll=2*NRIMX+2*JPHEXT
- NSIZELBY_ll=2*NRIMY+2*JPHEXT
- NSIZELBYV_ll=2*NRIMY+2*JPHEXT
- ALLOCATE(XLBXUM(IISIZEXFU,IJSIZEXFU,IKU))
- ALLOCATE(XLBYUM(IISIZEYF,IJSIZEYF,IKU))
- ALLOCATE(XLBXVM(IISIZEXF,IJSIZEXF,IKU))
- ALLOCATE(XLBYVM(IISIZEYFV,IJSIZEYFV,IKU))
- ALLOCATE(XLBXWM(IISIZEXF,IJSIZEXF,IKU))
- ALLOCATE(XLBYWM(IISIZEYF,IJSIZEYF,IKU))
- ALLOCATE(XLBXTHM(IISIZEXF,IJSIZEXF,IKU))
- ALLOCATE(XLBYTHM(IISIZEYF,IJSIZEYF,IKU))
- ELSE
- NSIZELBX_ll=2*JPHEXT ! 2
- NSIZELBXU_ll=2*(JPHEXT+1) ! 4
- NSIZELBY_ll=2*JPHEXT ! 2
- NSIZELBYV_ll=2*(JPHEXT+1) ! 4
- ALLOCATE(XLBXUM(IISIZEX4,IJSIZEX4,IKU))
- ALLOCATE(XLBYUM(IISIZEY2,IJSIZEY2,IKU))
- ALLOCATE(XLBXVM(IISIZEX2,IJSIZEX2,IKU))
- ALLOCATE(XLBYVM(IISIZEY4,IJSIZEY4,IKU))
- ALLOCATE(XLBXWM(IISIZEX2,IJSIZEX2,IKU))
- ALLOCATE(XLBYWM(IISIZEY2,IJSIZEY2,IKU))
- ALLOCATE(XLBXTHM(IISIZEX2,IJSIZEX2,IKU))
- ALLOCATE(XLBYTHM(IISIZEY2,IJSIZEY2,IKU))
- END IF
- !
- IF (CTURB /= 'NONE') THEN
- IF ( LHORELAX_TKE) THEN
- NSIZELBXTKE_ll=2*NRIMX+2*JPHEXT
- NSIZELBYTKE_ll=2*NRIMY+2*JPHEXT
- ALLOCATE(XLBXTKEM(IISIZEXF,IJSIZEXF,IKU))
- ALLOCATE(XLBYTKEM(IISIZEYF,IJSIZEYF,IKU))
- ELSE
- NSIZELBXTKE_ll=2*JPHEXT ! 2
- NSIZELBYTKE_ll=2*JPHEXT ! 2
- ALLOCATE(XLBXTKEM(IISIZEX2,IJSIZEX2,IKU))
- ALLOCATE(XLBYTKEM(IISIZEY2,IJSIZEY2,IKU))
- END IF
- ELSE
- NSIZELBXTKE_ll=0
- NSIZELBYTKE_ll=0
- ALLOCATE(XLBXTKEM(0,0,0))
- ALLOCATE(XLBYTKEM(0,0,0))
- END IF
- !
- IF ( NRR > 0 ) THEN
- IF (LHORELAX_RV .OR. LHORELAX_RC .OR. LHORELAX_RR .OR. LHORELAX_RI &
- .OR. LHORELAX_RS .OR. LHORELAX_RG .OR. LHORELAX_RH &
- ) THEN
- NSIZELBXR_ll=2*NRIMX+2*JPHEXT
- NSIZELBYR_ll=2*NRIMY+2*JPHEXT
- ALLOCATE(XLBXRM(IISIZEXF,IJSIZEXF,IKU,NRR))
- ALLOCATE(XLBYRM(IISIZEYF,IJSIZEYF,IKU,NRR))
- ELSE
- NSIZELBXR_ll=2*JPHEXT ! 2
- NSIZELBYR_ll=2*JPHEXT ! 2
- ALLOCATE(XLBXRM(IISIZEX2,IJSIZEX2,IKU,NRR))
- ALLOCATE(XLBYRM(IISIZEY2,IJSIZEY2,IKU,NRR))
- ENDIF
- ELSE
- NSIZELBXR_ll=0
- NSIZELBYR_ll=0
- ALLOCATE(XLBXRM(0,0,0,0))
- ALLOCATE(XLBYRM(0,0,0,0))
- END IF
- !
- IF ( NSV > 0 ) THEN
- IF ( ANY( LHORELAX_SV(:)) ) THEN
- NSIZELBXSV_ll=2*NRIMX+2*JPHEXT
- NSIZELBYSV_ll=2*NRIMY+2*JPHEXT
- ALLOCATE(XLBXSVM(IISIZEXF,IJSIZEXF,IKU,NSV))
- ALLOCATE(XLBYSVM(IISIZEYF,IJSIZEYF,IKU,NSV))
- ELSE
- NSIZELBXSV_ll=2*JPHEXT ! 2
- NSIZELBYSV_ll=2*JPHEXT ! 2
- ALLOCATE(XLBXSVM(IISIZEX2,IJSIZEX2,IKU,NSV))
- ALLOCATE(XLBYSVM(IISIZEY2,IJSIZEY2,IKU,NSV))
- END IF
- ELSE
- NSIZELBXSV_ll=0
- NSIZELBYSV_ll=0
- ALLOCATE(XLBXSVM(0,0,0,0))
- ALLOCATE(XLBYSVM(0,0,0,0))
- END IF
-END IF ! END OF THE IF STRUCTURE ON THE MODEL DIMENSION
-!
-!
-IF ( KMI > 1 ) THEN
- ! it has been assumed that the THeta field used the largest rim area compared
- ! to the others prognostic variables, if it is not the case, you must change
- ! these lines
- ALLOCATE(XCOEFLIN_LBXM(SIZE(XLBXTHM,1),SIZE(XLBXTHM,2),SIZE(XLBXTHM,3)))
- ALLOCATE( NKLIN_LBXM(SIZE(XLBXTHM,1),SIZE(XLBXTHM,2),SIZE(XLBXTHM,3)))
- ALLOCATE(XCOEFLIN_LBYM(SIZE(XLBYTHM,1),SIZE(XLBYTHM,2),SIZE(XLBYTHM,3)))
- ALLOCATE( NKLIN_LBYM(SIZE(XLBYTHM,1),SIZE(XLBYTHM,2),SIZE(XLBYTHM,3)))
- ALLOCATE(XCOEFLIN_LBXU(SIZE(XLBXUM,1),SIZE(XLBXUM,2),SIZE(XLBXUM,3)))
- ALLOCATE( NKLIN_LBXU(SIZE(XLBXUM,1),SIZE(XLBXUM,2),SIZE(XLBXUM,3)))
- ALLOCATE(XCOEFLIN_LBYU(SIZE(XLBYUM,1),SIZE(XLBYUM,2),SIZE(XLBYUM,3)))
- ALLOCATE( NKLIN_LBYU(SIZE(XLBYUM,1),SIZE(XLBYUM,2),SIZE(XLBYUM,3)))
- ALLOCATE(XCOEFLIN_LBXV(SIZE(XLBXVM,1),SIZE(XLBXVM,2),SIZE(XLBXVM,3)))
- ALLOCATE( NKLIN_LBXV(SIZE(XLBXVM,1),SIZE(XLBXVM,2),SIZE(XLBXVM,3)))
- ALLOCATE(XCOEFLIN_LBYV(SIZE(XLBYVM,1),SIZE(XLBYVM,2),SIZE(XLBYVM,3)))
- ALLOCATE( NKLIN_LBYV(SIZE(XLBYVM,1),SIZE(XLBYVM,2),SIZE(XLBYVM,3)))
- ALLOCATE(XCOEFLIN_LBXW(SIZE(XLBXWM,1),SIZE(XLBXWM,2),SIZE(XLBXWM,3)))
- ALLOCATE( NKLIN_LBXW(SIZE(XLBXWM,1),SIZE(XLBXWM,2),SIZE(XLBXWM,3)))
- ALLOCATE(XCOEFLIN_LBYW(SIZE(XLBYWM,1),SIZE(XLBYWM,2),SIZE(XLBYWM,3)))
- ALLOCATE( NKLIN_LBYW(SIZE(XLBYWM,1),SIZE(XLBYWM,2),SIZE(XLBYWM,3)))
-ELSE
- ALLOCATE(XCOEFLIN_LBXM(0,0,0))
- ALLOCATE( NKLIN_LBXM(0,0,0))
- ALLOCATE(XCOEFLIN_LBYM(0,0,0))
- ALLOCATE( NKLIN_LBYM(0,0,0))
- ALLOCATE(XCOEFLIN_LBXU(0,0,0))
- ALLOCATE( NKLIN_LBXU(0,0,0))
- ALLOCATE(XCOEFLIN_LBYU(0,0,0))
- ALLOCATE( NKLIN_LBYU(0,0,0))
- ALLOCATE(XCOEFLIN_LBXV(0,0,0))
- ALLOCATE( NKLIN_LBXV(0,0,0))
- ALLOCATE(XCOEFLIN_LBYV(0,0,0))
- ALLOCATE( NKLIN_LBYV(0,0,0))
- ALLOCATE(XCOEFLIN_LBXW(0,0,0))
- ALLOCATE( NKLIN_LBXW(0,0,0))
- ALLOCATE(XCOEFLIN_LBYW(0,0,0))
- ALLOCATE( NKLIN_LBYW(0,0,0))
-END IF
-!
-! allocation of the LS fields for vertical relaxation and numerical diffusion
-IF( .NOT. LSTEADYLS ) THEN
-!
- ALLOCATE(XLSUS(SIZE(XLSUM,1),SIZE(XLSUM,2),SIZE(XLSUM,3)))
- ALLOCATE(XLSVS(SIZE(XLSVM,1),SIZE(XLSVM,2),SIZE(XLSVM,3)))
- ALLOCATE(XLSWS(SIZE(XLSWM,1),SIZE(XLSWM,2),SIZE(XLSWM,3)))
- ALLOCATE(XLSTHS(SIZE(XLSTHM,1),SIZE(XLSTHM,2),SIZE(XLSTHM,3)))
- ALLOCATE(XLSRVS(SIZE(XLSRVM,1),SIZE(XLSRVM,2),SIZE(XLSRVM,3)))
- ALLOCATE(XLSZWSS(SIZE(XLSZWSM,1),SIZE(XLSZWSM,2)))
-!
-ELSE
-!
- ALLOCATE(XLSUS(0,0,0))
- ALLOCATE(XLSVS(0,0,0))
- ALLOCATE(XLSWS(0,0,0))
- ALLOCATE(XLSTHS(0,0,0))
- ALLOCATE(XLSRVS(0,0,0))
- ALLOCATE(XLSZWSS(0,0))
-!
-END IF
-! allocation of the LB fields for horizontal relaxation and Lateral Boundaries
-IF( .NOT. ( LSTEADYLS .AND. KMI==1 ) ) THEN
-!
- ALLOCATE(XLBXTKES(SIZE(XLBXTKEM,1),SIZE(XLBXTKEM,2),SIZE(XLBXTKEM,3)))
- ALLOCATE(XLBYTKES(SIZE(XLBYTKEM,1),SIZE(XLBYTKEM,2),SIZE(XLBYTKEM,3)))
- ALLOCATE(XLBXUS(SIZE(XLBXUM,1),SIZE(XLBXUM,2),SIZE(XLBXUM,3)))
- ALLOCATE(XLBYUS(SIZE(XLBYUM,1),SIZE(XLBYUM,2),SIZE(XLBYUM,3)))
- ALLOCATE(XLBXVS(SIZE(XLBXVM,1),SIZE(XLBXVM,2),SIZE(XLBXVM,3)))
- ALLOCATE(XLBYVS(SIZE(XLBYVM,1),SIZE(XLBYVM,2),SIZE(XLBYVM,3)))
- ALLOCATE(XLBXWS(SIZE(XLBXWM,1),SIZE(XLBXWM,2),SIZE(XLBXWM,3)))
- ALLOCATE(XLBYWS(SIZE(XLBYWM,1),SIZE(XLBYWM,2),SIZE(XLBYWM,3)))
- ALLOCATE(XLBXTHS(SIZE(XLBXTHM,1),SIZE(XLBXTHM,2),SIZE(XLBXTHM,3)))
- ALLOCATE(XLBYTHS(SIZE(XLBYTHM,1),SIZE(XLBYTHM,2),SIZE(XLBYTHM,3)))
- ALLOCATE(XLBXRS(SIZE(XLBXRM,1),SIZE(XLBXRM,2),SIZE(XLBXRM,3),SIZE(XLBXRM,4)))
- ALLOCATE(XLBYRS(SIZE(XLBYRM,1),SIZE(XLBYRM,2),SIZE(XLBYRM,3),SIZE(XLBYRM,4)))
- ALLOCATE(XLBXSVS(SIZE(XLBXSVM,1),SIZE(XLBXSVM,2),SIZE(XLBXSVM,3),SIZE(XLBXSVM,4)))
- ALLOCATE(XLBYSVS(SIZE(XLBYSVM,1),SIZE(XLBYSVM,2),SIZE(XLBYSVM,3),SIZE(XLBYSVM,4)))
-!
-ELSE
-!
- ALLOCATE(XLBXTKES(0,0,0))
- ALLOCATE(XLBYTKES(0,0,0))
- ALLOCATE(XLBXUS(0,0,0))
- ALLOCATE(XLBYUS(0,0,0))
- ALLOCATE(XLBXVS(0,0,0))
- ALLOCATE(XLBYVS(0,0,0))
- ALLOCATE(XLBXWS(0,0,0))
- ALLOCATE(XLBYWS(0,0,0))
- ALLOCATE(XLBXTHS(0,0,0))
- ALLOCATE(XLBYTHS(0,0,0))
- ALLOCATE(XLBXRS(0,0,0,0))
- ALLOCATE(XLBYRS(0,0,0,0))
- ALLOCATE(XLBXSVS(0,0,0,0))
- ALLOCATE(XLBYSVS(0,0,0,0))
-!
-END IF
-!
-!
-!* 3.7 Module MODD_RADIATIONS_n (except XOZON and XAER)
-!
-! Initialization of SW bands
-NSWB_OLD = 6 ! Number of bands in ECMWF original scheme (from Fouquart et Bonnel (1980))
- ! then modified through INI_RADIATIONS_ECMWF but remains equal to 6 practically
-
-#ifdef MNH_ECRAD
-#if ( VER_ECRAD == 140 )
-NLWB_OLD = 16 ! For XEMIS initialization (should be spectral in the future)
-#endif
-#endif
-
-NLWB_MNH = 16 ! For XEMIS initialization (should be spectral in the future)
-
-IF (CRAD == 'ECRA') THEN
- NSWB_MNH = 14
-#ifdef MNH_ECRAD
-#if ( VER_ECRAD == 140 )
- NLWB_MNH = 16
-#endif
-#endif
-ELSE
- NSWB_MNH = NSWB_OLD
-#ifdef MNH_ECRAD
-#if ( VER_ECRAD == 140 )
- NLWB_MNH = NLWB_OLD
-#endif
-#endif
-END IF
-
-ALLOCATE(XSW_BANDS (NSWB_MNH))
-ALLOCATE(XLW_BANDS (NLWB_MNH))
-ALLOCATE(XZENITH (IIU,IJU))
-ALLOCATE(XAZIM (IIU,IJU))
-ALLOCATE(XALBUV (IIU,IJU))
-XALBUV(:,:) = NALBUV_DEFAULT !Set to an arbitrary low value (XALBUV is needed in CH_INTERP_JVALUES even if no radiation)
-ALLOCATE(XDIRSRFSWD(IIU,IJU,NSWB_MNH))
-ALLOCATE(XSCAFLASWD(IIU,IJU,NSWB_MNH))
-ALLOCATE(XFLALWD (IIU,IJU))
-!
-IF (CRAD /= 'NONE') THEN
- ALLOCATE(XSLOPANG(IIU,IJU))
- ALLOCATE(XSLOPAZI(IIU,IJU))
- ALLOCATE(XDTHRAD(IIU,IJU,IKU))
- ALLOCATE(XDIRFLASWD(IIU,IJU,NSWB_MNH))
- ALLOCATE(XDIR_ALB(IIU,IJU,NSWB_MNH))
- ALLOCATE(XSCA_ALB(IIU,IJU,NSWB_MNH))
- ALLOCATE(XEMIS (IIU,IJU,NLWB_MNH))
- ALLOCATE(XTSRAD (IIU,IJU)) ; XTSRAD = XUNDEF_SFX
- ALLOCATE(XSEA (IIU,IJU))
- ALLOCATE(XZS_XY (IIU,IJU))
- ALLOCATE(NCLEARCOL_TM1(IIU,IJU))
- ALLOCATE(XSWU(IIU,IJU,IKU))
- ALLOCATE(XSWD(IIU,IJU,IKU))
- ALLOCATE(XLWU(IIU,IJU,IKU))
- ALLOCATE(XLWD(IIU,IJU,IKU))
- ALLOCATE(XDTHRADSW(IIU,IJU,IKU))
- ALLOCATE(XDTHRADLW(IIU,IJU,IKU))
- ALLOCATE(XRADEFF(IIU,IJU,IKU))
-ELSE
- ALLOCATE(XSLOPANG(0,0))
- ALLOCATE(XSLOPAZI(0,0))
- ALLOCATE(XDTHRAD(0,0,0))
- ALLOCATE(XDIRFLASWD(0,0,0))
- ALLOCATE(XDIR_ALB(0,0,0))
- ALLOCATE(XSCA_ALB(0,0,0))
- ALLOCATE(XEMIS (0,0,0))
- ALLOCATE(XTSRAD (0,0))
- ALLOCATE(XSEA (0,0))
- ALLOCATE(XZS_XY (0,0))
- ALLOCATE(NCLEARCOL_TM1(0,0))
- ALLOCATE(XSWU(0,0,0))
- ALLOCATE(XSWD(0,0,0))
- ALLOCATE(XLWU(0,0,0))
- ALLOCATE(XLWD(0,0,0))
- ALLOCATE(XDTHRADSW(0,0,0))
- ALLOCATE(XDTHRADLW(0,0,0))
- ALLOCATE(XRADEFF(0,0,0))
-END IF
-
-IF (CRAD == 'ECMW' .OR. CRAD == 'ECRA') THEN
- ALLOCATE(XSTROATM(31,6))
- ALLOCATE(XSMLSATM(31,6))
- ALLOCATE(XSMLWATM(31,6))
- ALLOCATE(XSPOSATM(31,6))
- ALLOCATE(XSPOWATM(31,6))
- ALLOCATE(XSTATM(31,6))
-ELSE
- ALLOCATE(XSTROATM(0,0))
- ALLOCATE(XSMLSATM(0,0))
- ALLOCATE(XSMLWATM(0,0))
- ALLOCATE(XSPOSATM(0,0))
- ALLOCATE(XSPOWATM(0,0))
- ALLOCATE(XSTATM(0,0))
-END IF
-!
-!* 3.8 Module MODD_DEEP_CONVECTION_n
-!
-IF (CDCONV /= 'NONE' .OR. CSCONV == 'KAFR') THEN
- ALLOCATE(NCOUNTCONV(IIU,IJU))
- ALLOCATE(XDTHCONV(IIU,IJU,IKU))
- ALLOCATE(XDRVCONV(IIU,IJU,IKU))
- ALLOCATE(XDRCCONV(IIU,IJU,IKU))
- ALLOCATE(XDRICONV(IIU,IJU,IKU))
- ALLOCATE(XPRCONV(IIU,IJU))
- ALLOCATE(XPACCONV(IIU,IJU))
- ALLOCATE(XPRSCONV(IIU,IJU))
- ! diagnostics
- IF (LCH_CONV_LINOX) THEN
- ALLOCATE(XIC_RATE(IIU,IJU))
- ALLOCATE(XCG_RATE(IIU,IJU))
- ALLOCATE(XIC_TOTAL_NUMBER(IIU,IJU))
- ALLOCATE(XCG_TOTAL_NUMBER(IIU,IJU))
- ELSE
- ALLOCATE(XIC_RATE(0,0))
- ALLOCATE(XCG_RATE(0,0))
- ALLOCATE(XIC_TOTAL_NUMBER(0,0))
- ALLOCATE(XCG_TOTAL_NUMBER(0,0))
- END IF
- IF ( LDIAGCONV ) THEN
- ALLOCATE(XUMFCONV(IIU,IJU,IKU))
- ALLOCATE(XDMFCONV(IIU,IJU,IKU))
- ALLOCATE(XPRLFLXCONV(IIU,IJU,IKU))
- ALLOCATE(XPRSFLXCONV(IIU,IJU,IKU))
- ALLOCATE(XCAPE(IIU,IJU))
- ALLOCATE(NCLTOPCONV(IIU,IJU))
- ALLOCATE(NCLBASCONV(IIU,IJU))
- ELSE
- ALLOCATE(XUMFCONV(0,0,0))
- ALLOCATE(XDMFCONV(0,0,0))
- ALLOCATE(XPRLFLXCONV(0,0,0))
- ALLOCATE(XPRSFLXCONV(0,0,0))
- ALLOCATE(XCAPE(0,0))
- ALLOCATE(NCLTOPCONV(0,0))
- ALLOCATE(NCLBASCONV(0,0))
- END IF
-ELSE
- ALLOCATE(NCOUNTCONV(0,0))
- ALLOCATE(XDTHCONV(0,0,0))
- ALLOCATE(XDRVCONV(0,0,0))
- ALLOCATE(XDRCCONV(0,0,0))
- ALLOCATE(XDRICONV(0,0,0))
- ALLOCATE(XPRCONV(0,0))
- ALLOCATE(XPACCONV(0,0))
- ALLOCATE(XPRSCONV(0,0))
- ALLOCATE(XIC_RATE(0,0))
- ALLOCATE(XCG_RATE(0,0))
- ALLOCATE(XIC_TOTAL_NUMBER(0,0))
- ALLOCATE(XCG_TOTAL_NUMBER(0,0))
- ALLOCATE(XUMFCONV(0,0,0))
- ALLOCATE(XDMFCONV(0,0,0))
- ALLOCATE(XPRLFLXCONV(0,0,0))
- ALLOCATE(XPRSFLXCONV(0,0,0))
- ALLOCATE(XCAPE(0,0))
- ALLOCATE(NCLTOPCONV(0,0))
- ALLOCATE(NCLBASCONV(0,0))
-END IF
-!
-IF ((CDCONV == 'KAFR' .OR. CSCONV == 'KAFR') &
- .AND. LSUBG_COND .AND. LSIG_CONV) THEN
- ALLOCATE(XMFCONV(IIU,IJU,IKU))
-ELSE
- ALLOCATE(XMFCONV(0,0,0))
-ENDIF
-!
-IF ((CDCONV == 'KAFR' .OR. CSCONV == 'KAFR') &
- .AND. LCHTRANS .AND. NSV > 0 ) THEN
- ALLOCATE(XDSVCONV(IIU,IJU,IKU,NSV))
-ELSE
- ALLOCATE(XDSVCONV(0,0,0,0))
-END IF
-!
-ALLOCATE(XCF_MF(IIU,IJU,IKU)) ; XCF_MF=0.0
-ALLOCATE(XRC_MF(IIU,IJU,IKU)) ; XRC_MF=0.0
-ALLOCATE(XRI_MF(IIU,IJU,IKU)) ; XRI_MF=0.0
-!
-!* 3.9 Local variables
-!
-ALLOCATE(ZJ(IIU,IJU,IKU))
-!
-!* 3.10 Forcing variables (Module MODD_FRC and MODD_FRCn)
-!
-IF ( LFORCING ) THEN
- ALLOCATE(XWTFRC(IIU,IJU,IKU)) ; XWTFRC = XUNDEF
- ALLOCATE(XUFRC_PAST(IIU,IJU,IKU)) ; XUFRC_PAST = XUNDEF
- ALLOCATE(XVFRC_PAST(IIU,IJU,IKU)) ; XVFRC_PAST = XUNDEF
-ELSE
- ALLOCATE(XWTFRC(0,0,0))
- ALLOCATE(XUFRC_PAST(0,0,0))
- ALLOCATE(XVFRC_PAST(0,0,0))
-END IF
-!
-IF (KMI == 1) THEN
- IF ( LFORCING ) THEN
- ALLOCATE(TDTFRC(NFRC))
- ALLOCATE(XUFRC(IKU,NFRC))
- ALLOCATE(XVFRC(IKU,NFRC))
- ALLOCATE(XWFRC(IKU,NFRC))
- ALLOCATE(XTHFRC(IKU,NFRC))
- ALLOCATE(XRVFRC(IKU,NFRC))
- ALLOCATE(XTENDTHFRC(IKU,NFRC))
- ALLOCATE(XTENDRVFRC(IKU,NFRC))
- ALLOCATE(XGXTHFRC(IKU,NFRC))
- ALLOCATE(XGYTHFRC(IKU,NFRC))
- ALLOCATE(XPGROUNDFRC(NFRC))
- ALLOCATE(XTENDUFRC(IKU,NFRC))
- ALLOCATE(XTENDVFRC(IKU,NFRC))
- ELSE
- ALLOCATE(TDTFRC(0))
- ALLOCATE(XUFRC(0,0))
- ALLOCATE(XVFRC(0,0))
- ALLOCATE(XWFRC(0,0))
- ALLOCATE(XTHFRC(0,0))
- ALLOCATE(XRVFRC(0,0))
- ALLOCATE(XTENDTHFRC(0,0))
- ALLOCATE(XTENDRVFRC(0,0))
- ALLOCATE(XGXTHFRC(0,0))
- ALLOCATE(XGYTHFRC(0,0))
- ALLOCATE(XPGROUNDFRC(0))
- ALLOCATE(XTENDUFRC(0,0))
- ALLOCATE(XTENDVFRC(0,0))
- END IF
-ELSE
- !Do not allocate because they are the same on all grids (not 'n' variables)
-END IF
-! ----------------------------------------------------------------------
-!
-IF (L2D_ADV_FRC) THEN
- WRITE(ILUOUT,*) 'L2D_ADV_FRC IS SET TO', L2D_ADV_FRC
- WRITE(ILUOUT,*) 'ADV FRC WILL BE SET'
- ALLOCATE(TDTADVFRC(NADVFRC))
- ALLOCATE(XDTHFRC(IIU,IJU,IKU,NADVFRC)) ; XDTHFRC=0.
- ALLOCATE(XDRVFRC(IIU,IJU,IKU,NADVFRC)) ; XDRVFRC=0.
-ELSE
- ALLOCATE(TDTADVFRC(0))
- ALLOCATE(XDTHFRC(0,0,0,0))
- ALLOCATE(XDRVFRC(0,0,0,0))
-ENDIF
-
-IF (L2D_REL_FRC) THEN
- WRITE(ILUOUT,*) 'L2D_REL_FRC IS SET TO', L2D_REL_FRC
- WRITE(ILUOUT,*) 'REL FRC WILL BE SET'
- ALLOCATE(TDTRELFRC(NRELFRC))
- ALLOCATE(XTHREL(IIU,IJU,IKU,NRELFRC)) ; XTHREL=0.
- ALLOCATE(XRVREL(IIU,IJU,IKU,NRELFRC)) ; XRVREL=0.
-ELSE
- ALLOCATE(TDTRELFRC(0))
- ALLOCATE(XTHREL(0,0,0,0))
- ALLOCATE(XRVREL(0,0,0,0))
-ENDIF
-!
-!* 4.11 BIS: Eddy fluxes allocation
-!
-IF ( LTH_FLX ) THEN
- ALLOCATE(XVTH_FLUX_M(IIU,IJU,IKU)) ; XVTH_FLUX_M = 0.
- ALLOCATE(XWTH_FLUX_M(IIU,IJU,IKU)) ; XWTH_FLUX_M = 0.
- IF (KMI /= 1) THEN
- ALLOCATE(XRTHS_EDDY_FLUX(IIU,IJU,IKU))
- XRTHS_EDDY_FLUX = 0.
- ELSE
- ALLOCATE(XRTHS_EDDY_FLUX(0,0,0))
- ENDIF
-ELSE
- ALLOCATE(XVTH_FLUX_M(0,0,0))
- ALLOCATE(XWTH_FLUX_M(0,0,0))
- ALLOCATE(XRTHS_EDDY_FLUX(0,0,0))
-END IF
-!
-IF ( LUV_FLX) THEN
- ALLOCATE(XVU_FLUX_M(IIU,IJU,IKU)) ; XVU_FLUX_M = 0.
- IF (KMI /= 1) THEN
- ALLOCATE(XRVS_EDDY_FLUX(IIU,IJU,IKU))
- XRVS_EDDY_FLUX = 0.
- ELSE
- ALLOCATE(XRVS_EDDY_FLUX(0,0,0))
- ENDIF
-ELSE
- ALLOCATE(XVU_FLUX_M(0,0,0))
- ALLOCATE(XRVS_EDDY_FLUX(0,0,0))
-END IF
-!
-!* 3.11 Module MODD_ICE_CONC_n
-!
-IF ( (CCLOUD == 'ICE3'.OR.CCLOUD == 'ICE4') .AND. &
- (CPROGRAM == 'DIAG '.OR.CPROGRAM == 'MESONH')) THEN
- ALLOCATE(XCIT(IIU,IJU,IKU))
-ELSE
- ALLOCATE(XCIT(0,0,0))
-END IF
-!
-IF ( CCLOUD == 'KHKO' .OR. CCLOUD == 'C2R2') THEN
- ALLOCATE(XSUPSAT(IIU,IJU,IKU))
- ALLOCATE(XNACT(IIU,IJU,IKU))
- ALLOCATE(XNPRO(IIU,IJU,IKU))
- ALLOCATE(XSSPRO(IIU,IJU,IKU))
-ELSE
- ALLOCATE(XSUPSAT(0,0,0))
- ALLOCATE(XNACT(0,0,0))
- ALLOCATE(XNPRO(0,0,0))
- ALLOCATE(XSSPRO(0,0,0))
-END IF
-!
-!* 3.12 Module MODD_TURB_CLOUD
-!
-IF (LCLOUDMODIFLM) THEN
- ALLOCATE(XCEI(IIU,IJU,IKU))
-ELSE
- ALLOCATE(XCEI(0,0,0))
-ENDIF
-!
-!* 3.13 Module MODD_CH_PH_n
-!
-IF (LUSECHAQ.AND.(CPROGRAM == 'DIAG '.OR.CPROGRAM == 'MESONH')) THEN
- IF (LCH_PH) THEN
- ALLOCATE(XPHC(IIU,IJU,IKU))
- IF (NRRL==2) THEN
- ALLOCATE(XPHR(IIU,IJU,IKU))
- ALLOCATE(XACPHR(IIU,IJU))
- XACPHR(:,:) = 0.
- ENDIF
- ENDIF
- IF (NRRL==2) THEN
- ALLOCATE(XACPRAQ(IIU,IJU,NSV_CHAC/2))
- XACPRAQ(:,:,:) = 0.
- ENDIF
-ENDIF
-IF (.NOT.(ASSOCIATED(XPHC))) ALLOCATE(XPHC(0,0,0))
-IF (.NOT.(ASSOCIATED(XPHR))) ALLOCATE(XPHR(0,0,0))
-IF (.NOT.(ASSOCIATED(XACPHR))) ALLOCATE(XACPHR(0,0))
-IF (.NOT.(ASSOCIATED(XACPRAQ))) ALLOCATE(XACPRAQ(0,0,0))
-IF ((LUSECHEM).AND.(CPROGRAM == 'DIAG ')) THEN
- ALLOCATE(XCHFLX(IIU,IJU,NSV_CHEM))
- XCHFLX(:,:,:) = 0.
-ELSE
- ALLOCATE(XCHFLX(0,0,0))
-END IF
-!
-!* 3.14 Module MODD_DRAG
-!
-IF (LDRAG) THEN
- ALLOCATE(XDRAG(IIU,IJU))
-ELSE
- ALLOCATE(XDRAG(0,0))
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. INITIALIZE BUDGET VARIABLES
-! ---------------------------
-!
-gles = lles_mean .or. lles_resolved .or. lles_subgrid .or. lles_updraft &
- .or. lles_downdraft .or. lles_spectra
-!Called if budgets are enabled via NAM_BUDGET
-!or if LES budgets are enabled via NAM_LES (condition on kmi==1 to call it max once)
-if ( ( cbutype /= "NONE" .and. nbumod == kmi ) .or. ( ( gles .or. lcheck ) .and. kmi == 1 ) ) THEN
- call Budget_preallocate()
-end if
-CALL TBUCONF_ASSOCIATE()
-IF ( CBUTYPE /= "NONE" .AND. NBUMOD == KMI ) THEN
- CALL Ini_budget(ILUOUT,XTSTEP,NSV,NRR, &
- LNUMDIFU,LNUMDIFTH,LNUMDIFSV, &
- LHORELAX_UVWTH,LHORELAX_RV, LHORELAX_RC,LHORELAX_RR, &
- LHORELAX_RI,LHORELAX_RS,LHORELAX_RG, LHORELAX_RH,LHORELAX_TKE, &
- LHORELAX_SV, LVE_RELAX, LVE_RELAX_GRD, &
- LCHTRANS,LNUDGING,LDRAGTREE,LDEPOTREE,LMAIN_EOL, &
- CRAD,CDCONV,CSCONV,CTURB,CTURBDIM,CCLOUD )
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 5. INITIALIZE INTERPOLATION COEFFICIENTS
-!
-CALL INI_BIKHARDT_n (NDXRATIO_ALL(KMI),NDYRATIO_ALL(KMI),KMI)
-!
-!-------------------------------------------------------------------------------
-!
-!* 6. BUILT THE GENERIC OUTPUT NAME
-! ----------------------------
-!
-IF (KMI == 1) THEN
- DO IMI = 1 , NMODEL
- WRITE(IO_SURF_MNH_MODEL(IMI)%COUTFILE,'(A,".",I1,".",A)') CEXP,IMI,TRIM(ADJUSTL(CSEG))
- WRITE(YNAME, '(A,".",I1,".",A)') CEXP,IMI,TRIM(ADJUSTL(CSEG))//'.000'
- CALL IO_File_add2list(LUNIT_MODEL(IMI)%TDIAFILE,YNAME,'MNHDIACHRONIC','WRITE', &
- HDIRNAME=CIO_DIR, &
- KLFINPRAR=INT(50,KIND=LFIINT),KLFITYPE=1,KLFIVERB=NVERB, &
- TPDADFILE=LUNIT_MODEL(NDAD(IMI))%TDIAFILE )
- END DO
- !
- TDIAFILE => LUNIT_MODEL(KMI)%TDIAFILE !Necessary because no call to GOTO_MODEL before needing it
- !
- IF (CPROGRAM=='MESONH') THEN
- IF ( NDAD(KMI) == 1) CDAD_NAME(KMI) = CEXP//'.1.'//CSEG
- IF ( NDAD(KMI) == 2) CDAD_NAME(KMI) = CEXP//'.2.'//CSEG
- IF ( NDAD(KMI) == 3) CDAD_NAME(KMI) = CEXP//'.3.'//CSEG
- IF ( NDAD(KMI) == 4) CDAD_NAME(KMI) = CEXP//'.4.'//CSEG
- IF ( NDAD(KMI) == 5) CDAD_NAME(KMI) = CEXP//'.5.'//CSEG
- IF ( NDAD(KMI) == 6) CDAD_NAME(KMI) = CEXP//'.6.'//CSEG
- IF ( NDAD(KMI) == 7) CDAD_NAME(KMI) = CEXP//'.7.'//CSEG
- IF ( NDAD(KMI) == 8) CDAD_NAME(KMI) = CEXP//'.8.'//CSEG
- END IF
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 7. INITIALIZE GRIDS AND METRIC COEFFICIENTS
-! ----------------------------------------
-!
-CALL SET_GRID( KMI, TPINIFILE, IKU, NIMAX_ll, NJMAX_ll, &
- XTSTEP, XSEGLEN, &
- XLONORI, XLATORI, XLON, XLAT, &
- XXHAT, XYHAT, XDXHAT, XDYHAT, XXHATM, XYHATM, &
- XXHAT_ll, XYHAT_ll, XXHATM_ll, XYHATM_ll, &
- XHAT_BOUND, XHATM_BOUND, &
- XMAP, XZS, XZZ, XZHAT, XZHATM, XZTOP, LSLEVE, &
- XLEN1, XLEN2, XZSMT, ZJ, &
- TDTMOD, TDTCUR, NSTOP, NBAK_NUMB, NOUT_NUMB, TBACKUPN, TOUTPUTN )
-!
-CALL METRICS(XMAP,XDXHAT,XDYHAT,XZZ,XDXX,XDYY,XDZX,XDZY,XDZZ)
-!
-!* update halos of metric coefficients
-!
-!
-CALL UPDATE_METRICS(CLBCX,CLBCY,XDXX,XDYY,XDZX,XDZY,XDZZ)
-!
-!
-CALL SET_DIRCOS(CLBCX,CLBCY,XDXX,XDYY,XDZX,XDZY,TZINITHALO2D_ll, &
- XDIRCOSXW,XDIRCOSYW,XDIRCOSZW,XCOSSLOPE,XSINSLOPE )
-!
-! grid nesting initializations
-IF ( KMI == 1 ) THEN
- XTSTEP_MODEL1=XTSTEP
-END IF
-!
-NDT_2_WAY(KMI)=4
-!
-!-------------------------------------------------------------------------------
-!
-!* 8. INITIALIZE DATA FOR JVALUES AND AEROSOLS
-!
-IF ( LUSECHEM .OR. LCHEMDIAG ) THEN
- IF ((KMI==1).AND.(CPROGRAM == "MESONH".OR.CPROGRAM == "DIAG ")) &
- CALL CH_INIT_JVALUES(TDTCUR%nday, TDTCUR%nmonth, &
- TDTCUR%nyear, ILUOUT, XCH_TUV_DOBNEW)
-!
- IF (LORILAM) THEN
- CALL CH_AER_MOD_INIT
- ENDIF
-END IF
-IF (.NOT.(ASSOCIATED(XMI))) ALLOCATE(XMI(0,0,0,0))
-IF (.NOT.(ASSOCIATED(XSOLORG))) ALLOCATE(XSOLORG(0,0,0,0))
-!
-IF (CCLOUD=='LIMA') CALL INIT_AEROSOL_PROPERTIES
-!
-!
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 9. FIRE initializations
-! --------------------
-!
-IF(LBLAZE) THEN
- !
- ! 9.1 Array allocation
- ! ----------------
- !
- ! Level Set function
- ALLOCATE(XLSPHI(IIU,IJU,NREFINX*NREFINY)); XLSPHI(:,:,:) = 0.
-
- ! BMap array
- ! BMap default value
- ! -1 = The fire is not here yet
- ALLOCATE(XBMAP(IIU,IJU,NREFINX*NREFINY)); XBMAP(:,:,:) = -1.
-
- ! A array
- ALLOCATE(XFMRFA(IIU,IJU,NREFINX*NREFINY)); XFMRFA(:,:,:) = 0.
-
- ! Wf0 array
- ALLOCATE(XFMWF0(IIU,IJU,NREFINX*NREFINY)); XFMWF0(:,:,:) = 0.
-
- ! R0 array
- ALLOCATE(XFMR0(IIU,IJU,NREFINX*NREFINY)); XFMR0(:,:,:) = 0.
-
- ! r00 array
- ALLOCATE(XFMR00(IIU,IJU,NREFINX*NREFINY)); XFMR00(:,:,:) = 0.
-
- ! Ignition
- ! Default value as 1E6 : Ignition long after simulation end time
- ! 1E6 should be enough as it is more than 11 days
- ALLOCATE(XFMIGNITION(IIU,IJU,NREFINX*NREFINY)); XFMIGNITION(:,:,:) = 1.E6
-
- ! Fuel type
- ALLOCATE(XFMFUELTYPE(IIU,IJU,NREFINX*NREFINY)); XFMFUELTYPE(:,:,:) = 0.
-
- ! Residence time function
- ALLOCATE(XFIRETAU(IIU,IJU,NREFINX*NREFINY)); XFIRETAU(:,:,:) = 0.
-
- ! Rate of spread with wind
- ALLOCATE(XFIRERW(IIU,IJU,NREFINX*NREFINY)); XFIRERW(:,:,:) = 0.
-
- ! Sensible heat flux parameters
- ! get number of parameters
- SELECT CASE(CHEAT_FLUX_MODEL)
- CASE('CST')
- ! 1 parameter for model : nominal injection value
- INBPARAMSENSIBLE = 1
-
- CASE('EXP')
- ! 2 parameters for model : Max value and characteristic time
- INBPARAMSENSIBLE = 2
-
- CASE('EXS')
- ! 3 parameters for model : Max value and characteristic time, smoldering injection value
- INBPARAMSENSIBLE = 3
- END SELECT
-
- ALLOCATE(XFLUXPARAMH(IIU,IJU,NREFINX*NREFINY,INBPARAMSENSIBLE));
- XFLUXPARAMH(:,:,:,:) = 0.
-
- ! Latent heat flux parameters
- ! get number of parameters
- SELECT CASE(CLATENT_FLUX_MODEL)
- CASE('CST')
- ! 1 parameter for model : nominal injection value
- INBPARAMLATENT = 1
-
- CASE('EXP')
- ! 2 parameters for model : Max value and characteristic time
- INBPARAMLATENT = 2
- END SELECT
-
- ALLOCATE(XFLUXPARAMW(IIU,IJU,NREFINX*NREFINY,INBPARAMLATENT));
- XFLUXPARAMW(:,:,:,:) = 0.
-
- ! Available Sensible energy
- ALLOCATE(XFMASE(IIU,IJU,NREFINX*NREFINY)); XFMASE(:,:,:) = 0.
-
- ! Available Latent energy
- ALLOCATE(XFMAWC(IIU,IJU,NREFINX*NREFINY)); XFMAWC(:,:,:) = 0.
-
- ! Walking Ignition map (Arrival time matrix for ignition)
- ALLOCATE(XFMWALKIG(IIU,IJU,NREFINX*NREFINY)); XFMWALKIG(:,:,:) = -1.
-
- ! Sensible heat flux (W/m2)
- ALLOCATE(XFMFLUXHDH(IIU,IJU,NREFINX*NREFINY)); XFMFLUXHDH(:,:,:) = 0.
-
- ! Latent heat flux (kg/s/m2)
- ALLOCATE(XFMFLUXHDW(IIU,IJU,NREFINX*NREFINY)); XFMFLUXHDW(:,:,:) = 0.
-
- ! filtered wind on front normal (m/s)
- ALLOCATE(XFMHWS(IIU,IJU,NREFINX*NREFINY)); XFMHWS(:,:,:) = 0.
-
- ! filtered wind U (m/s)
- ALLOCATE(XFMWINDU(IIU,IJU,NREFINX*NREFINY)); XFMWINDU(:,:,:) = 0.
-
- ! filtered wind V (m/s)
- ALLOCATE(XFMWINDV(IIU,IJU,NREFINX*NREFINY)); XFMWINDV(:,:,:) = 0.
-
- ! filtered wind W (m/s)
- ALLOCATE(XFMWINDW(IIU,IJU,NREFINX*NREFINY)); XFMWINDW(:,:,:) = 0.
-
- ! Gradient of Level Set on x
- ALLOCATE(XGRADLSPHIX(IIU,IJU,NREFINX*NREFINY)); XGRADLSPHIX(:,:,:) = 0.
-
- ! Gradient of Level Set on y
- ALLOCATE(XGRADLSPHIY(IIU,IJU,NREFINX*NREFINY)); XGRADLSPHIY(:,:,:) = 0.
-
- ! Wind for fire
- ALLOCATE(XFIREWIND(IIU,IJU,NREFINX*NREFINY)); XFIREWIND(:,:,:) = 0.
-
- ! Orographic gradient on fire mesh
- ALLOCATE(XFMGRADOROX(IIU,IJU,NREFINX*NREFINY)); XFMGRADOROX(:,:,:) = 0.
- ALLOCATE(XFMGRADOROY(IIU,IJU,NREFINX*NREFINY)); XFMGRADOROY(:,:,:) = 0.
- !
- ! 9.2 Array 2d fire mesh allocation
- ! -----------------------------
- !
- ! Level Set 2d
- ALLOCATE(XLSPHI2D(IIU*NREFINX,IJU*NREFINY)); XLSPHI2D(:,:) = 0.
- ! Gradient of Level Set on x 2d
- ALLOCATE(XGRADLSPHIX2D(IIU*NREFINX,IJU*NREFINY)); XGRADLSPHIX2D(:,:) = 0.
-
- ! Gradient of Level Set on y 2d
- ALLOCATE(XGRADLSPHIY2D(IIU*NREFINX,IJU*NREFINY)); XGRADLSPHIY2D(:,:) = 0.
-
- ! Level Set mask on x 2d
- ALLOCATE(XGRADMASKX(IIU*NREFINX,IJU*NREFINY)); XGRADMASKX(:,:) = 0.
-
- ! Level Set mask on y 2d
- ALLOCATE(XGRADMASKY(IIU*NREFINX,IJU*NREFINY)); XGRADMASKY(:,:) = 0.
-
- ! burnt surface ratio 2d
- ALLOCATE(XSURFRATIO2D(IIU*NREFINX,IJU*NREFINY)); XSURFRATIO2D(:,:) = 0.
-
- ! Level Set diffusuon x 2d
- ALLOCATE(XLSDIFFUX2D(IIU*NREFINX,IJU*NREFINY)); XLSDIFFUX2D(:,:) = 0.
-
- ! Level Set diffusion y 2d
- ALLOCATE(XLSDIFFUY2D(IIU*NREFINX,IJU*NREFINY)); XLSDIFFUY2D(:,:) = 0.
-
- ! ROS diffusion 2d
- ALLOCATE(XFIRERW2D(IIU*NREFINX,IJU*NREFINY)); XFIRERW2D(:,:) = 0.
- !
- ! 9.3 Compute fire mesh size
- ! ----------------------
- !
- XFIREMESHSIZE(1) = (XXHAT(2) - XXHAT(1)) / REAL(NREFINX)
- XFIREMESHSIZE(2) = (XYHAT(2) - XYHAT(1)) / REAL(NREFINY)
- !
-ELSE
- !
- ! 9.4 Default allocation
- ! ------------------
- !
- ! 3d array
- ALLOCATE(XLSPHI(0,0,0))
- ALLOCATE(XBMAP(0,0,0))
- ALLOCATE(XFMRFA(0,0,0))
- ALLOCATE(XFMR0(0,0,0))
- ALLOCATE(XFMWF0(0,0,0))
- ALLOCATE(XFMR00(0,0,0))
- ALLOCATE(XFMIGNITION(0,0,0))
- ALLOCATE(XFMFUELTYPE(0,0,0))
- ALLOCATE(XFIRETAU(0,0,0))
- ALLOCATE(XFIRERW(0,0,0))
- ALLOCATE(XFLUXPARAMH(0,0,0,0))
- ALLOCATE(XFLUXPARAMW(0,0,0,0))
- ALLOCATE(XFMASE(0,0,0))
- ALLOCATE(XFMAWC(0,0,0))
- ALLOCATE(XFMWALKIG(0,0,0))
- ALLOCATE(XFMFLUXHDH(0,0,0))
- ALLOCATE(XFMFLUXHDW(0,0,0))
- ALLOCATE(XFMHWS(0,0,0))
- ALLOCATE(XFMWINDU(0,0,0))
- ALLOCATE(XFMWINDV(0,0,0))
- ALLOCATE(XFMWINDW(0,0,0))
- ALLOCATE(XGRADLSPHIX(0,0,0))
- ALLOCATE(XGRADLSPHIY(0,0,0))
- ALLOCATE(XFIREWIND(0,0,0))
- ALLOCATE(XFMGRADOROX(0,0,0))
- ALLOCATE(XFMGRADOROY(0,0,0))
- ! 2d array
- ALLOCATE(XLSPHI2D(0,0))
- ALLOCATE(XGRADLSPHIX2D(0,0))
- ALLOCATE(XGRADLSPHIY2D(0,0))
- ALLOCATE(XGRADMASKX(0,0))
- ALLOCATE(XGRADMASKY(0,0))
- ALLOCATE(XSURFRATIO2D(0,0))
- ALLOCATE(XLSDIFFUX2D(0,0))
- ALLOCATE(XLSDIFFUY2D(0,0))
- ALLOCATE(XFIRERW2D(0,0))
-END IF
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 9. INITIALIZE THE PROGNOSTIC FIELDS
-! --------------------------------
-!
-CALL MPPDB_CHECK3D(XUT,"INI_MODEL_N-before read_field::XUT",PRECISION)
-CALL READ_FIELD(KMI,TPINIFILE,IIU,IJU,IKU, &
- CGETTKET,CGETRVT,CGETRCT,CGETRRT,CGETRIT,CGETCIT,CGETZWS, &
- CGETRST,CGETRGT,CGETRHT,CGETSVT,CGETSRCT,CGETSIGS,CGETCLDFR, &
- CGETICEFR, CGETBL_DEPTH,CGETSBL_DEPTH,CGETPHC,CGETPHR, &
- CUVW_ADV_SCHEME, CTEMP_SCHEME, &
- NSIZELBX_ll, NSIZELBXU_ll, NSIZELBY_ll, NSIZELBYV_ll, &
- NSIZELBXTKE_ll,NSIZELBYTKE_ll, &
- NSIZELBXR_ll,NSIZELBYR_ll,NSIZELBXSV_ll,NSIZELBYSV_ll, &
- XUM,XVM,XWM,XDUM,XDVM,XDWM, &
- XUT,XVT,XWT,XTHT,XPABST,XTKET,XRTKEMS, &
- XRT,XSVT,XZWS,XCIT,XDRYMASST,XDRYMASSS, &
- XSIGS,XSRCT,XCLDFR,XICEFR, XBL_DEPTH,XSBL_DEPTH,XWTHVMF, &
- XPHC,XPHR, XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XLSZWSM, &
- XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM, &
- XLBXRM,XLBXSVM, &
- XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM, &
- XLBYRM,XLBYSVM, &
- NFRC,TDTFRC,XUFRC,XVFRC,XWFRC,XTHFRC,XRVFRC, &
- XTENDTHFRC,XTENDRVFRC,XGXTHFRC,XGYTHFRC, &
- XPGROUNDFRC, XATC, &
- XTENDUFRC, XTENDVFRC, &
- NADVFRC,TDTADVFRC,XDTHFRC,XDRVFRC, &
- NRELFRC,TDTRELFRC,XTHREL,XRVREL, &
- XVTH_FLUX_M,XWTH_FLUX_M,XVU_FLUX_M, &
- XRUS_PRES,XRVS_PRES,XRWS_PRES,XRTHS_CLD,XRRS_CLD,XRSVS_CLD, &
- ZIBM_LS,XIBM_XMUT,XUMEANW,XVMEANW,XWMEANW,XUMEANN,XVMEANN, &
- XWMEANN,XUMEANE,XVMEANE,XWMEANE,XUMEANS,XVMEANS,XWMEANS, &
- XLSPHI, XBMAP, XFMASE, XFMAWC, XFMWINDU, XFMWINDV, XFMWINDW, XFMHWS )
-
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 10. INITIALIZE REFERENCE STATE
-! ---------------------------
-!
-!
-CALL SET_REF( KMI, TPINIFILE, &
- XZZ, XZHATM, ZJ, XDXX, XDYY, CLBCX, CLBCY, &
- XREFMASS, XMASS_O_PHI0, XLINMASS, &
- XRHODREF, XTHVREF, XRVREF, XEXNREF, XRHODJ )
-!
-!-------------------------------------------------------------------------------
-!
-!* 10.1 INITIALIZE THE TURBULENCE VARIABLES
-! -----------------------------------
-!
-IF(LSTATNW) THEN
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_MODEL_n','LSTATNW option not tested in Meso-NH')
-ENDIF
-CALL INI_TURB(CPROGRAM)
-IF ((CTURB == 'TKEL').AND.(CCONF=='START')) THEN
- CALL MPPDB_CHECK3D(XUT,"INI_MODEL_N-before ini_tke_eps::XUT",PRECISION)
- CALL INI_TKE_EPS(CGETTKET,XTHVREF,XZZ, &
- XUT,XVT,XTHT, &
- XTKET,TZINITHALO3D_ll )
- CALL MPPDB_CHECK3D(XUT,"INI_MODEL_N-after ini_tke_eps::XUT",PRECISION)
-END IF
-!
-!
-!* 10.2 INITIALIZE THE LES VARIABLES
-! ----------------------------
-!
-CALL INI_LES_n
-!
-!-------------------------------------------------------------------------------
-!
-!* 11. INITIALIZE THE SOURCE OF TOTAL DRY MASS Md
-! ------------------------------------------
-!
-IF((KMI==1).AND.LSTEADYLS .AND. (CCONF=='START') ) THEN
- XDRYMASSS = 0.
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 12. INITIALIZE THE MICROPHYSICS
-! ----------------------------
-!
-IF (CELEC == 'NONE') THEN
- CALL INI_MICRO_n(TPINIFILE,ILUOUT)
-!
-!-------------------------------------------------------------------------------
-!
-!* 13. INITIALIZE THE ATMOSPHERIC ELECTRICITY
-! --------------------------------------
-!
-ELSE
- CALL INI_ELEC_n(ILUOUT, CELEC, CCLOUD, TPINIFILE, &
- XTSTEP, XZZ, &
- XDXX, XDYY, XDZZ, XDZX, XDZY )
-!
- WRITE (UNIT=ILUOUT,&
- FMT='(/,"ELECTRIC VARIABLES ARE BETWEEN INDEX",I2," AND ",I2)')&
- NSV_ELECBEG, NSV_ELECEND
-!
- IF( CGETSVT(NSV_ELECBEG)=='INIT' ) THEN
- XSVT(:,:,:,NSV_ELECBEG) = XCION_POS_FW(:,:,:) ! Nb/kg
- XSVT(:,:,:,NSV_ELECEND) = XCION_NEG_FW(:,:,:)
-!
- XSVT(:,:,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
- ELSE ! Convert elec_variables per m3 into elec_variables per kg of air
- DO JSV = NSV_ELECBEG, NSV_ELECEND
- XSVT(:,:,:,JSV) = XSVT(:,:,:,JSV) / XRHODREF(:,:,:)
- ENDDO
- END IF
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 14. INITIALIZE THE LARGE SCALE SOURCES
-! ----------------------------------
-!
-IF ((KMI==1).AND.(.NOT. LSTEADYLS)) THEN
- CALL MPPDB_CHECK3D(XUT,"INI_MODEL_N-before ini_cpl::XUT",PRECISION)
- CALL INI_CPL(NSTOP,XTSTEP,LSTEADYLS,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 )
- CALL MPPDB_CHECK3D(XUT,"INI_MODEL_N-after ini_cpl::XUT",PRECISION)
-!
- 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
-! Blaze smoke
-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
-!
-END IF
-!
-IF ( KMI > 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_XLSUM=>XLSUM
- DPTR_XLSVM=>XLSVM
- DPTR_XLSWM=>XLSWM
- DPTR_XLSTHM=>XLSTHM
- DPTR_XLSRVM=>XLSRVM
- DPTR_XLSZWSM=>XLSZWSM
- DPTR_XLSUS=>XLSUS
- DPTR_XLSVS=>XLSVS
- DPTR_XLSWS=>XLSWS
- DPTR_XLSTHS=>XLSTHS
- DPTR_XLSRVS=>XLSRVS
- DPTR_XLSZWSS=>XLSZWSS
- !
- 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
- !
- CALL INI_SPAWN_LS_n(NDAD(KMI),XTSTEP,KMI, &
- 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(KMI),NDYRATIO_ALL(KMI), &
- DPTR_CLBCX,DPTR_CLBCY,DPTR_XZZ,DPTR_XZHAT, &
- LSLEVE,XLEN1,XLEN2, &
- DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSTHM,DPTR_XLSRVM,DPTR_XLSZWSM, &
- DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS,DPTR_XLSTHS,DPTR_XLSRVS,DPTR_XLSZWSS, &
- 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 )
- !
- 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
- IF (CCONF=='START') THEN
- CALL INI_ONE_WAY_n(NDAD(KMI),KMI, &
- 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(KMI),NDYRATIO_ALL(KMI), &
- 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, &
- 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 )
- ENDIF
-END IF
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 15. INITIALIZE THE SCALAR VARIABLES
-! -------------------------------
-!
-IF (LLG .AND. LINIT_LG .AND. CPROGRAM=='MESONH') &
- CALL INI_LG( XXHATM, XYHATM, XZZ, XSVT, XLBXSVM, XLBYSVM )
-
-!
-!-------------------------------------------------------------------------------
-!
-!* 16. INITIALIZE THE PARAMETERS FOR THE DYNAMICS
-! ------------------------------------------
-!
-CALL INI_DYNAMICS(XLON,XLAT,XRHODJ,XTHVREF,XMAP,XZZ,XDXHAT,XDYHAT, &
- XZHAT,XZHATM,CLBCX,CLBCY,XTSTEP, &
- 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_SVAER,LHORELAX_SVDST,LHORELAX_SVSLT, &
- LHORELAX_SVPP,LHORELAX_SVCS,LHORELAX_SVCHIC,LHORELAX_SVSNW, &
-#ifdef MNH_FOREFIRE
- LHORELAX_SVFF, &
-#endif
- XRIMKMAX,NRIMX,NRIMY, &
- XALKTOP,XALKGRD,XALZBOT,XALZBAS, &
- XT4DIFU,XT4DIFTH,XT4DIFSV, &
- XCORIOX,XCORIOY,XCORIOZ,XCURVX,XCURVY, &
- XDXHATM,XDYHATM,XRHOM,XAF,XBFY,XCF,XTRIGSX,XTRIGSY,NIFAXX,NIFAXY,&
- XALK,XALKW,NALBOT,XALKBAS,XALKWBAS,NALBAS, &
- LMASK_RELAX,XKURELAX,XKVRELAX,XKWRELAX, &
- XDK2U,XDK4U,XDK2TH,XDK4TH,XDK2SV,XDK4SV, &
- LZDIFFU,XZDIFFU_HALO2, &
- XBFB,XBF_SXP2_YP1_Z )
-!
-!
-!* 16.1 Initialize the XDRAG array
-! -------------
-IF (LDRAG) THEN
- CALL INI_DRAG(LMOUNT,XZS,XHSTART,NSTART,XDRAG)
-ENDIF
-!* 16.2 Initialize the LevelSet function
-! -------------
-IF (LIBM) THEN
- ALLOCATE(XIBM_LS(IIU,IJU,IKU,4)) ; XIBM_LS = -XIBM_IEPS
- XIBM_LS(:,:,:,1)=ZIBM_LS(:,:,:)
- DEALLOCATE(ZIBM_LS)
-ENDIF
-!-------------------------------------------------------------------------------
-!
-!* 17. SURFACE FIELDS
-! --------------
-!
-!* 17.1 Radiative setup
-! ---------------
-!
-IF (CRAD /= 'NONE') THEN
- IF (CGETRAD =='INIT') THEN
- GINIRAD =.TRUE.
- ELSE
- GINIRAD =.FALSE.
- END IF
- CALL INI_RADIATIONS(TPINIFILE,GINIRAD,TDTCUR,TDTEXP,XZZ, &
- XDXX, XDYY, &
- XSINDEL,XCOSDEL,XTSIDER,XCORSOL, &
- XSLOPANG,XSLOPAZI, &
- XDTHRAD,XDIRFLASWD,XSCAFLASWD, &
- XFLALWD,XDIRSRFSWD,NCLEARCOL_TM1, &
- XZENITH,XAZIM, &
- TDTRAD_FULL,TDTRAD_CLONLY, &
- TZINITHALO2D_ll, &
- XRADEFF,XSWU,XSWD,XLWU, &
- XLWD,XDTHRADSW,XDTHRADLW )
- !
- IF (GINIRAD) CALL SUNPOS_n(XZENITH,PAZIMSOL=XAZIM)
- CALL SURF_SOLAR_GEOM (XZS, XZS_XY)
- !
- ALLOCATE(XZS_ll (IIU_ll,IJU_ll))
- ALLOCATE(XZS_XY_ll (IIU_ll,IJU_ll))
- !
- CALL GATHERALL_FIELD_ll('XY',XZS,XZS_ll,IRESP)
- CALL GATHERALL_FIELD_ll('XY',XZS_XY,XZS_XY_ll,IRESP)
- XZS_MAX_ll=MAXVAL(XZS_ll)
-ELSE
- XAZIM = XPI
- XZENITH = XPI/2.
- XDIRSRFSWD = 0.
- XSCAFLASWD = 0.
- XFLALWD = 300. ! W/m2
- XTSIDER = 0.
-END IF
-!
-!
-CALL INI_SW_SETUP (CRAD,NSWB_MNH,XSW_BANDS)
-CALL INI_LW_SETUP (CRAD,NLWB_MNH,XLW_BANDS)
-!
-!
-! 17.1.1 Special initialisation for CO2 content
-! CO2 (molar mass=44) horizontally and vertically homogeneous at 360 ppm
-!
-XCCO2 = 360.0E-06 * 44.0E-03 / XMD
-#ifdef MNH_ECRAD
-RCCO2 = 360.0E-06 * 44.0E-03 / XMD
-#endif
-!
-!
-!* 17.2 Externalized surface fields
-! ---------------------------
-!
-ALLOCATE(ZCO2(IIU,IJU))
-ZCO2(:,:) = XCCO2
-!
-
-ALLOCATE(ZDIR_ALB(IIU,IJU,NSWB_MNH))
-ALLOCATE(ZSCA_ALB(IIU,IJU,NSWB_MNH))
-ALLOCATE(ZEMIS (IIU,IJU,NLWB_MNH))
-ALLOCATE(ZTSRAD (IIU,IJU))
-!
-IF (LCOUPLES.AND.(KMI>1))THEN
- CSURF ="NONE"
-ELSE
- IF ((TPINIFILE%NMNHVERSION(1)==4 .AND. TPINIFILE%NMNHVERSION(2)>=6) .OR. TPINIFILE%NMNHVERSION(1)>4) THEN
- CALL IO_Field_read(TPINIFILE,'SURF',CSURF)
- ELSE
- CSURF = "EXTE"
- END IF
-END IF
-!
-!
-IF (CSURF=='EXTE' .AND. (CPROGRAM=='MESONH' .OR. CPROGRAM=='DIAG ')) THEN
- ! ouverture du fichier PGD
- IF ( LEN_TRIM(CINIFILEPGD) > 0 ) THEN
- CALL IO_File_add2list(TINIFILEPGD,TRIM(CINIFILEPGD),'PGD','READ',KLFITYPE=2,KLFIVERB=NVERB)
- CALL IO_File_open(TINIFILEPGD,KRESP=IRESP)
- LUNIT_MODEL(KMI)%TINIFILEPGD => TINIFILEPGD
- IF (IRESP/=0) THEN
- WRITE(ILUOUT,FMT=*) "INI_MODEL_n ERROR TO OPEN THE FILE CINIFILEPGD=",CINIFILEPGD
- WRITE(ILUOUT,FMT=*) "CHECK YOUR NAMELIST NAM_LUNITn"
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_MODEL_n','')
- ENDIF
- ELSE
- ! case after a spawning
- CINIFILEPGD = TPINIFILE%CNAME
- END IF
- !
- CALL GOTO_SURFEX(KMI)
-#ifdef CPLOASIS
- CALL SFX_OASIS_READ_NAM(CPROGRAM,XTSTEP)
- WRITE(*,*) 'SFX-OASIS: READ NAM_SFX_SEA_CPL OK'
-#endif
- !* initialization of surface
- CALL INIT_GROUND_PARAM_n ('ALL',SIZE(CSV),CSV,ZCO2, &
- XZENITH,XAZIM,XSW_BANDS,XLW_BANDS,ZDIR_ALB,ZSCA_ALB, &
- ZEMIS,ZTSRAD )
- !
- IF (SIZE(XEMIS)>0) THEN
- XDIR_ALB = ZDIR_ALB
- XSCA_ALB = ZSCA_ALB
- XEMIS = ZEMIS
- XTSRAD = ZTSRAD
- CALL MNHGET_SURF_PARAM_n (PSEA=XSEA)
- END IF
-ELSE
- !* fields not physically necessary, but must be initialized
- IF (SIZE(XEMIS)>0) THEN
- XDIR_ALB = 0.
- XSCA_ALB = 0.
- XEMIS = 1.
- XTSRAD = XTT
- XSEA = 1.
- END IF
-END IF
-IF (CSURF=='EXTE' .AND. (CPROGRAM=='SPAWN ')) THEN
- ! ouverture du fichier PGD
- CALL IO_File_add2list(TINIFILEPGD,TRIM(CINIFILEPGD),'PGD','READ',KLFITYPE=2,KLFIVERB=NVERB)
- CALL IO_File_open(TINIFILEPGD,KRESP=IRESP)
- LUNIT_MODEL(KMI)%TINIFILEPGD => TINIFILEPGD
- IF (IRESP/=0) THEN
- WRITE(ILUOUT,FMT=*) "INI_MODEL_n ERROR TO OPEN THE FILE CINIFILEPGD=",CINIFILEPGD
- WRITE(ILUOUT,FMT=*) "CHECK YOUR NAMELIST NAM_LUNIT2_SPA"
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_MODEL_n','')
- ENDIF
-ENDIF
-!
-IF (.NOT.ASSOCIATED(TINIFILEPGD)) TINIFILEPGD => TFILE_DUMMY
-!
- !* special case after spawning in prep_real_case
-IF (CSURF=='EXRM' .AND. CPROGRAM=='REAL ') CSURF = 'EXTE'
-!
-DEALLOCATE(ZDIR_ALB)
-DEALLOCATE(ZSCA_ALB)
-DEALLOCATE(ZEMIS )
-DEALLOCATE(ZTSRAD )
-!
-DEALLOCATE(ZCO2)
-!
-!
-!* in a RESTART case, reads surface radiative quantities in the MESONH file
-!
-IF ((CRAD == 'ECMW' .OR. CRAD == 'ECRA') .AND. CGETRAD=='READ') THEN
- CALL INI_SURF_RAD(TPINIFILE, XDIR_ALB, XSCA_ALB, XEMIS, XTSRAD)
-END IF
-!
-!
-!* 17.3 Mesonh fields
-! -------------
-!
-IF (CPROGRAM/='REAL ') CALL MNHREAD_ZS_DUMMY_n(TINIFILEPGD)
-!
-!-------------------------------------------------------------------------------
-!
-!* 18. INITIALIZE THE PARAMETERS FOR THE PHYSICS
-! -----------------------------------------
-!
-IF (CRAD == 'ECMW') THEN
-!
-!* get cover mask for aerosols
-!
- IF (CPROGRAM=='MESONH' .OR. CPROGRAM=='DIAG ') THEN
- ALLOCATE(ZSEA(IIU,IJU))
- ALLOCATE(ZTOWN(IIU,IJU))
- ALLOCATE(ZBARE(IIU,IJU))
- IF (CSURF=='EXTE') THEN
- CALL GOTO_SURFEX(KMI)
- CALL MNHGET_SURF_PARAM_n(PSEA=ZSEA,PTOWN=ZTOWN,PBARE=ZBARE)
- ELSE
- ZSEA (:,:) = 1.
- ZTOWN(:,:) = 0.
- ZBARE(:,:) = 0.
- END IF
-!
- IF ( CAOP=='EXPL' .AND. LDUST .AND. KMI==1) THEN
- ALLOCATE( XEXT_COEFF_WVL_LKT_DUST( NMAX_RADIUS_LKT_DUST, NMAX_SIGMA_LKT_DUST, NMAX_WVL_SW_DUST ) )
- ALLOCATE( XEXT_COEFF_550_LKT_DUST( NMAX_RADIUS_LKT_DUST, NMAX_SIGMA_LKT_DUST ) )
- ALLOCATE( XPIZA_LKT_DUST ( NMAX_RADIUS_LKT_DUST, NMAX_SIGMA_LKT_DUST, NMAX_WVL_SW_DUST ) )
- ALLOCATE( XCGA_LKT_DUST ( NMAX_RADIUS_LKT_DUST, NMAX_SIGMA_LKT_DUST, NMAX_WVL_SW_DUST ) )
- END IF
-!
- IF ( CAOP=='EXPL' .AND. LSALT .AND. KMI==1) THEN
- ALLOCATE( XEXT_COEFF_WVL_LKT_SALT( NMAX_RADIUS_LKT_SALT, NMAX_SIGMA_LKT_SALT, NMAX_WVL_SW_SALT ) )
- ALLOCATE( XEXT_COEFF_550_LKT_SALT( NMAX_RADIUS_LKT_SALT, NMAX_SIGMA_LKT_SALT ) )
- ALLOCATE( XPIZA_LKT_SALT ( NMAX_RADIUS_LKT_SALT, NMAX_SIGMA_LKT_SALT, NMAX_WVL_SW_SALT ) )
- ALLOCATE( XCGA_LKT_SALT ( NMAX_RADIUS_LKT_SALT, NMAX_SIGMA_LKT_SALT, NMAX_WVL_SW_SALT ) )
- END IF
-!
- CALL INI_RADIATIONS_ECMWF (XZHAT,XPABST,XTHT,XTSRAD,XLAT,XLON,TDTCUR,TDTEXP, &
- CLW,NDLON,NFLEV,NFLUX,NRAD,NSWB_OLD,CAER,NAER,NSTATM, &
- XSTATM,ZSEA,ZTOWN,ZBARE,XOZON, XAER,XDST_WL, LSUBG_COND )
-!
- DEALLOCATE(ZSEA,ZTOWN,ZBARE)
- ALLOCATE (XAER_CLIM(SIZE(XAER,1),SIZE(XAER,2),SIZE(XAER,3),SIZE(XAER,4)))
- XAER_CLIM(:,:,:,:) =XAER(:,:,:,:)
-!
- END IF
-
-ELSE IF (CRAD == 'ECRA') THEN
-#ifdef MNH_ECRAD
-!* get cover mask for aerosols
-!
- IF (CPROGRAM=='MESONH' .OR. CPROGRAM=='DIAG ') THEN
- ALLOCATE(ZSEA(IIU,IJU))
- ALLOCATE(ZTOWN(IIU,IJU))
- ALLOCATE(ZBARE(IIU,IJU))
- IF (CSURF=='EXTE') THEN
- CALL GOTO_SURFEX(KMI)
- CALL MNHGET_SURF_PARAM_n(PSEA=ZSEA,PTOWN=ZTOWN,PBARE=ZBARE)
- ELSE
- ZSEA (:,:) = 1.
- ZTOWN(:,:) = 0.
- ZBARE(:,:) = 0.
- END IF
-!
- CALL INI_RADIATIONS_ECRAD (XZHAT,XPABST,XTHT,XTSRAD,XLAT,XLON,TDTCUR,TDTEXP, &
- CLW,NDLON,NFLEV,NFLUX,NRAD,NSWB_OLD,CAER,NAER,NSTATM, &
- XSTATM,ZSEA,ZTOWN,ZBARE,XOZON, XAER,XDST_WL, LSUBG_COND )
-
- DEALLOCATE(ZSEA,ZTOWN,ZBARE)
- ALLOCATE (XAER_CLIM(SIZE(XAER,1),SIZE(XAER,2),SIZE(XAER,3),SIZE(XAER,4)))
- XAER_CLIM(:,:,:,:) = XAER(:,:,:,:)
-!
- END IF
-#endif
-ELSE
- ALLOCATE (XOZON(0,0,0))
- ALLOCATE (XAER(0,0,0,0))
- ALLOCATE (XDST_WL(0,0,0,0))
- ALLOCATE (XAER_CLIM(0,0,0,0))
-END IF
-!
-!
-!
-IF (CDCONV /= 'NONE' .OR. CSCONV == 'KAFR') THEN
- IF (CGETCONV=='INIT') THEN
- GINIDCONV=.TRUE.
- ELSE
- GINIDCONV=.FALSE.
- END IF
-!
-! commensurability between convection calling time and time step
-!
- XDTCONV=XTSTEP*REAL( INT( (MIN(XDTCONV,1800.)+1.E-10)/XTSTEP ) )
- XDTCONV=MAX( XDTCONV, XTSTEP )
- IF (NVERB>=10) THEN
- WRITE(ILUOUT,*) 'XDTCONV has been set to : ',XDTCONV
- END IF
- CALL INI_DEEP_CONVECTION (TPINIFILE,GINIDCONV,TDTCUR, &
- NCOUNTCONV,XDTHCONV,XDRVCONV,XDRCCONV, &
- XDRICONV,XPRCONV,XPRSCONV,XPACCONV, &
- XUMFCONV,XDMFCONV,XMFCONV,XPRLFLXCONV,XPRSFLXCONV,&
- XCAPE,NCLTOPCONV,NCLBASCONV, &
- TDTDCONV, CGETSVCONV, XDSVCONV, &
- LCH_CONV_LINOX, XIC_RATE, XCG_RATE, &
- XIC_TOTAL_NUMBER, XCG_TOTAL_NUMBER )
-
-END IF
-!
-!
-!
-IF (CSCONV == 'EDKF') THEN
- CALL INI_MFSHALL()
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 19. ALLOCATION OF THE TEMPORAL SERIES
-! ---------------------------------
-!
-IF (LSERIES .AND. CPROGRAM/='DIAG ') CALL INI_SERIES_n
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 20. (re)initialize scalar variables
-! -------------------------------
-!
-!
-IF ( LUSECHEM .OR. LCHEMDIAG ) THEN
- IF (CPROGRAM=='MESONH'.AND.CCONF=='RESTA') LCH_INIT_FIELD =.FALSE.
- IF (CPROGRAM=='MESONH'.OR. CPROGRAM=='DIAG ' .OR. CPROGRAM=='IDEAL ') &
- CALL CH_INIT_FIELD_n(KMI, ILUOUT, NVERB)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 21. UPDATE HALO
-! -----------
-!
-!
-CALL UPDATE_HALO_ll(TZINITHALO3D_ll,IINFO_ll)
-CALL UPDATE_HALO_ll(TZINITHALO2D_ll,IINFO_ll)
-CALL CLEANLIST_ll(TZINITHALO3D_ll)
-CALL CLEANLIST_ll(TZINITHALO2D_ll)
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 22. DEALLOCATION
-! -------------
-!
-DEALLOCATE(ZJ)
-!
-DEALLOCATE(XSTROATM)
-DEALLOCATE(XSMLSATM)
-DEALLOCATE(XSMLWATM)
-DEALLOCATE(XSPOSATM)
-DEALLOCATE(XSPOWATM)
-!
-!-------------------------------------------------------------------------------
-!
-!* 23. BALLOON and AIRCRAFT initializations
-! ------------------------------------
-!
-CALL INI_AIRCRAFT_BALLOON( TPINIFILE, XLATORI, XLONORI )
-!
-!-------------------------------------------------------------------------------
-!
-!* 24. STATION initializations
-! -----------------------
-!
-CALL INI_SURFSTATION_n( )
-!
-!-------------------------------------------------------------------------------
-!
-!* 25. PROFILER initializations
-! ------------------------
-!
-CALL INI_POSPROFILER_n( )
-!
-!-------------------------------------------------------------------------------
-!
-!* 26. Prognostic aerosols
-! ------------------------
-!
-IF ( ( CRAD=='ECMW' .OR. CRAD=='ECRA' ) .AND. CAOP=='EXPL' .AND. LORILAM ) THEN
- IF(.NOT.ALLOCATED(POLYTAU)) ALLOCATE(POLYTAU(6,10,8,6,13))
- IF(.NOT.ALLOCATED(POLYSSA)) ALLOCATE(POLYSSA(6,10,8,6,13))
- IF(.NOT.ALLOCATED(POLYG)) ALLOCATE(POLYG (6,10,8,6,13))
- CALL INI_AEROSET1
- CALL INI_AEROSET2
- CALL INI_AEROSET3
- CALL INI_AEROSET4
- CALL INI_AEROSET5
- CALL INI_AEROSET6
-END IF
-#ifdef MNH_FOREFIRE
-!
-!-------------------------------------------------------------------------------
-!
-!* 27. FOREFIRE initializations
-! ------------------------
-!
-
-! Coupling with ForeFire if resolution is low enough
-!---------------------------------------------------
-IF ( LFOREFIRE .AND. 0.5*(XXHAT(2)-XXHAT(1)+XYHAT(2)-XYHAT(1)) < COUPLINGRES ) THEN
- FFCOUPLING = .TRUE.
-ELSE
- FFCOUPLING = .FALSE.
-ENDIF
-
-! Initializing the ForeFire variables
-!------------------------------------
-IF ( LFOREFIRE ) THEN
- CALL INIT_FOREFIRE_n(KMI, ILUOUT, IP &
- , TDTCUR%nyear, TDTCUR%nmonth, TDTCUR%nday, TDTCUR%xtime, XTSTEP)
-END IF
-#endif
-
-!-------------------------------------------------------------------------------
-!
-!* 30. Total production/Loss for chemical species
-!
-IF (LCHEMDIAG) THEN
- CALL CH_INIT_PRODLOSSTOT_n(ILUOUT)
- IF (NEQ_PLT>0) THEN
- ALLOCATE(XPROD(IIU,IJU,IKU,NEQ_PLT))
- ALLOCATE(XLOSS(IIU,IJU,IKU,NEQ_PLT))
- XPROD=0.0
- XLOSS=0.0
- ELSE
- ALLOCATE(XPROD(0,0,0,0))
- ALLOCATE(XLOSS(0,0,0,0))
- END IF
-ELSE
- ALLOCATE(XPROD(0,0,0,0))
- ALLOCATE(XLOSS(0,0,0,0))
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 31. Extended production/loss terms for chemical species
-!
-IF (LCHEMDIAG) THEN
- CALL CH_INIT_BUDGET_n(ILUOUT)
- IF (NEQ_BUDGET>0) THEN
- ALLOCATE(IINDEX(2,NNONZEROTERMS))
- ALLOCATE(IIND(NEQ_BUDGET))
- CALL CH_NONZEROTERMS(KMI,IINDEX,NNONZEROTERMS)
- ALLOCATE(XTCHEM(NEQ_BUDGET))
- DO JM=1,NEQ_BUDGET
- IIND(JM)=COUNT((IINDEX(1,:))==NSPEC_BUDGET(JM))
- ALLOCATE(XTCHEM(JM)%NB_REAC(IIND(JM)))
- ALLOCATE(XTCHEM(JM)%XB_REAC(IIU,IJU,IKU,IIND(JM)))
- END DO
- DEALLOCATE(IIND)
- DEALLOCATE(IINDEX)
- ELSE
- ALLOCATE(XTCHEM(0))
- END IF
-ELSE
- ALLOCATE(XTCHEM(0))
-END IF
-!-------------------------------------------------------------------------------
-!
-!* 32. Wind turbine
-!
-IF (LMAIN_EOL .AND. KMI == NMODEL_EOL) THEN
- ALLOCATE(XFX_RG(IIU,IJU,IKU))
- ALLOCATE(XFY_RG(IIU,IJU,IKU))
- ALLOCATE(XFZ_RG(IIU,IJU,IKU))
- ALLOCATE(XFX_SMR_RG(IIU,IJU,IKU))
- ALLOCATE(XFY_SMR_RG(IIU,IJU,IKU))
- ALLOCATE(XFZ_SMR_RG(IIU,IJU,IKU))
- SELECT CASE(CMETH_EOL)
- CASE('ADNR')
- CALL INI_EOL_ADNR
- CASE('ALM')
- CALL INI_EOL_ALM(XDXX,XDYY)
- END SELECT
-END IF
-!
-!* 33. Auto-coupling Atmos-Ocean LES NH
-!
-IF (LCOUPLES) THEN
- ALLOCATE(XSSUFL_C(IIU,IJU,1)); XSSUFL_C=0.0
- ALLOCATE(XSSVFL_C(IIU,IJU,1)); XSSVFL_C=0.0
- ALLOCATE(XSSTFL_C(IIU,IJU,1)); XSSTFL_C=0.0
- ALLOCATE(XSSRFL_C(IIU,IJU,1)); XSSRFL_C=0.
-ELSE
- ALLOCATE(XSSUFL_C(0,0,0))
- ALLOCATE(XSSVFL_C(0,0,0))
- ALLOCATE(XSSTFL_C(0,0,0))
- ALLOCATE(XSSRFL_C(0,0,0))
-END IF
-!
-END SUBROUTINE INI_MODEL_n
diff --git a/src/mesonh/ext/ini_nsv.f90 b/src/mesonh/ext/ini_nsv.f90
deleted file mode 100644
index 0d7358737ad6b6fbc37b3254fb5867691b27b86d..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/ini_nsv.f90
+++ /dev/null
@@ -1,1237 +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, NMOD_IFN, NMOD_IMM, PARAM_LIMA_ALLOCATE, PARAM_LIMA_DEALLOCATE
-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 MODE_LIMA_UPDATE_NSV, ONLY: LIMA_UPDATE_NSV
-
-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
-!
-!-------------------------------------------------------------------------------
-!
-
-!Associate the pointers
-CALL NSV_ASSOCIATE
-!
-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
-!
-CALL LIMA_UPDATE_NSV(LDINIT=.TRUE., KMI=KMI, KSV=ISV, CDCLOUD=CCLOUD, LDUPDATE=.FALSE.)
-IF (CCLOUD == 'LIMA' ) THEN
-
- IF ( NMOD_IFN > 0 ) THEN
- IF ( .NOT. ASSOCIATED( NIMM ) ) CALL PARAM_LIMA_ALLOCATE('NIMM', NMOD_CCN)
- NIMM(:) = 0
- IF ( ASSOCIATED( NINDICE_CCN_IMM ) ) CALL PARAM_LIMA_DEALLOCATE('NINDICE_CCN_IMM')
- CALL PARAM_LIMA_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
-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/ini_radar.f90 b/src/mesonh/ext/ini_radar.f90
deleted file mode 100644
index efe222510b6882e595a88afd90253a4ce5a7ec2c..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/ini_radar.f90
+++ /dev/null
@@ -1,234 +0,0 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! masdev4_7 BUG1 2007/06/15 17:47:18
-!-----------------------------------------------------------------
-! ########################
- MODULE MODI_INI_RADAR
-! ########################
-!
-INTERFACE
- SUBROUTINE INI_RADAR (HPRISTINE_ICE )
-!
-CHARACTER (LEN=4), INTENT(IN) :: HPRISTINE_ICE ! Indicator of ice crystal characteristics
-!
-!
-END SUBROUTINE INI_RADAR
-!
-END INTERFACE
-!
-END MODULE MODI_INI_RADAR
-! ###########################################################
- SUBROUTINE INI_RADAR ( HPRISTINE_ICE )
-! ###########################################################
-!
-!!**** *INI_RADAR *
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to initialize the constants used to
-!! compute radar reflectivity (radar_rain_ice.f90 or radar_simulator.f90)
-!! for DIAG after PREP_REAL_CASE with AROME file (CCLOUD=NONE)
-!!
-!!** METHOD
-!! ------
-!! The constants useful to radar are initialized to their
-!! numerical values as in ini_rain_ice.f90 for ICE3
-!!
-!! EXTERNAL
-!! --------
-!! GAMMA : gamma function
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CST
-!! XPI !
-!! XP00 ! Reference pressure
-!! XRD ! Gaz constant for dry air
-!! XRHOLW ! Liquid water density
-!! Module MODD_RAIN_ICE_DESCR
-!!
-!!
-!! AUTHOR
-!! ------
-!! G. TANGUY * CNRM *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 27/10/2009
-!! P.Scheffknecht 22/04/2015: test missing on already allocated XRTMIN
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-USE MODD_RAIN_ICE_DESCR_n
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-!
-CHARACTER (LEN=4), INTENT(IN) :: HPRISTINE_ICE ! Indicator of ice crystal caracteristics
-!
-!-------------------------------------------------------------------------------
-!
-!
-!
-!* 1.1 Raindrop characteristics
-!
-!
-!
-XAR = (XPI/6.0)*XRHOLW
-XBR = 3.0
-XCR = 842.
-XDR = 0.8
-XCCR = 8.E6
-!
-!* 1.2 Ice crystal characteristics
-!
-!
-SELECT CASE (HPRISTINE_ICE)
- CASE('PLAT')
- XAI = 0.82 ! Plates
- XBI = 2.5 ! Plates
- XC_I = 800. ! Plates
- XDI = 1.0 ! Plates
- CASE('COLU')
- XAI = 2.14E-3 ! Columns
- XBI = 1.7 ! Columns
- XC_I = 2.1E5 ! Columns
- XDI = 1.585 ! Columns
- CASE('BURO')
- XAI = 44.0 ! Bullet rosettes
- XBI = 3.0 ! Bullet rosettes
- XC_I = 4.3E5 ! Bullet rosettes
- XDI = 1.663 ! Bullet rosettes
-END SELECT
-!
-!
-!* 1.3 Snowflakes/aggregates characteristics
-!
-!
-XAS = 0.02
-XBS = 1.9
-XCS = 5.1
-XDS = 0.27
-XCCS = 5.0
-XCXS = 1.0
-!
-!* 1.4 Graupel/Frozen drop characteristics
-!
-!
-XAG = 19.6
-XBG = 2.8
-XCG = 124.
-XDG = 0.66
-XCCG = 5.E5
-XCXG = -0.5
-!
-!* 1.5 Hailstone characteristics
-!
-!
-XAH = 470.
-XBH = 3.0
-XCH = 207.
-XDH = 0.64
-XCCH = 4.E4
-XCXH = -1.0
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. DIMENSIONAL DISTRIBUTIONS OF THE SPECIES
-! ----------------------------------------
-!
-!* 2.1 Raindrops distribution
-!
-XALPHAR = 1.0 ! Exponential law
-XNUR = 1.0 ! Exponential law
-!
-!* 2.2 Ice crystal distribution
-!
-XALPHAI = 3.0 ! Gamma law for the ice crystal volume
-XNUI = 3.0 ! Gamma law with little dispersion
-!
-XALPHAS = 1.0 ! Exponential law
-XNUS = 1.0 ! Exponential law
-!
-XALPHAG = 1.0 ! Exponential law
-XNUG = 1.0 ! Exponential law
-!
-XALPHAH = 1.0 ! Gamma law
-XNUH = 8.0 ! Gamma law with little dispersion
-!
-!* 2.3 Constants for shape parameter
-!
-XLBEXR = 1.0/(-1.0-XBR)
-XLBR = ( XAR*XCCR*MOMG(XALPHAR,XNUR,XBR) )**(-XLBEXR)
-!
-XLBEXI = 1.0/(-XBI)
-XLBI = ( XAI*MOMG(XALPHAI,XNUI,XBI) )**(-XLBEXI)
-!
-XNS = 1.0/(XAS*MOMG(XALPHAS,XNUS,XBS))
-XLBEXS = 1.0/(XCXS-XBS)
-XLBS = ( XAS*XCCS*MOMG(XALPHAS,XNUS,XBS) )**(-XLBEXS)
-!
-XLBEXG = 1.0/(XCXG-XBG)
-XLBG = ( XAG*XCCG*MOMG(XALPHAG,XNUG,XBG) )**(-XLBEXG)
-!
-XLBEXH = 1.0/(XCXH-XBH)
-XLBH = ( XAH*XCCH*MOMG(XALPHAH,XNUH,XBH) )**(-XLBEXH)
-!
-!* 2.4 Minimal values allowed for the mixing ratios
-! ICE3
-IF(.NOT.ASSOCIATED(XRTMIN)) THEN
- CALL RAIN_ICE_DESCR_ALLOCATE(6)
-END IF
-!
-XRTMIN(1) = 1.0E-20
-XRTMIN(2) = 1.0E-20
-XRTMIN(3) = 1.0E-20
-XRTMIN(4) = 1.0E-20
-XRTMIN(5) = 1.0E-15
-XRTMIN(6) = 1.0E-15
-
-!
-CONTAINS
-!
-!------------------------------------------------------------------------------
-!
- FUNCTION MOMG (PALPHA,PNU,PP) RESULT (PMOMG)
-!
-! auxiliary routine used to compute the Pth moment order of the generalized
-! gamma law
-!
- USE MODI_GAMMA
-
- IMPLICIT NONE
-
- REAL, INTENT(IN) :: PALPHA ! first shape parameter of the dimensionnal distribution
- REAL, INTENT(IN) :: PNU ! second shape parameter of the dimensionnal distribution
- REAL, INTENT(IN) :: PP ! order of the moment
- REAL :: PMOMG ! result: moment of order ZP
-
-!------------------------------------------------------------------------------
-
-
- PMOMG = GAMMA(PNU+PP/PALPHA)/GAMMA(PNU)
-
- END FUNCTION MOMG
-
-!-------------------------------------------------------------------------------
-!
-!
-END SUBROUTINE INI_RADAR
-
-
diff --git a/src/mesonh/ext/ini_segn.f90 b/src/mesonh/ext/ini_segn.f90
deleted file mode 100644
index 8e034ced7f1cf068fda60861f09b102e8dc4604f..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/ini_segn.f90
+++ /dev/null
@@ -1,483 +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_INI_SEG_n
-! ###################
-!
-INTERFACE
-!
-SUBROUTINE INI_SEG_n(KMI,TPINIFILE,HINIFILEPGD,PTSTEP_ALL)
-!
-USE MODD_IO, ONLY : TFILEDATA
-!
-INTEGER, INTENT(IN) :: KMI !Model index
-TYPE(TFILEDATA), POINTER, INTENT(OUT) :: TPINIFILE !Initial file
-CHARACTER (LEN=28), INTENT(OUT) :: HINIFILEPGD
-REAL,DIMENSION(:), INTENT(INOUT) :: PTSTEP_ALL ! Time STEP of ALL models
-!
-END SUBROUTINE INI_SEG_n
-!
-END INTERFACE
-!
-END MODULE MODI_INI_SEG_n
-!
-!
-!
-!
-! #############################################################
- SUBROUTINE INI_SEG_n(KMI,TPINIFILE,HINIFILEPGD,PTSTEP_ALL)
-! #############################################################
-!
-!!**** *INI_SEG_n * - routine to read and update the descriptor files for
-!! model KMI
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to read the descriptor files in the
-! following order :
-! - DESFM file which gives informations about the initial file
-! (i.e. the description of the segment that produced the initial file
-! or the description of the preinitialisation that created the initial file)
-! - EXSEG file which gives informations about the segment to perform.
-!
-! Informations in EXSEG file are completed by DESFM file informations
-! and if the informations are not in DESFM file, they are set
-! to default values.
-!
-! The descriptor file EXSEG corresponding to the segment of simulation
-! to be performed, is then updated with the combined informations.
-! We also store in the updated EXSEG file, the informations on the status
-! of the different variables ( skip, init, read) in the namelist NAM_GETn,
-! which will be read in the INI_MODELn routine to properly initiliaze the
-! model n. Except this last namelist, the informations written in this
-! EXSEG file, will be identical to the NAMELIST section of the descriptive
-! part of the FM files containing the model outputs.
-!
-! In order not to duplicate the routines called by ini_seg, we use the
-! modules modd, corresponding to the first model to store the informations
-! read on the different files ( DESFM and EXSEG ). The final filling of
-! the modules modd (MODD_CONFn ....) will be realized in the subroutine
-! INI_MODELn. The goal of the INI_SEG_n part of the initialization is to
-! built the final EXSEG, which will be associated to the LFI files
-! generated during the segment ( and therefore not to fill the modd).
-!
-!
-!!** METHOD
-!! ------
-!! For a nested model of index KMI :
-!! - Logical unit numbers are associated to output-listing file and
-!! descriptor EXSEG file by FMATTR. Then these files are opened.
-!! The name of the initial file is read in EXSEG file.
-!! - Default values are supplied for variables in descriptor files
-!! (by DEFAULT_DESFM).
-!! - The Initial file (LFIFM + DESFM) is opened by IO_File_open.
-!! - The descriptor DESFM file is read (by READ_DESFM_n).
-!! - The descriptor file EXSEG is read (by READ_EXSEG_n) and coherence
-!! between the initial file and the description of segment is also checked
-!! in this routine.
-!! - If there is more than one model the EXSEG file is updated
-!! (by WRITE_DESFM$n). This routine prints also EXSEG content on
-!! output-listing.
-!! - If there is only one model (i.e. no grid-nesting),
-!! EXSEG file is also closed (logical unit number associated with this
-!! file is also released by FMFREE).
-!!
-!!
-!!
-!! EXTERNAL
-!! --------
-!! FMATTR : to associate a logical unit number to a file
-!! IO_File_open : to open descriptor file or LFI file
-!! DEFAULT_DESFM1: to set default values
-!! READ_DESFM_n : to read a DESFM file
-!! READ_EXSEG_n : to read a EXSEG file
-!! WRITE_DESFM1 : to write the DESFM part of the future outputs
-!! FMFREE : to release a logical unit number linked to a file
-!!
-!! Module MODI_DEFAULT_DESFM : Interface for routine DEFAULT_DESFM
-!! Module MODI_READ_DESFM_n : Interface for routine READ_DESFM_n
-!! Module MODI_READ_EXSEG_n : Interface for routine READ_EXSEG_n
-!! Module MODI_WRITE_DESFM1 : Interface for routine WRITE_DESFM1
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_LUNIT : contains names and logical unit numbers
-!!
-!! Module MODD_CONF : contains configuration variables
-!! CCONF : Configuration of models
-!! NMODEL : Number of nested models
-!! NVERB : Level of informations on output-listing
-!! 0 for minimum of prints
-!! 5 for intermediate level of prints
-!! 10 for maximum of prints
-!!
-!! Module MODN_LUNIT1 : contains declarations of namelist NAMLUNITMN
-!! and module MODD_LUNIT1
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of documentation (routine INI_SEG)
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Ducrocq * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 07/06/94
-!! Modification 26/10/94 remove the NAM_GETn from the namelist present
-!! in the EXSEG file (J.Stein)
-!! 11/01/95 change the read_exseg and desfm CALLS to add
-!! the G1D switch
-!! 15/02/95 add the HTURBLEN information (J. Cuxart)
-!! 18/08/95 Time STEP change (J. P. Lafore)
-!! 02/10/95 add the radiation control (J. Stein)
-!! 18/03/96 remove the no write option for WRITE_DESFM
-!! (J. Stein)
-!! 11/04/96 add the ice conc. control (J.-P. Pinty)
-!! 11/01/97 add the deep convection control (J.-P. Pinty)
-!! 17/07/96 correction for WRITE_DESFM1 call (J. P. Lafore)
-!! 22/07/96 PTSTEP_ALL introduction for nesting (J. P. Lafore)
-!! 7/08/98 // (V. Ducrocq)
-!! 02/08/99 remove unused argument for read_desfm (J. Stein)
-!! 15/03/99 test on execution program (V. Masson)
-!! 15/11/00 Add YCLOUD (J.-P. Pinty)
-!! 01/03/01 Add GUSECHEM (D. Gazen)
-!! 15/10/01 namelists in different orders (I.Mallet)
-!! 25/11/02 Add YELEC (P. Jabouille)
-!! 01/2004 externalization of surface (V. Masson)
-!! 01/2005 add GDUST, GSALT, and GORILAM (P. Tulet)
-!! 04/2010 add GUSECHAQ, GCH_PH (M. Leriche)
-!! 09/2010 add GUSECHIC (M. Leriche)
-!! 02/2012 add GFOREFIRE (Pialat/Tulet)
-!! 05/2014 missing reading of IMASDEV before COUPLING
-!! test (Escobar)
-!! 10/02/15 remove ABORT in parallel case for SPAWNING
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! 01/2015 add GLNOX_EXPLICIT (C. Barthe)
-!! 04/2016 add ABORT if CINIFILEPGD is not specified (G.Delautier)
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! 07/2017 add GBLOWSNOW (V. Vionnet)
-! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
-! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
-! P. Wautelet 19/06/2019: provide KMODEL to INI_FIELD_LIST when known
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-USE MODD_CONF
-USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
-USE MODN_CONFZ
-USE MODD_DYN_n, ONLY : LOCEAN
-USE MODD_DYN
-USE MODD_IO, ONLY: NVERB_FATAL, NVERB_WARNING, TFILE_OUTPUTLISTING, TFILEDATA
-USE MODD_LES, ONLY: LES_ASSOCIATE
-USE MODD_LUNIT
-USE MODD_LUNIT_n, ONLY: CINIFILE_n=> CINIFILE, TINIFILE_n => TINIFILE, CINIFILEPGD_n=> CINIFILEPGD, TLUOUT, LUNIT_MODEL
-USE MODD_PARAM_n, ONLY: CSURF
-USE MODD_PARAM_ICE_n
-USE MODD_PARAMETERS
-USE MODD_REF, ONLY: LBOUSS
-!
-use mode_field, only: Ini_field_list, Ini_field_scalars
-USE MODE_IO_FIELD_READ, only: IO_Field_read
-USE MODE_IO_FILE, ONLY: IO_File_close, IO_File_open
-USE MODE_IO, only: IO_Config_set
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
-USE MODE_MSG
-USE MODE_POS
-!
-USE MODI_DEFAULT_DESFM_n
-USE MODI_READ_DESFM_n
-USE MODI_READ_EXSEG_n
-USE MODI_WRITE_DESFM_n
-!
-USE MODN_CONFIO, ONLY: NAM_CONFIO
-USE MODN_LUNIT_n
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-INTEGER, INTENT(IN) :: KMI !Model index
-TYPE(TFILEDATA), POINTER, INTENT(OUT) :: TPINIFILE !Initial file
-CHARACTER (LEN=28), INTENT(OUT) :: HINIFILEPGD
-REAL,DIMENSION(:), INTENT(INOUT) :: PTSTEP_ALL ! Time STEP of ALL models
-!
-!* 0.1 declarations of local variables
-!
-LOGICAL :: GFOUND ! Return code when searching namelist
-CHARACTER (LEN=28) :: YINIFILE ! name of initial file
-CHARACTER (LEN=2) :: YMI ! string for model index
-INTEGER :: ILUOUT ! Logical unit number
- ! associated with TLUOUT
- !
-INTEGER :: IRESP,ILUSEG ! File management variables
-CHARACTER (LEN=5) :: YCONF ! Local variables which have
-LOGICAL :: GFLAT ! the same definition as the
-LOGICAL :: GUSERV,GUSERC,GUSERR,GUSERI ! variables in module MODD_CONF,
-LOGICAL :: GUSERS,GUSERG,GUSERH,GUSECI ! MODD_CONFn, MODD_PARAMn,
-LOGICAL :: GUSECHEM ! flag for chemistry
-LOGICAL :: GUSECHAQ ! flag for aq. phase chemistry
-LOGICAL :: GUSECHIC ! flag for ice phase chemistry
-LOGICAL :: GCH_PH ! flag for pH
-LOGICAL :: GCH_CONV_LINOX
-LOGICAL :: GDUST
-LOGICAL,DIMENSION(JPMODELMAX) :: GDEPOS_DST, GDEPOS_SLT, GDEPOS_AER
-LOGICAL :: GSALT
-LOGICAL :: GORILAM
-LOGICAL :: GLG
-LOGICAL :: GPASPOL
-LOGICAL :: GFIRE
-#ifdef MNH_FOREFIRE
-LOGICAL :: GFOREFIRE
-#endif
-LOGICAL :: GCONDSAMP
-LOGICAL :: GBLOWSNOW
-LOGICAL :: GCHTRANS
-LOGICAL :: GLNOX_EXPLICIT ! flag for LNOx
- ! These variables
- ! are used to locally store
-INTEGER :: ISV ! the value read in DESFM
-INTEGER :: IRIMX,IRIMY ! number of points for the
- ! horizontal relaxation
-CHARACTER (LEN=4) :: YTURB ! file in order to check the
-CHARACTER (LEN=4) :: YRAD ! corresponding informations
-CHARACTER (LEN=4) :: YTOM ! read in EXSEG file.
-LOGICAL :: GRMC01
-CHARACTER (LEN=4) :: YDCONV
-CHARACTER (LEN=4) :: YSCONV
-CHARACTER (LEN=4) :: YCLOUD
-CHARACTER (LEN=4) :: YELEC
-CHARACTER (LEN=3) :: YEQNSYS
-TYPE(TFILEDATA),POINTER :: TZFILE_DES
-!
-TPINIFILE => NULL()
-TZFILE_DES => NULL()
-!-------------------------------------------------------------------------------
-!
-!* 1. OPEN OUPTUT-LISTING FILE AND EXSEG FILE
-! ---------------------------------------
-!
-WRITE(YMI,'(I2.0)') KMI
-CALL IO_File_add2list(LUNIT_MODEL(KMI)%TLUOUT,'OUTPUT_LISTING'//ADJUSTL(YMI),'OUTPUTLISTING','WRITE')
-TLUOUT => LUNIT_MODEL(KMI)%TLUOUT !Necessary because TLUOUT was initially pointing to NULL
-CALL IO_File_open(TLUOUT)
-!
-!Set output file for PRINT_MSG
-TFILE_OUTPUTLISTING => TLUOUT
-!
-ILUOUT=TLUOUT%NLU
-!
-WRITE(UNIT=ILUOUT,FMT='(50("*"),/,"*",17X,"MODEL ",I1," LISTING",16X,"*",/, &
- & 50("*"))') KMI
-!
-IF (CPROGRAM=='MESONH') THEN
- CALL IO_File_add2list(TZFILE_DES,'EXSEG'//TRIM(ADJUSTL(YMI))//'.nam','NML','READ')
- CALL IO_File_open(TZFILE_DES)
-!
-!* 1.3 SPAWNING or SPEC or REAL program case
-! ---------------------
-!
-ELSE IF (CPROGRAM=='SPAWN ' .OR. CPROGRAM=='REAL '.OR. CPROGRAM=='SPEC ') THEN
- YINIFILE = CINIFILE_n
- HINIFILEPGD = CINIFILEPGD_n
- CALL IO_File_add2list(TPINIFILE,TRIM(YINIFILE),'MNH','READ',KLFITYPE=2,KLFIVERB=NVERB)
- CALL IO_File_open(TPINIFILE)
- TZFILE_DES => TPINIFILE%TDESFILE
-!
-!* 1.3bis DIAG program case
-!
-ELSE IF (CPROGRAM=='DIAG ') THEN
- YINIFILE = CINIFILE_n
- HINIFILEPGD = CINIFILEPGD_n
- CALL IO_File_add2list(TINIFILE_n,TRIM(YINIFILE),'MNH','READ',KLFITYPE=2,KLFIVERB=NVERB)
- CALL IO_File_open(TINIFILE_n)
- TPINIFILE => TINIFILE_n
- TZFILE_DES => TPINIFILE%TDESFILE
-!
-!* 1.4 Other program cases
-! -------------------
-!
-ELSE
-!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_SEG_n','should not be called for CPROGRAM='//TRIM(CPROGRAM))
-ENDIF
-!
-ILUSEG = TZFILE_DES%NLU
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. SET DEFAULT VALUES
-! ------------------
-!
-CALL LES_ASSOCIATE()
-CALL DEFAULT_DESFM_n(KMI)
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. READ INITIAL FILE NAME AND OPEN INITIAL FILE
-! --------------------------------------------
-!
-CALL POSNAM(ILUSEG,'NAM_LUNITN',GFOUND)
-IF (GFOUND) THEN
- CALL INIT_NAM_LUNITn
- READ(UNIT=ILUSEG,NML=NAM_LUNITn)
- CALL UPDATE_NAM_LUNITn
- IF (LEN_TRIM(CINIFILEPGD)==0 .AND. CSURF=='EXTE') THEN
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_SEG_n','error in namelist NAM_LUNITn: you need to specify CINIFILEPGD')
- ENDIF
-END IF
-
-IF (CPROGRAM=='MESONH') THEN
- IF (KMI.EQ.1) THEN
- CALL POSNAM(ILUSEG,'NAM_CONFZ',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONFZ)
- CALL POSNAM(ILUSEG,'NAM_CONFIO',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONFIO)
- CALL IO_Config_set()
- END IF
- HINIFILEPGD=CINIFILEPGD_n
- YINIFILE=CINIFILE_n
-
- CALL IO_File_add2list(TPINIFILE,TRIM(YINIFILE),'MNH','READ',KLFITYPE=2,KLFIVERB=NVERB)
- TINIFILE_n => TPINIFILE !Necessary because TINIFILE was initially pointing to NULL
- CALL IO_File_open(TPINIFILE)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. READ DESFM FILE
-! ---------------
-!
-CALL READ_DESFM_n(KMI,TPINIFILE,YCONF,GFLAT,GUSERV,GUSERC, &
- GUSERR,GUSERI,GUSECI,GUSERS,GUSERG,GUSERH,GUSECHEM,GUSECHAQ,&
- GUSECHIC,GCH_PH,GCH_CONV_LINOX,GSALT,GDEPOS_SLT,GDUST, &
- GDEPOS_DST, GCHTRANS, GORILAM, &
- GDEPOS_AER, GLG, GPASPOL,GFIRE, &
-#ifdef MNH_FOREFIRE
- GFOREFIRE, &
-#endif
- GLNOX_EXPLICIT, &
- GCONDSAMP,GBLOWSNOW, IRIMX,IRIMY,ISV, &
- YTURB,YTOM,GRMC01,YRAD,YDCONV,YSCONV,YCLOUD,YELEC,YEQNSYS )
-!
-!-------------------------------------------------------------------------------
-!
-!* 5. Initialize fieldlist
-! --------------------
-!
-IF (KMI==1) THEN !Do this only 1 time
- IF ( CPROGRAM=='SPAWN ' .OR. CPROGRAM=='DIAG ' .OR. CPROGRAM=='SPEC ' &
- .OR. ( CPROGRAM/='REAL ' .AND. CPROGRAM/='IDEAL ' ) ) THEN
- CALL INI_FIELD_LIST()
- END IF
-
- IF (CPROGRAM=='SPAWN ' .OR. CPROGRAM=='DIAG ' .OR. CPROGRAM=='SPEC ' .OR. CPROGRAM=='MESONH') THEN
- CALL INI_FIELD_SCALARS()
- END IF
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 6. READ in the LFI file SOME VARIABLES of MODD_CONF
-! ------------------------------------------------
-!
-IF (CPROGRAM=='MESONH' .OR. CPROGRAM=='SPAWN ') THEN
- IF ((TPINIFILE%NMNHVERSION(1)==4 .AND. TPINIFILE%NMNHVERSION(2)>9) .OR. TPINIFILE%NMNHVERSION(1)>4) THEN
- CALL IO_Field_read(TPINIFILE,'COUPLING',LCOUPLING)
- IF (LCOUPLING) THEN
- WRITE(ILUOUT,*) 'Error with the initial file'
- WRITE(ILUOUT,*) 'The file',YINIFILE,' was created with LCOUPLING=.TRUE.'
- WRITE(ILUOUT,*) 'You can not use it as initial file, only as coupling file'
- WRITE(ILUOUT,*) 'Run PREP_REAL_CASE with LCOUPLING=.FALSE.'
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_SEG_n','')
- ENDIF
- ENDIF
-END IF
-!
-! Read the storage type
- CALL IO_Field_read(TPINIFILE,'STORAGE_TYPE',CSTORAGE_TYPE,IRESP)
- IF (IRESP /= 0) THEN
- WRITE(ILUOUT,FMT=9002) 'STORAGE_TYPE',IRESP
-!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_SEG_n','')
- END IF
-IF (KMI == 1) THEN
-! Read the geometry kind
- CALL IO_Field_read(TPINIFILE,'CARTESIAN',LCARTESIAN)
-! Read the thinshell approximation
- CALL IO_Field_read(TPINIFILE,'THINSHELL',LTHINSHELL)
-!
- IF ((TPINIFILE%NMNHVERSION(1)==4 .AND. TPINIFILE%NMNHVERSION(2)>=6) .OR. TPINIFILE%NMNHVERSION(1)>4) THEN
- CALL IO_Field_read(TPINIFILE,'L1D',L1D,IRESP)
- IF (IRESP/=0) L1D=.FALSE.
-!
- CALL IO_Field_read(TPINIFILE,'L2D',L2D,IRESP)
- IF (IRESP/=0) L2D=.FALSE.
-!
- CALL IO_Field_read(TPINIFILE,'PACK',LPACK,IRESP)
- IF (IRESP/=0) LPACK=.TRUE.
- ELSE
- L1D=.FALSE.
- L2D=.FALSE.
- LPACK=.TRUE.
- END IF
- IF ((TPINIFILE%NMNHVERSION(1)==4 .AND. TPINIFILE%NMNHVERSION(2)>=10) .OR. TPINIFILE%NMNHVERSION(1)>4) THEN
- CALL IO_Field_read(TPINIFILE,'LBOUSS',LBOUSS)
- END IF
-!
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 7. READ EXSEG FILE
-! ---------------
-! We pass by arguments the informations read in DESFM descriptor to the
-! routine which read related informations in the EXSEG descriptor in order to
-! check coherence between both informations.
-!
-CALL IO_Field_read(TPINIFILE,'LOCEAN',LOCEAN,IRESP)
-IF ( IRESP /= 0 ) LOCEAN = .FALSE.
-!
-CALL READ_EXSEG_n(KMI,TZFILE_DES,YCONF,GFLAT,GUSERV,GUSERC, &
- GUSERR,GUSERI,GUSECI,GUSERS,GUSERG,GUSERH,GUSECHEM, &
- GUSECHAQ,GUSECHIC,GCH_PH, &
- GCH_CONV_LINOX,GSALT,GDEPOS_SLT,GDUST,GDEPOS_DST,GCHTRANS, &
- GORILAM,GDEPOS_AER,GLG,GPASPOL,GFIRE, &
-#ifdef MNH_FOREFIRE
- GFOREFIRE, &
-#endif
- GLNOX_EXPLICIT, &
- GCONDSAMP,GBLOWSNOW, IRIMX,IRIMY,ISV, &
- YTURB,YTOM,GRMC01,YRAD,YDCONV,YSCONV,YCLOUD,YELEC,YEQNSYS, &
- PTSTEP_ALL,CINIFILEPGD_n )
-!
-IF (CPROGRAM=='SPAWN ' .OR. CPROGRAM=='DIAG ' .OR. CPROGRAM=='SPEC ' &
- .OR. CPROGRAM=='REAL ') THEN
- CINIFILE_n = YINIFILE
- CCPLFILE(:) = ' '
- NMODEL=1
- LSTEADYLS=.TRUE.
-END IF
-!
-IF (CPROGRAM=='MESONH') THEN
- HINIFILEPGD=CINIFILEPGD_n
-END IF
-!-------------------------------------------------------------------------------
-!
-!* 7. CLOSE FILES
-! ------------
-!
-IF (CPROGRAM=='MESONH') CALL IO_File_close(TZFILE_DES)
-!
-!-------------------------------------------------------------------------------
-9002 FORMAT(/,'FATAL ERROR IN INI_SEG_n: pb to read ',A16,' IRESP=',I3)
-!
-END SUBROUTINE INI_SEG_n
diff --git a/src/mesonh/ext/ini_tke_eps.f90 b/src/mesonh/ext/ini_tke_eps.f90
deleted file mode 100644
index a07160722558475a37baff36ada0a00739bff061..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/ini_tke_eps.f90
+++ /dev/null
@@ -1,179 +0,0 @@
-!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! #######################
- MODULE MODI_INI_TKE_EPS
-! #######################
-INTERFACE
-!
- SUBROUTINE INI_TKE_EPS(HGETTKET,PTHVREF,PZZ, &
- PUT,PVT,PTHT, &
- PTKET,TPINITHALO3D_ll )
-!
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-CHARACTER (LEN=*), INTENT(IN) :: HGETTKET
- ! character string indicating whether TKE must be
- ! initialized or not
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! virtual potential
- ! temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! physical height for
- ! w-point
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PUT ! x-component of wind
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PVT ! y-component of wind
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PTHT ! potential temperature
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PTKET ! TKE fields
-TYPE(LIST_ll), POINTER, INTENT(INOUT):: TPINITHALO3D_ll ! pointer for the list of fields
- ! which must be communicated in INIT
-!
-END SUBROUTINE INI_TKE_EPS
-!
-END INTERFACE
-!
-END MODULE MODI_INI_TKE_EPS
-!
-! ###################################################################
- SUBROUTINE INI_TKE_EPS(HGETTKET,PTHVREF,PZZ, &
- PUT,PVT,PTHT, &
- PTKET,TPINITHALO3D_ll )
-! ###################################################################
-!
-!
-!! **** *INI_TKE* initializes by a 1D stationarized TKE equation the
-!! values of TKE. A positivity control is made. The
-!! dissipation of TKE is set to its minimum value.
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to initialize the values of the
-! turbulence kinetic energy. The dissipation is intialized to its minimum
-! value.
-!
-!!** METHOD
-!! ------
-!! A diagnostic 1D equation for the TKE is used. The transport terms
-!! are neglected.
-!!
-!! EXTERNAL
-!! --------
-!! DZF ,MXF, MYF, MZM : Shuman operators
-!! ADD3DFIELD_ll : add a field to 3D-list
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! MODD_CST : XG, XRV, XRD
-!! MODD_CTURB : XLINI, XTKEMIN, XCED, XCMFS
-!! MODD_PARAMETERS: JPVEXT
-!!
-!! REFERENCE
-!! ---------
-!! Book 2 of Documentation (routine INI_TKE)
-!! Book 1 of Documentation (Chapter Turbulence)
-!!
-!! AUTHOR
-!! ------
-!! Joan Cuxart * INM and Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original Jan 19, 1995
-!! Feb 13, 1995 (J. Cuxart) add EPS initialization
-!! March 25, 1995 (J. Stein)add PZZ in the arguments
-!! to compute a real gradient and allow RESTA conf.
-!! Aug 10, 1998 (N. Asencio) add parallel code
-!! May 2006 Remove KEPS
-! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
-!! March 2021 (JL Redelsperger) Add Ocean LES case)
-!! -------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_ARGSLIST_ll, ONLY: LIST_ll
-USE MODD_CST, ONLY: XG, XALPHAOC
-USE MODD_CTURB, ONLY: XCMFS
-USE MODD_TURB_n, ONLY: XLINI, XCED, XTKEMIN, XCSHF
-USE MODD_DYN_n, ONLY: LOCEAN
-USE MODD_PARAMETERS, ONLY: JPVEXT
-!
-USE MODE_ll
-!
-USE MODI_SHUMAN, ONLY: DZF, MXF, MYF, MZM
-!
-IMPLICIT NONE
-!
-!* 0.1. declarations of arguments
-!
-CHARACTER (LEN=*), INTENT(IN) :: HGETTKET
- ! character string indicating whether TKE must be
- ! initialized or not
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! virtual potential
- ! temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! physical height for
- ! w-point
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PUT ! x-component of wind
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PVT ! y-component of wind
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PTHT ! potential temperature
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PTKET ! TKE field
-TYPE(LIST_ll), POINTER, INTENT(INOUT):: TPINITHALO3D_ll ! pointer for the list of fields
- ! which must be communicated in INIT
-!
-!* 0.2 Declaration of local variables
-!
-INTEGER :: IKB,IKE ! index value for the first and last inner
- ! mass points
-INTEGER :: JKK ! vertical loop index
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZDELTZ ! vertical
- ! increment
-!
-! ---------------------------------------------------------------------
-!
-!
-IKB=1+JPVEXT
-IKE=SIZE(PTHT,3)-JPVEXT
-!
-!* 1. TKE DETERMINATION
-! -----------------
-!
-DO JKK=IKB-1,IKE
- ZDELTZ(:,:,JKK) = PZZ(:,:,JKK+1)-PZZ(:,:,JKK)
-END DO
-ZDELTZ(:,:,IKE+1) = ZDELTZ(:,:,IKE)
-!
-IF (HGETTKET == 'INIT' ) THEN
-! instant t
- PTHT(:,:,IKB-1) = PTHT(:,:,IKB)
- PUT(:,:,IKB-1) = PUT(:,:,IKB)
- PVT(:,:,IKB-1) = PVT(:,:,IKB)
- !
- PTHT(:,:,IKE+1) = PTHT(:,:,IKE)
- PUT(:,:,IKE+1) = PUT(:,:,IKE)
- PVT(:,:,IKE+1) = PVT(:,:,IKE)
- !
- ! determines TKE
- ! Equilibrium/Stationary/neutral 1D TKE equation
- IF (LOCEAN) THEN
- PTKET(:,:,:)=(XLINI**2/XCED)*( &
- XCMFS*( DZF(MXF(MZM(PUT)))**2 &
- +DZF(MYF(MZM(PVT)))**2) / ZDELTZ &
- -(XG*XALPHAOC)*XCSHF*DZF(MZM(PTHT)) &
- ) / ZDELTZ
- ELSE
- PTKET(:,:,:)=(XLINI**2/XCED)*( &
- XCMFS*( DZF(MXF(MZM(PUT)))**2 &
- +DZF(MYF(MZM(PVT)))**2) / ZDELTZ &
- -(XG/PTHVREF)*XCSHF*DZF(MZM(PTHT)) &
- ) / ZDELTZ
- END IF
- ! positivity control
- WHERE (PTKET < XTKEMIN) PTKET=XTKEMIN
- !
- !
- ! Add PTKET to TPINITHALO3D_ll list of fields updated at the
- ! end of initialization
- CALL ADD3DFIELD_ll ( TPINITHALO3D_ll, PTKET, 'INI_TKE_EPS::PTKET' )
-END IF
-!
-!
-END SUBROUTINE INI_TKE_EPS
diff --git a/src/mesonh/ext/init_mnh.f90 b/src/mesonh/ext/init_mnh.f90
deleted file mode 100644
index 4170ca68e7ebf89b388aa90fee1d25880fd73edd..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/init_mnh.f90
+++ /dev/null
@@ -1,252 +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.
-!-----------------------------------------------------------------
-! ###############
- SUBROUTINE INIT_MNH
-! ###############
-!
-!!**** *INIT_MNH * - monitor to initialize the variables of the model
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to initialize all the variables
-! used in the model temporal loop or in the post-processings
-!
-!!** METHOD
-!! ------
-!! This initialization is separated in three parts :
-!! 1. A part common to all models where :
-!! - The output-listing file common to all models is opened.
-!! - The physical constants are initialized.
-!! - The other constants for all models are initialized.
-!! 2. The treatment of descriptor files model by model :
-!! The DESFM and EXSEG files are read and the EXSEG file is updated
-!! 3. The sequential initialization of nested models :
-!! The initial data fields are read in different files for each
-!! model and variables which are not in these initial files are
-!! deduced.
-!!
-!!
-!! EXTERNAL
-!! --------
-!! INI_CST : to initialize physical constants
-!! INI_CTURB : to initialize for all models the constants used in the
-!! turbulence scheme
-!! INI_SEG_n : to read and update descriptor files
-!! INI_SIZE : to initialize the sizes of the different models
-!! INI_MODEL : to initialize each nested model
-!! INI_PARA_ll: to build the ll data structures
-!! GO_TOMODEL : displace the ll lists to the right nested model
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_PARAMETERS : JPMODELMAX
-!!
-!! Module MODD_CONF : NMODEL,NVERB
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of documentation (routine INIT_MNH)
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Ducrocq * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 02/06/94
-!! J.Stein 05/01/95 add ini_cturb
-!! J.P. Lafore 18/08/95 Time STEP change
-!! J.P. Lafore 22/07/96 ZTSTEP_ALL introduction for nesting
-!! V. Ducrocq 7/08/98 //
-!! P. Jabouille 7/07/99 split ini_modeln in 2 parts+ cleaning
-!! V. Masson 15/03/99 call to ini_data_cover
-!! P.Jabouille 15/07/99 special initialisation for spawning
-!! J.P Chaboureau 2015 add ini_spectre_n
-!! J.Escobar 2/03/2016 bypass , reset NHALO=1 for SPAWNING
-!! 06/2016 (G.Delautier) phasage surfex 8
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-USE MODD_CONF
-USE MODD_DYN_n, ONLY: CPRESOPT, NITR ! only for spawning purpose
-USE MODD_IO, ONLY: TFILE_OUTPUTLISTING, TPTR2FILE
-USE MODD_LBC_n, ONLY: CLBCX,CLBCY ! only for spawning purpose
-USE MODD_LUNIT
-USE MODD_LUNIT_n
-USE MODD_MNH_SURFEX_n
-USE MODD_PARAMETERS
-USE MODD_NSV, ONLY: NSV_ASSOCIATE
-!
-use mode_field, only: Alloc_field_scalars, Fieldlist_goto_model
-USE MODE_IO_FILE, ONLY: IO_File_open
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
-USE MODE_ll
-USE MODE_MODELN_HANDLER
-USE MODE_SPLITTINGZ_ll
-!
-USE MODE_INI_CST, ONLY: INI_CST
-USE MODI_INI_MODEL_n
-USE MODI_INI_SEG_n
-USE MODI_INI_SIZE_n
-USE MODI_INI_SIZE_SPAWN
-USE MODI_INI_SPECTRE_n
-USE MODI_READ_ALL_NAMELISTS
-USE MODI_RESET_EXSEG
-!
-IMPLICIT NONE
-!
-!* 0.1 Local variables
-!
-INTEGER :: JMI ! Loop index
-CHARACTER(LEN=28),DIMENSION(JPMODELMAX) :: YINIFILEPGD
-INTEGER :: ILUOUT0,IRESP ! Logical unit number for
- ! output-listing common
- ! to all models and return
- ! code of file management
-REAL, DIMENSION(JPMODELMAX) :: ZTSTEP_ALL ! Time STEP of ALL models
-INTEGER :: IINFO_ll ! return code of // routines
-!
-! Dummy pointers needed to correct an ifort Bug
-CHARACTER(LEN=4), DIMENSION(:), POINTER :: DPTR_CLBCX,DPTR_CLBCY
-
-!-------------------------------------------------------------------------------
-!
-!* 1. INITIALIZATION COMMON TO ALL MODELS
-! ------------------------------------
-!
-!* 1.1 initialize // E/S and open output-listing file
-!
-!
-IF (CPROGRAM/='REAL ') THEN
- CALL IO_File_add2list(TLUOUT0,'OUTPUT_LISTING0','OUTPUTLISTING','WRITE')
- CALL IO_File_open(TLUOUT0)
- !Set output file for PRINT_MSG
- TFILE_OUTPUTLISTING => TLUOUT0
- ILUOUT0=TLUOUT0%NLU
-ELSE
- ILUOUT0=TLUOUT0%NLU
-END IF
-!
-WRITE(UNIT=ILUOUT0,FMT="(50('*'),/,'*',48X,'*',/, &
- & 7('*'),10X, ' MESO-NH MODEL ',10X,8('*'),/, &
- & '*',48X,'*',/, &
- & 7('*'),12X,' CNRM - LA ',12X,8('*'),/, &
- & '*',48X,'*',/, 50('*'))")
-!
-CALL NSV_ASSOCIATE()
-!
-!
-!* 1.2 initialize physical constants
-!
-CALL INI_CST
-!
-!
-!* 1.3 initialize constants for the turbulence scheme
-!
-!Now done in ini_modeln
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. READ AND UPDATE DESCRIPTOR FILES
-! --------------------------------
-!
-IF (CPROGRAM=='SPAWN ' .OR. CPROGRAM=='DIAG ' .OR. CPROGRAM=='SPEC ' .OR. CPROGRAM=='MESONH') THEN
- CALL ALLOC_FIELD_SCALARS()
-END IF
-!
-CALL GOTO_MODEL(1)
-CALL INI_SEG_n(1,LUNIT_MODEL(1)%TINIFILE,YINIFILEPGD(1),ZTSTEP_ALL)
-!
-DO JMI=2,NMODEL
- CALL GOTO_MODEL(JMI)
- CALL INI_SEG_n(JMI,LUNIT_MODEL(JMI)%TINIFILE,YINIFILEPGD(JMI),ZTSTEP_ALL)
-END DO
-!
-IF (CPROGRAM=='SPAWN ') THEN
- !bypass
- NHALO = 1
-END IF
-!
-IF (CPROGRAM=='DIAG') CALL RESET_EXSEG()
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 3. INITIALIZE EACH MODEL SIZES AND DEPENDENCY
-! ------------------------------------------
-!
-DO JMI=1,NMODEL
- CALL GOTO_MODEL(JMI)
- CALL INI_SIZE_n(JMI,LUNIT_MODEL(JMI)%TINIFILE,YINIFILEPGD(JMI))
-END DO
-!
-IF (CPROGRAM=='SPAWN ') THEN
- DPTR_CLBCX=>CLBCX
- DPTR_CLBCY=>CLBCY
- CALL INI_PARAZ_ll(IINFO_ll)
- CALL INI_SIZE_SPAWN(DPTR_CLBCX,DPTR_CLBCY,CPRESOPT,NITR,LUNIT_MODEL(1)%TINIFILE)
-END IF
-!
-! INITIALIZE data structures of ComLib
-!
-!JUAN CALL INI_PARA_ll(IINFO_ll)
-CALL INI_PARAZ_ll(IINFO_ll)
-!
-!-------------------------------------------------------------------------------
-!
-!
-! Allocations of Surfex Types
-CALL SURFEX_ALLOC_LIST(NMODEL)
-!
-DO JMI=1,NMODEL
- YSURF_CUR => YSURF_LIST(JMI)
-!
- IF (CPROGRAM=='SPAWN ' .OR. CPROGRAM=='REAL ') THEN
- CALL READ_ALL_NAMELISTS(YSURF_CUR,'MESONH','PRE',.FALSE.)
- ELSE
- CALL READ_ALL_NAMELISTS(YSURF_CUR,'MESONH','ALL',.TRUE.)
- ENDIF
-ENDDO
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. INITIALIZE EACH MODEL
-! ---------------------
-!
-DO JMI=1,NMODEL
- CALL GO_TOMODEL_ll(JMI,IINFO_ll)
- CALL GOTO_MODEL(JMI)
- IF (CPROGRAM/='SPEC ') THEN
- CALL INI_MODEL_n(JMI,LUNIT_MODEL(JMI)%TINIFILE)
- !Call necessary to update the TFIELDLIST pointers to the data
- CALL FIELDLIST_GOTO_MODEL(JMI,JMI)
- ELSE
- CALL INI_SPECTRE_n(JMI,LUNIT_MODEL(JMI)%TINIFILE)
- END IF
-END DO
-!
-!-------------------------------------------------------------------------------
-!
-!* 5. WRITE MESSAGE ON OUTPUT-LISTING
-! -------------------------------
-!
-IF (NVERB >= 5) THEN
- WRITE(UNIT=ILUOUT0,FMT="(50('*'),/,'*',48X,'*',/, &
- & '*',10X,' INITIALIZATION TERMINATED',10X,'*',/, &
- & '*',48X,'*',/,50('*'))")
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!
-END SUBROUTINE INIT_MNH
diff --git a/src/mesonh/ext/ion_attach_elec.f90 b/src/mesonh/ext/ion_attach_elec.f90
deleted file mode 100644
index cd0fcf1c3eb268b93d7eeceef9161bc5157122aa..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/ion_attach_elec.f90
+++ /dev/null
@@ -1,631 +0,0 @@
-!MNH_LIC Copyright 2010-2020 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ############################
- MODULE MODI_ION_ATTACH_ELEC
-! ############################
-!
-INTERFACE
- SUBROUTINE ION_ATTACH_ELEC(KTCOUNT, KRR, PTSTEP, PRHODREF, &
- PRHODJ,PSVS, PRS, PTHT, PCIT, PPABST, PEFIELDU, &
- PEFIELDV, PEFIELDW, GATTACH, PTOWN, PSEA )
-
-
-INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference dry air density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry air density* Jacobian
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable vol. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable vol. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta (K) at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEFIELDU, PEFIELDV, PEFIELDW
- ! Electric field components
-LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GATTACH !Recombination and
- !Attachment if true
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! town fraction
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land-sea mask
-
- END SUBROUTINE ION_ATTACH_ELEC
-END INTERFACE
-END MODULE MODI_ION_ATTACH_ELEC
-
-
-
-! ######################################################################
- SUBROUTINE ION_ATTACH_ELEC(KTCOUNT, KRR, PTSTEP, PRHODREF, &
- PRHODJ,PSVS, PRS, PTHT, PCIT, PPABST, PEFIELDU, &
- PEFIELDV, PEFIELDW, GATTACH, PTOWN, PSEA )
-! ######################################################################
-
-
-!
-!!**** * -
-!!
-!! PURPOSE
-!! -------
-!! This routine computes the ion capture by (or attachment to) hydrometeors
-!! providing a source of charge for hydrometeors and a sink for positive
-!! negative ion mixing ratio. It is assumed as resulting from both ionic
-!! diffusion and conduction (electrical attraction).
-!!
-!!
-!! METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! M. Chong *Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 2010
-!! Modifications:
-!! J.Escobar : 18/12/2015 : Correction of bug in bound in // for NHALO <>1
-! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-use modd_budget, only : lbudget_sv, NBUDGET_SV1, tbudgets
-USE MODD_CONF, ONLY: CCONF
-USE MODD_CST
-USE MODD_ELEC_DESCR
-USE MODD_ELEC_n
-USE MODD_ELEC_PARAM
-USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELEC
-USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
-USE MODD_RAIN_ICE_DESCR_n
-USE MODD_RAIN_ICE_PARAM_n
-USE MODD_REF, ONLY: XTHVREFZ
-
-use mode_budget, only: Budget_store_init, Budget_store_end
-use mode_tools_ll, only: GET_INDICE_ll
-
-USE MODI_MOMG
-
-IMPLICIT NONE
-!
-! 0.1 Declaration of arguments
-!
-INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference dry air density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry air density* Jacobian
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable vol. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable vol. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta (K) at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEFIELDU, PEFIELDV, PEFIELDW
- ! Electric field components
-LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GATTACH !Recombination and
- !Attachment if true
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! town fraction
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land-sea mask
-
-!
-!
-! 0.2 Declaration of local variables
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZT ! Temperature (K)
-REAL, DIMENSION(:), ALLOCATABLE :: ZCONC, ZVIT, ZRADIUS ! Number concentration
- !fallspeed, radius
-REAL :: ZCQD, ZCDIF ! computed coefficients
-INTEGER, DIMENSION(SIZE(PTHT)) :: IGI, IGJ, IGK ! Valid grid index
-INTEGER :: IVALID ! Nb of valid grid
-INTEGER :: IIB ! Beginning (B) and end (E) grid points
-INTEGER :: IIE ! along i axis,
-INTEGER :: IJB ! j axis,
-INTEGER :: IJE !
-INTEGER :: IKB ! and k axis
-INTEGER :: IKE !
-
-INTEGER :: II, IJ, IK, JRR, JSV ! Loop index for variable
-INTEGER :: ITYPE ! Hydrometeor category (2: cloud, 3: rain,
- ! 4: ice crystal, 5: snow, 6: graupel, 7: hail)
-REAL :: ZCOMB ! Recombination
-!
-!
-!-------------------------------------------------------------------------------
-if ( lbudget_sv ) then
- do jrr = 1, nsv_elec
- call Budget_store_init( tbudgets( NBUDGET_SV1 - 1 + nsv_elecbeg - 1 + jrr), 'NEUT', psvs(:, :, :, jrr) )
- end do
-end if
-!
-!* 1. COMPUTE THE ION RECOMBINATION and TEMPERATURE
-! ---------------------------------------------
-!
-!
-ZCQD = 4 * XPI * XEPSILON * XBOLTZ / XECHARGE
-ZCDIF = XBOLTZ /XECHARGE
-!
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IKB = 1 + JPVEXT
-IKE = SIZE(PTHT,3) - JPVEXT
-!
-!* 1.1 Add Ion Recombination source (PSVS in 1/(m3.s))
-! and count and localize valid grid points for ion source terms
-!
-IVALID = 0
-DO IK = IKB, IKE
- DO IJ = IJB, IJE
- DO II = IIB, IIE
- IF (GATTACH(II,IJ,IK)) THEN
-! Recombination
- ZCOMB = XIONCOMB * (PSVS(II,IJ,IK,1)*PTSTEP) * &
- (PSVS(II,IJ,IK,NSV_ELEC)*PTSTEP) * &
- PRHODREF(II,IJ,IK) / PRHODJ(II,IJ,IK)
- ZCOMB = MIN(ZCOMB, PSVS(II,IJ,IK,1), PSVS(II,IJ,IK,NSV_ELEC))
- PSVS(II,IJ,IK,1) = PSVS(II,IJ,IK,1) - ZCOMB
- PSVS(II,IJ,IK,NSV_ELEC) = PSVS(II,IJ,IK,NSV_ELEC) - ZCOMB
-! Counting
- IVALID = IVALID + 1
- IGI(IVALID) = II
- IGJ(IVALID) = IJ
- IGK(IVALID) = IK
- END IF
- ENDDO
- ENDDO
-ENDDO
-!
-!* 1.2 Compute the temperature
-!
-IF( IVALID /= 0 ) THEN
- ALLOCATE (ZT(IVALID))
- DO II = 1, IVALID
- ZT(II) = PTHT(IGI(II),IGJ(II),IGK(II)) * &
- (PPABST(IGI(II),IGJ(II),IGK(II)) / XP00) ** (XRD / XCPD)
- ENDDO
-END IF
-!
-!
-!* 2. TRANSFORM VOLUM. SOURCE TERMS INTO MIXING RATIO
-! FOR WATER SPECIES, AND VOLUMIC CONTENT FOR ELECTRIC VARIABLES
-! -------------------------------------------------------------
-!
-DO JRR = 1, KRR
- PRS(:,:,:,JRR) = PRS(:,:,:,JRR) *PTSTEP / PRHODJ(:,:,:)
-ENDDO
-!
-DO JSV = 1, NSV_ELEC
- PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) *PTSTEP *PRHODREF(:,:,:) / PRHODJ(:,:,:)
-ENDDO
-!
-!
-!* 3. COMPUTE ATTACHMENT DUE TO ION DIFFUSION AND CONDUCTION
-! ------------------------------------------------------
-!
-! Attachment to cloud droplets, rain, cloud ice, snow, graupel,
-! and hail (optional)
-!
-!
-IF( IVALID /= 0 ) THEN
-!
-!* 3.1 Attachment to cloud droplets
-!
- ALLOCATE (ZCONC(IVALID))
- ALLOCATE (ZVIT (IVALID))
- ALLOCATE (ZRADIUS(IVALID))
-
- ITYPE = 2
- IF (PRESENT(PSEA)) THEN
- CALL HYDROPARAM (IGI, IGJ, IGK, ZCONC, ZVIT, ZRADIUS, ITYPE, PSEA, PTOWN)
- ELSE
- CALL HYDROPARAM (IGI, IGJ, IGK, ZCONC, ZVIT, ZRADIUS, ITYPE)
- ENDIF
-!
- CALL DIFF_COND (IGI, IGJ, IGK, PSVS(:,:,:,1), PSVS(:,:,:,NSV_ELEC), &
- PSVS(:,:,:,ITYPE))
-!
-!* 3.2 Attachment to raindrops, ice crystals, snow, graupel,
-! and hail (if activated)
-!
- DO ITYPE = 3, KRR
- CALL HYDROPARAM (IGI, IGJ, IGK, ZCONC, ZVIT, ZRADIUS, ITYPE)
-!
- CALL DIFF_COND (IGI, IGJ, IGK, PSVS(:,:,:,1), PSVS(:,:,:,NSV_ELEC), &
- PSVS(:,:,:,ITYPE))
- END DO
-!
- DEALLOCATE (ZCONC, ZVIT, ZRADIUS)
- DEALLOCATE (ZT)
-ENDIF
-!
-!
-!* 4. RETURN TO VOLUMETRIC SOURCE (Prognostic units)
-! ---------------------------
-!
-DO JRR = 1, KRR
- PRS(:,:,:,JRR) = PRS(:,:,:,JRR) * PRHODJ(:,:,:) / PTSTEP
-ENDDO
-!
-DO JSV = 1, NSV_ELEC
- PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) * PRHODJ(:,:,:) / (PTSTEP * PRHODREF(:,:,:))
-ENDDO
-!
-!
-!* 5. BUDGET
-! ------
-!
-if ( lbudget_sv ) then
- do jrr = 1, nsv_elec
- call Budget_store_end( tbudgets( NBUDGET_SV1 - 1 + nsv_elecbeg - 1 + jrr), 'NEUT', psvs(:, :, :, jrr) )
- end do
-end if
-!
-!------------------------------------------------------------------------------
-!
-CONTAINS
-!
-!------------------------------------------------------------------------------
-!
- SUBROUTINE HYDROPARAM (IGRIDX, IGRIDY, IGRIDZ, ZCONC, &
- ZVIT, ZRADIUS, ITYPE, PSEA, PTOWN)
-!
-! Purpose : Compute in regions of valid grid points (IGRIDX, IGRIDY, IGRIDZ)
-! the hydrometeor parameters: concentration (ZCONC),
-! fallspeed (ZVIT),
-! and mean radius (ZRADIUS)
-! involved in the evaluation of ion attachment
-!
-!
-!* 0. DECLARATIONS
-! ------------
-IMPLICIT NONE
-!
-!* 0.1 declaration of dummy arguments
-!
-INTEGER, DIMENSION(:), INTENT(IN) :: IGRIDX, IGRIDY, IGRIDZ ! Index of
- ! valid gridpoints
-INTEGER, INTENT(IN) :: ITYPE ! Hydrometeor category
- ! ITYPE= 2: cloud, 3: rain, 4: ice, 5: snow, 6: graupel, 7: hail
-REAL, DIMENSION(:), INTENT(INOUT) :: ZCONC, ZVIT, ZRADIUS
-! Number concentration, fallspeed, radius
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! town fraction
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land-sea mask
-!
-!* 0.2 declaration of local variables
-!
-REAL :: ZCONC1, ZCONC2 ! for cloud
-REAL :: ZLBC
-REAL :: ZFSEDC
-REAL :: ZRAY
-REAL :: ZEXP1, ZEXP2, ZMOM1, ZMOM2
-REAL :: ZVCOEF, ZRHO00, ZLBI
-REAL :: ZLAMBDA
-INTEGER :: JI, JJ, JK, IV
-!
-!
-ZCONC(:) = 0.
-ZVIT (:) = 0.
-ZRADIUS(:) = 0.
-!
-SELECT CASE (ITYPE)
-!
-!* 1. PARAMETERS FOR CLOUD
-! --------------------
- CASE (2)
-!
- IF (PRESENT(PSEA)) THEN
-
- ZMOM1 = 0.5*MOMG(XALPHAC,XNUC,1.)
- ZMOM2 = 0.5*MOMG(XALPHAC2,XNUC2,1.)
- DO IV = 1, IVALID
- JI = IGRIDX(IV)
- JJ = IGRIDY(IV)
- JK = IGRIDZ(IV)
- IF( PRS(JI, JJ, JK, 2)/PRHODREF(JI, JJ, JK) >XRTMIN_ELEC(2) .AND. &
- PSVS(JI, JJ, JK, 2) /=0. ) THEN
- ZCONC1 = PSEA(JI,JJ) * XCONC_SEA + (1. - PSEA(JI,JJ)) * XCONC_LAND
- ZLBC = PSEA(JI,JJ) * XLBC(2) + (1. - PSEA(JI,JJ)) * XLBC(1)
- ZFSEDC = PSEA(JI,JJ) * XFSEDC(2) + (1. - PSEA(JI,JJ)) * XFSEDC(1)
- ZFSEDC = MAX(MIN(XFSEDC(1),XFSEDC(2)), ZFSEDC)
- ZCONC2 = (1. - PTOWN(JI,JJ)) * ZCONC1 + PTOWN(JI,JJ) * XCONC_URBAN
- ZRAY = (1. - PSEA(JI,JJ)) * ZMOM1 + PSEA(JI,JJ) * ZMOM2
- ZCONC (IV) = ZCONC2 ! Number concentration
- ZLAMBDA = (ZLBC *ZCONC2 / (PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,2)))**XLBEXC
- ZRADIUS (IV) = ZRAY / ZLAMBDA
- ZVIT (IV) = XCC * ZFSEDC * ZLAMBDA**(-XDC) * &
- PRHODREF(JI,JJ,JK)**(-XCEXVT)
- END IF
- ENDDO
- ELSE
- ZRAY = 0.5*MOMG(XALPHAC,XNUC,1.)
- ZLBC = XLBC(1) * XCONC_LAND
- DO IV = 1, IVALID
- JI = IGRIDX(IV)
- JJ = IGRIDY(IV)
- JK = IGRIDZ(IV)
- IF( PRS(JI, JJ, JK, 2)/PRHODREF(JI, JJ, JK) >XRTMIN_ELEC(2) .AND. &
- PSVS(JI, JJ, JK, 2) /=0. ) THEN
- ZCONC (IV) = XCONC_LAND ! Number concentration
- ZLAMBDA = (ZLBC / (PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,2)))**XLBEXC
- ZRADIUS (IV) = ZRAY / ZLAMBDA
- ZVIT (IV) = XCC * XFSEDC(1) * ZLAMBDA**(-XDC) * &
- PRHODREF(JI,JJ,JK)**(-XCEXVT)
- END IF
- ENDDO
- END IF
-!
-!
-!* 2. PARAMETERS FOR RAIN
-! -------------------
- CASE (3)
- ZEXP1 = XEXSEDR - 1.
- ZEXP2 = ZEXP1 - XCEXVT
-!
- DO IV = 1, IVALID
- JI = IGRIDX(IV)
- JJ = IGRIDY(IV)
- JK = IGRIDZ(IV)
- IF( PRS(JI, JJ, JK, 3)/PRHODREF(JI, JJ, JK) >XRTMIN_ELEC(3) .AND. &
- PSVS(JI, JJ, JK, 3) /=0. ) THEN
- ZLAMBDA = XLBR * (PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,3))**XLBEXR
- ZRADIUS (IV) = 0.5 / ZLAMBDA
- ZCONC (IV) = XCCR / ZLAMBDA
- ZVIT (IV) = XFSEDR * PRHODREF(JI,JJ,JK)**ZEXP2 &
- * PRS(JI,JJ,JK,3)**ZEXP1
- END IF
- ENDDO
-!
-!
-!* 3. PARAMETERS FOR ICE
-! ------------------
-!
- CASE (4)
-!
- ZRAY = 0.5*MOMG(XALPHAI,XNUI,1.)
- ZRHO00 = XP00 / (XRD * XTHVREFZ(IKB))
-! ZVCOEF= XC_I * (GAMMA(XNUI+(XBI+XDI)/XALPHAI) / GAMMA(XNUI+XBI/XALPHAI)) &
-! * ZRHO00**XCEXVT
-! Computations for Columns (see ini_rain_ice_elec.f90)
- ZVCOEF = 2.1E5 * MOMG(XALPHAI,XNUI, 3.285) / MOMG(XALPHAI,XNUI, 1.7) &
- * ZRHO00**XCEXVT
- ZLBI = (2.14E-3 * MOMG(XALPHAI,XNUI,1.7)) **0.588235
-
- DO IV = 1, IVALID
- JI = IGRIDX(IV)
- JJ = IGRIDY(IV)
- JK = IGRIDZ(IV)
- IF( PRS(JI, JJ, JK, 4)/PRHODREF(JI, JJ, JK) > XRTMIN_ELEC(4) .AND. &
- PSVS(JI, JJ, JK, 4) /=0.) THEN
- ZCONC (IV) = XFCI * PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,4) * &
- MAX(0.05E6, -0.15319E6 - 0.021454E6 * &
- ALOG(PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,4)))**3
- ZLAMBDA = ZLBI * (ZCONC(IV) / (PRHODREF(JI,JJ,JK) * &
- PRS(JI,JJ,JK,4)))**0.588235
- ZRADIUS (IV) = ZRAY / ZLAMBDA
- ZVIT (IV) = ZVCOEF * ZLAMBDA**(-1.585) * & !(-XDI) * &
- PRHODREF(JI,JJ,JK)**(-XCEXVT)
- END IF
- ENDDO
-!
-!
-!* 4. PARAMETERS FOR SNOW
-! -------------------
-!
- CASE (5)
-!
- ZEXP1 = XEXSEDS - 1.
- ZEXP2 = ZEXP1 - XCEXVT
-!
- DO IV = 1, IVALID
- JI = IGRIDX(IV)
- JJ = IGRIDY(IV)
- JK = IGRIDZ(IV)
- IF( PRS(JI, JJ, JK, 5)/PRHODREF(JI, JJ, JK) >XRTMIN_ELEC(5) .AND. &
- PSVS(JI, JJ, JK, 5) /=0. ) THEN
- ZLAMBDA = XLBS * (PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,5))**XLBEXS
- ZRADIUS (IV) = 0.5 / ZLAMBDA
- ZCONC (IV) = XCCS * ZLAMBDA**XCXS
- ZVIT (IV) = XFSEDS * PRHODREF(JI,JJ,JK)**ZEXP2 &
- * PRS(JI,JJ,JK,5)**ZEXP1
- END IF
- ENDDO
-!
-!
-!* 5. PARAMETERS FOR GRAUPEL
-! ----------------------
-!
- CASE (6)
-!
- ZEXP1 = XEXSEDG - 1.
- ZEXP2 = ZEXP1 - XCEXVT
-!
- DO IV = 1, IVALID
- JI = IGRIDX(IV)
- JJ = IGRIDY(IV)
- JK = IGRIDZ(IV)
- IF( PRS(JI, JJ, JK, 6)/PRHODREF(JI, JJ, JK) >XRTMIN_ELEC(6) .AND. &
- PSVS(JI, JJ, JK, 6) /=0. ) THEN
- ZLAMBDA = XLBG * (PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,6))**XLBEXG
- ZRADIUS (IV) = 0.5 / ZLAMBDA
- ZCONC (IV) = XCCG * ZLAMBDA**XCXG
- ZVIT (IV) = XFSEDG * PRHODREF(JI,JJ,JK)**ZEXP2 &
- * PRS(JI,JJ,JK,6)**ZEXP1
- END IF
- ENDDO
-!
-!
-!* 6. PARAMETERS FOR HAIL
-! -------------------
-!
- CASE (7)
-!
- ZEXP1 = XEXSEDH - 1.
- ZEXP2 = ZEXP1-XCEXVT
- ZRAY = 0.5*MOMG(XALPHAH, XNUH, 1.)
-!
- DO IV = 1, IVALID
- JI = IGRIDX(IV)
- JJ = IGRIDY(IV)
- JK = IGRIDZ(IV)
- IF( PRS(JI, JJ, JK, 7)/PRHODREF(JI, JJ, JK) >XRTMIN_ELEC(7) .AND. &
- PSVS(JI, JJ, JK, 7) /=0. ) THEN
- ZLAMBDA = XLBH * (PRHODREF(JI,JJ,JK) * PRS(JI,JJ,JK,7))**XLBEXH
- ZRADIUS (IV) = ZRAY / ZLAMBDA
- ZCONC (IV) = XCCG * ZLAMBDA**XCXG
- ZVIT (IV) = XFSEDH * PRHODREF(JI,JJ,JK)**ZEXP2 &
- * PRS(JI,JJ,JK,7)**ZEXP1
- END IF
- ENDDO
-!
-END SELECT
-!
-END SUBROUTINE HYDROPARAM
-!
-!------------------------------------------------------------------------------
-!
- SUBROUTINE DIFF_COND (IGRIDX, IGRIDY, IGRIDZ, PQPIS, PQNIS, PQVS)
-!
-! Purpose : Compute in regions of valid grid points (IGRIDX, IGRIDY, IGRIDZ)
-! the attachment of positive (sink for PQPIS) and negative
-! (sink for PQNIS) ions to the hydrometeor variable (charge
-! source for PQVS)
-!
-!
-!* 0. DECLARATIONS
-! ------------
-IMPLICIT NONE
-!
-!* 0.1 declaration of dummy arguments
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQPIS ! Positive ion concentration
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQNIS ! Negative ion concentration
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQVS !Hydrom volumetric charge
-INTEGER, DIMENSION(:), INTENT(IN) :: IGRIDX, IGRIDY, IGRIDZ ! Index of
- ! valid gridpoints
-
-!
-!* 0.2 declaration of local variables
-!
-INTEGER :: JI, JJ, JK, IV
-REAL :: ZNC, ZRADI, ZVT ! Nb conc., radius, fallspeed of the hydrometeor category
-REAL :: ZQ ! net particule charge
-REAL :: ZX, ZFXP, ZFXN ! Limiting diffusion function ZFX = +/- ZX /(exp(+/-ZX) -1)
-REAL :: ZDIFP, ZDPIDT_D ! Diffusion of positive ions
-REAL :: ZDIFM, ZDNIDT_D ! Diffusion of negative ions
-REAL :: ZDPIDT_C ! Conduction of positive ions
-REAL :: ZDNIDT_C ! Conduction of negative ions
-REAL :: ZDELPI, ZDELNI ! Total attachment of pos/neg ions
-REAL :: ZEFIELD ! Electric field magnitude
-REAL :: ZQBOUND ! Limit charge for conduction
-!
-!
-!* 1. COMPUTE ION ATTACHMENT
-! ----------------------
-!
-DO IV = 1, IVALID
- IF (ZCONC(IV) .NE. 0.) THEN
- JI = IGRIDX(IV)
- JJ = IGRIDY(IV)
- JK = IGRIDZ(IV)
-!
- ZNC = ZCONC(IV)
- ZRADI = ZRADIUS(IV)
- ZVT = ZVIT(IV)
-!
-!* 1.0 Ion diffusion to a particle
-!
- ZDPIDT_D = 0.
- ZDNIDT_D = 0.
-!
- ZQ = PQVS(JI,JJ,JK) / ZNC
- ZX = ZQ / (ZCQD * ZRADI * ZT(IV))
-!
- IF(ZX /= 0. .AND. ABS(ZX) <= 20.0) THEN
- IF( ABS(ZX) < 1.0E-15) THEN
- ZFXP = 1.
- ZFXN = 1.
- ELSE
- ZFXP = ZX / (EXP(ZX) - 1.)
- ZFXN = -ZX / (EXP(-ZX) -1.)
- ENDIF
-!
- ZDIFP = 4. * XPI * XMOBIL_POS(JI,JJ,JK) * ZCDIF * ZT(IV)
- ZDPIDT_D = ZRADI * ZDIFP * PQPIS(JI,JJ,JK) * ZFXP * &
- (1. + (2. * ZRADI * ZVT / ZDIFP)**0.5)
-!
- ZDIFM = 4. * XPI * XMOBIL_NEG(JI,JJ,JK) * ZCDIF * ZT(IV)
- ZDNIDT_D = ZRADI * ZDIFM * PQNIS(JI,JJ,JK) * ZFXN * &
- (1. + (2. * ZRADI * ZVT / ZDIFM)**0.5)
-!
- ZDELPI = MIN(ZDPIDT_D*PTSTEP*ZNC, PQPIS(JI,JJ,JK))
- ZDELNI = MIN(ZDNIDT_D*PTSTEP*ZNC, PQNIS(JI,JJ,JK))
-!
- PQPIS(JI,JJ,JK) = PQPIS(JI,JJ,JK) - ZDELPI
- PQNIS(JI,JJ,JK) = PQNIS(JI,JJ,JK) - ZDELNI
- PQVS(JI,JJ,JK) = PQVS(JI,JJ,JK) + XECHARGE * (ZDELPI - ZDELNI)
- ENDIF
-!
-!
-!* 1.1 Ion conduction to a particle
-!
- ZDPIDT_C = 0.
- ZDNIDT_C = 0.
- ZEFIELD = SQRT(PEFIELDU(JI,JJ,JK)**2+PEFIELDV(JI,JJ,JK)**2+ &
- PEFIELDW(JI,JJ,JK)**2)
- ZQBOUND = 12. * XPI * XEPSILON * ZEFIELD * ZRADI**2
- ZQ = PQVS(JI,JJ,JK) / ZNC
-!
- IF (ABS(ZQ) < ZQBOUND) THEN
- IF (PEFIELDW(JI,JJ,JK) > 0.) THEN ! opposite to fall velocity direction
- ZDPIDT_C = 3. * XPI * ZRADI**2 * ZEFIELD * PQPIS(JI,JJ,JK) * &
- XMOBIL_POS(JI,JJ,JK) * (1. - ZQ / ZQBOUND)**2
- IF (ZVT < XMOBIL_NEG(JI,JJ,JK)*ZEFIELD) THEN
- ZDNIDT_C = 3. * XPI * ZRADI**2 * ZEFIELD * PQNIS(JI,JJ,JK) * &
- XMOBIL_NEG(JI,JJ,JK) * (1. + ZQ / ZQBOUND)**2
- ELSE IF (ZQ > 0.) THEN
- ZDNIDT_C = PQNIS(JI,JJ,JK) * XMOBIL_NEG(JI,JJ,JK) * ZQ / XEPSILON
- ENDIF
- ELSE IF (PEFIELDW(JI,JJ,JK) < 0.) THEN ! in the direction of fall veloc.
- IF( ZVT < XMOBIL_POS(JI,JJ,JK)*ZEFIELD) THEN
- ZDPIDT_C = 3. * XPI * ZRADI**2 * ZEFIELD * PQPIS(JI,JJ,JK) * &
- XMOBIL_POS(JI,JJ,JK) * (1. - ZQ / ZQBOUND)**2
- ELSE IF (ZQ < 0.) THEN
- ZDPIDT_C = -PQPIS(JI,JJ,JK) * XMOBIL_POS(JI,JJ,JK) * ZQ / XEPSILON
- ENDIF
- ZDNIDT_C = 3. * XPI * ZRADI**2 * ZEFIELD * PQNIS(JI,JJ,JK) * &
- XMOBIL_NEG(JI,JJ,JK) * (1. + ZQ / ZQBOUND)**2
- ENDIF
- ELSE IF (ZQ >= ZQBOUND) THEN
- ZDPIDT_C = 0.
- ZDNIDT_C = PQNIS(JI,JJ,JK) * XMOBIL_NEG(JI,JJ,JK) * ZQ / XEPSILON
- ELSE IF (ZQ <= -ZQBOUND) THEN
- ZDPIDT_C = -PQPIS(JI,JJ,JK) * XMOBIL_POS(JI,JJ,JK) * ZQ / XEPSILON
- ZDNIDT_C = 0.
- ENDIF
-!
- ZDELPI = MIN(ZDPIDT_C*PTSTEP*ZNC, PQPIS(JI,JJ,JK))
- ZDELNI = MIN(ZDNIDT_C*PTSTEP*ZNC, PQNIS(JI,JJ,JK))
-!
- PQPIS(JI,JJ,JK) = PQPIS(JI,JJ,JK) - ZDELPI
- PQNIS(JI,JJ,JK) = PQNIS(JI,JJ,JK) - ZDELNI
- PQVS(JI,JJ,JK) = PQVS(JI,JJ,JK) + XECHARGE *(ZDELPI - ZDELNI)
- END IF
-ENDDO
-!
-END SUBROUTINE DIFF_COND
-!
-!-----------------------------------------------------------------------------
-!
-END SUBROUTINE ION_ATTACH_ELEC
diff --git a/src/mesonh/ext/latlon_to_xy.f90 b/src/mesonh/ext/latlon_to_xy.f90
deleted file mode 100644
index b969a76f470de6daf738ff1ef67b08753224b1ff..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/latlon_to_xy.f90
+++ /dev/null
@@ -1,227 +0,0 @@
-!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ####################
- PROGRAM LATLON_TO_XY
-! ####################
-!
-!!**** *LATLON_TO_XY* program to compute x and y from latitude and longiude
-!! for a MESONH file
-!!
-!! PURPOSE
-!! -------
-!!
-!! METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! module MODE_GRIDPROJ : contains projection routines
-!! SM_LATLON and SM_XYHAT
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! module MODD_GRID : variables for projection:
-!! XLAT0,XLON0,XRPK,XBETA
-!!
-!! module MODD_PGDDIM : specify the dimentions of the data arrays:
-!! NPGDIMAX and NPGDJMAX
-!!
-!! module MODD_PGDGRID : grid variables:
-!! XPGDLONOR,XPGDLATOR: longitude and latitude of the
-!! origine point for the conformal projection.
-!! XPGDXHAT,XPGDYHAT: position x,y in the conformal plane
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! V. Masson Meteo-France
-!!
-!! MODIFICATION
-!! ------------
-!!
-!! Original 29/12/95
-!!
-!! remove the USE MODI_DEFAULT_DESFM Apr. 17, 1996 (J.Stein)
-!! no transfer of the file when closing Dec. 09, 1996 (V.Masson)
-!! + changes call to READ_HGRID
-! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
-! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-! P. Wautelet 10/04/2020: add missing initializations (LATLON_TO_XY was not working)
-! J. Escobar 21/07/2020: missing modi_version
-!----------------------------------------------------------------------------
-!
-!* 0. DECLARATION
-! -----------
-!
-use MODD_CONF, only: CPROGRAM
-USE MODD_DIM_n
-USE MODD_GRID
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PGDDIM
-USE MODD_PGDGRID
-USE MODD_PARAMETERS
-USE MODD_LUNIT
-!
-USE MODE_FIELD, ONLY: INI_FIELD_LIST
-USE MODE_GRIDPROJ
-USE MODE_IO, only: IO_Config_set, IO_Init
-use MODE_IO_FIELD_READ, only: IO_Field_read
-USE MODE_IO_FILE, only: IO_File_close, IO_File_open
-USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
-use MODE_INIT_ll, only: SET_DIM_ll, SET_JP_ll
-USE MODE_MODELN_HANDLER, ONLY: GOTO_MODEL
-USE MODE_POS, ONLY: POSNAM
-use MODE_SPLITTINGZ_ll
-!
-USE MODE_INI_CST, ONLY: INI_CST
-USE MODI_READ_HGRID
-USE MODI_VERSION
-!
-USE MODN_CONFIO, ONLY: NAM_CONFIO
-!
-IMPLICIT NONE
-!
-!* 0.2 Declaration of variables
-! ------------------------
-!
-CHARACTER(LEN=28) :: YINIFILE ! name of input FM file
-CHARACTER(LEN=28) :: YNAME ! true name of input FM file
-CHARACTER(LEN=28) :: YDAD ! name of dad of input FM file
-CHARACTER(LEN=2) :: YSTORAGE_TYPE
-INTEGER :: INAM ! Logical unit for namelist file
-INTEGER :: ILUOUT0 ! Logical unit for output file.
-INTEGER :: IRESP ! Return-code if problem eraised.
-REAL :: ZLAT ! input latitude
-REAL :: ZLON ! input longitude
-REAL :: ZXHAT ! output conformal coodinate x
-REAL :: ZYHAT ! output conformal coodinate y
-INTEGER :: II,IJ ! indexes of the point
-REAL :: ZI,ZJ ! fractionnal indexes of the point
-TYPE(TFILEDATA),POINTER :: TZINIFILE => NULL()
-TYPE(TFILEDATA),POINTER :: TZNMLFILE => NULL()
-LOGICAL :: GFOUND
-!
-!* 0.3 Declaration of namelists
-! ------------------------
-!
-NAMELIST/NAM_INIFILE/ YINIFILE
-!----------------------------------------------------------------------------
-!
- WRITE(*,*) '+---------------------------------+'
- WRITE(*,*) '| program latlon_to_xy |'
- WRITE(*,*) '+---------------------------------+'
- WRITE(*,*) ''
- WRITE(*,*) 'Warning: I and J are integer for flux points'
-!
-!* 1. Initializations
-! ---------------
-!
-CALL GOTO_MODEL(1)
-!
-CALL VERSION()
-!
-CPROGRAM='LAT2XY'
-!
-CALL IO_Init()
-!
-CALL INI_CST()
-!
-CALL INI_FIELD_LIST()
-!
-!* 2. Reading of namelist file
-! ------------------------
-!
-!
-CALL IO_File_add2list(TZNMLFILE,'LATLON2XY1.nam','NML','READ')
-CALL IO_File_open(TZNMLFILE)
-INAM=TZNMLFILE%NLU
-!
-CALL POSNAM(INAM,'NAM_INIFILE',GFOUND)
-IF (GFOUND) THEN
- READ(UNIT=INAM,NML=NAM_INIFILE)
- PRINT*, ' namelist NAM_INIFILE read'
-END IF
-!
-CALL POSNAM(INAM,'NAM_CONFIO',GFOUND)
-IF (GFOUND) THEN
- READ(UNIT=INAM,NML=NAM_CONFIO)
- PRINT*, ' namelist NAM_CONFIO read'
-END IF
-!
-CALL IO_Config_set()
-CALL IO_File_close(TZNMLFILE)
-!
-!* 1. Opening of MESONH file
-! ----------------------
-!
-CALL IO_File_add2list(TZINIFILE,TRIM(YINIFILE),'MNH','READ',KLFITYPE=2,KLFIVERB=2)
-CALL IO_File_open(TZINIFILE)
-!
-CALL IO_Field_read(TZINIFILE,'IMAX', NIMAX)
-CALL IO_Field_read(TZINIFILE,'JMAX', NJMAX)
-NKMAX = 1
-CALL IO_Field_read(TZINIFILE,'JPHEXT',JPHEXT)
-!
-CALL SET_JP_ll(1,JPHEXT,JPVEXT,JPHEXT)
-CALL SET_DIM_ll(NIMAX, NJMAX, NKMAX)
-CALL INI_PARAZ_ll(IRESP)
-!
-!* 2. Reading of MESONH file
-! ----------------------
-!
-CALL READ_HGRID(0,TZINIFILE,YNAME,YDAD,YSTORAGE_TYPE)
-!
-!* 3. Closing of MESONH file
-! ----------------------
-!
-CALL IO_File_close(TZINIFILE)
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. Reading of latitude and longitude
-! ---------------------------------
-!
-DO
- WRITE(*,*) '-------------------------------------------------------------------'
- WRITE(*,*) 'please enter the latitude (in decimal degrees; quit or q to stop):'
- READ(*,*,ERR=1) ZLAT
- WRITE(*,*) 'please enter the longitude (in decimal degrees; quit or q to stop):'
- READ(*,*,ERR=1) ZLON
-!
- CALL SM_XYHAT(XPGDLATOR,XPGDLONOR, &
- ZLAT,ZLON,ZXHAT,ZYHAT)
-!
- WRITE(*,*) 'x=', ZXHAT
- WRITE(*,*) 'y=', ZYHAT
-!
- II=MAX(MIN(COUNT(XPGDXHAT(:)<ZXHAT),NPGDIMAX+2*JPHEXT-1),1)
- IJ=MAX(MIN(COUNT(XPGDYHAT(:)<ZYHAT),NPGDJMAX+2*JPHEXT-1),1)
- ZI=(ZXHAT-XPGDXHAT(II))/(XPGDXHAT(II+1)-XPGDXHAT(II))+REAL(II)
- ZJ=(ZYHAT-XPGDYHAT(IJ))/(XPGDYHAT(IJ+1)-XPGDYHAT(IJ))+REAL(IJ)
-!
- IF ( (ZI>=1.) .AND. (ZI<=NPGDIMAX+2*JPHEXT+1) &
- .AND. (ZJ>=1.) .AND. (ZJ<=NPGDJMAX+2*JPHEXT+1) ) THEN
- WRITE(*,*) 'I=',ZI
- WRITE(*,*) 'J=',ZJ
- ELSE
- WRITE(*,*) 'point not in the domain'
- WRITE(*,*) 'I=',ZI
- WRITE(*,*) 'J=',ZJ
- END IF
-END DO
-1 WRITE(*,*) 'good bye'
-!
-!-------------------------------------------------------------------------------
-!
-END PROGRAM LATLON_TO_XY
diff --git a/src/mesonh/ext/les_cloud_masksn.f90 b/src/mesonh/ext/les_cloud_masksn.f90
deleted file mode 100644
index 10e9e4093fc35cf7e5d3ba3c0ebcce0047611694..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/les_cloud_masksn.f90
+++ /dev/null
@@ -1,419 +0,0 @@
-!MNH_LIC Copyright 2006-2020 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! #######################
- SUBROUTINE LES_CLOUD_MASKS_n
-! #######################
-!
-!
-!!**** *LES_MASKS_n* initializes the masks for clouds
-!!
-!!
-!! PURPOSE
-!! -------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 07/2006
-!! P. Aumond 10/2009 Add possibility of user maskS
-!! F.Couvreux 06/2011 : Conditional sampling
-!! C.Lac 10/2014 : Correction on user masks
-!! Q.Rodier 05/2019 : Missing parallelization
-!!
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_LES
-USE MODD_LES_n
-USE MODD_FIELD_n
-USE MODD_CONF_n
-USE MODD_CST , ONLY : XRD, XRV
-USE MODD_NSV , ONLY : NSV_CSBEG, NSV_CSEND, NSV_CS
-USE MODD_GRID_n , ONLY : XZHAT
-USE MODD_CONDSAMP
-!
-USE MODE_ll
-!
-USE MODI_LES_VER_INT
-USE MODI_LES_MEAN_ll
-USE MODI_SHUMAN
-!
-IMPLICIT NONE
-!
-!
-! 0.2 declaration of local variables
-!
-INTEGER :: JK ! vertical loop counter
-INTEGER :: JI ! loop index on masks
-INTEGER :: IIU, IJU,IIB,IJB,IIE,IJE ! hor. indices
-INTEGER :: IKU, KBASE, KTOP ! ver. index
-INTEGER :: IRR, IRRC, IRRR, IRRI, IRRS, IRRG ! moist variables indices
-INTEGER :: JSV ! ind of scalars
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRT ! total water
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHV ! Virtual potential temperature
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZW_LES ! W on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRC_LES ! Rc on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRI_LES ! Ri on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRT_LES ! Rt on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHV_LES ! thv on LES vertical grid
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSV_LES ! thv on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHV_ANOM ! thv-thv_mean on LES vertical grid
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSV_ANOM ! sv-sv_mean
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSTD_SV
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSTD_SVTRES ! threshold of sv
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK3D,ZWORK3DB
-REAL, DIMENSION(:), ALLOCATABLE :: ZWORK1D
-REAL, DIMENSION(:), ALLOCATABLE :: ZMEANRC
-!
-!
-!-------------------------------------------------------------------------------
-!
-CALL GET_DIM_EXT_ll('B',IIU,IJU)
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-!
-IKU = SIZE(XTHT,3)
-!
-!-------------------------------------------------------------------------------
-!
-!* 1.0 Thermodynamical computations
-! ----------------------------
-!
-ALLOCATE(ZRT (IIU,IJU,IKU))
-ALLOCATE(ZMEANRC (IKU))
-ZRT = 0.
-!
-IRR=0
-IF (LUSERV) THEN
- IRR=IRR+1
- ZRT = ZRT + XRT(:,:,:,1)
-END IF
-IF (LUSERC) THEN
- IRR=IRR+1
- IRRC=IRR
- ZRT = ZRT + XRT(:,:,:,IRRC)
-END IF
-IF (LUSERR) THEN
- IRR=IRR+1
- IRRR=IRR
- ZRT = ZRT + XRT(:,:,:,IRRR)
-END IF
-IF (LUSERI) THEN
- IRR=IRR+1
- IRRI=IRR
- ZRT = ZRT + XRT(:,:,:,IRRI)
-END IF
-IF (LUSERS) THEN
- IRR=IRR+1
- IRRS=IRR
- ZRT = ZRT + XRT(:,:,:,IRRS)
-END IF
-IF (LUSERG) THEN
- IRR=IRR+1
- IRRG=IRR
- ZRT = ZRT + XRT(:,:,:,IRRG)
-END IF
-!
-!
-!* computes fields on the LES grid in order to compute masks
-!
-ALLOCATE(ZTHV (IIU,IJU,IKU))
-ZTHV = XTHT
-IF (LUSERV) ZTHV=ZTHV*(1.+XRV/XRD*XRT(:,:,:,1))/(1.+ZRT(:,:,:))
-!
-!-------------------------------------------------------------------------------
-!
-!* 2.0 Fields on LES grid
-! ------------------
-!
-!* allocates fields on the LES grid
-!
-!
-ALLOCATE(ZW_LES (IIU,IJU,NLES_K))
-ALLOCATE(ZRC_LES (IIU,IJU,NLES_K))
-ALLOCATE(ZRI_LES (IIU,IJU,NLES_K))
-ALLOCATE(ZRT_LES (IIU,IJU,NLES_K))
-ALLOCATE(ZTHV_LES (IIU,IJU,NLES_K))
-ALLOCATE(ZTHV_ANOM(IIU,IJU,NLES_K))
-ALLOCATE(ZSV_LES (IIU,IJU,NLES_K,NSV_CS))
-ALLOCATE(ZSV_ANOM(IIU,IJU,NLES_K,NSV_CS))
-ALLOCATE(ZSTD_SV(NLES_K,NSV_CS))
-ALLOCATE(ZSTD_SVTRES(NLES_K,NSV_CS))
-ALLOCATE(ZWORK1D(NLES_K))
-ALLOCATE(ZWORK3D(IIU,IJU,IKU))
-ALLOCATE(ZWORK3DB(IIU,IJU,NLES_K))
-!
-ZWORK1D=0.
-ZWORK3D=0.
-ZWORK3DB=0.
-!
-CALL LES_VER_INT(MZF(XWT), ZW_LES)
-IF (NSV_CS>0) THEN
- DO JSV=NSV_CSBEG, NSV_CSEND
- CALL LES_VER_INT( XSVT(:,:,:,JSV), &
- ZSV_LES(:,:,:,JSV-NSV_CSBEG+1) )
- END DO
-END IF
-IF (LUSERC) THEN
- CALL LES_VER_INT(XRT(:,:,:,IRRC), ZRC_LES)
-ELSE
- ZRC_LES = 0.
-END IF
-IF (LUSERI) THEN
- CALL LES_VER_INT(XRT(:,:,:,IRRI), ZRI_LES)
-ELSE
- ZRI_LES = 0.
-END IF
-CALL LES_VER_INT(ZRT, ZRT_LES)
-CALL LES_VER_INT(ZTHV, ZTHV_LES)
-CALL LES_ANOMALY_FIELD(ZTHV,ZTHV_ANOM)
-!
-IF (NSV_CS>0) THEN
- DO JSV=NSV_CSBEG, NSV_CSEND
- ZWORK3D(:,:,:)=XSVT(:,:,:,JSV)
- CALL LES_ANOMALY_FIELD(ZWORK3D,ZWORK3DB)
- ZSV_ANOM(:,:,:,JSV-NSV_CSBEG+1)=ZWORK3DB(:,:,:)
- CALL LES_STDEV(ZWORK3DB,ZWORK1D)
- ZSTD_SV(:,JSV-NSV_CSBEG+1)=ZWORK1D(:)
- DO JK=1,NLES_K
- ZSTD_SVTRES(JK,JSV-NSV_CSBEG+1)=SUM(ZSTD_SV(1:JK,JSV-NSV_CSBEG+1))/(1.*JK)
- END DO
- END DO
-END IF
-!
-DEALLOCATE(ZTHV )
-DEALLOCATE(ZWORK3D)
-DEALLOCATE(ZWORK3DB)
-DEALLOCATE(ZWORK1D)
-!
-!-------------------------------------------------------------------------------
-!
-!* 3.0 Cloud mask
-! ----------
-!
-IF (LLES_NEB_MASK) THEN
- CALL LES_ALLOCATE('LLES_CURRENT_NEB_MASK',(/IIU,IJU,NLES_K/))
- LLES_CURRENT_NEB_MASK (:,:,:) = .FALSE.
- WHERE ((ZRC_LES(IIB:IIE,IJB:IJE,:)>1.E-6 .OR. ZRI_LES(IIB:IIE,IJB:IJE,:)>1.E-6) .AND. ZW_LES(IIB:IIE,IJB:IJE,:)>0.)
- LLES_CURRENT_NEB_MASK (IIB:IIE,IJB:IJE,:) = .TRUE.
- END WHERE
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 4.0 Cloud core mask
-! ---------------
-!
-IF (LLES_CORE_MASK) THEN
- CALL LES_ALLOCATE('LLES_CURRENT_CORE_MASK',(/IIU,IJU,NLES_K/))
- LLES_CURRENT_CORE_MASK (:,:,:) = .FALSE.
- WHERE ((ZRC_LES(IIB:IIE,IJB:IJE,:)>1.E-6 .OR. ZRI_LES(IIB:IIE,IJB:IJE,:)>1.E-6) &
- .AND. ZW_LES(IIB:IIE,IJB:IJE,:)>0. .AND. ZTHV_ANOM(IIB:IIE,IJB:IJE,:)>0.)
- LLES_CURRENT_CORE_MASK (IIB:IIE,IJB:IJE,:) = .TRUE.
- END WHERE
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 4.0 Conditional sampling mask
-! -------------------------
-!
-IF (LLES_CS_MASK) THEN
-!
- CALL LES_MEAN_ll(ZRC_LES, LLES_CURRENT_CART_MASK, ZMEANRC )
- CALL LES_ALLOCATE('LLES_CURRENT_CS1_MASK',(/IIU,IJU,NLES_K/))
- LLES_CURRENT_CS1_MASK(:,:,:) = .FALSE.
- IF (NSV_CS >= 2) THEN
- CALL LES_ALLOCATE('LLES_CURRENT_CS2_MASK',(/IIU,IJU,NLES_K/))
- LLES_CURRENT_CS2_MASK(:,:,:) = .FALSE.
- IF (NSV_CS == 3) THEN
- CALL LES_ALLOCATE('LLES_CURRENT_CS3_MASK',(/IIU,IJU,NLES_K/))
- LLES_CURRENT_CS3_MASK (:,:,:) = .FALSE.
- END IF
- END IF
-
-!
-! Cloud top and base computation
-!
- KBASE=2
- KTOP=NLES_K
- DO JK=2,NLES_K
- IF ((ZMEANRC(JK) > 1.E-7) .AND. (KBASE == 2)) KBASE=JK
- IF ((ZMEANRC(JK) < 1.E-7) .AND. (KBASE > 2) .AND. (KTOP == NLES_K)) &
- KTOP=JK-1
- END DO
-!
- DO JSV=NSV_CSBEG, NSV_CSEND
- DO JK=2,NLES_K
- IF (ZSTD_SV(JK,JSV-NSV_CSBEG+1) < 0.05*ZSTD_SVTRES(JK,JSV-NSV_CSBEG+1)) &
- ZSTD_SV(JK,JSV-NSV_CSBEG+1)=0.05*ZSTD_SVTRES(JK,JSV-NSV_CSBEG+1)
-! case no cloud top and base
- IF (JSV == NSV_CSBEG) THEN
- IF ((KBASE ==2) .AND. (KTOP == NLES_K)) THEN
- WHERE (ZW_LES(IIB:IIE,IJB:IJE,JK)>0. .AND. ZSV_ANOM(IIB:IIE,IJB:IJE,JK,JSV-NSV_CSBEG+1) > &
- XSCAL(JSV-NSV_CSBEG+1) * ZSTD_SV(JK,JSV-NSV_CSBEG+1))
- LLES_CURRENT_CS1_MASK (IIB:IIE,IJB:IJE,JK) = .TRUE.
- END WHERE
- END IF
-!
-! case cloud top and base defined
-!
- IF (XZHAT(JK) < XZHAT(KBASE)+(XZHAT(KTOP)-XZHAT(KBASE))/4.) THEN
- WHERE (ZW_LES(IIB:IIE,IJB:IJE,JK)>0. .AND. ZSV_ANOM(IIB:IIE,IJB:IJE,JK,JSV-NSV_CSBEG+1) > &
- XSCAL(JSV-NSV_CSBEG+1) *ZSTD_SV(JK,JSV-NSV_CSBEG+1))
- LLES_CURRENT_CS1_MASK (IIB:IIE,IJB:IJE,JK) = .TRUE.
- END WHERE
- END IF
-!
- IF (XZHAT(JK) >= XZHAT(KBASE)+(XZHAT(KTOP)-XZHAT(KBASE))/4.) THEN
- WHERE (ZW_LES(IIB:IIE,IJB:IJE,JK)>0. .AND. ZSV_ANOM(IIB:IIE,IJB:IJE,JK,JSV-NSV_CSBEG+1) > &
- XSCAL(JSV-NSV_CSBEG+1) * ZSTD_SV(JK,JSV-NSV_CSBEG+1) .AND. &
- ZRC_LES(IIB:IIE,IJB:IJE,JK)>1.E-6)
- LLES_CURRENT_CS1_MASK (IIB:IIE,IJB:IJE,JK) = .TRUE.
- END WHERE
- END IF
- ELSE IF ( JSV == NSV_CSBEG + 1 ) THEN
- IF ((KBASE ==2) .AND. (KTOP == NLES_K)) THEN
- WHERE ( ZSV_ANOM(IIB:IIE,IJB:IJE,JK,JSV-NSV_CSBEG+1) > &
- XSCAL(JSV-NSV_CSBEG+1) * ZSTD_SV(JK,JSV-NSV_CSBEG+1))
- LLES_CURRENT_CS2_MASK (IIB:IIE,IJB:IJE,JK) = .TRUE.
- END WHERE
- END IF
-!
-! case cloud top and base defined
-!
- IF (XZHAT(JK) < XZHAT(KBASE)+(XZHAT(KTOP)-XZHAT(KBASE))/4.) THEN
- WHERE (ZSV_ANOM(IIB:IIE,IJB:IJE,JK,JSV-NSV_CSBEG+1) > &
- XSCAL(JSV-NSV_CSBEG+1) *ZSTD_SV(JK,JSV-NSV_CSBEG+1))
- LLES_CURRENT_CS2_MASK (IIB:IIE,IJB:IJE,JK) = .TRUE.
- END WHERE
- END IF
-!
- IF (XZHAT(JK) >= XZHAT(KBASE)+(XZHAT(KTOP)-XZHAT(KBASE))/4.) THEN
- WHERE (ZSV_ANOM(IIB:IIE,IJB:IJE,JK,JSV-NSV_CSBEG+1) > &
- XSCAL(JSV-NSV_CSBEG+1) * ZSTD_SV(JK,JSV-NSV_CSBEG+1))
- LLES_CURRENT_CS2_MASK (IIB:IIE,IJB:IJE,JK) = .TRUE.
- END WHERE
- END IF
-!
- ELSE
- IF ((KBASE ==2) .AND. (KTOP == NLES_K)) THEN
- WHERE ( ZSV_ANOM(IIB:IIE,IJB:IJE,JK,JSV-NSV_CSBEG+1) > &
- XSCAL(JSV-NSV_CSBEG+1) * ZSTD_SV(JK,JSV-NSV_CSBEG+1))
- LLES_CURRENT_CS3_MASK (IIB:IIE,IJB:IJE,JK) = .TRUE.
- END WHERE
- END IF
-!
-! case cloud top and base defined
-!
- IF (XZHAT(JK) < XZHAT(KBASE)+(XZHAT(KTOP)-XZHAT(KBASE))/4.) THEN
- WHERE (ZSV_ANOM(IIB:IIE,IJB:IJE,JK,JSV-NSV_CSBEG+1) > &
- XSCAL(JSV-NSV_CSBEG+1) *ZSTD_SV(JK,JSV-NSV_CSBEG+1))
- LLES_CURRENT_CS3_MASK (IIB:IIE,IJB:IJE,JK) = .TRUE.
- END WHERE
- END IF
-!
- IF (XZHAT(JK) >= XZHAT(KBASE)+(XZHAT(KTOP)-XZHAT(KBASE))/4.) THEN
- WHERE (ZSV_ANOM(IIB:IIE,IJB:IJE,JK,JSV-NSV_CSBEG+1) > &
- XSCAL(JSV-NSV_CSBEG+1) * ZSTD_SV(JK,JSV-NSV_CSBEG+1))
- LLES_CURRENT_CS3_MASK (IIB:IIE,IJB:IJE,JK) = .TRUE.
- END WHERE
- END IF
- END IF
- END DO
- END DO
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 5.0 User mask
-! ---------
-!
-IF (LLES_MY_MASK) THEN
- CALL LES_ALLOCATE('LLES_CURRENT_MY_MASKS',(/IIU,IJU,NLES_K,NLES_MASKS_USER/))
- DO JI=1,NLES_MASKS_USER
- LLES_CURRENT_MY_MASKS (IIB:IIE,IJB:IJE,:,JI) = .FALSE.
- END DO
-! WHERE ((ZRC_LES + ZRI_LES) > 1.E-06)
-! LLES_CURRENT_MY_MASKS (:,:,:,1) = .TRUE.
-! END WHERE
-!
-END IF
-!-------------------------------------------------------------------------------
-!
-DEALLOCATE(ZW_LES )
-DEALLOCATE(ZRC_LES )
-DEALLOCATE(ZRI_LES )
-DEALLOCATE(ZRT_LES )
-DEALLOCATE(ZTHV_LES )
-DEALLOCATE(ZSV_LES )
-DEALLOCATE(ZTHV_ANOM)
-DEALLOCATE(ZSV_ANOM)
-DEALLOCATE(ZSTD_SV)
-DEALLOCATE(ZSTD_SVTRES)
-!-------------------------------------------------------------------------------
-DEALLOCATE(ZRT )
-DEALLOCATE(ZMEANRC)
-!--------------------------------------------------------------------------------
-!
-CONTAINS
-!
-!--------------------------------------------------------------------------------
-!
-SUBROUTINE LES_ANOMALY_FIELD(PF,PF_ANOM)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PF
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PF_ANOM
-
-REAL, DIMENSION(SIZE(PF_ANOM,3)) :: ZMEAN
-INTEGER :: JI, JJ
-
-CALL LES_VER_INT(PF, PF_ANOM)
-CALL LES_MEAN_ll(PF_ANOM, LLES_CURRENT_CART_MASK, ZMEAN )
-DO JJ=1,SIZE(PF_ANOM,2)
- DO JI=1,SIZE(PF_ANOM,1)
- PF_ANOM(JI,JJ,:) = PF_ANOM(JI,JJ,:) - ZMEAN(:)
- END DO
-END DO
-
-END SUBROUTINE LES_ANOMALY_FIELD
-!--------------------------------------------------------------------------------
-!
-!--------------------------------------------------------------------------------
-!
-SUBROUTINE LES_STDEV(PF_ANOM,PF_STD)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PF_ANOM
-REAL, DIMENSION(:), INTENT(OUT) :: PF_STD
-
-REAL, DIMENSION(SIZE(PF_ANOM,1),SIZE(PF_ANOM,2),SIZE(PF_ANOM,3)) :: Z2
-INTEGER :: JK
-
-Z2(:,:,:)=PF_ANOM(:,:,:)*PF_ANOM(:,:,:)
-CALL LES_MEAN_ll(Z2, LLES_CURRENT_CART_MASK, PF_STD )
-DO JK=1,SIZE(PF_ANOM,3)
- PF_STD(JK)=SQRT(PF_STD(JK))
-END DO
-
-END SUBROUTINE LES_STDEV
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LES_CLOUD_MASKS_n
diff --git a/src/mesonh/ext/les_ini_timestepn.f90 b/src/mesonh/ext/les_ini_timestepn.f90
deleted file mode 100644
index 98c5cd306456bf19b2839c9ee608448392c07078..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/les_ini_timestepn.f90
+++ /dev/null
@@ -1,407 +0,0 @@
-!MNH_LIC Copyright 2002-2021 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! #######################
-MODULE MODI_LES_INI_TIMESTEP_n
-! #######################
-!
-!
-INTERFACE LES_INI_TIMESTEP_n
-!
- SUBROUTINE LES_INI_TIMESTEP_n(KTCOUNT)
-!
-INTEGER, INTENT(IN) :: KTCOUNT ! current model time-step
-!
-END SUBROUTINE LES_INI_TIMESTEP_n
-!
-END INTERFACE
-!
-END MODULE MODI_LES_INI_TIMESTEP_n
-
-! ##############################
- SUBROUTINE LES_INI_TIMESTEP_n(KTCOUNT)
-! ##############################
-!
-!
-!!**** *LES_INI_TIMESTEP_n* initializes the LES variables for
-!! the current time-step of model _n
-!!
-!!
-!! PURPOSE
-!! -------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 06/11/02
-! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
-! P. Wautelet 30/03/2021: budgets: LES cartesian subdomain limits are defined in the physical domain
-! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-USE MODD_NSV
-USE MODD_LES
-USE MODD_LES_n
-USE MODD_FIELD_n
-USE MODD_METRICS_n
-USE MODD_REF_n
-USE MODD_CONF_n
-USE MODD_TIME_n
-USE MODD_DYN_n
-USE MODD_TIME
-USE MODD_CONF
-USE MODD_LES_BUDGET
-!
-use mode_datetime, only: Datetime_distance
-USE MODE_ll
-USE MODE_MODELN_HANDLER
-!
-USE MODI_LES_VER_INT
-USE MODI_THL_RT_FROM_TH_R
-USE MODI_LES_MEAN_ll
-USE MODI_SHUMAN
-!
-USE MODI_SECOND_MNH
-USE MODI_LES_CLOUD_MASKS_N
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-!
-INTEGER, INTENT(IN) :: KTCOUNT ! current model time-step
-!
-!
-! 0.2 declaration of local variables
-!
-INTEGER :: IXOR_ll, IYOR_ll ! origine point coordinates
-! ! of current processor domain
-! ! on model domain on all
-! ! processors
-INTEGER :: IIB_ll, IJB_ll ! SO point coordinates of
-! ! current processor phys. domain
-! ! on model domain on all
-! ! processors
-INTEGER :: IIE_ll, IJE_ll ! NE point coordinates of
-! ! current processor phys. domain
-! ! on model domain on all
-! ! processors
-INTEGER :: IIINF_MASK, IISUP_MASK ! cart. mask local proc. limits
-INTEGER :: IJINF_MASK, IJSUP_MASK ! cart. mask local proc. limits
-!
-INTEGER :: JK ! vertical loop counter
-INTEGER :: IIB, IJB, IIE, IJE ! hor. indices
-INTEGER :: IIU, IJU ! hor. indices
-INTEGER :: IKU ! ver. index
-INTEGER :: IRR, IRRC, IRRR, IRRI, IRRS, IRRG ! moist variables indices
-!
-INTEGER :: JSV ! scalar variables counter
-!
-REAL :: ZTIME1, ZTIME2 ! CPU time counters
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHL ! theta_l
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRT ! total water
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZL ! Latent heat of vaporization
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCP ! Cp
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEXN ! Exner function
-INTEGER :: IMI ! current model index
-!-------------------------------------------------------------------------------
-!
-!* 1. Does current time-step is a LES time-step?
-! -----------------------------------------
-!
-LLES_CALL= .FALSE.
-!
-CALL SECOND_MNH(ZTIME1)
-!
-IF (NLES_TCOUNT==NLES_TIMES) LLES_CALL=.FALSE.
-!
-IF ( KTCOUNT>1 .AND. MOD (KTCOUNT-1,NLES_DTCOUNT)==0) LLES_CALL=.TRUE.
-!
-IF (.NOT. LLES_CALL) RETURN
-!
-CALL BUDGET_FLAGS(LUSERV, LUSERC, LUSERR, &
- LUSERI, LUSERS, LUSERG, LUSERH )
-!
-NLES_TCOUNT = NLES_TCOUNT + 1
-!
-NLES_CURRENT_TCOUNT = NLES_TCOUNT
-!
-tles_dates(nles_tcount) = tdtcur
-call Datetime_distance( tdtseg, tdtcur, xles_times(nles_tcount) )
-!
-!* forward-in-time time-step
-!
-XCURRENT_TSTEP = XTSTEP
-!
-!-------------------------------------------------------------------------------
-!
-CALL GET_OR_ll ('B',IXOR_ll,IYOR_ll)
-CALL GET_DIM_EXT_ll('B',IIU,IJU)
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-!
-IIB_ll=IXOR_ll+IIB-1
-IJB_ll=IYOR_ll+IJB-1
-IIE_ll=IXOR_ll+IIE-1
-IJE_ll=IYOR_ll+IJE-1
-!
-IKU = SIZE(XTHT,3)
-!
-IMI = GET_CURRENT_MODEL_INDEX()
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. Definition of masks
-! -------------------
-!
-!* 2.1 Cartesian (sub-)domain (on local processor)
-! ----------------------
-!
-CALL LES_ALLOCATE('LLES_CURRENT_CART_MASK',(/IIU,IJU,NLES_K/))
-!
-IIINF_MASK = MAX(IIB, NLESn_IINF(IMI)+JPHEXT-(IIB_ll-1-JPHEXT))
-IJINF_MASK = MAX(IJB, NLESn_JINF(IMI)+JPHEXT-(IJB_ll-1-JPHEXT))
-IISUP_MASK = MIN(IIE, NLESn_ISUP(IMI)+JPHEXT-(IIB_ll-1-JPHEXT))
-IJSUP_MASK = MIN(IJE, NLESn_JSUP(IMI)+JPHEXT-(IJB_ll-1-JPHEXT))
-!
-!
-LLES_CURRENT_CART_MASK(:,:,:) = .FALSE.
-LLES_CURRENT_CART_MASK(IIINF_MASK:IISUP_MASK,IJINF_MASK:IJSUP_MASK,:) = .TRUE.
-!
-CLES_CURRENT_LBCX(:) = CLES_LBCX(:,IMI)
-CLES_CURRENT_LBCY(:) = CLES_LBCY(:,IMI)
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. Definition of LES vertical grid for this model
-! ----------------------------------------------
-!
-IF (CLES_LEVEL_TYPE=='Z') THEN
- IF (ASSOCIATED(XCOEFLIN_CURRENT_LES)) CALL LES_DEALLOCATE('XCOEFLIN_CURRENT_LES')
- IF (ASSOCIATED(NKLIN_CURRENT_LES )) CALL LES_DEALLOCATE('NKLIN_CURRENT_LES')
- !
- CALL LES_ALLOCATE('XCOEFLIN_CURRENT_LES',(/IIU,IJU,NLES_K/))
- CALL LES_ALLOCATE('NKLIN_CURRENT_LES',(/IIU,IJU,NLES_K/))
- !
- XCOEFLIN_CURRENT_LES(:,:,:) = XCOEFLIN_LES(:,:,:)
- NKLIN_CURRENT_LES (:,:,:) = NKLIN_LES (:,:,:)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. Definition of variables used in budgets for current model
-! ---------------------------------------------------------
-!
-IF (LUSERC) THEN
- ALLOCATE(XCURRENT_L_O_EXN_CP (IIU,IJU,IKU))
-ELSE
- ALLOCATE(XCURRENT_L_O_EXN_CP (0,0,0))
-END IF
-ALLOCATE(XCURRENT_RHODJ (IIU,IJU,IKU))
-!
-!* coefficients for Th to Thl conversion
-!
-IF (LUSERC) THEN
- ALLOCATE(ZL (IIU,IJU,IKU))
- ALLOCATE(ZEXN(IIU,IJU,IKU))
- ALLOCATE(ZCP (IIU,IJU,IKU))
- !
- !* Exner function
- !
- ZEXN(:,:,:) = (XPABST/XP00)**(XRD/XCPD)
- !
- !* Latent heat of vaporization
- !
- ZL(:,:,:) = XLVTT + (XCPD-XCL) * (XTHT(:,:,:)*ZEXN(:,:,:)-XTT)
- !
- !* heat capacity at constant pressure of the humid air
- !
- ZCP(:,:,:) = XCPD
- IRR=2
- ZCP(:,:,:) = ZCP(:,:,:) + XCPV * XRT(:,:,:,1)
- ZCP(:,:,:) = ZCP(:,:,:) + XCL * XRT(:,:,:,2)
- IF (LUSERR) THEN
- IRR=IRR+1
- ZCP(:,:,:) = ZCP(:,:,:) + XCL * XRT(:,:,:,IRR)
- END IF
- IF (LUSERI) THEN
- IRR=IRR+1
- ZCP(:,:,:) = ZCP(:,:,:) + XCI * XRT(:,:,:,IRR)
- END IF
- IF (LUSERS) THEN
- IRR=IRR+1
- ZCP(:,:,:) = ZCP(:,:,:) + XCI * XRT(:,:,:,IRR)
- END IF
- IF (LUSERG) THEN
- IRR=IRR+1
- ZCP(:,:,:) = ZCP(:,:,:) + XCI * XRT(:,:,:,IRR)
- END IF
- IF (LUSERH) THEN
- IRR=IRR+1
- ZCP(:,:,:) = ZCP(:,:,:) + XCI * XRT(:,:,:,IRR)
- END IF
- !
- !* L / (Exn * Cp)
- !
- XCURRENT_L_O_EXN_CP(:,:,:) = ZL(:,:,:) / ZEXN(:,:,:) / ZCP(:,:,:)
- !
- DEALLOCATE(ZL )
- DEALLOCATE(ZEXN)
- DEALLOCATE(ZCP )
-END IF
-!
-!* other initializations
-!
-XCURRENT_RHODJ=XRHODJ
-!
-LCURRENT_USERV=LUSERV
-LCURRENT_USERC=LUSERC
-LCURRENT_USERR=LUSERR
-LCURRENT_USERI=LUSERI
-LCURRENT_USERS=LUSERS
-LCURRENT_USERG=LUSERG
-LCURRENT_USERH=LUSERH
-!
-NCURRENT_RR = NRR
-!
-ALLOCATE(XCURRENT_RUS (IIU,IJU,IKU))
-ALLOCATE(XCURRENT_RVS (IIU,IJU,IKU))
-ALLOCATE(XCURRENT_RWS (IIU,IJU,IKU))
-ALLOCATE(XCURRENT_RTHS (IIU,IJU,IKU))
-ALLOCATE(XCURRENT_RTKES(IIU,IJU,IKU))
-ALLOCATE(XCURRENT_RRS (IIU,IJU,IKU,NRR))
-ALLOCATE(XCURRENT_RSVS (IIU,IJU,IKU,NSV))
-ALLOCATE(XCURRENT_RTHLS(IIU,IJU,IKU))
-ALLOCATE(XCURRENT_RRTS (IIU,IJU,IKU))
-!
-XCURRENT_RUS =XRUS
-XCURRENT_RVS =XRVS
-XCURRENT_RWS =XRWS
-XCURRENT_RTHS =XRTHS
-XCURRENT_RTKES=XRTKES
-XCURRENT_RRS =XRRS
-XCURRENT_RSVS =XRSVS
-CALL THL_RT_FROM_TH_R(LUSERV, LUSERC, LUSERR, &
- LUSERI, LUSERS, LUSERG, LUSERH, &
- XCURRENT_L_O_EXN_CP, &
- XCURRENT_RTHS, XCURRENT_RRS, &
- XCURRENT_RTHLS, XCURRENT_RRTS )
-
-ALLOCATE(X_LES_BU_RES_KE (NLES_K,NLES_TOT))
-ALLOCATE(X_LES_BU_RES_WThl (NLES_K,NLES_TOT))
-ALLOCATE(X_LES_BU_RES_Thl2 (NLES_K,NLES_TOT))
-ALLOCATE(X_LES_BU_SBG_Tke (NLES_K,NLES_TOT))
-ALLOCATE(X_LES_BU_RES_WRt (NLES_K,NLES_TOT))
-ALLOCATE(X_LES_BU_RES_Rt2 (NLES_K,NLES_TOT))
-ALLOCATE(X_LES_BU_RES_ThlRt(NLES_K,NLES_TOT))
-ALLOCATE(X_LES_BU_RES_Sv2 (NLES_K,NLES_TOT,NSV))
-ALLOCATE(X_LES_BU_RES_WSv (NLES_K,NLES_TOT,NSV))
-
-X_LES_BU_RES_KE = 0.
-X_LES_BU_RES_WThl = 0.
-X_LES_BU_RES_Thl2 = 0.
-X_LES_BU_SBG_Tke = 0.
-X_LES_BU_RES_WRt = 0.
-X_LES_BU_RES_Rt2 = 0.
-X_LES_BU_RES_ThlRt= 0.
-X_LES_BU_RES_Sv2 = 0.
-X_LES_BU_RES_WSv = 0.
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. Definition of anomaly fields
-! ----------------------------
-!
-ALLOCATE (XU_ANOM (IIU,IJU,NLES_K))
-ALLOCATE (XV_ANOM (IIU,IJU,NLES_K))
-ALLOCATE (XW_ANOM (IIU,IJU,NLES_K))
-ALLOCATE (XTHL_ANOM(IIU,IJU,NLES_K))
-IF (LUSERV) THEN
- ALLOCATE (XRT_ANOM (IIU,IJU,NLES_K))
-ELSE
- ALLOCATE (XRT_ANOM (0,0,0))
-END IF
-ALLOCATE (XSV_ANOM (IIU,IJU,NLES_K,NSV))
-!
-!* 4.1 conservative variables
-! ----------------------
-!
-ALLOCATE(ZTHL(IIU,IJU,IKU))
-ALLOCATE(ZRT (IIU,IJU,IKU))
-CALL THL_RT_FROM_TH_R(LUSERV, LUSERC, LUSERR, &
- LUSERI, LUSERS, LUSERG, LUSERH, &
- XCURRENT_L_O_EXN_CP, &
- XTHT, XRT, &
- ZTHL, ZRT )
-!
-!* 4.2 anomaly fields on the LES grid
-! ------------------------------
-!
-CALL LES_ANOMALY_FIELD(MXF(XUT),XU_ANOM)
-CALL LES_ANOMALY_FIELD(MYF(XVT),XV_ANOM)
-CALL LES_ANOMALY_FIELD(MZF(XWT),XW_ANOM)
-CALL LES_ANOMALY_FIELD(ZTHL,XTHL_ANOM)
-IF (LUSERV) CALL LES_ANOMALY_FIELD(ZRT,XRT_ANOM)
-DO JSV=1,NSV
- CALL LES_ANOMALY_FIELD(XSVT(:,:,:,JSV),XSV_ANOM(:,:,:,JSV))
-END DO
-!
-!-------------------------------------------------------------------------------
-!
-DEALLOCATE(ZTHL)
-DEALLOCATE(ZRT )
-!-------------------------------------------------------------------------------
-!
-!* 6.0 Nebulosity masks
-! ----------------
-!
-CALL LES_CLOUD_MASKS_n
-!
-!-------------------------------------------------------------------------------
-CALL SECOND_MNH(ZTIME2)
-XTIME_LES_BU = XTIME_LES_BU + ZTIME2 - ZTIME1
-!--------------------------------------------------------------------------------
-!
-CONTAINS
-!
-!--------------------------------------------------------------------------------
-!
-SUBROUTINE LES_ANOMALY_FIELD(PF,PF_ANOM)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PF
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PF_ANOM
-
-REAL, DIMENSION(SIZE(PF_ANOM,3)) :: ZMEAN
-INTEGER :: JI, JJ
-
-CALL LES_VER_INT(PF, PF_ANOM)
-CALL LES_MEAN_ll(PF_ANOM, LLES_CURRENT_CART_MASK, ZMEAN )
-DO JJ=1,SIZE(PF_ANOM,2)
- DO JI=1,SIZE(PF_ANOM,1)
- PF_ANOM(JI,JJ,:) = PF_ANOM(JI,JJ,:) - ZMEAN(:)
- END DO
-END DO
-
-END SUBROUTINE LES_ANOMALY_FIELD
-!--------------------------------------------------------------------------------
-!
-END SUBROUTINE LES_INI_TIMESTEP_n
-
diff --git a/src/mesonh/ext/lesn.f90 b/src/mesonh/ext/lesn.f90
deleted file mode 100644
index 6376d8360e303dc35c72a93820cace8d7ce6ed44..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/lesn.f90
+++ /dev/null
@@ -1,3580 +0,0 @@
-!MNH_LIC Copyright 2000-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.
-!-----------------------------------------------------------------
-! #################
- SUBROUTINE LES_n
-! #################
-!
-!
-!!**** *LES_n* computes the current time-step LES diagnostics for model _n
-!!
-!!
-!! PURPOSE
-!! -------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 07/02/00
-!! 01/02/01 (D. Gazen) add module MODD_NSV for NSV variable
-!! 06/11/02 (V. Masson) add LES budgets and use of anomalies
-!! in LES quantities computations
-!! 01/04/03 (V. Masson and F. Couvreux) bug in BL height loop
-!! 10/07 (J.Pergaud) Add mass flux diagnostics
-!! 06/08 (O.Thouron) Add radiative diagnostics
-!! 12/10 (R.Honnert) Add EDKF mass flux in BL height
-!! 10/09 (P. Aumond) Add possibility of user maskS
-!! 10/14 (C.Lac) Correction on user masks
-!! 10/16 (C.Lac) Add ground droplet deposition amount
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! 02/2019 (C. Lac) Add rain fraction as a LES diagnostic
-!!
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-USE MODD_CTURB, ONLY : XFTOP_O_FSURF
-!
-USE MODD_LES
-USE MODD_LES_BUDGET
-USE MODD_CONF
-USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
-USE MODD_LES_n
-USE MODD_RADIATIONS_n
-USE MODD_GRID_n
-USE MODD_REF_n
-USE MODD_FIELD_n
-USE MODD_CONF_n
-USE MODD_PARAM_n
-USE MODD_TURB_n
-USE MODD_METRICS_n
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_PARAM_n, ONLY: CCLOUD
-USE MODD_PRECIP_n, ONLY: XINPRR,XACPRR,XINPRR3D,XEVAP3D,XINPRC,XINDEP
-USE MODD_NSV, ONLY : NSV, NSV_CS
-USE MODD_PARAM_ICE_n, ONLY: LDEPOSC,LSEDIC
-USE MODD_PARAM_C2R2, ONLY: LDEPOC,LSEDC
-USE MODD_PARAM_LIMA, ONLY : MSEDC=>LSEDC
-!
-USE MODI_SHUMAN
-USE MODI_GRADIENT_M
-USE MODI_GRADIENT_U
-USE MODI_GRADIENT_V
-USE MODI_GRADIENT_W
-USE MODI_LES_VER_INT
-USE MODI_SPEC_VER_INT
-USE MODI_LES_MEAN_ll
-USE MODI_THL_RT_FROM_TH_R
-USE MODI_LES_RES_TR
-USE MODI_BUDGET_FLAGS
-USE MODI_LES_BUDGET_TEND_n
-USE MODE_BL_DEPTH_DIAG
-!
-USE MODE_ll
-USE MODE_MODELN_HANDLER
-USE MODE_FILL_DIMPHYEX, ONLY: FILL_DIMPHYEX
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-!
-! 0.2 declaration of local variables
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEXN ! Exner function
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHL ! liquid potential temperature
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHV ! virtual potential temperature
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHO ! air density
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: CHAMPXY1 !tableau intermediaire
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTEMP ! Temperature
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEW
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZINDCLD !indice cloud si rc>0
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZINDCLD2 !indice cloud rc>1E-5
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCLDFR_LES! CLDFR on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZICEFR_LES! ICEFR on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRAINFR_LES! RAINFR on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZMASSF ! massflux=rho*w
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZREHU ! relative humidity
-
-
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZZ_LES ! alt. on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE ::ZZZ_LES
-REAL, DIMENSION(:,:,:), ALLOCATABLE ::ZINPRR3D_LES ! precipitation flux 3D
-REAL, DIMENSION(:,:,:), ALLOCATABLE ::ZEVAP3D_LES !evaporation 3D
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZP_LES ! pres. on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDP_LES ! dynamical production TKE
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTP_LES ! thermal production TKE
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTR_LES ! transport production TKE
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDISS_LES ! dissipation TKE
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLM_LES ! mixing length
-
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDPDZ_LES ! dp/dz on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDTHLDZ_LES ! dThl/dz on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDTHDZ_LES ! dTh/dz on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDRTDZ_LES ! dRt/dz on LES vertical grid
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZDSvDZ_LES ! dSv/dz on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDUDZ_LES ! du/dz on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDVDZ_LES ! dv/dz on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDWDZ_LES ! dw/dz on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEXN_LES ! Exner on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHO_LES ! rho on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZU_LES ! U on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZV_LES ! V on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZW_LES ! W on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZMF_LES ! mass flux on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTH_LES ! Theta on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHV_LES ! thv on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHL_LES ! thl on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTKE_LES ! tke on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZKE_LES ! ke on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRV_LES ! Rv on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZREHU_LES ! Rehu on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRC_LES ! Rc on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRR_LES ! Rr on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRI_LES ! Ri on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRS_LES ! Rs on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRG_LES ! Rg on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRH_LES ! Rh on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRT_LES ! Rt on LES vertical grid
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSV_LES ! Sv on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTH_ANOM ! Theta anomaly on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHV_ANOM ! thv anomaly on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRV_ANOM ! Rv anomaly on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRC_ANOM ! Rc anomaly on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRI_ANOM ! Ri anomaly on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRR_ANOM ! Rr anomaly on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZP_ANOM ! p anomaly on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHO_ANOM ! rho anomaly on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDPDZ_ANOM! dp/dz anomaly on LES vertical grid
-REAL, DIMENSION(:), ALLOCATABLE :: ZMEAN_DPDZ! dp/dz mean on LES vertical grid
-REAL, DIMENSION(:), ALLOCATABLE :: ZLES_MEAN_DRtDZ! drt/dz mean on LES vertical grid
-REAL, DIMENSION(:), ALLOCATABLE :: ZLES_MEAN_DTHDZ! dth/dz mean on LES vertical grid
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZLES_MEAN_DSVDZ! drt/dz mean on LES vertical grid
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZLWP_LES, ZRWP_LES, ZTKET_LES
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZIWP_LES, ZSWP_LES, ZGWP_LES, ZHWP_LES
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZINDCLD2D !
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZINDCLD2D2 !
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZLWP_ANOM ! lwp anomaly
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZMAXWRR2D ! maxwrr2D
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZU_SPEC ! U on SPEC vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZV_SPEC ! V on SPEC vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZW_SPEC ! W on SPEC vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTH_SPEC ! Theta on SPEC vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHL_SPEC ! thl on SPEC vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRV_SPEC ! Rv on SPEC vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRC_SPEC ! Rc on SPEC vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRI_SPEC ! Ri on SPEC vertical grid
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSV_SPEC ! Sv on SPEC vertical grid
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRT ! rv+rc+rr+ri+rs+rg+rh
-REAL, DIMENSION(:), ALLOCATABLE :: ZWORK1D,ZWORK1DT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK2D
-REAL :: ZINPRRm,ZCOUNT
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRADEFF_LES ! Re on LES vertical grid
-!!fl sw, lw, dthrad on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSWU_LES ! SWU on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSWD_LES ! SWD on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLWU_LES ! LWU on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLWD_LES ! LWD on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDTHRADSW_LES ! DTHRADSW on LES vertical grid
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDTHRADLW_LES ! DTHRADLW on LES vertical grid
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZWORK !
-!
-INTEGER :: IRR ! moist variables counter
-INTEGER :: JSV ! scalar variables counter
-INTEGER :: IIU, IJU ! array sizes
-INTEGER :: IKE,IKB
-INTEGER :: JI, JJ, JK ! loop counters
-INTEGER :: IIU_ll, IJU_ll ! total domain I size (fin)
-INTEGER :: IIA_ll, IJA_ll ! total domain I size (debut)
-INTEGER :: IINFO_ll ! return code of parallel routine
-INTEGER :: IIMAX_ll, IJMAX_ll ! total physical domain I size
-INTEGER :: JLOOP
-!
-INTEGER :: IMASK ! mask counter
-INTEGER :: IMASKUSER! mask user number
-!
-INTEGER :: IRESP, ILUOUT
-INTEGER :: IMI ! Current model index
-TYPE(DIMPHYEX_t) :: YLDIMPHYEX
-!-------------------------------------------------------------------------------
-!
-IMI = GET_CURRENT_MODEL_INDEX()
-!
-IF (.NOT. LLES_CALL) RETURN
-!
-CALL GET_GLOBALDIMS_ll(IIMAX_ll,IJMAX_ll)
-IIU_ll = IIMAX_ll+JPHEXT
-IJU_ll = IJMAX_ll+JPHEXT
-IIA_ll=JPHEXT+1
-IJA_ll=JPHEXT+1
-IKE=SIZE(XVT,3)-JPVEXT
-IKB=1+JPVEXT
-CALL GET_DIM_EXT_ll('B',IIU,IJU)
-CALL FILL_DIMPHYEX(YLDIMPHYEX, SIZE(XTHT,1), SIZE(XTHT,2), SIZE(XTHT,3),.TRUE.)
-!
-ILUOUT = TLUOUT%NLU
-!
-!-------------------------------------------------------------------------------
-!
-!* interpolation coefficients for Z type grid
-!
-IF (CSPECTRA_LEVEL_TYPE=='Z') THEN
- IF (ASSOCIATED(XCOEFLIN_CURRENT_SPEC)) CALL LES_DEALLOCATE('XCOEFLIN_CURRENT_SPEC')
- IF (ASSOCIATED(NKLIN_CURRENT_SPEC )) CALL LES_DEALLOCATE('NKLIN_CURRENT_SPEC')
- !
- CALL LES_ALLOCATE('XCOEFLIN_CURRENT_SPEC',(/IIU,IJU,NSPECTRA_K/))
- CALL LES_ALLOCATE('NKLIN_CURRENT_SPEC',(/IIU,IJU,NSPECTRA_K/))
- !
- XCOEFLIN_CURRENT_SPEC(:,:,:) = XCOEFLIN_SPEC(:,:,:)
- NKLIN_CURRENT_SPEC (:,:,:) = NKLIN_SPEC (:,:,:)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. Allocations
-! -----------
-!
-ALLOCATE(ZP_LES (IIU,IJU,NLES_K))
-ALLOCATE(ZDP_LES (IIU,IJU,NLES_K))
-ALLOCATE(ZTP_LES (IIU,IJU,NLES_K))
-ALLOCATE(ZTR_LES (IIU,IJU,NLES_K))
-ALLOCATE(ZDISS_LES (IIU,IJU,NLES_K))
-ALLOCATE(ZLM_LES (IIU,IJU,NLES_K))
-ALLOCATE(ZDTHLDZ_LES(IIU,IJU,NLES_K))
-ALLOCATE(ZDTHDZ_LES(IIU,IJU,NLES_K))
-ALLOCATE(ZDRTDZ_LES(IIU,IJU,NLES_K))
-ALLOCATE(ZDUDZ_LES(IIU,IJU,NLES_K))
-ALLOCATE(ZDVDZ_LES(IIU,IJU,NLES_K))
-ALLOCATE(ZDWDZ_LES(IIU,IJU,NLES_K))
-ALLOCATE(ZDSVDZ_LES(IIU,IJU,NLES_K,NSV))
-
-ALLOCATE(ZDPDZ_LES(IIU,IJU,NLES_K))
-ALLOCATE(ZEXN_LES (IIU,IJU,NLES_K))
-ALLOCATE(ZRHO_LES (IIU,IJU,NLES_K))
-ALLOCATE(ZU_LES (IIU,IJU,NLES_K))
-ALLOCATE(ZV_LES (IIU,IJU,NLES_K))
-ALLOCATE(ZW_LES (IIU,IJU,NLES_K))
-ALLOCATE(ZMF_LES (IIU,IJU,NLES_K))
-ALLOCATE(ZTH_LES (IIU,IJU,NLES_K))
-IF (CRAD /= 'NONE') THEN
- ALLOCATE(ZRADEFF_LES (IIU,IJU,NLES_K))
- ALLOCATE(ZSWU_LES (IIU,IJU,NLES_K))
- ALLOCATE(ZSWD_LES (IIU,IJU,NLES_K))
- ALLOCATE(ZLWU_LES (IIU,IJU,NLES_K))
- ALLOCATE(ZLWD_LES (IIU,IJU,NLES_K))
- ALLOCATE(ZDTHRADSW_LES (IIU,IJU,NLES_K))
- ALLOCATE(ZDTHRADLW_LES (IIU,IJU,NLES_K))
-ELSE
- ALLOCATE(ZRADEFF_LES (0,0,0))
- ALLOCATE(ZSWU_LES (0,0,0))
- ALLOCATE(ZSWD_LES (0,0,0))
- ALLOCATE(ZLWU_LES (0,0,0))
- ALLOCATE(ZLWD_LES (0,0,0))
- ALLOCATE(ZDTHRADSW_LES (0,0,0))
- ALLOCATE(ZDTHRADLW_LES (0,0,0))
-END IF
-IF (LUSERV) THEN
- ALLOCATE(ZTHV_LES (IIU,IJU,NLES_K))
-ELSE
- ALLOCATE(ZTHV_LES (0,0,0))
-END IF
-ALLOCATE(ZTHL_LES (IIU,IJU,NLES_K))
-ALLOCATE(ZTKE_LES (IIU,IJU,NLES_K))
-ALLOCATE(ZKE_LES(IIU,IJU,NLES_K))
-ALLOCATE(ZTKET_LES(IIU,IJU))
-ALLOCATE(ZWORK1D (NLES_K))
-ALLOCATE(ZWORK1DT (NLES_K))
-ALLOCATE(ZZZ_LES(IIU,IJU,NLES_K))
-IF (LUSERV) THEN
- ALLOCATE(ZRV_LES (IIU,IJU,NLES_K))
- ALLOCATE(ZRT_LES (IIU,IJU,NLES_K))
- ALLOCATE(ZREHU_LES (IIU,IJU,NLES_K))
-ELSE
- ALLOCATE(ZRV_LES (0,0,0))
- ALLOCATE(ZRT_LES (0,0,0))
- ALLOCATE(ZREHU_LES (0,0,0))
-END IF
-IF (LUSERC) THEN
- ALLOCATE(ZRC_LES (IIU,IJU,NLES_K))
- ALLOCATE(ZLWP_LES(IIU,IJU))
- ALLOCATE(ZINDCLD2D(IIU,IJU))
- ALLOCATE(ZINDCLD2D2(IIU,IJU))
- ALLOCATE(ZCLDFR_LES(IIU,IJU,NLES_K))
- ALLOCATE(ZWORK2D(IIU,IJU))
- ALLOCATE(ZLWP_ANOM(IIU,IJU))
-ELSE
- ALLOCATE(ZRC_LES (0,0,0))
- ALLOCATE(ZLWP_LES(0,0))
- ALLOCATE(ZINDCLD2D(0,0))
- ALLOCATE(ZINDCLD2D2(0,0))
- ALLOCATE(ZCLDFR_LES(0,0,0))
- ALLOCATE(ZWORK2D(0,0))
- ALLOCATE(ZLWP_ANOM(0,0))
-END IF
-IF (LUSERR) THEN
- ALLOCATE(ZRR_LES (IIU,IJU,NLES_K))
- ALLOCATE(ZMAXWRR2D(IIU,IJU))
- ALLOCATE(ZRWP_LES(IIU,IJU))
- ALLOCATE(ZINPRR3D_LES (IIU,IJU,NLES_K))
- ALLOCATE(ZEVAP3D_LES (IIU,IJU,NLES_K))
- ALLOCATE(ZRAINFR_LES(IIU,IJU,NLES_K))
-ELSE
- ALLOCATE(ZRR_LES (0,0,0))
- ALLOCATE(ZMAXWRR2D(0,0))
- ALLOCATE(ZRWP_LES(0,0))
- ALLOCATE(ZINPRR3D_LES(0,0,0))
- ALLOCATE(ZEVAP3D_LES(0,0,0))
- ALLOCATE(ZRAINFR_LES(0,0,0))
-END IF
-IF (LUSERI) THEN
- ALLOCATE(ZRI_LES (IIU,IJU,NLES_K))
- ALLOCATE(ZIWP_LES(IIU,IJU))
- ALLOCATE(ZICEFR_LES(IIU,IJU,NLES_K))
-ELSE
- ALLOCATE(ZRI_LES (0,0,0))
- ALLOCATE(ZIWP_LES(0,0))
- ALLOCATE(ZICEFR_LES(0,0,0))
-END IF
-IF (LUSERS) THEN
- ALLOCATE(ZRS_LES (IIU,IJU,NLES_K))
- ALLOCATE(ZSWP_LES(IIU,IJU))
-ELSE
- ALLOCATE(ZRS_LES (0,0,0))
- ALLOCATE(ZSWP_LES(0,0))
-END IF
-IF (LUSERG) THEN
- ALLOCATE(ZRG_LES (IIU,IJU,NLES_K))
- ALLOCATE(ZGWP_LES(IIU,IJU))
-ELSE
- ALLOCATE(ZRG_LES (0,0,0))
- ALLOCATE(ZGWP_LES(0,0))
-END IF
-IF (LUSERH) THEN
- ALLOCATE(ZRH_LES (IIU,IJU,NLES_K))
- ALLOCATE(ZHWP_LES(IIU,IJU))
-ELSE
- ALLOCATE(ZRH_LES (0,0,0))
- ALLOCATE(ZHWP_LES(0,0))
-END IF
-IF (NSV>0) THEN
- ALLOCATE(ZSV_LES (IIU,IJU,NLES_K,NSV))
-ELSE
- ALLOCATE(ZSV_LES (0,0,0,0))
-END IF
-!
-ALLOCATE(ZP_ANOM (IIU,IJU,NLES_K))
-ALLOCATE(ZRHO_ANOM (IIU,IJU,NLES_K))
-ALLOCATE(ZTH_ANOM (IIU,IJU,NLES_K))
-ALLOCATE(ZDPDZ_ANOM(IIU,IJU,NLES_K))
-IF (LUSERV) THEN
- ALLOCATE(ZTHV_ANOM(IIU,IJU,NLES_K))
- ALLOCATE(ZRV_ANOM (IIU,IJU,NLES_K))
-ELSE
- ALLOCATE(ZTHV_ANOM(0,0,0))
- ALLOCATE(ZRV_ANOM (0,0,0))
-END IF
-IF (LUSERC) THEN
- ALLOCATE(ZRC_ANOM (IIU,IJU,NLES_K))
-ELSE
- ALLOCATE(ZRC_ANOM (0,0,0))
-END IF
-IF (LUSERI) THEN
- ALLOCATE(ZRI_ANOM (IIU,IJU,NLES_K))
-ELSE
- ALLOCATE(ZRI_ANOM (0,0,0))
-END IF
-IF (LUSERR) THEN
- ALLOCATE(ZRR_ANOM (IIU,IJU,NLES_K))
-ELSE
- ALLOCATE(ZRR_ANOM (0,0,0))
-END IF
-ALLOCATE(ZMEAN_DPDZ(NLES_K))
-ALLOCATE(ZLES_MEAN_DTHDZ(NLES_K))
-!
-!
-ALLOCATE(ZU_SPEC (NSPECTRA_NI,NSPECTRA_NJ,NSPECTRA_K))
-ALLOCATE(ZV_SPEC (NSPECTRA_NI,NSPECTRA_NJ,NSPECTRA_K))
-ALLOCATE(ZW_SPEC (NSPECTRA_NI,NSPECTRA_NJ,NSPECTRA_K))
-ALLOCATE(ZTH_SPEC (NSPECTRA_NI,NSPECTRA_NJ,NSPECTRA_K))
-IF (LUSERC) THEN
- ALLOCATE(ZTHL_SPEC(NSPECTRA_NI,NSPECTRA_NJ,NSPECTRA_K))
-ELSE
- ALLOCATE(ZTHL_SPEC(0,0,0))
-END IF
-IF (LUSERV) THEN
- ALLOCATE(ZRV_SPEC (NSPECTRA_NI,NSPECTRA_NJ,NSPECTRA_K))
-ELSE
- ALLOCATE(ZRV_SPEC (0,0,0))
-END IF
-IF (LUSERC) THEN
- ALLOCATE(ZRC_SPEC (NSPECTRA_NI,NSPECTRA_NJ,NSPECTRA_K))
-ELSE
- ALLOCATE(ZRC_SPEC (0,0,0))
-END IF
-IF (LUSERI) THEN
- ALLOCATE(ZRI_SPEC (NSPECTRA_NI,NSPECTRA_NJ,NSPECTRA_K))
-ELSE
- ALLOCATE(ZRI_SPEC (0,0,0))
-END IF
-IF (NSV>0) THEN
- ALLOCATE(ZSV_SPEC (NSPECTRA_NI,NSPECTRA_NJ,NSPECTRA_K,NSV))
-ELSE
- ALLOCATE(ZSV_SPEC (0,0,0,0))
-END IF
-!
-!
-ALLOCATE(ZEXN (IIU,IJU,SIZE(XTHT,3)))
-ALLOCATE(ZRHO (IIU,IJU,SIZE(XTHT,3)))
-ALLOCATE(ZRT (IIU,IJU,SIZE(XTHT,3)))
-ALLOCATE(ZTHV (IIU,IJU,SIZE(XTHT,3)))
-ALLOCATE(ZTHL (IIU,IJU,SIZE(XTHT,3)))
-ALLOCATE(ZEW (IIU,IJU,SIZE(XTHT,3)))
-ALLOCATE(ZMASSF (IIU,IJU,SIZE(XTHT,3)))
-ALLOCATE(ZTEMP (IIU,IJU,SIZE(XTHT,3)))
-ALLOCATE(ZREHU (IIU,IJU,SIZE(XTHT,3)))
-ALLOCATE(CHAMPXY1 (IIU,IJU,1))
-!
-!-------------------------------------------------------------------------------
-!
-!* 1.2 preliminary calculations
-! ------------------------
-!
-ZEXN(:,:,:) = (XPABST/XP00)**(XRD/XCPD)
-!
-!
-!* computation of relative humidity
-ZTEMP=XTHT*ZEXN
-ZEW=EXP (XALPW -XBETAW/ZTEMP-XGAMW*ALOG(ZTEMP))
-IF (LUSERV) THEN
- ZREHU(:,:,:)=100.*XRT(:,:,:,1)*XPABST(:,:,:)/((XRD/XRV+XRT(:,:,:,1))*ZEW(:,:,:))
-ELSE
- ZREHU(:,:,:)=0.
-END IF
-!
-CALL THL_RT_FROM_TH_R(LUSERV, LUSERC, LUSERR, &
- LUSERI, LUSERS, LUSERG, LUSERH, &
- XCURRENT_L_O_EXN_CP, &
- XTHT, XRT, &
- ZTHL, ZRT )
-!
-!* computation of density and virtual potential temperature
-!
-ZTHV=XTHT
-IF (LUSERV) ZTHV=ZTHV*(1.+XRV/XRD*XRT(:,:,:,1))/(1.+ZRT(:,:,:))
-!
-IF (CEQNSYS=='DUR') THEN
- ZRHO=XPABST/(XRD*ZTHV*ZEXN)
-ELSE
- ZRHO=XRHODREF*( 1. + (XCPD-XRD)/XRD*(ZEXN/XEXNREF - 1.) - (ZTHV/XTHVREF - 1.) )
-END IF
-!
-! computation of mass flux
-ZMASSF=MZM(ZRHO)*XWT
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. Vertical interpolations to LES vertical grid
-! --------------------------------------------
-!
-!* note that velocity fields are first localized on the MASS points
-!
-!
-IF (CRAD /= 'NONE') THEN
- CALL LES_VER_INT( XRADEFF, ZRADEFF_LES)
- CALL LES_VER_INT( XSWU, ZSWU_LES)
- CALL LES_VER_INT( XSWD, ZSWD_LES)
- CALL LES_VER_INT( XLWU, ZLWU_LES)
- CALL LES_VER_INT( XLWD, ZLWD_LES)
- CALL LES_VER_INT( XDTHRADSW, ZDTHRADSW_LES)
- CALL LES_VER_INT( XDTHRADLW, ZDTHRADLW_LES)
-END IF
-!
-CALL LES_VER_INT( XZZ , ZZZ_LES)
-CALL LES_VER_INT( XPABST, ZP_LES )
-CALL LES_VER_INT( XDYP, ZDP_LES )
-CALL LES_VER_INT( XTHP, ZTP_LES )
-CALL LES_VER_INT( XTR, ZTR_LES )
-CALL LES_VER_INT( XDISS, ZDISS_LES )
-CALL LES_VER_INT( XLEM, ZLM_LES )
-CALL LES_VER_INT( GZ_M_M(XPABST,XDZZ), ZDPDZ_LES )
-!
-CALL LES_VER_INT( MXF(XUT) ,ZU_LES )
-CALL LES_VER_INT( MYF(XVT) ,ZV_LES )
-CALL LES_VER_INT( MZF(XWT) ,ZW_LES )
-CALL LES_VER_INT( MZF(ZMASSF) ,ZMF_LES)
-CALL LES_VER_INT( XTHT ,ZTH_LES )
-CALL LES_VER_INT( MXF(MZF(GZ_U_UW(XUT,XDZZ))), ZDUDZ_LES )
-CALL LES_VER_INT( MYF(MZF(GZ_V_VW(XVT,XDZZ))), ZDVDZ_LES )
-CALL LES_VER_INT( GZ_W_M(XWT,XDZZ), ZDWDZ_LES )
-CALL LES_VER_INT( ZEXN, ZEXN_LES)
-!
-CALL LES_VER_INT( GZ_M_M(XTHT,XDZZ), ZDTHDZ_LES )
-!
-CALL LES_VER_INT(ZRHO, ZRHO_LES)
-!
-IF (LUSERV) CALL LES_VER_INT(ZTHV, ZTHV_LES)
-CALL LES_VER_INT(ZTHL, ZTHL_LES)
-CALL LES_VER_INT( GZ_M_M(ZTHL,XDZZ), ZDTHLDZ_LES )
-!
-CALL LES_VER_INT( XTKET ,ZTKE_LES)
-IRR = 0
-IF (LUSERV) THEN
- IRR = IRR + 1
- CALL LES_VER_INT( XRT(:,:,:,IRR) ,ZRV_LES )
- CALL LES_VER_INT( ZRT(:,:,:) ,ZRT_LES )
- CALL LES_VER_INT( GZ_M_M(ZRT,XDZZ), ZDRTDZ_LES )
- CALL LES_VER_INT( ZREHU(:,:,:) ,ZREHU_LES)
-END IF
-IF (LUSERC) THEN
- IRR = IRR + 1
- CALL LES_VER_INT( XRT(:,:,:,IRR) ,ZRC_LES )
- ALLOCATE(ZINDCLD (IIU,IJU,NLES_K))
- ALLOCATE(ZINDCLD2(IIU,IJU,NLES_K))
- ZINDCLD = CEILING(ZRC_LES-1.E-6)
- ZINDCLD2 = CEILING(ZRC_LES-1.E-5)
- CALL LES_VER_INT( XCLDFR(:,:,:) ,ZCLDFR_LES )
-ELSE
- ALLOCATE(ZINDCLD (0,0,0))
- ALLOCATE(ZINDCLD2(0,0,0))
-END IF
-IF (LUSERR) THEN
- IRR = IRR + 1
- CALL LES_VER_INT( XRT(:,:,:,IRR) ,ZRR_LES )
- CALL LES_VER_INT( XINPRR3D(:,:,:), ZINPRR3D_LES)
- CALL LES_VER_INT( XEVAP3D(:,:,:), ZEVAP3D_LES)
- CALL LES_VER_INT( XRAINFR(:,:,:) ,ZRAINFR_LES )
-END IF
-IF (LUSERC) THEN
- DO JJ=1,IJU
- DO JI=1,IIU
- ZINDCLD2D(JI,JJ) = maxval(ZINDCLD(JI,JJ,:))
- ZINDCLD2D2(JI,JJ)= maxval(ZINDCLD2(JI,JJ,:))
- END DO
- END DO
- !* integration of rho rc
- !!!ZLWP_LES only for cloud water
- ZLWP_LES(:,:) = 0.
- DO JK=1,NLES_K-1
- ZLWP_LES(:,:) = ZLWP_LES(:,:) + (ZZZ_LES(:,:,JK+1)-ZZZ_LES(:,:,JK)) &
- * (ZRC_LES(:,:,JK)) * ZRHO_LES(:,:,JK)
- END DO
- CALL LES_MEAN_ll ( ZLWP_LES, LLES_CURRENT_CART_MASK(:,:,1), &
- XLES_LWP(NLES_CURRENT_TCOUNT) )
-!
-END IF
-
- !!!ZRWP_LES only for rain water
-IF (LUSERR) THEN
- ZRWP_LES(:,:)=0.
- DO JK=1,NLES_K-1
- ZRWP_LES(:,:) = ZRWP_LES(:,:) + (ZZZ_LES(:,:,JK+1)-ZZZ_LES(:,:,JK)) &
- * (ZRR_LES(:,:,JK)) * ZRHO_LES(:,:,JK)
- END DO
- CALL LES_MEAN_ll ( ZRWP_LES, LLES_CURRENT_CART_MASK(:,:,1), &
- XLES_RWP(NLES_CURRENT_TCOUNT) )
-ENDIF
-!
-IF (LUSERI) THEN
- IRR = IRR + 1
- CALL LES_VER_INT( XRT(:,:,:,IRR) ,ZRI_LES )
- ZIWP_LES(:,:)=0.
- DO JK=1,NLES_K-1
- ZIWP_LES(:,:) = ZIWP_LES(:,:) + (ZZZ_LES(:,:,JK+1)-ZZZ_LES(:,:,JK)) &
- * (ZRI_LES(:,:,JK)) * ZRHO_LES(:,:,JK)
- END DO
- CALL LES_MEAN_ll ( ZIWP_LES, LLES_CURRENT_CART_MASK(:,:,1), &
- XLES_IWP(NLES_CURRENT_TCOUNT) )
- CALL LES_VER_INT( XICEFR(:,:,:) ,ZICEFR_LES )
-END IF
-IF (LUSERS) THEN
- IRR = IRR + 1
- CALL LES_VER_INT( XRT(:,:,:,IRR) ,ZRS_LES )
- ZSWP_LES(:,:)=0.
- DO JK=1,NLES_K-1
- ZSWP_LES(:,:) = ZSWP_LES(:,:) + (ZZZ_LES(:,:,JK+1)-ZZZ_LES(:,:,JK)) &
- * (ZRS_LES(:,:,JK)) * ZRHO_LES(:,:,JK)
- END DO
- CALL LES_MEAN_ll ( ZSWP_LES, LLES_CURRENT_CART_MASK(:,:,1), &
- XLES_SWP(NLES_CURRENT_TCOUNT) )
-END IF
-IF (LUSERG) THEN
- IRR = IRR + 1
- CALL LES_VER_INT( XRT(:,:,:,IRR) ,ZRG_LES )
- ZGWP_LES(:,:)=0.
- DO JK=1,NLES_K-1
- ZGWP_LES(:,:) = ZGWP_LES(:,:) + (ZZZ_LES(:,:,JK+1)-ZZZ_LES(:,:,JK)) &
- * (ZRG_LES(:,:,JK)) * ZRHO_LES(:,:,JK)
- END DO
- CALL LES_MEAN_ll ( ZGWP_LES, LLES_CURRENT_CART_MASK(:,:,1), &
- XLES_GWP(NLES_CURRENT_TCOUNT) )
-END IF
-IF (LUSERH) THEN
- IRR = IRR + 1
- CALL LES_VER_INT( XRT(:,:,:,IRR) ,ZRH_LES )
- ZHWP_LES(:,:)=0.
- DO JK=1,NLES_K-1
- ZHWP_LES(:,:) = ZHWP_LES(:,:) + (ZZZ_LES(:,:,JK+1)-ZZZ_LES(:,:,JK)) &
- * (ZRH_LES(:,:,JK)) * ZRHO_LES(:,:,JK)
- END DO
- CALL LES_MEAN_ll ( ZHWP_LES, LLES_CURRENT_CART_MASK(:,:,1), &
- XLES_HWP(NLES_CURRENT_TCOUNT) )
-END IF
-IF (NSV>0) THEN
- DO JSV=1,NSV
- CALL LES_VER_INT( XSVT(:,:,:,JSV), ZSV_LES(:,:,:,JSV) )
- CALL LES_VER_INT( GZ_M_M(XSVT(:,:,:,JSV),XDZZ), ZDSVDZ_LES(:,:,:,JSV) )
- END DO
-END IF
-!
-!*mean sw and lw fluxes
- CALL LES_MEAN_ll ( ZSWU_LES, LLES_CURRENT_CART_MASK, &
- XLES_SWU(:,NLES_CURRENT_TCOUNT) )
- CALL LES_MEAN_ll ( ZSWD_LES, LLES_CURRENT_CART_MASK, &
- XLES_SWD(:,NLES_CURRENT_TCOUNT) )
- CALL LES_MEAN_ll ( ZLWU_LES, LLES_CURRENT_CART_MASK, &
- XLES_LWU(:,NLES_CURRENT_TCOUNT) )
- CALL LES_MEAN_ll ( ZLWD_LES, LLES_CURRENT_CART_MASK, &
- XLES_LWD(:,NLES_CURRENT_TCOUNT) )
- CALL LES_MEAN_ll ( ZDTHRADSW_LES, LLES_CURRENT_CART_MASK, &
- XLES_DTHRADSW(:,NLES_CURRENT_TCOUNT) )
- CALL LES_MEAN_ll ( ZDTHRADLW_LES, LLES_CURRENT_CART_MASK, &
- XLES_DTHRADLW(:,NLES_CURRENT_TCOUNT) )
- CALL LES_MEAN_ll ( ZRADEFF_LES, LLES_CURRENT_CART_MASK, &
- XLES_RADEFF(:,NLES_CURRENT_TCOUNT) )
-!* mean vertical profiles on the LES grid
-!
- CALL LES_MEAN_ll ( ZU_LES, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_U(:,NLES_CURRENT_TCOUNT,1) )
-!
- CALL LES_MEAN_ll ( ZV_LES, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_V(:,NLES_CURRENT_TCOUNT,1) )
-!
- CALL LES_MEAN_ll ( ZW_LES, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_W(:,NLES_CURRENT_TCOUNT,1) )
-!
- CALL LES_MEAN_ll ( ZP_LES, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_P(:,NLES_CURRENT_TCOUNT,1) )
-!
- CALL LES_MEAN_ll ( ZDP_LES, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_DP(:,NLES_CURRENT_TCOUNT,1) )
-!
- CALL LES_MEAN_ll ( ZTP_LES, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_TP(:,NLES_CURRENT_TCOUNT,1) )
-!
- CALL LES_MEAN_ll ( ZTR_LES, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_TR(:,NLES_CURRENT_TCOUNT,1) )
-!
- CALL LES_MEAN_ll ( ZDISS_LES, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_DISS(:,NLES_CURRENT_TCOUNT,1) )
-!
- CALL LES_MEAN_ll ( ZLM_LES, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_LM(:,NLES_CURRENT_TCOUNT,1) )
-!
- CALL LES_MEAN_ll ( ZRHO_LES, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_RHO(:,NLES_CURRENT_TCOUNT,1) )
-!
- CALL LES_MEAN_ll ( ZMF_LES, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_Mf(:,NLES_CURRENT_TCOUNT,1) )
-!
- CALL LES_MEAN_ll ( ZTH_LES*ZEXN_LES, LLES_CURRENT_CART_MASK, &
- ZWORK1DT(:) )
-!
-!computation of es
- ZWORK1D(:)=EXP(XALPW - &
- XBETAW/ZWORK1DT(:) &
- -XGAMW*ALOG(ZWORK1DT(:)))
-!computation of qs
-
- IF (LUSERV) &
- XLES_MEAN_Qs(:,NLES_CURRENT_TCOUNT,1)=XRD/XRV*ZWORK1D(:)/ &
- (XLES_MEAN_P(:,NLES_CURRENT_TCOUNT,1)-ZWORK1D(:)*(1-XRD/XRV))
-! qs is determined from the temperature average over the current_mask
-!
- CALL LES_MEAN_ll ( ZTH_LES, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_Th(:,NLES_CURRENT_TCOUNT,1) )
-!
- IF (LUSERV) &
- CALL LES_MEAN_ll ( ZTHV_LES, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_Thv(:,NLES_CURRENT_TCOUNT,1) )
-!
- IF (LUSERC) &
- CALL LES_MEAN_ll ( ZTHL_LES, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_Thl(:,NLES_CURRENT_TCOUNT,1) )
-!
- IF (LUSERC) &
- CALL LES_MEAN_ll ( ZRT_LES, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_Rt(:,NLES_CURRENT_TCOUNT,1) )
-!
- IF (LUSERV) &
- CALL LES_MEAN_ll ( ZRV_LES, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_Rv(:,NLES_CURRENT_TCOUNT,1) )
-!
- IF (LUSERV) &
- CALL LES_MEAN_ll ( ZREHU_LES, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_Rehu(:,NLES_CURRENT_TCOUNT,1) )
-!
- IF (LUSERC) &
- CALL LES_MEAN_ll ( ZRC_LES, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_Rc(:,NLES_CURRENT_TCOUNT,1) )
-!
- IF (LUSERC) THEN
- CALL LES_MEAN_ll ( ZINDCLD, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_INDCf(:,NLES_CURRENT_TCOUNT,1) )
- CALL LES_MEAN_ll ( ZINDCLD2, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_INDCf2(:,NLES_CURRENT_TCOUNT,1) )
- CALL LES_MEAN_ll ( ZCLDFR_LES, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_Cf(:,NLES_CURRENT_TCOUNT,1) )
-!
-!* cf total
- CALL LES_MEAN_ll( ZINDCLD2D, LLES_CURRENT_CART_MASK(:,:,1) , &
- XLES_CFtot(NLES_CURRENT_TCOUNT) )
- CALL LES_MEAN_ll( ZINDCLD2D2, LLES_CURRENT_CART_MASK(:,:,1), &
- XLES_CF2tot(NLES_CURRENT_TCOUNT) )
- ENDIF
-!
- IF (LUSERR) THEN
-
- CALL LES_MEAN_ll ( XINPRR, LLES_CURRENT_CART_MASK(:,:,1), &
- XLES_INPRR(NLES_CURRENT_TCOUNT) )
- ZINPRRm=0.
- ZCOUNT=0.
- ZINDCLD2D(:,:)=0.
- DO JJ=1,IJU
- DO JI=1,IIU
- IF (ZRR_LES(JI,JJ,1) .GT. 1.E-6) ZINPRRm = ZINPRRm+XINPRR(JI,JJ)
- IF (ZRR_LES(JI,JJ,1) .GT. 1.E-6) ZINDCLD2D(JI,JJ)=1.
- IF (ZRR_LES(JI,JJ,1) .GT. 1.E-6) ZCOUNT=ZCOUNT+1.
- END DO
- END DO
- IF (ZCOUNT .GE. 1) ZINPRRm=ZINPRRm/ZCOUNT
- XLES_RAIN_INPRR(NLES_CURRENT_TCOUNT)=ZINPRRm
- CALL LES_MEAN_ll ( ZINDCLD2D, LLES_CURRENT_CART_MASK(:,:,1), &
- XLES_PRECFR(NLES_CURRENT_TCOUNT) )
- CALL LES_MEAN_ll ( ZINPRR3D_LES, LLES_CURRENT_CART_MASK, &
- XLES_INPRR3D(:,NLES_CURRENT_TCOUNT,1) )
- CALL LES_MEAN_ll ( ZEVAP3D_LES, LLES_CURRENT_CART_MASK, &
- XLES_EVAP3D(:,NLES_CURRENT_TCOUNT,1) )
- DO JK=1,NLES_K
- CHAMPXY1(:,:,1)=ZINPRR3D_LES(:,:,JK)
- XLES_MAX_INPRR3D(JK,NLES_CURRENT_TCOUNT,1)=MAX_ll (CHAMPXY1,IINFO_ll, &
- IIA_ll,IJA_ll,1,IIU_ll,IJU_ll,1)
- END DO
-!
-
-! conversion de m/s en mm/day
- XLES_RAIN_INPRR(NLES_CURRENT_TCOUNT)=XLES_RAIN_INPRR(NLES_CURRENT_TCOUNT)*3.6E6*24.
- XLES_INPRR(NLES_CURRENT_TCOUNT)=XLES_INPRR(NLES_CURRENT_TCOUNT)*3.6E6*24.
-
- CALL LES_MEAN_ll ( XACPRR, LLES_CURRENT_CART_MASK(:,:,1), &
- XLES_ACPRR(NLES_CURRENT_TCOUNT) )
-! conversion de m en mm
- XLES_ACPRR(NLES_CURRENT_TCOUNT)=XLES_ACPRR(NLES_CURRENT_TCOUNT)*1000.
- CALL LES_MEAN_ll ( ZRAINFR_LES, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_RF(:,NLES_CURRENT_TCOUNT,1) )
-
- ENDIF
-!
- IF (LUSERC ) THEN
- IF (( CCLOUD(1:3) == 'ICE' .AND.LSEDIC) .OR. &
- ((CCLOUD=='C2R2' .OR. CCLOUD=='C3R5' .OR. CCLOUD=='KHKO').AND.LSEDC) .OR. &
- ( CCLOUD=='LIMA' .AND.MSEDC)) THEN
- CALL LES_MEAN_ll ( XINPRC, LLES_CURRENT_CART_MASK(:,:,1), &
- XLES_INPRC(NLES_CURRENT_TCOUNT) )
-! conversion from m/s to mm/day
- XLES_INPRC(NLES_CURRENT_TCOUNT)=XLES_INPRC(NLES_CURRENT_TCOUNT)*3.6E6*24.
- ENDIF
- IF ( (((CCLOUD == 'KHKO') .OR.(CCLOUD == 'C2R2')) .AND. LDEPOC) &
- .OR. ( (CCLOUD(1:3) == 'ICE') .AND. LDEPOSC) ) THEN
- CALL LES_MEAN_ll ( XINDEP, LLES_CURRENT_CART_MASK(:,:,1), &
- XLES_INDEP(NLES_CURRENT_TCOUNT) )
-! conversion from m/s to mm/day
- XLES_INDEP(NLES_CURRENT_TCOUNT)=XLES_INDEP(NLES_CURRENT_TCOUNT)*3.6E6*24.
- ENDIF
- ENDIF
-!
- IF (LUSERR) &
- CALL LES_MEAN_ll ( ZRR_LES, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_Rr(:,NLES_CURRENT_TCOUNT,1) )
-!
- IF (LUSERI) &
- CALL LES_MEAN_ll ( ZRI_LES, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_Ri(:,NLES_CURRENT_TCOUNT,1) )
- CALL LES_MEAN_ll ( ZICEFR_LES, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_If(:,NLES_CURRENT_TCOUNT,1) )
-!
- IF (LUSERS) &
- CALL LES_MEAN_ll ( ZRS_LES, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_Rs(:,NLES_CURRENT_TCOUNT,1) )
-!
- IF (LUSERG) &
- CALL LES_MEAN_ll ( ZRG_LES, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_Rg(:,NLES_CURRENT_TCOUNT,1) )
-!
- IF (LUSERH) &
- CALL LES_MEAN_ll ( ZRH_LES, LLES_CURRENT_CART_MASK, &
- XLES_MEAN_Rh(:,NLES_CURRENT_TCOUNT,1) )
-!
- DO JSV=1,NSV
- CALL LES_MEAN_ll ( ZSV_LES(:,:,:,JSV), LLES_CURRENT_CART_MASK, &
- XLES_MEAN_Sv(:,NLES_CURRENT_TCOUNT,1,JSV) )
- END DO
-!
- CALL LES_MEAN_ll ( ZDPDZ_LES, LLES_CURRENT_CART_MASK, &
- ZMEAN_DPDZ(:) )
- CALL LES_MEAN_ll ( ZDTHDZ_LES, LLES_CURRENT_CART_MASK, &
- ZLES_MEAN_DTHDZ(:) )
-
-!
-!* build the 3D resolved turbulent fields by removing the mean field
-!
-DO JJ=1,IJU
- DO JI=1,IIU
- ZP_ANOM(JI,JJ,:) = ZP_LES(JI,JJ,:) - XLES_MEAN_P(:,NLES_CURRENT_TCOUNT,1)
- ZDPDZ_ANOM(JI,JJ,:) = ZDPDZ_LES(JI,JJ,:) - ZMEAN_DPDZ(:)
- ZTH_ANOM(JI,JJ,:) = ZTH_LES(JI,JJ,:) - XLES_MEAN_Th(:,NLES_CURRENT_TCOUNT,1)
- ZRHO_ANOM(JI,JJ,:) = ZRHO_LES(JI,JJ,:) - XLES_MEAN_Rho(:,NLES_CURRENT_TCOUNT,1)
- IF (LUSERV) THEN
- ZTHV_ANOM(JI,JJ,:) = ZTHV_LES(JI,JJ,:) - XLES_MEAN_Thv(:,NLES_CURRENT_TCOUNT,1)
- ZRV_ANOM(JI,JJ,:) = ZRV_LES(JI,JJ,:) - XLES_MEAN_Rv(:,NLES_CURRENT_TCOUNT,1)
- END IF
- IF (LUSERC) THEN
- ZRC_ANOM(JI,JJ,:) = ZRC_LES(JI,JJ,:) - XLES_MEAN_Rc(:,NLES_CURRENT_TCOUNT,1)
- ZLWP_ANOM(JI,JJ) =ZLWP_LES(JI,JJ)-XLES_LWP(NLES_CURRENT_TCOUNT)
- END IF
- IF (LUSERI) THEN
- ZRI_ANOM(JI,JJ,:) = ZRI_LES(JI,JJ,:) - XLES_MEAN_Ri(:,NLES_CURRENT_TCOUNT,1)
- END IF
- IF (LUSERR) THEN
- ZRR_ANOM(JI,JJ,:) = ZRR_LES(JI,JJ,:) - XLES_MEAN_Rr(:,NLES_CURRENT_TCOUNT,1)
- END IF
- END DO
-END DO
-!
-!
-!--------------------------------------------------------------------------------
-!
-!* vertical grid computed at first LES call for this model
-!
-IF (NLES_CURRENT_TCOUNT==1) THEN
- ALLOCATE(ZZ_LES (IIU,IJU,NLES_K))
- CALL LES_VER_INT( MZF(XZZ) ,ZZ_LES )
- CALL LES_MEAN_ll ( ZZ_LES, LLES_CURRENT_CART_MASK, XLES_Z )
- DEALLOCATE(ZZ_LES)
- CALL LES_MEAN_ll ( XZS, LLES_CURRENT_CART_MASK(:,:,1), XLES_ZS )
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. Vertical interpolations to SECTRA computations vertical grid
-! ------------------------------------------------------------
-!
-!* note that velocity fields are previously localized on the MASS points
-!
-CALL SPEC_VER_INT(IMI, MXF(XUT) ,ZU_SPEC )
-CALL SPEC_VER_INT(IMI, MYF(XVT) ,ZV_SPEC )
-CALL SPEC_VER_INT(IMI, MZF(XWT) ,ZW_SPEC )
-CALL SPEC_VER_INT(IMI, XTHT ,ZTH_SPEC )
-IF (LUSERC) CALL SPEC_VER_INT(IMI, ZTHL ,ZTHL_SPEC)
-IRR = 0
-IF (LUSERV) THEN
- IRR = IRR + 1
- CALL SPEC_VER_INT(IMI, XRT(:,:,:,IRR) ,ZRV_SPEC )
-END IF
-IF (LUSERC) THEN
- IRR = IRR + 1
- CALL SPEC_VER_INT(IMI, XRT(:,:,:,IRR) ,ZRC_SPEC )
-END IF
-IF (LUSERR) THEN
- IRR = IRR + 1
-END IF
-IF (LUSERI) THEN
- IRR = IRR + 1
- CALL SPEC_VER_INT(IMI, XRT(:,:,:,IRR) ,ZRI_SPEC )
-END IF
-IF (NSV>0) THEN
- DO JSV=1,NSV
- CALL SPEC_VER_INT(IMI, XSVT(:,:,:,JSV), ZSV_SPEC(:,:,:,JSV) )
- END DO
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. Call to LES computations on cartesian (sub-)domain
-! --------------------------------------------------
-!
-IMASK=1
-!
-CALL LES(LLES_CURRENT_CART_MASK)
-!
-!-------------------------------------------------------------------------------
-!
-!* 5. Call to LES computations on nebulosity mask
-! -------------------------------------------
-!
-IF (LLES_NEB_MASK) THEN
- IMASK=IMASK+1
- CALL LES(LLES_CURRENT_NEB_MASK .AND. LLES_CURRENT_CART_MASK)
-!
- IMASK=IMASK+1
- CALL LES((.NOT. LLES_CURRENT_NEB_MASK) .AND. LLES_CURRENT_CART_MASK)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 6. Call to LES computations on cloud core mask
-! -------------------------------------------
-!
-IF (LLES_CORE_MASK) THEN
- IMASK=IMASK+1
- CALL LES(LLES_CURRENT_CORE_MASK .AND. LLES_CURRENT_CART_MASK)
-!
- IMASK=IMASK+1
- CALL LES((.NOT. LLES_CURRENT_CORE_MASK) .AND. LLES_CURRENT_CART_MASK)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 7. Call to LES computations on user mask
-! -------------------------------------
-!
-IF (LLES_MY_MASK) THEN
- DO JI=1,NLES_MASKS_USER
- IMASK=IMASK+1
- CALL LES(LLES_CURRENT_MY_MASKS(:,:,:,JI))
- END DO
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 7b. Call to LES computations on conditional sampling mask
-! -----------------------------------------------------
-!
-IF (LLES_CS_MASK) THEN
- IMASK=IMASK+1
- CALL LES(LLES_CURRENT_CS1_MASK)
- IMASK=IMASK+1
- CALL LES(LLES_CURRENT_CS2_MASK)
- IMASK=IMASK+1
- CALL LES(LLES_CURRENT_CS3_MASK)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 8. budgets
-! -------
-!
-!* 8.1 tendencies
-! ----------
-!
-!
-!* 8.2 dynamical production, transport and mean advection
-! --------------------------------------------------
-!
-ALLOCATE(ZLES_MEAN_DRtDZ(NLES_K))
-ALLOCATE(ZLES_MEAN_DSVDZ(NLES_K,NSV))
-!
-IF (LUSERV) THEN
- ZLES_MEAN_DRtDZ(:) = XLES_MEAN_DRtDZ(:,NLES_CURRENT_TCOUNT,1)
-ELSE
- ZLES_MEAN_DRtDZ(:) = XUNDEF
-END IF
-!
-ZLES_MEAN_DSVDZ = 0.
-DO JSV=1,NSV
- ZLES_MEAN_DSvDZ(:,JSV) = XLES_MEAN_DSvDZ(:,NLES_CURRENT_TCOUNT,1,JSV)
-END DO
-!
-CALL LES_RES_TR(LUSERV, &
- XLES_MEAN_DUDZ(:,NLES_CURRENT_TCOUNT,1), &
- XLES_MEAN_DVDZ(:,NLES_CURRENT_TCOUNT,1), &
- XLES_MEAN_DWDZ(:,NLES_CURRENT_TCOUNT,1), &
- XLES_MEAN_DThlDZ(:,NLES_CURRENT_TCOUNT,1), &
- ZLES_MEAN_DRtDZ(:), &
- ZLES_MEAN_DSvDZ(:,:) )
-!
-DEALLOCATE(ZLES_MEAN_DRtDZ)
-DEALLOCATE(ZLES_MEAN_DSVDZ)
-!
-CALL LES_BUDGET_TEND_n
-!* 8.3 end of LES budgets computations
-! -------------------------------
-!
-DO JLOOP=1,NLES_TOT
- XLES_BU_RES_KE (:,NLES_CURRENT_TCOUNT,JLOOP) = X_LES_BU_RES_KE (:,JLOOP)
- XLES_BU_RES_WThl (:,NLES_CURRENT_TCOUNT,JLOOP) = X_LES_BU_RES_WThl (:,JLOOP)
- XLES_BU_RES_Thl2 (:,NLES_CURRENT_TCOUNT,JLOOP) = X_LES_BU_RES_Thl2 (:,JLOOP)
- XLES_BU_SBG_Tke (:,NLES_CURRENT_TCOUNT,JLOOP) = X_LES_BU_SBG_Tke (:,JLOOP)
- IF (LUSERV) THEN
- XLES_BU_RES_WRt (:,NLES_CURRENT_TCOUNT,JLOOP) = X_LES_BU_RES_WRt (:,JLOOP)
- XLES_BU_RES_Rt2 (:,NLES_CURRENT_TCOUNT,JLOOP) = X_LES_BU_RES_Rt2 (:,JLOOP)
- XLES_BU_RES_ThlRt(:,NLES_CURRENT_TCOUNT,JLOOP) = X_LES_BU_RES_ThlRt(:,JLOOP)
- END IF
- DO JSV=1,NSV
- XLES_BU_RES_Sv2 (:,NLES_CURRENT_TCOUNT,JLOOP,JSV) = X_LES_BU_RES_Sv2 (:,JLOOP,JSV)
- XLES_BU_RES_WSv (:,NLES_CURRENT_TCOUNT,JLOOP,JSV) = X_LES_BU_RES_WSv (:,JLOOP,JSV)
- END DO
-END DO
-!
-!-------------------------------------------------------------------------------
-!
-!* 9. Deallocations
-! -------------
-!
-!* 9.1 local variables
-! ---------------
-!
-DEALLOCATE(ZEXN )
-DEALLOCATE(ZTHL)
-DEALLOCATE(ZRT )
-DEALLOCATE(ZTHV )
-DEALLOCATE(ZRHO )
-DEALLOCATE(ZEW )
-
-DEALLOCATE(ZINDCLD )
-DEALLOCATE(ZINDCLD2 )
-DEALLOCATE(ZINDCLD2D )
-DEALLOCATE(ZINDCLD2D2)
-DEALLOCATE(ZCLDFR_LES)
-DEALLOCATE(ZICEFR_LES)
-DEALLOCATE(ZRAINFR_LES)
-DEALLOCATE(ZMASSF )
-DEALLOCATE(ZTEMP )
-DEALLOCATE(ZREHU )
-DEALLOCATE(CHAMPXY1 )
-!
-DEALLOCATE(ZU_LES)
-DEALLOCATE(ZV_LES)
-DEALLOCATE(ZW_LES)
-DEALLOCATE(ZTHL_LES)
-DEALLOCATE(ZRT_LES)
-DEALLOCATE(ZSV_LES)
-DEALLOCATE(ZP_LES )
-DEALLOCATE(ZDP_LES )
-DEALLOCATE(ZTP_LES )
-DEALLOCATE(ZTR_LES )
-DEALLOCATE(ZDISS_LES )
-DEALLOCATE(ZLM_LES )
-DEALLOCATE(ZDPDZ_LES)
-DEALLOCATE(ZLWP_ANOM)
-DEALLOCATE(ZWORK2D)
-DEALLOCATE(ZWORK1D)
-DEALLOCATE(ZWORK1DT)
-DEALLOCATE(ZMAXWRR2D)
-DEALLOCATE(ZDTHLDZ_LES)
-DEALLOCATE(ZDTHDZ_LES)
-DEALLOCATE(ZDRTDZ_LES)
-DEALLOCATE(ZDSVDZ_LES)
-DEALLOCATE(ZDUDZ_LES)
-DEALLOCATE(ZDVDZ_LES)
-DEALLOCATE(ZDWDZ_LES)
-DEALLOCATE(ZRHO_LES )
-DEALLOCATE(ZEXN_LES )
-DEALLOCATE(ZTH_LES )
-DEALLOCATE(ZMF_LES )
-DEALLOCATE(ZTHV_LES )
-DEALLOCATE(ZTKE_LES )
-DEALLOCATE(ZKE_LES )
-DEALLOCATE(ZTKET_LES)
-DEALLOCATE(ZRV_LES )
-DEALLOCATE(ZREHU_LES )
-DEALLOCATE(ZRC_LES )
-DEALLOCATE(ZRR_LES )
-DEALLOCATE(ZZZ_LES)
-DEALLOCATE(ZLWP_LES )
-DEALLOCATE(ZRWP_LES )
-DEALLOCATE(ZIWP_LES )
-DEALLOCATE(ZSWP_LES )
-DEALLOCATE(ZGWP_LES )
-DEALLOCATE(ZHWP_LES )
-DEALLOCATE(ZINPRR3D_LES)
-DEALLOCATE(ZEVAP3D_LES)
-DEALLOCATE(ZRI_LES )
-DEALLOCATE(ZRS_LES )
-DEALLOCATE(ZRG_LES )
-DEALLOCATE(ZRH_LES )
-DEALLOCATE(ZP_ANOM )
-DEALLOCATE(ZRHO_ANOM)
-DEALLOCATE(ZTH_ANOM )
-DEALLOCATE(ZTHV_ANOM)
-DEALLOCATE(ZRV_ANOM )
-DEALLOCATE(ZRC_ANOM )
-DEALLOCATE(ZRI_ANOM )
-DEALLOCATE(ZRR_ANOM )
-DEALLOCATE(ZDPDZ_ANOM)
-DEALLOCATE(ZMEAN_DPDZ)
-DEALLOCATE(ZLES_MEAN_DTHDZ)
-!
-DEALLOCATE(ZU_SPEC )
-DEALLOCATE(ZV_SPEC )
-DEALLOCATE(ZW_SPEC )
-DEALLOCATE(ZTH_SPEC )
-DEALLOCATE(ZTHL_SPEC )
-DEALLOCATE(ZRV_SPEC )
-DEALLOCATE(ZRC_SPEC )
-DEALLOCATE(ZRI_SPEC )
-DEALLOCATE(ZSV_SPEC )
-!
-DEALLOCATE(ZRADEFF_LES )
-DEALLOCATE(ZSWU_LES )
-DEALLOCATE(ZSWD_LES )
-DEALLOCATE(ZLWD_LES )
-DEALLOCATE(ZLWU_LES )
-DEALLOCATE(ZDTHRADSW_LES )
-DEALLOCATE(ZDTHRADLW_LES )
-!
-!* 9.2 current time-step LES masks (in MODD_LES)
-! ---------------------------
-!
-CALL LES_DEALLOCATE('LLES_CURRENT_CART_MASK')
-IF (LLES_NEB_MASK) CALL LES_DEALLOCATE('LLES_CURRENT_NEB_MASK')
-IF (LLES_CORE_MASK) CALL LES_DEALLOCATE('LLES_CURRENT_CORE_MASK')
-IF (LLES_MY_MASK) THEN
- CALL LES_DEALLOCATE('LLES_CURRENT_MY_MASKS')
-END IF
-IF (LLES_CS_MASK) THEN
- CALL LES_DEALLOCATE('LLES_CURRENT_CS1_MASK')
- IF (NSV_CS >= 2) CALL LES_DEALLOCATE('LLES_CURRENT_CS2_MASK')
- IF (NSV_CS == 3) CALL LES_DEALLOCATE('LLES_CURRENT_CS3_MASK')
-END IF
-!
-!
-!* 9.3 variables in MODD_LES_BUDGET
-! ----------------------------
-!
-
-DEALLOCATE(XU_ANOM )
-DEALLOCATE(XV_ANOM )
-DEALLOCATE(XW_ANOM )
-DEALLOCATE(XTHL_ANOM)
-DEALLOCATE(XRT_ANOM )
-DEALLOCATE(XSV_ANOM )
-!
-DEALLOCATE(XCURRENT_L_O_EXN_CP)
-DEALLOCATE(XCURRENT_RHODJ )
-!
-DEALLOCATE(XCURRENT_RUS )
-DEALLOCATE(XCURRENT_RVS )
-DEALLOCATE(XCURRENT_RWS )
-DEALLOCATE(XCURRENT_RTHS )
-DEALLOCATE(XCURRENT_RTKES)
-DEALLOCATE(XCURRENT_RRS )
-DEALLOCATE(XCURRENT_RSVS )
-DEALLOCATE(XCURRENT_RTHLS)
-DEALLOCATE(XCURRENT_RRTS )
-
-DEALLOCATE(X_LES_BU_RES_KE )
-DEALLOCATE(X_LES_BU_RES_WThl )
-DEALLOCATE(X_LES_BU_RES_Thl2 )
-DEALLOCATE(X_LES_BU_RES_WRt )
-DEALLOCATE(X_LES_BU_RES_Rt2 )
-DEALLOCATE(X_LES_BU_RES_ThlRt)
-DEALLOCATE(X_LES_BU_RES_Sv2 )
-DEALLOCATE(X_LES_BU_RES_WSv )
-DEALLOCATE(X_LES_BU_SBG_TKE )
-!-------------------------------------------------------------------------------
-!
-!* 10. end of LES computations for this time-step
-! ------------------------------------------
-!
-LLES_CALL=.FALSE.
-CALL BUDGET_FLAGS(LUSERV, LUSERC, LUSERR, &
- LUSERI, LUSERS, LUSERG, LUSERH )
-!
-!-------------------------------------------------------------------------------
-!
-CONTAINS
-!
-! ##########################################################################
- SUBROUTINE LES(OMASK)
-! ##########################################################################
-!
-!
-!!**** *LES* computes the current time-step LES diagnostics for one mask.
-!!
-!!
-!! PURPOSE
-!! -------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 07/02/00
-!!
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS
-!
-USE MODI_LES_FLUX_ll
-USE MODI_LES_3RD_MOMENT_ll
-USE MODI_LES_4TH_MOMENT_ll
-USE MODI_LES_MEAN_1PROC
-USE MODI_LES_MEAN_MPROC
-USE MODI_LES_PDF_ll
-!
-USE MODI_LES_HOR_CORR
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: OMASK ! 2D mask for computations
-!
-!
-!
-! 0.2 declaration of local variables
-!
-INTEGER :: JSV ! scalar variables counter
-INTEGER :: JI
-INTEGER :: JK ! vertical loop counter
-INTEGER :: JPDF ! pdf counter
-!
-LOGICAL, DIMENSION(SIZE(ZW_LES,1),SIZE(ZW_LES,2),SIZE(ZW_LES,3)) :: GUPDRAFT_MASK
-LOGICAL, DIMENSION(SIZE(ZW_LES,1),SIZE(ZW_LES,2),SIZE(ZW_LES,3)) :: GDOWNDRAFT_MASK
-REAL, DIMENSION(SIZE(ZW_LES,1),SIZE(ZW_LES,2),SIZE(ZW_LES,3)) :: ZUPDRAFT
-REAL, DIMENSION(SIZE(ZW_LES,1),SIZE(ZW_LES,2),SIZE(ZW_LES,3)) :: ZDOWNDRAFT
-REAL, DIMENSION(SIZE(ZW_LES,1),SIZE(ZW_LES,2),SIZE(ZW_LES,3)) :: ZW_UP
-REAL, DIMENSION(SIZE(ZW_LES,1),SIZE(ZW_LES,2),SIZE(ZW_LES,3)) :: ZWORK_LES
-!
-INTEGER, DIMENSION(SIZE(ZW_LES,3)) :: IAVG_PTS
-INTEGER, DIMENSION(SIZE(ZW_LES,3)) :: IUND_PTS
-REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZAVG
-!
-REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_RESOLVED_U3
-REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_RESOLVED_UV2
-REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_RESOLVED_UW2
-REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_RESOLVED_VU2
-REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_RESOLVED_V3
-REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_RESOLVED_VW2
-REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_RESOLVED_WU2
-REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_RESOLVED_WV2
-REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_UPDRAFT_U2
-REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_UPDRAFT_V2
-REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_UPDRAFT_W2
-REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_DOWNDRAFT_U2
-REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_DOWNDRAFT_V2
-REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZLES_DOWNDRAFT_W2
-REAL, DIMENSION(SIZE(ZW_LES,3),NPDF) :: ZPDF
-!
-INTEGER, DIMENSION(1) :: IKMIN_FLUX ! vertical index of min. W'thl'
-INTEGER, DIMENSION(1) :: IKMAX_TH !vertical index maxdth
-INTEGER, DIMENSION(1) :: IKMAX_CF ! vertical index of max. Cf
-!
-REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZKE_TOT ! total turbulent kinetic energy
-REAL :: ZINT_KE_TOT! integral of KE_TOT
-REAL :: ZINT_RHOKE! integral of RHO*KE
-REAL :: ZFRIC_SURF ! surface friction
-REAL, DIMENSION(SIZE(ZW_LES,3)) :: ZFRIC_LES ! friction at all LES levels
-!
-!-------------------------------------------------------------------------------
-!
-! 1. local diagnostics (for any mask type)
-! -----------------
-!
-!
-! 1.2 Number of points used for averaging on current processor
-! --------------------------------------------------------
-!
-!* to be sure to be coherent with other computations,
-! a field on LES vertical grid (and horizontal mass point grid) is used.
-! This information is necessary for the subgrid fluxes computations, because
-! half of the work is already done, but the number of averaging points was
-! not kept.
-!
-CALL LES_MEAN_1PROC ( XW_ANOM, OMASK, &
- ZAVG(:), &
- IAVG_PTS(:), &
- IUND_PTS(:) )
-!
-!
-! 1.3 Number of points used for averaging on all processor
-! ----------------------------------------------------
-!
-CALL LES_MEAN_ll ( XW_ANOM, OMASK, &
- ZAVG(:), &
- NLES_AVG_PTS_ll(:,NLES_CURRENT_TCOUNT,IMASK), &
- NLES_UND_PTS_ll(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!
-! 1.4 Mean quantities
-! ---------------
-!
-IF (LLES_MEAN .AND. IMASK > 1) THEN
-!
-!* horizontal wind velocities
-!
- CALL LES_MEAN_ll ( ZU_LES, OMASK, &
- XLES_MEAN_U(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
- CALL LES_MEAN_ll ( ZV_LES, OMASK, &
- XLES_MEAN_V(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* vertical wind velocity
-!
- CALL LES_MEAN_ll ( ZW_LES, OMASK, &
- XLES_MEAN_W(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* pressure
-!
- CALL LES_MEAN_ll ( ZP_LES, OMASK, &
- XLES_MEAN_P(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* dynamical production TKE
-!
- CALL LES_MEAN_ll ( ZDP_LES, OMASK, &
- XLES_MEAN_DP(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* thermal production TKE
-!
- CALL LES_MEAN_ll ( ZTP_LES, OMASK, &
- XLES_MEAN_TP(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* transport TKE
-!
- CALL LES_MEAN_ll ( ZTR_LES, OMASK, &
- XLES_MEAN_TR(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* dissipation TKE
-!
- CALL LES_MEAN_ll ( ZDISS_LES, OMASK, &
- XLES_MEAN_DISS(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* mixing length
-!
- CALL LES_MEAN_ll ( ZLM_LES, OMASK, &
- XLES_MEAN_LM(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* density
-!
- CALL LES_MEAN_ll ( ZRHO_LES, OMASK, &
- XLES_MEAN_RHO(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!
-!* potential temperature
-!
- CALL LES_MEAN_ll ( ZTH_LES, OMASK, &
- XLES_MEAN_Th(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* mass flux
- CALL LES_MEAN_ll ( ZMF_LES, OMASK, &
- XLES_MEAN_Mf(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!
-!* virtual potential temperature
-!
- IF (LUSERV) &
- CALL LES_MEAN_ll ( ZTHV_LES, OMASK, &
- XLES_MEAN_Thv(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* liquid potential temperature
-!
- IF (LUSERC) THEN
- CALL LES_MEAN_ll ( ZTHL_LES, OMASK, &
- XLES_MEAN_Thl(:,NLES_CURRENT_TCOUNT,IMASK) )
- END IF
-!
-!* vapor mixing ratio
-!
- IF (LUSERV) THEN
- CALL LES_MEAN_ll ( ZRV_LES, OMASK, &
- XLES_MEAN_Rv(:,NLES_CURRENT_TCOUNT,IMASK) )
- END IF
-!
-!*relative humidity
-!
- IF (LUSERV) THEN
- CALL LES_MEAN_ll ( ZREHU_LES, OMASK, &
- XLES_MEAN_Rehu(:,NLES_CURRENT_TCOUNT,IMASK) )
- END IF
-!
-!* cloud mixing ratio
-!
- IF (LUSERC) THEN
- CALL LES_MEAN_ll ( ZRC_LES, OMASK, &
- XLES_MEAN_Rc(:,NLES_CURRENT_TCOUNT,IMASK) )
- CALL LES_MEAN_ll ( ZRT_LES, OMASK, &
- XLES_MEAN_Rt(:,NLES_CURRENT_TCOUNT,IMASK) )
- END IF
-!
-!* rain mixing ratio
-!
- IF (LUSERR) THEN
- CALL LES_MEAN_ll ( ZRR_LES, OMASK, &
- XLES_MEAN_Rr(:,NLES_CURRENT_TCOUNT,IMASK) )
- END IF
-!
-!* ice mixing ratio
-!
- IF (LUSERI) THEN
- CALL LES_MEAN_ll ( ZRI_LES, OMASK, &
- XLES_MEAN_Ri(:,NLES_CURRENT_TCOUNT,IMASK) )
- END IF
-!
-!* snow mixing ratio
-!
- IF (LUSERS) THEN
- CALL LES_MEAN_ll ( ZRS_LES, OMASK, &
- XLES_MEAN_Rs(:,NLES_CURRENT_TCOUNT,IMASK) )
- END IF
-!
-!* graupel mixing ratio
-!
- IF (LUSERG) THEN
- CALL LES_MEAN_ll ( ZRG_LES, OMASK, &
- XLES_MEAN_Rg(:,NLES_CURRENT_TCOUNT,IMASK) )
- END IF
-!
-!* hail mixing ratio
-!
- IF (LUSERH) THEN
- CALL LES_MEAN_ll ( ZRH_LES, OMASK, &
- XLES_MEAN_Rh(:,NLES_CURRENT_TCOUNT,IMASK) )
- END IF
-!
-!* scalar variables mixing ratio
-!
- DO JSV=1,NSV
- CALL LES_MEAN_ll ( ZSV_LES(:,:,:,JSV), OMASK, &
- XLES_MEAN_Sv(:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
- END DO
-END IF
-!
-!* wind modulus
-!
-IF (LLES_MEAN) THEN
-!
- ZWORK_LES =SQRT( ZU_LES**2 +ZV_LES**2 )
- CALL LES_MEAN_ll ( ZWORK_LES, OMASK, &
- XLES_MEAN_WIND(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* vertical speed larger than mean vertical speed (updraft)
-!
- DO JK=1,NLES_K
- ZW_UP(:,:,JK) = MAX(ZW_LES(:,:,JK), XLES_MEAN_W(JK,NLES_CURRENT_TCOUNT,IMASK))
- END DO
-!
-!* upward mass flux
-!
- ZWORK_LES = ZW_UP * ZRHO_LES
- CALL LES_MEAN_ll ( ZWORK_LES, OMASK, &
- XLES_RESOLVED_MASSFX(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* pdf calculation
-!
- IF (LLES_PDF) THEN
- CALL LES_PDF_ll ( ZTH_LES,OMASK,XTH_PDF_MIN,XTH_PDF_MAX, &
- ZPDF(:,:) )
- DO JSV=1,NPDF
- XLES_PDF_TH(:,NLES_CURRENT_TCOUNT,IMASK,JSV)=ZPDF(:,JSV)
- END DO
-
- CALL LES_PDF_ll ( ZW_LES,OMASK,XW_PDF_MIN,XW_PDF_MAX, &
- ZPDF(:,:) )
- DO JSV=1,NPDF
- XLES_PDF_W(:,NLES_CURRENT_TCOUNT,IMASK,JSV)=ZPDF(:,JSV)
- END DO
- CALL LES_PDF_ll ( ZTHV_LES,OMASK,XTHV_PDF_MIN,XTHV_PDF_MAX, &
- ZPDF(:,:) )
- DO JSV=1,NPDF
- XLES_PDF_THV(:,NLES_CURRENT_TCOUNT,IMASK,JSV)=ZPDF(:,JSV)
- END DO
- IF (LUSERV) THEN
- CALL LES_PDF_ll ( ZRV_LES,OMASK,XRV_PDF_MIN,XRV_PDF_MAX, &
- ZPDF(:,:) )
- DO JSV=1,NPDF
- XLES_PDF_RV(:,NLES_CURRENT_TCOUNT,IMASK,JSV)=ZPDF(:,JSV)
- END DO
- END IF
- IF (LUSERC) THEN
- CALL LES_PDF_ll ( ZRC_LES,OMASK,XRC_PDF_MIN,XRC_PDF_MAX, &
- ZPDF(:,:) )
- DO JSV=1,NPDF
- XLES_PDF_RC(:,NLES_CURRENT_TCOUNT,IMASK,JSV)=ZPDF(:,JSV)
- END DO
- CALL LES_PDF_ll ( ZRT_LES,OMASK,XRT_PDF_MIN,XRT_PDF_MAX, &
- ZPDF(:,:) )
- DO JSV=1,NPDF
- XLES_PDF_RT(:,NLES_CURRENT_TCOUNT,IMASK,JSV)=ZPDF(:,JSV)
- END DO
- CALL LES_PDF_ll ( ZTHL_LES,OMASK,XTHL_PDF_MIN,XTHL_PDF_MAX, &
- ZPDF(:,:) )
- DO JSV=1,NPDF
- XLES_PDF_THL(:,NLES_CURRENT_TCOUNT,IMASK,JSV)=ZPDF(:,JSV)
- END DO
- END IF
- IF (LUSERR) THEN
- CALL LES_PDF_ll ( ZRR_LES,OMASK,XRR_PDF_MIN,XRR_PDF_MAX, &
- ZPDF(:,:) )
- DO JSV=1,NPDF
- XLES_PDF_RR(:,NLES_CURRENT_TCOUNT,IMASK,JSV)=ZPDF(:,JSV)
- END DO
- END IF
- IF (LUSERI) THEN
- CALL LES_PDF_ll ( ZRI_LES,OMASK,XRI_PDF_MIN,XRI_PDF_MAX, &
- ZPDF(:,:) )
- DO JSV=1,NPDF
- XLES_PDF_RI(:,NLES_CURRENT_TCOUNT,IMASK,JSV)=ZPDF(:,JSV)
- END DO
- END IF
- IF (LUSERS) THEN
- CALL LES_PDF_ll ( ZRS_LES,OMASK,XRS_PDF_MIN,XRS_PDF_MAX, &
- ZPDF(:,:) )
- DO JSV=1,NPDF
- XLES_PDF_RS(:,NLES_CURRENT_TCOUNT,IMASK,JSV)=ZPDF(:,JSV)
- END DO
- END IF
- IF (LUSERG) THEN
- CALL LES_PDF_ll ( ZRG_LES,OMASK,XRG_PDF_MIN,XRG_PDF_MAX, &
- ZPDF(:,:) )
- DO JSV=1,NPDF
- XLES_PDF_RG(:,NLES_CURRENT_TCOUNT,IMASK,JSV)=ZPDF(:,JSV)
- END DO
- END IF
- END IF
-!
-!* mean vertical gradients
-!
- CALL LES_MEAN_ll ( ZDTHLDZ_LES, OMASK, XLES_MEAN_DTHLDZ(:,NLES_CURRENT_TCOUNT,IMASK) )
- CALL LES_MEAN_ll ( ZDUDZ_LES, OMASK, XLES_MEAN_DUDZ(:,NLES_CURRENT_TCOUNT,IMASK) )
- CALL LES_MEAN_ll ( ZDVDZ_LES, OMASK, XLES_MEAN_DVDZ(:,NLES_CURRENT_TCOUNT,IMASK) )
- CALL LES_MEAN_ll ( ZDWDZ_LES, OMASK, XLES_MEAN_DWDZ(:,NLES_CURRENT_TCOUNT,IMASK) )
- IF (LUSERV) CALL LES_MEAN_ll ( ZDRtDZ_LES, OMASK, XLES_MEAN_DRtDZ(:,NLES_CURRENT_TCOUNT,IMASK) )
- DO JSV=1,NSV
- CALL LES_MEAN_ll ( ZDSVDZ_LES(:,:,:,JSV), OMASK, XLES_MEAN_DSVDZ(:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
- END DO
-
-END IF
-!-------------------------------------------------------------------------------
-!
-! 1.5 Resolved quantities
-! -------------------
-!
-!* horizontal wind variances
-!
- CALL LES_FLUX_ll ( XU_ANOM, XU_ANOM, &
- OMASK, &
- XLES_RESOLVED_U2 (:,NLES_CURRENT_TCOUNT,IMASK) )
-!
- CALL LES_FLUX_ll ( XV_ANOM, XV_ANOM, &
- OMASK, &
- XLES_RESOLVED_V2 (:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* vertical wind variance
-!
- CALL LES_FLUX_ll ( XW_ANOM, XW_ANOM, &
- OMASK, &
- XLES_RESOLVED_W2 (:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* pressure variance
-!
- CALL LES_FLUX_ll ( ZP_ANOM, ZP_ANOM, &
- OMASK, &
- XLES_RESOLVED_P2 (:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* potential temperature variance
-!
- CALL LES_FLUX_ll ( ZTH_ANOM, ZTH_ANOM, &
- OMASK, &
- XLES_RESOLVED_TH2(:,NLES_CURRENT_TCOUNT,IMASK) )
-
-!
-!* resolved turbulent kinetic energy
-!
- XLES_RESOLVED_Ke(:,NLES_CURRENT_TCOUNT,IMASK) = XUNDEF
-!
- WHERE(XLES_RESOLVED_U2 (:,NLES_CURRENT_TCOUNT,IMASK) /= XUNDEF) &
- XLES_RESOLVED_Ke(:,NLES_CURRENT_TCOUNT,IMASK) = 0.5*( &
- XLES_RESOLVED_U2 (:,NLES_CURRENT_TCOUNT,IMASK) &
- + XLES_RESOLVED_V2 (:,NLES_CURRENT_TCOUNT,IMASK) &
- + XLES_RESOLVED_W2 (:,NLES_CURRENT_TCOUNT,IMASK))
-!
-!* potential temperature - virtual potential temperature covariance
-!
- IF (LUSERV) THEN
- CALL LES_FLUX_ll ( ZTH_ANOM, ZTHV_ANOM, &
- OMASK, &
- XLES_RESOLVED_THTHV(:,NLES_CURRENT_TCOUNT,IMASK) )
-
-!
-!* vapor mixing ratio variance
-!
- CALL LES_FLUX_ll ( ZRV_ANOM, ZRV_ANOM, &
- OMASK, &
- XLES_RESOLVED_Rv2(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!
-!* potential temperature - vapor mixing ratio correlation
-!
- CALL LES_FLUX_ll ( ZTH_ANOM, ZRV_ANOM, &
- OMASK, &
- XLES_RESOLVED_ThRv(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* virtual potential temperature - vapor mixing ratio correlation
-!
- CALL LES_FLUX_ll ( ZTHV_ANOM, ZRV_ANOM, &
- OMASK, &
- XLES_RESOLVED_ThvRv(:,NLES_CURRENT_TCOUNT,IMASK) )
- END IF
-!
-!
-!* liquid potential temperature - virtual potential temperature covariance
-!
- IF (LUSERC) THEN
- CALL LES_FLUX_ll ( XTHL_ANOM, ZTHV_ANOM, &
- OMASK, &
- XLES_RESOLVED_THLTHV(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* liquid potential temperature variance
-!
- CALL LES_FLUX_ll ( XTHL_ANOM, XTHL_ANOM, &
- OMASK, &
- XLES_RESOLVED_THL2(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* total water mixing ratio variance
-!
- CALL LES_FLUX_ll ( XRT_ANOM, XRT_ANOM, &
- OMASK, &
- XLES_RESOLVED_Rt2(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* cloud mixing ratio variance
-!
- CALL LES_FLUX_ll ( ZRC_ANOM, ZRC_ANOM, &
- OMASK, &
- XLES_RESOLVED_Rc2(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* potential temperature - cloud mixing ratio correlation
-!
- CALL LES_FLUX_ll ( ZTH_ANOM, ZRC_ANOM, &
- OMASK, &
- XLES_RESOLVED_ThRc(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* liquid potential temperature - vapor mixing ratio correlation
-!
- CALL LES_FLUX_ll ( XTHL_ANOM, ZRV_ANOM, &
- OMASK, &
- XLES_RESOLVED_ThlRv(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* liquid potential temperature - cloud mixing ratio correlation
-!
- CALL LES_FLUX_ll ( XTHL_ANOM, ZRC_ANOM, &
- OMASK, &
- XLES_RESOLVED_ThlRc(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* virtual potential temperature - cloud mixing ratio correlation
-!
- CALL LES_FLUX_ll ( ZTHV_ANOM, ZRC_ANOM, &
- OMASK, &
- XLES_RESOLVED_ThvRc(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-! variance of lwp
-!
- IF (IMASK .EQ. 1) THEN
- CALL LES_FLUX_ll (ZLWP_ANOM, ZLWP_ANOM, &
- OMASK(:,:,1), &
- XLES_LWPVAR(NLES_CURRENT_TCOUNT) )
- END IF
- END IF
-!
-!* ice mixing ratio variance
-!
- IF (LUSERI) THEN
- CALL LES_FLUX_ll ( ZRI_ANOM, ZRI_ANOM, &
- OMASK, &
- XLES_RESOLVED_Ri2(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* potential temperature - ice mixing ratio correlation
-!
- CALL LES_FLUX_ll ( ZTH_ANOM, ZRI_ANOM, &
- OMASK, &
- XLES_RESOLVED_ThRi(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* liquid potential temperature - ice mixing ratio correlation
-!
- CALL LES_FLUX_ll ( XTHL_ANOM, ZRI_ANOM, &
- OMASK, &
- XLES_RESOLVED_ThlRi(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* virtual potential temperature - ice mixing ratio correlation
-!
- CALL LES_FLUX_ll ( ZTHV_ANOM, ZRI_ANOM, &
- OMASK, &
- XLES_RESOLVED_ThvRi(:,NLES_CURRENT_TCOUNT,IMASK) )
- END IF
-!
-!* scalar variable mixing ratio variances
-!
- DO JSV=1,NSV
- CALL LES_FLUX_ll ( XSV_ANOM(:,:,:,JSV), XSV_ANOM(:,:,:,JSV), &
- OMASK, &
- XLES_RESOLVED_Sv2(:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
-!
-!* potential temperature - scalar variables ratio correlation
-!
- CALL LES_FLUX_ll ( ZTH_ANOM, XSV_ANOM(:,:,:,JSV), &
- OMASK, &
- XLES_RESOLVED_ThSv(:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
-!
-!* liquid potential temperature - scalar variables ratio correlation
-!
- IF (LUSERC) THEN
- CALL LES_FLUX_ll ( XTHL_ANOM, XSV_ANOM(:,:,:,JSV), &
- OMASK, &
- XLES_RESOLVED_ThlSv(:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
- END IF
-!
-!* virtual potential temperature - scalar variables ratio correlation
-!
- IF (LUSERV) THEN
- CALL LES_FLUX_ll ( ZTHV_ANOM, XSV_ANOM(:,:,:,JSV), &
- OMASK, &
- XLES_RESOLVED_ThvSv(:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
- END IF
- END DO
-!
-!
-!* wind fluxes
-!
- CALL LES_FLUX_ll ( XU_ANOM, XV_ANOM, &
- OMASK, &
- XLES_RESOLVED_UV (:,NLES_CURRENT_TCOUNT,IMASK) )
-!
- CALL LES_FLUX_ll ( XW_ANOM, XU_ANOM, &
- OMASK, &
- XLES_RESOLVED_WU (:,NLES_CURRENT_TCOUNT,IMASK) )
-!
- CALL LES_FLUX_ll ( XW_ANOM, XV_ANOM, &
- OMASK, &
- XLES_RESOLVED_WV (:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* pressure fluxes
-!
- CALL LES_FLUX_ll ( XU_ANOM, ZDPDZ_ANOM, &
- OMASK, &
- XLES_RESOLVED_UP (:,NLES_CURRENT_TCOUNT,IMASK) )
-!
- CALL LES_FLUX_ll ( XV_ANOM, ZDPDZ_ANOM, &
- OMASK, &
- XLES_RESOLVED_VP (:,NLES_CURRENT_TCOUNT,IMASK) )
-!
- CALL LES_FLUX_ll ( XW_ANOM, ZDPDZ_ANOM, &
- OMASK, &
- XLES_RESOLVED_WP (:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* theta fluxes
-!
- CALL LES_FLUX_ll ( XU_ANOM, ZTH_ANOM, &
- OMASK, &
- XLES_RESOLVED_UTh (:,NLES_CURRENT_TCOUNT,IMASK) )
-
- CALL LES_FLUX_ll ( XV_ANOM, ZTH_ANOM, &
- OMASK, &
- XLES_RESOLVED_VTh (:,NLES_CURRENT_TCOUNT,IMASK) )
-!
- CALL LES_FLUX_ll ( XW_ANOM, ZTH_ANOM, &
- OMASK, &
- XLES_RESOLVED_WTh (:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* virtual theta fluxes
-!
- IF (LUSERV) THEN
- CALL LES_FLUX_ll ( XU_ANOM, ZTHV_ANOM, &
- OMASK, &
- XLES_RESOLVED_UThv (:,NLES_CURRENT_TCOUNT,IMASK) )
-!
- CALL LES_FLUX_ll ( XV_ANOM, ZTHV_ANOM, &
- OMASK, &
- XLES_RESOLVED_VThv (:,NLES_CURRENT_TCOUNT,IMASK) )
-!
- CALL LES_FLUX_ll ( XW_ANOM, ZTHV_ANOM, &
- OMASK, &
- XLES_RESOLVED_WThv (:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* vapor mixing ratio fluxes
-!
- CALL LES_FLUX_ll ( XU_ANOM, ZRV_ANOM, &
- OMASK, &
- XLES_RESOLVED_URv (:,NLES_CURRENT_TCOUNT,IMASK) )
-!
- CALL LES_FLUX_ll ( XV_ANOM, ZRV_ANOM, &
- OMASK, &
- XLES_RESOLVED_VRv (:,NLES_CURRENT_TCOUNT,IMASK) )
-!
- CALL LES_FLUX_ll ( XW_ANOM, ZRV_ANOM, &
- OMASK, &
- XLES_RESOLVED_WRv (:,NLES_CURRENT_TCOUNT,IMASK) )
- END IF
-!
-!* cloud water mixing ratio fluxes
-!
- IF (LUSERC) THEN
- CALL LES_FLUX_ll ( XU_ANOM, ZRC_ANOM, &
- OMASK, &
- XLES_RESOLVED_URc (:,NLES_CURRENT_TCOUNT,IMASK) )
-!
- CALL LES_FLUX_ll ( XV_ANOM, ZRC_ANOM, &
- OMASK, &
- XLES_RESOLVED_VRc (:,NLES_CURRENT_TCOUNT,IMASK) )
-!
- CALL LES_FLUX_ll ( XW_ANOM, ZRC_ANOM, &
- OMASK, &
- XLES_RESOLVED_WRc (:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* liquid theta fluxes
-!
- CALL LES_FLUX_ll ( XU_ANOM, XTHL_ANOM, &
- OMASK, &
- XLES_RESOLVED_UThl (:,NLES_CURRENT_TCOUNT,IMASK) )
-!
- CALL LES_FLUX_ll ( XV_ANOM, XTHL_ANOM, &
- OMASK, &
- XLES_RESOLVED_VThl (:,NLES_CURRENT_TCOUNT,IMASK) )
-!
- CALL LES_FLUX_ll ( XW_ANOM, XTHL_ANOM, &
- OMASK, &
- XLES_RESOLVED_WThl (:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* total water mixing ratio fluxes
-!
- CALL LES_FLUX_ll ( XW_ANOM, XRT_ANOM, &
- OMASK, &
- XLES_RESOLVED_WRt (:,NLES_CURRENT_TCOUNT,IMASK) )
- END IF
-!
-!* cloud ice mixing ratio fluxes
-!
- IF (LUSERI) THEN
- CALL LES_FLUX_ll ( XU_ANOM, ZRI_ANOM, &
- OMASK, &
- XLES_RESOLVED_URi (:,NLES_CURRENT_TCOUNT,IMASK) )
-!
- CALL LES_FLUX_ll ( XV_ANOM, ZRI_ANOM, &
- OMASK, &
- XLES_RESOLVED_VRi (:,NLES_CURRENT_TCOUNT,IMASK) )
-!
- CALL LES_FLUX_ll ( XW_ANOM, ZRI_ANOM, &
- OMASK, &
- XLES_RESOLVED_WRi (:,NLES_CURRENT_TCOUNT,IMASK) )
- END IF
- IF (LUSERR) THEN
- CALL LES_FLUX_ll ( XW_ANOM, ZRR_ANOM, &
- OMASK, &
- XLES_RESOLVED_WRr (:,NLES_CURRENT_TCOUNT,IMASK) )
- END IF
-!
-
-!
-!* scalar variables fluxes
-!
- DO JSV=1,NSV
- CALL LES_FLUX_ll ( XU_ANOM, XSV_ANOM(:,:,:,JSV), &
- OMASK, &
- XLES_RESOLVED_USv (:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
-!
- CALL LES_FLUX_ll ( XV_ANOM, XSV_ANOM(:,:,:,JSV), &
- OMASK, &
- XLES_RESOLVED_VSv (:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
-!
- CALL LES_FLUX_ll ( XW_ANOM, XSV_ANOM(:,:,:,JSV), &
- OMASK, &
- XLES_RESOLVED_WSv (:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
- END DO
-!
-!* skewness
-!
- CALL LES_3RD_MOMENT_ll ( XU_ANOM, XU_ANOM, XU_ANOM, &
- OMASK, &
- XLES_RESOLVED_U3 (:,NLES_CURRENT_TCOUNT,IMASK) )
-
- CALL LES_3RD_MOMENT_ll ( XV_ANOM, XV_ANOM, XV_ANOM, &
- OMASK, &
- XLES_RESOLVED_V3 (:,NLES_CURRENT_TCOUNT,IMASK) )
-
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, XW_ANOM, XW_ANOM, &
- OMASK, &
- XLES_RESOLVED_W3 (:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* kurtosis
-!
- CALL LES_4TH_MOMENT_ll ( XU_ANOM, XU_ANOM, XU_ANOM, XU_ANOM, &
- OMASK, &
- XLES_RESOLVED_U4 (:,NLES_CURRENT_TCOUNT,IMASK) )
-
- CALL LES_4TH_MOMENT_ll ( XV_ANOM, XV_ANOM, XV_ANOM, XV_ANOM, &
- OMASK, &
- XLES_RESOLVED_V4 (:,NLES_CURRENT_TCOUNT,IMASK) )
-
- CALL LES_4TH_MOMENT_ll ( XW_ANOM, XW_ANOM, XW_ANOM, XW_ANOM, &
- OMASK, &
- XLES_RESOLVED_W4 (:,NLES_CURRENT_TCOUNT,IMASK) )
-!
-!* third moments of liquid potential temperature
-!
- IF (LUSERC) THEN
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, XTHL_ANOM, XTHL_ANOM, &
- OMASK, &
- XLES_RESOLVED_WThl2(:,NLES_CURRENT_TCOUNT,IMASK) )
-
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, XW_ANOM, XTHL_ANOM, &
- OMASK, &
- XLES_RESOLVED_W2Thl(:,NLES_CURRENT_TCOUNT,IMASK) )
-
- ELSE
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, ZTH_ANOM, ZTH_ANOM, &
- OMASK, &
- XLES_RESOLVED_WThl2(:,NLES_CURRENT_TCOUNT,IMASK) )
-
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, XW_ANOM, ZTH_ANOM, &
- OMASK, &
- XLES_RESOLVED_W2Thl(:,NLES_CURRENT_TCOUNT,IMASK) )
- END IF
-!
-!* third moments of water vapor
-!
- IF (LUSERV) THEN
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, ZRV_ANOM, ZRV_ANOM, &
- OMASK, &
- XLES_RESOLVED_WRv2 (:,NLES_CURRENT_TCOUNT,IMASK) )
-
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, XW_ANOM, ZRV_ANOM, &
- OMASK, &
- XLES_RESOLVED_W2Rv (:,NLES_CURRENT_TCOUNT,IMASK) )
- END IF
-
- IF (LUSERC) THEN
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, XTHL_ANOM, ZRV_ANOM, &
- OMASK, &
- XLES_RESOLVED_WThlRv(:,NLES_CURRENT_TCOUNT,IMASK) )
- ELSE IF (LUSERV) THEN
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, ZTH_ANOM, ZRV_ANOM, &
- OMASK, &
- XLES_RESOLVED_WThlRv(:,NLES_CURRENT_TCOUNT,IMASK) )
- END IF
-!
-!* third moments of total water
-!
- IF (LUSERC) THEN
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, XRT_ANOM, XRT_ANOM, &
- OMASK, &
- XLES_RESOLVED_WRt2 (:,NLES_CURRENT_TCOUNT,IMASK) )
-
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, XW_ANOM, XRT_ANOM, &
- OMASK, &
- XLES_RESOLVED_W2Rt (:,NLES_CURRENT_TCOUNT,IMASK) )
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, XTHL_ANOM, XRT_ANOM, &
- OMASK, &
- XLES_RESOLVED_WThlRt (:,NLES_CURRENT_TCOUNT,IMASK) )
- ELSE IF (LUSERV) THEN
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, ZRV_ANOM, ZRV_ANOM, &
- OMASK, &
- XLES_RESOLVED_WRt2 (:,NLES_CURRENT_TCOUNT,IMASK) )
-
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, XW_ANOM, ZRV_ANOM, &
- OMASK, &
- XLES_RESOLVED_W2Rt (:,NLES_CURRENT_TCOUNT,IMASK) )
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, ZTH_ANOM, ZRV_ANOM, &
- OMASK, &
- XLES_RESOLVED_WThlRt (:,NLES_CURRENT_TCOUNT,IMASK) )
- END IF
-!
-!* third moments of cloud water
-!
- IF (LUSERC) THEN
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, ZRC_ANOM, ZRC_ANOM, &
- OMASK, &
- XLES_RESOLVED_WRc2 (:,NLES_CURRENT_TCOUNT,IMASK) )
-
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, XW_ANOM, ZRC_ANOM, &
- OMASK, &
- XLES_RESOLVED_W2Rc (:,NLES_CURRENT_TCOUNT,IMASK) )
-
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, XTHL_ANOM, ZRC_ANOM, &
- OMASK, &
- XLES_RESOLVED_WThlRc(:,NLES_CURRENT_TCOUNT,IMASK) )
-
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, ZRV_ANOM, ZRC_ANOM, &
- OMASK, &
- XLES_RESOLVED_WRvRc (:,NLES_CURRENT_TCOUNT,IMASK) )
- END IF
-!
-!* third moments of cloud ice
-!
- IF (LUSERI) THEN
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, ZRI_ANOM, ZRI_ANOM, &
- OMASK, &
- XLES_RESOLVED_WRi2 (:,NLES_CURRENT_TCOUNT,IMASK) )
-
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, XW_ANOM, ZRI_ANOM, &
- OMASK, &
- XLES_RESOLVED_W2Ri (:,NLES_CURRENT_TCOUNT,IMASK) )
-
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, XTHL_ANOM, ZRI_ANOM, &
- OMASK, &
- XLES_RESOLVED_WThlRi(:,NLES_CURRENT_TCOUNT,IMASK) )
-
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, ZRV_ANOM, ZRI_ANOM, &
- OMASK, &
- XLES_RESOLVED_WRvRi (:,NLES_CURRENT_TCOUNT,IMASK) )
- END IF
-!
-!* third moments of scalar variables
-!
- DO JSV=1,NSV
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, XSV_ANOM(:,:,:,JSV), XSV_ANOM(:,:,:,JSV), &
- OMASK, &
- XLES_RESOLVED_WSv2 (:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
-
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, XW_ANOM, XSV_ANOM(:,:,:,JSV), &
- OMASK, &
- XLES_RESOLVED_W2Sv (:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
- IF (LUSERC) THEN
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, XTHL_ANOM, XSV_ANOM(:,:,:,JSV), &
- OMASK, &
- XLES_RESOLVED_WThlSv(:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
- ELSE
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, ZTH_ANOM, XSV_ANOM(:,:,:,JSV), &
- OMASK, &
- XLES_RESOLVED_WThlSv(:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
- END IF
-
- IF (LUSERV) THEN
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, ZRV_ANOM, XSV_ANOM(:,:,:,JSV), &
- OMASK, &
- XLES_RESOLVED_WRvSv (:,NLES_CURRENT_TCOUNT,IMASK,JSV) )
- END IF
- END DO
-!
-!* presso-correlations
-!
-!
- CALL LES_FLUX_ll ( XTHL_ANOM, ZDPDZ_ANOM, &
- OMASK, &
- XLES_RESOLVED_ThlPz(:,NLES_CURRENT_TCOUNT,IMASK) )
-
- IF (LUSERV) &
- CALL LES_FLUX_ll ( ZRV_ANOM, ZDPDZ_ANOM, &
- OMASK, &
- XLES_RESOLVED_RvPz(:,NLES_CURRENT_TCOUNT,IMASK) )
-
- IF (LUSERC) THEN
- CALL LES_FLUX_ll ( XRT_ANOM, ZDPDZ_ANOM, &
- OMASK, &
- XLES_RESOLVED_RtPz(:,NLES_CURRENT_TCOUNT,IMASK) )
-
- CALL LES_FLUX_ll ( ZRC_ANOM, ZDPDZ_ANOM, &
- OMASK, &
- XLES_RESOLVED_RcPz(:,NLES_CURRENT_TCOUNT,IMASK) )
- END IF
-
- IF (LUSERI) &
- CALL LES_FLUX_ll ( ZRI_ANOM, ZDPDZ_ANOM, &
- OMASK, &
- XLES_RESOLVED_RiPz(:,NLES_CURRENT_TCOUNT,IMASK) )
-
-!
-!
-!* resolved turbulent kinetic energy fluxes
-!
-
- CALL LES_3RD_MOMENT_ll ( XU_ANOM, XU_ANOM, XU_ANOM, &
- OMASK, &
- ZLES_RESOLVED_U3 (:) )
-
- CALL LES_3RD_MOMENT_ll ( XU_ANOM, XV_ANOM, XV_ANOM, &
- OMASK, &
- ZLES_RESOLVED_UV2 (:) )
-
- CALL LES_3RD_MOMENT_ll ( XU_ANOM, XW_ANOM, XW_ANOM, &
- OMASK, &
- ZLES_RESOLVED_UW2 (:) )
-
- XLES_RESOLVED_UKe(:,NLES_CURRENT_TCOUNT,IMASK) = 0.5*( ZLES_RESOLVED_U3 &
- + ZLES_RESOLVED_UV2 &
- + ZLES_RESOLVED_UW2 )
-
-
-
- CALL LES_3RD_MOMENT_ll ( XV_ANOM, XU_ANOM, XU_ANOM, &
- OMASK, &
- ZLES_RESOLVED_VU2 (:) )
-
- CALL LES_3RD_MOMENT_ll ( XV_ANOM, XV_ANOM, XV_ANOM, &
- OMASK, &
- ZLES_RESOLVED_V3 (:) )
-
- CALL LES_3RD_MOMENT_ll ( XV_ANOM, XW_ANOM, XW_ANOM, &
- OMASK, &
- ZLES_RESOLVED_VW2 (:) )
-
- XLES_RESOLVED_VKe(:,NLES_CURRENT_TCOUNT,IMASK) = 0.5*( ZLES_RESOLVED_VU2 &
- + ZLES_RESOLVED_V3 &
- + ZLES_RESOLVED_VW2 )
-
-
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, XU_ANOM, XU_ANOM, &
- OMASK, &
- ZLES_RESOLVED_WU2 (:) )
-
- CALL LES_3RD_MOMENT_ll ( XW_ANOM, XV_ANOM, XV_ANOM, &
- OMASK, &
- ZLES_RESOLVED_WV2 (:) )
-
- XLES_RESOLVED_WKe(:,NLES_CURRENT_TCOUNT,IMASK) = 0.5*( ZLES_RESOLVED_WU2 &
- + ZLES_RESOLVED_WV2 &
- + XLES_RESOLVED_W3(:,NLES_CURRENT_TCOUNT,IMASK) )
-
-!
-!
-!-------------------------------------------------------------------------------
-!
-! 1.6 Subgrid quantities
-! ------------------
-!
-IF (LLES_SUBGRID) THEN
-!
-!* wind fluxes and variances
-!
- CALL LES_MEAN_ll ( ZTKE_LES, OMASK, &
- XLES_SUBGRID_Tke(:,NLES_CURRENT_TCOUNT,IMASK) )
-
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_UV(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_WU(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_WV(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_U2(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_V2(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_W2(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-!
-!
-!* liquid potential temperature fluxes
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_UThl(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_VThl(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_WThl(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-!
-
-!* liquid potential temperature variance
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_Thl2(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-!
-!* Mass flux scheme of shallow convection
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_THLUP_MF(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_RTUP_MF(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_RVUP_MF(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_RCUP_MF(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_RIUP_MF(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_WUP_MF(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_MASSFLUX(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_DETR(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_ENTR(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_FRACUP(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_THVUP_MF(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_WTHLMF(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_WRTMF(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_WTHVMF(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_WUMF(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_WVMF(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
-
-!* total water mixing ratio fluxes, correlation and variance
-!
- IF (LUSERV) THEN
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_URt(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
- !
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_VRt(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
- !
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_WRt(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
- !
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_ThlRt(:,NLES_CURRENT_TCOUNT,IMASK),&
- IAVG_PTS(:), IUND_PTS(:) )
- !
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_Rt2(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
- END IF
-!
-!* scalar variances
-!
- DO JSV=1,NSV
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_Sv2(:,NLES_CURRENT_TCOUNT,IMASK,JSV), &
- IAVG_PTS(:), IUND_PTS(:) )
- END DO
-!
-!* cloud water mixing ratio fluxes
-!
- IF (LUSERC) THEN
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_URc(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
- !
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_VRc(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
- !
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_WRc(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
- END IF
-!
-!* scalar variables fluxes
-!
- DO JSV=1,NSV
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_USv(:,NLES_CURRENT_TCOUNT,IMASK,JSV), &
- IAVG_PTS(:), IUND_PTS(:) )
- !
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_VSv(:,NLES_CURRENT_TCOUNT,IMASK,JSV), &
- IAVG_PTS(:), IUND_PTS(:) )
- !
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_WSv(:,NLES_CURRENT_TCOUNT,IMASK,JSV), &
- IAVG_PTS(:), IUND_PTS(:) )
- END DO
-!
-!* subgrid turbulent kinetic energy fluxes
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_UTke(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
- !
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_VTke(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
- !
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_WTke(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_ddz_WTke(:,NLES_CURRENT_TCOUNT,IMASK),&
- IAVG_PTS(:), IUND_PTS(:) )
-!
-!* fluxes and correlations with virtual potential temperature
-!
- IF (LUSERV) THEN
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_WThv(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_ThlThv(:,NLES_CURRENT_TCOUNT,IMASK),&
- IAVG_PTS(:), IUND_PTS(:) )
-
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_RtThv(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- DO JSV=1,NSV
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_SvThv(:,NLES_CURRENT_TCOUNT,IMASK,JSV), &
- IAVG_PTS(:), IUND_PTS(:) )
- END DO
- END IF
-!
-!* third order fluxes
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_W2Thl(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_WThl2(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- IF (LUSERV) THEN
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_W2Rt(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_WThlRt(:,NLES_CURRENT_TCOUNT,IMASK),&
- IAVG_PTS(:), IUND_PTS(:) )
-
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_WRt2(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- END IF
- DO JSV=1,NSV
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_W2Sv(:,NLES_CURRENT_TCOUNT,IMASK,JSV), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_WSv2(:,NLES_CURRENT_TCOUNT,IMASK,JSV), &
- IAVG_PTS(:), IUND_PTS(:) )
- END DO
-!
-!* dissipative terms
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_DISS_Tke(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_DISS_Thl2(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- IF (LUSERV) THEN
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_DISS_Rt2(:,NLES_CURRENT_TCOUNT,IMASK),&
- IAVG_PTS(:), IUND_PTS(:) )
-
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_DISS_ThlRt(:,NLES_CURRENT_TCOUNT,IMASK),&
- IAVG_PTS(:), IUND_PTS(:) )
- END IF
-
- DO JSV=1,NSV
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_DISS_Sv2(:,NLES_CURRENT_TCOUNT,IMASK,JSV), &
- IAVG_PTS(:), IUND_PTS(:) )
- END DO
-!
-!* presso-correlation terms
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_WP(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_ThlPz(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- IF (LUSERV) THEN
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_RtPz(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- END IF
-
- DO JSV=1,NSV
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_SvPz(:,NLES_CURRENT_TCOUNT,IMASK,JSV), &
- IAVG_PTS(:), IUND_PTS(:) )
- END DO
-
-!* phi3 and psi3 terms
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_PHI3(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- IF (LUSERV) THEN
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_PSI3(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
- END IF
-!
-!* subgrid mixing length
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_LMix(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-!
-!* subgrid dissipative length
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_LDiss(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-!
-!* eddy diffusivities
-!
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_Km(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- CALL LES_MEAN_MPROC ( XLES_SUBGRID_Kh(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
-END IF
-!
-! computation of KHT and KHR depending on LLES
- IF (LUSERC) THEN
- IF (LLES_RESOLVED) THEN
- XLES_MEAN_KHt(:,NLES_CURRENT_TCOUNT,IMASK)=0.
- WHERE(XLES_MEAN_DTHLDZ(:,NLES_CURRENT_TCOUNT,IMASK)/=0) &
- XLES_MEAN_KHt(:,NLES_CURRENT_TCOUNT,IMASK)=-1. &
- *XLES_RESOLVED_WThl (:,NLES_CURRENT_TCOUNT,IMASK)/ &
- XLES_MEAN_DTHLDZ(:,NLES_CURRENT_TCOUNT,IMASK)
- XLES_MEAN_KHr(:,NLES_CURRENT_TCOUNT,IMASK)=0.
- WHERE(XLES_MEAN_DRtDZ(:,NLES_CURRENT_TCOUNT,IMASK)/=0) &
- XLES_MEAN_KHr(:,NLES_CURRENT_TCOUNT,IMASK)=-1.* &
- XLES_RESOLVED_WRt (:,NLES_CURRENT_TCOUNT,IMASK)/ &
- XLES_MEAN_DRtDZ(:,NLES_CURRENT_TCOUNT,IMASK)
- END IF
- IF (LLES_SUBGRID) THEN
- XLES_MEAN_KHt(:,NLES_CURRENT_TCOUNT,IMASK)=0.
- WHERE(XLES_MEAN_DTHLDZ(:,NLES_CURRENT_TCOUNT,IMASK)/=0) &
- XLES_MEAN_KHt(:,NLES_CURRENT_TCOUNT,IMASK)=-1. &
- *XLES_SUBGRID_WThl (:,NLES_CURRENT_TCOUNT,IMASK) / &
- XLES_MEAN_DTHLDZ(:,NLES_CURRENT_TCOUNT,IMASK)
- XLES_MEAN_KHr(:,NLES_CURRENT_TCOUNT,IMASK)=0.
- WHERE(XLES_MEAN_DRtDZ(:,NLES_CURRENT_TCOUNT,IMASK)/=0) &
- XLES_MEAN_KHr(:,NLES_CURRENT_TCOUNT,IMASK)=-1.* &
- XLES_SUBGRID_WRt (:,NLES_CURRENT_TCOUNT,IMASK) / &
- XLES_MEAN_DRtDZ(:,NLES_CURRENT_TCOUNT,IMASK)
- END IF
- IF (LLES_RESOLVED .AND. LLES_SUBGRID) THEN
- XLES_MEAN_KHt(:,NLES_CURRENT_TCOUNT,IMASK)=0.
- WHERE(XLES_MEAN_DTHLDZ(:,NLES_CURRENT_TCOUNT,IMASK)/=0) &
- XLES_MEAN_KHt(:,NLES_CURRENT_TCOUNT,IMASK)=-1. &
- *(XLES_RESOLVED_WThl (:,NLES_CURRENT_TCOUNT,IMASK)+ &
- XLES_SUBGRID_WThl (:,NLES_CURRENT_TCOUNT,IMASK))/ &
- XLES_MEAN_DTHLDZ(:,NLES_CURRENT_TCOUNT,IMASK)
- XLES_MEAN_KHr(:,NLES_CURRENT_TCOUNT,IMASK)=0.
- WHERE(XLES_MEAN_DRtDZ(:,NLES_CURRENT_TCOUNT,IMASK)/=0) &
- XLES_MEAN_KHr(:,NLES_CURRENT_TCOUNT,IMASK)=-1.* &
- (XLES_RESOLVED_WRt (:,NLES_CURRENT_TCOUNT,IMASK)+ &
- XLES_SUBGRID_WRt (:,NLES_CURRENT_TCOUNT,IMASK)) / &
- XLES_MEAN_DRtDZ(:,NLES_CURRENT_TCOUNT,IMASK)
- END IF
- END IF
-!-------------------------------------------------------------------------------
-!
-! 1.7 Interaction of subgrid and resolved quantities
-! ----------------------------------------------
-!
-!* WARNING: these terms also contain the term due to the mean flow.
-! this mean flow contribution will be removed from them
-! when treated in write_les_budgetn.f90
-!
-!
-!* subgrid turbulent kinetic energy fluxes
-!
-IF (LLES_RESOLVED) THEN
- CALL LES_FLUX_ll ( XU_ANOM, ZTKE_LES, &
- OMASK, &
- XLES_RES_U_SBG_Tke(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
- CALL LES_FLUX_ll ( XV_ANOM, ZTKE_LES, &
- OMASK, &
- XLES_RES_V_SBG_Tke(:,NLES_CURRENT_TCOUNT,IMASK) )
-!
- CALL LES_FLUX_ll ( XW_ANOM, ZTKE_LES, &
- OMASK, &
- XLES_RES_W_SBG_Tke(:,NLES_CURRENT_TCOUNT,IMASK) )
-END IF
-!
-!* WARNING: these terms also contain the term due to the mean flow.
-! this mean flow contribution will be removed from them
-! when treated in write_les_budgetn.f90
-!
-!* production terms for subgrid quantities
-!
-IF (LLES_RESOLVED .AND. LLES_SUBGRID) THEN
- CALL LES_MEAN_MPROC ( XLES_RES_ddxa_U_SBG_UaU(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- CALL LES_MEAN_MPROC ( XLES_RES_ddxa_V_SBG_UaV(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- CALL LES_MEAN_MPROC ( XLES_RES_ddxa_W_SBG_UaW(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- CALL LES_MEAN_MPROC ( XLES_RES_ddxa_W_SBG_UaThl(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- CALL LES_MEAN_MPROC ( XLES_RES_ddxa_Thl_SBG_UaW(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- CALL LES_MEAN_MPROC ( XLES_RES_ddz_Thl_SBG_W2 (:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- CALL LES_MEAN_MPROC ( XLES_RES_ddxa_Thl_SBG_UaThl(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- IF (LUSERV) THEN
- CALL LES_MEAN_MPROC ( XLES_RES_ddxa_W_SBG_UaRt(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- CALL LES_MEAN_MPROC ( XLES_RES_ddxa_Rt_SBG_UaW(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- CALL LES_MEAN_MPROC ( XLES_RES_ddz_Rt_SBG_W2 (:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- CALL LES_MEAN_MPROC ( XLES_RES_ddxa_Thl_SBG_UaRt(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- CALL LES_MEAN_MPROC ( XLES_RES_ddxa_Rt_SBG_UaThl(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- CALL LES_MEAN_MPROC ( XLES_RES_ddxa_Rt_SBG_UaRt(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- END IF
-!
-!* WARNING: these terms also contain the term due to the mean flow.
-! this mean flow contribution will be removed from them
-! when treated in write_les_budgetn.f90
-!
-!* turbulent transport and advection terms for subgrid quantities
-!
- CALL LES_MEAN_MPROC ( XLES_RES_W_SBG_WThl(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- CALL LES_MEAN_MPROC ( XLES_RES_W_SBG_Thl2(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- IF (LUSERV) THEN
- CALL LES_MEAN_MPROC ( XLES_RES_W_SBG_WRt(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- CALL LES_MEAN_MPROC ( XLES_RES_W_SBG_Rt2(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- CALL LES_MEAN_MPROC ( XLES_RES_W_SBG_ThlRt(:,NLES_CURRENT_TCOUNT,IMASK), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- END IF
-
- DO JSV=1,NSV
- CALL LES_MEAN_MPROC ( XLES_RES_W_SBG_WSv(:,NLES_CURRENT_TCOUNT,IMASK,JSV), &
- IAVG_PTS(:), IUND_PTS(:) )
-
- CALL LES_MEAN_MPROC ( XLES_RES_W_SBG_Sv2(:,NLES_CURRENT_TCOUNT,IMASK,JSV), &
- IAVG_PTS(:), IUND_PTS(:) )
- END DO
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-! 2. The following is for cartesian mask only
-! ----------------------------------------
-!
-IF (IMASK>1) RETURN
-!
-!-------------------------------------------------------------------------------
-!
-! 3. Updraft diagnostics
-! -------------------
-!
-IF (LLES_UPDRAFT) THEN
-!
- DO JK=1,NLES_K
- GUPDRAFT_MASK(:,:,JK) = (XW_ANOM(:,:,JK) > 0.) .AND. LLES_CURRENT_CART_MASK(:,:,JK)
- END DO
-!
-!
-! 3.1 Updraft fraction
-! ----------------
-!
- ZUPDRAFT(:,:,:) = 0.
- WHERE (GUPDRAFT_MASK(:,:,:))
- ZUPDRAFT(:,:,:) = 1.
- END WHERE
-!
- CALL LES_MEAN_ll ( ZUPDRAFT, OMASK, &
- XLES_UPDRAFT(:,NLES_CURRENT_TCOUNT) )
-!
-!
-! 3.2 Updraft mean quantities
-! -----------------------
-!
-!* vertical wind velocity
-!
- CALL LES_MEAN_ll ( ZW_LES, GUPDRAFT_MASK, &
- XLES_UPDRAFT_W(:,NLES_CURRENT_TCOUNT) )
-!
-!* potential temperature
-!
- CALL LES_MEAN_ll ( ZTH_LES, GUPDRAFT_MASK, &
- XLES_UPDRAFT_Th(:,NLES_CURRENT_TCOUNT) )
-!
-!* liquid potential temperature
-!
- IF (LUSERC) &
- CALL LES_MEAN_ll ( ZTHL_LES, GUPDRAFT_MASK, &
- XLES_UPDRAFT_Thl(:,NLES_CURRENT_TCOUNT) )
-!
-!* virtual potential temperature
-!
- IF (LUSERV) &
- CALL LES_MEAN_ll ( ZTHV_LES, GUPDRAFT_MASK, &
- XLES_UPDRAFT_Thv(:,NLES_CURRENT_TCOUNT) )
-!
-!* vapor mixing ratio
-!
- IF (LUSERV) &
- CALL LES_MEAN_ll ( ZRV_LES, GUPDRAFT_MASK, &
- XLES_UPDRAFT_Rv(:,NLES_CURRENT_TCOUNT) )
-!
-!* cloud water mixing ratio
-!
- IF (LUSERC) &
- CALL LES_MEAN_ll ( ZRC_LES, GUPDRAFT_MASK, &
- XLES_UPDRAFT_Rc(:,NLES_CURRENT_TCOUNT) )
-!
-!* rain mixing ratio
-!
- IF (LUSERR) &
- CALL LES_MEAN_ll ( ZRR_LES, GUPDRAFT_MASK, &
- XLES_UPDRAFT_Rr(:,NLES_CURRENT_TCOUNT) )
-!
-!* cloud ice mixing ratio
-!
- IF (LUSERI) &
- CALL LES_MEAN_ll ( ZRI_LES, GUPDRAFT_MASK, &
- XLES_UPDRAFT_Ri(:,NLES_CURRENT_TCOUNT) )
-!
-!* snow mixing ratio
-!
- IF (LUSERS) &
- CALL LES_MEAN_ll ( ZRS_LES, GUPDRAFT_MASK, &
- XLES_UPDRAFT_Rs(:,NLES_CURRENT_TCOUNT) )
-!
-!* graupel mixing ratio
-!
- IF (LUSERG) &
- CALL LES_MEAN_ll ( ZRG_LES, GUPDRAFT_MASK, &
- XLES_UPDRAFT_Rg(:,NLES_CURRENT_TCOUNT) )
-!
-!* hail mixing ratio
-!
- IF (LUSERH) &
- CALL LES_MEAN_ll ( ZRG_LES, GUPDRAFT_MASK, &
- XLES_UPDRAFT_Rh(:,NLES_CURRENT_TCOUNT) )
-!
-!* scalar variables
-!
- DO JSV=1,NSV
- CALL LES_MEAN_ll ( ZSV_LES(:,:,:,JSV), GUPDRAFT_MASK, &
- XLES_UPDRAFT_Sv(:,NLES_CURRENT_TCOUNT,JSV) )
- END DO
-!
-!* subgrid turbulent kinetic energy
-!
- CALL LES_MEAN_ll ( ZTKE_LES, GUPDRAFT_MASK, &
- XLES_UPDRAFT_Tke(:,NLES_CURRENT_TCOUNT) )
-!
-!
-! 3.3 Updraft resolved quantities
-! ---------------------------
-!
-!
-!* resolved turbulent kinetic energy
-!
- CALL LES_FLUX_ll ( XU_ANOM, XU_ANOM, &
- GUPDRAFT_MASK, &
- ZLES_UPDRAFT_U2(:) )
-
- CALL LES_FLUX_ll ( XV_ANOM, XV_ANOM, &
- GUPDRAFT_MASK, &
- ZLES_UPDRAFT_V2(:) )
-
- CALL LES_FLUX_ll ( XW_ANOM, XW_ANOM, &
- GUPDRAFT_MASK, &
- ZLES_UPDRAFT_W2(:) )
-
- XLES_UPDRAFT_Ke(:,NLES_CURRENT_TCOUNT) = 0.5 * ( ZLES_UPDRAFT_U2(:) &
- + ZLES_UPDRAFT_V2(:) &
- + ZLES_UPDRAFT_W2(:) )
-!
-!* vertical potential temperature flux
-!
- CALL LES_FLUX_ll ( XW_ANOM, ZTH_ANOM, &
- GUPDRAFT_MASK, &
- XLES_UPDRAFT_WTh(:,NLES_CURRENT_TCOUNT) )
-!
-!* vertical liquid potential temperature flux
-!
- IF (LUSERC) &
- CALL LES_FLUX_ll ( XW_ANOM, XTHL_ANOM, &
- GUPDRAFT_MASK, &
- XLES_UPDRAFT_WThl(:,NLES_CURRENT_TCOUNT) )
-!
-!* vertical virtual potential temperature flux
-!
- IF (LUSERV) &
- CALL LES_FLUX_ll ( XW_ANOM, ZTHV_ANOM, &
- GUPDRAFT_MASK, &
- XLES_UPDRAFT_WThv(:,NLES_CURRENT_TCOUNT) )
-!
-!* potential temperature variance
-!
- CALL LES_FLUX_ll ( ZTH_ANOM, ZTH_ANOM, &
- GUPDRAFT_MASK, &
- XLES_UPDRAFT_Th2(:,NLES_CURRENT_TCOUNT) )
-!
-!* liquid potential temperature variance
-!
- IF (LUSERC) &
- CALL LES_FLUX_ll ( XTHL_ANOM, XTHL_ANOM, &
- GUPDRAFT_MASK, &
- XLES_UPDRAFT_Thl2(:,NLES_CURRENT_TCOUNT) )
-!
-!* potential temperature - virtual potential temperature covariance
-!
- IF (LUSERV) &
- CALL LES_FLUX_ll ( ZTH_ANOM, ZTHV_ANOM, &
- GUPDRAFT_MASK, &
- XLES_UPDRAFT_ThThv (:,NLES_CURRENT_TCOUNT) )
-!
-!* liquid potential temperature - virtual potential temperature covariance
-!
- IF (LUSERC) &
- CALL LES_FLUX_ll ( XTHL_ANOM, ZTHV_ANOM, &
- GUPDRAFT_MASK, &
- XLES_UPDRAFT_ThlThv(:,NLES_CURRENT_TCOUNT) )
-!
-!* water vapor mixing ratio flux, variance and correlations
-!
- IF (LUSERV) THEN
- CALL LES_FLUX_ll ( XW_ANOM, ZRV_ANOM, &
- GUPDRAFT_MASK, &
- XLES_UPDRAFT_WRv(:,NLES_CURRENT_TCOUNT) )
- !
- CALL LES_FLUX_ll ( ZRV_ANOM, ZRV_ANOM, &
- GUPDRAFT_MASK, &
- XLES_UPDRAFT_Rv2(:,NLES_CURRENT_TCOUNT) )
- !
- CALL LES_FLUX_ll ( ZTH_ANOM, ZRV_ANOM, &
- GUPDRAFT_MASK, &
- XLES_UPDRAFT_ThRv (:,NLES_CURRENT_TCOUNT) )
- !
- IF (LUSERC) &
- CALL LES_FLUX_ll ( XTHL_ANOM, ZRV_ANOM, &
- GUPDRAFT_MASK, &
- XLES_UPDRAFT_ThlRv(:,NLES_CURRENT_TCOUNT) )
-
- CALL LES_FLUX_ll ( ZTHV_ANOM, ZRV_ANOM, &
- GUPDRAFT_MASK, &
- XLES_UPDRAFT_ThvRv(:,NLES_CURRENT_TCOUNT) )
- END IF
-!
-!* cloud water mixing ratio flux
-!
- IF (LUSERC) THEN
- CALL LES_FLUX_ll ( XW_ANOM, ZRC_ANOM, &
- GUPDRAFT_MASK, &
- XLES_UPDRAFT_WRc(:,NLES_CURRENT_TCOUNT) )
- !
- CALL LES_FLUX_ll ( ZRC_ANOM, ZRC_ANOM, &
- GUPDRAFT_MASK, &
- XLES_UPDRAFT_Rc2(:,NLES_CURRENT_TCOUNT) )
- !
- CALL LES_FLUX_ll ( ZTH_ANOM, ZRC_ANOM, &
- GUPDRAFT_MASK, &
- XLES_UPDRAFT_ThRc (:,NLES_CURRENT_TCOUNT) )
- !
- CALL LES_FLUX_ll ( XTHL_ANOM, ZRC_ANOM, &
- GUPDRAFT_MASK, &
- XLES_UPDRAFT_ThlRc(:,NLES_CURRENT_TCOUNT) )
- !
- CALL LES_FLUX_ll ( ZTHV_ANOM, ZRC_ANOM, &
- GUPDRAFT_MASK, &
- XLES_UPDRAFT_ThvRc(:,NLES_CURRENT_TCOUNT) )
- END IF
-!
-!* cloud ice mixing ratio flux
-!
- IF (LUSERI) THEN
- CALL LES_FLUX_ll ( XW_ANOM, ZRI_ANOM, &
- GUPDRAFT_MASK, &
- XLES_UPDRAFT_WRi(:,NLES_CURRENT_TCOUNT) )
- !
- CALL LES_FLUX_ll ( ZRI_ANOM, ZRI_ANOM, &
- GUPDRAFT_MASK, &
- XLES_UPDRAFT_Ri2(:,NLES_CURRENT_TCOUNT) )
- !
- CALL LES_FLUX_ll ( ZTH_ANOM, ZRI_ANOM, &
- GUPDRAFT_MASK, &
- XLES_UPDRAFT_ThRi (:,NLES_CURRENT_TCOUNT) )
- !
- CALL LES_FLUX_ll ( XTHL_ANOM, ZRI_ANOM, &
- GUPDRAFT_MASK, &
- XLES_UPDRAFT_ThlRi(:,NLES_CURRENT_TCOUNT) )
- !
- CALL LES_FLUX_ll ( ZTHV_ANOM, ZRI_ANOM, &
- GUPDRAFT_MASK, &
- XLES_UPDRAFT_ThvRi(:,NLES_CURRENT_TCOUNT) )
- END IF
-!
-!* scalar variables flux
-!
- DO JSV=1,NSV
- CALL LES_FLUX_ll ( XW_ANOM, XSV_ANOM(:,:,:,JSV), &
- GUPDRAFT_MASK, &
- XLES_UPDRAFT_WSv(:,NLES_CURRENT_TCOUNT,JSV) )
- !
- CALL LES_FLUX_ll ( XSV_ANOM(:,:,:,JSV), XSV_ANOM(:,:,:,JSV), &
- GUPDRAFT_MASK, &
- XLES_UPDRAFT_Sv2(:,NLES_CURRENT_TCOUNT,JSV) )
- !
- CALL LES_FLUX_ll ( ZTH_ANOM, XSV_ANOM(:,:,:,JSV), &
- GUPDRAFT_MASK, &
- XLES_UPDRAFT_ThSv(:,NLES_CURRENT_TCOUNT,JSV) )
- !
- IF (LUSERC) &
- CALL LES_FLUX_ll ( XTHL_ANOM, XSV_ANOM(:,:,:,JSV), &
- GUPDRAFT_MASK, &
- XLES_UPDRAFT_ThlSv(:,NLES_CURRENT_TCOUNT,JSV) )
- !
- IF (LUSERV) &
- CALL LES_FLUX_ll ( ZTHV_ANOM, XSV_ANOM(:,:,:,JSV), &
- GUPDRAFT_MASK, &
- XLES_UPDRAFT_ThvSv(:,NLES_CURRENT_TCOUNT,JSV) )
- END DO
-!
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-! 4. Downdraft diagnostics
-! ---------------------
-!
-IF (LLES_DOWNDRAFT) THEN
-!
- DO JK=1,NLES_K
- GDOWNDRAFT_MASK(:,:,JK) = (XW_ANOM(:,:,JK) <= 0.) .AND. LLES_CURRENT_CART_MASK(:,:,JK)
- END DO
-!
-!
-! 4.1 Downdraft fraction
-! ------------------
-!
- ZDOWNDRAFT(:,:,:) = 0.
- WHERE (GDOWNDRAFT_MASK(:,:,:))
- ZDOWNDRAFT(:,:,:) = 1.
- END WHERE
-!
- CALL LES_MEAN_ll ( ZDOWNDRAFT, OMASK, &
- XLES_DOWNDRAFT(:,NLES_CURRENT_TCOUNT) )
-!
-!
-! 4.2 Downdraft mean quantities
-! -------------------------
-!
-!* vertical wind velocity
-!
- CALL LES_MEAN_ll ( ZW_LES, GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_W(:,NLES_CURRENT_TCOUNT) )
-!
-!* potential temperature
-!
- CALL LES_MEAN_ll ( ZTH_LES, GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_Th(:,NLES_CURRENT_TCOUNT) )
-!
-!* liquid potential temperature
-!
- IF (LUSERC) &
- CALL LES_MEAN_ll ( ZTHL_LES, GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_Thl(:,NLES_CURRENT_TCOUNT) )
-!
-!* virtual potential temperature
-!
- IF (LUSERV) &
- CALL LES_MEAN_ll ( ZTHV_LES, GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_Thv(:,NLES_CURRENT_TCOUNT) )
-!
-!* vapor mixing ratio
-!
- IF (LUSERV) &
- CALL LES_MEAN_ll ( ZRV_LES, GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_Rv(:,NLES_CURRENT_TCOUNT) )
-!
-!* cloud water mixing ratio
-!
- IF (LUSERC) &
- CALL LES_MEAN_ll ( ZRC_LES, GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_Rc(:,NLES_CURRENT_TCOUNT) )
-!
-!* rain mixing ratio
-!
- IF (LUSERR) &
- CALL LES_MEAN_ll ( ZRR_LES, GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_Rr(:,NLES_CURRENT_TCOUNT) )
-!
-!* cloud ice mixing ratio
-!
- IF (LUSERI) &
- CALL LES_MEAN_ll ( ZRI_LES, GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_Ri(:,NLES_CURRENT_TCOUNT) )
-!
-!* snow mixing ratio
-!
- IF (LUSERS) &
- CALL LES_MEAN_ll ( ZRS_LES, GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_Rs(:,NLES_CURRENT_TCOUNT) )
-!
-!* graupel mixing ratio
-!
- IF (LUSERG) &
- CALL LES_MEAN_ll ( ZRG_LES, GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_Rg(:,NLES_CURRENT_TCOUNT) )
-!
-!* hail mixing ratio
-!
- IF (LUSERH) &
- CALL LES_MEAN_ll ( ZRG_LES, GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_Rh(:,NLES_CURRENT_TCOUNT) )
-!
-!* scalar variables
-!
- DO JSV=1,NSV
- CALL LES_MEAN_ll ( ZSV_LES(:,:,:,JSV), GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_Sv(:,NLES_CURRENT_TCOUNT,JSV) )
- END DO
-!
-!* subgrid turbulent kinetic energy
-!
- CALL LES_MEAN_ll ( ZTKE_LES, GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_Tke(:,NLES_CURRENT_TCOUNT) )
-!
-!
-! 4.3 Downdraft resolved quantities
-! -----------------------------
-!
-!* resolved turbulent kinetic energy
-!
- CALL LES_FLUX_ll ( XU_ANOM, XU_ANOM, &
- GDOWNDRAFT_MASK, &
- ZLES_DOWNDRAFT_U2(:) )
-
- CALL LES_FLUX_ll ( XV_ANOM, XV_ANOM, &
- GDOWNDRAFT_MASK, &
- ZLES_DOWNDRAFT_V2(:) )
-
- CALL LES_FLUX_ll ( XW_ANOM, XW_ANOM, &
- GDOWNDRAFT_MASK, &
- ZLES_DOWNDRAFT_W2(:) )
-
- XLES_DOWNDRAFT_Ke(:,NLES_CURRENT_TCOUNT) = 0.5 * ( ZLES_DOWNDRAFT_U2(:) &
- + ZLES_DOWNDRAFT_V2(:) &
- + ZLES_DOWNDRAFT_W2(:) )
-!
-!* vertical potential temperature flux
-!
- CALL LES_FLUX_ll ( XW_ANOM, ZTH_ANOM, &
- GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_WTh(:,NLES_CURRENT_TCOUNT) )
-!
-!* vertical liquid potential temperature flux
-!
- IF (LUSERC) &
- CALL LES_FLUX_ll ( XW_ANOM, XTHL_ANOM, &
- GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_WThl(:,NLES_CURRENT_TCOUNT) )
-!
-!* vertical virtual potential temperature flux
-!
- IF (LUSERV) &
- CALL LES_FLUX_ll ( XW_ANOM, ZTHV_ANOM, &
- GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_WThv(:,NLES_CURRENT_TCOUNT) )
-!
-!* potential temperature variance
-!
- CALL LES_FLUX_ll ( ZTH_ANOM, ZTH_ANOM, &
- GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_Th2(:,NLES_CURRENT_TCOUNT) )
-!
-!* liquid potential temperature variance
-!
- IF (LUSERC) &
- CALL LES_FLUX_ll ( XTHL_ANOM, XTHL_ANOM, &
- GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_Thl2(:,NLES_CURRENT_TCOUNT) )
-!
-!* potential temperature - virtual potential temperature covariance
-!
- IF (LUSERV) &
- CALL LES_FLUX_ll ( ZTH_ANOM, ZTHV_ANOM, &
- GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_ThThv (:,NLES_CURRENT_TCOUNT) )
-!
-!* liquid potential temperature - virtual potential temperature covariance
-!
- IF (LUSERC) &
- CALL LES_FLUX_ll ( XTHL_ANOM, ZTHV_ANOM, &
- GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_ThlThv(:,NLES_CURRENT_TCOUNT) )
-!
-!
-!* water vapor mixing ratio flux, variance and correlations
-!
- IF (LUSERV) THEN
- CALL LES_FLUX_ll ( XW_ANOM, ZRV_ANOM, &
- GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_WRv(:,NLES_CURRENT_TCOUNT) )
- !
- CALL LES_FLUX_ll ( ZRV_ANOM, ZRV_ANOM, &
- GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_Rv2(:,NLES_CURRENT_TCOUNT) )
- !
- CALL LES_FLUX_ll ( ZTH_ANOM, ZRV_ANOM, &
- GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_ThRv (:,NLES_CURRENT_TCOUNT) )
- !
- CALL LES_FLUX_ll ( ZTHV_ANOM, ZRV_ANOM, &
- GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_ThvRv(:,NLES_CURRENT_TCOUNT) )
- !
- IF (LUSERC) &
- CALL LES_FLUX_ll ( XTHL_ANOM, ZRV_ANOM, &
- GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_ThlRv(:,NLES_CURRENT_TCOUNT) )
- END IF
-!
-!* cloud water mixing ratio flux
-!
- IF (LUSERC) THEN
- CALL LES_FLUX_ll ( XW_ANOM, ZRC_ANOM, &
- GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_WRc(:,NLES_CURRENT_TCOUNT) )
- !
- CALL LES_FLUX_ll ( ZRC_ANOM, ZRC_ANOM, &
- GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_Rc2(:,NLES_CURRENT_TCOUNT) )
- !
- CALL LES_FLUX_ll ( ZTH_ANOM, ZRC_ANOM, &
- GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_ThRc (:,NLES_CURRENT_TCOUNT) )
- !
- CALL LES_FLUX_ll ( ZTHV_ANOM, ZRC_ANOM, &
- GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_ThvRc(:,NLES_CURRENT_TCOUNT) )
- !
- CALL LES_FLUX_ll ( XTHL_ANOM, ZRC_ANOM, &
- GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_ThlRc(:,NLES_CURRENT_TCOUNT) )
- END IF
-!
-!* cloud ice mixing ratio flux
-!
- IF (LUSERI) THEN
- CALL LES_FLUX_ll ( XW_ANOM, ZRI_ANOM, &
- GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_WRi(:,NLES_CURRENT_TCOUNT) )
- !
- CALL LES_FLUX_ll ( ZRI_ANOM, ZRI_ANOM, &
- GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_Ri2(:,NLES_CURRENT_TCOUNT) )
- !
- CALL LES_FLUX_ll ( ZTH_ANOM, ZRI_ANOM, &
- GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_ThRi (:,NLES_CURRENT_TCOUNT) )
- !
- CALL LES_FLUX_ll ( ZTHV_ANOM, ZRI_ANOM, &
- GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_ThvRi(:,NLES_CURRENT_TCOUNT) )
- !
- CALL LES_FLUX_ll ( XTHL_ANOM, ZRI_ANOM, &
- GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_ThlRi(:,NLES_CURRENT_TCOUNT) )
- END IF
-!
-!* scalar variables flux
-!
- DO JSV=1,NSV
- CALL LES_FLUX_ll ( XW_ANOM, XSV_ANOM(:,:,:,JSV), &
- GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_WSv(:,NLES_CURRENT_TCOUNT,JSV) )
- !
- CALL LES_FLUX_ll ( XSV_ANOM(:,:,:,JSV), XSV_ANOM(:,:,:,JSV), &
- GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_Sv2(:,NLES_CURRENT_TCOUNT,JSV) )
- !
- CALL LES_FLUX_ll ( ZTH_ANOM, XSV_ANOM(:,:,:,JSV), &
- GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_ThSv(:,NLES_CURRENT_TCOUNT,JSV) )
- !
- IF (LUSERC) &
- CALL LES_FLUX_ll ( XTHL_ANOM, XSV_ANOM(:,:,:,JSV), &
- GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_ThlSv(:,NLES_CURRENT_TCOUNT,JSV) )
- !
- IF (LUSERV) &
- CALL LES_FLUX_ll ( ZTHV_ANOM, XSV_ANOM(:,:,:,JSV), &
- GDOWNDRAFT_MASK, &
- XLES_DOWNDRAFT_ThvSv(:,NLES_CURRENT_TCOUNT,JSV) )
- END DO
-!
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-! 5. surface or 2D variables (only for the cartesian mask)
-! -----------------------
-!
-!* surface flux of temperature Qo
-!
-CALL LES_MEAN_MPROC ( XLES_Q0 (NLES_CURRENT_TCOUNT), IAVG_PTS(1), IUND_PTS(1) )
-!
-!* surface flux of water vapor Eo
-!
-CALL LES_MEAN_MPROC ( XLES_E0 (NLES_CURRENT_TCOUNT), IAVG_PTS(1), IUND_PTS(1) )
-!
-!* surface flux for scalar variables
-!
-DO JSV=1,NSV
- CALL LES_MEAN_MPROC ( XLES_SV0 (NLES_CURRENT_TCOUNT,JSV), IAVG_PTS(1), IUND_PTS(1) )
-END DO
-!
-!* surface flux of U wind component
-!
-CALL LES_MEAN_MPROC ( XLES_UW0 (NLES_CURRENT_TCOUNT), IAVG_PTS(1), IUND_PTS(1) )
-!
-!* surface flux of V wind component
-!
-CALL LES_MEAN_MPROC ( XLES_VW0 (NLES_CURRENT_TCOUNT), IAVG_PTS(1), IUND_PTS(1) )
-!
-!* friction velocity u*
-!
-!* average of local u*
-!!CALL LES_MEAN_MPROC ( XLES_USTAR(NLES_CURRENT_TCOUNT), IAVG_PTS(1), IUND_PTS(1) )
-!* or true global u*
-XLES_USTAR(NLES_CURRENT_TCOUNT) = SQRT(SQRT(XLES_UW0(NLES_CURRENT_TCOUNT)**2 &
- +XLES_VW0(NLES_CURRENT_TCOUNT)**2 ))
-!
-!* Boundary layer height
-!
-IF (CBL_HEIGHT_DEF=='WTV') THEN
-!
-!* level where temperature flux is minimum
-!
-ALLOCATE(ZWORK(SIZE(XLES_SUBGRID_WTHVMF(:,NLES_CURRENT_TCOUNT,IMASK),1)))
-ZWORK=XLES_SUBGRID_WTHVMF(:,NLES_CURRENT_TCOUNT,IMASK)
-WHERE(ZWORK==XUNDEF) ZWORK=0.
-
- IF (LUSERC) THEN
- IKMIN_FLUX = MINLOC( XLES_RESOLVED_WThv(:,NLES_CURRENT_TCOUNT,1) &
- + XLES_SUBGRID_WThl (:,NLES_CURRENT_TCOUNT,1) &
- + ZWORK & ! flux if EDKF
- + (XRV/XRD - 1.) *( XLES_SUBGRID_WRt (:,NLES_CURRENT_TCOUNT,1) &
- -XLES_SUBGRID_WRc (:,NLES_CURRENT_TCOUNT,1)) )
- ELSE IF (LUSERV) THEN
- IKMIN_FLUX = MINLOC( XLES_RESOLVED_WThv(:,NLES_CURRENT_TCOUNT,1) &
- + ZWORK & ! flux if EDKF
- + XLES_SUBGRID_WThl (:,NLES_CURRENT_TCOUNT,1) &
- + (XRV/XRD - 1.) * XLES_SUBGRID_WRt (:,NLES_CURRENT_TCOUNT,1) )
- ELSE
- IKMIN_FLUX = MINLOC( XLES_RESOLVED_WTh(:,NLES_CURRENT_TCOUNT,1) &
- + ZWORK & ! flux if EDKF
- + XLES_SUBGRID_WThl(:,NLES_CURRENT_TCOUNT,1) )
- END IF
-DEALLOCATE(ZWORK)
-!
-!* boundary layer height
-!
- XLES_BL_HEIGHT(NLES_CURRENT_TCOUNT) = XLES_Z(IKMIN_FLUX(1)) - XLES_ZS
-!
-ELSE IF (CBL_HEIGHT_DEF=='DTH') THEN
- IKMAX_TH=MAXLOC( ZLES_MEAN_DTHDZ(:))
- XLES_BL_HEIGHT(NLES_CURRENT_TCOUNT) = XLES_Z(IKMAX_TH(1)) - XLES_ZS
-!
-ELSE IF (CBL_HEIGHT_DEF=='KE ') THEN
-
- XLES_BL_HEIGHT(NLES_CURRENT_TCOUNT) = XLES_Z(NLES_K) - XLES_ZS
-!
-!* total Turbulent Kinetic Energy
-!
- ZKE_TOT(:) = 0.
-!
- ZKE_TOT(:) = ZKE_TOT(:) + XLES_SUBGRID_TKE (:,NLES_CURRENT_TCOUNT,1)
-!
- IF (CTURBLEN/='BL89' .AND. CTURBLEN/='RM17' .AND. LLES_RESOLVED) &
- ZKE_TOT(:) = ZKE_TOT(:) + XLES_RESOLVED_KE(:,NLES_CURRENT_TCOUNT,1)
-!
- ZINT_KE_TOT = 0.
-!
-!* integration of total kinetic energy on boundary layer depth
-!
- ZINT_KE_TOT = ZINT_KE_TOT +XLES_Z(1)*ZKE_TOT(1)
- DO JK=1,NLES_K-1
- ZINT_KE_TOT = ZINT_KE_TOT + (XLES_Z(JK+1)-XLES_Z(JK)) &
- * 0.5 *( ZKE_TOT(JK+1) + ZKE_TOT(JK) )
-!
-!* test of total kinetic energy smaller than 5% of the averaged value below
-!
- IF ( ZKE_TOT(JK+1) < 0.05 * ZINT_KE_TOT / (XLES_Z(JK+1)-XLES_Z(1)) ) THEN
- XLES_BL_HEIGHT(NLES_CURRENT_TCOUNT) = XLES_Z(JK) - XLES_ZS
- EXIT
- END IF
-!
- END DO
-!
-ELSE IF (CBL_HEIGHT_DEF=='TKE') THEN
-
- XLES_BL_HEIGHT(NLES_CURRENT_TCOUNT) = XLES_Z(NLES_K) - XLES_ZS
-!
-!* subgrid Turbulent Kinetic Energy
-!
- ZKE_TOT(:) = XLES_SUBGRID_TKE (:,NLES_CURRENT_TCOUNT,1)
-!
- ZINT_KE_TOT = 0.
-!
-!* integration of subgrid kinetic energy on boundary layer depth
-!
- DO JK=1,NLES_K-1
- ZINT_KE_TOT = ZINT_KE_TOT + (XLES_Z(JK+1)-XLES_Z(JK)) &
- * 0.5 *( ZKE_TOT(JK+1) + ZKE_TOT(JK) )
-!
-!* test of subgrid kinetic energy smaller than 0.1% of the averaged value below
-!
- IF ( ZKE_TOT(JK+1) < 0.001 * ZINT_KE_TOT / (XLES_Z(JK+1)-XLES_Z(1)) ) THEN
- XLES_BL_HEIGHT(NLES_CURRENT_TCOUNT) = XLES_Z(JK) - XLES_ZS
- EXIT
- END IF
- END DO
-ELSE IF (CBL_HEIGHT_DEF=='FRI') THEN
- ZFRIC_LES = SQRT( ( XLES_SUBGRID_WU (:,NLES_CURRENT_TCOUNT,1) &
- +XLES_RESOLVED_WU(:,NLES_CURRENT_TCOUNT,1))**2 &
- +( XLES_SUBGRID_WV (:,NLES_CURRENT_TCOUNT,1) &
- +XLES_RESOLVED_WV(:,NLES_CURRENT_TCOUNT,1))**2 )
- ZFRIC_SURF = XLES_USTAR(NLES_CURRENT_TCOUNT)**2
- CALL BL_DEPTH_DIAG(YLDIMPHYEX,ZFRIC_SURF, XLES_ZS, &
- ZFRIC_LES, XLES_Z, &
- XFTOP_O_FSURF,XLES_BL_HEIGHT(NLES_CURRENT_TCOUNT))
-END IF
-!
-!
-!* integration of total kinetic energy on boundary layer depth
-!
-XLES_INT_TKE(NLES_CURRENT_TCOUNT)=ZINT_KE_TOT
- !* integration of tke
- ZTKET_LES(:,:) = 0.
- DO JK=1,NLES_K-1
- ZKE_LES(:,:,JK)=0.5*(XU_ANOM(:,:,JK)*XU_ANOM(:,:,JK)+&
- XV_ANOM(:,:,JK)*XV_ANOM(:,:,JK)+XW_ANOM(:,:,JK)*XW_ANOM(:,:,JK))
-
- ZTKET_LES(:,:) = ZTKET_LES(:,:) + (ZZZ_LES(:,:,JK+1)-ZZZ_LES(:,:,JK)) &
- * (ZTKE_LES(:,:,JK)+ZKE_LES(:,:,JK))
- END DO
- CALL LES_MEAN_ll ( ZTKET_LES, LLES_CURRENT_CART_MASK(:,:,1), &
- XLES_INT_TKE(NLES_CURRENT_TCOUNT) )
-!
-!* convective velocity
-!
-XLES_WSTAR(NLES_CURRENT_TCOUNT) = 0.
-!
-IF ( XLES_Q0(NLES_CURRENT_TCOUNT) &
- + (XRV/XRD-1.)*XLES_E0(NLES_CURRENT_TCOUNT) >0.) THEN
- IF (LUSERV) THEN
- XLES_WSTAR(NLES_CURRENT_TCOUNT) = &
- ( XG / XLES_MEAN_Thv (1,NLES_CURRENT_TCOUNT,1) &
- * ( XLES_Q0( NLES_CURRENT_TCOUNT ) &
- + (XRV/XRD - 1.) * XLES_E0( NLES_CURRENT_TCOUNT )) &
- * XLES_BL_HEIGHT( NLES_CURRENT_TCOUNT ) &
- ) ** (1./3.)
- ELSE
- XLES_WSTAR(NLES_CURRENT_TCOUNT) = &
- ( XG / XLES_MEAN_Th (1,NLES_CURRENT_TCOUNT,1) &
- * ( XLES_Q0( NLES_CURRENT_TCOUNT ) &
- + (XRV/XRD - 1.) * XLES_E0( NLES_CURRENT_TCOUNT )) &
- * XLES_BL_HEIGHT( NLES_CURRENT_TCOUNT ) &
- ) ** (1./3.)
- END IF
-END IF
-!
-!* cloud base height
- IF (LUSERC) THEN
- ZINT_RHOKE =0.
- JJ=1
- DO JI=1,NLES_K
- IF ((ZINT_RHOKE .EQ. 0) .AND. &
- (XLES_MEAN_RC(JI,NLES_CURRENT_TCOUNT,1) .GT. 1.E-6)) THEN
- ZINT_RHOKE=1.
- JJ=JI
- END IF
- END DO
- XLES_ZCB(NLES_CURRENT_TCOUNT)= XLES_Z(JJ)-XLES_ZS
- ENDIF
-!
-!* height of max of cf
- IF (LUSERC) THEN
- IKMAX_CF= MAXLOC( XLES_MEAN_INDCf(:,NLES_CURRENT_TCOUNT,1))
- XLES_ZMAXCF(NLES_CURRENT_TCOUNT) = XLES_Z(IKMAX_CF(1)) - XLES_ZS
- IKMAX_CF= MAXLOC( XLES_MEAN_INDCf2(:,NLES_CURRENT_TCOUNT,1))
- XLES_ZMAXCF2(NLES_CURRENT_TCOUNT) = XLES_Z(IKMAX_CF(1)) - XLES_ZS
- ENDIF
-!
-!* Monin-Obukhov length
-!
-XLES_MO_LENGTH(NLES_CURRENT_TCOUNT) = 0.
-!
-IF (LUSERV) THEN
- IF ( XLES_Q0(NLES_CURRENT_TCOUNT)+(XRV/XRD-1.)*XLES_E0(NLES_CURRENT_TCOUNT) /=0. )&
- XLES_MO_LENGTH(NLES_CURRENT_TCOUNT) = (- (XLES_USTAR(NLES_CURRENT_TCOUNT))**3) &
- / (XKARMAN*( XLES_Q0(NLES_CURRENT_TCOUNT) &
- +(XRV/XRD-1.)*XLES_E0(NLES_CURRENT_TCOUNT)) &
- *XG/XLES_MEAN_Thv(1,NLES_CURRENT_TCOUNT,1) )
-ELSE
- IF ( XLES_Q0(NLES_CURRENT_TCOUNT) /=0. ) &
- XLES_MO_LENGTH(NLES_CURRENT_TCOUNT) = (- (XLES_USTAR(NLES_CURRENT_TCOUNT))**3) &
- / (XKARMAN*XLES_Q0(NLES_CURRENT_TCOUNT) &
- *XG/XLES_MEAN_Th(1,NLES_CURRENT_TCOUNT,1) )
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-! 6. correlations along x and y axes
-! -------------------------------
-!
-!* u * u
-!
-DO JK=1,NSPECTRA_K
- CALL LES_HOR_CORR( ZU_SPEC(:,:,JK), ZU_SPEC(:,:,JK), &
- CLES_LBCX , CLES_LBCY, &
- XCORRi_UU(:,JK,NLES_CURRENT_TCOUNT), &
- XCORRj_UU(:,JK,NLES_CURRENT_TCOUNT) )
-END DO
-!
-!* v * v
-!
-DO JK=1,NSPECTRA_K
- CALL LES_HOR_CORR( ZV_SPEC(:,:,JK), ZV_SPEC(:,:,JK), &
- CLES_LBCX , CLES_LBCY, &
- XCORRi_VV(:,JK,NLES_CURRENT_TCOUNT), &
- XCORRj_VV(:,JK,NLES_CURRENT_TCOUNT) )
-END DO
-!
-!* u * v
-!
-DO JK=1,NSPECTRA_K
- CALL LES_HOR_CORR( ZU_SPEC(:,:,JK), ZV_SPEC(:,:,JK), &
- CLES_LBCX , CLES_LBCY, &
- XCORRi_UV(:,JK,NLES_CURRENT_TCOUNT), &
- XCORRj_UV(:,JK,NLES_CURRENT_TCOUNT) )
-END DO
-!
-!* w * u
-!
-DO JK=1,NSPECTRA_K
- CALL LES_HOR_CORR( ZW_SPEC(:,:,JK), ZU_SPEC(:,:,JK), &
- CLES_LBCX , CLES_LBCY, &
- XCORRi_WU(:,JK,NLES_CURRENT_TCOUNT), &
- XCORRj_WU(:,JK,NLES_CURRENT_TCOUNT) )
-END DO
-!
-!* w * v
-!
-DO JK=1,NSPECTRA_K
- CALL LES_HOR_CORR( ZW_SPEC(:,:,JK), ZV_SPEC(:,:,JK), &
- CLES_LBCX , CLES_LBCY, &
- XCORRi_WV(:,JK,NLES_CURRENT_TCOUNT), &
- XCORRj_WV(:,JK,NLES_CURRENT_TCOUNT) )
-END DO
-!
-!* w * w
-!
-DO JK=1,NSPECTRA_K
- CALL LES_HOR_CORR( ZW_SPEC(:,:,JK), ZW_SPEC(:,:,JK), &
- CLES_LBCX , CLES_LBCY, &
- XCORRi_WW(:,JK,NLES_CURRENT_TCOUNT), &
- XCORRj_WW(:,JK,NLES_CURRENT_TCOUNT) )
-END DO
-!
-!* w * th
-!
-DO JK=1,NSPECTRA_K
- CALL LES_HOR_CORR( ZW_SPEC(:,:,JK), ZTH_SPEC(:,:,JK), &
- CLES_LBCX , CLES_LBCY, &
- XCORRi_WTh(:,JK,NLES_CURRENT_TCOUNT), &
- XCORRj_WTh(:,JK,NLES_CURRENT_TCOUNT) )
-END DO
-!
-!* w * thl
-!
-DO JK=1,NSPECTRA_K
- IF (LUSERC) &
- CALL LES_HOR_CORR( ZW_SPEC(:,:,JK), ZTHL_SPEC(:,:,JK), &
- CLES_LBCX , CLES_LBCY, &
- XCORRi_WThl(:,JK,NLES_CURRENT_TCOUNT), &
- XCORRj_WThl(:,JK,NLES_CURRENT_TCOUNT) )
-END DO
-!
-!* th * th
-!
-DO JK=1,NSPECTRA_K
- CALL LES_HOR_CORR( ZTH_SPEC(:,:,JK), ZTH_SPEC(:,:,JK), &
- CLES_LBCX , CLES_LBCY, &
- XCORRi_ThTh(:,JK,NLES_CURRENT_TCOUNT), &
- XCORRj_ThTh(:,JK,NLES_CURRENT_TCOUNT) )
-END DO
-!
-!* thl * thl
-!
-DO JK=1,NSPECTRA_K
- IF (LUSERC) &
- CALL LES_HOR_CORR( ZTHL_SPEC(:,:,JK), ZTHL_SPEC(:,:,JK), &
- CLES_LBCX , CLES_LBCY, &
- XCORRi_ThlThl(:,JK,NLES_CURRENT_TCOUNT), &
- XCORRj_ThlThl(:,JK,NLES_CURRENT_TCOUNT) )
-END DO
-!
-!* correlations with water vapor
-!
-IF (LUSERV) THEN
- DO JK=1,NSPECTRA_K
- CALL LES_HOR_CORR( ZW_SPEC(:,:,JK), ZRV_SPEC(:,:,JK), &
- CLES_LBCX , CLES_LBCY, &
- XCORRi_WRv(:,JK,NLES_CURRENT_TCOUNT), &
- XCORRj_WRv(:,JK,NLES_CURRENT_TCOUNT) )
- END DO
- !
- DO JK=1,NSPECTRA_K
- CALL LES_HOR_CORR( ZTH_SPEC(:,:,JK), ZRV_SPEC(:,:,JK), &
- CLES_LBCX , CLES_LBCY, &
- XCORRi_ThRv(:,JK,NLES_CURRENT_TCOUNT), &
- XCORRj_ThRv(:,JK,NLES_CURRENT_TCOUNT) )
- END DO
- !
- DO JK=1,NSPECTRA_K
- IF (LUSERC) &
- CALL LES_HOR_CORR( ZTHL_SPEC(:,:,JK), ZRV_SPEC(:,:,JK), &
- CLES_LBCX , CLES_LBCY, &
- XCORRi_ThlRv(:,JK,NLES_CURRENT_TCOUNT), &
- XCORRj_ThlRv(:,JK,NLES_CURRENT_TCOUNT) )
- END DO
- !
- DO JK=1,NSPECTRA_K
- CALL LES_HOR_CORR( ZRV_SPEC(:,:,JK), ZRV_SPEC(:,:,JK), &
- CLES_LBCX , CLES_LBCY, &
- XCORRi_RvRv(:,JK,NLES_CURRENT_TCOUNT), &
- XCORRj_RvRv(:,JK,NLES_CURRENT_TCOUNT) )
- END DO
-END IF
-!
-!
-!* correlations with cloud water
-!
-IF (LUSERC) THEN
- DO JK=1,NSPECTRA_K
- CALL LES_HOR_CORR( ZW_SPEC(:,:,JK), ZRC_SPEC(:,:,JK), &
- CLES_LBCX , CLES_LBCY, &
- XCORRi_WRc(:,JK,NLES_CURRENT_TCOUNT), &
- XCORRj_WRc(:,JK,NLES_CURRENT_TCOUNT) )
- END DO
- !
- DO JK=1,NSPECTRA_K
- CALL LES_HOR_CORR( ZTH_SPEC(:,:,JK), ZRC_SPEC(:,:,JK), &
- CLES_LBCX , CLES_LBCY, &
- XCORRi_ThRc(:,JK,NLES_CURRENT_TCOUNT), &
- XCORRj_ThRc(:,JK,NLES_CURRENT_TCOUNT) )
- END DO
- !
- DO JK=1,NSPECTRA_K
- CALL LES_HOR_CORR( ZTHL_SPEC(:,:,JK), ZRC_SPEC(:,:,JK), &
- CLES_LBCX , CLES_LBCY, &
- XCORRi_ThlRc(:,JK,NLES_CURRENT_TCOUNT), &
- XCORRj_ThlRc(:,JK,NLES_CURRENT_TCOUNT) )
- END DO
- !
- DO JK=1,NSPECTRA_K
- CALL LES_HOR_CORR( ZRC_SPEC(:,:,JK), ZRC_SPEC(:,:,JK), &
- CLES_LBCX , CLES_LBCY, &
- XCORRi_RcRc(:,JK,NLES_CURRENT_TCOUNT), &
- XCORRj_RcRc(:,JK,NLES_CURRENT_TCOUNT) )
- END DO
-END IF
-!
-!* correlations with cloud ice
-!
-IF (LUSERI) THEN
- DO JK=1,NSPECTRA_K
- CALL LES_HOR_CORR( ZW_SPEC(:,:,JK), ZRI_SPEC(:,:,JK), &
- CLES_LBCX , CLES_LBCY, &
- XCORRi_WRi(:,JK,NLES_CURRENT_TCOUNT), &
- XCORRj_WRi(:,JK,NLES_CURRENT_TCOUNT) )
- END DO
- !
- DO JK=1,NSPECTRA_K
- CALL LES_HOR_CORR( ZTH_SPEC(:,:,JK), ZRI_SPEC(:,:,JK), &
- CLES_LBCX , CLES_LBCY, &
- XCORRi_ThRi(:,JK,NLES_CURRENT_TCOUNT), &
- XCORRj_ThRi(:,JK,NLES_CURRENT_TCOUNT) )
- END DO
- !
- DO JK=1,NSPECTRA_K
- CALL LES_HOR_CORR( ZTHL_SPEC(:,:,JK), ZRI_SPEC(:,:,JK), &
- CLES_LBCX , CLES_LBCY, &
- XCORRi_ThlRi(:,JK,NLES_CURRENT_TCOUNT), &
- XCORRj_ThlRi(:,JK,NLES_CURRENT_TCOUNT) )
- END DO
- !
- DO JK=1,NSPECTRA_K
- CALL LES_HOR_CORR( ZRI_SPEC(:,:,JK), ZRI_SPEC(:,:,JK), &
- CLES_LBCX , CLES_LBCY, &
- XCORRi_RiRi(:,JK,NLES_CURRENT_TCOUNT), &
- XCORRj_RiRi(:,JK,NLES_CURRENT_TCOUNT) )
- END DO
-END IF
-!
-!* correlations with scalar variables
-!
-DO JSV=1,NSV
- DO JK=1,NSPECTRA_K
- CALL LES_HOR_CORR( ZW_SPEC(:,:,JK), ZSV_SPEC(:,:,JK,JSV), &
- CLES_LBCX , CLES_LBCY, &
- XCORRi_WSv(:,JK,NLES_CURRENT_TCOUNT,JSV), &
- XCORRj_WSv(:,JK,NLES_CURRENT_TCOUNT,JSV) )
- END DO
- !
- DO JK=1,NSPECTRA_K
- CALL LES_HOR_CORR( ZSV_SPEC(:,:,JK,JSV), ZSV_SPEC(:,:,JK,JSV), &
- CLES_LBCX , CLES_LBCY, &
- XCORRi_SvSv(:,JK,NLES_CURRENT_TCOUNT,JSV), &
- XCORRj_SvSv(:,JK,NLES_CURRENT_TCOUNT,JSV) )
- END DO
-END DO
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LES
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LES_n
diff --git a/src/mesonh/ext/lidar.f90 b/src/mesonh/ext/lidar.f90
deleted file mode 100644
index 93cfad846b1d3342188e5e085056f1edbfb6a001..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/lidar.f90
+++ /dev/null
@@ -1,695 +0,0 @@
-!MNH_LIC Copyright 2007-2020 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! #################
- MODULE MODI_LIDAR
-! #################
-!
-INTERFACE
- SUBROUTINE LIDAR(HCLOUD,HVIEW,PALT,PWVL,PZZ,PRHO,PT,PCLDFR,PRT, &
- PLIDAROUT,PLIPAROUT,PCT,PDSTC,PDSTD,PDSTS)
-!
-CHARACTER(LEN=*), INTENT(IN) :: HCLOUD ! Name of the cloud scheme
-CHARACTER(LEN=*), INTENT(IN) :: HVIEW ! Upward or Downward integration
-REAL, INTENT(IN) :: PALT ! Altitude of the lidar source
-REAL, INTENT(IN) :: PWVL ! Wavelength of the lidar source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Altitude
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! Air density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Air temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Cloud fraction
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Moist variables at t
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLIDAROUT ! Lidar output
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLIPAROUT ! Lidar output (particle only)
-
-REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: PCT ! Concentration
- ! (C2R2 and C1R3)
-REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: PDSTC ! Dust Concentration
-REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: PDSTD ! Dust Diameter
-REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: PDSTS ! Dust Sigma
-!
-
-!
-END SUBROUTINE LIDAR
-!
-END INTERFACE
-!
-END MODULE MODI_LIDAR
-! #########################################################
- SUBROUTINE LIDAR(HCLOUD,HVIEW,PALT,PWVL,PZZ,PRHO,PT,PCLDFR,PRT, &
- PLIDAROUT,PLIPAROUT,PCT,PDSTC,PDSTD,PDSTS)
-! #########################################################
-!
-!!**** *LIDAR * - computes pertinent lidar parameters
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the normalized backscattered
-!! signal of an upward or downward looking lidar in an atmosperic column
-!! containing air molecules, aerosols, cloud particles and hydrometeors.
-!!
-!!** METHOD
-!! ------
-!! The reflectivities are computed using the n(D) * D**6 formula. The
-!! equivalent reflectiviy is the sum of the reflectivity produced by the
-!! the raindrops and the equivalent reflectivities of the ice crystals.
-!! The latter are computed using the melted diameter. The Doppler
-!! reflectivity is the 'fall speed'-moment of individual particle
-!! reflectivity. Ice crystal are assumed to have no preferred orientation.
-!! the Z_VV formula is taken from Brandes et al. (MWR, 1995).
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CST
-!! XPI !
-!! XRHOLW ! Liquid water density
-!! Module MODD_RAIN_ICE_DESCR
-!! Module MODD_RAIN_ICE_PARAM
-!!
-!! REFERENCE
-!! ---------
-!! Chaboureau et al. 2011: Long-range transport of Saharan dust and its
-!! radiative impact on precipitation forecast over western Europe: a case
-!! study during COPS. Quart. J. Roy. Meteor. Soc., 137, 236-251
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 04/10/07
-!! JP Chaboureau 12/02/10 change dust refraction index
-!! add inputs (lidar charact. and cloud fraction)
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! B.VIE 2016 : LIMA
-! P. Wautelet 18/03/2020: remove ICE2 option
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS
-USE MODD_CST
-USE MODD_RAIN_C2R2_DESCR, ONLY : XLBEXC, XLBEXR, &
- XRTMIN, XCTMIN
-USE MODD_PARAM_C2R2, ONLY : YALPHAC=>XALPHAC,YNUC=>XNUC, &
- YALPHAR=>XALPHAR,YNUR=>XNUR
-USE MODD_PARAM_ICE_n, ONLY: WSNOW_T=>LSNOW_T
-USE MODD_RAIN_ICE_DESCR_n, ONLY : XCCR, WLBEXR=>XLBEXR, XLBR, &
- XCCS, XCXS, XLBEXS, XLBS, WNS=>XNS, WBS=>XBS, &
- XCCG, XCXG, XLBEXG, XLBG, &
- XCCH, XCXH, XLBEXH, XLBH, &
- WRTMIN=>XRTMIN, &
- WLBDAS_MAX=>XLBDAS_MAX,WLBDAS_MIN=>XLBDAS_MIN,WTRANS_MP_GAMMAS=>XTRANS_MP_GAMMAS
-USE MODD_ICE_C1R3_DESCR, ONLY : XLBEXI, &
- YRTMIN=>XRTMIN, YCTMIN=>XCTMIN
-!
-USE MODD_PARAM_LIMA, ONLY : URTMIN=>XRTMIN, UCTMIN=>XCTMIN, &
- UALPHAC=>XALPHAC,UNUC=>XNUC, &
- UALPHAR=>XALPHAR,UNUR=>XNUR, &
- UALPHAI=>XALPHAI,UNUI=>XNUI, &
- USNOW_T=>LSNOW_T
-USE MODD_PARAM_LIMA_COLD, ONLY : UCCS=>XCCS, UCXS=>XCXS, ULBEXS=>XLBEXS, &
- ULBS=>XLBS, UNS=>XNS, UBS=>XBS, &
- ULBDAS_MAX=>XLBDAS_MAX,ULBDAS_MIN=>XLBDAS_MIN,UTRANS_MP_GAMMAS=>XTRANS_MP_GAMMAS
-USE MODD_PARAM_LIMA_MIXED,ONLY : UCCG=>XCCG, UCXG=>XCXG, ULBEXG=>XLBEXG, &
- ULBG=>XLBG
-
-use mode_tools_ll, only: GET_INDICE_ll
-
-USE MODI_BHMIE_WATER ! Gamma or mono dispersed size distributions
-USE MODI_BHMIE_AEROSOLS ! Lognormal or mono dispersed size distributions
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-CHARACTER(LEN=*), INTENT(IN) :: HCLOUD ! Name of the cloud scheme
-CHARACTER(LEN=*), INTENT(IN) :: HVIEW ! Upward or Downward integration
-REAL, INTENT(IN) :: PALT ! Altitude of the lidar source
-REAL, INTENT(IN) :: PWVL ! Wavelength of the lidar source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Altitude
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! Air density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Air temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Cloud fraction
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Moist variables at t
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLIDAROUT ! Lidar output
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLIPAROUT ! Lidar output (particle only)
-
-REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: PCT ! Concentration
- ! (C2R2 and C1R3)
-REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: PDSTC ! Dust Concentration
-REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: PDSTD ! Dust Diameter
-REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: PDSTS ! Dust Sigma
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: JI, JJ, JK
-INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE
-INTEGER :: IALT
-INTEGER, DIMENSION(3) :: IKMIN
-!
-REAL, PARAMETER :: ZCLDFRMIN = 1.0E-03 ! Cloud fraction minimum
-!
-!
-COMPLEX, PARAMETER :: ZZREFIND_WAT = (1.337E+00,1.818E-09) ! Refraction Index
- ! of pure water
-COMPLEX, PARAMETER :: ZZREFIND_ICE = (1.312E+00,2.614E-09) ! Refraction Index
- ! of pure ice
-!COMPLEX, PARAMETER :: ZZREFIND_DUST= (1.530E+00,8.000E-03) ! Refraction Index
-! ! of mineral dust
-! West, R. A., L. R. Doose, A. M. Eibl, M. G. Tomasko, and M. I. Mishchenko
-! (1997), Laboratory measurements of mineral dust scattering phase function
-! and linear polarization, J. Geophys. Res., 102(D14), 16,871-16,882.
-COMPLEX :: ZZREFIND_DUST
-
-! Tulet, P., M. Mallet, V. Pont, J. Pelon, and A. Boone (2008), The 7-13
-! March 2006 dust storm over West Africa: Generation, transport, and vertical
-! stratification, J. Geophys. Res., 113, D00C08, doi:10.1029/2008JD009871.
-!! Ri = 1.448-0.00292i for wavelengths between 0.185 and 0.69um.
-!! Ri = 1.44023-0.00116i for wavelengths between 0.69 and 1.19um.
-!! Ri = 1.41163-0.00106i for wavelengths between 1.19 and 4.0um.
-COMPLEX, PARAMETER :: ZZREFIND_DSTL= (1.448,2.92E-03)
-COMPLEX, PARAMETER :: ZZREFIND_DSTM= (1.44023,1.16E-03)
-COMPLEX, PARAMETER :: ZZREFIND_DSTH= (1.41163,1.06E-03)
-
-!
-! COMPLEX, PARAMETER :: ZZREFIND_WAT = (1.321E+00,1.280E-06) ! Refraction Index
-! ! of pure water
-! COMPLEX, PARAMETER :: ZZREFIND_ICE = (1.300E+00,1.898E-06) ! Refraction Index
-! ! of pure ice
-!
-COMPLEX, PARAMETER :: ZZREFIND_COAT= (1.337E+00,1.818E-09) ! Refraction Index
- ! of coating material
-COMPLEX, PARAMETER :: ZZREFIND_BC = (1.870E+00,0.569E+00) ! Refraction Index
- ! of black carbone
-REAL :: ZCXR=-1.0 ! for rain N ~ 1/N_0
- ! (in Kessler parameterization)
-!
-REAL :: ZCMOL
-REAL :: ZWAVE_LENGTH
-! BETA: backscattering coefficient
-! ALPHA: extinction coefficient
-REAL, DIMENSION(SIZE(PRHO,1),SIZE(PRHO,2),SIZE(PRHO,3)) :: ZBETA_MOL
-REAL, DIMENSION(SIZE(PRHO,1),SIZE(PRHO,2),SIZE(PRHO,3)) :: ZALPH_MOL
-REAL, DIMENSION(SIZE(PRHO,1),SIZE(PRHO,2),SIZE(PRHO,3)) :: ZBETA_PAR
-REAL, DIMENSION(SIZE(PRHO,1),SIZE(PRHO,2),SIZE(PRHO,3)) :: ZALPH_PAR
-REAL, ALLOCATABLE, DIMENSION(:,:) :: ZOPTD_TOT ! Optical depths
-REAL, ALLOCATABLE, DIMENSION(:,:) :: ZOPTD_MOL
-REAL, ALLOCATABLE, DIMENSION(:,:) :: ZOPTD_PAR
-!
-CHARACTER (LEN=5) :: YDSD
-INTEGER :: IRADIUS, IANGLE
-REAL :: ZRADIUS, ZCONC, ZLWC, ZIWC
-REAL :: ZREFF_FACT
-REAL :: ZEXT_COEF, ZBAK_COEF
-REAL :: ZLBDAR, ZLBDAS, ZLBDAG, ZLBDAH, ZTCEL
-REAL :: ZFRACVOL_CORE, ZDMODAL, ZSIG
-REAL :: ZFRACVOL_BC
-!
-REAL :: ZETACLD, ZETAAER ! Multiple diffusion paramter for cloud and dust
-!
-REAL, DIMENSION(5) :: ZPOLC, ZPOLR, ZPOLI ! BackScat. Coefficients
-!
-REAL, DIMENSION(10) :: ZRTMIN, ZCTMIN
-REAL :: ZLBEXR
-!
-INTEGER :: JL
-REAL :: ZALPHAC, ZNUC, ZALPHAR, ZNUR, ZALPHAI, ZNUI
-REAL :: ZCCS, ZCXS, ZLBEXS, ZLBS, ZNS
-REAL :: ZCCG, ZCXG, ZLBEXG, ZLBG
-!
-! -----------------------------------------------------------------------------
-!
-!* 1. COMPUTE THE LOOP BOUNDS
-! -----------------------
-!
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IKB=1+JPVEXT
-IKE=SIZE(PRHO,3) - JPVEXT
-!
-ZWAVE_LENGTH = PWVL
-ZCMOL=5.45E-32*((ZWAVE_LENGTH)/0.55E-6)**(-4.09)
-IF (ZWAVE_LENGTH<0.69E-6) THEN
- PRINT *,'Tulet et al. refractive index - low wavelength'
- ZZREFIND_DUST = ZZREFIND_DSTL
-ELSEIF (ZWAVE_LENGTH<1.00E-6) THEN
- PRINT *,'Tulet et al. refractive index - medium wavelength'
- ZZREFIND_DUST = ZZREFIND_DSTM
-ELSE
- PRINT *,'Tulet et al. refractive index - high wavelength'
- ZZREFIND_DUST = ZZREFIND_DSTH
-END IF
-ZPOLC = (/ 2.6980E-8,-3.7701E-6, 1.6594E-4,-0.0024, 0.0626 /)
-ZPOLR(:) = ZPOLC(:)
-ZPOLI = (/-1.0176E-8, 1.7615E-6,-1.0480E-4, 0.0019, 0.0460 /)
-!
-! Multiple diffusion parameter
-ZETAAER=1.0
-ZETACLD=1.0
-! a multiple scattering correction for lidar in space; Platt 73
-IF (HVIEW=='NADIR'.AND.PALT==0.) ZETACLD=0.5
-PRINT *,'Multiple diffusion parameter for aerosol ',ZETAAER
-PRINT *,'Multiple diffusion parameter for cloud ',ZETACLD
-!
-!
-!* 1. MORE INITIALIZATION
-! -------------------
-!
-SELECT CASE ( HCLOUD )
- CASE('KESS')
- ZRTMIN(1) = 1.0E-20
- ZRTMIN(2) = 1.0E-20
- ZRTMIN(3) = 1.0E-20
- ZLBEXR = 1.0/(-1.0-3.0)
- CASE('ICE3','ICE4')
- ZRTMIN(1:SIZE(WRTMIN)) = WRTMIN(1:SIZE(WRTMIN))
- ZLBEXR = WLBEXR
- ZCCS = XCCS
- ZCXS = XCXS
- ZLBEXS = XLBEXS
- ZLBS = XLBS
- ZNS = WNS
- ZCCG = XCCG
- ZCXG = XCXG
- ZLBEXG = XLBEXG
- ZLBG = XLBG
- CASE('C2R2')
- ZRTMIN(1:SIZE(XRTMIN)) = XRTMIN(1:SIZE(XRTMIN))
- ZCTMIN(1:SIZE(XCTMIN)) = XCTMIN(1:SIZE(XCTMIN))
- ZLBEXR = XLBEXR
- ZALPHAC = YALPHAC
- ZNUR = YNUR
- ZALPHAR = YALPHAR
- ZNUC = YNUC
- CASE('C3R5')
- ZRTMIN(1:SIZE(YRTMIN)) = YRTMIN(1:SIZE(YRTMIN))
- ZCTMIN(1:SIZE(YCTMIN)) = YCTMIN(1:SIZE(YCTMIN))
- ZALPHAC = YALPHAC
- ZNUR = YNUR
- ZALPHAR = YALPHAR
- ZNUC = YNUC
- ZALPHAI = ZALPHAC
- ZNUI = ZNUC
- ZCCS = XCCS
- ZCXS = XCXS
- ZLBEXS = XLBEXS
- ZLBS = XLBS
- ZCCG = XCCG
- ZCXG = XCXG
- ZLBEXG = XLBEXG
- ZLBG = XLBG
- CASE('LIMA')
- ZRTMIN(1:SIZE(URTMIN)) = URTMIN(1:SIZE(URTMIN))
- ZCTMIN(1:SIZE(UCTMIN)) = UCTMIN(1:SIZE(UCTMIN))
- ZALPHAC = UALPHAC
- ZNUR = UNUR
- ZALPHAR = UALPHAR
- ZNUC = UNUC
- ZALPHAI = UALPHAI
- ZNUI = UNUI
- ZCCS = UCCS
- ZCXS = UCXS
- ZLBEXS = ULBEXS
- ZLBS = ULBS
- ZNS = UNS
- ZCCG = UCCG
- ZCXG = UCXG
- ZLBEXG = ULBEXG
- ZLBG = ULBG
-END SELECT
-!
-! -----------------------------------------------------------------------------
-!
-!* 2. INITIALIZES THE MEAN-LAYER VARIABLES
-! ------------------------------------
-!
-!
-! MOLECULAR CONTRIBUTION
-!
-ZBETA_MOL(:,:,:) = ( PRHO(:,:,:)*XAVOGADRO/XMD )*ZCMOL
-ZALPH_MOL(:,:,:) = ZBETA_MOL(:,:,:)*(8.0*XPI/3.0)
-!
-! PARTICULAR CONTRIBUTION
-!
-ZBETA_PAR(:,:,:) = 0.
-ZALPH_PAR(:,:,:) = 0.
-!
-! AEROSOL CONTRIBUTION ! call bhmie_aerosols
-!
-IF (PRESENT(PDSTC)) THEN
- DO JL = 1, SIZE(PDSTD,4)
- DO JK = IKB, IKE
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- IF ( PDSTD(JI,JJ,JK,JL)>0.1 ) THEN
- !
- ! Desert dust particles
- !
- YDSD = 'MONOD'
- ZCONC = PDSTC(JI,JJ,JK,JL)
- ZFRACVOL_CORE = 1.0
- ZRADIUS = PDSTD(JI,JJ,JK,JL)*1.0E-6
- IF( ZRADIUS .GE. 1.0E-3 ) ZRADIUS = ZRADIUS * 1.0E-6
- CALL BHMIE_AEROSOLS( ZWAVE_LENGTH, ZZREFIND_DUST, ZZREFIND_DUST, &
- YDSD, ZCONC, ZFRACVOL_CORE, ZEXT_COEF, &
- ZBAK_COEF, PRADIUS=ZRADIUS )
- ZALPH_PAR(JI,JJ,JK) = ZALPH_PAR(JI,JJ,JK) + ZETAAER * ZEXT_COEF
- ZBETA_PAR(JI,JJ,JK) = ZBETA_PAR(JI,JJ,JK) + ZBAK_COEF
- END IF
- END DO
- END DO
- END DO
- END DO
-END IF
-!
-!
-! HYDROMETEOR CONTRIBUTION ! call bhmie_water
-!
-! LIQUID WATER
-!
-! Some Prefactors: Assume Martin et al. (1994, JAS) for Reff
-!
-ZREFF_FACT = 1.0E-3*(3.E3/(4.0*XPI*0.67E-3))**0.33 ! Continental N=500
-ZREFF_FACT = 1.0E-3*(3.E3/(4.0*XPI*0.80E-3))**0.33 ! Maritime N=150
-!
-SELECT CASE ( HCLOUD )
- CASE('KESS','ICE3','ICE4')
- DO JK = IKB, IKE
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- IF ( PRT(JI,JJ,JK,2)>ZRTMIN(2) .AND. PCLDFR(JI,JJ,JK)>ZCLDFRMIN) THEN
-!
-! Cloud droplets
-!
- YDSD = 'MONOD'
- ZCONC = 200.E6 ! Continental case
- ZLWC = PRHO(JI,JJ,JK)*PRT(JI,JJ,JK,2) / PCLDFR(JI,JJ,JK)
- ZRADIUS = MIN( 16.0E-6,MAX( 4.0E-6,ZREFF_FACT*(ZLWC/ZCONC)**0.33 ) )
- IANGLE = 11
- CALL BHMIE_WATER( ZWAVE_LENGTH, ZZREFIND_WAT, YDSD, ZCONC, &
- IANGLE, ZEXT_COEF, ZBAK_COEF, PRADIUS=ZRADIUS )
- ZALPH_PAR(JI,JJ,JK) = ZALPH_PAR(JI,JJ,JK) + ZETACLD * ZEXT_COEF &
- * PCLDFR(JI,JJ,JK)
- ZBETA_PAR(JI,JJ,JK) = ZBETA_PAR(JI,JJ,JK) + ZBAK_COEF &
- * PCLDFR(JI,JJ,JK)
- END IF
- END DO
- END DO
- END DO
- DO JK = IKB, IKE
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- IF ( PRT(JI,JJ,JK,3)>ZRTMIN(3) ) THEN
-!
-! Rain drops
-!
- YDSD = 'MONOD'
- ZLWC = PRHO(JI,JJ,JK)*PRT(JI,JJ,JK,3)
- ZLBDAR = XLBR*(ZLWC)**ZLBEXR
- ZCONC = XCCR*(ZLBDAR)**ZCXR
- ZRADIUS = 0.5*(3.0/ZLBDAR) ! Assume Marshall-Palmer law for Reff
- IANGLE = 11
- CALL BHMIE_WATER( ZWAVE_LENGTH, ZZREFIND_WAT, YDSD, ZCONC, &
- IANGLE, ZEXT_COEF, ZBAK_COEF, PRADIUS=ZRADIUS )
- ZALPH_PAR(JI,JJ,JK) = ZALPH_PAR(JI,JJ,JK) + ZETACLD * ZEXT_COEF
- ZBETA_PAR(JI,JJ,JK) = ZBETA_PAR(JI,JJ,JK) + ZBAK_COEF
- END IF
- END DO
- END DO
- END DO
- CASE ('C2R2','C3R5','LIMA')
- DO JK = IKB, IKE
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- IF (PRT(JI,JJ,JK,2)>ZRTMIN(2) .AND. PCT(JI,JJ,JK,2)>ZCTMIN(2)) THEN
-!
-! Cloud droplets
-!
- YDSD = 'GAMMA'
- ZCONC = PCT(JI,JJ,JK,2)
- IRADIUS = 20
- ZLWC = PRHO(JI,JJ,JK)*PRT(JI,JJ,JK,2)
- IANGLE = 11
- CALL BHMIE_WATER( ZWAVE_LENGTH, ZZREFIND_WAT, YDSD, ZCONC, &
- IANGLE, ZEXT_COEF, ZBAK_COEF, KRADIUS=IRADIUS, &
- PALPHA=ZALPHAC, PNU=ZNUC, PLWC=ZLWC )
- ZALPH_PAR(JI,JJ,JK) = ZALPH_PAR(JI,JJ,JK) + ZETACLD * ZEXT_COEF
- ZBETA_PAR(JI,JJ,JK) = ZBETA_PAR(JI,JJ,JK) + ZBAK_COEF
- END IF
- END DO
- END DO
- END DO
- DO JK = IKB, IKE
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- IF (PRT(JI,JJ,JK,3)>ZRTMIN(3) .AND. PCT(JI,JJ,JK,3)>ZCTMIN(3)) THEN
-!
-! Rain drops
-!
- YDSD = 'GAMMA'
- ZCONC = PCT(JI,JJ,JK,3)
- IRADIUS = 20
- ZLWC = PRHO(JI,JJ,JK)*PRT(JI,JJ,JK,3)
- IANGLE = 11
- CALL BHMIE_WATER( ZWAVE_LENGTH, ZZREFIND_WAT, YDSD, ZCONC, &
- IANGLE, ZEXT_COEF, ZBAK_COEF, KRADIUS=IRADIUS, &
- PALPHA=ZALPHAR, PNU=ZNUR, PLWC=ZLWC )
- ZALPH_PAR(JI,JJ,JK) = ZALPH_PAR(JI,JJ,JK) + ZETACLD * ZEXT_COEF
- ZBETA_PAR(JI,JJ,JK) = ZBETA_PAR(JI,JJ,JK) + ZBAK_COEF
- END IF
- END DO
- END DO
- END DO
-END SELECT
-!
-! SOLID ICE
-!
-SELECT CASE ( HCLOUD )
- CASE('ICE3','ICE4')
- DO JK = IKB, IKE
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- IF ( PRT(JI,JJ,JK,4)>ZRTMIN(4) .AND. PCLDFR(JI,JJ,JK)>ZCLDFRMIN) THEN
-!
-! Pristine crystals
-!
- YDSD = 'MONOD'
- ZCONC = 10.E3 ! Continental case
- ZIWC = PRHO(JI,JJ,JK)*PRT(JI,JJ,JK,4) / PCLDFR(JI,JJ,JK)
- ZTCEL = 10.0-0.0065*PZZ(JI,JJ,JK) ! A rough estimate
- ZRADIUS = MIN( 350.0E-6,MAX( 45.0E-6,0.5E-6*(1.2351+0.0105*ZTCEL)* &
- (5.8966*(ZIWC*1.0E3)**0.2214 + &
- (0.7957*(ZIWC*1.0E3)**0.2535)*(ZTCEL+190.0)) ) )
- IANGLE = 11
- CALL BHMIE_WATER( ZWAVE_LENGTH, ZZREFIND_ICE, YDSD, ZCONC, &
- IANGLE, ZEXT_COEF, ZBAK_COEF, PRADIUS=ZRADIUS )
- ZALPH_PAR(JI,JJ,JK) = ZALPH_PAR(JI,JJ,JK) + ZETACLD * ZEXT_COEF &
- *PCLDFR(JI,JJ,JK)
- ZBETA_PAR(JI,JJ,JK) = ZBETA_PAR(JI,JJ,JK) + ZBAK_COEF &
- *PCLDFR(JI,JJ,JK)
- END IF
- END DO
- END DO
- END DO
- CASE ('C3R5','LIMA')
- DO JK = IKB, IKE
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- IF (PRT(JI,JJ,JK,4)>ZRTMIN(4) .AND. PCT(JI,JJ,JK,4)>ZCTMIN(4)) THEN
-!
-! Pristine crystals
-!
- YDSD = 'GAMMA'
- ZCONC = PCT(JI,JJ,JK,4)
- IRADIUS = 20
- ZIWC = PRHO(JI,JJ,JK)*PRT(JI,JJ,JK,4)
- IANGLE = 11
- CALL BHMIE_WATER( ZWAVE_LENGTH, ZZREFIND_ICE, YDSD, ZCONC, &
- IANGLE, ZEXT_COEF, ZBAK_COEF, KRADIUS=IRADIUS, &
- PALPHA=ZALPHAI, PNU=ZNUI, PLWC=ZIWC )
- ZALPH_PAR(JI,JJ,JK) = ZALPH_PAR(JI,JJ,JK) + ZETACLD * ZEXT_COEF
- ZBETA_PAR(JI,JJ,JK) = ZBETA_PAR(JI,JJ,JK) + ZBAK_COEF
- END IF
- END DO
- END DO
- END DO
-END SELECT
-SELECT CASE ( HCLOUD )
- CASE('ICE3','ICE4','C3R5','LIMA')
- DO JK = IKB, IKE
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- IF ( PRT(JI,JJ,JK,5)>ZRTMIN(5) ) THEN
-!
-! Snow flakes
-!
- YDSD = 'MONOD'
- ZIWC = PRHO(JI,JJ,JK)*PRT(JI,JJ,JK,5)
- IF (HCLOUD=='LIMA' .AND. USNOW_T) THEN
- IF (PT(JI,JJ,JK)>263.15) THEN
- ZLBDAS = MAX(MIN(ULBDAS_MAX, 10**(14.554-0.0423*PT(JI,JJ,JK))),ULBDAS_MIN)*UTRANS_MP_GAMMAS
- ELSE
- ZLBDAS = MAX(MIN(ULBDAS_MAX, 10**(6.226-0.0106*PT(JI,JJ,JK))),ULBDAS_MIN)*UTRANS_MP_GAMMAS
- END IF
- ZCONC=ZNS*ZIWC*ZLBDAS**UBS
- ELSE IF (HCLOUD=='ICE3' .AND. WSNOW_T) THEN
- IF (PT(JI,JJ,JK)>263.15) THEN
- ZLBDAS = MAX(MIN(WLBDAS_MAX, 10**(14.554-0.0423*PT(JI,JJ,JK))),WLBDAS_MIN)*WTRANS_MP_GAMMAS
- ELSE
- ZLBDAS = MAX(MIN(WLBDAS_MAX, 10**(6.226-0.0106*PT(JI,JJ,JK))),WLBDAS_MIN)*WTRANS_MP_GAMMAS
- END IF
- ZCONC=ZNS*ZIWC*ZLBDAS**WBS
- ELSE
- ZLBDAS = ZLBS*(ZIWC)**ZLBEXS
- ZCONC = ZCCS*(ZLBDAS)**ZCXS
- END IF
- IF (ZLBDAS .GT. 0) THEN
- ZRADIUS = 0.5*(3.0/ZLBDAS) ! Assume Marshall-Palmer law for Reff
- IANGLE = 11
- CALL BHMIE_WATER( ZWAVE_LENGTH, ZZREFIND_ICE, YDSD, ZCONC, &
- IANGLE, ZEXT_COEF, ZBAK_COEF, PRADIUS=ZRADIUS )
- ZALPH_PAR(JI,JJ,JK) = ZALPH_PAR(JI,JJ,JK) + ZETACLD * ZEXT_COEF
- ZBETA_PAR(JI,JJ,JK) = ZBETA_PAR(JI,JJ,JK) + ZBAK_COEF
- END IF
- END IF
- END DO
- END DO
- END DO
-END SELECT
-SELECT CASE ( HCLOUD )
- CASE('ICE3','ICE4','C3R5','LIMA')
- DO JK = IKB, IKE
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- IF ( PRT(JI,JJ,JK,6)>ZRTMIN(6) ) THEN
-!
-! Graupel particles
-!
- YDSD = 'MONOD'
- ZIWC = PRHO(JI,JJ,JK)*PRT(JI,JJ,JK,6)
- ZLBDAG = ZLBG*(ZIWC)**ZLBEXG
- ZCONC = ZCCG*(ZLBDAG)**ZCXG
- ZRADIUS = 0.5*(3.0/ZLBDAG) ! Assume Marshall-Palmer law for Reff
- IANGLE = 11
- CALL BHMIE_WATER( ZWAVE_LENGTH, ZZREFIND_ICE, YDSD, ZCONC, &
- IANGLE, ZEXT_COEF, ZBAK_COEF, PRADIUS=ZRADIUS )
- ZALPH_PAR(JI,JJ,JK) = ZALPH_PAR(JI,JJ,JK) + ZETACLD * ZEXT_COEF
- ZBETA_PAR(JI,JJ,JK) = ZBETA_PAR(JI,JJ,JK) + ZBAK_COEF
- END IF
- END DO
- END DO
- END DO
-END SELECT
-SELECT CASE ( HCLOUD )
- CASE('ICE4')
- DO JK = IKB, IKE
- DO JJ = IJB, IJE
- DO JI = IIB, IIE
- IF ( PRT(JI,JJ,JK,7)>ZRTMIN(7) ) THEN
-!
-! Hailstones
-!
- YDSD = 'MONOD'
- ZIWC = PRHO(JI,JJ,JK)*PRT(JI,JJ,JK,7)
- ZLBDAH = XLBH*(ZIWC)**XLBEXH
- ZCONC = XCCH*(ZLBDAH)**XCXH
- ZRADIUS = 0.5*(3.0/ZLBDAH) ! Assume Marshall-Palmer law for Reff
- IANGLE = 11
- CALL BHMIE_WATER( ZWAVE_LENGTH, ZZREFIND_ICE, YDSD, ZCONC, &
- IANGLE, ZEXT_COEF, ZBAK_COEF, PRADIUS=ZRADIUS )
- ZALPH_PAR(JI,JJ,JK) = ZALPH_PAR(JI,JJ,JK) + ZETACLD * ZEXT_COEF
- ZBETA_PAR(JI,JJ,JK) = ZBETA_PAR(JI,JJ,JK) + ZBAK_COEF
- END IF
- END DO
- END DO
- END DO
-END SELECT
-!
-! -----------------------------------------------------------------------------
-!
-!* 3. PERFORMS THE BOTTOM-UP OR TOP-DOWN VERTICAL INTEGRATION
-! -------------------------------------------------------
-!
-!
-ALLOCATE(ZOPTD_TOT(SIZE(PRHO,1),SIZE(PRHO,2)))
-ALLOCATE(ZOPTD_MOL(SIZE(PRHO,1),SIZE(PRHO,2)))
-ALLOCATE(ZOPTD_PAR(SIZE(PRHO,1),SIZE(PRHO,2)))
-ZOPTD_TOT(:,:) = 0.
-ZOPTD_MOL(:,:) = 0.
-ZOPTD_PAR(:,:) = 0.
-!
-IF( HVIEW=='ZENIT' ) THEN
- IALT=IKB
- IF (PALT/=0.) THEN
- IKMIN=MINLOC(ABS(PZZ(:,:,:)-PALT))
- IALT=MIN(MAX(IKB,IKMIN(3)),IKE)
- ENDIF
- DO JK=IALT,IKE
-!
-! molecular optical depth
-!
- ZOPTD_MOL(:,:) = ZOPTD_MOL(:,:) &
- + ZALPH_MOL(:,:,JK)*(PZZ(:,:,JK)-PZZ(:,:,JK-1))
-!
-! Particular optical depth
-!
- ZOPTD_PAR(:,:) = ZOPTD_PAR(:,:) &
- + ZALPH_PAR(:,:,JK)*(PZZ(:,:,JK)-PZZ(:,:,JK-1))
-!
-! Total optical depth
-!
- ZOPTD_TOT(:,:) = ZOPTD_MOL(:,:) + ZOPTD_PAR(:,:)
-!
-! Normalized Lidar profile
-!
- PLIDAROUT(:,:,JK) = ( ZBETA_MOL(:,:,JK)+ZBETA_PAR(:,:,JK) ) &
- * EXP( -2.0*ZOPTD_TOT(:,:) )
-!
-! Normalized Lidar particle profile
-!
- PLIPAROUT(:,:,JK) = ZBETA_PAR(:,:,JK) * EXP( -2.0*ZOPTD_PAR(:,:) )
- END DO
-ELSE IF( HVIEW=='NADIR' ) THEN
- IALT=IKE
- IF (PALT/=0.) THEN
- IKMIN=MINLOC(ABS(PZZ(:,:,:)-PALT))
- IALT=MIN(MAX(IKB,IKMIN(3)),IKE)
- ENDIF
- DO JK=IALT,IKB,-1
-!
-! molecular optical depth
-!
- ZOPTD_MOL(:,:) = ZOPTD_MOL(:,:) &
- + ZALPH_MOL(:,:,JK)*(PZZ(:,:,JK)-PZZ(:,:,JK-1))
-!
-! Particular optical depth
-!
- ZOPTD_PAR(:,:) = ZOPTD_PAR(:,:) &
- + ZALPH_PAR(:,:,JK)*(PZZ(:,:,JK)-PZZ(:,:,JK-1))
-!
-! Total optical depth
-!
- ZOPTD_TOT(:,:) = ZOPTD_MOL(:,:) + ZOPTD_PAR(:,:)
-!
-! Normalized Lidar profile
-!
- PLIDAROUT(:,:,JK) = ( ZBETA_MOL(:,:,JK)+ZBETA_PAR(:,:,JK) ) &
- * EXP( -2.0*ZOPTD_TOT(:,:) )
-!
-! Normalized Lidar particle profile
-!
- PLIPAROUT(:,:,JK) = ZBETA_PAR(:,:,JK) * EXP( -2.0*ZOPTD_PAR(:,:) )
- END DO
-ENDIF
-!
-DEALLOCATE(ZOPTD_TOT,ZOPTD_MOL,ZOPTD_PAR)
-!
-!------------------------------------------------------------------------------
-!
-END SUBROUTINE LIDAR
diff --git a/src/mesonh/ext/mnh2lpdm.f90 b/src/mesonh/ext/mnh2lpdm.f90
deleted file mode 100644
index d00036b2e9da0be4bf25c177c9af6c21be11ea69..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/mnh2lpdm.f90
+++ /dev/null
@@ -1,181 +0,0 @@
-!MNH_LIC Copyright 2002-2021 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------------
-! ######spl
- PROGRAM MNH2LPDM
-! ##############
-!-----------------------------------------------------------------------------
-!**** MNH2DIF COUPLAGE MESO-NH / SPRAY.
-!
-! Auteur : Michel Bouzom, DP/SERV/ENV
-! Creation : 16.07.2002
-! Modification : 07.01.2006 (T.LAUVAUX, adaptation LPDM)
-! Modification : 04.01.2009 (F. BONNARDOT, DP/SER/ENV )
-! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-! P. Wautelet 05/11/2020: correct I/O of MNH2LPDM
-!
-!-----------------------------------------------------------------------------
-!
-!
-!
-!* 0. DECLARATIONS.
-! -------------
-!
-!* 0.1 Modules.
-!
-USE MODD_CONF, ONLY : CPROGRAM
-USE MODD_IO, ONLY : TFILEDATA, TFILE_OUTPUTLISTING, TPTR2FILE
-use modd_lunit, only: TLUOUT0
-use modd_lunit_n, only: TLUOUT
-USE MODD_MNH2LPDM
-!
-USE MODE_FIELD, ONLY: INI_FIELD_LIST, INI_FIELD_SCALARS
-USE MODE_IO, ONLY: IO_Init, IO_Config_set
-USE MODE_IO_FILE, ONLY: IO_File_open, IO_File_close
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
-USE MODE_MODELN_HANDLER
-use mode_msg
-USE MODE_POS
-!
-USE MODE_INI_CST, ONLY: INI_CST
-USE MODI_MNH2LPDM_ECH
-USE MODI_MNH2LPDM_INI
-USE MODI_VERSION
-!
-USE MODN_CONFIO
-!
-!
-!* 0.2 Variables locales.
-!
-IMPLICIT NONE
-!
-CHARACTER(LEN=*),PARAMETER :: YFLOG = 'METEO.log' ! Log filename
-CHARACTER(LEN=*),PARAMETER :: YFNML = 'MNH2LPDM1.nam' ! Namelist filename
-INTEGER, PARAMETER :: IVERB = 5
-!
-INTEGER :: IFNML ! Unit of namelist
-INTEGER :: JFIC
-LOGICAL :: GFOUND ! Return code when searching namelist
-TYPE(TPTR2FILE),DIMENSION(JPMNHMAX) :: TZFMNH ! MesoNH files
-TYPE(TFILEDATA),POINTER :: TZDATEFILE => NULL() ! Date file
-TYPE(TFILEDATA),POINTER :: TZGRIDFILE => NULL() ! Grid file
-TYPE(TFILEDATA),POINTER :: TZMETEOFILE => NULL() ! Meteo file
-TYPE(TFILEDATA),POINTER :: TZLOGFILE => NULL() ! Log file
-TYPE(TFILEDATA),POINTER :: TZNMLFILE => NULL() ! Namelist file
-!
-!
-!
-!
-!* 1. INITIALISATION.
-! ---------------
-!
-CPROGRAM='M2LPDM'
-CALL GOTO_MODEL(1)
-CALL VERSION()
-CALL IO_Init()
-CALL INI_CST()
-CALL INI_FIELD_LIST()
-CALL INI_FIELD_SCALARS()
-!
-CALL IO_File_add2list(TLUOUT0,'OUTPUT_LISTING1','OUTPUTLISTING','WRITE')
-CALL IO_File_open(TLUOUT0)
-!Set output files for PRINT_MSG
-TLUOUT => TLUOUT0
-TFILE_OUTPUTLISTING => TLUOUT0
-!
-!* 1.1 Variables generales.
-!
- CFMNH(:) = ''
-!
-!
-!* 1.2 Initialisation routines LL.
-!
-CALL IO_Init()
-!
-!
-!* 1.3 Ouverture du fichier log.
-!
-CALL IO_File_add2list(TZLOGFILE,YFLOG,'TXT','WRITE')
-CALL IO_File_open(TZLOGFILE)
-!
-!
-!* 1.4 Lecture des namelists.
-!
-CALL IO_File_add2list(TZNMLFILE,YFNML,'NML','READ')
-CALL IO_File_open(TZNMLFILE)
-IFNML = TZNMLFILE%NLU
-
-READ(UNIT=IFNML,NML=NAM_TURB)
-READ(UNIT=IFNML,NML=NAM_FIC)
-print *,'Lecture de NAM_FIC OK.'
-
-CALL POSNAM(IFNML,'NAM_CONFIO',GFOUND)
-IF (GFOUND) THEN
- READ(UNIT=IFNML,NML=NAM_CONFIO)
-END IF
-LCDF4 = .FALSE.
-LLFIOUT = .FALSE.
-LLFIREAD = .FALSE.
-CALL IO_Config_set()
-CALL IO_File_close(TZNMLFILE)
-!
-!
-!* 1.5 Comptage des FM a traiter.
-!
-IF (LEN_TRIM(CFMNH(1))>0) THEN
- NBMNH=1
- CALL IO_File_add2list(TZFMNH(1)%TZFILE,TRIM(CFMNH(1)),'MNH','READ',KLFITYPE=2,KLFIVERB=IVERB)
- DO WHILE (CFMNH(NBMNH+1).NE.'VIDE')
- NBMNH=NBMNH+1
- CALL IO_File_add2list(TZFMNH(NBMNH)%TZFILE,TRIM(CFMNH(NBMNH)),'MNH','READ',KLFITYPE=2,KLFIVERB=IVERB)
- END DO
- print *,NBMNH,' fichiers a traiter.'
-ELSE
- call Print_msg( NVERB_FATAL, 'GEN', 'MNH2LPDM', 'no CFMNH file given' )
-END IF
-!
-!
-!
-!
-!* 2. TRAITEMENTS.
-! ------------
-!
-!* 2.1 Ouverture des fichiers METEO et GRILLE et DATE.
-!
-CALL IO_File_add2list(TZGRIDFILE,CFGRI,'TXT','WRITE')
-CALL IO_File_open(TZGRIDFILE)
-CALL IO_File_add2list(TZDATEFILE,CFDAT,'TXT','WRITE')
-CALL IO_File_open(TZDATEFILE)
-!
-!
-!* 2.2 Preparation du couplage.
-!
-CALL MNH2LPDM_INI(TZFMNH(1)%TZFILE,TZFMNH(NBMNH)%TZFILE,TZLOGFILE,TZGRIDFILE,TZDATEFILE)
-!
-!
-!* 2.3 Traitement des echeances.
-!
-DO JFIC=1,NBMNH
- print*,"CFMTO(JFIC)=",CFMTO(JFIC)
- CALL IO_File_add2list(TZMETEOFILE,CFMTO(JFIC),'METEO','WRITE')
- CALL IO_File_open(TZMETEOFILE)
- CALL MNH2LPDM_ECH(TZFMNH(JFIC)%TZFILE,TZMETEOFILE)
- print*,"CLOSE_LL(CFMTO(JFIC)"
- CALL IO_File_close(TZMETEOFILE)
- TZMETEOFILE => NULL()
-END DO
-!
-!
-!* 2.4 Fermeture des fichiers, METEO, GRILLE et LOG.
-!
-CALL IO_File_close(TZGRIDFILE)
-CALL IO_File_close(TZDATEFILE)
-CALL IO_File_close(TZLOGFILE)
-!
-!
-!
-END PROGRAM MNH2LPDM
diff --git a/src/mesonh/ext/mnh2lpdm_ech.f90 b/src/mesonh/ext/mnh2lpdm_ech.f90
deleted file mode 100644
index a916c8922e4c593d22658fce09a769978a0d2163..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/mnh2lpdm_ech.f90
+++ /dev/null
@@ -1,497 +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.
-!-----------------------------------------------------------------------
-! ######spl
- SUBROUTINE MNH2LPDM_ECH(TPFILE,TPMETEOFILE)
-! ##################################################
-!-----------------------------------------------------------------------
-!**** MNH2S2_ECH TRAITEMENT D'UNE ECHEANCE.
-!
-! Auteur : Francois Bonnardot, DP/SERV/ENV
-! Creation : 07.01.2009
-! Modifications:
-! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 28/05/2018: corrected truncated integer division (1/3 -> 1./3.)
-! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-! P. Wautelet 05/11/2020: correct I/O of MNH2LPDM
-!-----------------------------------------------------------------------
-!
-!* 0. DECLARATIONS.
-! -------------
-!
-!* 0.1 Modules.
-!
-!
-!
-USE MODD_DIM_n
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_TIME_n
-USE MODD_GRID_n
-!
-USE MODD_CST
-USE MODD_PARAMETERS
-USE MODD_TIME
-!
-USE MODD_MNH2LPDM
-!
-use modd_field, only: tfieldmetadata, TYPEREAL
-USE MODE_IO_FILE, only: IO_File_close, IO_File_open
-USE MODE_IO_FIELD_READ, only: IO_Field_read
-USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
-!
-IMPLICIT NONE
-!
-!
-!* 0.2 Arguments.
-!
-TYPE(TFILEDATA),POINTER,INTENT(INOUT) :: TPFILE
-TYPE(TFILEDATA),POINTER,INTENT(IN) :: TPMETEOFILE
-!
-!
-!* 0.3 Variables locales.
-!
-CHARACTER(LEN=100) :: YFTURB ! Stockage champs de turbulence.
-INTEGER :: IFTURB
-INTEGER :: IFMTO,IREP
-INTEGER :: ICURAA,ICURMM,ICURJJ ! Date courante.
-INTEGER :: ICURHH,ICURMN,ICURSS ! Heure courante.
-INTEGER :: JI,JJ,JK
-TYPE(DATE_TIME) :: TZDTCUR
-type(tfieldmetadata) :: tzfield
-TYPE(TFILEDATA),POINTER :: TZFILE
-!
-!
-!
-!
-!* 1. INITIALISATION.
-! ---------------
-!
-!* 1.1 Blabla.
-!
-TZFILE => NULL()
-IFMTO = TPMETEOFILE%NLU
-!
-!* 2. LECTURE DES DONNEES MESO-NH DE BASE.
-! ------------------------------------
-!
-!* 2.1 Ouverture du fichier Meso-NH.
-!
-CALL IO_File_open(TPFILE)
-!
-!* 2.2 Date et heure courante.
-!
-CALL IO_Field_read(TPFILE,'DTCUR',TZDTCUR)
-!
-ICURAA=MOD(TZDTCUR%nyear,100) ! Annee sur 2 caracteres.
-ICURMM=TZDTCUR%nmonth
-ICURJJ=TZDTCUR%nday
-ICURSS=NINT(TZDTCUR%xtime)
-!
-ICURMN = NINT( (REAL(ICURSS)/60.0)/5.0 )*5 ! Heure arrondie a 5 minutes pres.
-ICURSS = 0
-ICURHH =ICURMN/60
-ICURMN =ICURMN-ICURHH*60
-!
-print*, '%%% MNH2LPDM2_ECH Date et heure des donnees :'
-print 20300, ICURJJ,ICURMM,ICURAA,ICURHH,ICURMN,ICURSS
-20300 FORMAT(I2.2,'/',I2.2,'/',I4.4,' ',I2.1,'h',I2.1,'mn',I2.1,'sec')
-!
-!
-!
-!* 2.3 Lecture des champs Meso-NH de base.
-!
-CALL IO_Field_read(TPFILE,'UT', XUT)
-CALL IO_Field_read(TPFILE,'VT', XVT)
-CALL IO_Field_read(TPFILE,'WT', XWT)
-CALL IO_Field_read(TPFILE,'THT', XTHT)
-CALL IO_Field_read(TPFILE,'TKET', XTKET)
-
-tzfield = tfieldmetadata( &
- cmnhname = 'LM', &
- clongname = '', &
- cunits = 'm', &
- cdir = 'XY', &
- ccomment = 'Mixing length', &
- ngrid = 1, &
- ntype = TYPEREAL, &
- ndims = 3 )
-CALL IO_Field_read(TPFILE, tzfield, XLM)
-
-tzfield = tfieldmetadata(&
- cmnhname = 'THW_FLX', &
- clongname = '', &
- cunits = 'K s-1', & !correct?
- cdir = 'XY', &
- ccomment = 'Conservative potential temperature vertical flux', &
- ngrid = 4, &
- ntype = TYPEREAL, &
- ndims = 3 )
-CALL IO_Field_read(TPFILE, tzfield, XWPTHP)
-
-tzfield = tfieldmetadata( &
- cmnhname = 'DISS', &
- clongname = '', &
- cunits = '', & !TODO: set units
- cdir = 'XY', &
- ccomment = 'X_Y_Z_DISS', &
- ngrid = 1, &
- ntype = TYPEREAL, &
- ndims = 3 )
-CALL IO_Field_read(TPFILE, tzfield, XDISSIP)
-
-tzfield = tfieldmetadata( &
- cmnhname = 'FMU', &
- clongname = '', &
- cunits = 'kg m-1 s-2', &
- cdir = 'XY', &
- ccomment = 'X_Y_FMU', &
- ngrid = 4, &
- ntype = TYPEREAL, &
- ndims = 2 )
-CALL IO_Field_read(TPFILE, tzfield, XSFU)
-
-tzfield = tfieldmetadata( &
- cmnhname = 'FMV', &
- clongname = '', &
- cunits = 'kg m-1 s-2', &
- cdir = 'XY', &
- ccomment = 'X_Y_FMV', &
- ngrid = 4, &
- ntype = TYPEREAL, &
- ndims = 2 )
-CALL IO_Field_read(TPFILE, tzfield, XSFV)
-
-CALL IO_Field_read(TPFILE,'INPRT', XINRT)
-CALL IO_Field_read(TPFILE,'RVT', XRMVT)
-CALL IO_Field_read(TPFILE,'RCT', XRMCT)
-CALL IO_Field_read(TPFILE,'RRT', XRMRT)
-!
-! Lecture des donnees Meso-NH terminee.'
-!
-!* 2.4 Fermeture du fichier Meso-NH.
-!
-CALL IO_File_close(TPFILE)
-!
-!
-!* 3. PREPARATION DES DONNEES.
-! ------------------------
-!
-!
-!* 3.2 Niveaux altitude "hors-sol" (1:NKMAX).
-!
-XSU(:,:,1:NKMAX) = XUT(NSIB:NSIE,NSJB:NSJE,NKB:NKE)
-XSV(:,:,1:NKMAX) = XVT(NSIB:NSIE,NSJB:NSJE,NKB:NKE)
-XSW(:,:,1:NKMAX) = XWT(NSIB:NSIE,NSJB:NSJE,NKB:NKE)
-XSTH(:,:,1:NKMAX) = XTHT(NSIB:NSIE,NSJB:NSJE,NKB:NKE)
-XSTKE(:,:,1:NKMAX) = XTKET(NSIB:NSIE,NSJB:NSJE,NKB:NKE)
-XSLM(:,:,1:NKMAX) = XLM(NSIB:NSIE,NSJB:NSJE,NKB:NKE)
-XSDISSIP(:,:,1:NKMAX) = XDISSIP(NSIB:NSIE,NSJB:NSJE,NKB:NKE)
-XSINRT(:,:) = XINRT(NSIB:NSIE,NSJB:NSJE)
-XSWPTHP(:,:,1:NKMAX) = XWPTHP(NSIB:NSIE,NSJB:NSJE,NKB:NKE)
-XSRMV(:,:,1:NKMAX) = XRMVT(NSIB:NSIE,NSJB:NSJE,NKB:NKE)
-XSRMC(:,:,1:NKMAX) = XRMCT(NSIB:NSIE,NSJB:NSJE,NKB:NKE)
-XSRMR(:,:,1:NKMAX) = XRMRT(NSIB:NSIE,NSJB:NSJE,NKB:NKE)
-XSSFU(:,:) = XSFU(NSIB:NSIE,NSJB:NSJE)
-XSSFV(:,:) = XSFV(NSIB:NSIE,NSJB:NSJE)
-!
-!
-!* 4. CALCULS DES TEMPS LAGRANGIENS ET VARIANCES DU VENT POUR LPDM.
-! ------------------------------------------------------------
-!
- XRVSRD = XRV/XRD
-!
- XSUSTAR (:,:) = XUNDEF
- XSLMO (:,:) = XUNDEF
- XSHMIX (:,:) = XUNDEF
- XSWSTAR (:,:) = XUNDEF
- XSSIGU (:,:,:) = XUNDEF
- XSSIGW (:,:,:) = XUNDEF
- XSTIMEU (:,:,:) = XUNDEF
- XSTIMEW (:,:,:) = XUNDEF
-!
- DO JI=1,NSIMAX ; DO JJ=1,NSJMAX
- !
- !* Temperature potentielle virtuelle.
- !
- XSTHETAV(:)=1.0+XSRMV(JI,JJ,:)+XSRMC(JI,JJ,:)+XSRMR(JI,JJ,:)
- XSTHETAV(:) = XSTH(JI,JJ,:)*(1.0+XSRMV(JI,JJ,:)*XRVSRD)/XSTHETAV(:)
- !
- !* ZHMIX Hauteur de melange.
- !
- XTHSOL = XSTHETAV(1)+0.5
- XSHMIX(JI,JJ) = 0.0
- DO JK=2,NKMAX
- IF ( XSTHETAV(JK).GT.XTHSOL ) THEN
- XSHMIX(JI,JJ) = XSHAUT (JK-1) &
- +( XSHAUT (JK) - XSHAUT (JK-1) ) &
- /( XSTHETAV(JK) - XSTHETAV(JK-1) ) &
- *( XTHSOL - XSTHETAV(JK-1) )
- EXIT
- ENDIF
- END DO
- XSHMIX(JI,JJ)=MAX(XSHMIX(JI,JJ),50.0)
-
- !
- !* XSUSTAR Vitesse de frottement.
- !
- XSUSTAR(JI,JJ) = XSSFU(JI,JJ)*XSSFU(JI,JJ) &
- +XSSFV(JI,JJ)*XSSFV(JI,JJ)
- XSUSTAR(JI,JJ) = SQRT(SQRT(XSUSTAR(JI,JJ)))
- !
- !
- !
- !* XSLMO Longueur de Monin-Obukhov.
- !
- IF (XSWPTHP(JI,JJ,1).NE.0.) THEN
- XSLMO(JI,JJ)= -XSTHETAV(1)*(XSUSTAR(JI,JJ)**3) &
- / (XKARMAN*XG*XSWPTHP(JI,JJ,1))
- ENDIF
- !
- !
- !* XSWSTAR Vitesse Verticale Convective.
- !
- XSWSTAR(JI,JJ)=XG/XSTHETAV(1)*XSWPTHP(JI,JJ,1)*XSHMIX(JI,JJ)
- XSWSTAR(JI,JJ)=SIGN(1.,XSWSTAR(JI,JJ)) &
- * ( ABS(XSWSTAR(JI,JJ))**(1./3.))
- !
- !
- IF (CTURBPARAM=="HANNA".OR.CTURBPARAM=="HANNABIS") THEN
- !
- IF ((XSLMO(JI,JJ).GT.0).AND.(XSLMO(JI,JJ).LE.300)) THEN
- !
- !* Conditions stables.
- !
- !* XSSIGU,XSSIGW <u'2>**0.5, <w'2>**0.5
- DO JK=1,NKMAX
- IF (XSHAUT(JK).LT.XSHMIX(JI,JJ)) THEN
- XSSIGU(JI,JJ,JK) = SQRT( 0.5 * &
- ((2.0*(1-XSHAUT(JK)/XSHMIX(JI,JJ))*XSUSTAR(JI,JJ))**2) &
- + ((1.3*(1-XSHAUT(JK)/XSHMIX(JI,JJ))*XSUSTAR(JI,JJ))**2) )
- XSSIGW(JI,JJ,JK) = 1.3*(1-XSHAUT(JK)/XSHMIX(JI,JJ)) &
- *XSUSTAR(JI,JJ)
- ELSE
- XSSIGU(JI,JJ,JK) = 0.001
- XSSIGW(JI,JJ,JK) = 0.001
- ENDIF
- ENDDO
- !
- XSSIGU(JI,JJ,:)=MAX(0.001,XSSIGU(JI,JJ,:))
- XSSIGW(JI,JJ,:)=MAX(0.001,XSSIGW(JI,JJ,:))
- !
- !* Lagrangian time scale
- XSTIMEU(JI,JJ,:) = 0.11*XSHMIX(JI,JJ)/XSSIGU(JI,JJ,:) &
- *SQRT( XSHAUT(:)/XSHMIX(JI,JJ) )
- XSTIMEW(JI,JJ,:) = 0.10*XSHMIX(JI,JJ)/XSSIGW(JI,JJ,:) &
- *( XSHAUT(:)/XSHMIX(JI,JJ) )**0.8
- !
- !
- ENDIF
- !
- !
- IF (ABS(XSLMO(JI,JJ)).GT.300) THEN
- !
- !* Conditions neutres.
- !
- !* XSSIGU,XSSIGW <u'2>**0.5, <w'2>**0.5
- XSSIGU(JI,JJ,:)=SQRT( 0.5 * &
- ((2.0*XSUSTAR(JI,JJ)*EXP(-3*XSCORIOZ(JI,JJ)*XSHAUT(:)/XSUSTAR(JI,JJ)))**2) &
- + ((1.3*XSUSTAR(JI,JJ)*EXP(-2*XSCORIOZ(JI,JJ)*XSHAUT(:)/XSUSTAR(JI,JJ)))**2) )
- XSSIGW(JI,JJ,:)=1.3*XSUSTAR(JI,JJ)*EXP(-2*XSCORIOZ(JI,JJ)*XSHAUT(:)/XSUSTAR(JI,JJ))
- XSSIGU(JI,JJ,:)=MAX(0.001,XSSIGU(JI,JJ,:))
- XSSIGW(JI,JJ,:)=MAX(0.001,XSSIGW(JI,JJ,:))
- !
- !* lagrangian time scale
- XSTIMEU(JI,JJ,:) = 0.5*XSHAUT(:)/ &
- (XSSIGW(JI,JJ,:)*(1.+15.0*XSCORIOZ(JI,JJ)*XSHAUT(:)/XSUSTAR(JI,JJ)))
- XSTIMEW(JI,JJ,:) = XSTIMEU(JI,JJ,:)
- !
- ENDIF
- !
- !
- IF ((XSLMO(JI,JJ).LT.0).AND.(XSLMO(JI,JJ).GE.-300)) THEN
- !
- !* Conditions instables.
- !
- !* XSSIGU,XSSIGW <u'2>**0.5, <w'2>**0.5
- !
- IF (CTURBPARAM=="HANNA") THEN
- !
- DO JK=1,NKMAX
- IF (XSHAUT(JK).LE.XSHMIX(JI,JJ)) THEN
- XSSIGU(JI,JJ,JK)=XSUSTAR(JI,JJ) &
- * (12+0.5*XSHMIX(JI,JJ)/ABS(XSLMO(JI,JJ)))**(1./3.)
- ELSE
- XSSIGU(JI,JJ,JK)=0.001
- ENDIF
- ENDDO
- !
- DO JK=1,NKMAX
- !IF (XSHAUT(JK).LE.XSHMIX(JI,JJ)) THEN
- ! XSSIGW(JI,JJ,JK)=SQRT( 1.2*XSWSTAR(JI,JJ)**2 &
- ! *(1-0.9*XSHAUT(JK)/XSHMIX(JI,JJ)) &
- ! *(XSHAUT(JK)/XSHMIX(JI,JJ))**(2/3) &
- ! + (1.8-1.4*XSHAUT(JK)/XSHMIX(JI,JJ)) &
- ! *XSUSTAR(JI,JJ)**2 )
- !ELSE
- IF (XSHAUT(JK).LE.0.4*XSHMIX(JI,JJ)) THEN
- XSSIGW(JI,JJ,JK)=0.763*(XSHAUT(JK)/XSHMIX(JI,JJ))**0.175
- ELSE IF (XSHAUT(JK).LE.0.96*XSHMIX(JI,JJ)) THEN
- XSSIGW(JI,JJ,JK)=0.722*XSWSTAR(JI,JJ)* &
- (1-XSHAUT(JK)/XSHMIX(JI,JJ))**0.207
- ELSE IF (XSHAUT(JK).LE.XSHMIX(JI,JJ)) THEN
- XSSIGW(JI,JJ,JK)=0.37*XSWSTAR(JI,JJ)
- ELSE
- XSSIGW(JI,JJ,JK)=0.001
- ENDIF
- ENDDO
- !
- XSSIGU(JI,JJ,:)=MAX(0.001,XSSIGU(JI,JJ,:))
- XSSIGW(JI,JJ,:)=MAX(0.001,XSSIGW(JI,JJ,:))
- !
- !* Lagrangian time scale
- XSTIMEU(JI,JJ,:) = 0.15*XSHMIX(JI,JJ)/XSSIGU(JI,JJ,:)
- DO JK=1,NKMAX
- IF (XSHAUT(JK).LE.(0.1*XSHMIX(JI,JJ))) THEN
- IF ( XSHAUT(JK).LT.(XSZ0(JI,JJ)-XSLMO(JI,JJ)) ) THEN
- XSTIMEW(JI,JJ,JK) = 0.1*XSHAUT(JK)/XSSIGW(JI,JJ,JK) &
- / ( 0.55 - 0.38*(XSHAUT(JK)-XSZ0(JI,JJ))/ABS(XSLMO(JI,JJ)))
- ELSE
- XSTIMEW(JI,JJ,JK) = 0.59*XSHAUT(JK)/XSSIGW(JI,JJ,JK)
- ENDIF
- ELSE
- XSTIMEW(JI,JJ,JK) = 0.15*XSHMIX(JI,JJ)/XSSIGW(JI,JJ,JK) &
- *( 1.-EXP(-5*XSHAUT(JK)/XSHMIX(JI,JJ)) )
- ENDIF
- END DO
- !
- ELSE IF (CTURBPARAM=="HANNABIS") THEN
- !* sigmas
- XSSIGW(JI,JJ,:) = SQRT(2./3.*XSTKE(JI,JJ,:))
- XSSIGU(JI,JJ,:) = XSSIGW(JI,JJ,:)
- !* Temps Lagrangien
- DO JK=1,NKMAX
- IF (XSHAUT(JK).LE.XSHMIX(JI,JJ)) THEN
- XSTIMEU(JI,JJ,JK)=0.17*XSHMIX(JI,JJ)/XSSIGU(JI,JJ,JK)
- XSTIMEW(JI,JJ,JK)=0.2*XSHMIX(JI,JJ)/XSSIGW(JI,JJ,JK)* &
- (1-EXP(-4*XSHAUT(JK)/XSHMIX(JI,JJ)) &
- -0.0003*EXP(8*XSHAUT(JK)/XSHMIX(JI,JJ)))
- ELSE IF (XSHAUT(JK).LE.XSHMIX(JI,JJ)*1.2) THEN
- XSTIMEU(JI,JJ,JK)= &
- (1-(XSHAUT(JK)-XSHAUT(JK-1))/(XSHAUT(JK+1)-XSHAUT(JK-1)))* &
- XSTIMEU(JI,JJ,JK-1) &
- +(XSHAUT(JK)-XSHAUT(JK-1))/(XSHAUT(JK+1)-XSHAUT(JK-1))*10000.0
- XSTIMEW(JI,JJ,JK)= &
- (1-(XSHAUT(JK)-XSHAUT(JK-1))/(XSHAUT(JK+1)-XSHAUT(JK-1)))* &
- XSTIMEW(JI,JJ,JK-1) &
- +(XSHAUT(JK)-XSHAUT(JK-1))/(XSHAUT(JK+1)-XSHAUT(JK-1))*10000.0
- ELSE
- XSTIMEU(JI,JJ,JK)=10000.0
- XSTIMEW(JI,JJ,JK)=10000.0
- ENDIF
- ENDDO
- !
- ENDIF ! CTURBPARAM=HANNA ou HANNABIS
- !
- ENDIF ! instable
- !
- ELSE ! CTURBPARAM=="ISOTROPE"
- !
- !* XSSIGU,XSSIGW <u'2>**0.5, <w'2>**0.5
- !
- XSSIGW(JI,JJ,:) = SQRT(2./3.*XSTKE(JI,JJ,:))
- XSSIGU(JI,JJ,:) = XSSIGW(JI,JJ,:)
- !
- !* Lagrangian time scale
- DO JK=1,NKMAX
- IF (XSHAUT(JK).LE.XSHMIX(JI,JJ)) THEN
- XSTIMEU(JI,JJ,JK)=ABS(2*(XSSIGU(JI,JJ,JK)**2)/(3*XSDISSIP(JI,JJ,JK)))
- XSTIMEW(JI,JJ,JK)=ABS(2*(XSSIGW(JI,JJ,JK)**2)/(3*XSDISSIP(JI,JJ,JK)))
- ELSE IF (XSHAUT(JK).LE.XSHMIX(JI,JJ)*1.2) THEN
- XSTIMEU(JI,JJ,JK)= &
- (1-(XSHAUT(JK)-XSHAUT(JK-1))/(XSHAUT(JK+1)-XSHAUT(JK-1)))*XSTIMEU(JI,JJ,JK-1) &
- +(XSHAUT(JK)-XSHAUT(JK-1))/(XSHAUT(JK+1)-XSHAUT(JK-1))*1000.0
- XSTIMEW(JI,JJ,JK)=XSTIMEU(JI,JJ,JK)
- ELSE
- XSTIMEU(JI,JJ,JK)=1000.0
- XSTIMEW(JI,JJ,JK)=1000.0
- ENDIF
- ENDDO
- !
- ENDIF
- !
- !
- END DO
- END DO
- !
- IF (IGRILLE.EQ.2) THEN
- WRITE(YFTURB,'("TURB_LPDM",5I2.2)') ICURAA,ICURMM,ICURJJ,ICURHH,ICURMN
- CALL IO_File_add2list(TZFILE,YFTURB,'TXT','WRITE')
- CALL IO_File_open(TZFILE)
- IFTURB = TZFILE%NLU
- WRITE(UNIT=IFTURB,FMT='(5A12)') "WSTAR ","USTAR ", &
- "HMIX ","LMO ", &
- "WPTHP"
- WRITE(UNIT=IFTURB,FMT='(5F12.5)') XSWSTAR(15,15),XSUSTAR(15,15), &
- XSHMIX(15,15),XSLMO(15,15), &
- XSWPTHP(15,15,1)
-
-
- WRITE(UNIT=IFTURB,FMT='(8A12)') "HAUT ","TKE ", &
- "DISS ","THETA ", &
- "SIGU ","SIGW ", &
- "TIMEU ","TIMEW "
- DO JK=1,NKMAX
- WRITE(UNIT=IFTURB,FMT='(6F12.5,2F12.1)') XSHAUT(JK),XSTKE(15,15,JK), &
- XSDISSIP(15,15,JK),XSTH(15,15,JK), &
- XSSIGU(15,15,JK),XSSIGW(15,15,JK), &
- XSTIMEU(15,15,JK),XSTIMEW(15,15,JK)
-
- ENDDO
- CALL IO_File_close(TZFILE)
- ENDIF
-!
-
-
-!
-!* 5. ECRITURES FIC MTO.
-! ------------------
-!
-!
-DO JK = 1,NKMAX
-WRITE(IFMTO) XSU(:,:,JK) ! Composante zonale du vent.
-ENDDO
-DO JK = 1,NKMAX
-WRITE(IFMTO) XSV(:,:,JK) ! Composante meridienne du vent.
-ENDDO
-DO JK = 1,NKMAX
-WRITE(IFMTO) XSW(:,:,JK) ! Vitesse verticale.
-ENDDO
-DO JK = 1,NKMAX
-WRITE(IFMTO) XSTH(:,:,JK) ! Temperature potentielle.
-ENDDO
-DO JK = 1,NKMAX
-WRITE(IFMTO) XSTKE(:,:,JK) ! Energie cinetique Turbulence
-ENDDO
-DO JK = 1,NKMAX
-WRITE(IFMTO) (XSSIGU(:,:,JK))**2 ! SigmaU
-ENDDO
-DO JK = 1,NKMAX
-WRITE(IFMTO) (XSSIGU(:,:,JK))**2 ! SigmaV
-ENDDO
-DO JK = 1,NKMAX
-WRITE(IFMTO) (XSSIGW(:,:,JK))**2 ! SigmaW
-ENDDO
-DO JK = 1,NKMAX
-WRITE(IFMTO) XSTIMEU(:,:,JK) ! Temps lagrangien U
-ENDDO
-DO JK = 1,NKMAX
-WRITE(IFMTO) XSTIMEU(:,:,JK) ! Temps lagrangien V
-ENDDO
-DO JK = 1,NKMAX
-WRITE(IFMTO) XSTIMEW(:,:,JK) ! Dissipation de TKE
-ENDDO
-WRITE(IFMTO) XSINRT
-!
-END SUBROUTINE MNH2LPDM_ECH
diff --git a/src/mesonh/ext/mnh2lpdm_ini.f90 b/src/mesonh/ext/mnh2lpdm_ini.f90
deleted file mode 100644
index a18acfcbec58726cee80ab7c9f92620c6b5c96bd..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/mnh2lpdm_ini.f90
+++ /dev/null
@@ -1,459 +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.
-!-----------------------------------------------------------------------
-! ######spl
- SUBROUTINE MNH2LPDM_INI(TPFILE1,TPFILE2,TPLOGFILE,TPGRIDFILE,TPDATEFILE)
-!--------------------------------------------------------------------------
-!* MNH2S2_INI : INITIALISATION DU COUPLAGE MESO-NH / LPDM.
-!
-! Auteur : Francois BONNARDOT, DP/SERV/ENV
-! Creation : 04.01.2009 (mnh2s2_ini.f90)
-!
-!
-! Arguments explicites.
-! ---------------------
-! TPFILE1,TPFILE2 First and last files to treat
-! TPLOGFILE Log file
-! TPGRIDFILE Grid file
-! TPDATEFILE Date file
-!
-! Modifications:
-! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-! P. Wautelet 05/11/2020: correct I/O of MNH2LPDM
-!--------------------------------------------------------------------------
-!
-!
-!
-!* 0. INITIALISATION.
-! ---------------
-!
-!* 0.1 Modules.
-!
-USE MODD_CST
-USE MODD_DIM_n
-use modd_field, only: tfieldmetadata, TYPEREAL
-USE MODD_GRID
-USE MODD_GRID_n
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LUNIT
-USE MODD_MNH2LPDM
-USE MODD_PARAMETERS
-USE MODD_TIME
-USE MODD_TIME_n
-!
-USE MODE_DATETIME
-USE MODE_GRIDPROJ
-USE MODE_IO_FILE, only: IO_File_close, IO_File_open
-USE MODE_IO_FIELD_READ, only: IO_Field_read
-USE MODE_MODELN_HANDLER
-!
-USE MODE_INI_CST, ONLY: INI_CST
-USE MODI_READ_HGRID
-USE MODI_XYTOLATLON
-!
-!* 0.2 Arguments.
-!
-IMPLICIT NONE
-!
-TYPE(TFILEDATA),POINTER,INTENT(INOUT) :: TPFILE1,TPFILE2
-TYPE(TFILEDATA),POINTER,INTENT(IN) :: TPLOGFILE
-TYPE(TFILEDATA),POINTER,INTENT(IN) :: TPGRIDFILE
-TYPE(TFILEDATA),POINTER,INTENT(IN) :: TPDATEFILE
-!
-!
-!* 0.3 Variables locales.
-!
-CHARACTER(LEN=28) :: YNAME,YDAD ! Noms du FM et de son papa.
-CHARACTER(LEN=2) :: YSTORAGE ! Type de variable.
-!
-REAL :: ZECHEANCE1,ZECHEANCE2 ! dist temp date modele - date courante
-INTEGER :: IHHMDL,IMNMDL,ISSMDL ! h - mn - s du model
-INTEGER :: IHHCUR1,IMNCUR1,ISSCUR1
-INTEGER :: IHHCUR2,IMNCUR2,ISSCUR2
-CHARACTER(LEN=14) :: YDATMDL,YDATCUR1,YDATCUR2
-!
-REAL :: XLATOR,XLONOR,XPTLAT,XPTLON
-REAL :: XXPTSOMNH,XYPTSOMNH
-INTEGER :: JI,JJ,JK,a
-INTEGER :: b,c,I
-INTEGER, DIMENSION(:), ALLOCATABLE :: TAB1D
-INTEGER, DIMENSION(:,:), ALLOCATABLE :: TAB2D
-TYPE(DATE_TIME) :: TZDTCUR1,TZDTCUR2,TZDTEXP1
-INTEGER :: IFDAT,IFGRI,IFLOG
-type(tfieldmetadata) :: tzfield
-!
-!
-!
-!* 1. INITIALISATION.
-! ---------------
-!
-IFDAT = TPDATEFILE%NLU
-IFGRI = TPGRIDFILE%NLU
-IFLOG = TPLOGFILE%NLU
-!
-CALL INI_CST
-!
-CALL GOTO_MODEL(1)
-!
-!
-!* 2. DONNEES MESO-NH.
-! ----------------
-!
-!* 2.1 Ouverture du fichier Meso-NH.
-!
-CALL IO_File_open(TPFILE1)
-CALL IO_File_open(TPFILE2)
-!
-!
-!* 2.2 Date et heure du modele.
-!
-CALL IO_Field_read(TPFILE1,'DTEXP',TZDTEXP1)
-CALL IO_Field_read(TPFILE1,'DTCUR',TZDTCUR1)
-CALL IO_Field_read(TPFILE2,'DTCUR',TZDTCUR2)
-!
-CALL DATETIME_DISTANCE(TZDTEXP1,TZDTCUR1,ZECHEANCE1)
-CALL DATETIME_DISTANCE(TZDTEXP1,TZDTCUR2,ZECHEANCE2)
-!
-IHHMDL=INT(TZDTEXP1%xtime/3600)
-IMNMDL=INT((TZDTEXP1%xtime-IHHMDL*3600)/60)
-ISSMDL=INT(TZDTEXP1%xtime-IHHMDL*3600-IMNMDL*60)
-IHHCUR1=INT(TZDTCUR1%xtime/3600)
-IMNCUR1=INT((TZDTCUR1%xtime-IHHCUR1*3600)/60)
-ISSCUR1=INT(TZDTCUR1%xtime-IHHCUR1*3600-IMNCUR1*60)
-IHHCUR2=INT(TZDTCUR2%xtime/3600)
-IMNCUR2=INT((TZDTCUR2%xtime-IHHCUR2*3600)/60)
-ISSCUR2=INT(TZDTCUR2%xtime-IHHCUR2*3600-IMNCUR2*60)
-!
-WRITE(YDATMDL, '(I4.4,5I2.2)') TZDTEXP1%nyear, TZDTEXP1%nmonth, TZDTEXP1%nday, &
- IHHMDL, IMNMDL, ISSMDL
-WRITE(YDATCUR1,'(I4.4,5I2.2)') TZDTCUR1%nyear, TZDTCUR1%nmonth, TZDTCUR1%nday, &
- IHHCUR1, IMNCUR1, ISSCUR1
-WRITE(YDATCUR2,'(I4.4,5I2.2)') TZDTCUR2%nyear, TZDTCUR2%nmonth, TZDTCUR2%nday, &
- IHHCUR2, IMNCUR2, ISSCUR2
-!
-NMDLAA=MOD( TZDTEXP1%nyear, 100 ) ! Annee arrondi a 2 chiffres.
-NMDLMM=TZDTEXP1%nmonth
-NMDLJJ=TZDTEXP1%nday
-NMDLSS=NINT(TZDTEXP1%xtime)
-!
-!* Heure du modele arrondie a 5 minutes pres.
-!
-NMDLMN = NINT( (REAL(NMDLSS)/60.0)/5.0 )*5
-NMDLSS = 0
-NMDLHH =NMDLMN/60
-NMDLMN =NMDLMN-NMDLHH*60
-!
-!* 2.3 Grille horizontale.
-!
-CALL READ_HGRID(1,TPFILE1,YNAME,YDAD,YSTORAGE)
-IF (YNAME == YDAD) THEN
-IGRILLE=1
-ELSE
-IGRILLE=2
-ENDIF
-print*,IGRILLE
-!
-! Lecture grille horizontale
-!
-NIU=NIMAX+2*JPHEXT
-NJU=NJMAX+2*JPHEXT
-NIB=1+JPHEXT
-NJB=1+JPHEXT
-NIE=NIU-JPHEXT
-NJE=NJU-JPHEXT
-!
-!
-!* 2.4 Nombre de niveaux-verticaux.
-!
-CALL IO_Field_read(TPFILE1,'KMAX',NKMAX)
-!WRITE(IFLOG,*) '%%% MNH2S2_INI Lecture du nombre de niveau OK.'
-!
-NKU = NKMAX+2*JPVEXT
-NKB = 1+JPVEXT
-NKE = NKU-JPVEXT
-!
-!
-!* 2.5 Allocations Meso-NH.
-!
-ALLOCATE( XZHAT(NKU) )
-ALLOCATE( XZS(NIU,NJU) )
-ALLOCATE( XZ0(NIU,NJU) )
-ALLOCATE( XUT(NIU,NJU,NKU))
-ALLOCATE( XVT(NIU,NJU,NKU))
-ALLOCATE( XWT(NIU,NJU,NKU))
-ALLOCATE( XTHT(NIU,NJU,NKU))
-ALLOCATE( XTKET(NIU,NJU,NKU))
-ALLOCATE( XLM(NIU,NJU,NKU))
-ALLOCATE( XDISSIP(NIU,NJU,NKU))
-ALLOCATE( XWPTHP(NIU,NJU,NKU))
-ALLOCATE( XRMVT(NIU,NJU,NKU))
-ALLOCATE( XRMCT(NIU,NJU,NKU))
-ALLOCATE( XRMRT(NIU,NJU,NKU))
-ALLOCATE( XINRT(NIU,NJU))
-ALLOCATE( XSFU(NIU,NJU))
-ALLOCATE( XSFV(NIU,NJU))
-!
-!* 2.6 Decoupage vertical.
-!
-CALL IO_Field_read(TPFILE1,'ZHAT',XZHAT)
-CALL IO_Field_read(TPFILE1,'ZTOP',XZTOP)
-!
-!* 2.7 Orographie.
-!
-CALL IO_Field_read(TPFILE1,'ZS',XZS)
-!
-!* 2.8 Rugosite Z0.
-!
-tzfield = tfieldmetadata( &
- cmnhname = 'Z0', &
- clongname = '', &
- cunits = 'm', &
- cdir = 'XY', &
- ccomment = 'X_Y_Z0', &
- ngrid = 4, &
- ntype = TYPEREAL, &
- ndims = 2 )
-CALL IO_Field_read(TPFILE1,tzfield,XZ0)
-!
-XXPTSOMNH=XXHAT(1)+(XXHAT(2)-XXHAT(1))/2
-XYPTSOMNH=XYHAT(1)+(XYHAT(2)-XYHAT(1))/2
-CALL SM_LATLON(XLATORI,XLONORI,XXPTSOMNH,XYPTSOMNH,XLATOR,XLONOR)
-!
-!* 2.9 DOMAINE D'EXTRACTION.
-! ---------------------
-!
-NSIB = NIB
-NSIE = NIE
-NSJB = NJB
-NSJE = NJE
-!
-NSIMAX = NSIE-NSIB+1
-NSJMAX = NSJE-NSJB+1
-!
-!
-!* 3. Impression de controle Meso-NH.
-! -------------------------------
-!
-! Domaine horizontal Meso-NH.
-!modif 12.2014 : passage a 1 seul domaine MesoNH
-! ---------------------------
-WRITE(IFLOG,'(I1,a12)') IGRILLE,' ngrid '
-!WRITE(IFLOG,'(a13)') '2 ngrids'
-WRITE(IFLOG,'(a13)') '1 ngrids'
-WRITE(IFLOG,'(i4,3x,a6)') NSIMAX,'nx '
-WRITE(IFLOG,'(i4,3x,a6)') NSJMAX,'ny '
-WRITE(IFLOG,'(i4,3x,a6)') NKU-2,'nz '
-WRITE(IFLOG,'(i4,3x,a6)') NKU-3,'nzg '
-WRITE(IFLOG,'(a13)') '12 npatch'
-WRITE(IFLOG,'(a13)') '0 icloud'
-WRITE(IFLOG,'(a11)') '0.0 wlon '
-WRITE(IFLOG,'(a11)') '45.0 rnlat '
-WRITE(IFLOG,'(f10.1,3x,a6)') XZHAT(NKE),'s '
-WRITE(IFLOG,'(f8.0,a8)') ZECHEANCE1,' time1 '
-WRITE(IFLOG,'(f8.0,a8)') ZECHEANCE2,' time2 '
-WRITE(IFLOG,'(a13)') '3600 dtmet '
-WRITE(IFLOG,'(a13)') 'm tunits'
-WRITE(IFLOG,'(a13)') '12 nvout '
-WRITE(IFLOG,'(6x,a8,i4)') 'u ',1
-WRITE(IFLOG,'(6x,a8,i4)') 'v ',1
-WRITE(IFLOG,'(6x,a8,i4)') 'w ',1
-WRITE(IFLOG,'(6x,a8,i4)') 'tp ',1
-WRITE(IFLOG,'(6x,a8,i4)') 'tke ',1
-WRITE(IFLOG,'(6x,a8,i4)') 'uu ',1
-WRITE(IFLOG,'(6x,a8,i4)') 'vv ',1
-WRITE(IFLOG,'(6x,a8,i4)') 'ww ',1
-WRITE(IFLOG,'(6x,a8,i4)') 'tlx ',1
-WRITE(IFLOG,'(6x,a8,i4)') 'tly ',1
-WRITE(IFLOG,'(6x,a8,i4)') 'tlz ',1
-WRITE(IFLOG,'(6x,a8,i4)') 'intopr ',1
-WRITE(IFLOG,*) ' grid structure'
-!
-!* 4. FICHIER METEO.
-! --------------
-!
-!* 4.1 Allocations.
-!
-ALLOCATE( XSHAUT(NKMAX))
-ALLOCATE( XSREL(NSIMAX,NSJMAX) )
-ALLOCATE( XSZ0(NSIMAX,NSJMAX) )
-ALLOCATE( XSCORIOZ (NSIMAX,NSJMAX) )
-ALLOCATE( XSPHI(NSIMAX,NSJMAX,NKMAX) )
-ALLOCATE( XSU(NSIMAX,NSJMAX,NKMAX))
-ALLOCATE( XSV(NSIMAX,NSJMAX,NKMAX))
-ALLOCATE( XSW(NSIMAX,NSJMAX,NKMAX))
-ALLOCATE( XSTH(NSIMAX,NSJMAX,NKMAX))
-ALLOCATE( XSTKE(NSIMAX,NSJMAX,NKMAX))
-ALLOCATE( XSLM(NSIMAX,NSJMAX,NKMAX))
-ALLOCATE( XSDISSIP(NSIMAX,NSJMAX,NKMAX))
-ALLOCATE( XSWPTHP(NSIMAX,NSJMAX,NKMAX))
-ALLOCATE( XSRMV(NSIMAX,NSJMAX,NKMAX))
-ALLOCATE( XSRMC(NSIMAX,NSJMAX,NKMAX))
-ALLOCATE( XSRMR(NSIMAX,NSJMAX,NKMAX))
-ALLOCATE( XSINRT(NSIMAX,NSJMAX))
-ALLOCATE( XSSFU(NSIMAX,NSJMAX))
-ALLOCATE( XSSFV(NSIMAX,NSJMAX))
-ALLOCATE( XSTIMEW(NSIMAX,NSJMAX,NKMAX))
-ALLOCATE( XSTIMEU(NSIMAX,NSJMAX,NKMAX))
-ALLOCATE( XSSIGW(NSIMAX,NSJMAX,NKMAX))
-ALLOCATE( XSSIGU(NSIMAX,NSJMAX,NKMAX))
-ALLOCATE( XSUSTAR(NSIMAX,NSJMAX))
-ALLOCATE( XSWSTAR(NSIMAX,NSJMAX))
-ALLOCATE( XSHMIX(NSIMAX,NSJMAX))
-ALLOCATE( XSLMO(NSIMAX,NSJMAX))
-ALLOCATE( XSTHETAV(NKMAX))
-
-!
-! 4.2. Nombre de niveaux en Z
-!
-XSHAUT(1:NKMAX) = (XZHAT(NKB:NKE)+XZHAT(NKB+1:NKE+1))/2.
-print*,"niveaux hauteur"
-DO JK=1,NKMAX
-print*,XSHAUT(JK)
-ENDDO
-!
-! 4.3. Calcul du tableau contenant les coef. de coriolis de la grille
-!
-DO JI=NSIB,NSIE ; DO JJ=NSJB,NSJE
- CALL SM_LATLON(XLATORI,XLONORI,XXHAT(JI),XYHAT(JJ),XPTLAT,XPTLON)
- XSCORIOZ(JI-1,JJ-1)=2.*XOMEGA*SIN(XPTLAT*XPI/180.)
-ENDDO ; ENDDO
-!
-!
-!* 4.4 Geometrie de la grille et positionnement.
-!
-!
-! On a besoin du point sud-ouest, c'est-a-dire de l'angle inferieur gauche
-! du domaine physique de la maille "en bas a gauche". Ca tombe bien, on
-! va travailler avec les XXHAT et les XYHAT directement.
-!
-XPASXM = XXHAT(2)-XXHAT(1) ! Pas selon X en metres.
-XPASYM = XYHAT(2)-XYHAT(1) ! Pas selon Y en metres.
-ZMAILLE = MAX(XPASXM,XPASYM)
-!
-!* 4.5 Constantes et champs constants.
-!
-!* Relief.
-!
-XSREL(:,:) = XZS(NSIB:NSIE,NSJB:NSJE)
-!
-!* Geopotentiel PHI
-!
-print*,"Geopotentiel"
-DO JK=1,NKMAX
-XSPHI(:,:,JK) = (XSREL(:,:)+XSHAUT(JK))*XG
-print*,MINVAL(XSPHI(:,:,JK)),MAXVAL(XSPHI(:,:,JK))
-ENDDO
-!
-!* Rugosite.
-!
-XSZ0(:,:) = XZ0(NSIB:NSIE,NSJB:NSJE)
-print*,"Rugosite"
-print*,MINVAL(XSZ0),MAXVAL(XSZ0)
-!
-!* 5 FICHIER DATES.
-! -------------
-!
-WRITE(IFDAT,'(A14)') YDATMDL
-WRITE(IFDAT,'(A14)') YDATCUR1
-WRITE(IFDAT,'(A14)') YDATCUR2
-!
-!* 5. FICHIER GRILLE.
-! --------------
-!
-!
-!* 5.1 Infos franchement utiles.
-!
-WRITE(IFGRI,'(F15.8,1X,A)') &
- XLON0, 'XLON0 Longitude reference (deg.deci.)'
-WRITE(IFGRI,'(F15.8,1X,A)') &
- XLAT0, 'XLAT0 Latitude reference (deg.deci.)'
-WRITE(IFGRI,'(F15.8,1X,A)') &
- XBETA, 'XBETA Rotation grille (deg.deci.)'
-WRITE(IFGRI,'(F15.8,1X,A)') XRPK, 'XRPK Facteur de conicite'
-WRITE(IFGRI,'(F15.8,1X,A)') &
- XLONOR, 'XLONOR Longitude origine (deg.deci.)'
-WRITE(IFGRI,'(F15.8,1X,A)') &
- XLATOR, 'XLATOR Latitude origine (deg.deci.)'
-WRITE(IFGRI,'(F15.1,1X,A)') XXHAT(1),'XHAT(1) Coord. Cartesienne (m)'
-WRITE(IFGRI,'(F15.1,1X,A)') XXHAT(2),'XHAT(2) Coord. Cartesienne (m)'
-WRITE(IFGRI,'(F15.1,1X,A)') XYHAT(1),'YHAT(1) Coord. Cartesienne (m)'
-WRITE(IFGRI,'(F15.1,1X,A)') XYHAT(2),'YHAT(2) Coord. Cartesienne (m)'
-!
-print*,"GRILLE"
-print*,"LON0 : ",XLON0
-print*,"LAT0 : ",XLAT0
-print*,"BETA : ",XBETA
-print*,"RPK : ",XRPK
-print*,"LONOR: ",XLONOR
-print*,"LATOR: ",XLATOR
-!
-!* 5.2 Points de grille x y z zg
-!
-WRITE(IFLOG,*)NSIMAX,' gridpoints in x direction'
-WRITE(IFLOG,'(8f10.0)')XXHAT(NSIB:NSIE)
-WRITE(IFLOG,*)NSJMAX,' gridpoints y direction'
-WRITE(IFLOG,'(8f10.0)')XYHAT(NSJB:NSJE)
-WRITE(IFLOG,*)NKMAX,' main gridpoints in z direction'
-WRITE(IFLOG,'(8f10.2)')XSHAUT(1:NKMAX)
-WRITE(IFLOG,'(i4,3x,a38)')NKU-2,'intermediate gridpoints in z direction'
-WRITE(IFLOG,'(8f10.2)')XZHAT(2:NKU-1)
-WRITE(IFLOG,*)' =================================================='
-!
-! Topographie
-!
-WRITE(IFLOG,*) 'TERRAIN TOPOGRAPHY'
-c=1
-a=0
-!modif 12/2014 : passage a une grille haute resolution MesoNH, on depasse 99
-!300 format(i2,'|',18i4)
-300 format(i3,'|',18i5)
-!400 format(i2,'|',18(f4.2))
-!400 format(i3,'|',18(f5.2))
-!301 format(3x,18('__',i2))
-301 format(3x,18('__',i3))
-ALLOCATE(TAB2D(NSIMAX,NSJMAX))
-ALLOCATE(TAB1D(NSIMAX))
-DO I=1,NSIMAX
- TAB1D(I)=I
-ENDDO
-TAB2D(:,:) = NINT(XSREL(:,:))
-DO WHILE (c.lt.(NSIMAX+1))
- DO b=NSJB,NSJE
- IF ((c+17).LT.(NSIMAX+1)) then
- a=NSJMAX-b+NSJB
- WRITE(IFLOG,300) a,TAB2D(c:c+17,a)
- ELSE
- a=NSJMAX-b+NSJB
- WRITE(IFLOG,300) a,TAB2D(c:NSIMAX,a)
- ENDIF
- ENDDO
-IF ((c+17).LT.(NSIMAX+1)) then
- WRITE(IFLOG,301) TAB1D(c:c+17)
-ELSE
- WRITE(IFLOG,301) TAB1D(c:NSIMAX)
-ENDIF
-
-c=c+18
-ENDDO
-!
-DEALLOCATE(TAB2D)
-DEALLOCATE(TAB1D)
-DEALLOCATE(XZS)
-DEALLOCATE(XZ0)
-DEALLOCATE(XZHAT)
-!
-! Fermeture du fichier Meso-NH.
-!
-CALL IO_File_close(TPFILE1)
-CALL IO_File_close(TPFILE2)
-!
-!
-!-------------------------------------------'
-print*,' FIN MNH2LPDM_INI'
-!-------------------------------------------'
-!
-!
-END SUBROUTINE MNH2LPDM_INI
diff --git a/src/mesonh/ext/modd_param_ice.F90 b/src/mesonh/ext/modd_param_ice.F90
deleted file mode 100644
index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000
diff --git a/src/mesonh/ext/modd_rain_ice_descr.F90 b/src/mesonh/ext/modd_rain_ice_descr.F90
deleted file mode 100644
index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000
diff --git a/src/mesonh/ext/modd_rain_ice_param.F90 b/src/mesonh/ext/modd_rain_ice_param.F90
deleted file mode 100644
index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000
diff --git a/src/mesonh/ext/modeln.f90 b/src/mesonh/ext/modeln.f90
deleted file mode 100644
index bd57f893d6501adffa2dfd8739dc49bd671ad13d..0000000000000000000000000000000000000000
--- 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_n, ONLY: LWARM,LSEDIC,LCONVHG,LDEPOSC, CSUBG_AUCV_RC
-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_n, 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_n
-USE MODD_NEB_n, ONLY: VSIGQSAT, LSIGMAS, LSUBG_COND
-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 (LCLOUDMODIFLM) 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_RC,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_RC, &
- 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, CCONF, 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_RC, &
- 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_RC, &
- 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/modn_param_ice.f90 b/src/mesonh/ext/modn_param_ice.f90
deleted file mode 100644
index 8b137891791fe96927ad78e64b0aad7bded08bdc..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/modn_param_ice.f90
+++ /dev/null
@@ -1 +0,0 @@
-
diff --git a/src/mesonh/ext/modn_turb.f90 b/src/mesonh/ext/modn_turb.f90
deleted file mode 100644
index 8b137891791fe96927ad78e64b0aad7bded08bdc..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/modn_turb.f90
+++ /dev/null
@@ -1 +0,0 @@
-
diff --git a/src/mesonh/ext/modn_turbn.f90 b/src/mesonh/ext/modn_turbn.f90
deleted file mode 100644
index 8b137891791fe96927ad78e64b0aad7bded08bdc..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/modn_turbn.f90
+++ /dev/null
@@ -1 +0,0 @@
-
diff --git a/src/mesonh/ext/nrcolss.f90 b/src/mesonh/ext/nrcolss.f90
deleted file mode 100644
index 4dbeaa1de9d30855774e4761cb6046206225d372..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/nrcolss.f90
+++ /dev/null
@@ -1,316 +0,0 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 init 2006/11/23 10:39:56
-!-----------------------------------------------------------------
-! ###################
- MODULE MODI_NRCOLSS
-! ###################
-!
-INTERFACE
-!
- SUBROUTINE NRCOLSS( KND, PALPHAS, PNUS, PALPHAR, PNUR, &
- PESR, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR,&
- PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
- PDINFTY, PNRCOLSS, PAG, PBS, PAS )
-!
-INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DS and DR
-!
-REAL, INTENT(IN) :: PALPHAS ! First shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUS ! Second shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PALPHAR ! First shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUR ! Second shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PESR ! Efficiency of aggregates collecting rain
-REAL, INTENT(IN) :: PFALLS ! Fall speed constant of aggregates
-REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of aggregates
-REAL, INTENT(IN) :: PFALLEXPS ! Fall speed exponential of aggregates (Thompson 2008)
-REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain
-REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain
-REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of aggregates
-REAL, INTENT(IN) :: PLBDARMAX ! Maximun slope of size distribution of rain
-REAL, INTENT(IN) :: PLBDASMIN ! Minimun slope of size distribution of aggregates
-REAL, INTENT(IN) :: PLBDARMIN ! Minimun slope of size distribution of rain
-REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
- ! which the diameter integration is performed
-REAL, INTENT(IN) :: PAG, PBS, PAS
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PNRCOLSS! Scaled fall speed difference in
- ! the mass collection kernel as a
- ! function of LAMBDAX and LAMBDAZ
-!
- END SUBROUTINE NRCOLSS
-!
-END INTERFACE
-!
- END MODULE MODI_NRCOLSS
-! ########################################################################
- SUBROUTINE NRCOLSS( KND, PALPHAS, PNUS, PALPHAR, PNUR, &
- PESR, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR,&
- PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
- PDINFTY, PNRCOLSS, PAG, PBS, PAS )
-! ########################################################################
-!
-!
-!
-!!**** * - Build up a look-up table containing the scaled fall speed
-!! difference between size distributed particles of aggregates and Z
-!!
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to integrate numerically the scaled fall
-!! speed difference between aggregates and rain for use in collection
-!! kernels FOR CONCENTRATIONS. A first integral of the form
-!!
-!! infty Dz_max
-!! / /
-!! |{| }
-!! |{| E_xz (Dx+Dz)^2 |cxDx^dx-czDz^dz| n(Dz) dDz} n(Dx) dDx
-!! |{| }
-!! / /
-!! 0 Dz_min
-!!
-!! is evaluated and normalised by a second integral of the form
-!!
-!! infty
-!! / /
-!! |{| }
-!! |{| (Dx+Dz)^2 n(Dz) dDz} n(Dx) dDx
-!! |{| }
-!! / /
-!! 0
-!!
-!! The result is stored in a two-dimensional array.
-!!
-!!** METHOD
-!! ------
-!! The free parameters of the size distribution function of aggregates and Z
-!! (slope parameter LAMBDA) are discretized with a geometrical rate in a
-!! specific range
-!! LAMBDA = exp( (Log(LAMBDA_max) - Log(LAMBDA_min))/N_interval )
-!! The two above integrals are performed using the trapezoidal scheme.
-!!
-!! EXTERNAL
-!! --------
-!! MODI_GENERAL_GAMMA: Generalized gamma distribution law
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! MODD_CST : XPI,XRHOLW
-!! MODD_RAIN_ICE_DESCR: XAS,XAS,XBS
-!!
-!! REFERENCE
-!! ---------
-!! B.S. Ferrier , 1994 : A Double-Moment Multiple-Phase Four-Class
-!! Bulk Ice Scheme,JAS,51,249-280.
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 8/11/95
-!! M. Taufour 03/2022 Adapted from rrcolss for concentration
-!! J. Wurtz 03/2022 New snow characteristics
-!!
-!-------------------------------------------------------------------------------
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE MODI_GENERAL_GAMMA
-!
-USE MODD_CST
-USE MODD_RAIN_ICE_DESCR_n
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 Declarations of dummy arguments
-! -------------------------------
-!
-!
-INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DS and DR
-!
-REAL, INTENT(IN) :: PALPHAS ! First shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUS ! Second shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PALPHAR ! First shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUR ! Second shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PESR ! Efficiency of aggregates collecting rain
-REAL, INTENT(IN) :: PFALLS ! Fall speed constant of aggregates
-REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of aggregates
-REAL, INTENT(IN) :: PFALLEXPS ! Fall speed exponential of aggregates (Thompson 2008)
-REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain
-REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain
-REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of aggregates
-REAL, INTENT(IN) :: PLBDARMAX ! Maximun slope of size distribution of rain
-REAL, INTENT(IN) :: PLBDASMIN ! Minimun slope of size distribution of aggregates
-REAL, INTENT(IN) :: PLBDARMIN ! Minimun slope of size distribution of rain
-REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
- ! which the diameter integration is performed
-REAL, INTENT(IN) :: PAG, PBS, PAS
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PNRCOLSS! Scaled fall speed difference in
- ! the mass collection kernel as a
- ! function of LAMBDAX and LAMBDAZ
-!
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-!
-INTEGER :: JLBDAS ! Slope index of the size distribution of aggregates
-INTEGER :: JLBDAR ! Slope index of the size distribution of rain
-INTEGER :: JDS ! Diameter index of a particle of aggregates
-INTEGER :: JDR ! Diameter index of a particle of rain
-!
-INTEGER :: INR ! Number of diameter step for the partial integration
-!
-!
-REAL :: ZLBDAS ! Current slope parameter LAMBDA of aggregates
-REAL :: ZLBDAR ! Current slope parameter LAMBDA of rain
-REAL :: ZDLBDAS ! Growth rate of the slope parameter LAMBDA of aggregates
-REAL :: ZDLBDAR ! Growth rate of the slope parameter LAMBDA of rain
-REAL :: ZDDS ! Integration step of the diameter of aggregates
-REAL :: ZDDSCALR! Integration step of the diameter of rain (scaling integral)
-REAL :: ZDDCOLLR! Integration step of the diameter of rain (fallspe integral)
-REAL :: ZDS ! Current diameter of the particle aggregates
-REAL :: ZDR ! Current diameter of the rain
-REAL :: ZDRMAX ! Maximal diameter of the raindrops where the integration ends
-REAL :: ZCOLLR ! Single integral of the mass weighted fall speed difference
- ! over the spectrum of rain
-REAL :: ZCOLLDRMAX ! Maximum ending point for the partial integral
-REAL :: ZCOLLSR ! Double integral of the mass weighted fall speed difference
- ! over the spectra of aggregates and rain
-REAL :: ZSCALR ! Single integral of the scaling factor over
- ! the spectrum of rain
-REAL :: ZSCALSR ! Double integral of the scaling factor over
- ! the spectra of aggregates and rain
-REAL :: ZFUNC ! Ancillary function
-REAL :: ZCST1
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1 COMPUTE THE SCALED VELOCITY DIFFERENCE IN THE MASS
-!* COLLECTION KERNEL,
-! -------------------------------------------------
-!
-!
-!
-!* 1.0 Initialization
-!
-PNRCOLSS(:,:) = 0.0
-ZCST1 = (3.0/XPI)/XRHOLW
-!
-!* 1.1 Compute the growth rate of the slope factors LAMBDA
-!
-ZDLBDAS = EXP( LOG(PLBDASMAX/PLBDASMIN)/REAL(SIZE(PNRCOLSS(:,:),1)-1) )
-ZDLBDAR = EXP( LOG(PLBDARMAX/PLBDARMIN)/REAL(SIZE(PNRCOLSS(:,:),2)-1) )
-!
-!* 1.2 Scan the slope factors LAMBDAX and LAMBDAZ
-!
-DO JLBDAS = 1,SIZE(PNRCOLSS(:,:),1)
- ZLBDAS = PLBDASMIN * ZDLBDAS ** (JLBDAS-1)
-!
-!* 1.3 Compute the diameter steps
-!
- ZDDS = PDINFTY / (REAL(KND) * ZLBDAS)
- DO JLBDAR = 1,SIZE(PNRCOLSS(:,:),2)
- ZLBDAR = PLBDARMIN * ZDLBDAR ** (JLBDAR-1)
-!
-!* 1.4 Initialize the collection integrals
-!
- ZSCALSR = 0.0
- ZCOLLSR = 0.0
-!
-!* 1.5 Compute the diameter steps
-!
- ZDDSCALR = PDINFTY / (REAL(KND) * ZLBDAR)
-!
-!* 1.6 Scan over the diameters DS and DR
-!
- DO JDS = 1,KND-1
- ZDS = ZDDS * REAL(JDS)
- ZSCALR = 0.0
- ZCOLLR = 0.0
- DO JDR = 1,KND-1
- ZDR = ZDDSCALR * REAL(JDR)
-!
-!* 1.7 Compute the normalization factor by integration over the
-! dimensional spectrum of rain
-!
- ZSCALR = ZSCALR + (ZDS+ZDR)**2 * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR)
- END DO
-!
-!* 1.8 Compute the scaled fall speed difference by partial
-! integration over the dimensional spectrum of rain
-!
- ZFUNC = PAG - PAS*ZDS**(PBS-3.0) ! approximate limit is Ds=240 microns
- IF( ZFUNC>0.0 ) THEN
- ZDRMAX = ZDS*( ZCST1*ZFUNC )**0.3333333
- ELSE
- ZDRMAX = PDINFTY / ZLBDAR
- END IF
- IF( ZDS>1.0E-4 ) THEN ! allow computation if Ds>100 microns
- ! corresponding to a maximal density of the aggregates of XRHOLW
- IF( ZDRMAX >= 0.5*ZDDSCALR ) THEN
- INR = CEILING( ZDRMAX/ZDDSCALR )
- ZDDCOLLR = ZDRMAX / REAL(INR)
- IF (INR>=KND ) THEN
- INR = KND
- ZDDCOLLR = ZDDSCALR
- END IF
- DO JDR = 1,INR-1
- ZDR = ZDDCOLLR * REAL(JDR)
- ZCOLLR = ZCOLLR + (ZDS+ZDR)**2 &
- * PESR * ABS(PFALLS*ZDS**PEXFALLS * EXP(-(PFALLEXPS*ZDS)**PALPHAS)-PFALLR*ZDR**PEXFALLR) &
- * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR)
- END DO
- ZCOLLDRMAX = (ZDS+ZDRMAX)**2 &
- * PESR * ABS(PFALLS*ZDS**PEXFALLS* EXP(-(PFALLEXPS*ZDS)**PALPHAS)-PFALLR*ZDRMAX**PEXFALLR) &
- * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDRMAX)
- ZCOLLR = (ZCOLLR + 0.5*ZCOLLDRMAX)*(ZDDCOLLR/ZDDSCALR)
-!
-!* 1.9 Compute the normalization factor by integration over the
-! dimensional spectrum of aggregates
-!
- ZFUNC = GENERAL_GAMMA(PALPHAS,PNUS,ZLBDAS,ZDS)
- ZSCALSR = ZSCALSR + ZSCALR * ZFUNC
-!
-!* 1.10 Compute the scaled fall speed difference by integration over
-! the dimensional spectrum of aggregates
-!
- ZCOLLSR = ZCOLLSR + ZCOLLR * ZFUNC
- END IF
-!
-! Otherwise ZDRMAX = 0.0 so the density of the graupel cannot be reached
-! and so PRRCOLSS(JLBDAS,JLBDAR) = 0.0 !
-!
- END IF
- END DO
-!
-!* 1.11 Scale the fall speed difference
-!
- IF( ZSCALSR>0.0 ) PNRCOLSS(JLBDAS,JLBDAR) = ZCOLLSR / ZSCALSR
- END DO
-END DO
-!
-END SUBROUTINE NRCOLSS
diff --git a/src/mesonh/ext/nscolrg.f90 b/src/mesonh/ext/nscolrg.f90
deleted file mode 100644
index 08de78478dc94cb386c188ec3b0d887960c12f43..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/nscolrg.f90
+++ /dev/null
@@ -1,317 +0,0 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 init 2006/11/23 10:43:02
-!-----------------------------------------------------------------
-! ###################
- MODULE MODI_NSCOLRG
-! ###################
-!
-INTERFACE
-!
- SUBROUTINE NSCOLRG( KND, PALPHAS, PZNUS, PALPHAR, PNUR, &
- PESR, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR,&
- PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
- PDINFTY, PNSCOLRG,PAG, PBS, PAS )
-!
-INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DS and DR
-!
-REAL, INTENT(IN) :: PALPHAS ! First shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PZNUS ! Second shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PALPHAR ! First shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUR ! Second shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PESR ! Efficiency of the aggregates collecting rain
-REAL, INTENT(IN) :: PFALLS ! Fall speed constant of the aggregates
-REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of the aggregates
-REAL, INTENT(IN) :: PFALLEXPS ! Fall speed exponential constant of the aggregates
-REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain
-REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain
-REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of the aggregates
-REAL, INTENT(IN) :: PLBDARMAX ! Maximun slope of size distribution of rain
-REAL, INTENT(IN) :: PLBDASMIN ! Minimun slope of size distribution of the aggregates
-REAL, INTENT(IN) :: PLBDARMIN ! Minimun slope of size distribution of rain
-REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
- ! which the diameter integration is performed
-REAL, INTENT(IN) :: PAG, PBS, PAS
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PNSCOLRG! Scaled fall speed difference in
- ! the mass collection kernel as a
- ! function of LAMBDAX and LAMBDAZ
-!
- END SUBROUTINE NSCOLRG
-!
-END INTERFACE
-!
- END MODULE MODI_NSCOLRG
-! ########################################################################
- SUBROUTINE NSCOLRG( KND, PALPHAS, PZNUS, PALPHAR, PNUR, &
- PESR, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR,&
- PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
- PDINFTY, PNSCOLRG,PAG, PBS, PAS )
-! ########################################################################
-!
-!
-!
-!!**** * - Build up a look-up table containing the scaled fall speed
-!! difference between size distributed particles of the aggregates and Z
-!!
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to integrate numerically the scaled fall
-!! speed difference between aggregates and rain for use in collection
-!! kernels. A first integral of the form
-!!
-!! infty Dz_max
-!! / /
-!! |{| }
-!! |{| E_xz (Dx+Dz)^2 |cxDx^dx-czDz^dz| n(Dz) dDz} n(Dx) dDx
-!! |{| }
-!! / /
-!! 0 Dz_min
-!!
-!! is evaluated and normalised by a second integral of the form
-!!
-!! infty
-!! / /
-!! |{| }
-!! |{| (Dx+Dz)^2 n(Dz) dDz} n(Dx) dDx
-!! |{| }
-!! / /
-!! 0
-!!
-!! The result is stored in a two-dimensional array.
-!!
-!!** METHOD
-!! ------
-!! The free parameters of the size distribution function of the aggregates
-!! and Z (slope parameter LAMBDA) are discretized with a geometrical rate
-!! in a specific range
-!! LAMBDA = exp( (Log(LAMBDA_max) - Log(LAMBDA_min))/N_interval )
-!! The two above integrals are performed using the trapezoidal scheme.
-!!
-!! EXTERNAL
-!! --------
-!! MODI_GENERAL_GAMMA: Generalized gamma distribution law
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! MODD_CST : XPI,XRHOLW
-!! MODD_RAIN_ICE_DESCR: XAS,XAS,XBS
-!!
-!! REFERENCE
-!! ---------
-!! B.S. Ferrier , 1994 : A Double-Moment Multiple-Phase Four-Class
-!! Bulk Ice Scheme,JAS,51,249-280.
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 8/11/95
-!! M. Taufour 03/2022 Adapted from rscolrg for concentration
-!! J. Wurtz 03/2022 New snow characteristics
-!!
-!-------------------------------------------------------------------------------
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODI_GENERAL_GAMMA
-!
-USE MODD_CST
-USE MODD_RAIN_ICE_DESCR_n
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments
-! -------------------------------
-!
-!
-INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DS and DR
-!
-REAL, INTENT(IN) :: PALPHAS ! First shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PZNUS ! Second shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PALPHAR ! First shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUR ! Second shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PESR ! Efficiency of the aggregates collecting rain
-REAL, INTENT(IN) :: PFALLS ! Fall speed constant of the aggregates
-REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of the aggregates
-REAL, INTENT(IN) :: PFALLEXPS ! Fall speed exponential constant of the aggregates
-REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain
-REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain
-REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of the aggregates
-REAL, INTENT(IN) :: PLBDARMAX ! Maximun slope of size distribution of rain
-REAL, INTENT(IN) :: PLBDASMIN ! Minimun slope of size distribution of the aggregates
-REAL, INTENT(IN) :: PLBDARMIN ! Minimun slope of size distribution of rain
-REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
- ! which the diameter integration is performed
-REAL, INTENT(IN) :: PAG, PBS, PAS
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PNSCOLRG! Scaled fall speed difference in
- ! the mass collection kernel as a
- ! function of LAMBDAX and LAMBDAZ
-!
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-!
-INTEGER :: JLBDAS ! Slope index of the size distribution of the aggregates
-INTEGER :: JLBDAR ! Slope index of the size distribution of rain
-INTEGER :: JDS ! Diameter index of a particle of the aggregates
-INTEGER :: JDR ! Diameter index of a particle of rain
-!
-INTEGER :: INR ! Number of diameter step for the partial integration
-!
-REAL :: ZLBDAS ! Current slope parameter LAMBDA of the aggregates
-REAL :: ZLBDAR ! Current slope parameter LAMBDA of rain
-REAL :: ZDLBDAS ! Growth rate of the slope parameter LAMBDA of the aggregates
-REAL :: ZDLBDAR ! Growth rate of the slope parameter LAMBDA of rain
-REAL :: ZDDS ! Integration step of the diameter of the aggregates
-REAL :: ZDDSCALR! Integration step of the diameter of rain (scaling integral)
-REAL :: ZDDCOLLR! Integration step of the diameter of rain (fallspe integral)
-REAL :: ZDS ! Current diameter of the particle aggregates
-REAL :: ZDR ! Current diameter of the raindrops
-REAL :: ZDRMIN ! Minimal diameter of the raindrops where the integration starts
-REAL :: ZDRMAX ! Maximal diameter of the raindrops where the integration ends
-REAL :: ZCOLLR ! Single integral of the mass weighted fall speed difference
- ! over the spectrum of rain
-REAL :: ZCOLLDRMIN ! Minimum ending point for the partial integral
-REAL :: ZCOLLSR ! Double integral of the mass weighted fall speed difference
- ! over the spectra of the aggregates and rain
-REAL :: ZSCALR ! Single integral of the scaling factor over
- ! the spectrum of rain
-REAL :: ZSCALSR ! Double integral of the scaling factor over
- ! the spectra of the aggregates and rain
-REAL :: ZFUNC ! Ancillary function
-REAL :: ZCST1
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1 COMPUTE THE SCALED VELOCITY DIFFERENCE IN THE MASS
-!* COLLECTION KERNEL,
-! -------------------------------------------------
-!
-!
-!* 1.0 Initialization
-!
-PNSCOLRG(:,:) = 0.0
-ZCST1 = (3.0/XPI)/XRHOLW
-!
-!* 1.1 Compute the growth rate of the slope factors LAMBDA
-!
-ZDLBDAR = EXP( LOG(PLBDARMAX/PLBDARMIN)/REAL(SIZE(PNSCOLRG(:,:),1)-1) )
-ZDLBDAS = EXP( LOG(PLBDASMAX/PLBDASMIN)/REAL(SIZE(PNSCOLRG(:,:),2)-1) )
-!
-!* 1.2 Scan the slope factors LAMBDAX and LAMBDAZ
-!
-DO JLBDAR = 1,SIZE(PNSCOLRG(:,:),1)
- ZLBDAR = PLBDARMIN * ZDLBDAR ** (JLBDAR-1)
- ZDRMAX = PDINFTY / ZLBDAR
-!
-!* 1.3 Compute the diameter steps
-!
- ZDDSCALR = PDINFTY / (REAL(KND) * ZLBDAR)
- DO JLBDAS = 1,SIZE(PNSCOLRG(:,:),2)
- ZLBDAS = PLBDASMIN * ZDLBDAS ** (JLBDAS-1)
-!
-!* 1.4 Initialize the collection integrals
-!
- ZSCALSR = 0.0
- ZCOLLSR = 0.0
-!
-!* 1.5 Compute the diameter steps
-!
- ZDDS = PDINFTY / (REAL(KND) * ZLBDAS)
-!
-!* 1.6 Scan over the diameters DS and DR
-!
- DO JDS = 1,KND-1
- ZDS = ZDDS * REAL(JDS)
- ZSCALR = 0.0
- ZCOLLR = 0.0
- DO JDR = 1,KND-1
- ZDR = ZDDSCALR * REAL(JDR)
-!
-!* 1.7 Compute the normalization factor by integration over the
-! dimensional spectrum of rain
-!
- ZSCALR = ZSCALR + (ZDS+ZDR)**2 * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR)
- END DO
-!
-!* 1.8 Compute the scaled fall speed difference by partial
-! integration over the dimensional spectrum of rain
-!
- ZFUNC = PAG - PAS*ZDS**(PBS-3.0) ! approximate limit is Ds=240 microns
- IF( ZFUNC>0.0 ) THEN
- ZDRMIN = ZDS*( ZCST1*ZFUNC )**0.3333333
- ELSE
- ZDRMIN = 0.0
- END IF
- IF( ZDS>1.0E-4 ) THEN ! allow computation if Ds>100 microns
- ! corresponding to a maximal density of the aggregates of XRHOLW
- IF( (ZDRMAX-ZDRMIN) >= 0.5*ZDDSCALR ) THEN
- INR = CEILING( (ZDRMAX-ZDRMIN)/ZDDSCALR )
- ZDDCOLLR = (ZDRMAX-ZDRMIN) / REAL(INR)
- DO JDR = 1,INR-1
- ZDR = ZDDCOLLR * REAL(JDR) + ZDRMIN
- ZCOLLR = ZCOLLR + (ZDS+ZDR)**2 &
- * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR) &
- * PESR * ABS(PFALLS*ZDS**PEXFALLS*EXP(-(ZDS*PFALLEXPS)**PALPHAS)-PFALLR*ZDR**PEXFALLR)
- END DO
- IF( ZDRMIN>0.0 ) THEN
- ZCOLLDRMIN = (ZDS+ZDRMIN)**2 &
- * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDRMIN) &
- * PESR * ABS(PFALLS*ZDS**PEXFALLS*EXP(-(ZDS*PFALLEXPS)**PALPHAS)-PFALLR*ZDRMIN**PEXFALLR)
- ELSE
- ZCOLLDRMIN = 0.0
- END IF
- ZCOLLR = (ZCOLLR + 0.5*ZCOLLDRMIN)*(ZDDCOLLR/ZDDSCALR)
-!
-!* 1.9 Compute the normalization factor by integration over the
-! dimensional spectrum of the aggregates
-!
- ZFUNC = GENERAL_GAMMA(PALPHAS,PZNUS,ZLBDAS,ZDS) ! MTaufour : !*(ZDS**PEXMASSS)
- ZSCALSR = ZSCALSR + ZSCALR * ZFUNC
-!
-!* 1.10 Compute the scaled fall speed difference by integration over
-! the dimensional spectrum of the aggregates
-!
- ZCOLLSR = ZCOLLSR + ZCOLLR * ZFUNC
-!
-! Otherwise ZDRMIN>ZDRMAX so PRRCOLSS(JLBDAS,JLBDAR) = 0.0 !
-!
- END IF
-!
-! Otherwise ZDRMAX = 0.0 so the density of the graupel cannot be reached
-! and so PRRCOLSS(JLBDAS,JLBDAR) = 0.0 !
-!
- END IF
- END DO
-!
-!* 1.10 Scale the fall speed difference
-!
- IF( ZSCALSR>0.0 ) PNSCOLRG(JLBDAR,JLBDAS) = ZCOLLSR / ZSCALSR
- END DO
-END DO
-!
-END SUBROUTINE NSCOLRG
diff --git a/src/mesonh/ext/phys_paramn.f90 b/src/mesonh/ext/phys_paramn.f90
deleted file mode 100644
index d1c53a2defe126e82caf00d1c7efce45c8b37bf0..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/phys_paramn.f90
+++ /dev/null
@@ -1,1699 +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_PHYS_PARAM_n
-! ########################
-!
-!
-INTERFACE
-!
- SUBROUTINE PHYS_PARAM_n( KTCOUNT, TPFILE, &
- PRAD, PSHADOWS, PKAFR, PGROUND, PMAFL, PDRAG,PEOL, PTURB, &
- PTRACER, PTIME_BU, PWETDEPAER, OMASKkids, OCLOUD_ONLY )
-!
-USE MODD_IO, ONLY: TFILEDATA
-use modd_precision, only: MNHTIME
-!
-INTEGER, INTENT(IN) :: KTCOUNT ! temporal iteration count
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Synchronous output file
-! advection schemes
-REAL(kind=MNHTIME), DIMENSION(2), INTENT(INOUT) :: PRAD,PSHADOWS,PKAFR,PGROUND,PTURB,PMAFL,PDRAG,PTRACER,PEOL ! to store CPU
- ! time for computing time
-REAL(kind=MNHTIME), DIMENSION(2), INTENT(INOUT) :: PTIME_BU ! time used in budget&LES budgets statistics
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PWETDEPAER
-LOGICAL, DIMENSION(:,:), INTENT(IN) :: OMASKkids ! kids domains mask
-LOGICAL, INTENT(OUT) :: OCLOUD_ONLY ! conditionnal radiation computations for
- ! the only cloudy columns
- !
-END SUBROUTINE PHYS_PARAM_n
-!
-END INTERFACE
-!
-END MODULE MODI_PHYS_PARAM_n
-!
-! ########################################################################################
- SUBROUTINE PHYS_PARAM_n( KTCOUNT, TPFILE, &
- PRAD, PSHADOWS, PKAFR, PGROUND, PMAFL, PEOL, PDRAG, PTURB, &
- PTRACER, PTIME_BU, PWETDEPAER, OMASKkids, OCLOUD_ONLY )
-! ########################################################################################
-!
-!!**** *PHYS_PARAM_n * -monitor of the parameterizations used by model _n
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to update the sources by adding the
-! parameterized terms. This is realized by sequentially calling the
-! specialized routines.
-!
-!!** METHOD
-!! ------
-!! The first parametrization is the radiation scheme:
-!! ----------------
-!! * CRAD = 'FIXE'
-!! In this case, a temporal interpolation is performed for the downward
-!! surface fluxes XFLALWD and XFLASWD.
-!! * CRAD = 'ECMWF'
-!! Several tests are performed before calling the radiation computations
-!! interface with the ECMWF radiation scheme code. A control is made to
-!! ensure that:
-!! - the full radiation code is called at the first model timestep
-!! - there is a priority for calling the full radiation instead of the
-!! cloud-only approximation if both must be called at the current
-!! timestep
-!! - the cloud-only option (approximation) is coherent with the
-!! occurence of one cloudy vertical column at least
-!! If all the above conditions are fulfilled (GRAD is .TRUE.) then the
-!! position of the sun is computed in routine SUNPOS_n and the interfacing
-!! routine RADIATIONS is called to update the radiative tendency XDTHRAD
-!! and the downward surface fluxes XFLALWD and XFLASWD. Finally, the
-!! radiative tendency is integrated as a source term in the THETA prognostic
-!! equation.
-!!
-!! The second parameterization is the soil scheme:
-!! -----------
-!!
-!! externalized surface
-!!
-!! The third parameterization is the turbulence scheme:
-!! -----------------
-!! * CTURB='NONE'
-!! no turbulent mixing is taken into account
-!! * CTURB='TKEL'
-!! The turbulent fluxes are computed according to a one and half order
-!! closure of the hydrodynamical equations. This scheme is based on a
-!! prognostic for the turbulent kinetic energy and a mixing length
-!! computation ( the mesh size or a physically based length). Other
-!! turbulent moments are diagnosed according to a stationarization of the
-!! second order turbulent moments. This turbulent scheme forecasts
-!! either a purely vertical turbulent mixing or 3-dimensional mixing
-!! according to its internal degrees of freedom.
-!!
-!!
-!! The LAST parameterization is the chemistry scheme:
-!! -----------------
-!! The chemistry part of MesoNH has two namelists, NAM_SOLVER for the
-!! parameters concerning the stiff solver, and NAM_MNHCn concerning the
-!! configuration and options of the chemistry module itself.
-!! The switch LUSECHEM in NAM_CONF acitvates or deactivates the chemistry.
-!! The only variables of MesoNH that are modified by chemistry are the
-!! scalar variables. If calculation of chemical surface fluxes is
-!! requested, those fluxes are calculated before
-!! entering the turbulence scheme, since those fluxes are taken into
-!! account by TURB as surface boundary conditions.
-!! CAUTION: chemistry has allways to be called AFTER ALL OTHER TERMS
-!! that affect the scalar variables (dynamical terms, forcing,
-!! parameterizations (like TURB, CONVECTION), since it uses the variables
-!! XRSVS as input in case of the time-split option.
-!!
-!! EXTERNAL
-!! --------
-!! Subroutine SUNPOS_n : computes the position of the sun
-!! Subroutine RADIATIONS : computes the radiative tendency and fluxes
-!! Subroutine TSZ0 : computes the surface from temporally
-!! interpolated Ts and given z0
-!! Subroutine ISBA : computes the surface fluxes from a soil scheme
-!! Subroutine TURB : computes the turbulence source terms
-!! Subroutine CONVECTION : computes the convection source term
-!! Subroutine CH_SURFACE_FLUX_n: computes the surface flux for chemical
-!! species
-!! Subroutine CH_MONITOR_n : computes the chemistry source terms
-!! that are applied to the scalar variables
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! USE MODD_DYN
-!! USE MODD_CONF
-!! USE MODD_CONF_n
-!! USE MODD_CURVCOR_n
-!! USE MODD_DYN_n
-!! USE MODD_FIELD_n
-!! USE MODD_GR_FIELD_n
-!! USE MODD_LSFIELD_n
-!! USE MODD_GRID_n
-!! USE MODD_LBC_n
-!! USE MODD_PARAM_RAD_n
-!! USE MODD_RADIATIONS_n
-!! USE MODD_REF_n
-!! USE MODD_LUNIT_n
-!! USE MODD_TIME_n
-!! USE MODD_CH_MNHC_n
-!!
-!! REFERENCE
-!! ---------
-!! None
-!!
-!! AUTHOR
-!! ------
-!! J. Stein * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 05/01/95
-!! Modifications Feb 14, 1995 (J.Cuxart) add the I/O arguments,
-!! the director cosinus and change the names of the surface fluxes
-!! Modifications March 21, 1995 (J.M.Carriere) take into account liquid
-!! water
-!! June 30,1995 (J.Stein) initialize at 0 the surf. fluxes
-!! Modifications Sept. 1, 1995 (S.Belair) ISBA scheme
-!! Modifications Sept.25, 1995 (J.Stein) switch on the radiation scheme
-!! Modifications Sept. 11, 1995 (J.-P. Pinty) radiation scheme
-!! Nov. 15, 1995 (J.Stein) cleaning + change the temporal
-!! algorithm for the soil scheme-turbulence
-!! Jan. 23, 1996 (J.Stein) add a new option for the surface
-!! fluxes where Ts and z0 are given
-!! March 18, 1996 (J.Stein) add the cloud fraction
-!! March 28, 1996 (J.Stein) the soil scheme gives energy
-!! fluxes + cleaning
-!! June 17, 1996 (Lafore) statistics of computing time
-!! August 4, 1996 (K. Suhre) add chemistry
-!! Oct. 12, 1996 (J.Stein) use XSRCM in the turbulence
-!! scheme
-!! Nov. 18, 1996 (J.-P. Pinty) add domain translation
-!! change arg. in radiations
-!! Fev. 4, 1997 (J.Viviand) change isba's calling for ice
-!! Jun. 22, 1997 (J.Stein) change the equation system and use
-!! the absolute pressure
-!! Jul. 09, 1997 (V.Masson) add directional z0
-!! Jan. 24, 1998 (P.Bechtold) add convective transport for tracers
-!! Jan. 24, 1998 (J.-P. Pinty) split SW and LW part for radiation
-!! Mai. 10, 1999 (P.Bechtold) shallow convection
-!! Oct. 20, 1999 (P.Jabouille) domain translation for turbulence
-!! Jan. 04, 2000 (V.Masson) removes TSZ0 case
-!! Jan. 04, 2000 (V.Masson) modifies albedo computation
-! Jul 02, 2000 (F.Solmon/V.Masson) adaptation for patch approach
-!! Nov. 15, 2000 (V.Masson) LES routines
-!! Nov. 15, 2000 (V.Masson) effect of slopes on surface fluxes
-!! Feb. 02, 2001 (P.Tulet) add friction velocities and aerodynamical
-!! resistance (patch approach)
-!! Jan. 04, 2000 (V.Masson) modify surf_rad_modif computation
-!! Mar. 04, 2002 (F.Solmon) new interface for radiation call
-!! Nov. 06, 2002 (V.Masson) LES budgets & budget time counters
-!! Jan. 2004 (V.Masson) surface externalization
-!! Jan. 13, 2004 (J.Escobar) bug correction : compute "GRAD" in parallel
-!! Jan. 20, 2005 (P. Tulet) add dust sedimentation
-!! Jan. 20, 2005 (P. Tulet) climatologic SSA
-!! Jan. 20, 2005 (P. Tulet) add aerosol / dust scavenging
-!! Jul. 2005 (N. Asencio) use the two-way result-fields
-!! before ground_param call
-!! May 2006 Remove EPS
-!! Oct. 2007 (J.Pergaud) Add shallow_MF
-!! Oct. 2009 (C.Lac) Introduction of different PTSTEP according to the
-!! advection schemes
-!! Oct. 2009 (V. MAsson) optimization of Pergaud et al massflux scheme
-!! Aug. 2010 (V.Masson, C.Lac) Exchange of SBL_DEPTH for
-!! reproducibility
-!! Oct. 2010 (J.Escobar) init ZTIME_LES_MF ( pb detected with g95 )
-!! Feb. 2011 (V.Masson, C.Lac) SBL_DEPTH values on outer pts
-!! for RMC01
-!! Sept.2011 (J.Escobar) init YINST_SFU ='M'
-!!
-!! Specific for 2D modeling :
-!!
-!! 06/2010 (P.Peyrille) add Call to aerozon.f90 if LAERO_FT=T
-!! to update
-!! aerosols and ozone climatology at each call to
-!! phys_param otherwise it is constant to monthly average
-!! 03/2013 (C.Lac) FIT temporal scheme
-!! 01/2014 (C.Lac) correction for the nesting of 2D surface
-!! fields if the number of the son model does not
-!! follow the number of the dad model
-!! J.Escobar 21/03/2013: for HALOK comment all NHALO=1 test
-!! 2014 (M.Faivre)
-!! 06/2016 (G.Delautier) phasage surfex 8
-!! 2016 B.VIE LIMA
-!! M. Leriche 02/2017 Avoid negative fluxes if sv=0 outside the physics domain
-!! C.Lac 10/2017 : ch_monitor and aer_monitor extracted from phys_param
-!! to be called directly by modeln as the last process
-!! 02/2018 Q.Libois ECRAD
-! P. Wautelet 28/03/2018: replace TEMPORAL_DIST by DATETIME_DISTANCE
-! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 28/03/2019: use MNHTIME for time measurement 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
-! P. Wautelet 21/11/2019: ZRG_HOUR and ZRAT_HOUR are now parameter arrays
-! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
-! F. Auguste 02/2021: add IBM
-! JL Redelsperger 03/2021: add the SW flux penetration for Ocean model case
-! P. Wautelet 30/11/2022: compute XTHW_FLUX, XRCW_FLUX and XSVW_FLUX only when needed
-! A. Costes 12/2021: add Blaze fire model
-! Q. Rodier 2022: integration with PHYEX
-!!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_ADV_n, ONLY : XRTKEMS
-USE MODD_AIRCRAFT_BALLOON, ONLY: LFLYER
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-USE MODD_BLOWSNOW, ONLY : LBLOWSNOW,XRSNOW
-USE MODD_BUDGET, ONLY: NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
- TBUDGETS, xtime_bu_process, TBUCONF
-USE MODD_CH_AEROSOL
-USE MODD_CH_MNHC_n, ONLY : LUSECHEM, &! indicates if chemistry is used
- LCH_CONV_SCAV, &
- LCH_CONV_LINOX
-USE MODD_CLOUD_MF_n
-USE MODD_CONDSAMP
-USE MODD_CONF
-USE MODD_CONF_n
-USE MODD_CST, ONLY : CST
-USE MODD_CTURB, ONLY : CSTURB
-USE MODD_CURVCOR_n
-USE MODD_DEEP_CONVECTION_n
-USE MODD_DEF_EDDY_FLUX_n ! Ajout PP
-USE MODD_DEF_EDDYUV_FLUX_n ! Ajout PP
-USE MODD_DIAG_IN_RUN, ONLY: LDIAG_IN_RUN, XCURRENT_TKE_DISS
-USE MODD_DIM_n, ONLY: NIMAX_ll, NJMAX_ll
-USE MODD_DRAGBLDG_n
-USE MODD_DRAGTREE_n
-USE MODD_DUST
-USE MODD_DYN
-USE MODD_DYN_n
-USE MODD_EOL_MAIN, ONLY: LMAIN_EOL, CMETH_EOL, NMODEL_EOL
-USE MODD_FIELD_n
-USE MODD_FRC
-USE MODD_FRC_n
-USE MODD_GRID
-USE MODD_GRID_n
-USE MODD_IBM_PARAM_n, ONLY: LIBM, XIBM_EPSI, XIBM_LS, XIBM_XMUT
-USE MODD_ICE_C1R3_DESCR, ONLY : XRTMIN_C1R3=>XRTMIN
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LATZ_EDFLX
-USE MODD_LBC_n
-USE MODD_LES
-USE MODD_LES_n, ONLY: NLES_TIMES
-USE MODD_LES_BUDGET
-USE MODD_LSFIELD_n
-USE MODD_LUNIT_n
-USE MODD_METRICS_n
-USE MODD_MNH_SURFEX_n
-USE MODD_NESTING, ONLY : XWAY,NDAD, NDXRATIO_ALL, NDYRATIO_ALL
-USE MODD_NSV, ONLY : NSV, NSV_LGBEG, NSV_LGEND, &
- NSV_SLTBEG,NSV_SLTEND,NSV_SLT,&
- NSV_AERBEG,NSV_AEREND, &
- NSV_DSTBEG,NSV_DSTEND, NSV_DST,&
- NSV_LIMA_NR,NSV_LIMA_NS,NSV_LIMA_NG,NSV_LIMA_NH
-USE MODD_OCEANH
-USE MODD_OUT_n
-USE MODD_PARAM_C2R2, ONLY : LSEDC
-USE MODD_PARAMETERS
-USE MODD_PARAM_ICE_n, ONLY : LSEDIC
-USE MODD_PARAM_KAFR_n
-USE MODD_PARAM_LIMA, ONLY : MSEDC => LSEDC, XRTMIN_LIMA=>XRTMIN
-USE MODD_PARAM_MFSHALL_n, ONLY: CMF_CLOUD
-USE MODD_PARAM_n
-USE MODD_PARAM_RAD_n
-USE MODD_PASPOL
-USE MODD_PASPOL_n
-USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
-USE MODD_PRECIP_n
-use modd_precision, only: MNHTIME
-USE MODD_RADIATIONS_n
-USE MODD_RAIN_ICE_DESCR_n, ONLY: XRTMIN
-USE MODD_REF, ONLY: LCOUPLES
-USE MODD_REF_n
-USE MODD_SALT
-USE MODD_SHADOWS_n
-USE MODD_SUB_PHYS_PARAM_n
-USE MODD_TIME_n
-USE MODD_TIME_n
-USE MODD_TIME, ONLY : TDTEXP ! Ajout PP
-USE MODD_TURB_FLUX_AIRCRAFT_BALLOON, ONLY : XTHW_FLUX, XRCW_FLUX, XSVW_FLUX
-USE MODD_TURB_n
-USE MODD_NEB_n, ONLY: NEBN
-
-USE MODE_AERO_PSD
-use mode_budget, only: Budget_store_end, Budget_store_init
-USE MODE_DATETIME
-USE MODE_DUST_PSD
-USE MODE_ll
-USE MODE_GATHER_ll
-USE MODE_MNH_TIMING
-USE MODE_MODELN_HANDLER
-USE MODE_MPPDB
-USE MODE_FILL_DIMPHYEX, ONLY: FILL_DIMPHYEX
-USE MODE_SALT_PSD
-
-USE MODI_AEROZON ! Ajout PP
-USE MODI_CONDSAMP
-USE MODI_CONVECTION
-USE MODI_DRAG_BLD
-USE MODI_DRAG_VEG
-USE MODI_DUST_FILTER
-USE MODI_EDDY_FLUX_n ! Ajout PP
-USE MODI_EDDY_FLUX_ONE_WAY_n ! Ajout PP
-USE MODI_EDDYUV_FLUX_n ! Ajout PP
-USE MODI_EDDYUV_FLUX_ONE_WAY_n ! Ajout PP
-USE MODI_EOL_MAIN
-USE MODI_GROUND_PARAM_n
-USE MODI_GRADIENT_M
-USE MODI_GRADIENT_W
-USE MODI_PASPOL
-USE MODI_RADIATIONS
-USE MODI_SALT_FILTER
-USE MODI_SEDIM_DUST
-USE MODI_SEDIM_SALT
-USE MODI_SHALLOW_MF_PACK
-USE MODI_SUNPOS_n
-USE MODI_SURF_RAD_MODIF
-USE MODI_SWITCH_SBG_LES_N
-USE MODI_TURB
-
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-INTEGER, INTENT(IN) :: KTCOUNT ! temporal iteration count
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Synchronous output file
-! advection schemes
-REAL(kind=MNHTIME), DIMENSION(2), INTENT(INOUT) :: PRAD,PSHADOWS,PKAFR,PGROUND,PTURB,PMAFL,PDRAG,PTRACER,PEOL ! to store CPU
- ! time for computing time
-REAL(kind=MNHTIME), DIMENSION(2), INTENT(INOUT) :: PTIME_BU ! time used in budget&LES budgets statistics
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PWETDEPAER
-LOGICAL, DIMENSION(:,:), INTENT(IN) :: OMASKkids ! kids domains mask
-LOGICAL, INTENT(OUT) :: OCLOUD_ONLY ! conditionnal radiation computations for
- ! the only cloudy columns
- !
-!
-!* 0.2 declarations of local variables
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFU ! surface flux of x and
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFV ! y component of wind
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFTH ! surface flux of theta
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFRV ! surface flux of vapor
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSFSV ! surface flux of scalars
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSFCO2! surface flux of CO2
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDIR_ALB ! direct albedo
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSCA_ALB ! diffuse albedo
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEMIS ! emissivity
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZTSRAD ! surface temperature
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZRGDST,ZSIGDST,ZNDST,ZSVDST
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZRGSLT,ZSIGSLT,ZNSLT,ZSVSLT
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZRGAER,ZSIGAER,ZNAER,ZSVAER
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVT
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEXN ! Atmospheric density and Exner
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSIGMF ! MF contribution to XSIGS
-!
-REAL, DIMENSION(0:24), parameter :: ZRG_HOUR = (/ 0., 0., 0., 0., 0., 32.04, 114.19, &
- 228.01, 351.25, 465.49, 557.24, &
- 616.82, 638.33, 619.43, 566.56, &
- 474.71, 359.20, 230.87, 115.72, &
- 32.48, 0., 0., 0., 0., 0. /)
-!
-REAL, DIMENSION(0:24), parameter :: ZRAT_HOUR = (/ 326.00, 325.93, 325.12, 324.41, &
- 323.16, 321.95, 322.51, 325.16, &
- 328.01, 331.46, 335.58, 340.00, &
- 345.20, 350.32, 354.20, 356.58, &
- 356.56, 355.33, 352.79, 351.34, &
- 347.00, 342.00, 337.00, 332.00, &
- 326.00 /)
-!
-!
-character(len=6) :: ynum
-INTEGER :: IHOUR ! parameters necessary for the temporal
-REAL :: ZTIME, ZDT ! interpolation
-REAL :: ZTEMP_DIST ! time between 2 instants (in seconds)
-!
-LOGICAL :: GRAD ! conditionnal call for the full radiation
- ! computations
-REAL :: ZRAD_GLOB_ll ! 'real' global parallel mask of 'GRAD'
-INTEGER :: INFO_ll ! error report of parallel routines
- ! the only cloudy columns
-!
-REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME1, ZTIME2, ZTIME3, ZTIME4 ! for computing time analysis
-REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME_LES_MF ! time spent in LES computation in shallow conv.
-LOGICAL :: GDCONV ! conditionnal call for the deep convection
- ! computations
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRC, ZRI, ZWT ! additional dummies
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZDXDY ! grid area
- ! for rc, ri, w required if main variables not allocated
-!
-INTEGER :: IIU, IJU, IKU ! dimensional indexes
-!
-INTEGER :: JSV ! Loop index for Scalar Variables
-INTEGER :: JSWB ! loop on SW spectral bands
-INTEGER :: IIB,IIE,IJB,IJE, IKB, IKE, JI,JJ
-INTEGER :: IMODEIDX
- ! index values for the Beginning or the End of the physical
- ! domain in x and y directions
-TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
-INTEGER :: IINFO_ll ! return code of parallel routine
-!
-!* variables for writing in a fm file
-!
-INTEGER :: IRESP ! IRESP : return-code if a problem appears
- !in LFI subroutines at the open of the file
-INTEGER :: ILUOUT ! logical unit numbers of output-listing
-INTEGER :: IMI ! model index
-INTEGER :: JKID ! loop index to look for the KID models
-REAL :: ZINIRADIUSI, ZINIRADIUSJ ! ORILAM initial radius
-REAL, DIMENSION(NMODE_DST) :: ZINIRADIUS ! DUST initial radius
-REAL, DIMENSION(NMODE_SLT) :: ZINIRADIUS_SLT ! Sea Salt initial radius
-REAL, DIMENSION(SIZE(XRSVS,1), SIZE(XRSVS,2), SIZE(XRSVS,3), SIZE(XRSVS,4)) :: ZRSVS
-LOGICAL :: GCLD ! conditionnal call for dust wet deposition
-! * arrays to store the surface fields before radiation and convection scheme
-! calls
-INTEGER :: IMODSON ! Number of son models of IMI with XWAY=2
-INTEGER :: IKIDM ! index loop
-INTEGER :: IGRADIENTS ! Number of horizontal gradients in turb
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSAVE_INPRR,ZSAVE_INPRS,ZSAVE_INPRG,ZSAVE_INPRH
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSAVE_INPRC,ZSAVE_PRCONV,ZSAVE_PRSCONV
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSAVE_DIRFLASWD, ZSAVE_SCAFLASWD,ZSAVE_DIRSRFSWD
-! for ocean model
-INTEGER :: JKM , JSW ! vertical index loop
-REAL :: ZSWA,TINTSW ! index for SW interpolation and int time betwenn forcings (ocean model)
-REAL, DIMENSION(:), ALLOCATABLE :: ZIZOCE(:) ! Solar flux penetrating in ocean
-REAL, DIMENSION(:), ALLOCATABLE :: ZPROSOL1(:),ZPROSOL2(:) ! Funtions for penetrating solar flux
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLENGTHM, ZLENGTHH, ZMFMOIST !OHARAT turb option from AROME (not allocated in MNH)
- ! to be moved as optional args for turb
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTDIFF, ZTDISS
-REAL, DIMENSION(:),ALLOCATABLE :: ZXHAT_ll,ZYHAT_ll ! Position x/y in the conformal
- ! plane (array on the complete domain)
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZDIST ! distance from the center of the cooling
-!
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZHGRAD ! horizontal gradient used in turb
-TYPE(DIMPHYEX_t) :: YLDIMPHYEX
-LOGICAL :: GCOMPUTE_SRC ! flag to define dimensions of SIGS and SRCT variables
-!-----------------------------------------------------------------------------
-
-NULLIFY(TZFIELDS_ll)
-IMI=GET_CURRENT_MODEL_INDEX()
-!
-ILUOUT = TLUOUT%NLU
-CALL GET_DIM_EXT_ll ('B',IIU,IJU)
-IKU=SIZE(XTHT,3)
-IKB = 1 + JPVEXT
-IKE = IKU - JPVEXT
-!
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-CALL FILL_DIMPHYEX(YLDIMPHYEX, SIZE(XTHT,1), SIZE(XTHT,2), SIZE(XTHT,3),.TRUE., NLES_TIMES)
-!
-ZTIME1 = 0.0_MNHTIME
-ZTIME2 = 0.0_MNHTIME
-ZTIME3 = 0.0_MNHTIME
-ZTIME4 = 0.0_MNHTIME
-PTIME_BU = 0._MNHTIME
-ZTIME_LES_MF = 0.0_MNHTIME
-PWETDEPAER(:,:,:,:) = 0.
-!
-!* allocation of variables used in more than one parameterization
-!
-ALLOCATE(ZSFU (IIU,IJU)) ! surface schemes + turbulence
-ALLOCATE(ZSFV (IIU,IJU))
-ALLOCATE(ZSFTH (IIU,IJU))
-ALLOCATE(ZSFRV (IIU,IJU))
-ALLOCATE(ZSFSV (IIU,IJU,NSV))
-ALLOCATE(ZSFCO2(IIU,IJU))
-!
-!* if XWAY(son)=2 save surface fields before radiation or convective scheme
-! calls
-!
-IMODSON = 0
-DO JKID = IMI+1,NMODEL ! min value of the possible kids
- IF (IMI == NDAD(JKID) .AND. XWAY(JKID) == 2. .AND. CPROGRAM=='MESONH' &
- .AND. (CCONF == 'RESTA' .OR. (CCONF == 'START' .AND. KTCOUNT /= 1))) THEN
- IMODSON = IMODSON + 1
- END IF
-END DO
-!
- IF (IMODSON /= 0 ) THEN
- IF (LUSERC .AND. ( &
- (LSEDIC .AND. CCLOUD(1:3) == 'ICE') .OR. &
- (LSEDC .AND. (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO')) .OR. &
- (MSEDC .AND. CCLOUD=='LIMA') &
- )) THEN
- ALLOCATE( ZSAVE_INPRC(SIZE(XINPRC,1),SIZE(XINPRC,2),IMODSON))
- ELSE
- ALLOCATE( ZSAVE_INPRC(0,0,0))
- END IF
- IF (LUSERR) THEN
- ALLOCATE( ZSAVE_INPRR(SIZE(XINPRR,1),SIZE(XINPRR,2),IMODSON))
- ELSE
- ALLOCATE( ZSAVE_INPRR(0,0,0))
- END IF
- IF (LUSERS) THEN
- ALLOCATE( ZSAVE_INPRS(SIZE(XINPRS,1),SIZE(XINPRS,2),IMODSON))
- ELSE
- ALLOCATE( ZSAVE_INPRS(0,0,0))
- END IF
- IF (LUSERG) THEN
- ALLOCATE( ZSAVE_INPRG(SIZE(XINPRG,1),SIZE(XINPRG,2),IMODSON))
- ELSE
- ALLOCATE( ZSAVE_INPRG(0,0,0))
- END IF
- IF (LUSERH) THEN
- ALLOCATE( ZSAVE_INPRH(SIZE(XINPRH,1),SIZE(XINPRH,2),IMODSON))
- ELSE
- ALLOCATE( ZSAVE_INPRH(0,0,0))
- END IF
- IF (CDCONV /= 'NONE') THEN
- ALLOCATE( ZSAVE_PRCONV(SIZE(XPRCONV,1),SIZE(XPRCONV,2),IMODSON))
- ALLOCATE( ZSAVE_PRSCONV(SIZE(XPRSCONV,1),SIZE(XPRSCONV,2),IMODSON))
- ELSE
- ALLOCATE( ZSAVE_PRCONV(0,0,0))
- ALLOCATE( ZSAVE_PRSCONV(0,0,0))
- END IF
- IF (CRAD /= 'NONE') THEN
- ALLOCATE( ZSAVE_DIRFLASWD(SIZE(XDIRFLASWD,1),SIZE(XDIRFLASWD,2),SIZE(XDIRFLASWD,3),IMODSON))
- ALLOCATE( ZSAVE_SCAFLASWD(SIZE(XSCAFLASWD,1),SIZE(XSCAFLASWD,2),SIZE(XSCAFLASWD,3),IMODSON))
- ALLOCATE( ZSAVE_DIRSRFSWD(SIZE(XDIRSRFSWD,1),SIZE(XDIRSRFSWD,2),SIZE(XDIRSRFSWD,3),IMODSON))
- ELSE
- ALLOCATE( ZSAVE_DIRFLASWD(0,0,0,0))
- ALLOCATE( ZSAVE_SCAFLASWD(0,0,0,0))
- ALLOCATE( ZSAVE_DIRSRFSWD(0,0,0,0))
- END IF
- ENDIF
-!
-IKIDM=0
-DO JKID = IMI+1,NMODEL ! min value of the possible kids
- IF (IMI == NDAD(JKID) .AND. XWAY(JKID) == 2. .AND. CPROGRAM=='MESONH' &
- .AND. (CCONF == 'RESTA' .OR. (CCONF == 'START' .AND. KTCOUNT /= 1))) THEN
-! BUG if number of the son does not follow the number of the dad
-! IKIDM = JKID-IMI
- IKIDM = IKIDM + 1
- IF (LUSERC .AND. ( &
- (LSEDIC .AND. CCLOUD(1:3) == 'ICE') .OR. &
- (LSEDC .AND. (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO')) .OR. &
- (MSEDC .AND. CCLOUD=='LIMA') &
- )) THEN
- ZSAVE_INPRC(:,:,IKIDM) = XINPRC(:,:)
- END IF
- IF (LUSERR) THEN
- ZSAVE_INPRR(:,:,IKIDM) = XINPRR(:,:)
- END IF
- IF (LUSERS) THEN
- ZSAVE_INPRS(:,:,IKIDM) = XINPRS(:,:)
- END IF
- IF (LUSERG) THEN
- ZSAVE_INPRG(:,:,IKIDM) = XINPRG(:,:)
- END IF
- IF (LUSERH) THEN
- ZSAVE_INPRH(:,:,IKIDM) = XINPRH(:,:)
- END IF
- IF (CDCONV /= 'NONE') THEN
- ZSAVE_PRCONV(:,:,IKIDM) = XPRCONV(:,:)
- ZSAVE_PRSCONV(:,:,IKIDM) = XPRSCONV(:,:)
- END IF
- IF (CRAD /= 'NONE') THEN
- ZSAVE_DIRFLASWD(:,:,:,IKIDM) = XDIRFLASWD(:,:,:)
- ZSAVE_SCAFLASWD(:,:,:,IKIDM) = XSCAFLASWD(:,:,:)
- ZSAVE_DIRSRFSWD(:,:,:,IKIDM) = XDIRSRFSWD(:,:,:)
- END IF
- ENDIF
-END DO
-!
-!-----------------------------------------------------------------------------
-!
-!* 1. RADIATION SCHEME
-! ----------------
-!
-!
-XTIME_BU_PROCESS = 0.
-XTIME_LES_BU_PROCESS = 0.
-!
-CALL SECOND_MNH2(ZTIME1)
-!
-!
-!* 1.1 Tests to control how the radiation package should be called (at the current timestep)
-! -----------------------------------------------------------
-!
-!
-GRAD = .FALSE.
-OCLOUD_ONLY = .FALSE.
-!
-IF (CRAD /='NONE') THEN
-!
-! test to see if the partial radiations for cloudy must be called
-!
- IF (CRAD =='ECMW' .OR. CRAD =='ECRA') THEN
- CALL DATETIME_DISTANCE(TDTRAD_CLONLY,TDTCUR,ZTEMP_DIST)
- IF( MOD(NINT(ZTEMP_DIST/XTSTEP),NINT(XDTRAD_CLONLY/XTSTEP))==0 ) THEN
- TDTRAD_CLONLY = TDTCUR
- GRAD = .TRUE.
- OCLOUD_ONLY = .TRUE.
- END IF
- END IF
-!
-! test to see if the full radiations must be called
-!
- CALL DATETIME_DISTANCE(TDTCUR,TDTRAD_FULL,ZTEMP_DIST)
- IF( MOD(NINT(ZTEMP_DIST/XTSTEP),NINT(XDTRAD/XTSTEP))==0 ) THEN
- TDTRAD_FULL = TDTCUR
- GRAD = .TRUE.
- OCLOUD_ONLY = .FALSE.
- END IF
-!
-! tests to see if any cloud exists
-!
- IF (CRAD =='ECMW' .OR. CRAD =='ECRA') THEN
- IF (GRAD .AND. NRR.LE.3 ) THEN
- IF( MAX(MAXVAL(XCLDFR(:,:,:)),MAXVAL(XICEFR(:,:,:))).LE. 1.E-10 .AND. OCLOUD_ONLY ) THEN
- GRAD = .FALSE. ! only the cloudy verticals would be
- ! refreshed but there is no clouds
- END IF
- END IF
-!
- IF (GRAD .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. OCLOUD_ONLY ) THEN
- GRAD = .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. OCLOUD_ONLY ) THEN
- GRAD = .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. OCLOUD_ONLY ) THEN
- GRAD = .FALSE. ! only the cloudy verticals would be
- ! refreshed but there is no cloudwater and ice
- END IF
- END IF
- END IF
- END IF
-!
-END IF
-!
-! global parallel mask for 'GRAD'
-ZRAD_GLOB_ll = 0.0
-IF (GRAD) ZRAD_GLOB_ll = 1.0
-CALL REDUCESUM_ll(ZRAD_GLOB_ll,INFO_ll)
-if (ZRAD_GLOB_ll .NE. 0.0 ) GRAD = .TRUE.
-!
-!
-IF( GRAD ) THEN
- ALLOCATE(ZCOSZEN(IIU,IJU))
- ALLOCATE(ZSINZEN(IIU,IJU))
- ALLOCATE(ZAZIMSOL(IIU,IJU))
-!
-!
-!* 1.2. Astronomical computations
-! -------------------------
-!
-! Ajout PP
-IF (.NOT. OCLOUD_ONLY .AND. KTCOUNT /= 1) THEN
- IF (LAERO_FT) THEN
- CALL AEROZON (XPABST,XTHT,XTSRAD,XLAT,XLON,TDTCUR,TDTEXP, &
- NDLON,NFLEV,CAER,NAER,NSTATM, &
- XSINDEL,XCOSDEL,XTSIDER,XCORSOL, &
- XSTATM,XOZON, XAER)
- XAER_CLIM = XAER
- END IF
-END IF
-!
-CALL SUNPOS_n ( XZENITH, ZCOSZEN, ZSINZEN, ZAZIMSOL )
-!
-!* 1.3 Call to radiation scheme
-! ------------------------
-!
- SELECT CASE ( CRAD )
-!
-!* 1.3.1 TOP of Atmposphere radiation
-! ----------------------------
- CASE('TOPA')
-!
- XFLALWD (:,:) = 300.
- DO JSWB=1,NSWB_MNH
- XDIRFLASWD(:,:,JSWB) = CST%XI0 * MAX(COS(XZENITH(:,:)),0.)/REAL(NSWB_MNH)
- XSCAFLASWD(:,:,JSWB) = 0.
- END DO
- XDTHRAD(:,:,:) = 0.
-
-!
-!* 1.3.1 FIXEd radiative surface fluxes
-! ------------------------------
-!
- CASE('FIXE')
- ZTIME = MOD(TDTCUR%xtime +XLON0*240., CST%XDAY)
- IHOUR = INT( ZTIME/3600. )
- IF (IHOUR < 0) IHOUR=IHOUR + 24
- ZDT = ZTIME/3600. - REAL(IHOUR)
- XDIRFLASWD(:,:,:) =(( ZRG_HOUR(IHOUR+1)-ZRG_HOUR(IHOUR) )*ZDT + ZRG_HOUR(IHOUR)) / REAL(NSWB_MNH)
- XFLALWD (:,:) = (ZRAT_HOUR(IHOUR+1)-ZRAT_HOUR(IHOUR))*ZDT + ZRAT_HOUR(IHOUR)
- DO JSWB=1,NSWB_MNH
- WHERE(ZCOSZEN(:,:)<0.) XDIRFLASWD(:,:,JSWB) = 0.
- END DO
-
- XSCAFLASWD(:,:,:) = XDIRFLASWD(:,:,:) * 0.2
- XDIRFLASWD(:,:,:) = XDIRFLASWD(:,:,:) * 0.8
- XDTHRAD(:,:,:) = 0.
- !
-!
-!* 1.3.2 ECMWF or ECRAD radiative surface and atmospheric fluxes
-! ----------------------------------------------
-!
- CASE('ECMW' , 'ECRA')
- IF (LLES_MEAN) OCLOUD_ONLY=.FALSE.
- XRADEFF(:,:,:)=0.0
- XSWU(:,:,:)=0.0
- XSWD(:,:,:)=0.0
- XLWU(:,:,:)=0.0
- XLWD(:,:,:)=0.0
- XDTHRADSW(:,:,:)=0.0
- XDTHRADLW(:,:,:)=0.0
- CALL RADIATIONS( TPFILE, &
- LCLEAR_SKY, OCLOUD_ONLY, NCLEARCOL_TM1, CEFRADL, CEFRADI, COPWSW, COPISW, &
- COPWLW, COPILW, XFUDG, &
- NDLON, NFLEV, NRAD_DIAG, NFLUX, NRAD, NAER, NSWB_OLD, NSWB_MNH, NLWB_MNH, &
- NSTATM, NRAD_COLNBR, ZCOSZEN, XSEA, XCORSOL, &
- XDIR_ALB, XSCA_ALB, XEMIS, MAX(XCLDFR,XICEFR), XCCO2, XTSRAD, XSTATM, XTHT, XRT, &
- XPABST, XOZON, XAER,XDST_WL, XAER_CLIM, XSVT, &
- XDTHRAD, XFLALWD, XDIRFLASWD, XSCAFLASWD, XRHODREF, XZZ , &
- XRADEFF, XSWU, XSWD, XLWU, XLWD, XDTHRADSW, XDTHRADLW )
-!
-
- WRITE(UNIT=ILUOUT,FMT='(" RADIATIONS called for KTCOUNT=",I6, &
- & "with the CLOUD_ONLY option set ",L2)') KTCOUNT,OCLOUD_ONLY
-!
- !
- WHERE (XDIRFLASWD.LT.0.0)
- XDIRFLASWD=0.0
- ENDWHERE
- !
- WHERE (XDIRFLASWD.GT.1500.0)
- XDIRFLASWD=1500.0
- ENDWHERE
- !
- WHERE (XSCAFLASWD.LT.0.0)
- XSCAFLASWD=0.0
- ENDWHERE
- !
- WHERE (XSCAFLASWD.GT.1500.0)
- XSCAFLASWD=1500.0
- ENDWHERE
- !
- WHERE( XDIRFLASWD(:,:,1) + XSCAFLASWD(:,:,1) >0. )
- XALBUV(:,:) = ( XDIR_ALB(:,:,1) * XDIRFLASWD(:,:,1) &
- + XSCA_ALB(:,:,1) * XSCAFLASWD(:,:,1) ) &
- / (XDIRFLASWD(:,:,1) + XSCAFLASWD(:,:,1) )
- ELSEWHERE
- XALBUV(:,:) = XDIR_ALB(:,:,1)
- END WHERE
-!
- END SELECT
-!
- CALL SECOND_MNH2(ZTIME2)
-!
- PRAD = PRAD + ZTIME2 - ZTIME1
-!
- ZTIME1 = ZTIME2
-!
- CALL SURF_RAD_MODIF (XMAP, XDXHAT, XDYHAT, XXHAT, XYHAT, &
- ZCOSZEN, ZSINZEN, ZAZIMSOL, XZS, XZS_XY, &
- XDIRFLASWD, XDIRSRFSWD )
-!
-!* Azimuthal angle to be sent later to surface processes
-! Defined in radian, clockwise, from North
-!
- XAZIM = ZAZIMSOL
-!
- CALL SECOND_MNH2(ZTIME2)
-!
- PSHADOWS = PSHADOWS + ZTIME2 - ZTIME1
-!
- ZTIME1 = ZTIME2
-!
- DEALLOCATE(ZCOSZEN)
- DEALLOCATE(ZSINZEN)
- DEALLOCATE(ZAZIMSOL)
-!
-END IF
-!
-!
-!* 1.4 control prints
-! --------------
-!
-!* 1.5 Radiative tendency integration
-! ------------------------------
-!
-IF (CRAD /='NONE') THEN
- if ( TBUCONF%LBUDGET_th ) call Budget_store_init( TBUDGETS(NBUDGET_TH), 'RAD', xrths(:, :, :) )
- XRTHS(:,:,:) = XRTHS(:,:,:) + XRHODJ(:,:,:)*XDTHRAD(:,:,:)
- if ( TBUCONF%LBUDGET_th ) call Budget_store_end ( TBUDGETS(NBUDGET_TH), 'RAD', xrths(:, :, :) )
-END IF
-!
-!
-!* 1.6 Ocean case:
-! Sfc turbulent fluxes & Radiative tendency due to SW penetrating ocean
-!
-IF (LCOUPLES) THEN
-ZSFU(:,:)= XSSUFL_C(:,:,1)
-ZSFV(:,:)= XSSVFL_C(:,:,1)
-ZSFTH(:,:)= XSSTFL_C(:,:,1)
-ZSFRV(:,:)=XSSRFL_C(:,:,1)
-ELSE
-IF (LOCEAN) THEN
-!
- ALLOCATE( ZIZOCE(IKU)); ZIZOCE(:)=0.
- ALLOCATE( ZPROSOL1(IKU))
- ALLOCATE( ZPROSOL2(IKU))
- ALLOCATE(XSSOLA(IIU,IJU))
- ! Time interpolation
- JSW = INT(TDTCUR%xtime/REAL(NINFRT))
- ZSWA = TDTCUR%xtime/REAL(NINFRT)-REAL(JSW)
- ZSFRV = 0.
- ZSFTH = (XSSTFL_T(JSW+1)*(1.-ZSWA)+XSSTFL_T(JSW+2)*ZSWA)
- ZSFU = (XSSUFL_T(JSW+1)*(1.-ZSWA)+XSSUFL_T(JSW+2)*ZSWA)
- ZSFV = (XSSVFL_T(JSW+1)*(1.-ZSWA)+XSSVFL_T(JSW+2)*ZSWA)
-!
- ZIZOCE(IKU) = XSSOLA_T(JSW+1)*(1.-ZSWA)+XSSOLA_T(JSW+2)*ZSWA
- ZPROSOL1(IKU) = CST%XROC*ZIZOCE(IKU)
- ZPROSOL2(IKU) = (1.-CST%XROC)*ZIZOCE(IKU)
- if ( TBUCONF%LBUDGET_th ) call Budget_store_init( TBUDGETS(NBUDGET_TH), 'OCEAN', xrths(:, :, :) )
- DO JKM=IKU-1,2,-1
- ZPROSOL1(JKM) = ZPROSOL1(JKM+1)* exp(-XDZZ(2,2,JKM)/CST%XD1)
- ZPROSOL2(JKM) = ZPROSOL2(JKM+1)* exp(-XDZZ(2,2,JKM)/CST%XD2)
- ZIZOCE(JKM) = (ZPROSOL1(JKM+1)-ZPROSOL1(JKM) + ZPROSOL2(JKM+1)-ZPROSOL2(JKM))/XDZZ(2,2,JKM)
- ! Adding to temperature tendency, the solar radiation penetrating in ocean
- XRTHS(:,:,JKM) = XRTHS(:,:,JKM) + XRHODJ(:,:,JKM)*ZIZOCE(JKM)
- END DO
- if ( TBUCONF%LBUDGET_th ) call Budget_store_end ( TBUDGETS(NBUDGET_TH), 'OCEAN', xrths(:, :, :) )
- DEALLOCATE (XSSOLA)
- DEALLOCATE( ZIZOCE)
- DEALLOCATE (ZPROSOL1)
- DEALLOCATE (ZPROSOL2)
-END IF! LOCEAN NO LCOUPLES
-END IF!NO LCOUPLES
-!
-!
-CALL SECOND_MNH2(ZTIME2)
-!
-PRAD = PRAD + ZTIME2 - ZTIME1 &
- - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
-!
-PTIME_BU = PTIME_BU + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
-!
-!
-!-----------------------------------------------------------------------------
-!
-!* 2. DEEP CONVECTION SCHEME
-! ----------------------
-!
-ZTIME1 = ZTIME2
-XTIME_BU_PROCESS = 0.
-XTIME_LES_BU_PROCESS = 0.
-!
-CALL SECOND_MNH2(ZTIME1)
-!
-IF( CDCONV == 'KAFR' .OR. CSCONV == 'KAFR' ) THEN
-
- if ( TBUCONF%LBUDGET_th ) call Budget_store_init( TBUDGETS(NBUDGET_TH), 'DCONV', xrths(:, :, :) )
- if ( TBUCONF%LBUDGET_rv ) call Budget_store_init( TBUDGETS(NBUDGET_RV), 'DCONV', xrrs (:, :, :, 1) )
- if ( TBUCONF%LBUDGET_rc ) call Budget_store_init( TBUDGETS(NBUDGET_RC), 'DCONV', xrrs (:, :, :, 2) )
- if ( TBUCONF%LBUDGET_ri ) call Budget_store_init( TBUDGETS(NBUDGET_RI), 'DCONV', xrrs (:, :, :, 4) )
- if ( TBUCONF%LBUDGET_sv .and. lchtrans ) then
- do jsv = 1, size( xrsvs, 4 )
- call Budget_store_init( TBUDGETS(NBUDGET_SV1 - 1 + jsv), 'DCONV', xrsvs (:, :, :, jsv) )
- end do
- end if
-!
-! test to see if the deep convection scheme should be called
-!
- GDCONV = .FALSE.
-!
- CALL DATETIME_DISTANCE(TDTDCONV,TDTCUR,ZTEMP_DIST)
- IF( MOD(NINT(ZTEMP_DIST/XTSTEP),NINT(XDTCONV/XTSTEP))==0 ) THEN
- TDTDCONV = TDTCUR
- GDCONV = .TRUE.
- END IF
-!
- IF( GDCONV ) THEN
- IF (CDCONV == 'KAFR' .OR. CSCONV == 'KAFR' ) THEN
- ALLOCATE( ZRC(IIU,IJU,IKU) )
- ALLOCATE( ZRI(IIU,IJU,IKU) )
- ALLOCATE( ZWT(IIU,IJU,IKU) )
- ALLOCATE( ZDXDY(IIU,IJU) )
- ! Compute grid area
- ZDXDY(:,:) = SPREAD(XDXHAT(1:IIU),2,IJU) * SPREAD(XDYHAT(1:IJU),1,IIU)
- !
- IF( LUSERC .AND. LUSERI ) THEN
- ZRC(:,:,:) = XRT(:,:,:,2)
- ZRI(:,:,:) = XRT(:,:,:,4)
- ELSE IF( LUSERC .AND. (.NOT. LUSERI) ) THEN
- ZRC(:,:,:) = XRT(:,:,:,2)
- ZRI(:,:,:) = 0.0
- ELSE
- ZRC(:,:,:) = 0.0
- ZRI(:,:,:) = 0.0
- END IF
- WRITE(UNIT=ILUOUT,FMT='(" CONVECTION called for KTCOUNT=",I6)') &
- KTCOUNT
- IF ( LFORCING .AND. L1D ) THEN
- ZWT(:,:,:) = XWTFRC(:,:,:)
- ELSE
- ZWT(:,:,:) = XWT(:,:,:)
- ENDIF
- IF (LDUST) CALL DUST_FILTER(XSVT(:,:,:,NSV_DSTBEG:NSV_DSTEND), XRHODREF(:,:,:))
- IF (LSALT) CALL SALT_FILTER(XSVT(:,:,:,NSV_SLTBEG:NSV_SLTEND), XRHODREF(:,:,:))
- IF (LCH_CONV_LINOX) THEN
- CALL CONVECTION( XDTCONV, CDCONV, CSCONV, LREFRESH_ALL, LDOWN, NICE, &
- LSETTADJ, XTADJD, XTADJS, LDIAGCONV, NENSM, &
- XPABST, XZZ, ZDXDY, &
- XTHT, XRT(:,:,:,1), ZRC, ZRI, XUT, XVT, &
- ZWT,XTKET(:,:,IKB), &
- NCOUNTCONV, XDTHCONV, XDRVCONV, XDRCCONV, XDRICONV, &
- XPRCONV, XPRSCONV, &
- XUMFCONV,XDMFCONV,XMFCONV,XPRLFLXCONV,XPRSFLXCONV, &
- XCAPE, NCLTOPCONV, NCLBASCONV, &
- LCHTRANS, XSVT, XDSVCONV, &
- LUSECHEM, LCH_CONV_SCAV, LCH_CONV_LINOX, &
- LDUST, LSALT, &
- XRHODREF, XIC_RATE, XCG_RATE )
- ELSE
- CALL CONVECTION( XDTCONV, CDCONV, CSCONV, LREFRESH_ALL, LDOWN, NICE, &
- LSETTADJ, XTADJD, XTADJS, LDIAGCONV, NENSM, &
- XPABST, XZZ, ZDXDY, &
- XTHT, XRT(:,:,:,1), ZRC, ZRI, XUT, XVT, &
- ZWT,XTKET(:,:,IKB), &
- NCOUNTCONV, XDTHCONV, XDRVCONV, XDRCCONV, XDRICONV, &
- XPRCONV, XPRSCONV, &
- XUMFCONV,XDMFCONV,XMFCONV,XPRLFLXCONV,XPRSFLXCONV, &
- XCAPE, NCLTOPCONV, NCLBASCONV, &
- LCHTRANS, XSVT, XDSVCONV, &
- LUSECHEM, LCH_CONV_SCAV, LCH_CONV_LINOX, &
- LDUST, LSALT, &
- XRHODREF )
- END IF
-!
- DEALLOCATE( ZRC )
- DEALLOCATE( ZRI )
- DEALLOCATE( ZWT )
- DEALLOCATE( ZDXDY )
- END IF
- END IF
-!
-! Deep convection tendency integration
-!
- XRTHS(:,:,:) = XRTHS(:,:,:) + XRHODJ(:,:,:) * XDTHCONV(:,:,:)
- XRRS(:,:,:,1) = XRRS(:,:,:,1) + XRHODJ(:,:,:) * XDRVCONV(:,:,:)
-!
-!
-! Aerosols size distribution
-! Compute Rg and sigma before tracers convection tendency (for orilam, dust and sea
-! salt)
-!
-
- IF ( LCHTRANS ) THEN ! update tracers for chemical transport
- IF (LORILAM) ZRSVS(:,:,:,:) = XRSVS(:,:,:,:) !
- IF ((LDUST)) THEN ! dust convective balance
- ALLOCATE(ZSIGDST(IIU,IJU,IKU,NMODE_DST))
- ALLOCATE(ZRGDST(IIU,IJU,IKU,NMODE_DST))
- ALLOCATE(ZNDST(IIU,IJU,IKU,NMODE_DST))
- ALLOCATE(ZSVDST(IIU,IJU,IKU,NSV_DST))
- !
- DO JSV=1,NMODE_DST
- IMODEIDX = JPDUSTORDER(JSV)
- IF (CRGUNITD=="MASS") THEN
- ZINIRADIUS(JSV) = XINIRADIUS(IMODEIDX) * EXP(-3.*(LOG(XINISIG(IMODEIDX)))**2)
- ELSE
- ZINIRADIUS(JSV) = XINIRADIUS(IMODEIDX)
- END IF
- ZSIGDST(:,:,:,JSV) = XINISIG(IMODEIDX)
- ZRGDST(:,:,:,JSV) = ZINIRADIUS(JSV)
- ZNDST(:,:,:,JSV) = XN0MIN(IMODEIDX)
- ENDDO
- !
- IF (CPROGRAM == "MESONH") THEN
- DO JSV=NSV_DSTBEG,NSV_DSTEND
- ZSVDST(:,:,:,JSV-NSV_DSTBEG+1) = XRSVS(:,:,:,JSV) * XTSTEP / XRHODJ(:,:,:)
- ENDDO
- ELSE
- DO JSV=NSV_DSTBEG,NSV_DSTEND
- ZSVDST(:,:,:,JSV-NSV_DSTBEG+1) = XSVT(:,:,:,JSV)
- ENDDO
- ENDIF
- CALL PPP2DUST(ZSVDST(IIB:IIE,IJB:IJE,IKB:IKE,:), XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE),&
- PSIG3D=ZSIGDST(IIB:IIE,IJB:IJE,IKB:IKE,:), PRG3D=ZRGDST(IIB:IIE,IJB:IJE,IKB:IKE,:), &
- PN3D=ZNDST(IIB:IIE,IJB:IJE,IKB:IKE,:))
- END IF
- !
- IF ((LSALT)) THEN ! sea salt convective balance
- ALLOCATE(ZSIGSLT(IIU,IJU,IKU,NMODE_SLT))
- ALLOCATE(ZRGSLT(IIU,IJU,IKU,NMODE_SLT))
- ALLOCATE(ZNSLT(IIU,IJU,IKU,NMODE_SLT))
- ALLOCATE(ZSVSLT(IIU,IJU,IKU,NSV_SLT))
- !
- DO JSV=1,NMODE_SLT
- IMODEIDX = JPSALTORDER(JSV)
- IF (CRGUNITS=="MASS") THEN
- ZINIRADIUS_SLT(JSV) = XINIRADIUS_SLT(IMODEIDX) * &
- EXP(-3.*(LOG(XINISIG_SLT(IMODEIDX)))**2)
- ELSE
- ZINIRADIUS_SLT(JSV) = XINIRADIUS_SLT(IMODEIDX)
- END IF
- ZSIGSLT(:,:,:,JSV) = XINISIG_SLT(IMODEIDX)
- ZRGSLT(:,:,:,JSV) = ZINIRADIUS_SLT(JSV)
- ZNSLT(:,:,:,JSV) = XN0MIN_SLT(IMODEIDX)
- ENDDO
- !
- IF (CPROGRAM == "MESONH") THEN
- DO JSV=NSV_SLTBEG,NSV_SLTEND
- ZSVSLT(:,:,:,JSV-NSV_SLTBEG+1) = XRSVS(:,:,:,JSV) * XTSTEP / XRHODJ(:,:,:)
- ENDDO
- ELSE
- DO JSV=NSV_SLTBEG,NSV_SLTEND
- ZSVSLT(:,:,:,JSV-NSV_SLTBEG+1) = XSVT(:,:,:,JSV)
- ENDDO
- END IF
- CALL PPP2SALT(ZSVSLT(IIB:IIE,IJB:IJE,IKB:IKE,:), XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE),&
- PSIG3D=ZSIGSLT(IIB:IIE,IJB:IJE,IKB:IKE,:), PRG3D=ZRGSLT(IIB:IIE,IJB:IJE,IKB:IKE,:), &
- PN3D=ZNSLT(IIB:IIE,IJB:IJE,IKB:IKE,:))
- END IF
- !
-!
-! Compute convective tendency for all tracers
-!
- IF (LCHTRANS) THEN
- DO JSV = 1, SIZE(XRSVS,4)
- XRSVS(:,:,:,JSV) = XRSVS(:,:,:,JSV) + XRHODJ(:,:,:) * XDSVCONV(:,:,:,JSV)
- END DO
- IF (LORILAM) THEN
- DO JSV = NSV_AERBEG,NSV_AEREND
- PWETDEPAER(:,:,:,JSV-NSV_AERBEG+1) = XDSVCONV(:,:,:,JSV) * XRHODJ(:,:,:)
- XRSVS(:,:,:,JSV) = ZRSVS(:,:,:,JSV)
- END DO
- END IF
- END IF
-!
- IF ((LDUST).AND.(LCHTRANS)) THEN ! dust convective balance
- IF (CPROGRAM == "MESONH") THEN
- DO JSV=NSV_DSTBEG,NSV_DSTEND
- ZSVDST(:,:,:,JSV-NSV_DSTBEG+1) = XRSVS(:,:,:,JSV) * XTSTEP / XRHODJ(:,:,:)
- ENDDO
- ELSE
- DO JSV=NSV_DSTBEG,NSV_DSTEND
- ZSVDST(:,:,:,JSV-NSV_DSTBEG+1) = XSVT(:,:,:,JSV)
- ENDDO
- ENDIF
- CALL DUST2PPP(ZSVDST(IIB:IIE,IJB:IJE,IKB:IKE,:), &
- XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), ZSIGDST(IIB:IIE,IJB:IJE,IKB:IKE,:),&
- ZRGDST(IIB:IIE,IJB:IJE,IKB:IKE,:))
- DO JSV=NSV_DSTBEG,NSV_DSTEND
- XRSVS(:,:,:,JSV) = ZSVDST(:,:,:,JSV-NSV_DSTBEG+1) * XRHODJ(:,:,:) / XTSTEP
- ENDDO
- !
- DEALLOCATE(ZSVDST)
- DEALLOCATE(ZNDST)
- DEALLOCATE(ZRGDST)
- DEALLOCATE(ZSIGDST)
- END IF
- !
- IF ((LSALT).AND.(LCHTRANS)) THEN ! sea salt convective balance
- IF (CPROGRAM == "MESONH") THEN
- DO JSV=NSV_SLTBEG,NSV_SLTEND
- ZSVSLT(:,:,:,JSV-NSV_SLTBEG+1) = XRSVS(:,:,:,JSV) * XTSTEP / XRHODJ(:,:,:)
- ENDDO
- ELSE
- DO JSV=NSV_SLTBEG,NSV_SLTEND
- ZSVSLT(:,:,:,JSV-NSV_SLTBEG+1) = XSVT(:,:,:,JSV)
- ENDDO
- END IF
- CALL SALT2PPP(ZSVSLT(IIB:IIE,IJB:IJE,IKB:IKE,:), &
- XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), ZSIGSLT(IIB:IIE,IJB:IJE,IKB:IKE,:),&
- ZRGSLT(IIB:IIE,IJB:IJE,IKB:IKE,:))
- DO JSV=NSV_SLTBEG,NSV_SLTEND
- XRSVS(:,:,:,JSV) = ZSVSLT(:,:,:,JSV-NSV_SLTBEG+1) * XRHODJ(:,:,:) / XTSTEP
- ENDDO
- !
- DEALLOCATE(ZSVSLT)
- DEALLOCATE(ZNSLT)
- DEALLOCATE(ZRGSLT)
- DEALLOCATE(ZSIGSLT)
- END IF
- !
-END IF
-!
- IF( LUSERC .AND. LUSERI ) THEN
- XRRS(:,:,:,2) = XRRS(:,:,:,2) + XRHODJ(:,:,:) * XDRCCONV(:,:,:)
- XRRS(:,:,:,4) = XRRS(:,:,:,4) + XRHODJ(:,:,:) * XDRICONV(:,:,:)
-!
- ELSE IF ( LUSERC .AND. (.NOT. LUSERI) ) THEN
-!
-! If only cloud water but no cloud ice is used, the convective tendency
-! for cloud ice is added to the tendency for cloud water
-!
- XRRS(:,:,:,2) = XRRS(:,:,:,2) + XRHODJ(:,:,:) * (XDRCCONV(:,:,:) + &
- XDRICONV(:,:,:) )
-! and cloud ice is melted
-!
- XRTHS(:,:,:) = XRTHS(:,:,:) - XRHODJ(:,:,:) * &
- ( XP00/XPABST(:,:,:) )**(XRD/XCPD) * CST%XLMTT / XCPD * XDRICONV(:,:,:)
-!
- ELSE IF ( (.NOT. LUSERC) .AND. (.NOT. LUSERI) ) THEN
-!
-! If no cloud water and no cloud ice are used the convective tendencies for these
-! variables are added to the water vapor tendency
-!
- XRRS(:,:,:,1) = XRRS(:,:,:,1) + XRHODJ(:,:,:) * (XDRCCONV(:,:,:) + &
- XDRICONV(:,:,:) )
-! and all cloud condensate is evaporated
-!
- XRTHS(:,:,:) = XRTHS(:,:,:) - XRHODJ(:,:,:) / XCPD * ( &
- CST%XLVTT * XDRCCONV(:,:,:) + CST%XLSTT * XDRICONV(:,:,:) ) *&
- ( XP00 / XPABST(:,:,:) ) ** ( XRD / XCPD )
- END IF
-
- if ( TBUCONF%LBUDGET_th ) call Budget_store_end( TBUDGETS(NBUDGET_TH), 'DCONV', xrths(:, :, :) )
- if ( TBUCONF%LBUDGET_rv ) call Budget_store_end( TBUDGETS(NBUDGET_RV), 'DCONV', xrrs (:, :, :, 1) )
- if ( TBUCONF%LBUDGET_rc ) call Budget_store_end( TBUDGETS(NBUDGET_RC), 'DCONV', xrrs (:, :, :, 2) )
- if ( TBUCONF%LBUDGET_ri ) call Budget_store_end( TBUDGETS(NBUDGET_RI), 'DCONV', xrrs (:, :, :, 4) )
- if ( TBUCONF%LBUDGET_sv .and. lchtrans ) then
- do jsv = 1, size( xrsvs, 4 )
- call Budget_store_end( TBUDGETS(NBUDGET_SV1 - 1 + jsv), 'DCONV', xrsvs (:, :, :, jsv) )
- end do
- end if
-END IF
-!
-CALL SECOND_MNH2(ZTIME2)
-!
-PKAFR = PKAFR + ZTIME2 - ZTIME1 &
- - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
-!
-PTIME_BU = PTIME_BU + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
-!
-!-----------------------------------------------------------------------------
-!
-!* 3. TURBULENT SURFACE FLUXES
-! ------------------------
-!
-ZTIME1 = ZTIME2
-!
-IF (CSURF=='EXTE') THEN
- CALL GOTO_SURFEX(IMI)
-!
- IF( LTRANS ) THEN
- XUT(:,:,1+JPVEXT) = XUT(:,:,1+JPVEXT) + XUTRANS
- XVT(:,:,1+JPVEXT) = XVT(:,:,1+JPVEXT) + XVTRANS
- END IF
- !
- ALLOCATE(ZDIR_ALB(IIU,IJU,NSWB_MNH))
- ALLOCATE(ZSCA_ALB(IIU,IJU,NSWB_MNH))
- ALLOCATE(ZEMIS (IIU,IJU,NLWB_MNH))
- ALLOCATE(ZTSRAD (IIU,IJU))
- !
- IKIDM=0
- DO JKID = IMI+1,NMODEL ! min value of the possible kids
- IF (IMI == NDAD(JKID) .AND. XWAY(JKID) == 2. .AND. &
- CPROGRAM=='MESONH' .AND. &
- (CCONF == 'RESTA' .OR. (CCONF == 'START' .AND. KTCOUNT /= 1))) THEN
- ! where kids exist, use the two-way output fields (i.e. OMASKkids true)
- ! rather than the farther calculations in radiation and convection schemes
-! BUG if number of the son does not follow the number of the dad
-! IKIDM = JKID-IMI
- IKIDM = IKIDM + 1
- IF (LUSERC .AND. ( &
- (LSEDIC .AND. CCLOUD(1:3) == 'ICE') .OR. &
- (LSEDC .AND. (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO')) .OR. &
- (MSEDC .AND. CCLOUD=='LIMA') &
- )) THEN
- WHERE (OMASKkids(:,:) )
- XINPRC(:,:) = ZSAVE_INPRC(:,:,IKIDM)
- ENDWHERE
- END IF
- IF (LUSERR) THEN
- WHERE (OMASKkids(:,:) )
- XINPRR(:,:) = ZSAVE_INPRR(:,:,IKIDM)
- ENDWHERE
- END IF
- IF (LUSERS) THEN
- WHERE (OMASKkids(:,:) )
- XINPRS(:,:) = ZSAVE_INPRS(:,:,IKIDM)
- ENDWHERE
- END IF
- IF (LUSERG) THEN
- WHERE (OMASKkids(:,:) )
- XINPRG(:,:) = ZSAVE_INPRG(:,:,IKIDM)
- ENDWHERE
- END IF
- IF (LUSERH) THEN
- WHERE (OMASKkids(:,:) )
- XINPRH(:,:) = ZSAVE_INPRH(:,:,IKIDM)
- ENDWHERE
- END IF
- IF (CDCONV /= 'NONE') THEN
- WHERE (OMASKkids(:,:) )
- XPRCONV(:,:) = ZSAVE_PRCONV(:,:,IKIDM)
- XPRSCONV(:,:) = ZSAVE_PRSCONV(:,:,IKIDM)
- ENDWHERE
- END IF
- IF (CRAD /= 'NONE') THEN
- DO JSWB=1,NSWB_MNH
- WHERE (OMASKkids(:,:) )
- XDIRFLASWD(:,:,JSWB) = ZSAVE_DIRFLASWD(:,:,JSWB,IKIDM)
- XSCAFLASWD(:,:,JSWB) = ZSAVE_SCAFLASWD(:,:,JSWB,IKIDM)
- XDIRSRFSWD(:,:,JSWB) = ZSAVE_DIRSRFSWD(:,:,JSWB,IKIDM)
- ENDWHERE
- ENDDO
- END IF
- ENDIF
- END DO
- !
- IF (IMODSON /= 0 ) THEN
- DEALLOCATE( ZSAVE_INPRR,ZSAVE_INPRS,ZSAVE_INPRG,ZSAVE_INPRH)
- DEALLOCATE( ZSAVE_INPRC,ZSAVE_PRCONV,ZSAVE_PRSCONV)
- DEALLOCATE( ZSAVE_DIRFLASWD,ZSAVE_SCAFLASWD,ZSAVE_DIRSRFSWD)
- END IF
- CALL GROUND_PARAM_n(YLDIMPHYEX,ZSFTH, ZSFRV, ZSFSV, ZSFCO2, ZSFU, ZSFV, &
- ZDIR_ALB, ZSCA_ALB, ZEMIS, ZTSRAD, KTCOUNT, TPFILE )
- !
- IF (LIBM) THEN
- WHERE(XIBM_LS(:,:,IKB,1).GT.-XIBM_EPSI)
- ZSFTH(:,:)=0.
- ZSFRV(:,:)=0.
- ZSFU (:,:)=0.
- ZSFV (:,:)=0.
- ENDWHERE
- IF (NSV>0) THEN
- DO JSV = 1 , NSV
- WHERE(XIBM_LS(:,:,IKB,1).GT.-XIBM_EPSI) ZSFSV(:,:,JSV)=0.
- ENDDO
- ENDIF
- ENDIF
- !
- IF (SIZE(XEMIS)>0) THEN
- XDIR_ALB = ZDIR_ALB
- XSCA_ALB = ZSCA_ALB
- XEMIS = ZEMIS
- XTSRAD = ZTSRAD
- END IF
- !
- DEALLOCATE(ZDIR_ALB)
- DEALLOCATE(ZSCA_ALB)
- DEALLOCATE(ZEMIS )
- DEALLOCATE(ZTSRAD )
- !
- !
- IF( LTRANS ) THEN
- XUT(:,:,1+JPVEXT) = XUT(:,:,1+JPVEXT) - XUTRANS
- XVT(:,:,1+JPVEXT) = XVT(:,:,1+JPVEXT) - XVTRANS
- END IF
-!
-ELSE ! case no SURFEX (CSURF logical)
- ZSFSV = 0.
- ZSFCO2 = 0.
- IF (.NOT.LOCEAN) THEN
- ZSFTH = 0.
- ZSFRV = 0.
- ZSFSV = 0.
- ZSFCO2 = 0.
- ZSFU = 0.
- ZSFV = 0.
- END IF
-END IF !CSURF
-!
-CALL SECOND_MNH2(ZTIME2)
-!
-PGROUND = PGROUND + ZTIME2 - ZTIME1
-!
-!-----------------------------------------------------------------------------
-!
-!* 3.1 EDDY FLUXES PARAMETRIZATION
-! ------------------
-!
-IF (IMI==1) THEN ! On calcule les flus turb. comme preconise par PP
-
- ! Heat eddy fluxes
- IF ( LTH_FLX ) CALL EDDY_FLUX_n(IMI,KTCOUNT,XVT,XTHT,XRHODJ,XRTHS,XVTH_FLUX_M,XWTH_FLUX_M)
- !
- ! Momentum eddy fluxes
- IF ( LUV_FLX ) CALL EDDYUV_FLUX_n(IMI,KTCOUNT,XVT,XTHT,XRHODJ,XRHODREF,XPABSM,XRVS,XVU_FLUX_M)
-
-ELSE
- ! TEST pour maille infèrieure à 20km ?
- ! car pb d'instabilités ?
- ! Pour le modèle fils, on spawne les flux du modèle père
- ! Heat eddy fluxes
- IF ( LTH_FLX ) CALL EDDY_FLUX_ONE_WAY_n (IMI,KTCOUNT,NDXRATIO_ALL(IMI),NDYRATIO_ALL(IMI),CLBCX,CLBCY)
- !
- ! Momentum eddy fluxes
- IF ( LUV_FLX ) CALL EDDYUV_FLUX_ONE_WAY_n (IMI,KTCOUNT,NDXRATIO_ALL(IMI),NDYRATIO_ALL(IMI),CLBCX,CLBCY)
- !
-END IF
-!-----------------------------------------------------------------------------
-!
-!* 4. PASSIVE POLLUTANTS
-! ------------------
-!
-ZTIME1 = ZTIME2
-!
-IF (LPASPOL) CALL PASPOL(XTSTEP, ZSFSV, ILUOUT, NVERB, TPFILE)
-!
-!
-!* 4b. PASSIVE POLLUTANTS FOR MASS-FLUX SCHEME DIAGNOSTICS
-! ---------------------------------------------------
-!
-IF (LCONDSAMP) CALL CONDSAMP(XTSTEP, ZSFSV, ILUOUT, NVERB)
-!
-CALL SECOND_MNH2(ZTIME2)
-!
-PTRACER = PTRACER + ZTIME2 - ZTIME1
-!-----------------------------------------------------------------------------
-!
-!* 5a. Drag force
-! ----------
-!
-ZTIME1 = ZTIME2
-XTIME_BU_PROCESS = 0.
-XTIME_LES_BU_PROCESS = 0.
-!
-IF (LDRAGTREE) CALL DRAG_VEG( XTSTEP, XUT, XVT, XTKET, LDEPOTREE, XVDEPOTREE, &
- CCLOUD, XPABST, XTHT, XRT, XSVT, XRHODJ, XZZ, &
- XRUS, XRVS, XRTKES, XRRS, XRSVS )
-!
-IF (LDRAGBLDG) CALL DRAG_BLD( XTSTEP, XUT, XVT, XTKET, XRHODJ, XZZ, XRUS, XRVS, XRTKES )
-!
-CALL SECOND_MNH2(ZTIME2)
-!
-PDRAG = PDRAG + ZTIME2 - ZTIME1 &
- - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
-!
-PTIME_BU = PTIME_BU + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
-!
-!* 5b. Drag force from wind turbines
-! -----------------------
-!
-ZTIME1 = ZTIME2
-XTIME_BU_PROCESS = 0.
-XTIME_LES_BU_PROCESS = 0.
-!
-IF (LMAIN_EOL .AND. IMI == NMODEL_EOL) THEN
- CALL EOL_MAIN(KTCOUNT,XTSTEP, &
- XDXX,XDYY,XDZZ, &
- XRHODJ, &
- XUT,XVT,XWT, &
- XRUS, XRVS, XRWS )
-END IF
-!
-CALL SECOND_MNH2(ZTIME2)
-!
-PEOL = PEOL + ZTIME2 - ZTIME1 &
- - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
-!
-PTIME_BU = PTIME_BU + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
-!
-!*
-!-----------------------------------------------------------------------------
-!
-!* 6. TURBULENCE SCHEME
-! -----------------
-!
-ZTIME1 = ZTIME2
-XTIME_BU_PROCESS = 0.
-XTIME_LES_BU_PROCESS = 0.
-!
-ZSFTH(:,:) = ZSFTH(:,:) * XDIRCOSZW(:,:)
-ZSFRV(:,:) = ZSFRV(:,:) * XDIRCOSZW(:,:)
-DO JSV=1,NSV
- ZSFSV(:,:,JSV) = ZSFSV(:,:,JSV) * XDIRCOSZW(:,:)
-END DO
-!
-IF (LLES_CALL) CALL SWITCH_SBG_LES_n
-!
-!
-IF ( CTURB == 'TKEL' ) THEN
-!
-
-!* 6.1 complete surface flux fields on the border
-!
-!!$ IF(NHALO == 1) THEN
- CALL ADD2DFIELD_ll( TZFIELDS_ll, ZSFTH, 'PHYS_PARAM_n::ZSFTH' )
- CALL ADD2DFIELD_ll( TZFIELDS_ll, ZSFRV, 'PHYS_PARAM_n::ZSFRV' )
- CALL ADD2DFIELD_ll( TZFIELDS_ll, ZSFU, 'PHYS_PARAM_n::ZSFU' )
- CALL ADD2DFIELD_ll( TZFIELDS_ll, ZSFV, 'PHYS_PARAM_n::ZSFV' )
- IF(NSV >0)THEN
- DO JSV=1,NSV
- write ( ynum, '( I6 ) ' ) jsv
- CALL ADD2DFIELD_ll( TZFIELDS_ll, ZSFSV(:,:,JSV), 'PHYS_PARAM_n::ZSFSV:'//trim( adjustl( ynum ) ) )
- END DO
- END IF
- CALL ADD2DFIELD_ll( TZFIELDS_ll, ZSFCO2, 'PHYS_PARAM_n::ZSFCO2' )
- CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDS_ll)
-!!$ END IF
-!
- CALL MPPDB_CHECK2D(ZSFU,"phys_param::ZSFU",PRECISION)
- !
- IF ( CLBCX(1) /= "CYCL" .AND. LWEST_ll()) THEN
- ZSFTH(IIB-1,:)=ZSFTH(IIB,:)
- ZSFRV(IIB-1,:)=ZSFRV(IIB,:)
- ZSFU(IIB-1,:)=ZSFU(IIB,:)
- ZSFV(IIB-1,:)=ZSFV(IIB,:)
- IF (NSV>0) THEN
- ZSFSV(IIB-1,:,:)=ZSFSV(IIB,:,:)
- WHERE ((ZSFSV(IIB-1,:,:).LT.0.).AND.(XSVT(IIB-1,:,IKB,:).EQ.0.))
- ZSFSV(IIB-1,:,:) = 0.
- END WHERE
- ENDIF
- ZSFCO2(IIB-1,:)=ZSFCO2(IIB,:)
- END IF
- !
- IF ( CLBCX(2) /= "CYCL" .AND. LEAST_ll()) THEN
- ZSFTH(IIE+1,:)=ZSFTH(IIE,:)
- ZSFRV(IIE+1,:)=ZSFRV(IIE,:)
- ZSFU(IIE+1,:)=ZSFU(IIE,:)
- ZSFV(IIE+1,:)=ZSFV(IIE,:)
- IF (NSV>0) THEN
- ZSFSV(IIE+1,:,:)=ZSFSV(IIE,:,:)
- WHERE ((ZSFSV(IIE+1,:,:).LT.0.).AND.(XSVT(IIE+1,:,IKB,:).EQ.0.))
- ZSFSV(IIE+1,:,:) = 0.
- END WHERE
- ENDIF
- ZSFCO2(IIE+1,:)=ZSFCO2(IIE,:)
- END IF
- !
- IF ( CLBCY(1) /= "CYCL" .AND. LSOUTH_ll()) THEN
- ZSFTH(:,IJB-1)=ZSFTH(:,IJB)
- ZSFRV(:,IJB-1)=ZSFRV(:,IJB)
- ZSFU(:,IJB-1)=ZSFU(:,IJB)
- ZSFV(:,IJB-1)=ZSFV(:,IJB)
- IF (NSV>0) THEN
- ZSFSV(:,IJB-1,:)=ZSFSV(:,IJB,:)
- WHERE ((ZSFSV(:,IJB-1,:).LT.0.).AND.(XSVT(:,IJB-1,IKB,:).EQ.0.))
- ZSFSV(:,IJB-1,:) = 0.
- END WHERE
- ENDIF
- ZSFCO2(:,IJB-1)=ZSFCO2(:,IJB)
- END IF
- !
- IF ( CLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
- ZSFTH(:,IJE+1)=ZSFTH(:,IJE)
- ZSFRV(:,IJE+1)=ZSFRV(:,IJE)
- ZSFU(:,IJE+1)=ZSFU(:,IJE)
- ZSFV(:,IJE+1)=ZSFV(:,IJE)
- IF (NSV>0) THEN
- ZSFSV(:,IJE+1,:)=ZSFSV(:,IJE,:)
- WHERE ((ZSFSV(:,IJE+1,:).LT.0.).AND.(XSVT(:,IJE+1,IKB,:).EQ.0.))
- ZSFSV(:,IJE+1,:) = 0.
- END WHERE
- ENDIF
- ZSFCO2(:,IJE+1)=ZSFCO2(:,IJE)
- END IF
-!
- IF( LTRANS ) THEN
- XUT(:,:,:) = XUT(:,:,:) + XUTRANS
- XVT(:,:,:) = XVT(:,:,:) + XVTRANS
- END IF
-!
-!
-IF ( ALLOCATED( XTHW_FLUX ) ) DEALLOCATE( XTHW_FLUX )
-IF ( LFLYER ) THEN
- ALLOCATE( XTHW_FLUX(SIZE( XTHT, 1 ), SIZE( XTHT, 2 ), SIZE( XTHT, 3 )) )
-ELSE
- ALLOCATE( XTHW_FLUX(0, 0, 0) )
-END IF
-
-IF ( ALLOCATED( XRCW_FLUX ) ) DEALLOCATE( XRCW_FLUX )
-IF ( LFLYER ) THEN
- ALLOCATE( XRCW_FLUX(SIZE( XTHT, 1 ), SIZE( XTHT, 2 ), SIZE( XTHT, 3 )) )
-ELSE
- ALLOCATE( XRCW_FLUX(0, 0, 0) )
-END IF
-
-IF ( ALLOCATED( XSVW_FLUX ) ) DEALLOCATE( XSVW_FLUX )
-IF ( LFLYER ) THEN
- ALLOCATE( XSVW_FLUX(SIZE( XSVT, 1 ), SIZE( XSVT, 2 ), SIZE( XSVT, 3 ), SIZE( XSVT, 4 )) )
-ELSE
- ALLOCATE( XSVW_FLUX(0, 0, 0, 0) )
-END IF
-!
-GCOMPUTE_SRC=SIZE(XSIGS, 3)/=0
-!
-ALLOCATE(ZTDIFF(IIU,IJU,IKU))
-ALLOCATE(ZTDISS(IIU,IJU,IKU))
-!
-!! Compute Shape of sfc flux for Oceanic Deep Conv Case
-!
-IF (LOCEAN .AND. LDEEPOC) THEN
- ALLOCATE(ZDIST(IIU,IJU))
- !* COMPUTES THE PHYSICAL SUBDOMAIN BOUNDS
- ALLOCATE(ZXHAT_ll(NIMAX_ll+2*JPHEXT),ZYHAT_ll(NJMAX_ll+2*JPHEXT))
- !compute ZXHAT_ll = position in the (0:Lx) domain 1 (Lx=Size of domain1 )
- !compute XXHAT_ll = position in the (L0_subproc,Lx_subproc) domain for the current subproc
- ! L0_subproc as referenced in the full domain 1
- CALL GATHERALL_FIELD_ll('XX',XXHAT,ZXHAT_ll,IRESP)
- CALL GATHERALL_FIELD_ll('YY',XYHAT,ZYHAT_ll,IRESP)
- CALL GET_DIM_EXT_ll('B',IIU,IJU)
- DO JJ = IJB,IJE
- DO JI = IIB,IIE
- ZDIST(JI,JJ) = SQRT( &
- (( (XXHAT(JI)+XXHAT(JI+1))*0.5 - XCENTX_OC ) / XRADX_OC)**2 + &
- (( (XYHAT(JJ)+XYHAT(JJ+1))*0.5 - XCENTY_OC ) / XRADY_OC)**2 &
- )
- END DO
- END DO
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IF ( ZDIST(JI,JJ) > 1.) ZSFTH(JI,JJ)=0.
- END DO
- END DO
-END IF !END DEEP OCEAN CONV CASE
-!
-IF(LLEONARD) THEN
- IGRADIENTS=6
- ALLOCATE(ZHGRAD(IIU,IJU,IKU,IGRADIENTS))
- ZHGRAD(:,:,:,1) = GX_W_UW(XWT(:,:,:), XDXX,XDZZ,XDZX,1,IKU,1)
- ZHGRAD(:,:,:,2) = GY_W_VW(XWT(:,:,:), XDXX,XDZZ,XDZX,1,IKU,1)
- ZHGRAD(:,:,:,3) = GX_M_M(XTHT(:,:,:), XDXX,XDZZ,XDZX,1,IKU,1)
- ZHGRAD(:,:,:,4) = GY_M_M(XTHT(:,:,:), XDXX,XDZZ,XDZX,1,IKU,1)
- ZHGRAD(:,:,:,5) = GX_M_M(XRT(:,:,:,1), XDXX,XDZZ,XDZX,1,IKU,1)
- ZHGRAD(:,:,:,6) = GY_M_M(XRT(:,:,:,1), XDXX,XDZZ,XDZX,1,IKU,1)
-END IF
- CALL TURB( CST,CSTURB, TBUCONF, TURBN, NEBN, YLDIMPHYEX,TLES, &
- NRR, NRRL, NRRI, CLBCX, CLBCY, IGRADIENTS, NHALO, NTURBSPLIT, &
- LCLOUDMODIFLM, NSV, NSV_LGBEG, NSV_LGEND, &
- NSV_LIMA_NR, NSV_LIMA_NS, NSV_LIMA_NG, NSV_LIMA_NH, &
- L2D, LNOMIXLG,LFLAT, &
- LCOUPLES, LBLOWSNOW, LIBM,LFLYER, &
- GCOMPUTE_SRC, XRSNOW, &
- LOCEAN, LDEEPOC, LDIAG_IN_RUN, &
- CTURBLEN_CLOUD, CCLOUD, &
- XTSTEP, TPFILE, &
- XDXX, XDYY, XDZZ, XDZX, XDZY, XZZ, &
- XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, XCOSSLOPE, XSINSLOPE, &
- XRHODJ, XTHVREF, ZHGRAD, XZS, &
- ZSFTH, ZSFRV, ZSFSV, ZSFU, ZSFV, &
- XPABST, XUT, XVT, XWT, XTKET, XSVT, XSRCT, &
- ZLENGTHM, ZLENGTHH, ZMFMOIST, &
- XBL_DEPTH, XSBL_DEPTH, &
- XCEI, XCEI_MIN, XCEI_MAX, XCOEF_AMPL_SAT, &
- XTHT, XRT, &
- XRUS, XRVS, XRWS, XRTHS, XRRS, XRSVS, XRTKES, XSIGS, XWTHVMF, &
- XTHW_FLUX, XRCW_FLUX, XSVW_FLUX,XDYP, XTHP, ZTDIFF, ZTDISS, &
- TBUDGETS, KBUDGETS=SIZE(TBUDGETS),PLEM=XLEM,PRTKEMS=XRTKEMS, &
- PTR=XTR, PDISS=XDISS, PCURRENT_TKE_DISS=XCURRENT_TKE_DISS, &
- PIBM_LS=XIBM_LS(:,:,:,1), PIBM_XMUT=XIBM_XMUT, &
- PSSTFL=XSSTFL, PSSTFL_C=XSSTFL_C, PSSRFL_C=XSSRFL_C, &
- PSSUFL_C=XSSUFL_C, PSSVFL_C=XSSVFL_C, PSSUFL=XSSUFL, PSSVFL=XSSVFL )
-!
-DEALLOCATE(ZTDIFF)
-DEALLOCATE(ZTDISS)
-IF(LLEONARD) DEALLOCATE(ZHGRAD)
-!
-IF (LRMC01) THEN
- CALL ADD2DFIELD_ll( TZFIELDS_ll, XSBL_DEPTH, 'PHYS_PARAM_n::XSBL_DEPTH' )
- CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDS_ll)
- IF ( CLBCX(1) /= "CYCL" .AND. LWEST_ll()) THEN
- XSBL_DEPTH(IIB-1,:)=XSBL_DEPTH(IIB,:)
- END IF
- IF ( CLBCX(2) /= "CYCL" .AND. LEAST_ll()) THEN
- XSBL_DEPTH(IIE+1,:)=XSBL_DEPTH(IIE,:)
- END IF
- IF ( CLBCY(1) /= "CYCL" .AND. LSOUTH_ll()) THEN
- XSBL_DEPTH(:,IJB-1)=XSBL_DEPTH(:,IJB)
- END IF
- IF ( CLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
- XSBL_DEPTH(:,IJE+1)=XSBL_DEPTH(:,IJE)
- END IF
-END IF
-!
-CALL SECOND_MNH2(ZTIME3)
-!
-!-----------------------------------------------------------------------------
-!
-!* 7. EDMF SCHEME
-! -----------
-!
-IF (CSCONV == 'EDKF') THEN
- ALLOCATE(ZEXN (IIU,IJU,IKU))
- ALLOCATE(ZSIGMF (IIU,IJU,IKU))
- ZSIGMF(:,:,:)=0.
- ZEXN(:,:,:)=(XPABST(:,:,:)/XP00)**(XRD/XCPD)
- !$20131113 check3d on ZEXN
- CALL MPPDB_CHECK3D(ZEXN,"physparan.7::ZEXN",PRECISION)
- CALL ADD3DFIELD_ll( TZFIELDS_ll, ZEXN, 'PHYS_PARAM_n::ZEXN' )
- !$20131113 add update_halo_ll
- CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDS_ll)
- CALL MPPDB_CHECK3D(ZEXN,"physparam.7::ZEXN",PRECISION)
- !
- CALL SHALLOW_MF_PACK(NRR,NRRL,NRRI, &
- TPFILE,ZTIME_LES_MF, &
- XTSTEP, &
- XDZZ, XZZ,XDXHAT(1),XDYHAT(1), &
- XRHODJ, XRHODREF, XPABST, ZEXN, ZSFTH, ZSFRV, &
- XTHT,XRT,XUT,XVT,XTKET,XSVT, &
- XRTHS,XRRS,XRUS,XRVS,XRSVS, &
- ZSIGMF,XRC_MF, XRI_MF, XCF_MF, XWTHVMF)
-!
-ELSE
- XWTHVMF(:,:,:)=0.
- XRC_MF(:,:,:)=0.
- XRI_MF(:,:,:)=0.
- XCF_MF(:,:,:)=0.
-ENDIF
-!
-CALL SECOND_MNH2(ZTIME4)
-
- IF( LTRANS ) THEN
- XUT(:,:,:) = XUT(:,:,:) - XUTRANS
- XVT(:,:,:) = XVT(:,:,:) - XVTRANS
- END IF
- IF (CMF_CLOUD == 'STAT') THEN
- XSIGS =SQRT( XSIGS**2 + ZSIGMF**2 )
- ENDIF
- IF (CSCONV == 'EDKF') THEN
- DEALLOCATE(ZSIGMF)
- DEALLOCATE(ZEXN)
- ENDIF
-END IF
-!
-IF (LLES_CALL) CALL SWITCH_SBG_LES_n
-!
-CALL SECOND_MNH2(ZTIME2)
-!
-PTURB = PTURB + ZTIME2 - ZTIME1 - (XTIME_LES-ZTIME_LES_MF) - XTIME_LES_BU_PROCESS &
- - XTIME_BU_PROCESS - (ZTIME4 - ZTIME3)
-!
-PMAFL = PMAFL + ZTIME4 - ZTIME3 - ZTIME_LES_MF
-!
-PTIME_BU = PTIME_BU + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* deallocation of variables used in more than one parameterization
-!
-DEALLOCATE(ZSFU ) ! surface schemes + turbulence
-DEALLOCATE(ZSFV )
-DEALLOCATE(ZSFTH )
-DEALLOCATE(ZSFRV )
-DEALLOCATE(ZSFSV )
-DEALLOCATE(ZSFCO2)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE PHYS_PARAM_n
-
diff --git a/src/mesonh/ext/prep_ideal_case.f90 b/src/mesonh/ext/prep_ideal_case.f90
deleted file mode 100644
index 9b4c61fad08449e598520f875e4975d227713bc4..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/prep_ideal_case.f90
+++ /dev/null
@@ -1,1952 +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.
-!-----------------------------------------------------------------
-! #######################
- PROGRAM PREP_IDEAL_CASE
-! #######################
-!
-!!**** *PREP_IDEAL_CASE* - program to write an initial FM-file
-!!
-!! PURPOSE
-!! -------
-! The purpose of this program is to prepare an initial meso-NH file
-! (LFIFM and DESFM files) filled with some idealized fields.
-!
-! ---- The present version can provide two types of fields:
-!
-! 1) CIDEAL = 'CSTN' : 3D fields derived from a vertical profile with
-! --------------- n levels of constant moist Brunt Vaisala frequency
-! The vertical profile is read in EXPRE file.
-! These fields can be used for model runs
-!
-! 2) CIDEAL = 'RSOU' : 3D fields derived from a radiosounding.
-! ---------------
-! The radiosounding is read in EXPRE file.
-! The following kind of data is permitted :
-! YKIND = 'STANDARD' : Zsol, Psol, Tsol, TDsol
-! (Pressure, dd, ff) ,
-! (Pressure, T, Td)
-! YKIND = 'PUVTHVMR' : zsol, Psol, Thvsol, Rsol
-! (Pressure, U, V) ,
-! (Pressure, THv, R)
-! YKIND = 'PUVTHVHU' : zsol, Psol, Thvsol, Husol
-! (Pressure, U, V) ,
-! (Pressure, THv, Hu)
-! YKIND = 'ZUVTHVHU' : zsol, Psol, Thvsol, Husol
-! (height, U, V) ,
-! (height, THv, Hu)
-! YKIND = 'ZUVTHVMR' : zsol, Psol, Thvsol, Rsol
-! (height, U, V) ,
-! (height, THv, R)
-! YKIND = 'PUVTHDMR' : zsol, Psol, Thdsol, Rsol
-! (Pressure, U, V) ,
-! (Pressure, THd, R)
-! YKIND = 'PUVTHDHU' : zsol, Psol, Thdsol, Husol
-! (Pressure, U, V) ,
-! (Pressure, THd, Hu)
-! YKIND = 'ZUVTHDMR' : zsol, Psol, Thdsol, Rsol
-! (height, U, V) ,
-! (height, THd, R)
-! YKIND = 'ZUVTHLMR' : zsol, Psol, Thdsol, Rsol
-! (height, U, V) ,
-! (height, THl, Rt)
-!
-! These fields can be used for model runs
-!
-! Cases (1) and (2) can be balanced
-! (geostrophic, hydrostatic and anelastic balances) if desired.
-!
-! ---- The orography can be flat (YZS='FLAT'), but also
-! sine-shaped (YZS='SINE') or bell-shaped (YZS='BELL')
-!
-! ---- The U(z) profile given in the RSOU and CSTN cases can
-! be multiplied (CUFUN="Y*Z") by a function of y (function FUNUY)
-! The V(z) profile given in the RSOU and CSTN cases can
-! be multiplied (CVFUN="X*Z") by a function of x (function FUNVX).
-! If it is not the case, i.e. U(y,z)=U(z) then CUFUN="ZZZ" and
-! CVFUN="ZZZ" for V(y,z)=V(z). Instead of these separable forms,
-! non-separables functions FUNUYZ (CUFUN="Y,Z") and FUNVXZ (CVFUN="X,Z")
-! can be used to specify the wind components.
-!
-!!** METHOD
-!! ------
-!! The directives and data to perform the preparation of the initial FM
-!! file are stored in EXPRE file. This file is composed of two parts :
-!! - a namelists-format part which is present in all cases
-!! - a free-format part which contains data in cases
-!! of discretised orography (CZS='DATA')
-!! of radiosounding (CIDEAL='RSOU') or Nv=cste profile (CIDEAL='CSTN')
-!! of forced version (LFORCING=.TRUE.)
-!!
-!!
-!! The following PREP_IDEAL_CASE program :
-!!
-!! - initializes physical constants by calling INI_CST
-!!
-!! - sets default values for global variables which will be
-!! written in DESFM file and for variables in EXPRE file (namelists part)
-!! which will be written in LFIFM file.
-!!
-!! - reads the namelists part of EXPRE file which gives
-!! informations about the preinitialization to perform,
-!!
-!! - allocates memory for arrays,
-!!
-!! - initializes fields depending on the
-!! directives (CIDEAL in namelist NAM_CONF_PRE) :
-!!
-!! * grid variables :
-!! The gridpoints are regularly spaced by XDELTAX, XDELTAY.
-!! The grid is stretched along the z direction, the mesh varies
-!! from XDZGRD near the ground to XDZTOP near the top and the
-!! weigthing function is a TANH function characterized by its
-!! center and width above and under this center
-!! The orography is initialized following the kind of orography
-!! (YZS in namelist NAM_CONF_PRE) and the degrees of freedom :
-!! sine-shape ---> ZHMAX, IEXPX,IEXPY
-!! bell-shape ---> ZHMAX, ZAX,ZAY,IIZS,IJZS
-!! The horizontal grid variables are initialized following
-!! the kind of geometry (LCARTESIAN in namelist NAM_CONF_PRE)
-!! and the grid parameters XLAT0,XLON0,XBETA in both geometries
-!! and XRPK,XLONORI,XLATORI in conformal projection.
-!! In the case of initialization from a radiosounding, the
-!! date and time is read in free-part of the EXPRE file. In other
-!! cases year, month and day are set to NUNDEF and time to 0.
-!!
-!! * prognostic fields :
-!!
-!! U,V,W, Theta and r. are first determined. They are
-!! multiplied by rhoj after the anelastic reference state
-!! computation.
-!! For the CSTN and RSOU cases, the determination of
-!! Theta and rv is performed respectively by SET_RSOU
-!! and by SET_CSTN which call the common routine SET_MASS.
-!! These three routines have the following actions :
-!! --- The input vertical profile is converted in
-!! variables (U,V,thetav,r) and interpolated
-!! on a mixed grid (with VERT_COORD) as in PREP_REAL_CASE
-!! --- A variation of the u-wind component( x-model axis component)
-!! is possible in y direction, a variation of the v-wind component
-!! (y-model axis component) is possible in x direction.
-!! --- Thetav could be computed with thermal wind balance
-!! (LGEOSBAL=.TRUE. with call of SET_GEOSBAL)
-!! --- The mass fields (theta and r ) and the wind components are
-!! then interpolated on the model grid with orography as in
-!! PREP_REAL_CASE with the option LSHIFT
-!! --- An anelastic correction is applied in PRESSURE_IN_PREP in
-!! the case of non-vanishing orography.
-!!
-!! * anelastic reference state variables :
-!!
-!! 1D reference state :
-!! RSOU and CSTN cases : rhorefz and thvrefz are computed
-!! by SET_REFZ (called by SET_MASS).
-!! They are deduced from thetav and r on the model grid
-!! without orography.
-!! The 3D reference state is computed by SET_REF
-!!
-!! * The total mass of dry air is computed by TOTAL_DMASS
-!!
-!! - writes the DESFM file,
-!!
-!! - writes the LFIFM file .
-!!
-!! EXTERNAL
-!! --------
-!! DEFAULT_DESFM : to set default values for variables which can be
-!! contained in DESFM file
-!! DEFAULT_EXPRE : to set default values for other global variables
-!! which can be contained in namelist-part of EXPRE file
-!! Module MODE_GRIDPROJ : contains conformal projection routines
-!! SM_GRIDPROJ : to compute some grid variables, in
-!! case of conformal projection.
-!! Module MODE_GRIDCART : contains cartesian geometry routines
-!! SM_GRIDCART : to compute some grid variables, in
-!! case of cartesian geometry.
-!! SET_RSOU : to initialize mass fields from a radiosounding
-!! SET_CSTN : to initialize mass fields from a vertical profile of
-!! n layers of Nv=cste
-!! SET_REF : to compute rhoJ
-!! RESSURE_IN_PREP : to apply an anelastic correction in the case of
-!! non-vanishing orography
-!! IO_File_open : to open a FM-file (DESFM + LFIFM)
-!! WRITE_DESFM : to write the DESFM file
-!! WRI_LFIFM : to write the LFIFM file
-!! IO_File_close : to close a FM-file (DESFM + LFIFM)
-!!
-!! MXM,MYM,MZM : Shuman operators
-!! WGUESS : to compute W with the continuity equation from
-!! the U,V values
-!!
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_PARAMETERS : contains parameters
-!! Module MODD_DIM1 : contains dimensions
-!! Module MODD_CONF : contains configuration variables for
-!! all models
-!! Module MODD_CST : contains physical constants
-!! Module MODD_GRID : contains grid variables for all models
-!! Module MODD_GRID1 : contains grid variables
-!! Module MODD_TIME : contains time variables for all models
-!! Module MODD_TIME1 : contains time variables
-!! Module MODD_REF : contains reference state variables for
-!! all models
-!! Module MODD_REF1 : contains reference state variables
-!! Module MODD_LUNIT : contains variables which concern names
-!! and logical unit numbers of files for all models
-!! Module MODD_FIELD1 : contains prognostics variables
-!! Module MODD_GR_FIELD1 : contains the surface prognostic variables
-!! Module MODD_LSFIELD1 : contains Larger Scale fields
-!! Module MODD_DYN1 : contains dynamic control variables for model 1
-!! Module MODD_LBC1 : contains lbc control variables for model 1
-!!
-!!
-!! Module MODN_CONF1 : contains configuration variables for model 1
-!! and the NAMELIST list
-!! Module MODN_LUNIT1 : contains variables which concern names
-!! and logical unit numbers of files and
-!! the NAMELIST list
-!!
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of MESO-NH documentation (program PREP_IDEAL_CASE)
-!!
-!! AUTHOR
-!! ------
-!! V. Ducrocq *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 05/05/94
-!! updated V. Ducrocq 27/06/94
-!! updated P.M. 27/07/94
-!! updated V. Ducrocq 23/08/94
-!! updated V. Ducrocq 01/09/94
-!! namelist changes J. Stein 26/10/94
-!! namelist changes J. Stein 04/11/94
-!! remove the second step of the geostrophic balance 14/11/94 (J.Stein)
-!! add grid stretching in the z direction + Larger scale fields +
-!! cleaning 6/12/94 (J.Stein)
-!! periodize the orography and the grid sizes in the periodic case
-!! 19/12/94 (J.Stein)
-!! correct a bug in the Larger Scale Fields initialization
-!! 19/12/94 (J.Stein)
-!! add the vertical grid stretching 02/01/95 (J. Stein)
-!! Total mass of dry air computation 02/01/95 (J.P.Lafore)
-!! add the 1D switch 13/01/95 (J. Stein)
-!! enforce a regular vertical grid if desired 18/01/95 (J. Stein)
-!! add the tdtcur initialization 26/01/95 (J. Stein)
-!! bug in the test of the type of RS localization 25/02/95 (J. Stein)
-!! remove R from the historical variables 16/03/95 (J. Stein)
-!! error on the grid stretching 30/06/95 (J. Stein)
-!! add the soil fields 01/09/95 (S.Belair)
-!! change the streching function and the wind guess
-!! (J. Stein and V.Masson) 21/09/95
-!! reset to FALSE LUSERC,..,LUSERH 12/12/95 (J. Stein)
-!! enforce the RS localization in 1D and 2D config.
-!! + add the 'TSZ0' option for the soil variables 28/01/96 (J. Stein)
-!! initialization of domain from center point 31/01/96 (V. Masson)
-!! add the constant file reading 05/02/96 (J. Stein)
-!! enter vertical model levels values 20/10/95 (T.Montmerle)
-!! add LFORCING option 19/02/96 (K. Suhre)
-!! modify structure of NAM_CONF_PRE 20/02/96 (J.-P. Pinty)
-!! default of the domain center when use of pgd file 12/03/96 (V. Masson)
-!! change the surface initialization 20/03/96 ( Stein,
-!! Bougeault, Kastendeutsch )
-!! change the DEFAULT_DESFMN CALL 17/04/96 ( Lafore )
-!! set the STORAGE_TYPE to 'TT' (a single instant) 30/04/96 (Stein,
-!! Jabouille)
-!! new wguess to spread the divergence 15/05/96 (Stein)
-!! set LTHINSHELL to TRUE + return to the old wguess 29/08/96 (Stein)
-!! MY_NAME and DAD_NAME writing for nesting 30/07/96 (Lafore)
-!! MY_NAME and DAD_NAME reading in pgd file 26/09/96 (Masson)
-!! and reading of pgd grid in a new routine
-!! XXHAT and XYHAT are set to 0. at origine point 02/10/96 (Masson)
-!! add LTHINSHELL in namelist NAM_CONF_PRE 08/10/96 (Masson)
-!! restores use of TS and T2 26/11/96 (Masson)
-!! value XUNDEF for soil and vegetation fields on sea 27/11/96 (Masson)
-!! use of HUG and HU2 in both ISBA and TSZ0 cases 04/12/96 (Masson)
-!! add initialization of chemical variables 06/08/96 (K. Suhre)
-!! add MANUAL option for the terrain elevation 12/12/96 (J.-P. Pinty)
-!! set DATA instead of MANUAL for the terrain
-!! elevation option
-!! add new anelastic equations' systems 29/06/97 (Stein)
-!! split mode_lfifm_pgd 29/07/97 (Masson)
-!! add directional z0 and subgrid scale orography 31/07/97 (Masson)
-!! separates surface treatment in PREP_IDEAL_SURF 15/03/99 (Masson)
-!! new PGD fields allocations 15/03/99 (Masson)
-!! iterative call to pressure solver 15/03/99 (Masson)
-!! removes TSZ0 case 04/01/00 (Masson)
-!! parallelization 18/06/00 (Pinty)
-!! adaptation for patch approach 02/07/00 (Solmon/Masson)
-!! bug in W LB field on Y direction 05/03/01 (Stein)
-!! add module MODD_NSV for NSV variable 01/02/01 (D. Gazen)
-!! allow namelists in different orders 15/10/01 (I. Mallet)
-!! allow LUSERC and LUSERI in 1D configuration 05/06/02 (P. Jabouille)
-!! add ZUVTHLMR case (move in set_rsou latter) 05/12/02 Jabouille/Masson
-!! move LHORELAX_SV (after INI_NSV) 30/04/04 (Pinty)
-!! Correction Parallel bug IBEG & IDEND evalution 13/11/08 J.Escobar
-!! add the option LSHIFT for interpolation of 26/10/10 (G.Tanguy)
-!! correction for XHAT & parallelizarion of ZSDATA 23/09/11 J.Escobar
-!! the vertical profile (as in PREP_REAL_CASE)
-!! add use MODI of SURFEX routines 10/10/111 J.Escobar
-!!
-!! For 2D modeling:
-!! Initialization of ADVFRC profiles (SET_ADVFRC) 06/2010 (P.Peyrille)
-!! when LDUMMY(2)=T in PRE_IDEA1.nam
-!! USE MODDB_ADVFRC_n for grid-nesting 02*2012 (M. Tomasini)
-!! LBOUSS in MODD_REF 07/2013 (C.Lac)
-!! Correction for ZS in PGD file 04/2014 (G. TANGUY)
-!! Bug : remove NC WRITE_HGRID 05/2014 (S. Bielli via J.Escobar )
-!! BUG if ZFRC and ZFRC_ADV or ZFRC_REL are used together 11/2014 (G. Delautier)
-!! Bug : detected with cray compiler ,
-!! missing '&' in continuation string 3/12/2014 J.Escobar
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! 06/2016 (G.Delautier) phasage surfex 8
-!! P.Wautelet : 08/07/2016 : removed MNH_NCWRIT define
-!! 01/2018 (G.Delautier) SURFEX 8.1
-! P. Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
-! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
-! 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
-! F. Auguste 02/2021: add IBM
-! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
-! Jean-Luc Redelsperger 03/2021: ocean LES case
-! P. Wautelet 06/07/2021: use FINALIZE_MNH
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS ! Declarative modules
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-USE MODD_BUDGET, ONLY: TBUCONF_ASSOCIATE
-USE MODD_DIM_n
-USE MODD_CONF
-USE MODD_CST
-USE MODD_GRID
-USE MODD_GRID_n
-USE MODD_IBM_LSF, ONLY: CIBM_TYPE, LIBM_LSF, NIBM_SMOOTH, XIBM_SMOOTH
-USE MODD_IBM_PARAM_n, ONLY: XIBM_LS
-USE MODD_METRICS_n
-USE MODD_LES, ONLY : LES_ASSOCIATE
-USE MODD_PGDDIM
-USE MODD_PGDGRID
-USE MODD_TIME
-USE MODD_TIME_n
-USE MODD_REF
-USE MODD_REF_n
-USE MODD_LUNIT
-USE MODD_FIELD_n
-USE MODD_DYN_n
-USE MODD_LBC_n
-USE MODD_LSFIELD_n
-USE MODD_PARAM_n
-USE MODD_CH_MNHC_n, ONLY: LUSECHEM, LUSECHAQ, LUSECHIC, LCH_PH, LCH_INIT_FIELD
-USE MODD_CH_AEROSOL,ONLY: LORILAM, CORGANIC, LVARSIGI, LVARSIGJ, LINITPM, XINIRADIUSI, &
- XINIRADIUSJ, XINISIGI, XINISIGJ, XN0IMIN, XN0JMIN, CRGUNIT
-USE MODD_DUST, ONLY: LDUST, NMODE_DST, CRGUNITD, XINISIG, XINIRADIUS, XN0MIN
-USE MODD_SALT, ONLY: LSALT, NMODE_SLT, CRGUNITS, XINISIG_SLT, XINIRADIUS_SLT, XN0MIN_SLT
-USE MODD_VAR_ll, ONLY: NPROC
-USE MODD_LUNIT, ONLY: TLUOUT0, TOUTDATAFILE
-USE MODD_LUNIT_n
-USE MODD_IO, ONLY: TFILE_DUMMY, TFILE_OUTPUTLISTING
-USE MODD_CONF_n
-USE MODD_NSV, ONLY: NSV
-use modd_precision, only: LFIINT, MNHREAL_MPI, MNHTIME
-!
-USE MODN_BLANK_n
-!
-USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
-USE MODE_THERMO
-USE MODE_POS
-USE MODE_GRIDCART ! Executive modules
-USE MODE_GRIDPROJ
-USE MODE_GATHER_ll
-USE MODE_IO, only: IO_Config_set, IO_Init, IO_Pack_set
-USE MODE_IO_FIELD_READ, only: IO_Field_read
-USE MODE_IO_FIELD_WRITE, only: IO_Field_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
-USE MODE_MODELN_HANDLER
-use mode_field, only: Alloc_field_scalars, Ini_field_list, Ini_field_scalars
-USE MODE_MSG
-USE MODE_SET_GRID, only: INTERP_HORGRID_TO_MASSPOINTS, STORE_GLOB_HORGRID
-!
-USE MODI_DEFAULT_DESFM_n ! Interface modules
-USE MODI_DEFAULT_EXPRE
-USE MODI_IBM_INIT_LS
-USE MODI_READ_HGRID
-USE MODI_SHUMAN
-USE MODI_SET_RSOU
-USE MODI_SET_CSTN
-USE MODI_SET_FRC
-USE MODI_PRESSURE_IN_PREP
-USE MODI_WRITE_DESFM_n
-USE MODI_WRITE_LFIFM_n
-USE MODI_METRICS
-USE MODI_UPDATE_METRICS
-USE MODI_SET_REF
-USE MODI_SET_PERTURB
-USE MODI_TOTAL_DMASS
-USE MODI_CH_INIT_FIELD_n
-USE MODI_INI_NSV
-USE MODI_READ_PRE_IDEA_NAM_n
-USE MODI_ZSMT_PIC
-USE MODI_ZSMT_PGD
-USE MODI_READ_VER_GRID
-USE MODI_READ_ALL_NAMELISTS
-USE MODI_PGD_GRID_SURF_ATM
-USE MODI_SPLIT_GRID
-USE MODI_PGD_SURF_ATM
-USE MODI_ICE_ADJUST_BIS
-USE MODI_WRITE_PGD_SURF_ATM_n
-USE MODI_PREP_SURF_MNH
-USE MODI_INIT_SALT
-USE MODI_AER2LIMA
-USE MODD_PARAM_LIMA
-!
-!JUAN
-USE MODE_SPLITTINGZ_ll
-USE MODD_SUB_MODEL_n
-USE MODE_MNH_TIMING
-USE MODN_CONFZ
-!JUAN
-!
-USE MODI_VERSION
-USE MODI_INIT_PGD_SURF_ATM
-USE MODI_WRITE_SURF_ATM_N
-USE MODD_MNH_SURFEX_n
-! Modif ADVFRC
-USE MODD_2D_FRC
-USE MODD_ADVFRC_n ! Modif for grid-nesting
-USE MODI_SETADVFRC
-USE MODD_RELFRC_n ! Modif for grid-nesting
-USE MODI_SET_RELFRC
-!
-USE MODE_INI_CST, ONLY: INI_CST
-USE MODD_NEB_n, ONLY: NEBN
-USE MODI_WRITE_HGRID
-USE MODD_MPIF
-USE MODD_VAR_ll
-USE MODD_IO, ONLY: TFILEDATA,TFILE_SURFEX
-!
-USE MODE_MPPDB
-!
-USE MODD_GET_n
-!
-USE MODN_CONFIO, ONLY : NAM_CONFIO
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of global variables not declared in the modules
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: XJ ! Jacobian
-REAL :: XLATCEN=XUNDEF, XLONCEN=XUNDEF ! latitude and longitude of the center of
- ! the domain for initialization. This
- ! point is vertical vorticity point
- ! ------------------------
-REAL :: XDELTAX=0.5E4, XDELTAY=0.5E4 ! horizontal mesh lengths
- ! used to determine XXHAT,XYHAT
-!
-INTEGER :: NLUPRE,NLUOUT ! Logical unit numbers for EXPRE file
- ! and for output_listing file
-INTEGER :: NRESP ! return code in FM routines
-INTEGER :: NTYPE ! type of file (cpio or not)
-INTEGER(KIND=LFIINT) :: NNPRAR ! number of articles predicted in the LFIFM file
-LOGICAL :: GFOUND ! Return code when searching namelist
-!
-INTEGER :: JLOOP,JILOOP,JJLOOP ! Loop indexes
-!
-INTEGER :: NIB,NJB,NKB ! Begining useful area in x,y,z directions
-INTEGER :: NIE,NJE ! Ending useful area in x,y directions
-INTEGER :: NIU,NJU,NKU ! Upper bounds in x,y,z directions
-CHARACTER(LEN=4) :: CIDEAL ='CSTN' ! kind of idealized fields
- ! 'CSTN' : Nv=cste case
- ! 'RSOU' : radiosounding case
-CHARACTER(LEN=4) :: CZS ='FLAT' ! orography selector
- ! 'FLAT' : zero orography
- ! 'SINE' : sine-shaped orography
- ! 'BELL' : bell-shaped orography
-REAL :: XHMAX=XUNDEF ! Maximum height for orography
-REAL :: NEXPX=3,NEXPY=1 ! Exponents for orography in case of CZS='SINE'
-REAL :: XAX= 1.E4, XAY=1.E4 ! Widths for orography in case CZS='BELL'
- ! along x and y
-INTEGER :: NIZS = 5, NJZS = 5 ! Localization of the center in
- ! case CZS ='BELL'
-!
-!* 0.1.1 Declarations of local variables for N=cste and
-! radiosounding cases :
-!
-INTEGER :: NYEAR,NMONTH,NDAY ! year, month and day in EXPRE file
-REAL :: XTIME ! time in EXPRE file
-LOGICAL :: LPERTURB =.FALSE. ! Logical to add a perturbation to
- ! a basic state
-LOGICAL :: LGEOSBAL =.FALSE. ! Logical to satisfy the geostrophic
- ! balance
- ! .TRUE. for geostrophic balance
- ! .FALSE. to ignore this balance
-LOGICAL :: LSHIFT =.FALSE. ! flag to perform vertical shift or not.
-CHARACTER(LEN=3) :: CFUNU ='ZZZ' ! CHARACTER STRING for variation of
- ! U in y direction
- ! 'ZZZ' : U = U(Z)
- ! 'Y*Z' : U = F(Y) * U(Z)
- ! 'Y,Z' : U = G(Y,Z)
-CHARACTER(LEN=3) :: CFUNV ='ZZZ' ! CHARACTER STRING for variation of
- ! V in x direction
- ! 'ZZZ' : V = V(Z)
- ! 'Y*Z' : V = F(X) * V(Z)
- ! 'Y,Z' : V = G(X,Z)
-CHARACTER(LEN=6) :: CTYPELOC='IJGRID' ! Type of informations used to give the
- ! localization of vertical profile
- ! 'IJGRID' for (i,j) point on index space
- ! 'XYHATM' for (x,y) coordinates on
- ! conformal or cartesian plane
- ! 'LATLON' for (latitude,longitude) on
- ! spherical earth
-REAL :: XLATLOC= 45., XLONLOC=0.
- ! Latitude and longitude of the vertical
- ! profile localization (used in case
- ! CTYPELOC='LATLON')
-REAL :: XXHATLOC=2.E4, XYHATLOC=2.E4
- ! (x,y) of the vertical profile
- ! localization (used in cases
- ! CTYPELOC='LATLON' and 'XYHATM')
-INTEGER, DIMENSION(1) :: NILOC=4, NJLOC=4
- ! (i,j) of the vertical profile
- ! localization
-!
-!
-REAL,DIMENSION(:,:,:),ALLOCATABLE :: XCORIOZ ! Coriolis parameter (this
- ! is exceptionnaly a 3D array
- ! for computing needs)
-!
-!
-!* 0.1.2 Declarations of local variables used when a PhysioGraphic Data
-! file is used :
-!
-INTEGER :: JSV ! loop index on scalar var.
-CHARACTER(LEN=28) :: CPGD_FILE=' ' ! Physio-Graphic Data file name
-LOGICAL :: LREAD_ZS = .TRUE., & ! switch to use orography
- ! coming from the PGD file
- LREAD_GROUND_PARAM = .TRUE. ! switch to use soil parameters
- ! useful for the soil scheme
- ! coming from the PGD file
-
-INTEGER :: NSLEVE =12 ! number of iteration for smooth orography
-REAL :: XSMOOTH_ZS = XUNDEF ! optional uniform smooth orography for SLEVE coordinate
-CHARACTER(LEN=28) :: YPGD_NAME, YPGD_DAD_NAME ! general information
-CHARACTER(LEN=2) :: YPGD_TYPE
-!
-INTEGER :: IINFO_ll ! return code of // routines
-TYPE(LIST_ll), POINTER :: TZ_FIELDS_ll ! list of metric coefficient fields
-!
-INTEGER :: IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU ! dimensions of the
-INTEGER :: IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2 ! West-east LB arrays
-INTEGER :: IISIZEYF,IJSIZEYF,IISIZEYFV,IJSIZEYFV ! dimensions of the
-INTEGER :: IISIZEY4,IJSIZEY4,IISIZEY2,IJSIZEY2 ! North-south LB arrays
-INTEGER :: IBEG,IEND,IXOR,IXDIM,IYOR,IYDIM,ILBX,ILBY
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE ::ZTHL,ZT,ZRT,ZFRAC_ICE,&
- ZEXN,ZLVOCPEXN,ZLSOCPEXN,ZCPH, &
- ZRSATW, ZRSATI
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZBUF
- ! variables for adjustement
-REAL :: ZDIST
-!
-!JUAN TIMING
-REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME1, ZTIME2, ZEND, ZTOT
-CHARACTER :: YMI
-INTEGER :: IMI
-!JUAN TIMING
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZZS_ll
-INTEGER :: IJ
-!
-REAL :: ZZS_MAX, ZZS_MAX_ll
-INTEGER :: IJPHEXT
-!
-TYPE(TFILEDATA),POINTER :: TZEXPREFILE => NULL()
-!
-!
-!* 0.2 Namelist declarations
-!
-NAMELIST/NAM_CONF_PRE/ LTHINSHELL,LCARTESIAN, &! Declarations in MODD_CONF
- LPACK, &!
- NVERB,CIDEAL,CZS, &!+global variables initialized
- LBOUSS,LOCEAN,LPERTURB, &! at their declarations
- LFORCING,CEQNSYS, &! at their declarations
- LSHIFT,L2D_ADV_FRC,L2D_REL_FRC, &
- NHALO , JPHEXT
-NAMELIST/NAM_GRID_PRE/ XLON0,XLAT0, & ! Declarations in MODD_GRID
- XBETA,XRPK, &
- XLONORI,XLATORI
-NAMELIST/NAM_GRIDH_PRE/ XLATCEN,XLONCEN, & ! local variables initialized
- XDELTAX,XDELTAY, & ! at their declarations
- XHMAX,NEXPX,NEXPY, &
- XAX,XAY,NIZS,NJZS
-NAMELIST/NAM_VPROF_PRE/LGEOSBAL, CFUNU,CFUNV, &! global variables initialized
- CTYPELOC,XLATLOC,XLONLOC, &! at their declarations
- XXHATLOC,XYHATLOC,NILOC,NJLOC
-NAMELIST/NAM_REAL_PGD/CPGD_FILE, & ! Physio-Graphic Data file
- ! name
- LREAD_ZS, & ! switch to use orography
- ! coming from the PGD file
- LREAD_GROUND_PARAM
-NAMELIST/NAM_SLEVE/NSLEVE, XSMOOTH_ZS
-!
-!* 0.3 Auxillary Namelist declarations
-!
-NAMELIST/NAM_AERO_PRE/ LORILAM, LINITPM, XINIRADIUSI, XINIRADIUSJ, &
- XINISIGI, XINISIGJ, XN0IMIN, XN0JMIN, CRGUNIT, &
- LDUST, LSALT, CRGUNITD, CRGUNITS,&
- NMODE_DST, XINISIG, XINIRADIUS, XN0MIN,&
- XINISIG_SLT, XINIRADIUS_SLT, XN0MIN_SLT, &
- NMODE_SLT
-!
-NAMELIST/NAM_IBM_LSF/ LIBM_LSF, CIBM_TYPE, NIBM_SMOOTH, XIBM_SMOOTH
-!
-!-------------------------------------------------------------------------------
-!
-!* 0. PROLOGUE
-! --------
-CALL MPPDB_INIT()
-!
-CALL GOTO_MODEL(1)
-!
-CALL IO_Init()
-NULLIFY(TZ_FIELDS_ll)
-CALL VERSION
-CPROGRAM='IDEAL '
-!
-!JUAN TIMING
- XT_START = 0.0_MNHTIME
- XT_STORE = 0.0_MNHTIME
-!
- CALL SECOND_MNH2(ZEND)
-!
-!JUAN TIMING
-!
-!* 1. INITIALIZE PHYSICAL CONSTANTS :
-! ------------------------------
-!
-NVERB = 5
-CALL INI_CST
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 2. SET DEFAULT VALUES :
-! --------------------
-!
-!
-!* 2.1 For variables in DESFM file
-!
-CALL ALLOC_FIELD_SCALARS()
-CALL TBUCONF_ASSOCIATE()
-CALL LES_ASSOCIATE()
-CALL DEFAULT_DESFM_n(1)
-!
-CSURF = "NONE"
-!
-!
-!* 2.2 For other global variables in EXPRE file
-!
-CALL DEFAULT_EXPRE
-!-------------------------------------------------------------------------------
-!
-!* 3. READ THE EXPRE FILE :
-! --------------------
-!
-!* 3.1 initialize logical unit numbers (EXPRE and output-listing files)
-! and open these files :
-!
-!
-CALL IO_File_add2list(TLUOUT0,'OUTPUT_LISTING1','OUTPUTLISTING','WRITE')
-CALL IO_File_open(TLUOUT0)
-NLUOUT = TLUOUT0%NLU
-!Set output files for PRINT_MSG
-TLUOUT => TLUOUT0
-TFILE_OUTPUTLISTING => TLUOUT0
-!
-CALL IO_File_add2list(TZEXPREFILE,'PRE_IDEA1.nam','NML','READ')
-CALL IO_File_open(TZEXPREFILE)
-NLUPRE=TZEXPREFILE%NLU
-!
-!* 3.2 read in NLUPRE the namelist informations
-!
-WRITE(NLUOUT,FMT=*) 'attempt to read ',TRIM(TZEXPREFILE%CNAME),' file'
-CALL POSNAM(NLUPRE,'NAM_REAL_PGD',GFOUND,NLUOUT)
-IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_REAL_PGD)
-!
-!
-CALL POSNAM(NLUPRE,'NAM_CONF_PRE',GFOUND,NLUOUT)
-IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_CONF_PRE)
-!JUANZ
-CALL POSNAM(NLUPRE,'NAM_CONFZ',GFOUND,NLUOUT)
-IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_CONFZ)
-!JUANZ
-CALL POSNAM(NLUPRE,'NAM_CONFIO',GFOUND,NLUOUT)
-IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_CONFIO)
-CALL IO_Config_set()
-CALL POSNAM(NLUPRE,'NAM_GRID_PRE',GFOUND,NLUOUT)
-IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_GRID_PRE)
-CALL POSNAM(NLUPRE,'NAM_GRIDH_PRE',GFOUND,NLUOUT)
-IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_GRIDH_PRE)
-CALL POSNAM(NLUPRE,'NAM_VPROF_PRE',GFOUND,NLUOUT)
-IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_VPROF_PRE)
-CALL POSNAM(NLUPRE,'NAM_BLANKN',GFOUND,NLUOUT)
-CALL INIT_NAM_BLANKn
-IF (GFOUND) THEN
- READ(UNIT=NLUPRE,NML=NAM_BLANKn)
- CALL UPDATE_NAM_BLANKn
-END IF
-CALL READ_PRE_IDEA_NAM_n(NLUPRE,NLUOUT)
-CALL POSNAM(NLUPRE,'NAM_AERO_PRE',GFOUND,NLUOUT)
-IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_AERO_PRE)
-CALL POSNAM(NLUPRE,'NAM_IBM_LSF' ,GFOUND,NLUOUT)
-IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_IBM_LSF )
-!
-CALL INI_FIELD_LIST()
-!
-CALL INI_FIELD_SCALARS()
-! Sea salt
-CALL INIT_SALT
-!
-IF( LEN_TRIM(CPGD_FILE) /= 0 ) THEN
- ! open the PGD_FILE
- CALL IO_File_add2list(TPGDFILE,TRIM(CPGD_FILE),'PGD','READ',KLFINPRAR=NNPRAR,KLFITYPE=2,KLFIVERB=NVERB)
- CALL IO_File_open(TPGDFILE)
-
- ! read the grid in the PGD file
- CALL IO_Field_read(TPGDFILE,'IMAX', NIMAX)
- CALL IO_Field_read(TPGDFILE,'JMAX', NJMAX)
- CALL IO_Field_read(TPGDFILE,'JPHEXT',IJPHEXT)
-
- IF ( CPGD_FILE /= CINIFILEPGD) THEN
- WRITE(NLUOUT,FMT=*) ' WARNING : in PRE_IDEA1.nam, in NAM_LUNITn you&
- & have CINIFILEPGD= ',CINIFILEPGD
- WRITE(NLUOUT,FMT=*) ' whereas in NAM_REAL_PGD you have CPGD_FILE = '&
- ,CPGD_FILE
- WRITE(NLUOUT,FMT=*) ' '
- WRITE(NLUOUT,FMT=*) ' CINIFILEPGD HAS BEEN SET TO ',CPGD_FILE
- CINIFILEPGD=CPGD_FILE
- END IF
- IF ( IJPHEXT .NE. JPHEXT ) THEN
- WRITE(NLUOUT,FMT=*) ' PREP_IDEAL_CASE : JPHEXT in PRE_IDEA1.nam/NAM_CONF_PRE ( or default value )&
- & JPHEXT=',JPHEXT
- WRITE(NLUOUT,FMT=*) ' different from PGD files=', CINIFILEPGD,' value JPHEXT=',IJPHEXT
- WRITE(NLUOUT,FMT=*) '-> JOB ABORTED'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','')
- !WRITE(NLUOUT,FMT=*) ' JPHEXT HAS BEEN SET TO ', IJPHEXT
- !IJPHEXT = JPHEXT
- END IF
-END IF
-!
-NIMAX_ll=NIMAX !! _ll variables are global variables
-NJMAX_ll=NJMAX !! but the old names are kept in PRE_IDEA1.nam file
-!
-!* 3.3 check some parameters:
-!
-L1D=.FALSE. ; L2D=.FALSE.
-!
-IF ((NIMAX == 1).OR.(NJMAX == 1)) THEN
- L2D=.TRUE.
- NJMAX_ll=1
- NIMAX_ll=MAX(NIMAX,NJMAX)
- WRITE(NLUOUT,FMT=*) ' NJMAX HAS BEEN SET TO 1 SINCE 2D INITIAL FILE IS REQUIRED &
- & (L2D=TRUE) )'
-END IF
-!
-IF ((NIMAX == 1).AND.(NJMAX == 1)) THEN
- L1D=.TRUE.
- NIMAX_ll = 1
- NJMAX_ll = 1
- WRITE(NLUOUT,FMT=*) ' 1D INITIAL FILE IS REQUIRED (L1D=TRUE) '
-END IF
-!
-IF(.NOT. L1D) THEN
- LHORELAX_UVWTH=.TRUE.
- LHORELAX_RV=.TRUE.
-ENDIF
-!
-NRIMX= MIN(JPRIMMAX,NIMAX_ll/2)
-!
-IF (L2D) THEN
- NRIMY=0
-ELSE
- NRIMY= MIN(JPRIMMAX,NJMAX_ll/2)
-END IF
-!
-IF (L1D) THEN
- NRIMX=0
- NRIMY=0
-END IF
-!
-IF (L1D .AND. ( LPERTURB .OR. LGEOSBAL .OR. &
- (.NOT. LCARTESIAN ) .OR. (.NOT. LTHINSHELL) ))THEN
- LGEOSBAL = .FALSE.
- LPERTURB = .FALSE.
- LCARTESIAN = .TRUE.
- LTHINSHELL = .TRUE.
- WRITE(NLUOUT,FMT=*) ' LGEOSBAL AND LPERTURB HAVE BEEN SET TO FALSE &
- & AND LCARTESIAN AND LTHINSHELL TO TRUE &
- & SINCE 1D INITIAL FILE IS REQUIRED (L1D=TRUE)'
-END IF
-!
-IF (LGEOSBAL .AND. LSHIFT ) THEN
- LSHIFT=.FALSE.
- WRITE(NLUOUT,FMT=*) ' LSHIFT HAS BEEN SET TO FALSE SINCE &
- & LGEOSBAL=.TRUE. IS REQUIRED '
-END IF
-!
-!* 3.4 compute the number of moist variables :
-!
-IF (.NOT.LUSERV) THEN
- LUSERV = .TRUE.
- WRITE(NLUOUT,FMT=*) ' LUSERV HAS BEEN RESET TO TRUE, SINCE A MOIST VARIABLE &
- & IS PRESENT IN EXPRE FILE (CIDEAL = RSOU OR CSTN)'
-END IF
-!
-IF((LUSERI .OR. LUSERC).AND. (CIDEAL /= 'RSOU')) THEN
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','use of hydrometeors is only allowed in RSOU case')
-ENDIF
-IF (LUSERI) THEN
- LUSERC =.TRUE.
- LUSERR =.TRUE.
- LUSERI =.TRUE.
- LUSERS =.TRUE.
- LUSERG =.TRUE.
- LUSERH =.FALSE.
- CCLOUD='ICE3'
-ELSEIF(LUSERC) THEN
- LUSERR =.FALSE.
- LUSERI =.FALSE.
- LUSERS =.FALSE.
- LUSERG =.FALSE.
- LUSERH =.FALSE.
- CCLOUD='REVE'
-ELSE
- LUSERC =.FALSE.
- LUSERR =.FALSE.
- LUSERI =.FALSE.
- LUSERS =.FALSE.
- LUSERG =.FALSE.
- LUSERH =.FALSE.
- LHORELAX_RC=.FALSE.
- LHORELAX_RR=.FALSE.
- LHORELAX_RI=.FALSE.
- LHORELAX_RS=.FALSE.
- LHORELAX_RG=.FALSE.
- LHORELAX_RH=.FALSE.
- CCLOUD='NONE'
-!
-END IF
-!
-NRR=0
-IF (LUSERV) THEN
- NRR=NRR+1
- IDX_RVT = NRR
-END IF
-IF (LUSERC) THEN
- NRR=NRR+1
- IDX_RCT = NRR
-END IF
-IF (LUSERR) THEN
- NRR=NRR+1
- IDX_RRT = NRR
-END IF
-IF (LUSERI) THEN
- NRR=NRR+1
- IDX_RIT = NRR
-END IF
-IF (LUSERS) THEN
- NRR=NRR+1
- IDX_RST = NRR
-END IF
-IF (LUSERG) THEN
- NRR=NRR+1
- IDX_RGT = NRR
-END IF
-IF (LUSERH) THEN
- NRR=NRR+1
- IDX_RHT = NRR
-END IF
-!
-! NRR=4 for RSOU case because RI and Rc always computed
-IF (CIDEAL == 'RSOU' .AND. NRR < 4 ) NRR=4
-!
-!
-!* 3.5 Chemistry
-!
-IF (LORILAM .OR. LCH_INIT_FIELD) THEN
- LUSECHEM = .TRUE.
- IF (LORILAM) THEN
- CORGANIC = "MPMPO"
- LVARSIGI = .TRUE.
- LVARSIGJ = .TRUE.
- END IF
-END IF
-! initialise NSV_* variables
-CALL INI_NSV(1)
-LHORELAX_SV(:)=.FALSE.
-IF(.NOT. L1D) LHORELAX_SV(1:NSV)=.TRUE.
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. ALLOCATE MEMORY FOR ARRAYS :
-! ----------------------------
-!
-!* 4.1 Vertical Spatial grid
-!
-CALL READ_VER_GRID(TZEXPREFILE)
-!
-!* 4.2 Initialize parallel variables and compute array's dimensions
-!
-!
-IF(LGEOSBAL) THEN
- CALL SET_SPLITTING_ll('XSPLITTING') ! required for integration of thermal wind balance
-ELSE
- CALL SET_SPLITTING_ll('BSPLITTING')
-ENDIF
-CALL SET_JP_ll(1,JPHEXT,JPVEXT,JPHEXT)
-CALL SET_DAD0_ll()
-CALL SET_DIM_ll(NIMAX_ll, NJMAX_ll, NKMAX)
-CALL IO_Pack_set(L1D,L2D,LPACK)
-CALL SET_LBX_ll(CLBCX(1), 1)
-CALL SET_LBY_ll(CLBCY(1), 1)
-CALL SET_XRATIO_ll(1, 1)
-CALL SET_YRATIO_ll(1, 1)
-CALL SET_XOR_ll(1, 1)
-CALL SET_XEND_ll(NIMAX_ll+2*JPHEXT, 1)
-CALL SET_YOR_ll(1, 1)
-CALL SET_YEND_ll(NJMAX_ll+2*JPHEXT, 1)
-CALL SET_DAD_ll(0, 1)
-CALL INI_PARAZ_ll(IINFO_ll)
-!
-! sizes of arrays of the extended sub-domain
-!
-CALL GET_DIM_EXT_ll('B',NIU,NJU)
-CALL GET_DIM_PHYS_ll('B',NIMAX,NJMAX)
-CALL GET_INDICE_ll(NIB,NJB,NIE,NJE)
-CALL GET_OR_ll('B',IXOR,IYOR)
-NKB=1+JPVEXT
-NKU=NKMAX+2*JPVEXT
-!
-!* 4.3 Global variables absent from the modules :
-!
-ALLOCATE(XJ(NIU,NJU,NKU))
-SELECT CASE(CIDEAL)
- CASE('RSOU','CSTN')
- IF (LGEOSBAL) ALLOCATE(XCORIOZ(NIU,NJU,NKU)) ! exceptionally a 3D array
- CASE DEFAULT ! undefined preinitialization
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','CIDEAL is not correctly defined')
-END SELECT
-!
-!* 4.4 Prognostic variables at M instant (module MODD_FIELD1):
-!
-ALLOCATE(XUT(NIU,NJU,NKU))
-ALLOCATE(XVT(NIU,NJU,NKU))
-ALLOCATE(XWT(NIU,NJU,NKU))
-ALLOCATE(XTHT(NIU,NJU,NKU))
-ALLOCATE(XPABST(NIU,NJU,NKU))
-ALLOCATE(XRT(NIU,NJU,NKU,NRR))
-ALLOCATE(XSVT(NIU,NJU,NKU,NSV))
-!
-!* 4.5 Grid variables (module MODD_GRID1 and MODD_METRICS1):
-!
-ALLOCATE(XMAP(NIU,NJU))
-ALLOCATE(XLAT(NIU,NJU))
-ALLOCATE(XLON(NIU,NJU))
-ALLOCATE(XDXHAT(NIU),XDYHAT(NJU))
-IF (LEN_TRIM(CPGD_FILE)==0) ALLOCATE(XZS(NIU,NJU))
-IF (LEN_TRIM(CPGD_FILE)==0) ALLOCATE(ZZS_ll(NIMAX_ll))
-IF (LEN_TRIM(CPGD_FILE)==0) ALLOCATE(XZSMT(NIU,NJU))
-ALLOCATE(XZZ(NIU,NJU,NKU))
-!
-ALLOCATE(XDXX(NIU,NJU,NKU))
-ALLOCATE(XDYY(NIU,NJU,NKU))
-ALLOCATE(XDZX(NIU,NJU,NKU))
-ALLOCATE(XDZY(NIU,NJU,NKU))
-ALLOCATE(XDZZ(NIU,NJU,NKU))
-!
-!* 4.6 Reference state variables (modules MODD_REF and MODD_REF1):
-!
-ALLOCATE(XRHODREFZ(NKU),XTHVREFZ(NKU))
-XTHVREFZ(:)=0.0
-IF (LCOUPLES) THEN
- ! Arrays for reference state different in ocean and atmosphere
- ALLOCATE(XRHODREFZO(NKU),XTHVREFZO(NKU))
- XTHVREFZO(:)=0.0
-END IF
-IF(CEQNSYS == 'DUR') THEN
- ALLOCATE(XRVREF(NIU,NJU,NKU))
-ELSE
- ALLOCATE(XRVREF(0,0,0))
-END IF
-ALLOCATE(XRHODREF(NIU,NJU,NKU),XTHVREF(NIU,NJU,NKU),XEXNREF(NIU,NJU,NKU))
-ALLOCATE(XRHODJ(NIU,NJU,NKU))
-!
-!* 4.7 Larger Scale fields (modules MODD_LSFIELD1):
-!
-ALLOCATE(XLSUM(NIU,NJU,NKU))
-ALLOCATE(XLSVM(NIU,NJU,NKU))
-ALLOCATE(XLSWM(NIU,NJU,NKU))
-ALLOCATE(XLSTHM(NIU,NJU,NKU))
-IF ( NRR >= 1) THEN
- ALLOCATE(XLSRVM(NIU,NJU,NKU))
-ELSE
- ALLOCATE(XLSRVM(0,0,0))
-ENDIF
-!
-! allocate lateral boundary field used for coupling
-!
-IF ( L1D) THEN ! 1D case
-!
- NSIZELBX_ll=0
- NSIZELBXU_ll=0
- NSIZELBY_ll=0
- NSIZELBYV_ll=0
- NSIZELBXTKE_ll=0
- NSIZELBXR_ll=0
- NSIZELBXSV_ll=0
- NSIZELBYTKE_ll=0
- NSIZELBYR_ll=0
- NSIZELBYSV_ll=0
- ALLOCATE(XLBXUM(0,0,0))
- ALLOCATE(XLBYUM(0,0,0))
- ALLOCATE(XLBXVM(0,0,0))
- ALLOCATE(XLBYVM(0,0,0))
- ALLOCATE(XLBXWM(0,0,0))
- ALLOCATE(XLBYWM(0,0,0))
- ALLOCATE(XLBXTHM(0,0,0))
- ALLOCATE(XLBYTHM(0,0,0))
- ALLOCATE(XLBXTKEM(0,0,0))
- ALLOCATE(XLBYTKEM(0,0,0))
- ALLOCATE(XLBXRM(0,0,0,0))
- ALLOCATE(XLBYRM(0,0,0,0))
- ALLOCATE(XLBXSVM(0,0,0,0))
- ALLOCATE(XLBYSVM(0,0,0,0))
-!
-ELSEIF( L2D ) THEN ! 2D case (not yet parallelized)
-!
- CALL GET_SIZEX_LB(NIMAX_ll,NJMAX_ll,NRIMX, &
- IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU, &
- IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2)
- NSIZELBY_ll=0
- NSIZELBYV_ll=0
- NSIZELBYTKE_ll=0
- NSIZELBYR_ll=0
- NSIZELBYSV_ll=0
- ALLOCATE(XLBYUM(0,0,0))
- ALLOCATE(XLBYVM(0,0,0))
- ALLOCATE(XLBYWM(0,0,0))
- ALLOCATE(XLBYTHM(0,0,0))
- ALLOCATE(XLBYTKEM(0,0,0))
- ALLOCATE(XLBYRM(0,0,0,0))
- ALLOCATE(XLBYSVM(0,0,0,0))
- !
- IF ( LHORELAX_UVWTH ) THEN
-!JUAN A REVOIR TODO_JPHEXT
-! <<<<<<< prep_ideal_case.f90
- ! NSIZELBX_ll=2*NRIMX+2
- ! NSIZELBXU_ll=2*NRIMX+2
- ALLOCATE(XLBXUM(IISIZEXFU,NJU,NKU))
- ALLOCATE(XLBXVM(IISIZEXF,NJU,NKU))
- ALLOCATE(XLBXWM(IISIZEXF,NJU,NKU))
- ALLOCATE(XLBXTHM(IISIZEXF,NJU,NKU))
-! =======
- NSIZELBX_ll=2*NRIMX+2*JPHEXT
- NSIZELBXU_ll=2*NRIMX+2*JPHEXT
- ! ALLOCATE(XLBXUM(2*NRIMX+2*JPHEXT,NJU,NKU))
- ! ALLOCATE(XLBXVM(2*NRIMX+2*JPHEXT,NJU,NKU))
- ! ALLOCATE(XLBXWM(2*NRIMX+2*JPHEXT,NJU,NKU))
- ! ALLOCATE(XLBXTHM(2*NRIMX+2*JPHEXT,NJU,NKU))
-! >>>>>>> 1.3.2.4.2.3.2.14.2.8.2.11.2.2
- ELSE
- NSIZELBX_ll= 2*JPHEXT ! 2
- NSIZELBXU_ll=2*(JPHEXT+1) ! 4
- ALLOCATE(XLBXUM(NSIZELBXU_ll,NJU,NKU))
- ALLOCATE(XLBXVM(NSIZELBX_ll,NJU,NKU))
- ALLOCATE(XLBXWM(NSIZELBX_ll,NJU,NKU))
- ALLOCATE(XLBXTHM(NSIZELBX_ll,NJU,NKU))
- END IF
- !
- IF ( NRR > 0 ) THEN
- IF ( LHORELAX_RV .OR. LHORELAX_RC .OR. LHORELAX_RR .OR. LHORELAX_RI &
- .OR. LHORELAX_RS .OR. LHORELAX_RG .OR. LHORELAX_RH &
- ) THEN
-!JUAN A REVOIR TODO_JPHEXT
-! <<<<<<< prep_ideal_case.f90
- ! NSIZELBXR_ll=2* NRIMX+2
- ALLOCATE(XLBXRM(IISIZEXF,NJU,NKU,NRR))
-! =======
- NSIZELBXR_ll=2*NRIMX+2*JPHEXT
- ! ALLOCATE(XLBXRM(2*NRIMX+2*JPHEXT,NJU,NKU,NRR))
-! >>>>>>> 1.3.2.4.2.3.2.14.2.8.2.11.2.2
- ELSE
- NSIZELBXR_ll=2*JPHEXT ! 2
- ALLOCATE(XLBXRM(NSIZELBXR_ll,NJU,NKU,NRR))
- ENDIF
- ELSE
- NSIZELBXR_ll=0
- ALLOCATE(XLBXRM(0,0,0,0))
- END IF
- !
- IF ( NSV > 0 ) THEN
- IF ( ANY( LHORELAX_SV(:)) ) THEN
-!JUAN A REVOIR TODO_JPHEXT
-! <<<<<<< prep_ideal_case.f90
- ! NSIZELBXSV_ll=2* NRIMX+2
- ALLOCATE(XLBXSVM(IISIZEXF,NJU,NKU,NSV))
-! =======
- NSIZELBXSV_ll=2*NRIMX+2*JPHEXT
- ! ALLOCATE(XLBXSVM(2*NRIMX+2*JPHEXT,NJU,NKU,NSV))
-! >>>>>>> 1.3.2.4.2.3.2.14.2.8.2.11.2.2
- ELSE
- NSIZELBXSV_ll=2*JPHEXT ! 2
- ALLOCATE(XLBXSVM(NSIZELBXSV_ll,NJU,NKU,NSV))
- END IF
- ELSE
- NSIZELBXSV_ll=0
- ALLOCATE(XLBXSVM(0,0,0,0))
- END IF
-!
-ELSE ! 3D case
-!
- CALL GET_SIZEX_LB(NIMAX_ll,NJMAX_ll,NRIMX, &
- IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU, &
- IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2)
- CALL GET_SIZEY_LB(NIMAX_ll,NJMAX_ll,NRIMY, &
- IISIZEYF,IJSIZEYF,IISIZEYFV,IJSIZEYFV, &
- IISIZEY4,IJSIZEY4,IISIZEY2,IJSIZEY2)
-!
- IF ( LHORELAX_UVWTH ) THEN
- NSIZELBX_ll=2*NRIMX+2*JPHEXT
- NSIZELBXU_ll=2*NRIMX+2*JPHEXT
- NSIZELBY_ll=2*NRIMY+2*JPHEXT
- NSIZELBYV_ll=2*NRIMY+2*JPHEXT
- ALLOCATE(XLBXUM(IISIZEXFU,IJSIZEXFU,NKU))
- ALLOCATE(XLBYUM(IISIZEYF,IJSIZEYF,NKU))
- ALLOCATE(XLBXVM(IISIZEXF,IJSIZEXF,NKU))
- ALLOCATE(XLBYVM(IISIZEYFV,IJSIZEYFV,NKU))
- ALLOCATE(XLBXWM(IISIZEXF,IJSIZEXF,NKU))
- ALLOCATE(XLBYWM(IISIZEYF,IJSIZEYF,NKU))
- ALLOCATE(XLBXTHM(IISIZEXF,IJSIZEXF,NKU))
- ALLOCATE(XLBYTHM(IISIZEYF,IJSIZEYF,NKU))
- ELSE
- NSIZELBX_ll=2*JPHEXT ! 2
- NSIZELBXU_ll=2*(JPHEXT+1) ! 4
- NSIZELBY_ll=2*JPHEXT ! 2
- NSIZELBYV_ll=2*(JPHEXT+1) ! 4
- ALLOCATE(XLBXUM(IISIZEX4,IJSIZEX4,NKU))
- ALLOCATE(XLBYUM(IISIZEY2,IJSIZEY2,NKU))
- ALLOCATE(XLBXVM(IISIZEX2,IJSIZEX2,NKU))
- ALLOCATE(XLBYVM(IISIZEY4,IJSIZEY4,NKU))
- ALLOCATE(XLBXWM(IISIZEX2,IJSIZEX2,NKU))
- ALLOCATE(XLBYWM(IISIZEY2,IJSIZEY2,NKU))
- ALLOCATE(XLBXTHM(IISIZEX2,IJSIZEX2,NKU))
- ALLOCATE(XLBYTHM(IISIZEY2,IJSIZEY2,NKU))
- END IF
- !
- IF ( NRR > 0 ) THEN
- IF ( LHORELAX_RV .OR. LHORELAX_RC .OR. LHORELAX_RR .OR. LHORELAX_RI &
- .OR. LHORELAX_RS .OR. LHORELAX_RG .OR. LHORELAX_RH &
- ) THEN
- NSIZELBXR_ll=2*NRIMX+2*JPHEXT
- NSIZELBYR_ll=2*NRIMY+2*JPHEXT
- ALLOCATE(XLBXRM(IISIZEXF,IJSIZEXF,NKU,NRR))
- ALLOCATE(XLBYRM(IISIZEYF,IJSIZEYF,NKU,NRR))
- ELSE
- NSIZELBXR_ll=2*JPHEXT ! 2
- NSIZELBYR_ll=2*JPHEXT ! 2
- ALLOCATE(XLBXRM(IISIZEX2,IJSIZEX2,NKU,NRR))
- ALLOCATE(XLBYRM(IISIZEY2,IJSIZEY2,NKU,NRR))
- ENDIF
- ELSE
- NSIZELBXR_ll=0
- NSIZELBYR_ll=0
- ALLOCATE(XLBXRM(0,0,0,0))
- ALLOCATE(XLBYRM(0,0,0,0))
- END IF
- !
- IF ( NSV > 0 ) THEN
- IF ( ANY( LHORELAX_SV(:)) ) THEN
- NSIZELBXSV_ll=2*NRIMX+2*JPHEXT
- NSIZELBYSV_ll=2*NRIMY+2*JPHEXT
- ALLOCATE(XLBXSVM(IISIZEXF,IJSIZEXF,NKU,NSV))
- ALLOCATE(XLBYSVM(IISIZEYF,IJSIZEYF,NKU,NSV))
- ELSE
- NSIZELBXSV_ll=2*JPHEXT ! 2
- NSIZELBYSV_ll=2*JPHEXT ! 2
- ALLOCATE(XLBXSVM(IISIZEX2,IJSIZEX2,NKU,NSV))
- ALLOCATE(XLBYSVM(IISIZEY2,IJSIZEY2,NKU,NSV))
- END IF
- ELSE
- NSIZELBXSV_ll=0
- NSIZELBYSV_ll=0
- ALLOCATE(XLBXSVM(0,0,0,0))
- ALLOCATE(XLBYSVM(0,0,0,0))
- END IF
-END IF
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 5. INITIALIZE ALL THE MODEL VARIABLES
-! ----------------------------------
-!
-!
-!* 5.1 Grid variables and RS localization:
-!
-!* 5.1.1 Horizontal Spatial grid :
-!
-IF( LEN_TRIM(CPGD_FILE) /= 0 ) THEN
-!--------------------------------------------------------
-! the MESONH horizontal grid will be read in the PGD_FILE
-!--------------------------------------------------------
- CALL READ_HGRID(1,TPGDFILE,YPGD_NAME,YPGD_DAD_NAME,YPGD_TYPE)
-! control the cartesian option
- IF( LCARTESIAN ) THEN
- WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE : IN GENERAL, THE USE OF A PGD_FILE &
- & IMPLIES THAT YOU MUST TAKE INTO ACCOUNT THE EARTH SPHERICITY'
- WRITE(NLUOUT,FMT=*) 'NEVERTHELESS, LCARTESIAN HAS BEEN KEPT TO TRUE'
- END IF
-!
-!* use of the externalized surface
-!
- CSURF = "EXTE"
-!
-! determine whether the model is flat or no
-!
- ZZS_MAX = ABS( MAXVAL(XZS(NIB:NIU-JPHEXT,NJB:NJU-JPHEXT)))
- CALL MPI_ALLREDUCE(ZZS_MAX, ZZS_MAX_ll, 1, MNHREAL_MPI, MPI_MAX, &
- NMNH_COMM_WORLD,IINFO_ll)
- IF( ABS(ZZS_MAX_ll) < 1.E-10 ) THEN
- LFLAT=.TRUE.
- ELSE
- LFLAT=.FALSE.
- END IF
-!
-
-ELSE
-!------------------------------------------------------------------------
-! the MESONH horizontal grid is built from the PRE_IDEA1.nam informations
-!------------------------------------------------------------------------
-!
- ALLOCATE( XXHAT(NIU), XYHAT(NJU) )
- ALLOCATE( XXHATM(NIU), XYHATM(NJU) )
-!
-! define the grid localization at the earth surface by the central point
-! coordinates
-!
- IF (XLONCEN/=XUNDEF .OR. XLATCEN/=XUNDEF) THEN
- IF (XLONCEN/=XUNDEF .AND. XLATCEN/=XUNDEF) THEN
-!
-! it should be noted that XLATCEN and XLONCEN refer to a vertical
-! vorticity point and (XLATORI, XLONORI) refer to the mass point of
-! conformal coordinates (0,0). This is to allow the centering of the model in
-! a non-cyclic configuration regarding to XLATCEN or XLONCEN.
-!
- CALL SM_LATLON(XLATCEN,XLONCEN, &
- -XDELTAX*(NIMAX_ll/2-0.5+JPHEXT), &
- -XDELTAY*(NJMAX_ll/2-0.5+JPHEXT), &
- XLATORI,XLONORI)
-!
- WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE : XLATORI=' , XLATORI, &
- ' XLONORI= ', XLONORI
- ELSE
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE',&
- 'latitude and longitude of the center point must be initialized alltogether or not')
- END IF
- END IF
-!
- IF (NPROC > 1) THEN
- CALL GET_DIM_EXT_ll('B',IXDIM,IYDIM)
- IBEG = IXOR-JPHEXT-1
- IEND = IBEG+IXDIM-1
- XXHAT(:) = (/ (REAL(JLOOP)*XDELTAX, JLOOP=IBEG,IEND) /)
- IBEG = IYOR-JPHEXT-1
- IEND = IBEG+IYDIM-1
- XYHAT(:) = (/ (REAL(JLOOP)*XDELTAY, JLOOP=IBEG,IEND) /)
-!
- ELSE
- XXHAT(:) = (/ (REAL(JLOOP-NIB)*XDELTAX, JLOOP=1,NIU) /)
- XYHAT(:) = (/ (REAL(JLOOP-NJB)*XDELTAY, JLOOP=1,NJU) /)
- END IF
-
- ! Interpolations of positions to mass points
- CALL INTERP_HORGRID_TO_MASSPOINTS( XXHAT, XYHAT, XXHATM, XYHATM )
-
- ! Collect global domain boundaries
- CALL STORE_GLOB_HORGRID( XXHAT, XYHAT, XXHATM, XYHATM, XXHAT_ll, XYHAT_ll, XXHATM_ll, XYHATM_ll, XHAT_BOUND, XHATM_BOUND )
-
-END IF
-!
-!* 5.1.2 Orography and Gal-Chen Sommerville transformation :
-!
-IF ( LEN_TRIM(CPGD_FILE) == 0 .OR. .NOT. LREAD_ZS) THEN
- SELECT CASE(CZS) ! 'FLAT' or 'SINE' or 'BELL'
- CASE('FLAT')
- LFLAT = .TRUE.
- IF (XHMAX==XUNDEF) THEN
- XZS(:,:) = 0.
- ELSE
- XZS(:,:) = XHMAX
- END IF
- CASE('SINE') ! sinus-shaped orography
- IF (XHMAX==XUNDEF) XHMAX=300.
- LFLAT =.FALSE.
- XZS(:,:) = XHMAX & ! three-dimensional case
- *SPREAD((/((SIN((XPI/(NIMAX_ll+2*JPHEXT-1))*JLOOP)**2)**NEXPX,JLOOP=IXOR-1,IXOR+NIU-2)/),2,NJU) &
- *SPREAD((/((SIN((XPI/(NJMAX_ll+2*JPHEXT-1))*JLOOP)**2)**NEXPY,JLOOP=IYOR-1,IYOR+NJU-2)/),1,NIU)
- IF(L1D) THEN ! one-dimensional case
- XZS(:,:) = XHMAX
- END IF
- CASE('BELL') ! bell-shaped orography
- IF (XHMAX==XUNDEF) XHMAX=300.
- LFLAT = .FALSE.
- IF(.NOT.L2D) THEN ! three-dimensional case
- XZS(:,:) = XHMAX / ( 1. &
- + ( (SPREAD(XXHAT(1:NIU),2,NJU) - REAL(NIZS) * XDELTAX) /XAX ) **2 &
- + ( (SPREAD(XYHAT(1:NJU),1,NIU) - REAL(NJZS) * XDELTAY) /XAY ) **2 ) **1.5
- ELSE ! two-dimensional case
- XZS(:,:) = XHMAX / ( 1. &
- + ( (SPREAD(XXHAT(1:NIU),2,NJU) - REAL(NIZS) * XDELTAX) /XAX ) **2 )
- ENDIF
- IF(L1D) THEN ! one-dimensional case
- XZS(:,:) = XHMAX
- END IF
- CASE('COSI') ! (1+cosine)**4 shape
- IF (XHMAX==XUNDEF) XHMAX=800.
- LFLAT = .FALSE.
- IF(L2D) THEN ! two-dimensional case
- DO JILOOP = 1, NIU
- ZDIST = XXHAT(JILOOP)-REAL(NIZS)*XDELTAX
- IF( ABS(ZDIST)<(4.0*XAX) ) THEN
- XZS(JILOOP,:) = (XHMAX/16.0)*( 1.0 + COS((XPI*ZDIST)/(4.0*XAX)) )**4
- ELSE
- XZS(JILOOP,:) = 0.0
- ENDIF
- END DO
- ENDIF
- CASE('SCHA') ! exp(-(x/a)**2)*cosine(pi*x/lambda)**2 shape
- IF (XHMAX==XUNDEF) XHMAX=800.
- LFLAT = .FALSE.
- IF(L2D) THEN ! two-dimensional case
- DO JILOOP = 1, NIU
- ZDIST = XXHAT(JILOOP)-REAL(NIZS)*XDELTAX
- IF( ABS(ZDIST)<(4.0*XAX) ) THEN
- XZS(JILOOP,:) = XHMAX*EXP(-(ZDIST/XAY)**2)*COS((XPI*ZDIST)/XAX)**2
- ELSE
- XZS(JILOOP,:) = 0.0
- ENDIF
- END DO
- ENDIF
- CASE('AGNE') ! h*a**2/(x**2+a**2) shape
- LFLAT = .FALSE.
- IF(L2D) THEN ! two-dimensional case
- DO JILOOP = 1, NIU
- ZDIST = XXHAT(JILOOP)-REAL(NIZS)*XDELTAX
- XZS(JILOOP,:) = XHMAX*(XAX**2)/(XAX**2+ZDIST**2)
- END DO
- ELSE ! three dimensionnal case - infinite profile in y direction
- DO JILOOP = 1, NIU
- ZDIST = XXHAT(JILOOP)-REAL(NIZS)*XDELTAX
- XZS(JILOOP,:) = XHMAX*(XAX**2)/(XAX**2+ZDIST**2)
- END DO
- ENDIF
-
- CASE('DATA') ! discretized orography
- LFLAT =.FALSE.
- WRITE(NLUOUT,FMT=*) 'CZS="DATA", ATTEMPT TO READ ARRAY &
- &XZS(NIB:NIU-JPHEXT:1,NJU-JPHEXT:NJB:-1) &
- &starting from the first index'
- CALL POSKEY(NLUPRE,NLUOUT,'ZSDATA')
- DO JJLOOP = NJMAX_ll+2*JPHEXT-1,JPHEXT+1,-1 ! input like a map prior the sounding
- READ(NLUPRE,FMT=*) ZZS_ll
- IF ( ( JJLOOP <= ( NJU-JPHEXT + IYOR-1 ) ) .AND. ( JJLOOP >= ( NJB + IYOR-1 ) ) ) THEN
- IJ = JJLOOP - ( IYOR-1 )
- XZS(NIB:NIU-JPHEXT,IJ) = ZZS_ll(IXOR:IXOR + NIU-JPHEXT - NIB )
- END IF
- END DO
-!
- CASE DEFAULT ! undefined shape of orography
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','erroneous ground type')
- END SELECT
-!
- CALL ADD2DFIELD_ll( TZ_FIELDS_ll, XZS, 'PREP_IDEAL_CASE::XZS' )
- CALL UPDATE_HALO_ll(TZ_FIELDS_ll,IINFO_ll)
- CALL CLEANLIST_ll(TZ_FIELDS_ll)
-!
-END IF
-!
-!IF( ( LEN_TRIM(CPGD_FILE) /= 0 ) .AND. .NOT.LFLAT .AND. &
-! ((CLBCX(1) /= "OPEN" ) .OR. &
-! (CLBCX(2) /= "OPEN" ) .OR. (CLBCY(1) /= "OPEN" ) .OR. &
-! (CLBCY(2) /= "OPEN" )) ) THEN
-! !callabortstop
-! CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','with a PGD file, you cannot be in a cyclic LBC')
-!END IF
-!
-IF (LWEST_ll()) THEN
- DO JILOOP = 1,JPHEXT
- XZS(JILOOP,:) = XZS(NIB,:)
- END DO
-END IF
-IF (LEAST_ll()) THEN
- DO JILOOP = NIU-JPHEXT+1,NIU
- XZS(JILOOP,:)=XZS(NIU-JPHEXT,:)
- END DO
-END IF
-IF (LSOUTH_ll()) THEN
- DO JJLOOP = 1,JPHEXT
- XZS(:,JJLOOP)=XZS(:,NJB)
- END DO
-END IF
-IF (LNORTH_ll()) THEN
- DO JJLOOP =NJU-JPHEXT+1,NJU
- XZS(:,JJLOOP)=XZS(:,NJU-JPHEXT)
- END DO
-END IF
-!
-IF ( LEN_TRIM(CPGD_FILE) == 0 .OR. .NOT. LREAD_ZS) THEN
- IF (LSLEVE) THEN
- CALL ZSMT_PIC(NSLEVE,XSMOOTH_ZS)
- ELSE
- XZSMT(:,:) = 0.
- END IF
-END IF
-!
-IF (LCARTESIAN) THEN
- CALL SM_GRIDCART(XXHAT,XYHAT,XZHAT,XZS,LSLEVE,XLEN1,XLEN2,XZSMT,XDXHAT,XDYHAT,XZZ,XJ)
- XMAP=1.
-ELSE
- CALL SM_GRIDPROJ( XXHAT, XYHAT, XZHAT, XXHATM, XYHATM, XZS, &
- LSLEVE, XLEN1, XLEN2, XZSMT, XLATORI, XLONORI, &
- XMAP, XLAT, XLON, XDXHAT, XDYHAT, XZZ, XJ )
-END IF
-!* 5.4.1 metrics coefficients and update halos:
-!
-CALL METRICS(XMAP,XDXHAT,XDYHAT,XZZ,XDXX,XDYY,XDZX,XDZY,XDZZ)
-!
-CALL UPDATE_METRICS(CLBCX,CLBCY,XDXX,XDYY,XDZX,XDZY,XDZZ)
-!
-!* 5.1.3 Compute the localization in index space of the vertical profile
-! in CSTN and RSOU cases :
-!
-IF (CTYPELOC =='LATLON' ) THEN
- IF (.NOT.LCARTESIAN) THEN ! compute (x,y) if
- CALL SM_XYHAT(XLATORI,XLONORI, & ! the localization
- XLATLOC,XLONLOC,XXHATLOC,XYHATLOC) ! is given in latitude
- ELSE ! and longitude
- WRITE(NLUOUT,FMT=*) 'CTYPELOC CANNOT BE LATLON IN CARTESIAN GEOMETRY'
- WRITE(NLUOUT,FMT=*) '-> JOB ABORTED'
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','CTYPELOC cannot be LATLON in cartesian geometry')
- END IF
-END IF
-!
-IF (CTYPELOC /= 'IJGRID') THEN
- NILOC = MINLOC(ABS(XXHATLOC-XXHAT_ll(:)))
- NJLOC = MINLOC(ABS(XYHATLOC-XYHAT_ll(:)))
-END IF
-!
-IF ( L1D .AND. ( NILOC(1) /= 1 .OR. NJLOC(1) /= 1 ) ) THEN
- NILOC = 1
- NJLOC = 1
- WRITE(NLUOUT,FMT=*) 'FOR 1D CONFIGURATION, THE RS INFORMATIONS ARE TAKEN AT &
- & I=1 AND J=1 (CENTRAL VERTICAL WITHOUT HALO)'
-END IF
-!
-IF ( L2D .AND. ( NJLOC(1) /= 1 ) ) THEN
- NJLOC = 1
- WRITE(NLUOUT,FMT=*) 'FOR 2D CONFIGURATION, THE RS INFORMATIONS ARE TAKEN AT &
- & J=1 (CENTRAL PLANE WITHOUT HALO)'
-END IF
-!
-!* 5.2 Prognostic variables (not multiplied by rhoJ) : u,v,w,theta,r
-! and 1D anelastic reference state
-!
-!
-!* 5.2.1 Use a Radiosounding : CIDEAL='RSOU''
-!
-IF (CIDEAL == 'RSOU') THEN
- WRITE(NLUOUT,FMT=*) 'CIDEAL="RSOU", attempt to read DATE'
- CALL POSKEY(NLUPRE,NLUOUT,'RSOU')
- READ(NLUPRE,FMT=*) NYEAR,NMONTH,NDAY,XTIME
- TDTCUR = DATE_TIME(NYEAR,NMONTH,NDAY,XTIME)
- TDTEXP = TDTCUR
- TDTSEG = TDTCUR
- TDTMOD = TDTCUR
- WRITE(NLUOUT,FMT=*) 'CIDEAL="RSOU", ATTEMPT TO PROCESS THE SOUNDING DATA'
- IF (LGEOSBAL) THEN
- CALL SET_RSOU(TFILE_DUMMY,TZEXPREFILE,CFUNU,CFUNV,NILOC(1),NJLOC(1),LBOUSS, &
- XJ,LSHIFT,XCORIOZ)
- ELSE
- CALL SET_RSOU(TFILE_DUMMY,TZEXPREFILE,CFUNU,CFUNV,NILOC(1),NJLOC(1),LBOUSS, &
- XJ,LSHIFT)
- END IF
-!
-!* 5.2.2 N=cste and U(z) : CIDEAL='CSTN'
-!
-ELSE IF (CIDEAL == 'CSTN') THEN
- WRITE(NLUOUT,FMT=*) 'CIDEAL="CSTN", attempt to read DATE'
- CALL POSKEY(NLUPRE,NLUOUT,'CSTN')
- READ(NLUPRE,FMT=*) NYEAR,NMONTH,NDAY,XTIME
- TDTCUR = DATE_TIME(NYEAR,NMONTH,NDAY,XTIME)
- TDTEXP = TDTCUR
- TDTSEG = TDTCUR
- TDTMOD = TDTCUR
- WRITE(NLUOUT,FMT=*) 'CIDEAL="CSTN", ATTEMPT TO PROCESS THE SOUNDING DATA'
- IF (LGEOSBAL) THEN
- CALL SET_CSTN(TFILE_DUMMY,TZEXPREFILE,CFUNU,CFUNV,NILOC(1),NJLOC(1),LBOUSS, &
- XJ,LSHIFT,XCORIOZ)
- ELSE
- CALL SET_CSTN(TFILE_DUMMY,TZEXPREFILE,CFUNU,CFUNV,NILOC(1),NJLOC(1),LBOUSS, &
- XJ,LSHIFT)
- END IF
-!
-END IF
-!
-!* 5.3 Forcing variables
-!
-IF (LFORCING) THEN
- WRITE(NLUOUT,FMT=*) 'FORCING IS ENABLED, ATTEMPT TO SET FORCING FIELDS'
- CALL POSKEY(NLUPRE,NLUOUT,'ZFRC ','PFRC')
- CALL SET_FRC(TZEXPREFILE)
-END IF
-!
-!! ---------------------------------------------------------------------
-! Modif PP ADV FRC
-! 5.4.2 initialize profiles for adv forcings
-IF (L2D_ADV_FRC) THEN
- WRITE(NLUOUT,FMT=*) 'L2D_ADV_FRC IS SET TO TRUE'
- WRITE(NLUOUT,FMT=*) 'ADVECTING FORCING USED IS USER MADE, NOT STANDARD ONE '
- WRITE(NLUOUT,FMT=*) 'IT IS FOR 2D IDEALIZED WAM STUDY ONLY '
- CALL POSKEY(NLUPRE,NLUOUT,'ZFRC_ADV')
- CALL SET_ADVFRC(TZEXPREFILE)
-ENDIF
-IF (L2D_REL_FRC) THEN
- WRITE(NLUOUT,FMT=*) 'L2D_REL_FRC IS SET TO TRUE'
- WRITE(NLUOUT,FMT=*) 'RELAXATION FORCING USED IS USER MADE, NOT STANDARD ONE '
- WRITE(NLUOUT,FMT=*) 'IT IS FOR 2D IDEALIZED WAM STUDY ONLY '
- CALL POSKEY(NLUPRE,NLUOUT,'ZFRC_REL')
- CALL SET_RELFRC(TZEXPREFILE)
-ENDIF
-!* 5.4 3D Reference state variables :
-!
-!
-!* 5.4.1 metrics coefficients and update halos:
-!
-CALL METRICS(XMAP,XDXHAT,XDYHAT,XZZ,XDXX,XDYY,XDZX,XDZY,XDZZ)
-!
-CALL UPDATE_METRICS(CLBCX,CLBCY,XDXX,XDYY,XDZX,XDZY,XDZZ)
-!
-!* 5.4.2 3D reference state :
-!
-CALL SET_REF( 0, TFILE_DUMMY, &
- XZZ, XZHATM, XJ, XDXX, XDYY, CLBCX, CLBCY, &
- XREFMASS, XMASS_O_PHI0, XLINMASS, &
- XRHODREF, XTHVREF, XRVREF, XEXNREF, XRHODJ )
-!
-!
-!* 5.5.1 Absolute pressure :
-!
-!
-!* 5.5.2 Total mass of dry air Md computation :
-!
-CALL TOTAL_DMASS(XJ,XRHODREF,XDRYMASST)
-!
-!
-!* 5.6 Complete prognostic variables (multipliy by rhoJ) at time t :
-!
-! U grid : gridpoint 2
-IF (LWEST_ll()) XUT(1,:,:) = 2.*XUT(2,:,:) - XUT(3,:,:)
-! V grid : gridpoint 3
-IF (LSOUTH_ll()) XVT(:,1,:) = 2.*XVT(:,2,:) - XVT(:,3,:)
-! SV : gridpoint 1
-XSVT(:,:,:,:) = 0.
-!
-!
-!* 5.7 Larger scale fields initialization :
-!
-XLSUM(:,:,:) = XUT(:,:,:) ! these fields do not satisfy the
-XLSVM(:,:,:) = XVT(:,:,:) ! lower boundary condition but are
-XLSWM(:,:,:) = XWT(:,:,:) ! in equilibrium
-XLSTHM(:,:,:)= XTHT(:,:,:)
-XLSRVM(:,:,:)= XRT(:,:,:,1)
-!
-! enforce the vertical homogeneity under the ground and above the top of
-! the model for the LS fields
-!
-XLSUM(:,:,NKB-1)=XLSUM(:,:,NKB)
-XLSUM(:,:,NKU)=XLSUM(:,:,NKU-1)
-XLSVM(:,:,NKB-1)=XLSVM(:,:,NKB)
-XLSVM(:,:,NKU)=XLSVM(:,:,NKU-1)
-XLSWM(:,:,NKB-1)=XLSWM(:,:,NKB)
-XLSWM(:,:,NKU)=XLSWM(:,:,NKU-1)
-XLSTHM(:,:,NKB-1)=XLSTHM(:,:,NKB)
-XLSTHM(:,:,NKU)=XLSTHM(:,:,NKU-1)
-IF ( NRR > 0 ) THEN
- XLSRVM(:,:,NKB-1)=XLSRVM(:,:,NKB)
- XLSRVM(:,:,NKU)=XLSRVM(:,:,NKU-1)
-END IF
-!
-ILBX=SIZE(XLBXUM,1)
-ILBY=SIZE(XLBYUM,2)
-IF(LWEST_ll() .AND. .NOT. L1D) THEN
- XLBXUM(1:NRIMX+JPHEXT, :,:) = XUT(2:NRIMX+JPHEXT+1, :,:)
- XLBXVM(1:NRIMX+JPHEXT, :,:) = XVT(1:NRIMX+JPHEXT, :,:)
- XLBXWM(1:NRIMX+JPHEXT, :,:) = XWT(1:NRIMX+JPHEXT, :,:)
- XLBXTHM(1:NRIMX+JPHEXT, :,:) = XTHT(1:NRIMX+JPHEXT, :,:)
- XLBXRM(1:NRIMX+JPHEXT, :,:,:) = XRT(1:NRIMX+JPHEXT, :,:,:)
-ENDIF
-IF(LEAST_ll() .AND. .NOT. L1D) THEN
- XLBXUM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:) = XUT(NIU-NRIMX-JPHEXT+1:NIU, :,:)
- XLBXVM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:) = XVT(NIU-NRIMX-JPHEXT+1:NIU, :,:)
- XLBXWM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:) = XWT(NIU-NRIMX-JPHEXT+1:NIU, :,:)
- XLBXTHM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:) = XTHT(NIU-NRIMX-JPHEXT+1:NIU, :,:)
- XLBXRM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:,:) = XRT(NIU-NRIMX-JPHEXT+1:NIU, :,:,:)
-ENDIF
-IF(LSOUTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) THEN
- XLBYUM(:,1:NRIMY+JPHEXT, :) = XUT(:,1:NRIMY+JPHEXT, :)
- XLBYVM(:,1:NRIMY+JPHEXT, :) = XVT(:,2:NRIMY+JPHEXT+1, :)
- XLBYWM(:,1:NRIMY+JPHEXT, :) = XWT(:,1:NRIMY+JPHEXT, :)
- XLBYTHM(:,1:NRIMY+JPHEXT, :) = XTHT(:,1:NRIMY+JPHEXT, :)
- XLBYRM(:,1:NRIMY+JPHEXT, :,:) = XRT(:,1:NRIMY+JPHEXT, :,:)
-ENDIF
-IF(LNORTH_ll().AND. .NOT. L1D .AND. .NOT. L2D) THEN
- XLBYUM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:) = XUT(:,NJU-NRIMY-JPHEXT+1:NJU, :)
- XLBYVM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:) = XVT(:,NJU-NRIMY-JPHEXT+1:NJU, :)
- XLBYWM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:) = XWT(:,NJU-NRIMY-JPHEXT+1:NJU, :)
- XLBYTHM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:) = XTHT(:,NJU-NRIMY-JPHEXT+1:NJU, :)
- XLBYRM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:,:) = XRT(:,NJU-NRIMY-JPHEXT+1:NJU, :,:)
-ENDIF
-DO JSV = 1, NSV
- IF(LWEST_ll() .AND. .NOT. L1D) &
- XLBXSVM(1:NRIMX+JPHEXT, :,:,JSV) = XSVT(1:NRIMX+JPHEXT, :,:,JSV)
- IF(LEAST_ll() .AND. .NOT. L1D) &
- XLBXSVM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:,JSV) = XSVT(NIU-NRIMX-JPHEXT+1:NIU, :,:,JSV)
- IF(LSOUTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) &
- XLBYSVM(:,1:NRIMY+JPHEXT, :,JSV) = XSVT(:,1:NRIMY+JPHEXT, :,JSV)
- IF(LNORTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) &
- XLBYSVM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:,JSV) = XSVT(:,NJU-NRIMY-JPHEXT+1:NJU, :,JSV)
-END DO
-!
-!
-!* 5.8 Add a perturbation to a basic state :
-!
-IF(LPERTURB) CALL SET_PERTURB(TZEXPREFILE)
-!
-!
-!* 5.9 Anelastic correction and pressure:
-!
-IF (.NOT.LOCEAN) THEN
- CALL ICE_ADJUST_BIS(XPABST,XTHT,XRT)
- IF ( .NOT. L1D ) CALL PRESSURE_IN_PREP(XDXX,XDYY,XDZX,XDZY,XDZZ)
- CALL ICE_ADJUST_BIS(XPABST,XTHT,XRT)
-END IF
-!
-!
-!* 5.10 Compute THETA, vapor and cloud mixing ratio
-!
-IF (CIDEAL == 'RSOU') THEN
- ALLOCATE(ZEXN(NIU,NJU,NKU))
- ALLOCATE(ZT(NIU,NJU,NKU))
- ALLOCATE(ZTHL(NIU,NJU,NKU))
- ALLOCATE(ZRT(NIU,NJU,NKU))
- ALLOCATE(ZCPH(NIU,NJU,NKU))
- ALLOCATE(ZLVOCPEXN(NIU,NJU,NKU))
- ALLOCATE(ZLSOCPEXN(NIU,NJU,NKU))
- ALLOCATE(ZFRAC_ICE(NIU,NJU,NKU))
- ALLOCATE(ZRSATW(NIU,NJU,NKU))
- ALLOCATE(ZRSATI(NIU,NJU,NKU))
- ALLOCATE(ZBUF(NIU,NJU,NKU,16))
- ZRT=XRT(:,:,:,1)+XRT(:,:,:,2)+XRT(:,:,:,4)
-IF (LOCEAN) THEN
- ZEXN(:,:,:)= 1.
- ZT=XTHT
- ZTHL=XTHT
- ZCPH=XCPD+ XCPV * XRT(:,:,:,1)
- ZLVOCPEXN = XLVTT
- ZLSOCPEXN = XLSTT
-ELSE
- ZEXN=(XPABST/XP00) ** (XRD/XCPD)
- ZT=XTHT*(XPABST/XP00)**(XRD/XCPD)
- ZCPH=XCPD+ XCPV * XRT(:,:,:,1)+ XCL *XRT(:,:,:,2) + XCI * XRT(:,:,:,4)
- ZLVOCPEXN = (XLVTT + (XCPV-XCL) * (ZT-XTT))/(ZCPH*ZEXN)
- ZLSOCPEXN = (XLSTT + (XCPV-XCI) * (ZT-XTT))/(ZCPH*ZEXN)
- ZTHL=XTHT-ZLVOCPEXN*XRT(:,:,:,2)-ZLSOCPEXN*XRT(:,:,:,4)
- CALL TH_R_FROM_THL_RT(CST, NEBN, SIZE(ZFRAC_ICE), 'T',ZFRAC_ICE,XPABST,ZTHL,ZRT,XTHT,XRT(:,:,:,1), &
- XRT(:,:,:,2),XRT(:,:,:,4),ZRSATW, ZRSATI,OOCEAN=.FALSE.,&
- PBUF=ZBUF)
-END IF
- DEALLOCATE(ZEXN)
- DEALLOCATE(ZT)
- DEALLOCATE(ZCPH)
- DEALLOCATE(ZLVOCPEXN)
- DEALLOCATE(ZLSOCPEXN)
- DEALLOCATE(ZTHL)
- DEALLOCATE(ZRT)
- DEALLOCATE(ZBUF)
-! Coherence test
- IF ((.NOT. LUSERI) ) THEN
- IF (MAXVAL(XRT(:,:,:,4))/= 0) THEN
- WRITE(NLUOUT,FMT=*) "*********************************"
- WRITE(NLUOUT,FMT=*) 'WARNING'
- WRITE(NLUOUT,FMT=*) 'YOU HAVE LUSERI=FALSE '
- WRITE(NLUOUT,FMT=*) ' BUT WITH YOUR RADIOSOUNDING Ri/=0'
- WRITE(NLUOUT,FMT=*) MINVAL(XRT(:,:,:,4)),MAXVAL(XRT(:,:,:,4))
- WRITE(NLUOUT,FMT=*) "*********************************"
- ENDIF
- ENDIF
- IF ((.NOT. LUSERC)) THEN
- IF (MAXVAL(XRT(:,:,:,2))/= 0) THEN
- WRITE(NLUOUT,FMT=*) "*********************************"
- WRITE(NLUOUT,FMT=*) 'WARNING'
- WRITE(NLUOUT,FMT=*) 'YOU HAVE LUSERC=FALSE '
- WRITE(NLUOUT,FMT=*) 'BUT WITH YOUR RADIOSOUNDING RC/=0'
- WRITE(NLUOUT,FMT=*) MINVAL(XRT(:,:,:,2)),MAXVAL(XRT(:,:,:,2))
- WRITE(NLUOUT,FMT=*) "*********************************"
- ENDIF
- ENDIF
- ! on remet les bonnes valeurs pour NRR
- IF(CCLOUD=='NONE') NRR=1
- IF(CCLOUD=='REVE') NRR=2
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 6. INITIALIZE SCALAR VARIABLES FOR CHEMISTRY
-! -----------------------------------------
-!
-! before calling chemistry
-CCONF = 'START'
-CSTORAGE_TYPE='TT'
-CALL IO_File_close(TZEXPREFILE) ! Close the EXPRE file
-!
-IF ( LCH_INIT_FIELD ) CALL CH_INIT_FIELD_n(1, NLUOUT, NVERB)
-!
-! Initialization LIMA variables by ORILAM
-IF (CCLOUD == 'LIMA' .AND. ((LORILAM).OR.(LDUST).OR.(LSALT))) &
- CALL AER2LIMA(XSVT, XRHODREF, XRT(:,:,:,1), XPABST, XTHT, XZZ)
-!-------------------------------------------------------------------------------
-!
-!* 7. INITIALIZE LEVELSET FOR IBM
-! ---------------------------
-!
-IF (LIBM_LSF) THEN
- !
- ! In their current state, the IBM can only be used in
- ! combination with cartesian coordinates and flat orography.
- !
- IF ((CZS.NE."FLAT").OR.(.NOT.LCARTESIAN)) THEN
- CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','IBM can only be used with flat ground')
- ENDIF
- !
- ALLOCATE(XIBM_LS(NIU,NJU,NKU,4))
- !
- CALL IBM_INIT_LS(XIBM_LS)
- !
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* 8. WRITE THE FMFILE
-! ----------------
-!
-CALL SECOND_MNH2(ZTIME1)
-!
-NNPRAR = 22 + 2*(NRR+NSV) & ! 22 = number of grid variables + reference
- + 8 + 17 ! state variables + dimension variables
- ! 2*(8+NRR+NSV) + 1 = number of prognostic
- ! variables at time t and t-dt
-NTYPE=1
-!
-CALL IO_File_add2list(TINIFILE,TRIM(CINIFILE),'MNH','WRITE',KLFINPRAR=NNPRAR,KLFITYPE=NTYPE,KLFIVERB=NVERB)
-!
-CALL IO_File_open(TINIFILE)
-!
-CALL IO_Header_write(TINIFILE)
-!
-CALL WRITE_DESFM_n(1,TINIFILE)
-!
-CALL WRITE_LFIFM_n(TINIFILE,'') ! There is no DAD model for PREP_IDEAL_CASE
-!
-CALL SECOND_MNH2(ZTIME2)
-!
-XT_STORE = XT_STORE + ZTIME2 - ZTIME1
-!
-!-------------------------------------------------------------------------------
-!
-!* 9. EXTERNALIZED SURFACE
-! --------------------
-!
-!
-IF (CSURF =='EXTE') THEN
- IF (LEN_TRIM(CINIFILEPGD)==0) THEN
- IF (LEN_TRIM(CPGD_FILE)/=0) THEN
- CINIFILEPGD=CPGD_FILE
- ELSE
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','CINIFILEPGD needed in NAM_LUNITn')
- ENDIF
- ENDIF
- CALL SURFEX_ALLOC_LIST(1)
- YSURF_CUR => YSURF_LIST(1)
- CALL READ_ALL_NAMELISTS(YSURF_CUR,'MESONH','PRE',.FALSE.)
- ! Switch to model 1 surface variables
- CALL GOTO_SURFEX(1)
- !* definition of physiographic fields
- ! computed ...
- IF (LEN_TRIM(CPGD_FILE)==0 .OR. .NOT. LREAD_GROUND_PARAM) THEN
- TPGDFILE => TINIFILE
- CALL PGD_GRID_SURF_ATM(YSURF_CUR%UG, YSURF_CUR%U,YSURF_CUR%GCP,'MESONH',TINIFILE%CNAME,'MESONH',.TRUE.,HDIR='-')
- CALL PGD_SURF_ATM (YSURF_CUR,'MESONH',TINIFILE%CNAME,'MESONH',.TRUE.)
- CALL IO_File_add2list(TINIFILEPGD,TRIM(CINIFILEPGD),'PGD','WRITE',KLFINPRAR=NNPRAR,KLFITYPE=NTYPE,KLFIVERB=NVERB)
- CALL IO_File_open (TINIFILEPGD)
- TPGDFILE => TINIFILEPGD
- ELSE
- ! ... or read from file.
- CALL INIT_PGD_SURF_ATM( YSURF_CUR, 'MESONH', 'PGD', &
- ' ', ' ', &
- TDTCUR%nyear, TDTCUR%nmonth, &
- TDTCUR%nday, TDTCUR%xtime )
-!
- END IF
- !
- !* forces orography from atmospheric file
- IF (.NOT. LREAD_ZS) CALL MNHPUT_ZS_n
- !
- ! on ecrit un nouveau fichier PGD que s'il n'existe pas
- IF (LEN_TRIM(CPGD_FILE)==0 .OR. .NOT. LREAD_GROUND_PARAM) THEN
- !* writing of physiographic fields in the file
- CSTORAGE_TYPE='PG'
- !
- CALL IO_Header_write(TINIFILEPGD)
- CALL IO_Field_write(TINIFILEPGD,'JPHEXT', JPHEXT)
- CALL IO_Field_write(TINIFILEPGD,'SURF','EXTE')
- CALL IO_Field_write(TINIFILEPGD,'L1D', L1D)
- CALL IO_Field_write(TINIFILEPGD,'L2D', L2D)
- CALL IO_Field_write(TINIFILEPGD,'PACK',LPACK)
- CALL WRITE_HGRID(1,TINIFILEPGD)
- !
- TOUTDATAFILE => TINIFILEPGD
- !
- TFILE_SURFEX => TINIFILEPGD
- ALLOCATE(YSURF_CUR%DUO%CSELECT(0))
- CALL WRITE_PGD_SURF_ATM_n(YSURF_CUR,'MESONH')
- NULLIFY(TFILE_SURFEX)
- CSTORAGE_TYPE='TT'
- ENDIF
- !
- !
- !* rereading of physiographic fields and definition of prognostic fields
- !* writing of all surface fields
- TOUTDATAFILE => TINIFILE
- TFILE_SURFEX => TINIFILE
- CALL PREP_SURF_MNH(' ',' ')
- NULLIFY(TFILE_SURFEX)
-ELSE
- CSURF = "NONE"
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 10. CLOSES THE FILE
-! ---------------
-!
-IF (CSURF =='EXTE' .AND. (LEN_TRIM(CPGD_FILE)==0 .OR. .NOT. LREAD_GROUND_PARAM)) THEN
- CALL IO_File_close(TINIFILEPGD)
-ENDIF
-CALL IO_File_close(TINIFILE)
-IF( LEN_TRIM(CPGD_FILE) /= 0 ) THEN
- CALL IO_File_close(TPGDFILE)
-ENDIF
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 11. PRINTS ON OUTPUT-LISTING
-! ------------------------
-!
-IF (NVERB >= 5) THEN
- WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: LCARTESIAN,CIDEAL,CZS=', &
- LCARTESIAN,CIDEAL,CZS
- WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: LUSERV=',LUSERV
- WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: XLON0,XLAT0,XBETA,XRPK,XLONORI,XLATORI=', &
- XLON0,XLAT0,XBETA,XRPK,XLONORI,XLATORI
- WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: XDELTAX,XDELTAY=',XDELTAX,XDELTAY
- WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: NVERB=',NVERB
- IF(LCARTESIAN) THEN
- WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: No map projection used.'
- ELSE
- IF (XRPK == 1.) THEN
- WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: Polar stereo used.'
- ELSE IF (XRPK == 0.) THEN
- WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: Mercator used.'
- ELSE
- WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: Lambert used, cone factor=',XRPK
- END IF
- END IF
-END IF
-!
-IF (NVERB >= 5) THEN
- WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: IIB, IJB, IKB=',NIB,NJB,NKB
- WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: IIU, IJU, IKU=',NIU,NJU,NKU
-END IF
-!
-!
-!* 28.1 print statistics!
-!
- !
- CALL SECOND_MNH2(ZTIME2)
- XT_START=XT_START+ZTIME2-ZEND
- !
- ! Set File Timing OUTPUT
- !
- CALL SET_ILUOUT_TIMING(TLUOUT0)
- !
- ! Compute global time
- !
- CALL TIME_STAT_ll(XT_START,ZTOT)
- !
- !
- IMI = 1
- CALL TIME_HEADER_ll(IMI)
- !
- CALL TIME_STAT_ll(XT_STORE,ZTOT, ' STORE-FIELDS','=')
- 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('+')
-WRITE(NLUOUT,FMT=*) ' '
-WRITE(NLUOUT,FMT=*) '****************************************************'
-WRITE(NLUOUT,FMT=*) '* PREP_IDEAL_CASE: PREP_IDEAL_CASE ENDS CORRECTLY. *'
-WRITE(NLUOUT,FMT=*) '****************************************************'
-!
-CALL FINALIZE_MNH()
-!
-!
-CONTAINS
-INCLUDE "th_r_from_thl_rt.func.h"
-INCLUDE "compute_frac_ice.func.h"
-END PROGRAM PREP_IDEAL_CASE
diff --git a/src/mesonh/ext/prep_nest_pgd.f90 b/src/mesonh/ext/prep_nest_pgd.f90
deleted file mode 100644
index 4a2352d7736938047c49746ff2bfb416e4357fb1..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/prep_nest_pgd.f90
+++ /dev/null
@@ -1,408 +0,0 @@
-!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! #####################
- PROGRAM PREP_NEST_PGD
-! #####################
-!
-!!**** *PREP_NEST_PGD* - to make coherent pgd files for nesting
-!!
-!! PURPOSE
-!! -------
-!!
-!! The purpose of this program is to prepare pgd files with which
-!! nesting can be performed. A pgd file must be coherent with its
-!! father:
-!! The average of orography of fine model on each of its father grid
-!! mesh must be the same as its father orography.
-!!
-!! All the pgd files are read at the begining of the program,
-!! then they are checked, and recursively, the orography of a father
-!! is replaced by the averaged orography from ist son.
-!!
-!! The control data are given in the namelist file PRE_NEST.nam
-!!
-!! &NAM_NEST_PGD1 CPGD='coarser model' /
-!! &NAM_NEST_PGD2 CPGD='medium model' , IDAD=1 /
-!! &NAM_NEST_PGD3 CPGD='medium model' , IDAD=1 /
-!! &NAM_NEST_PGD4 CPGD='fine model' , IDAD=2 /
-!! &NAM_NEST_PGD5 CPGD='fine model' , IDAD=2 /
-!! &NAM_NEST_PGD6 CPGD='fine model' , IDAD=3 /
-!! &NAM_NEST_PGD7 CPGD='very fine model' , IDAD=6 /
-!! &NAM_NEST_PGD8 CPGD='very very fine model' , IDAD=7 /
-!!
-!! In each namelist is given the name of the pgd file, and the number
-!! of its father. This one MUST be smaller.
-!! There is one output file for each input file, with the suffix
-!! '.nest' added at the end of the file name (even if the file has not
-!! been changed).
-!!
-!! In the case of the namelist above, one obtain something like:
-!!
-!! +----------------------------------------------------------+
-!! | 1 |
-!! | +-----------------------+ |
-!! | | 2 | |
-!! | | | |
-!! | | +-+ | |
-!! | | +-------+ |5| | +-----------------------+ |
-!! | | | 4 | +-+ | | +----------+ 3 | |
-!! | | +-------+ | | |+------+ 6| | |
-!! | +-----------------------+ | || +-+ 7| | | |
-!! | | || |8| | | | |
-!! | | || +-+ | | | |
-!! | | |+------+ | | |
-!! | | +----------+ | |
-!! | +-----------------------+ |
-!! +----------------------------------------------------------+
-!!
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book 2
-!!
-!! AUTHOR
-!! ------
-!!
-!! V.Masson Meteo-France
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 26/09/95
-!! 30/07/97 (Masson) split of mode_lfifm_pgd
-!! 2014 (M.Faivre)
-!! 06/2015 (M.Moge) parallelization
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! J.Escobar : 19/04/2016 : Pb IOZ/NETCDF , missing OPARALLELIO=.FALSE. for PGD files
-!! 06/2016 (G.Delautier) phasage surfex 8
-!! P.Wautelet : 08/07/2016 : removed MNH_NCWRIT define
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
-! P. Wautelet 06/07/2021: use FINALIZE_MNH
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CONF
-USE MODD_CONF_n
-USE MODD_CST
-USE MODD_DIM_n
-USE MODD_IO, ONLY: TFILE_SURFEX, TPTR2FILE
-USE MODD_GRID_n, ONLY: XZSMT
-USE MODD_LUNIT, ONLY: TPGDFILE,TLUOUT0,TOUTDATAFILE
-USE MODD_MNH_SURFEX_n
-USE MODD_NESTING
-USE MODD_PARAMETERS
-USE MODD_VAR_ll, ONLY: NPROC, IP, NMNH_COMM_WORLD
-!
-use mode_field, only: Ini_field_list
-USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
-USE MODE_IO, only: IO_Init, IO_Pack_set
-USE MODE_IO_FIELD_READ, only: IO_Field_read
-USE MODE_IO_FIELD_WRITE, only: IO_Field_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
-USE MODE_MNH_WORLD, ONLY: INIT_NMNH_COMM_WORLD
-USE MODE_MODELN_HANDLER
-USE MODE_MPPDB
-USE MODE_SPLITTINGZ_ll, ONLY: INI_PARAZ_ll
-!
-USE MODI_DEFINE_MASK_n
-USE MODI_INIT_HORGRID_ll_n
-USE MODI_INIT_PGD_SURF_ATM
-USE MODI_NEST_FIELD_n
-USE MODI_NEST_ZSMT_n
-USE MODI_OPEN_NESTPGD_FILES
-USE MODI_READ_ALL_NAMELISTS
-USE MODI_READ_HGRID
-USE MODI_RETRIEVE1_NEST_INFO_n
-USE MODI_VERSION
-USE MODI_WRITE_PGD_SURF_ATM_N
-USE MODE_INI_CST, ONLY: INI_CST
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of local variables
-! ------------------------------
-!
-INTEGER, DIMENSION(JPMODELMAX) :: NXSIZE ! number of grid points for each model
-INTEGER, DIMENSION(JPMODELMAX) :: NYSIZE ! in x and y-directions
- ! relatively to its father grid
-!
-INTEGER :: ILUOUT0
-INTEGER :: IINFO_ll ! return code of // routines
-INTEGER :: JPGD ! loop control
-CHARACTER(LEN=28) :: YMY_NAME,YDAD_NAME
-CHARACTER(LEN=2) :: YSTORAGE_TYPE
-LOGICAL, DIMENSION(JPMODELMAX) :: L1D_ALL ! Flag for 1D conf. for each PGD
-LOGICAL, DIMENSION(JPMODELMAX) :: L2D_ALL ! Flag for 2D conf. for each PGD
-LOGICAL, DIMENSION(JPMODELMAX) :: LPACK_ALL! Flag for packing conf. for each PGD
-!
-INTEGER :: JTIME,ITIME
-INTEGER :: IIMAX,IJMAX,IKMAX
-INTEGER :: IDXRATIO,IDYRATIO
-INTEGER :: IDAD
-INTEGER :: II
-LOGICAL :: GISINIT
-!
-TYPE(TPTR2FILE),DIMENSION(:),ALLOCATABLE :: TZFILEPGD ! Input PGD files
-TYPE(TPTR2FILE),DIMENSION(:),ALLOCATABLE,TARGET :: TZFILENESTPGD ! Output PGD files
-!
-!-------------------------------------------------------------------------------
-!
-CALL MPPDB_INIT()
-!
-CALL VERSION
-CPROGRAM='NESPGD'
-!
-CALL IO_Init()
-!!$CALL SET_JP_ll(JPMODELMAX,JPHEXT,JPVEXT,JPHEXT)
-!
-!* 1. INITIALIZATION OF PHYSICAL CONSTANTS
-! ------------------------------------
-!
-CALL INI_CST
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. OPENING OF THE FILES
-! ---------------------
-!
-NVERB=1
-!
-CALL OPEN_NESTPGD_FILES(TZFILEPGD,TZFILENESTPGD)
-CALL SET_JP_ll(JPMODELMAX,JPHEXT,JPVEXT,JPHEXT)
-!
-ILUOUT0 = TLUOUT0%NLU
-!
-CALL SURFEX_ALLOC_LIST(NMODEL)
-YSURF_CUR => YSURF_LIST(1)
-CALL READ_ALL_NAMELISTS(YSURF_CUR,'MESONH','PRE',.FALSE.)
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. READING OF THE GRIDS
-! --------------------
-!
-CALL INI_FIELD_LIST()
-!
-CALL SET_DAD0_ll()
-DO JPGD=1,NMODEL
- ! read and set dimensions and ratios of model JPGD
- CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'IMAX', IIMAX)
- CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'JMAX', IJMAX)
- CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'DXRATIO',NDXRATIO_ALL(JPGD))
- CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'DYRATIO',NDYRATIO_ALL(JPGD))
- CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'XSIZE', NXSIZE(JPGD))
- CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'YSIZE', NYSIZE(JPGD))
- CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'XOR', NXOR_ALL(JPGD))
- CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'YOR', NYOR_ALL(JPGD))
- CALL SET_DIM_ll(IIMAX, IJMAX, 1)
- ! compute origin and end of local subdomain of model JPGD
- ! initialize variables from MODD_NESTING, origin and end of global model JPGD in coordinates of its father
- IF ( NDAD(JPGD) > 0 ) THEN
- NXEND_ALL(JPGD) = NXOR_ALL(JPGD) + NXSIZE(JPGD) - 1 + 2*JPHEXT
- NYEND_ALL(JPGD) = NYOR_ALL(JPGD) + NYSIZE(JPGD) - 1 + 2*JPHEXT
- ELSE ! this is not a son model
- NXOR_ALL(JPGD) = 1
- NXEND_ALL(JPGD) = IIMAX+2*JPHEXT
- NYOR_ALL(JPGD) = 1
- NYEND_ALL(JPGD) = IJMAX+2*JPHEXT
- NDXRATIO_ALL(JPGD) = 1
- NDYRATIO_ALL(JPGD) = 1
- ENDIF
- ! initialize variables from MODD_DIM_ll, origin and end of global model JPGD in coordinates of its father
- CALL SET_XOR_ll(NXOR_ALL(JPGD), JPGD)
- CALL SET_XEND_ll(NXEND_ALL(JPGD), JPGD)
- CALL SET_YOR_ll(NYOR_ALL(JPGD), JPGD)
- CALL SET_YEND_ll(NYEND_ALL(JPGD), JPGD)
- ! set the father model of model JPGD
-! set MODD_NESTING::NDAD using MODD_DIM_ll::NDAD
-! MODD_DIM_ll::NDAD was filled in OPEN_NESTPGD_FILES
- CALL SET_DAD_ll(NDAD(JPGD), JPGD)
- ! set the ratio of model JPGD in MODD_DIM_ll
- CALL SET_XRATIO_ll(NDXRATIO_ALL(JPGD), JPGD)
- CALL SET_YRATIO_ll(NDYRATIO_ALL(JPGD), JPGD)
-END DO
-!
-! reading of the grids
-!
- CALL SET_DIM_ll(NXEND_ALL(1)-NXOR_ALL(1)+1-2*JPHEXT, NYEND_ALL(1)-NYOR_ALL(1)+1-2*JPHEXT, 1)
- CALL INI_PARAZ_ll(IINFO_ll)
-DO JPGD=1,NMODEL
- CALL GOTO_MODEL(JPGD)
- CALL GO_TOMODEL_ll(JPGD,IINFO_ll)
- CALL GOTO_SURFEX(JPGD)
- CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'L1D', L1D_ALL(JPGD))
- CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'L2D', L2D_ALL(JPGD))
- CALL IO_Field_read(TZFILEPGD(JPGD)%TZFILE,'PACK',LPACK_ALL(JPGD))
- CALL IO_Pack_set(L1D_ALL(JPGD),L2D_ALL(JPGD),LPACK_ALL(JPGD))
- CALL READ_HGRID(JPGD,TZFILEPGD(JPGD)%TZFILE,YMY_NAME,YDAD_NAME,YSTORAGE_TYPE)
- CSTORAGE_TYPE='PG'
-END DO
- CALL INI_PARAZ_ll(IINFO_ll)
-!
-!-------------------------------------------------------------------------------
-!
-!* 5. MASKS DEFINITIONS
-! -----------------
-!
-
-DO JPGD=1,NMODEL
- CALL GOTO_SURFEX(JPGD)
- CALL GOTO_MODEL(JPGD)
- CALL GO_TOMODEL_ll(JPGD,IINFO_ll)
-!!$ CALL INIT_HORGRID_ll_n()
- CALL DEFINE_MASK_n()
-END DO
-!
-!-------------------------------------------------------------------------------
-!
-!* 6. MODIFICATION OF OROGRAPHY
-! -------------------------
-!
-WRITE(ILUOUT0,FMT=*)
-WRITE(ILUOUT0,FMT=*) 'field ZS of all models'
-DO JPGD=NMODEL,1,-1
- CALL GOTO_MODEL(JPGD)
- CALL GO_TOMODEL_ll(JPGD,IINFO_ll)
- CALL GOTO_SURFEX(JPGD)
- CALL NEST_FIELD_n('ZS ')
-END DO
-!
-! *** Adaptation of smooth topography for SLEVE coordinate
-!
-WRITE(ILUOUT0,FMT=*)
-WRITE(ILUOUT0,FMT=*) 'field ZSMT of all models'
-DO JPGD=1,NMODEL
- CALL GOTO_MODEL(JPGD)
- CALL GO_TOMODEL_ll(JPGD,IINFO_ll)
- CALL GOTO_SURFEX(JPGD)
- CALL NEST_ZSMT_n('ZSMT ')
-END DO
-
-!
-!-------------------------------------------------------------------------------
-!
-!* 7. SURFACE FIELDS READING
-! ----------------------
-!
-DO JPGD=1,NMODEL
- IF (LEN_TRIM(TZFILEPGD(JPGD)%TZFILE%CNAME)>0) THEN
- CALL GO_TOMODEL_ll(JPGD,IINFO_ll)
- TPGDFILE => TZFILEPGD(JPGD)%TZFILE
- CALL GOTO_MODEL(JPGD)
- CALL GOTO_SURFEX(JPGD)
- CALL INIT_PGD_SURF_ATM(YSURF_CUR,'MESONH','PGD', &
- ' ',' ',&
- NUNDEF,NUNDEF,NUNDEF,XUNDEF )
- END IF
-END DO
-!
-!-------------------------------------------------------------------------------
-!
-!* 8. MODIFICATION OF OROGRAPHY
-! -------------------------
-!
-DO JPGD=1,NMODEL
- CALL GOTO_MODEL(JPGD)
- CALL GO_TOMODEL_ll(JPGD,IINFO_ll)
- CALL GOTO_SURFEX(JPGD)
- CALL MNHPUT_ZS_n
-END DO
-!
-!-------------------------------------------------------------------------------
-!
-!* 10. SURFACE FIELDS WRITING
-! ----------------------
-!
-DO JPGD=1,NMODEL
- CALL GO_TOMODEL_ll(JPGD,IINFO_ll)
- TPGDFILE => TZFILEPGD(JPGD)%TZFILE
- TOUTDATAFILE => TZFILENESTPGD(JPGD)%TZFILE
- CALL GOTO_MODEL(JPGD)
- !Open done here because grid dimensions have to be known
- CALL IO_File_open(TZFILENESTPGD(JPGD)%TZFILE)
- CALL GOTO_SURFEX(JPGD)
- TFILE_SURFEX => TZFILENESTPGD(JPGD)%TZFILE
- CALL WRITE_PGD_SURF_ATM_n(YSURF_CUR,'MESONH')
- NULLIFY(TFILE_SURFEX)
- CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'ZSMT',XZSMT)
-END DO
-!
-!-------------------------------------------------------------------------------
-!
-!* 12. Write configuration variables in the output file
-! ------------------------------------------------
-!
-!
-DO JPGD=1,NMODEL
- CALL IO_Header_write(TZFILENESTPGD(JPGD)%TZFILE)
- IF ( ASSOCIATED(TZFILENESTPGD(JPGD)%TZFILE%TDADFILE) ) THEN
- CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'DXRATIO',NDXRATIO_ALL(JPGD))
- CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'DYRATIO',NDYRATIO_ALL(JPGD))
- CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'XOR', NXOR_ALL(JPGD))
- CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'YOR', NYOR_ALL(JPGD))
- END IF
- CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'SURF', 'EXTE')
- CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'L1D', L1D_ALL(JPGD))
- CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'L2D', L2D_ALL(JPGD))
- CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'PACK', LPACK_ALL(JPGD))
- CALL IO_Field_write(TZFILENESTPGD(JPGD)%TZFILE,'JPHEXT',JPHEXT)
-END DO
-!
-!-------------------------------------------------------------------------------
-!
-!* 13. CLOSING OF THE FILES
-! --------------------
-!
-DO JPGD=1,NMODEL
- CALL IO_File_close(TZFILEPGD(JPGD)%TZFILE)
- CALL IO_File_close(TZFILENESTPGD(JPGD)%TZFILE)
-END DO
-!
-!* loop to spare enough time to transfer commands before end of program
-ITIME=0
-DO JTIME=1,1000000
- ITIME=ITIME+1
-END DO
-!-------------------------------------------------------------------------------
-!
-!* 12. EPILOGUE
-! --------
-!
-WRITE(ILUOUT0,FMT=*)
-WRITE(ILUOUT0,FMT=*) '************************************************'
-WRITE(ILUOUT0,FMT=*) '* PREP_NEST_PGD: PREP_NEST_PGD ends correctly. *'
-WRITE(ILUOUT0,FMT=*) '************************************************'
-!
-!-------------------------------------------------------------------------------
-!
-!* 10. FINALIZE THE PARALLEL SESSION
-! -----------------------------
-!
-CALL FINALIZE_MNH()
-
-! CALL END_PARA_ll(IINFO_ll)
-!
-! CALL SURFEX_DEALLO_LIST
-!
-!-------------------------------------------------------------------------------
-
-END PROGRAM PREP_NEST_PGD
diff --git a/src/mesonh/ext/prep_pgd.f90 b/src/mesonh/ext/prep_pgd.f90
deleted file mode 100644
index 41c4a13988d5a89107b90a04cc434da82ca0bb7d..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/prep_pgd.f90
+++ /dev/null
@@ -1,340 +0,0 @@
-!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ################
- PROGRAM PREP_PGD
-! ################
-!!
-!! PURPOSE
-!! -------
-!! This program prepares the physiographic data fields.
-!!
-!! METHOD
-!! ------
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! F. Mereyde Meteo-France
-!!
-!! MODIFICATION
-!! ------------
-!!
-!! Original 21/07/95
-!! Modification 26/07/95 Treatment of orography and subgrid-scale
-!! orography roughness length (V. Masson)
-!! Modification 22/05/96 Variable CSTORAGE_TYPE (V. Masson)
-!! Modification 25/05/96 Modification of splines, correction on z0rel
-!! and set limits for some surface varaibles
-!! Modification 12/06/96 Treatment of a rare case for ZPGDZ0EFF (Masson)
-!! Modification 22/11/96 removes the filtering. It will have to be
-!! performed in ADVANCED_PREP_PGD (Masson)
-!! Modification 15/03/99 **** MAJOR MODIFICATION **** (Masson)
-!! PGD fields are now defined from the cover
-!! type fractions in the grid meshes
-!! User can still include its own data, and
-!! even additional (dummy) fields
-!! Modificatio 06/00 patch approach, for vegetation related variable (Solmon/Masson)
-! averaging is performed on subclass(=patch) of nature
-!! 08/03/01 add chemical emission treatment (D.Gazen)
-!! Modification 15/10/01 allow namelists in different orders (I.Mallet)
-!!
-!! ################################
-!! MODIFICATION 13/10/03 EXTERNALIZED VERSION (V. Masson)
-!! ################################
-!! J.Escobar 4/04/2008 Improve checking --> add STATUS=OLD in open_ll(PRE_PGD1.nam,...
-!!
-!! Modification 30/03/2012 Add NAM_NCOUT for netcdf output (S.Bielli)
-!! S.Bielli 23/04/2014 supress writing of LAt and LON in NETCDF case
-!! S.Bielli 20/11/2014 add writing of LAt and LON in NETCDF case
-!! M.Moge 01/03/2015 use MPPDB + SPLIT_GRID is now called in PGD_GRID. Here we extend
-!! the new grid on the halo with EXTEND_GRID_ON_HALO (M.Moge)
-!! M.Moge 06/2015 write NDXRATIO,NDYRATIO,NXSIZE,NYSIZE,NXOR,NYOR in .lfi output file
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! J.Escobar : 05/10/2015 : missing JPHEXT for LAT/LON/ZS/ZSMT writing
-!! M.Moge 11/2015 disable the creation of files on multiple
-!! Z-levels when using parallel IO for PREP_PGD
-!! 06/2016 (G.Delautier) phasage surfex 8
-!! P.Wautelet : 08/07/2016 : removed MNH_NCWRIT define
-!! 10/2016 (S.Faroux S.Bielli) correction for NHALO=0
-!! 01/2018 (G.Delautier) SURFEX 8.1
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! Q. Rodier 01/2019 : add a new filtering for very high slopes in NAM_ZSFILTER
-! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
-! P. Wautelet 07/02/2019: remove OPARALLELIO argument from open and close files subroutines
-! (nsubfiles_ioz is now determined in IO_File_add2list)
-! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
-! P. Wautelet 06/07/2021: use FINALIZE_MNH
-!----------------------------------------------------------------------------
-!
-!* 0. DECLARATION
-! -----------
-!
-USE MODD_CONF, ONLY : CPROGRAM, L1D, L2D, LPACK, LCARTESIAN
-USE MODD_CONF_n,ONLY : CSTORAGE_TYPE
-USE MODD_LUNIT, ONLY : TLUOUT0
-USE MODD_LUNIT_n,ONLY : LUNIT_MODEL
-USE MODD_PARAMETERS, ONLY : XUNDEF
-USE MODD_IO, only: TFILEDATA, TFILE_OUTPUTLISTING, TFILE_SURFEX
-use modd_precision, only: LFIINT
-USE MODD_IO_SURF_MNH, ONLY : NHALO
-USE MODD_SPAWN, ONLY : NDXRATIO,NDYRATIO,NXSIZE,NYSIZE,NXOR,NYOR
-!
-use mode_field, only: Ini_field_list
-USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
-USE MODE_IO, only: IO_Config_set, IO_Init
-USE MODE_IO_FIELD_WRITE, only: IO_Field_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
-USE MODE_MODELN_HANDLER
-USE MODE_MSG
-USE MODE_POS
-!
-USE MODI_ZSMT_PGD
-!
-!JUAN
-USE MODN_CONFZ
-USE MODD_PARAMETERS, ONLY : JPHEXT
-USE MODD_CONF, ONLY : NHALO_CONF_MNH => NHALO
-!JUAN
-!
-USE MODI_READ_ALL_NAMELISTS
-USE MODI_VERSION
-USE MODI_PGD_GRID_SURF_ATM
-USE MODI_SPLIT_GRID
-USE MODI_PGD_SURF_ATM
-USE MODI_WRITE_PGD_SURF_ATM_N
-USE MODD_MNH_SURFEX_n
-!
-USE MODE_MPPDB
-USE MODI_EXTEND_GRID_ON_HALO
-!
-USE MODN_CONFIO, ONLY : NAM_CONFIO
-USE MODE_INI_CST, ONLY: INI_CST
-!
-IMPLICIT NONE
-!
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-INTEGER :: IRESP ! return code for I/O
-INTEGER :: ILUOUT0
-INTEGER :: ILUNAM
-LOGICAL :: GFOUND
-CHARACTER(LEN=28) :: YDAD =' ' ! name of dad of input FM file
-CHARACTER(LEN=28) :: CPGDFILE ='PGDFILE' ! name of the output file
-CHARACTER(LEN=100) :: YMSG
-INTEGER :: NZSFILTER=1 ! number of iteration for filter for fine orography
-INTEGER :: NLOCZSFILTER=3 ! number of iteration for filter of local fine orography
-LOGICAL :: LHSLOP=.FALSE. ! filtering of local slopes higher than XHSLOP
-REAL :: XHSLOP=1.0 ! slopes where the local fine filtering is applied
-INTEGER :: NSLEVE =12 ! number of iteration for filter for smooth orography
-REAL :: XSMOOTH_ZS = XUNDEF ! optional uniform smooth orography for SLEVE coordinate
-REAL, DIMENSION(:,:),ALLOCATABLE :: ZWORK ! work array for lat and lon reshape
-REAL, DIMENSION(:,:),ALLOCATABLE :: ZWORK_LAT ! work array for lat and lon reshape
-REAL, DIMENSION(:,:),ALLOCATABLE :: ZWORK_LON ! work array for lat and lon reshape
-INTEGER :: IIMAX, IJMAX
-INTEGER :: NHALO_MNH
-TYPE(TFILEDATA),POINTER :: TZFILE => NULL()
-TYPE(TFILEDATA),POINTER :: TZNMLFILE => NULL() ! Namelist file
-!
-NAMELIST/NAM_PGDFILE/CPGDFILE, NHALO
-NAMELIST/NAM_ZSFILTER/NZSFILTER,NLOCZSFILTER,LHSLOP,XHSLOP
-NAMELIST/NAM_SLEVE/NSLEVE, XSMOOTH_ZS
-NAMELIST/NAM_CONF_PGD/JPHEXT, NHALO_MNH
-!------------------------------------------------------------------------------
-!
-CALL MPPDB_INIT()
-!
-CPROGRAM='PGD '
-!
-!* 1. Set default names and parallelized I/O
-! --------------------------------------
-!
-CALL IO_Init()
-!
-NHALO=15
-!
-CALL IO_File_add2list(TLUOUT0,'OUTPUT_LISTING0','OUTPUTLISTING','WRITE')
-CALL IO_File_open(TLUOUT0)
-!
-!Set output file for PRINT_MSG
-TFILE_OUTPUTLISTING => TLUOUT0
-!
-LUNIT_MODEL(1)%TLUOUT => TLUOUT0
-ILUOUT0=TLUOUT0%NLU
-!
-!JUAN
-CALL IO_File_add2list(TZNMLFILE,'PRE_PGD1.nam','NML','READ')
-CALL IO_File_open(TZNMLFILE,KRESP=IRESP)
-ILUNAM = TZNMLFILE%NLU
-IF (IRESP.NE.0 ) THEN
- WRITE(YMSG,*) 'file PRE_PGD1.nam not found, IRESP=', IRESP
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_PGD',YMSG)
-ENDIF
-!JUAN
-
-CALL POSNAM(ILUNAM,'NAM_PGDFILE',GFOUND)
-IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_PGDFILE)
-CALL POSNAM(ILUNAM,'NAM_ZSFILTER',GFOUND)
-IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_ZSFILTER)
-CALL POSNAM(ILUNAM,'NAM_SLEVE',GFOUND)
-IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_SLEVE)
-!JUANZ
-CALL POSNAM(ILUNAM,'NAM_CONFZ',GFOUND)
-IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CONFZ)
-CALL POSNAM(ILUNAM,'NAM_CONF_PGD',GFOUND)
-IF (GFOUND) THEN
- NHALO_MNH = NHALO_CONF_MNH
- READ(UNIT=ILUNAM,NML=NAM_CONF_PGD)
- NHALO_CONF_MNH = NHALO_MNH
-ENDIF
-!JUANZ
-CALL POSNAM(ILUNAM,'NAM_CONFIO',GFOUND)
-IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CONFIO)
-CALL IO_Config_set()
-!
-CALL IO_File_close(TZNMLFILE)
-!
-!
-CALL SURFEX_ALLOC_LIST(1)
-YSURF_CUR => YSURF_LIST(1)
-CALL READ_ALL_NAMELISTS(YSURF_CUR,'MESONH','PRE',.FALSE.)
-!
-CALL INI_FIELD_LIST()
-!
-CALL GOTO_MODEL(1)
-CALL GOTO_SURFEX(1)
-!
-CALL VERSION
-CSTORAGE_TYPE = 'PG'
-!
-CALL INI_CST
-!
-!
-!* 2. Preparation of surface physiographic fields
-! -------------------------------------------
-!
-!* Initializes the grid
-! --------------------
-!
-CALL PGD_GRID_SURF_ATM(YSURF_CUR%UG, YSURF_CUR%U,YSURF_CUR%GCP,'MESONH',&
- ' ',' ',.FALSE.,HDIR='-')
-!
-CALL EXTEND_GRID_ON_HALO('MESONH',YSURF_CUR%UG, YSURF_CUR%U,&
- YSURF_CUR%UG%G%NGRID_PAR, YSURF_CUR%UG%G%XGRID_PAR)
-!
-!
-!* Initializes all physiographic fields
-! ------------------------------------
-!
-CALL PGD_SURF_ATM(YSURF_CUR,'MESONH',' ',' ',.FALSE.)
-!
-!
-!* 3. Writes the physiographic fields
-! -------------------------------
-!
-CALL IO_File_add2list(TZFILE,CPGDFILE,'PGD','WRITE',KLFINPRAR=INT(1,KIND=LFIINT),KLFITYPE=1,KLFIVERB=5)
-!
-CALL IO_File_open(TZFILE)
-!
-CALL IO_Header_write(TZFILE)
-!
-CALL IO_Field_write(TZFILE,'SURF','EXTE')
-CALL IO_Field_write(TZFILE,'L1D', L1D)
-CALL IO_Field_write(TZFILE,'L2D', L2D)
-CALL IO_Field_write(TZFILE,'PACK',LPACK)
-IF ( NDXRATIO <= 0 .AND. NDYRATIO <= 0 ) THEN
- NDXRATIO = 1
- NDYRATIO = 1
-ENDIF
-IF ( NXSIZE < 0 .AND. NYSIZE < 0 ) THEN
- NXSIZE = 0
- NYSIZE = 0
-ENDIF
-IF ( NXOR <= 0 .AND. NYOR <= 0 ) THEN
- NXOR = 1
- NYOR = 1
-ENDIF
-CALL IO_Field_write(TZFILE,'DXRATIO',NDXRATIO)
-CALL IO_Field_write(TZFILE,'DYRATIO',NDYRATIO)
-CALL IO_Field_write(TZFILE,'XSIZE', NXSIZE)
-CALL IO_Field_write(TZFILE,'YSIZE', NYSIZE)
-CALL IO_Field_write(TZFILE,'XOR', NXOR)
-CALL IO_Field_write(TZFILE,'YOR', NYOR)
-CALL IO_Field_write(TZFILE,'JPHEXT', JPHEXT)
-!
-TFILE_SURFEX => TZFILE
-ALLOCATE(YSURF_CUR%DUO%CSELECT(0))
-CALL WRITE_PGD_SURF_ATM_n(YSURF_CUR,'MESONH')
-NULLIFY(TFILE_SURFEX) !Probably not necessary
-!
-!* 4. Computes and writes smooth orography for SLEVE coordinate
-! ---------------------------------------------------------
-CALL ZSMT_PGD(TZFILE,NZSFILTER,NSLEVE,NLOCZSFILTER,LHSLOP,XHSLOP,XSMOOTH_ZS)
-!
-IF (.NOT.LCARTESIAN) THEN
-!!!! WRITE LAT and LON
- CALL GET_DIM_PHYS_ll('B',IIMAX,IJMAX)
- ALLOCATE(ZWORK(IIMAX+NHALO*2,IJMAX+NHALO*2))
- ALLOCATE(ZWORK_LAT(IIMAX+2*JPHEXT,IJMAX+2*JPHEXT))
- ALLOCATE(ZWORK_LON(IIMAX+2*JPHEXT,IJMAX+2*JPHEXT))
- ZWORK=RESHAPE(YSURF_CUR%UG%G%XLAT, (/ (IIMAX+NHALO*2),(IJMAX+NHALO*2) /) )
- IF (NHALO/=0) THEN
- ZWORK_LAT=ZWORK(NHALO:(IIMAX+NHALO+1),NHALO:(IJMAX+NHALO+1))
- ELSE
- ZWORK_LAT(2:IIMAX+1,2:IJMAX+1)=ZWORK
- ZWORK_LAT(1,:) = ZWORK_LAT(2,:)
- ZWORK_LAT(IIMAX+2,:) = ZWORK_LAT(IIMAX+1,:)
- ZWORK_LAT(:,1) = ZWORK_LAT(:,2)
- ZWORK_LAT(:,IJMAX+2) = ZWORK_LAT(:,IJMAX+1)
- ENDIF
- ZWORK=RESHAPE(YSURF_CUR%UG%G%XLON, (/ IIMAX+NHALO*2,IJMAX+NHALO*2 /) )
- IF (NHALO/=0) THEN
- ZWORK_LON=ZWORK(NHALO:(IIMAX+NHALO+1),NHALO:(IJMAX+NHALO+1))
- ELSE
- ZWORK_LON(2:IIMAX+1,2:IJMAX+1)=ZWORK
- ZWORK_LON(1,:) = ZWORK_LON(2,:)
- ZWORK_LON(IIMAX+2,:) = ZWORK_LON(IIMAX+1,:)
- ZWORK_LON(:,1) = ZWORK_LON(:,2)
- ZWORK_LON(:,IJMAX+2) = ZWORK_LON(:,IJMAX+1)
- ENDIF
- CALL IO_Field_write(TZFILE,'LAT',ZWORK_LAT)
- CALL IO_Field_write(TZFILE,'LON',ZWORK_LON)
- !
- DEALLOCATE(ZWORK,ZWORK_LAT,ZWORK_LON)
-END IF
-!
-!
-WRITE(ILUOUT0,*)
-WRITE(ILUOUT0,*) '***************************'
-WRITE(ILUOUT0,*) '* PREP_PGD ends correctly *'
-WRITE(ILUOUT0,*) '***************************'
-!
-!* 6. Close parallelized I/O
-! ----------------------
-!
-CALL IO_File_close(TZFILE)
-!
-CALL FINALIZE_MNH()
-!
-!-------------------------------------------------------------------------------
-!
-END PROGRAM PREP_PGD
diff --git a/src/mesonh/ext/prep_real_case.f90 b/src/mesonh/ext/prep_real_case.f90
deleted file mode 100644
index f71ccb8c4fb2cbfc1a31ef32393e13b5a4e717fe..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/prep_real_case.f90
+++ /dev/null
@@ -1,1451 +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.
-!-----------------------------------------------------------------
-! ######################
- PROGRAM PREP_REAL_CASE
-! ######################
-!
-!!**** *PREP_REAL_CASE* - program to write an initial FM file from real case
-!! situation.
-!!
-!! PURPOSE
-!! -------
-!!
-!! The purpose of this program is to prepare an initial meso-NH file
-!! (LFIFM and DESFM files) filled by some fields of a real situation.
-!! General data are given by the MESO-NH user in the namelist file
-!! 'PRE_REAL1.nam'. The fields are obtained from three sources:
-!! - an atmospheric input file, which can be:
-!! * an Aladin file, itself obtained from an Arpege file with
-!! the Aladin routine "FULLPOS".
-!! * a grib file (ECMWF, Grib Arpege or Grib Aladin)
-!! * a MESONH file
-!! - an physiographic data file.
-!!
-!! 1) Fields obtained from the Atmospheric file:
-!! -----------------------------------------
-!!
-!! - the projection parameters (checked with PGD file):
-!! reference latitude and longitude
-!! parameter of projection
-!! angle of rotation of the domain
-!!
-!! - the horizontal grid definition (checked with PGD file):
-!! grid mesh
-!! latitude and longitude of the reference point
-!! (with data from PRE_REAL1.nam)
-!!
-!! - thermodynamical 3D and 2D fields:
-!! potential temperature
-!! vapor mixing ratio
-!!
-!! - dynamical fields:
-!! three components of the wind
-!!
-!! - reference anelastic state variables:
-!! profile of virtual potential temperature
-!! profile of dry density
-!! Exner function at model top
-!!
-!! - total dry air mass
-!!
-!!
-!! 2) Fields obtained from the physiographic data file:
-!! ------------------------------------------------
-!!
-!! - the projection parameters:
-!! reference latitude and longitude
-!! parameter of projection
-!! angle of rotation of the domain
-!!
-!! - the horizontal grid definition:
-!! grid mesh
-!! latitude and longitude of the reference point
-!! (with data from PRE_REAL1.nam)
-!! - physiografic fields: (orographic, vegetation, soil and radiation fields)
-!!
-!!
-!! 3) Data obtained from the namelist file PRE_REAL1.nam:
-!! --------------------------------------------------
-!!
-!! - type of equations system
-!! - vertical grid definition
-!! - number of points in x and y directions
-!! - level of verbosity
-!! - name of the different files
-!!
-!!
-!!** METHOD
-!! ------
-!! In this program, once the MESO-NH domain is calculated, all the
-!! 2D or 3D fields are computed on the MESO-NH horizontal domain WITH
-!! the external points. This is particularly important for the large
-!! scale fields during the MESO-NH run.
-!!
-!! 1) The following PREP_REAL_CASE program:
-!!
-!! - set default values for global variables which will be written in
-!! DESFM file (by calling DEFAULT_DESFM1); lateral boundary conditions
-!! are open.
-!!
-!! - opens the different files (by calling OPEN_PRC_FILES).
-!!
-!! - initializes physical constants (by calling INI_CST).
-!!
-!! - initializes the horizontal domain from the data read in the
-!! descriptive part of the Aladin file and the directives read in the
-!! namelist file (routines READ_GENERAL and SET_SUBDOMAIN in
-!! READ_ALL_DATA). This MESO-NH domain is a part of the Aladin domain.
-!!
-!! - initializes global variables from namelists and the MESO-NH
-!! vertical grid definition variables in the namelist file
-!! (routine READ_VER_GRID).
-!!
-!! - initializes the physiographic 2D fields from the physiographic data
-!! file, in particular the MESO-NH orography.
-!!
-!! - reads the 3D and 2D variable fields in the Grib file
-!! (routine READ_ALL_DATA_GRIB_CASE),
-!! if HATMFILETYPE='GRIBEX':
-!! absolute temperature
-!! specific humidity
-!! horizontal contravariant wind
-!! surface pressure
-!! large scale orography
-!!
-!! - reads the 3D and 2D variable fields in the input MESONH file
-!! (routine READ_ALL_DATA_MESONH_CASE), if HATMFILETYPE='MESONH':
-!! potential temperature
-!! vapor mixing ratio
-!! horizontal wind
-!! other mixing ratios
-!! turbulence prognostic and semi-prognostic variables
-!! large scale orography
-!!
-!! - computes some geometric variables (routines SM_GRIDPROJ and METRICS),
-!! in particular:
-!! * altitude 3D array
-!! * metric coefficients
-!! * jacobian
-!!
-!! - initializes MESO-NH thermodynamical fields:
-!! * changes of variables (routine VER_PREP_mmmmmm_CASE):
-!! absolute temperature --> virtual potential temperature
-!! specific humidity --> vapor mixing ratio
-!! * interpolates/extrapolates the fields from the large scale
-!! orography to the MESO-NH one (routine VER_INT_THERMO in
-!! VER_THERMO, by using a shifting function method).
-!! in water vapor case, the interpolations are always performed
-!! on relative humidity.
-!! * the pressure is computed on each grid by integration of the
-!! hydrostatic equation from bottom or top. When input atmospheric
-!! file is a MESO-NH one, information about the difference between
-!! hydrostatic pressure and total pressure is kept and interpolated
-!! during the entire PREP_REAL_CASE process.
-!! * interpolates the fields to the MESO-NH vertical grid
-!! (also by routine VER_INT_THERMO in VER_THERMO).
-!! * computes the potential temperature (routine VER_THERMO).
-!! * sets to zero the mixing ratios, except the vapor mixing ratio
-!! (VER_THERMO).
-!!
-!! - initializes the reference anelastic state variables (routine SET_REFZ
-!! in VER_THERMO).
-!!
-!! - computes the total dry air mass (routine DRY_MASS in VER_THERMO).
-!!
-!! - initializes MESO-NH dynamical variables:
-!! * changes Aladin contravariant wind into true horizontal wind
-!! (in subroutine VER_PREP).
-!! * interpolates/extrapolates the momentum from the large scale
-!! orography to the MESO-NH one (routine VER_INT_DYN in
-!! VER_DYN, by using a shifting function method).
-!! * interpolates the fields to the MESO-NH vertical grid
-!! (also by routine VER_INT_DYN in VER_DYN). The fields
-!! are located on a horizontal Arakawa A-grid, as the Aladin fields.
-!! * The momentum is interpolated to the Arakawa C-grid
-!! (routine VER_DYN).
-!! * A first guess of the vertical momentum, verifying the
-!! uncompressible continuity equation and the material lower boundary
-!! condition against the ground, is computed (routine WGUESS).
-!! * computes the final non-divergent wind field (routine
-!! ANEL_BALANCE).
-!!
-!! - copies the interpolated fields also at t-dt and in the large scale
-!! fields (routine INI_PROG_VAR).
-!!
-!! - writes the DESFM and LFIFM files (routines WRITE_DESFM1 and
-!! WRITE_LFIFM1).
-!!
-!!
-!! 2) Some conventions are used in this program and its subroutines because
-!! of the number of different grids and fields:
-!!
-!! - subscripts:
-!! * the subscripts I and J are used for all the horizontal grid.
-!! * the subcript K is used for the MESO-NH vertical grid (increasing
-!! from bottom to top).
-!! * the subscript L is used for the Aladin or input Mesonh grids
-!! (increasing from bottom to top).
-!!
-!! - suffixes:
-!! * _LS:
-!! If used for a geographic or horizontal grid definition variable,
-!! this variable is connected to the large horizontal domain.
-!! If used for a surface variable, this variable corresponds to
-!! the large scale orography, and therefore will be modified.
-!! If used for another variable, this variable is discretized
-!! on the Aladin or input MESONH file vertical grid
-!! (large-scale orography with input vertical discretization,
-!! either coming from eta levels or input Gal-Chen grid).
-!! * _MX:
-!! Such a variable is discretized on the mixed grid.
-!! (large-scale orography with output Gal-Chen vertical grid
-!! discretization)
-!! * _SH:
-!! Such a variable is discretized on the shifted grid.
-!! (fine orography with a shifted vertical grid, NOT Gal-Chen)
-!! * no suffix:
-!! The variable is discretized on the MESO-NH grid.
-!! (fine orography with output Gal-Chen vertical grid discretization)
-!!
-!! - additional pre-suffixes: (for pressure, Exner and altitude fields)
-!! * MASS:
-!! The variable is discretized on a mass point
-!! * FLUX:
-!! The variable is discretized on a flux point
-!!
-!!
-!! - names of variables: for a physical variable VAR:
-!! * pVARs is the variable itself.
-!! * pRHODVARs is the variable multiplied by the dry density rhod.
-!! * pRHODJVARs is the variable multiplied by the dry density rhod
-!! and the Jacobian.
-!! * pRVARs is the variable multiplied by rhod_ref, the anelastic
-!! reference state dry density and the Jacobian.
-!! where p and s are the appropriate prefix and suffix.
-!!
-!! - allocation of arrays: the arrays are allocated
-!! * just before their initialization for the general arrays stored in
-!! modules.
-!! * in the subroutine in which they are declared for the local arrays
-!! in a subroutine.
-!! * in the routine in which they are initialized for the arrays
-!! defined in the monitor PREP_REAL_CASE. In this case they are in
-!! fact passed as pointer to the subroutines to allow their
-!! dynamical allocation (exception which confirms the rule: ZJ).
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! Routine DEFAULT_DESFM1 : to set default values for variables which can be
-!! contained in DESFM file.
-!! Routine OPEN_PRC_FILES: to open all files.
-!! Routine INI_CST : to initialize physical constants.
-!! Routine READ_ALL_DATA_GRIB_CASE : to read all input data.
-!! Routine READ_ALL_DATA_MESONH_CASE : to read all input data.
-!! Routine SM_GRIDPROJ : to compute some grid variables, in case of
-!! conformal projection.
-!! Routine METRICS : to compute metric coefficients.
-!! Routine VER_PREP_GRIBEX_CASE : to prepare the interpolations.
-!! Routine VER_PREP_MESONH_CASE : to prepare the interpolations.
-!! Routine VER_THERMO : to perform the interpolation of thermodynamical
-!! variables.
-!! Routine VER_DYN : to perform the interpolation of dynamical
-!! variables.
-!! Routine INI_PROG_VAR : to initialize the prognostic varaibles not yet
-!! initialized
-!! Routine WRITE_DESFM1 : to write a DESFM file.
-!! Routine WRITE_LFIFM1 : to write a LFIFM file.
-!! Routine IO_File_close : to close a FM-file (DESFM + LFIFM).
-!!
-!! Module MODE_GRIDPROJ : contains conformal projection routines
-!!
-!! Module MODI_DEFAULT_DESFM1 : interface module for routine DEFAULT_DESFM1
-!! Module MODI_OPEN_PRC_FILES : interface module for routine OPEN_PRC_FILES
-!! Module MODI_READ_ALL_DATA_MESONH_CASE : interface module for routine
-!! READ_ALL_DATA_MESONH_CASE
-!! Module MODI_METRICS : interface module for routine METRICS
-!! Module MODI_VER_PREP_GRIBEX_CASE : interface module for routine
-!! VER_PREP_GRIBEX_CASE
-!! Module MODI_VER_PREP_MESONH_CASE : interface module for routine
-!! VER_PREP_MESONH_CASE
-!! Module MODI_VER_THERMO : interface module for routine VER_THERMO
-!! Module MODI_VER_DYN : interface module for routine VER_DYN
-!! Module MODI_INI_PROG_VAR : interface module for routine INI_PROG_VAR
-!! Module MODI_WRITE_DESFM1 : interface module for routine WRITE_DESFM1
-!! Module MODI_WRITE_LFIFM1 : interface module for routine WRITE_LFIFM1
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! Module MODD_CONF : contains configuration variables for all models.
-!! NVERB : verbosity level for output-listing
-!! Module MODD_CONF1 : contains configuration variables for model 1.
-!! NRR : number of moist variables
-!! Module MODD_LUNIT : contains logical unit and names of files.
-!! Module MODD_LUNIT : contains logical unit and names of files (model1).
-!! CINIFILE: name of the FM file which will be used for the MESO-NH run.
-!! Module MODD_GRID1 : contains grid variables.
-!! XLAT : latitude of the grid points
-!! XLON : longitudeof the grid points
-!! XXHAT : position xhat in the conformal plane
-!! XYHAT : position yhat in the conformal plane
-!! XDXHAT : horizontal local meshlength on the conformal plane
-!! XDYHAT : horizontal local meshlength on the conformal plane
-!! XZS : MESO-NH orography
-!! XZZ : altitude
-!! XZHAT : height zhat
-!! XMAP : map factor
-!! Module MODD_LBC1 : contains declaration of lateral boundary conditions
-!! CLBCX : X-direction LBC type at left(1) and right(2) boundaries
-!! CLBCY : Y-direction LBC type at left(1) and right(2) boundaries
-!! Module MODD_PARAM1 : contains declaration of the parameterizations' names
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book 2
-!!
-!! AUTHOR
-!! ------
-!!
-!! V.Masson Meteo-France
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/01/95
-!! Sept. 21, 1995 (J.Stein and V.Masson) surface pressure
-!! Jan. 09, 1996 (V. Masson) pressure function deduced from
-!! hydrostatic pressure
-!! Jan. 31, 1996 (V. Masson) possibility to initialize
-!! atmospheric fields from MESONH file
-!! Mar. 18, 1996 (V. Masson) new vertical extrapolation of Ts
-!! in case of initialization with MESONH file
-!! Apr 17, 1996 (J. Stein ) change the DEFAULT_DESFM CALL
-!! May 25, 1996 (V. Masson) Variable CSTORAGE_TYPE
-!! Aug 26, 1996 (V. Masson) Only thinshell approximation is
-!! currently available.
-!! Sept 24, 1996 (V. Masson) add writing of varaibles for
-!! nesting ('DAD_NAME', 'DXRATIO', 'DYRATIO')
-!! Oct 11, 1996 (V. Masson) L1D and L2D configurations
-!! Oct 28, 1996 (V. Masson) add deallocations and NVERB
-!! default set to 1
-!! Dec 02, 1996 (V. Masson) vertical interpolation of
-!! surface fields in aladin case
-!! Dec 12, 1996 (V. Masson) add LS vertical velocity
-!! Jan 16, 1997 (J. Stein) Durran's anelastic system
-!! May 07, 1997 (V. Masson) add LS tke
-!! Jun 27, 1997 (V. Masson) add absolute pressure
-!! Jul 09, 1997 (V. Masson) add namelist NAM_REAL_CONF
-!! Jul 10, 1997 (V. Masson) add LS epsilon
-!! Aug 25, 1997 (V. Masson) add computing time analysis
-!! Jan 20, 1998 (J. Stein) add LB and LS fields
-!! Apr, 30, 1998 (V. Masson) Large scale VEG and LAI
-!! Jun, 04, 1998 (V. Masson) Large scale D2 and Aladin ISBA
-!! files
-!! Jun, 04, 1998 (V. Masson) Add new soil interface var.
-!! Jan 20, 1999 (J. Stein) add a Boundaries call
-!! March 15 1999 (J. Pettre, V. Bousquet and V. Masson)
-!! initialization from GRIB files
-!! Jul 2000 (F.solmon/V.Masson) Adaptation for patch
-!! according to GRIB or MESONH case
-!! Nov 22, 2000 (P.Tulet, I. Mallet) initialization
-!! from GRIB MOCAGE file
-!! Fev 01, 2001 (D.Gazen) add module MODD_NSV for NSV variable
-!! Jul 02, 2001 (J.Stein) add LCARTESIAN case
-!! Oct 15, 2001 (I.Mallet) allow namelists in different orders
-!! Dec 2003 (V.Masson) removes surface calls
-!! Jun 01, 2002 (O.Nuissier) filtering of tropical cyclone
-!! Aou 09, 2005 (D.Barbary) add CDADATMFILE CDADBOGFILE
-!! May 2006 Remove KEPS
-!! Feb 02, 2012 (C. Mari) interpolation from MOZART
-!! add call to READ_CHEM_NETCDF_CASE &
-!! VER_PREP_NETCDF_CASE
-!! Mar 2012 Add NAM_NCOUT for netcdf output
-!! July 2013 (Bosseur & Filippi) Adds Forefire
-!! Mars 2014 (J.Escobar) Missing 'full' UPDATE_METRICS for arp2lfi // run
-!! April 2014 (G.TANGUY) Add LCOUPLING
-!! 2014 (M.Faivre)
-!! Fevr 2015 (M.Moge) Cleaning up
-!! Aug 2015 (M.Moge) removing EXTRAPOL on XDXX and XDYY in part 8
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! M.Leriche 2015 : add LUSECHEM dans NAM_CH_CONF
-!! Feb 02, 2012 (C. Mari & BV) interpolation from CAMS
-!! add call to READ_CAMS_NETCDF_CASE &
-!! VER_PREP_NETCDF_CASE
-!! Modification 01/2016 (JP Pinty) Add LIMA
-!! Modification 02/2016 (JP Pinty) Convert CAMS mix ratio to nbr conc
-!
-!! 06/2016 (G.Delautier) phasage surfex 8
-!! P.Wautelet : 08/07/2016 : removed MNH_NCWRIT define
-!! B.VIE 2016 : LIMA
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
-! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
-! S. Bielli 02/2019: sea salt: significant sea wave height influences salt emission; 5 salt modes
-! P. Wautelet 20/03/2019: missing use MODI_INIT_SALT
-! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
-! T.Nagel 02/2021: add IBM
-! P. Wautelet 06/07/2021: use FINALIZE_MNH
-!! M. Leriche 26/01/2022: add reading of CAMS reanalysis for chemistry
-!! and/or for LIMA
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_BUDGET, ONLY: TBUCONF_ASSOCIATE
-USE MODD_CH_M9_n
-USE MODD_CH_MNHC_n, ONLY: LUSECHAQ_n=>LUSECHAQ,LUSECHIC_n=>LUSECHIC, LUSECHEM_n=>LUSECHEM
-USE MODD_CONF
-USE MODD_CONF_n
-USE MODD_CST
-USE MODD_DIM_n
-!UPG*PT
-USE MODD_CH_AEROSOL
-USE MODD_DUST, ONLY: LDUST, NMODE_DST, CRGUNITD, XINISIG, XINIRADIUS, XN0MIN,&
- LDSTCAMS
-!UPG*PT
-
-USE MODD_DYN_n, CPRESOPT_n=>CPRESOPT, LRES_n=>LRES, XRES_n=>XRES , NITR_n=>NITR
-USE MODD_FIELD_n
-USE MODD_GR_FIELD_n
-USE MODD_GRID
-USE MODD_GRID_n
-USE MODD_HURR_CONF
-USE MODD_IBM_LSF, ONLY: CIBM_TYPE, LIBM_LSF, NIBM_SMOOTH, XIBM_SMOOTH
-USE MODD_IBM_PARAM_n, ONLY: XIBM_LS
-USE MODD_IO, ONLY: TFILEDATA, TFILE_SURFEX
-USE MODD_LBC_n
-USE MODD_LES, ONLY: LES_ASSOCIATE
-USE MODD_LSFIELD_n
-USE MODD_LUNIT, ONLY: TPGDFILE,TLUOUT0,TOUTDATAFILE
-USE MODD_LUNIT_n, ONLY: CINIFILE,TINIFILE,TLUOUT
-USE MODD_METRICS_n
-USE MODD_MNH_SURFEX_n
-USE MODD_NESTING
-USE MODD_NSV
-USE MODD_PARAMETERS
-USE MODD_PARAM_n
-USE MODD_PREP_REAL
-USE MODD_REF_n
-!UPG*PT
-USE MODD_SALT, ONLY: LSALT, NMODE_SLT, CRGUNITS, XINISIG_SLT, XINIRADIUS_SLT, XN0MIN_SLT,&
- LSLTCAMS
-USE MODD_CH_AERO_n, ONLY: XM3D, XRHOP3D, XSIG3D, XRG3D, XN3D, XCTOTA3D
-!UPG*PT
-USE MODD_TURB_n
-!
-USE MODE_EXTRAPOL
-use mode_field, only: Alloc_field_scalars, Ini_field_list, Ini_field_scalars
-USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
-USE MODE_GRIDCART
-USE MODE_GRIDPROJ
-USE MODE_IO, only: IO_Init
-USE MODE_IO_FIELD_READ, only: IO_Field_read
-USE MODE_IO_FIELD_WRITE, only: IO_Header_write
-USE MODE_IO_FILE, only: IO_File_close, IO_File_open
-USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list, IO_File_find_byname
-USE MODE_ll
-USE MODE_MODELN_HANDLER
-USE MODE_MPPDB
-USE MODE_MSG
-USE MODE_POS
-USE MODE_SPLITTINGZ_ll
-!
-USE MODI_BOUNDARIES
-USE MODI_COMPARE_DAD
-USE MODI_DEALLOCATE_MODEL1
-USE MODI_DEALLOC_PARA_LL
-USE MODI_DEFAULT_DESFM_n
-USE MODI_ERROR_ON_TEMPERATURE
-USE MODI_IBM_INIT_LS
-USE MODI_INI_PROG_VAR
-USE MODI_INIT_SALT
-USE MODI_LIMA_MIXRAT_TO_NCONC
-USE MODI_METRICS
-USE MODI_MNHREAD_ZS_DUMMY_n
-USE MODI_MNHWRITE_ZS_DUMMY_n
-USE MODI_OPEN_PRC_FILES
-USE MODI_PREP_SURF_MNH
-USE MODI_PRESSURE_IN_PREP
-USE MODI_READ_ALL_DATA_GRIB_CASE
-USE MODI_READ_ALL_DATA_MESONH_CASE
-USE MODI_READ_ALL_NAMELISTS
-!UPG*PT
-!USE MODI_READ_CAMS_DATA_NETCDF_CASE
-!USE MODI_READ_CHEM_DATA_NETCDF_CASE
-USE MODI_READ_CHEM_DATA_MOZART_CASE
-USE MODI_READ_CHEM_DATA_CAMS_CASE
-USE MODI_READ_LIMA_DATA_NETCDF_CASE
-USE MODI_AER2LIMA
-USE MODI_CH_AER_EQM_INIT_n
-!UPG*PT
-USE MODI_READ_VER_GRID
-USE MODI_SECOND_MNH
-USE MODI_SET_REF
-USE MODI_UPDATE_METRICS
-USE MODI_VER_DYN
-USE MODI_VER_PREP_GRIBEX_CASE
-USE MODI_VER_PREP_MESONH_CASE
-USE MODI_VER_PREP_NETCDF_CASE
-USE MODI_VERSION
-USE MODI_VER_THERMO
-USE MODI_WRITE_DESFM_n
-USE MODI_WRITE_LFIFM_n
-!
-USE MODN_CONF, ONLY: JPHEXT , NHALO
-USE MODN_CONFZ
-USE MODD_PARAM_LIMA, ONLY: PARAM_LIMA_INIT, NMOD_CCN, NMOD_IFN
-USE MODE_INI_CST, ONLY: INI_CST
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of local variables
-! ------------------------------
-!
-CHARACTER(LEN=28) :: YATMFILE ! name of the Atmospheric file
-CHARACTER(LEN=6) :: YATMFILETYPE! type of the Atmospheric file
-CHARACTER(LEN=28) :: YCHEMFILE ! name of the Chemical file
-CHARACTER(LEN=6) :: YCHEMFILETYPE! type of the Chemical file
-!UP*PT
-!CHARACTER(LEN=28) :: YCAMSFILE ! name of the input CAMS file
-!CHARACTER(LEN=6) :: YCAMSFILETYPE! type of the input CAMS file
-CHARACTER(LEN=28) :: YLIMAFILE ! name of the input MACC file
-CHARACTER(LEN=6) :: YLIMAFILETYPE! type of the input MACC file
-!UP*PT
-CHARACTER(LEN=28) :: YSURFFILE ! name of the Surface file
-CHARACTER(LEN=6) :: YSURFFILETYPE! type of the Surface file
-CHARACTER(LEN=28) :: YPGDFILE ! name of the physiographic data
-! ! file
-!
-CHARACTER(LEN=28) :: YDAD_NAME ! true name of the atmospheric file
-!
-!* other variables
-!
-REAL,DIMENSION(:,:,:), ALLOCATABLE:: ZJ ! Jacobian
-!
-!* file management variables and counters
-!
-INTEGER :: ILUOUT0 ! logical unit for listing file
-INTEGER :: IPRE_REAL1 ! logical unit for namelist file
-INTEGER :: IRESP ! return code in FM routines
-LOGICAL :: GFOUND ! Return code when searching namelist
-INTEGER :: NIU,NJU,NKU ! Upper bounds in x,y,z directions
-!
-REAL :: ZSTART, ZEND, ZTIME1, ZTIME2, ZTOT, ZALL ! for computing time analysis
-REAL :: ZMISC, ZREAD, ZHORI, ZPREP, ZSURF, ZTHERMO, ZDYN, ZDIAG, ZWRITE
-REAL :: ZDG ! diagnostics time in routines
-INTEGER :: IINFO_ll ! return code of // routines
-! Namelist model variables
-CHARACTER(LEN=5) :: CPRESOPT
-INTEGER :: NITR
-LOGICAL :: LRES
-REAL :: XRES
-LOGICAL :: LSHIFT ! flag to perform vertical shift or not.
-LOGICAL :: LDUMMY_REAL ! flag to read and interpolate
- !dummy fields from GRIBex file
-INTEGER :: JRR ! loop counter for moist var.
-LOGICAL :: LUSECHAQ
-LOGICAL :: LUSECHIC
-LOGICAL :: LUSECHEM
-INTEGER :: JN
-!
-TYPE(TFILEDATA),POINTER :: TZATMFILE => NULL()
-TYPE(TFILEDATA),POINTER :: TZPRE_REAL1FILE => NULL()
-!
-!
-!* 0.3 Declaration of namelists
-! ------------------------
-!
-NAMELIST/NAM_REAL_CONF/ NVERB, CEQNSYS, CPRESOPT, LSHIFT, LDUMMY_REAL, &
- LRES, XRES, NITR,LCOUPLING, NHALO , JPHEXT
-! Filtering and balancing of the large-scale and radar tropical cyclone
-NAMELIST/NAM_HURR_CONF/ LFILTERING, CFILTERING, &
-XLAMBDA, NK, XLATGUESS, XLONGUESS, XBOXWIND, XRADGUESS, NPHIL, NDIAG_FILT, &
-NLEVELR0,LBOGUSSING, &
-XLATBOG, XLONBOG, XVTMAXSURF, XRADWINDSURF, &
-XMAX, XC, XRHO_Z, XRHO_ZZ, XB_0, XBETA_Z, XBETA_ZZ,&
-XANGCONV0, XANGCONV1000, XANGCONV2000, &
- CDADATMFILE, CDADBOGFILE
- NAMELIST/NAM_AERO_CONF/ LORILAM, LINITPM, LDUST, XINIRADIUSI, XINIRADIUSJ,&
- XINISIGI, XINISIGJ, XN0IMIN, XN0JMIN, CRGUNIT, CRGUNITD,&
- LSALT, CRGUNITS, NMODE_DST, XINISIG, XINIRADIUS, XN0MIN,&
- XINISIG_SLT, XINIRADIUS_SLT, XN0MIN_SLT, NMODE_SLT, &
- LDSTCAMS, LSLTCAMS,CACTCCN,CCLOUD, NMOD_IFN, NMOD_CCN, LAERINIT
-
-NAMELIST/NAM_CH_CONF/ LUSECHAQ,LUSECHIC,LUSECHEM
-!
-NAMELIST/NAM_IBM_LSF/ LIBM_LSF, CIBM_TYPE, NIBM_SMOOTH, XIBM_SMOOTH
-!
-! name of dad of input FM file
-INTEGER :: II, IJ, IGRID, ILENGTH
-CHARACTER (LEN=100) :: HCOMMENT
-TYPE(LIST_ll), POINTER :: TZFIELDS_ll=>NULL() ! list of fields to exchange
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBXRHO, ZLBYRHO
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBXZZ, ZLBYZZ
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBXPABST, ZLBYPABST
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBXRM, ZLBYRM
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBXTHM, ZLBYTHM
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZLBXSVM, ZLBYSVM
-!
-INTEGER :: ILBX,ILBY,IIB,IJB,IIE,IJE
-LOGICAL :: GAERINIT
-!-------------------------------------------------------------------------------
-!
-CALL MPPDB_INIT()
-!
-CALL GOTO_MODEL(1,ONOFIELDLIST=.TRUE.)
-!
-ZDIAG = 0.
-CALL SECOND_MNH (ZSTART)
-!
-ZHORI = 0.
-ZSURF = 0.
-ZTIME1 = ZSTART
-!
-!* 1. SET DEFAULT VALUES
-! ------------------
-!
-CALL VERSION
-CPROGRAM='REAL '
-!
-CALL ALLOC_FIELD_SCALARS()
-CALL TBUCONF_ASSOCIATE()
-CALL LES_ASSOCIATE()
-CALL DEFAULT_DESFM_n(1)
-NRR=1
-IDX_RVT = 1
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. OPENNING OF THE FILES
-! ---------------------
-CALL IO_Init()
-!
-CALL OPEN_PRC_FILES(TZPRE_REAL1FILE,YATMFILE, YATMFILETYPE,TZATMFILE &
- ,YCHEMFILE,YCHEMFILETYPE &
- ,YSURFFILE,YSURFFILETYPE &
- ,YPGDFILE,TPGDFILE &
-!UPG*PT
-! ,YCAMSFILE,YCAMSFILETYPE)
- ,YLIMAFILE,YLIMAFILETYPE)
-!UPG*PT
-ILUOUT0 = TLUOUT0%NLU
-TLUOUT => TLUOUT0
-!
-IF (YATMFILETYPE=='MESONH') THEN
- LSHIFT = .FALSE.
-ELSE IF (YATMFILETYPE=='GRIBEX') THEN
- LSHIFT = .TRUE.
-ELSE
- LSHIFT = .TRUE.
- WRITE(ILUOUT0,FMT=*) 'HATMFILETYPE WAS SET TO: '//TRIM(YATMFILETYPE)
- WRITE(ILUOUT0,FMT=*) 'ONLY TWO VALUES POSSIBLE FOR HATMFILETYPE:'
- WRITE(ILUOUT0,FMT=*) 'EITHER MESONH OR GRIBEX'
- WRITE(ILUOUT0,FMT=*) '-> JOB ABORTED'
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_REAL_CASE','')
-END IF
-!
-LCPL_AROME=.FALSE.
-LCOUPLING=.FALSE.
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. INITIALIZATION OF PHYSICAL CONSTANTS
-! ------------------------------------
-!
-CALL INI_CST
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. READING OF NAMELIST
-! -------------------
-!
-!* 4.1 reading of configuration variables
-!
-IPRE_REAL1 = TZPRE_REAL1FILE%NLU
-!
-CALL INIT_NMLVAR
-CALL POSNAM(IPRE_REAL1,'NAM_REAL_CONF',GFOUND,ILUOUT0)
-IF (GFOUND) READ(IPRE_REAL1,NAM_REAL_CONF)
-CALL PARAM_LIMA_INIT(CPROGRAM, IPRE_REAL1, .FALSE., ILUOUT0, .FALSE., .TRUE., .FALSE., 0)
-!
-CALL INI_FIELD_LIST()
-!
-CALL INI_FIELD_SCALARS()
-!
-!* 4.2 reading of values of some configuration variables in namelist
-!
-!
-!JUAN REALZ from prep_surfex
-!
-IF (YATMFILETYPE == 'GRIBEX') THEN
-!
-!* 4.1 Vertical Spatial grid
-!
-CALL INIT_NMLVAR()
-CALL READ_VER_GRID(TZPRE_REAL1FILE)
-!
-CALL IO_Field_read(TPGDFILE,'IMAX',NIMAX)
-CALL IO_Field_read(TPGDFILE,'JMAX',NJMAX)
-!
-NIMAX_ll=NIMAX !! _ll variables are global variables
-NJMAX_ll=NJMAX !! but the old names are kept in PRE_IDEA1.nam file
-!
-CALL SET_JP_ll(JPMODELMAX,JPHEXT,JPVEXT,JPHEXT)
-CALL SET_DAD0_ll()
-!JUAN 4/04/2014 correction for PREP_REAL_CASE on Gribex files
-!CALL SET_DIM_ll(NIMAX_ll, NJMAX_ll, 128)
-CALL SET_DIM_ll(NIMAX_ll, NJMAX_ll, NKMAX)
-CALL SET_LBX_ll('OPEN',1)
-CALL SET_LBY_ll('OPEN', 1)
-CALL SET_XRATIO_ll(1, 1)
-CALL SET_YRATIO_ll(1, 1)
-CALL SET_XOR_ll(1, 1)
-CALL SET_XEND_ll(NIMAX_ll+2*JPHEXT, 1)
-CALL SET_YOR_ll(1, 1)
-CALL SET_YEND_ll(NJMAX_ll+2*JPHEXT, 1)
-CALL SET_DAD_ll(0, 1)
-!JUANZ
-!CALL INI_PARA_ll(IINFO_ll)
-CALL INI_PARAZ_ll(IINFO_ll)
-!JUANZ
-
-!
-! sizes of arrays of the extended sub-domain
-!
-CALL GET_DIM_PHYS_ll('B',NIMAX,NJMAX)
-!!$CALL GET_DIM_EXT_ll('B',NIU,NJU)
-!!$CALL GET_INDICE_ll(NIB,NJB,NIE,NJE)
-!!$CALL GET_OR_ll('B',IXOR,IYOR)
-ENDIF
-!JUAN REALZ
-!
-LDUMMY_REAL= .FALSE.
-LFILTERING= .FALSE.
-CFILTERING= 'UVT '
-XLATGUESS= XUNDEF ; XLONGUESS= XUNDEF ; XBOXWIND=XUNDEF; XRADGUESS= XUNDEF
-NK=50 ; XLAMBDA=0.2 ; NPHIL=24
-NLEVELR0=15
-NDIAG_FILT=-1
-LBOGUSSING= .FALSE.
-XLATBOG= XUNDEF ; XLONBOG= XUNDEF
-XVTMAXSURF= XUNDEF ; XRADWINDSURF= XUNDEF
-XMAX=16000. ; XC=0.7 ; XRHO_Z=-0.3 ; XRHO_ZZ=0.9
-XB_0=1.65 ; XBETA_Z=-0.5 ; XBETA_ZZ=0.35
-XANGCONV0=0. ; XANGCONV1000=0. ; XANGCONV2000=0.
-CDADATMFILE=' ' ; CDADBOGFILE=' '
-!
-CALL INIT_NMLVAR
-CALL POSNAM(IPRE_REAL1,'NAM_REAL_CONF',GFOUND,ILUOUT0)
-IF (GFOUND) READ(IPRE_REAL1,NAM_REAL_CONF)
-CALL POSNAM(IPRE_REAL1,'NAM_HURR_CONF',GFOUND,ILUOUT0)
-IF (GFOUND) READ(IPRE_REAL1,NAM_HURR_CONF)
-CALL POSNAM(IPRE_REAL1,'NAM_CH_CONF',GFOUND,ILUOUT0)
-IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_CH_CONF)
-CALL UPDATE_MODD_FROM_NMLVAR
-CALL POSNAM(IPRE_REAL1,'NAM_AERO_CONF',GFOUND,ILUOUT0)
-IF (GFOUND) READ(IPRE_REAL1,NAM_AERO_CONF)
-CALL POSNAM(IPRE_REAL1,'NAM_CONFZ',GFOUND,ILUOUT0)
-IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_CONFZ)
-CALL POSNAM(IPRE_REAL1,'NAM_IBM_LSF' ,GFOUND,ILUOUT0)
-IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_IBM_LSF)
-!
-GAERINIT = LAERINIT
-
-! Sea salt
-CALL INIT_SALT
-!
-!* 4.3 set soil scheme to ISBA for initialization from GRIB
-!
-IF (YATMFILETYPE=='GRIBEX') THEN
- CLBCX(:) ='OPEN'
- CLBCY(:) ='OPEN'
-END IF
-!
-CALL SECOND_MNH(ZTIME2)
-ZMISC = ZTIME2 - ZTIME1
-!-------------------------------------------------------------------------------
-!
-!* 5. READING OF THE INPUT DATA
-! -------------------------
-!
-ZTIME1 = ZTIME2
-!
-IF (YATMFILETYPE=='MESONH') THEN
- CALL READ_ALL_DATA_MESONH_CASE(TZPRE_REAL1FILE,YATMFILE,TPGDFILE,YDAD_NAME)
-ELSE IF (YATMFILETYPE=='GRIBEX') THEN
- IF(LEN_TRIM(YCHEMFILE)>0 .AND. YCHEMFILETYPE=='GRIBEX')THEN
- CALL READ_ALL_DATA_GRIB_CASE('ATM1',TZPRE_REAL1FILE,YATMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL)
- ELSE
- CALL READ_ALL_DATA_GRIB_CASE('ATM0',TZPRE_REAL1FILE,YATMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL)
- END IF
-!
- YDAD_NAME=' '
-END IF
-LAERINIT = GAERINIT
-!
-IF (NIMAX==1 .AND. NJMAX==1) THEN
- L1D=.TRUE.
- L2D=.FALSE.
-ELSE IF (NJMAX==1) THEN
- L1D=.FALSE.
- L2D=.TRUE.
-ELSE
- L1D=.FALSE.
- L2D=.FALSE.
-END IF
-!
-! UPG*PT
-!* 5.1 reading of the input chemical data
-!
-!IF(LEN_TRIM(YCHEMFILE)>0)THEN
-! ! read again Nam_aero_conf
-! CALL POSNAM(IPRE_REAL1,'NAM_AERO_CONF',GFOUND,ILUOUT0)
-! IF (GFOUND) READ(IPRE_REAL1,NAM_AERO_CONF)
-! IF(YCHEMFILETYPE=='GRIBEX') &
-! CALL READ_ALL_DATA_GRIB_CASE('CHEM',TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL)
-! IF (YCHEMFILETYPE=='NETCDF') &
-! CALL READ_CHEM_DATA_NETCDF_CASE(TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL)
-!END IF
-!
-!* 5.2 reading the input CAMS data
-!
-!IF(LEN_TRIM(YCAMSFILE)>0)THEN
-! IF(YCAMSFILETYPE=='NETCDF') THEN
-! CALL READ_CAMS_DATA_NETCDF_CASE(TZPRE_REAL1FILE,YCAMSFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL)
-! ELSE
-! CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_REAL_CASE','CANNOT READ CAMS GRIB FILES YET')
-! END IF
-!END IF
-!* 5.1 reading CAMS or MACC files for init LIMA
-!
-IF(LEN_TRIM(YLIMAFILE)>0)THEN
- IF(YLIMAFILETYPE=='NETCDF') THEN
- CALL READ_LIMA_DATA_NETCDF_CASE(TZPRE_REAL1FILE,YLIMAFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL)
- ELSE
- WRITE(ILUOUT0,FMT=*)
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_REAL_CASE','Pb in MACC/CAMS file')
- STOP
- END IF
-END IF
-!
-!* 5.2 reading of the input chemical data + dusts + salts if needed
-!
-IF(LEN_TRIM(YCHEMFILE)>0)THEN
- ! read again Nam_aero_conf
- CALL POSNAM(IPRE_REAL1,'NAM_AERO_CONF',GFOUND,ILUOUT0)
- IF (GFOUND) READ(IPRE_REAL1,NAM_AERO_CONF)
- IF(YCHEMFILETYPE=='GRIBEX') &
- CALL READ_ALL_DATA_GRIB_CASE('CHEM',TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL)
- IF (YCHEMFILETYPE=='MOZART') &
- CALL READ_CHEM_DATA_MOZART_CASE(TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL)
- IF (YCHEMFILETYPE=='CAMSEU') &
- CALL READ_CHEM_DATA_CAMS_CASE(TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB, &
- LDUMMY_REAL,LUSECHEM)
-END IF
-
-!UPG*PT
-!
-CALL IO_File_close(TZPRE_REAL1FILE)
-!
-CALL SECOND_MNH(ZTIME2)
-ZREAD = ZTIME2 - ZTIME1 - ZHORI
-!-------------------------------------------------------------------------------
-!
-CALL IO_File_add2list(TINIFILE,CINIFILE,'MNH','WRITE',KLFITYPE=1,KLFIVERB=NVERB)
-CALL IO_File_open(TINIFILE)
-!
-ZTIME1=ZTIME2
-!
-!* 6. CONFIGURATION VARIABLES
-! -----------------------
-!
-!* 6.1 imposed values of some other configuration variables
-!
-CDCONV='NONE'
-CSCONV='NONE'
-CRAD='NONE'
-CCONF='START'
-NRIMX=6
-NRIMY=6
-LHORELAX_UVWTH=.TRUE.
-LHORELAX_RV=LUSERV
-LHORELAX_RC=LUSERC
-LHORELAX_RR=LUSERR
-LHORELAX_RI=LUSERI
-LHORELAX_RS=LUSERS
-LHORELAX_RG=LUSERG
-LHORELAX_RH=LUSERH
-LHORELAX_SV(:)=.FALSE.
-LHORELAX_SVC2R2 = (NSV_C2R2 > 0)
-LHORELAX_SVC1R3 = (NSV_C1R3 > 0)
-LHORELAX_SVLIMA = (NSV_LIMA > 0)
-LHORELAX_SVELEC = (NSV_ELEC > 0)
-LHORELAX_SVCHEM = (NSV_CHEM > 0)
-LHORELAX_SVCHIC = (NSV_CHIC > 0)
-LHORELAX_SVDST = (NSV_DST > 0)
-LHORELAX_SVSLT = (NSV_SLT > 0)
-LHORELAX_SVAER = (NSV_AER > 0)
-LHORELAX_SVPP = (NSV_PP > 0)
-#ifdef MNH_FOREFIRE
-LHORELAX_SVFF = (NSV_FF > 0)
-#endif
-LHORELAX_SVCS = (NSV_CS > 0)
-
-LHORELAX_SVLG = .FALSE.
-LHORELAX_SV(1:NSV)=.TRUE.
-IF ( CTURB /= 'NONE') THEN
- LHORELAX_TKE = .TRUE.
-ELSE
- LHORELAX_TKE = .FALSE.
-END IF
-!
-!
-CSTORAGE_TYPE='TT'
-!-------------------------------------------------------------------------------
-!
-!* 8. COMPUTATION OF GEOMETRIC VARIABLES
-! ----------------------------------
-!
-ZTIME1 = ZTIME2
-!
-ALLOCATE(XMAP(SIZE(XXHAT),SIZE(XYHAT)))
-ALLOCATE(XLAT(SIZE(XXHAT),SIZE(XYHAT)))
-ALLOCATE(XLON(SIZE(XXHAT),SIZE(XYHAT)))
-ALLOCATE(XDXHAT(SIZE(XXHAT)))
-ALLOCATE(XDYHAT(SIZE(XYHAT)))
-ALLOCATE(XZZ(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)))
-ALLOCATE(ZJ(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)))
-!
-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
-!
-CALL MPPDB_CHECK2D(XZS,"prep_real_case8:XZS",PRECISION)
-CALL MPPDB_CHECK2D(XMAP,"prep_real_case8:XMAP",PRECISION)
-CALL MPPDB_CHECK2D(XLAT,"prep_real_case8:XLAT",PRECISION)
-CALL MPPDB_CHECK2D(XLON,"prep_real_case8:XLON",PRECISION)
-CALL MPPDB_CHECK3D(XZZ,"prep_real_case8:XZZ",PRECISION)
-CALL MPPDB_CHECK3D(ZJ,"prep_real_case8:ZJ",PRECISION)
-!
-ALLOCATE(XDXX(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)))
-ALLOCATE(XDYY(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)))
-ALLOCATE(XDZX(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)))
-ALLOCATE(XDZY(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)))
-ALLOCATE(XDZZ(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)))
-!
-!20131024 add update halo
-!=> corrects on PDXX calculation in metrics and XDXX !!
-CALL ADD3DFIELD_ll( TZFIELDS_ll, XZZ, 'PREP_REAL_CASE::XZZ' )
-CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
-CALL CLEANLIST_ll(TZFIELDS_ll)
-!
-CALL METRICS(XMAP,XDXHAT,XDYHAT,XZZ,XDXX,XDYY,XDZX,XDZY,XDZZ)
-!
-CALL MPPDB_CHECK3D(XDXX,"prc8-beforeupdate_metrics:PDXX",PRECISION)
-CALL MPPDB_CHECK3D(XDYY,"prc8-beforeupdate_metrics:PDYY",PRECISION)
-CALL MPPDB_CHECK3D(XDZX,"prc8-beforeupdate_metrics:PDZX",PRECISION)
-CALL MPPDB_CHECK3D(XDZY,"prc8-beforeupdate_metrics:PDZY",PRECISION)
-!
-CALL UPDATE_METRICS(CLBCX,CLBCY,XDXX,XDYY,XDZX,XDZY,XDZZ)
-!
-!20131112 add update_halo for XDYY and XDZY!!
-CALL ADD3DFIELD_ll( TZFIELDS_ll, XDXX, 'PREP_REAL_CASE::XDXX' )
-CALL ADD3DFIELD_ll( TZFIELDS_ll, XDZX, 'PREP_REAL_CASE::XDZX' )
-CALL ADD3DFIELD_ll( TZFIELDS_ll, XDYY, 'PREP_REAL_CASE::XDYY' )
-CALL ADD3DFIELD_ll( TZFIELDS_ll, XDZY, 'PREP_REAL_CASE::XDZY' )
-CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
-CALL CLEANLIST_ll(TZFIELDS_ll)
-
-!CALL EXTRAPOL('W',XDXX,XDZX)
-!CALL EXTRAPOL('S',XDYY,XDZY)
-
-CALL SECOND_MNH(ZTIME2)
-
-ZMISC = ZMISC + ZTIME2 - ZTIME1
-!-------------------------------------------------------------------------------
-!
-!* 9. PREPARATION OF THE VERTICAL SHIFT AND INTERPOLATION
-! ---------------------------------------------------
-!
-ZTIME1 = ZTIME2
-!
-IF (YATMFILETYPE=='GRIBEX') THEN
- CALL VER_PREP_GRIBEX_CASE('ATM ',ZDG)
-ELSE IF (YATMFILETYPE=='MESONH') THEN
- CALL VER_PREP_MESONH_CASE(ZDG)
-END IF
-!
-IF (LEN_TRIM(YCHEMFILE)>0 .AND. YCHEMFILETYPE=='GRIBEX') THEN
- CALL VER_PREP_GRIBEX_CASE('CHEM',ZDG)
-END IF
-!UPG*PT
-!IF ((LEN_TRIM(YCHEMFILE)>0 .AND. YCHEMFILETYPE=='NETCDF') .OR. &
-! (LEN_TRIM(YCAMSFILE)>0 .AND. YCAMSFILETYPE=='NETCDF')) THEN
-! CALL VER_PREP_NETCDF_CASE(ZDG)
-!END IF
-IF (LEN_TRIM(YCHEMFILE)>0 .AND. ((YCHEMFILETYPE=='MOZART').OR. &
- (YCHEMFILETYPE=='CAMSEU'))) THEN
- CALL VER_PREP_NETCDF_CASE(ZDG,XSV_LS)
-
- DEALLOCATE(XSV_LS)
-END IF
-!
-IF (LEN_TRIM(YLIMAFILE)>0 .AND. YLIMAFILETYPE=='NETCDF') THEN
- CALL VER_PREP_NETCDF_CASE(ZDG,XSV_LS_LIMA)
- DEALLOCATE(XSV_LS_LIMA)
-END IF
-!UPG*PT
-!
-CALL SECOND_MNH(ZTIME2)
-ZPREP = ZTIME2 - ZTIME1 - ZDG
-ZDIAG = ZDIAG + ZDG
-!-------------------------------------------------------------------------------
-!
-!* 10. VERTICAL INTERPOLATION OF ALL THERMODYNAMICAL VARIABLES
-! -------------------------------------------------------
-!
-ZTIME1 = ZTIME2
-!
-ALLOCATE(XPSURF(SIZE(XXHAT),SIZE(XYHAT)))
-!
-CALL EXTRAPOL('E',XEXNTOP2D)
-IF (YATMFILETYPE=='GRIBEX') THEN
- CALL VER_THERMO(TINIFILE,LSHIFT,XTHV_MX,XR_MX,XZS_LS,XZSMT_LS,XZMASS_MX,XZFLUX_MX,XPMHP_MX,ZJ, &
- XDXX,XDYY,XEXNTOP2D,XPSURF,ZDG )
-ELSE IF (YATMFILETYPE=='MESONH') THEN
- CALL VER_THERMO(TINIFILE,LSHIFT,XTHV_MX,XR_MX,XZS_LS,XZSMT_LS,XZMASS_MX,XZFLUX_MX,XPMHP_MX,ZJ, &
- XDXX,XDYY,XEXNTOP2D,XPSURF,ZDG, &
- XLSTH_MX,XLSRV_MX )
-END IF
-!
-CALL SECOND_MNH(ZTIME2)
-ZTHERMO = ZTIME2 - ZTIME1 - ZDG
-ZDIAG = ZDIAG + ZDG
-!-------------------------------------------------------------------------------
-!
-!* 12. VERTICAL INTERPOLATION OF DYNAMICAL VARIABLES
-! ---------------------------------------------
-!
-ZTIME1 = ZTIME2
-IF (YATMFILETYPE=='GRIBEX') THEN
- CALL VER_DYN(LSHIFT,XU_MX,XV_MX,XW_MX,XRHOD_MX,XZFLUX_MX,XZMASS_MX,XZS_LS, &
- XDXX,XDYY,XDZZ,XDZX,XDZY,ZJ,YATMFILETYPE )
-ELSE IF (YATMFILETYPE=='MESONH') THEN
- CALL VER_DYN(LSHIFT,XU_MX,XV_MX,XW_MX,XRHOD_MX,XZFLUX_MX,XZMASS_MX,XZS_LS, &
- XDXX,XDYY,XDZZ,XDZX,XDZY,ZJ,YATMFILETYPE, &
- XLSU_MX,XLSV_MX,XLSW_MX )
-END IF
-!
-!
-IF (ALLOCATED(XTHV_MX)) DEALLOCATE(XTHV_MX)
-IF (ALLOCATED(XR_MX)) DEALLOCATE(XR_MX)
-IF (ALLOCATED(XPMHP_MX)) DEALLOCATE(XPMHP_MX)
-IF (ALLOCATED(XU_MX)) DEALLOCATE(XU_MX)
-IF (ALLOCATED(XV_MX)) DEALLOCATE(XV_MX)
-IF (ALLOCATED(XW_MX)) DEALLOCATE(XW_MX)
-IF (ALLOCATED(XLSTH_MX)) DEALLOCATE(XLSTH_MX)
-IF (ALLOCATED(XLSRV_MX)) DEALLOCATE(XLSRV_MX)
-IF (ALLOCATED(XLSU_MX)) DEALLOCATE(XLSU_MX)
-IF (ALLOCATED(XLSV_MX)) DEALLOCATE(XLSV_MX)
-IF (ALLOCATED(XLSW_MX)) DEALLOCATE(XLSW_MX)
-IF (ALLOCATED(XZFLUX_MX)) DEALLOCATE(XZFLUX_MX)
-IF (ALLOCATED(XZMASS_MX)) DEALLOCATE(XZMASS_MX)
-IF (ALLOCATED(XRHOD_MX)) DEALLOCATE(XRHOD_MX)
-IF (ALLOCATED(XEXNTOP2D)) DEALLOCATE(XEXNTOP2D)
-IF (ALLOCATED(XZS_LS)) DEALLOCATE(XZS_LS)
-IF (ALLOCATED(XZSMT_LS)) DEALLOCATE(XZSMT_LS)
-!
-!-------------------------------------------------------------------------------
-!
-!* 13. ANELASTIC CORRECTION
-! --------------------
-!
-CALL PRESSURE_IN_PREP(XDXX,XDYY,XDZX,XDZY,XDZZ)
-!
-CALL SECOND_MNH(ZTIME2)
-ZDYN = ZTIME2 - ZTIME1
-!
-!-------------------------------------------------------------------------------
-!
-!* 14. INITIALIZATION OF THE REMAINING PROGNOSTIC VARIABLES (COPIES)
-! -------------------------------------------------------------
-!
-ZTIME1 = ZTIME2
-!
-IF(LEN_TRIM(YCHEMFILE)>0 .AND. YCHEMFILETYPE=='MESONH')THEN
- CALL INI_PROG_VAR(XTKE_MX,XSV_MX,YCHEMFILE)
- LHORELAX_SVCHEM = (NSV_CHEM > 0)
- LHORELAX_SVCHIC = (NSV_CHIC > 0)
- LHORELAX_SVDST = (NSV_DST > 0)
- LHORELAX_SVSLT = (NSV_SLT > 0)
- LHORELAX_SVAER = (NSV_AER > 0)
-ELSE
-!
-!UPG*PT
-!IF (LEN_TRIM(YCAMSFILE)>0 .AND. YCAMSFILETYPE=='NETCDF') THEN
-IF (LEN_TRIM(YLIMAFILE)>0 .AND. YLIMAFILETYPE=='NETCDF') THEN
-!UPG*PT
- CALL LIMA_MIXRAT_TO_NCONC(XPABST, XTHT, XRT(:,:,:,1), XSV_MX)
-END IF
-!
- CALL INI_PROG_VAR(XTKE_MX,XSV_MX)
-END IF
-!
-
-! Initialization of ORILAM variables
-IF (LORILAM) THEN
- IF (.NOT.(ASSOCIATED(XN3D))) ALLOCATE(XN3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE))
- IF (.NOT.(ASSOCIATED(XRG3D))) ALLOCATE(XRG3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE))
- IF (.NOT.(ASSOCIATED(XSIG3D))) ALLOCATE(XSIG3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE))
- IF (.NOT.(ASSOCIATED(XRHOP3D))) ALLOCATE(XRHOP3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE))
- IF (.NOT.(ASSOCIATED(XM3D))) ALLOCATE(XM3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE*3))
- IF (.NOT.(ASSOCIATED(XCTOTA3D))) &
- ALLOCATE(XCTOTA3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),NSP+NCARB+NSOA,JPMODE))
-
- CALL CH_AER_EQM_INIT_n(XSVT(:,:,:,NSV_CHEMBEG:NSV_CHEMEND),&
- XSVT(:,:,:,NSV_AERBEG:NSV_AEREND),&
- XM3D,XRHOP3D,XSIG3D,&
- XRG3D,XN3D, XRHODREF, XCTOTA3D)
-END IF
-!
-! Initialization LIMA variables by ORILAM
-IF (CCLOUD == 'LIMA' .AND. ((LORILAM).OR.(LDUST).OR.(LSALT))) THEN
-
- ! Init LIMA by ORILAM
- CALL AER2LIMA(XSVT, XRHODREF, XRT(:,:,:,1), XPABST, XTHT,XZZ)
-
- ! Init LB LIMA by ORILAM
- ALLOCATE(ZLBXRHO(SIZE(XLBXSVM,1), SIZE(XLBXSVM,2), SIZE(XLBXSVM,3)))
- ALLOCATE(ZLBYRHO(SIZE(XLBYSVM,1), SIZE(XLBYSVM,2), SIZE(XLBYSVM,3)))
- ALLOCATE(ZLBXPABST(SIZE(XLBXSVM,1), SIZE(XLBXSVM,2), SIZE(XLBXSVM,3)))
- ALLOCATE(ZLBYPABST(SIZE(XLBYSVM,1), SIZE(XLBYSVM,2), SIZE(XLBYSVM,3)))
- ALLOCATE(ZLBXTHM(SIZE(XLBXSVM,1), SIZE(XLBXSVM,2), SIZE(XLBXSVM,3)))
- ALLOCATE(ZLBYTHM(SIZE(XLBYSVM,1), SIZE(XLBYSVM,2), SIZE(XLBYSVM,3)))
- ALLOCATE(ZLBXZZ(SIZE(XLBXSVM,1), SIZE(XLBXSVM,2), SIZE(XLBXSVM,3)))
- ALLOCATE(ZLBYZZ(SIZE(XLBYSVM,1), SIZE(XLBYSVM,2), SIZE(XLBYSVM,3)))
- ALLOCATE(ZLBXRM(SIZE(XLBXSVM,1), SIZE(XLBXSVM,2), SIZE(XLBXSVM,3)))
- ALLOCATE(ZLBYRM(SIZE(XLBYSVM,1), SIZE(XLBYSVM,2), SIZE(XLBYSVM,3)))
- ALLOCATE(ZLBXSVM(SIZE(XLBXSVM,1), SIZE(XLBXSVM,2), SIZE(XLBXSVM,3), SIZE(XLBXSVM,4)))
- ALLOCATE(ZLBYSVM(SIZE(XLBYSVM,1), SIZE(XLBYSVM,2), SIZE(XLBYSVM,3), SIZE(XLBXSVM,4)))
-
- ILBX=SIZE(XLBXSVM,1)/2-JPHEXT
- ILBY=SIZE(XLBYSVM,2)/2-JPHEXT
-
- CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-
- ZLBXRHO(1:ILBX+1,:,:) = XRHODREF(IIB-1:IIB-1+ILBX,:,:)
- ZLBXRHO(ILBX+2:2*ILBX+2,:,:) = XRHODREF(IIE+1-ILBX:IIE+1,:,:)
- ZLBYRHO(:,1:ILBY+1,:) = XRHODREF(:,IJB-1:IJB-1+ILBY,:)
- ZLBYRHO(:,ILBY+2:2*ILBY+2,:) = XRHODREF(:,IJE+1-ILBY:IJE+1,:)
- ZLBXPABST(1:ILBX+1,:,:) = XPABST(IIB-1:IIB-1+ILBX,:,:)
- ZLBXPABST(ILBX+2:2*ILBX+2,:,:) = XPABST(IIE+1-ILBX:IIE+1,:,:)
- ZLBYPABST(:,1:ILBY+1,:) = XPABST(:,IJB-1:IJB-1+ILBY,:)
- ZLBYPABST(:,ILBY+2:2*ILBY+2,:) = XPABST(:,IJE+1-ILBY:IJE+1,:)
- ZLBXTHM(1:ILBX+1,:,:) = XTHT(IIB-1:IIB-1+ILBX,:,:)
- ZLBXTHM(ILBX+2:2*ILBX+2,:,:) = XTHT(IIE+1-ILBX:IIE+1,:,:)
- ZLBYTHM(:,1:ILBY+1,:) = XTHT(:,IJB-1:IJB-1+ILBY,:)
- ZLBYTHM(:,ILBY+2:2*ILBY+2,:) = XTHT(:,IJE+1-ILBY:IJE+1,:)
- ZLBXZZ(1:ILBX+1,:,:) = XZZ(IIB-1:IIB-1+ILBX,:,:)
- ZLBXZZ(ILBX+2:2*ILBX+2,:,:) = XZZ(IIE+1-ILBX:IIE+1,:,:)
- ZLBYZZ(:,1:ILBY+1,:) = XZZ(:,IJB-1:IJB-1+ILBY,:)
- ZLBYZZ(:,ILBY+2:2*ILBY+2,:) = XZZ(:,IJE+1-ILBY:IJE+1,:)
- ZLBXSVM(1:ILBX+1,:,:,:) = XSVT(IIB-1:IIB-1+ILBX,:,:,:)
- ZLBXSVM(ILBX+2:2*ILBX+2,:,:,:) = XSVT(IIE+1-ILBX:IIE+1,:,:,:)
- ZLBYSVM(:,1:ILBY+1,:,:) = XSVT(:,IJB-1:IJB-1+ILBY,:,:)
- ZLBYSVM(:,ILBY+2:2*ILBY+2,:,:) = XSVT(:,IJE+1-ILBY:IJE+1,:,:)
- ZLBXRM(1:ILBX+1,:,:) = XRT(IIB-1:IIB-1+ILBX,:,:,1)
- ZLBXRM(ILBX+2:2*ILBX+2,:,:) = XRT(IIE+1-ILBX:IIE+1,:,:,1)
- ZLBYRM(:,1:ILBY+1,:) = XRT(:,IJB-1:IJB-1+ILBY,:,1)
- ZLBYRM(:,ILBY+2:2*ILBY+2,:) = XRT(:,IJE+1-ILBY:IJE+1,:,1)
-
-
- CALL AER2LIMA(ZLBXSVM, ZLBXRHO, ZLBXRM(:,:,:), ZLBXPABST, ZLBXTHM, ZLBXZZ)
- CALL AER2LIMA(ZLBYSVM, ZLBYRHO, ZLBYRM(:,:,:), ZLBYPABST, ZLBYTHM, ZLBYZZ)
-
- DEALLOCATE(ZLBXRHO)
- DEALLOCATE(ZLBYRHO)
- DEALLOCATE(ZLBXPABST)
- DEALLOCATE(ZLBYPABST)
- DEALLOCATE(ZLBXTHM)
- DEALLOCATE(ZLBYTHM)
- DEALLOCATE(ZLBXZZ)
- DEALLOCATE(ZLBYZZ)
- DEALLOCATE(ZLBXRM)
- DEALLOCATE(ZLBYRM)
- DEALLOCATE(ZLBXSVM)
- DEALLOCATE(ZLBYSVM)
-END IF
-!
-IF (ALLOCATED(XSV_MX)) DEALLOCATE(XSV_MX)
-IF (ALLOCATED(XTKE_MX)) DEALLOCATE(XTKE_MX)
-!
-CALL BOUNDARIES ( &
- 0.,CLBCX,CLBCY,NRR,NSV,1, &
- XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, &
- XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
- XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, &
- XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
- XRHODJ,XRHODREF, &
- XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT )
-!
-CALL SECOND_MNH(ZTIME2)
-ZMISC = ZMISC + ZTIME2 - ZTIME1
-!
-!-------------------------------------------------------------------------------
-!
-!* 15. Error on temperature during interpolations
-! ------------------------------------------
-!
-ZTIME1 = ZTIME2
-!
-IF (YATMFILETYPE=='GRIBEX' .AND. NVERB>1) THEN
- CALL ERROR_ON_TEMPERATURE(XT_LS,XPMASS_LS,XPABST,XPS_LS,XPSURF)
-END IF
-!
-IF (YATMFILETYPE=='GRIBEX') THEN
- DEALLOCATE(XT_LS)
- DEALLOCATE(XPMASS_LS)
- DEALLOCATE(XPS_LS)
-END IF
-!
-IF (ALLOCATED(XPSURF)) DEALLOCATE(XPSURF)
-!
-CALL SECOND_MNH(ZTIME2)
-ZDIAG = ZDIAG + ZTIME2 - ZTIME1
-!-------------------------------------------------------------------------------
-!
-!* 16. INITIALIZE LEVELSET FOR IBM
-! ---------------------------
-!
-IF (LIBM_LSF) THEN
- !
- IF (.NOT.LCARTESIAN) THEN
- CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','IBM can only be used with cartesian coordinates')
- ENDIF
- !
- CALL GET_DIM_EXT_ll('B',NIU,NJU)
- NKU=NKMAX+2*JPVEXT
- !
- ALLOCATE(XIBM_LS(NIU,NJU,NKU,4))
- !
- CALL IBM_INIT_LS(XIBM_LS)
- !
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* 17. WRITING OF THE MESO-NH FM-FILE
-! ------------------------------
-!
-ZTIME1 = ZTIME2
-!
-CSTORAGE_TYPE='TT'
-IF (YATMFILETYPE=='GRIBEX') THEN
- CSURF = "EXTE"
- DO JRR=1,NRR
- IF (JRR==1) THEN
- LUSERV=.TRUE.
- IDX_RVT = JRR
- END IF
- IF (JRR==2) THEN
- LUSERC=.TRUE.
- IDX_RCT = JRR
- END IF
- IF (JRR==3) THEN
- LUSERR=.TRUE.
- IDX_RRT = JRR
- END IF
- IF (JRR==4) THEN
- LUSERI=.TRUE.
- IDX_RIT = JRR
- END IF
- IF (JRR==5) THEN
- LUSERS=.TRUE.
- IDX_RST = JRR
- END IF
- IF (JRR==6) THEN
- LUSERG=.TRUE.
- IDX_RGT = JRR
- END IF
- IF (JRR==7) THEN
- LUSERH=.TRUE.
- IDX_RHT = JRR
- END IF
- END DO
-END IF
-!
-CALL WRITE_DESFM_n(1,TINIFILE)
-CALL IO_Header_write(TINIFILE,HDAD_NAME=YDAD_NAME)
-CALL WRITE_LFIFM_n(TINIFILE,YDAD_NAME)
-!
-CALL SECOND_MNH(ZTIME2)
-ZWRITE = ZTIME2 - ZTIME1
-!
-!-------------------------------------------------------------------------------
-!
-!* 18. OROGRAPHIC and DUMMY PHYSIOGRAPHIC FIELDS
-! -----------------------------------------
-!
-!* reading in the PGD file
-!
-CALL MNHREAD_ZS_DUMMY_n(TPGDFILE)
-!
-!* writing in the output file
-!
-TOUTDATAFILE => TINIFILE
-CALL MNHWRITE_ZS_DUMMY_n(TINIFILE)
-!
-CALL DEALLOCATE_MODEL1(3)
-!
-IF (YATMFILETYPE=='MESONH'.AND. YATMFILE/=YPGDFILE) THEN
- CALL IO_File_find_byname(TRIM(YATMFILE),TZATMFILE,IRESP)
- CALL IO_File_close(TZATMFILE)
-END IF
-!-------------------------------------------------------------------------------
-!
-!* 19. INTERPOLATION OF SURFACE VARIABLES
-! ----------------------------------
-!
-IF (.NOT. LCOUPLING ) THEN
- ZTIME1 = ZTIME2
-!
- IF (CSURF=="EXTE") THEN
- IF (YATMFILETYPE/='MESONH') THEN
- CALL SURFEX_ALLOC_LIST(1)
- YSURF_CUR => YSURF_LIST(1)
- CALL READ_ALL_NAMELISTS(YSURF_CUR,'MESONH','PRE',.FALSE.)
- ENDIF
- CALL GOTO_SURFEX(1)
- TFILE_SURFEX => TINIFILE
- CALL PREP_SURF_MNH(YSURFFILE,YSURFFILETYPE)
- NULLIFY(TFILE_SURFEX)
- ENDIF
-!
- CALL SECOND_MNH(ZTIME2)
- ZSURF = ZSURF + ZTIME2 - ZTIME1
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* 20. EPILOGUE
-! --------
-!
-WRITE(ILUOUT0,*)
-WRITE(ILUOUT0,*)
-WRITE(ILUOUT0,*)
-WRITE(ILUOUT0,*) '**************************************************'
-WRITE(ILUOUT0,*) '* PREP_REAL_CASE: PREP_REAL_CASE ends correctly. *'
-WRITE(ILUOUT0,*) '**************************************************'
-WRITE(ILUOUT0,*)
-!
-!-------------------------------------------------------------------------------
-!
-CALL SECOND_MNH (ZEND)
-!
-ZTOT = ZEND - ZSTART ! for computing time analysis
-!
-ZALL = ZMISC + ZREAD + ZHORI + ZPREP + ZTHERMO + ZSURF + ZDYN + ZDIAG + ZWRITE
-!
-WRITE(ILUOUT0,*)
-WRITE(ILUOUT0,*) ' ------------------------------------------------------------ '
-WRITE(ILUOUT0,*) '| |'
-WRITE(ILUOUT0,*) '| COMPUTING TIME ANALYSIS in PREP_REAL_CASE |'
-WRITE(ILUOUT0,*) '| |'
-WRITE(ILUOUT0,*) '|------------------------------------------------------------|'
-WRITE(ILUOUT0,*) '| | | |'
-WRITE(ILUOUT0,*) '| ROUTINE NAME | CPU-TIME | PERCENTAGE % |'
-WRITE(ILUOUT0,*) '| | | |'
-WRITE(ILUOUT0,*) '|---------------------|-------------------|------------------|'
-WRITE(ILUOUT0,*) '| | | |'
-WRITE(UNIT=ILUOUT0,FMT=2) ZREAD, 100.*ZREAD/ZTOT
-WRITE(UNIT=ILUOUT0,FMT=9) ZHORI, 100.*ZHORI/ZTOT
-WRITE(UNIT=ILUOUT0,FMT=3) ZPREP, 100.*ZPREP/ZTOT
-WRITE(UNIT=ILUOUT0,FMT=4) ZTHERMO, 100.*ZTHERMO/ZTOT
-WRITE(UNIT=ILUOUT0,FMT=6) ZDYN, 100.*ZDYN/ZTOT
-WRITE(UNIT=ILUOUT0,FMT=7) ZDIAG, 100.*ZDIAG/ZTOT
-WRITE(UNIT=ILUOUT0,FMT=8) ZWRITE, 100.*ZWRITE/ZTOT
-WRITE(UNIT=ILUOUT0,FMT=1) ZMISC, 100.*ZMISC/ZTOT
-WRITE(UNIT=ILUOUT0,FMT=5) ZSURF, 100.*ZSURF/ZTOT
-!
-WRITE(UNIT=ILUOUT0,FMT=10) ZTOT , 100.*ZALL/ZTOT
-WRITE(ILUOUT0,*) ' ------------------------------------------------------------ '
-!
-! FORMATS
-! -------
-!
-2 FORMAT(' | READING OF DATA | ',F8.3,' | ',F8.3,' |')
-9 FORMAT(' | HOR. INTERPOLATIONS | ',F8.3,' | ',F8.3,' |')
-3 FORMAT(' | VER_PREP | ',F8.3,' | ',F8.3,' |')
-4 FORMAT(' | VER_THERMO | ',F8.3,' | ',F8.3,' |')
-6 FORMAT(' | VER_DYN | ',F8.3,' | ',F8.3,' |')
-7 FORMAT(' | DIAGNOSTICS | ',F8.3,' | ',F8.3,' |')
-8 FORMAT(' | WRITE | ',F8.3,' | ',F8.3,' |')
-1 FORMAT(' | MISCELLANEOUS | ',F8.3,' | ',F8.3,' |')
-5 FORMAT(' | SURFACE | ',F8.3,' | ',F8.3,' |')
-10 FORMAT(' | PREP_REAL_CASE | ',F8.3,' | ',F8.3,' |')
-!
-!-------------------------------------------------------------------------------
-!
-IF (LEN_TRIM(YDAD_NAME)>0) THEN
- WRITE(ILUOUT0,*) ' '
- WRITE(ILUOUT0,*) ' ------------------------------------------------------------'
- WRITE(ILUOUT0,*) '| Nesting allowed |'
- WRITE(ILUOUT0,*) '| DAD_NAME="',YDAD_NAME,'" |'
- WRITE(ILUOUT0,*) ' ------------------------------------------------------------'
- WRITE(ILUOUT0,*) ' '
-ELSE
- WRITE(ILUOUT0,*) ' '
- WRITE(ILUOUT0,*) ' ------------------------------------------------------------'
- WRITE(ILUOUT0,*) '| Nesting not allowed with a larger-scale model. |'
- WRITE(ILUOUT0,*) '| The new file can only be used as model number 1 |'
- WRITE(ILUOUT0,*) ' ------------------------------------------------------------'
- WRITE(ILUOUT0,*) ' '
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-CALL IO_File_close(TINIFILE)
-CALL IO_File_close(TPGDFILE)
-!
-CALL FINALIZE_MNH()
-!
-!-------------------------------------------------------------------------------
-!
-CONTAINS
-
-SUBROUTINE INIT_NMLVAR
-CPRESOPT=CPRESOPT_n
-LRES=LRES_n
-XRES=XRES_n
-NITR=NITR_n
-LUSECHAQ=LUSECHAQ_n
-LUSECHIC=LUSECHIC_n
-LUSECHEM=LUSECHEM_n
-END SUBROUTINE INIT_NMLVAR
-
-SUBROUTINE UPDATE_MODD_FROM_NMLVAR
-CPRESOPT_n=CPRESOPT
-LRES_n=LRES
-XRES_n=XRES
-NITR_n=NITR
-LUSECHAQ_n=LUSECHAQ
-LUSECHIC_n=LUSECHIC
-LUSECHEM_n=LUSECHEM
-END SUBROUTINE UPDATE_MODD_FROM_NMLVAR
-
-END PROGRAM PREP_REAL_CASE
diff --git a/src/mesonh/ext/prep_surfex.f90 b/src/mesonh/ext/prep_surfex.f90
deleted file mode 100644
index 6c3c81277095e0087f0f7d63a998dbade6008a07..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/prep_surfex.f90
+++ /dev/null
@@ -1,208 +0,0 @@
-!MNH_LIC Copyright 2004-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.
-!-----------------------------------------------------------------
-! #############################
- PROGRAM PREP_SURFEX
-! #############################
-!
-!!**** *PREP_SURFEX* - program to write an initial FM file from real case
-!! situation containing only surface fields.
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book 2
-!!
-!! AUTHOR
-!! ------
-!!
-!! V.Masson Meteo-France
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 12/2004 (P. Le Moigne)
-!! 10/10/2011 J.Escobar call INI_PARAZ_ll
-!! 06/2016 (G.Delautier) phasage surfex 8
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
-!! 2021 B.Vie LIMA - CAMS coupling
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CONF, ONLY : CPROGRAM,&
- L1D, L2D, LPACK
-USE MODD_CONF_n, ONLY : CSTORAGE_TYPE
-USE MODD_IO, ONLY : TFILEDATA, TFILE_SURFEX
-USE MODD_LUNIT, ONLY : TPGDFILE, TLUOUT0
-USE MODD_LUNIT_n, ONLY : CINIFILE, TINIFILE
-USE MODD_MNH_SURFEX_n
-USE MODD_PARAMETERS, ONLY : JPMODELMAX,JPHEXT,JPVEXT, NUNDEF, XUNDEF
-USE MODD_TIME_n, ONLY : TDTCUR
-!
-use mode_field, only: Ini_field_list, Ini_field_scalars
-USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
-USE MODE_IO, only: IO_Init
-USE MODE_IO_FIELD_READ, only: IO_Field_read
-USE MODE_IO_FIELD_WRITE, only: IO_Field_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
-USE MODE_MSG
-USE MODE_MODELN_HANDLER
-USE MODE_SPLITTINGZ_ll
-!
-USE MODI_OPEN_PRC_FILES
-USE MODI_PREP_SURF_MNH
-USE MODI_READ_ALL_NAMELISTS
-USE MODI_VERSION
-USE MODE_INI_CST, ONLY: INI_CST
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of local variables
-! ------------------------------
-!
-CHARACTER(LEN=28) :: YATMFILE ! name of the Atmospheric file
-CHARACTER(LEN=6) :: YATMFILETYPE ! type of the Atmospheric file
-CHARACTER(LEN=28) :: YCHEMFILE ! name of the Chemical file (not used)
-CHARACTER(LEN=6) :: YCHEMFILETYPE ! type of the Chemical file (not used)
-CHARACTER(LEN=28) :: YCAMSFILE ! name of the input CAMS file
-CHARACTER(LEN=6) :: YCAMSFILETYPE ! type of the input CAMS file
-CHARACTER(LEN=28) :: YSURFFILE ! name of the Surface file (not used)
-CHARACTER(LEN=6) :: YSURFFILETYPE ! type of the Surface file (not used)
-CHARACTER(LEN=28) :: YPGDFILE ! name of the physiographic data
-! ! file
-!
-!* file management variables and counters
-!
-INTEGER :: ILUOUT0 ! logical unit for listing file
-INTEGER :: IRESP ! return code in FM routines
-!
-INTEGER :: IINFO_ll ! return code of // routines
-CHARACTER (LEN=100) :: HCOMMENT
-INTEGER :: II, IJ, IGRID, ILENGTH
-!
-TYPE(TFILEDATA),POINTER :: TZATMFILE => NULL()
-TYPE(TFILEDATA),POINTER :: TZPRE_REAL1FILE => NULL()
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. SET DEFAULT VALUES
-! ------------------
-!
-CALL GOTO_MODEL(1)
-!
-CALL VERSION
-CPROGRAM='REAL '
-CSTORAGE_TYPE='SU'
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. OPENNING OF THE FILES
-! ---------------------
-CALL IO_Init()
-!
-CALL OPEN_PRC_FILES(TZPRE_REAL1FILE,YATMFILE, YATMFILETYPE,TZATMFILE &
- ,YCHEMFILE,YCHEMFILETYPE &
- ,YSURFFILE,YSURFFILETYPE &
- ,YPGDFILE,TPGDFILE &
- ,YCAMSFILE,YCAMSFILETYPE)
-ILUOUT0 = TLUOUT0%NLU
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. INITIALIZATION OF PHYSICAL CONSTANTS
-! ------------------------------------
-!
-CALL INI_CST
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. READING OF NAMELIST
-! -------------------
-!
-!* 4.1 reading of configuration variables
-!
-CALL IO_File_close(TZPRE_REAL1FILE)
-!
-!* 4.2 reading of values of some configuration variables in namelist
-!
-CALL INI_FIELD_LIST()
-!
-CALL INI_FIELD_SCALARS()
-!
-CALL IO_Field_read(TPGDFILE,'IMAX',II)
-CALL IO_Field_read(TPGDFILE,'JMAX',IJ)
-CALL SET_JP_ll(JPMODELMAX,JPHEXT,JPVEXT,JPHEXT)
-CALL SET_DAD0_ll()
-CALL SET_DIM_ll(II, IJ, 1)
-CALL SET_LBX_ll('OPEN',1)
-CALL SET_LBY_ll('OPEN', 1)
-CALL SET_XRATIO_ll(1, 1)
-CALL SET_YRATIO_ll(1, 1)
-CALL SET_XOR_ll(1, 1)
-CALL SET_XEND_ll(II+2*JPHEXT, 1)
-CALL SET_YOR_ll(1, 1)
-CALL SET_YEND_ll(IJ+2*JPHEXT, 1)
-CALL SET_DAD_ll(0, 1)
-!JUANZ CALL INI_PARA_ll(IINFO_ll)
-CALL INI_PARAZ_ll(IINFO_ll)
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 5. PREPARATION OF SURFACE FIELDS
-! -----------------------------
-!
-!* reading of date
-!
-IF (YATMFILETYPE=='MESONH') THEN
- CALL IO_File_add2list(TZATMFILE,TRIM(YATMFILE),'MNH','READ',KLFITYPE=1,KLFIVERB=1)
- CALL IO_File_open(TZATMFILE)
- CALL IO_Field_read(TZATMFILE,'DTCUR',TDTCUR)
- CALL IO_File_close(TZATMFILE)
-ELSE
- TDTCUR%nyear = NUNDEF
- TDTCUR%nmonth = NUNDEF
- TDTCUR%nday = NUNDEF
- TDTCUR%xtime = XUNDEF
-END IF
-!
-CALL SURFEX_ALLOC_LIST(1)
-YSURF_CUR => YSURF_LIST(1)
-CALL READ_ALL_NAMELISTS(YSURF_CUR,'MESONH','PRE',.FALSE.)
-CALL GOTO_SURFEX(1)
-!
-CALL IO_File_add2list(TINIFILE,TRIM(CINIFILE),'PGD','WRITE',KLFITYPE=1,KLFIVERB=1)
-!The open is done later in PREP_SURF_MNH when domain dimensions are known
-!
-TFILE_SURFEX => TINIFILE
-CALL PREP_SURF_MNH(YATMFILE,YATMFILETYPE,OINIFILEOPEN=.TRUE.)
-NULLIFY(TFILE_SURFEX)
-!
-!-------------------------------------------------------------------------------
-!
-CALL IO_Header_write(TINIFILE)
-CALL IO_Field_write(TINIFILE,'SURF','EXTE')
-CALL IO_Field_write(TINIFILE,'L1D', L1D)
-CALL IO_Field_write(TINIFILE,'L2D', L2D)
-CALL IO_Field_write(TINIFILE,'PACK',LPACK)
-!
-!-------------------------------------------------------------------------------
-WRITE(ILUOUT0,*) ' '
-WRITE(ILUOUT0,*) '----------------------------------'
-WRITE(ILUOUT0,*) '| |'
-WRITE(ILUOUT0,*) '| PREP_SURFEX ends correctly |'
-WRITE(ILUOUT0,*) '| |'
-WRITE(ILUOUT0,*) '----------------------------------'
-CALL IO_File_close(TINIFILE)
-!
-CALL FINALIZE_MNH()
-!-------------------------------------------------------------------------------
-!
-END PROGRAM PREP_SURFEX
diff --git a/src/mesonh/ext/profilern.f90 b/src/mesonh/ext/profilern.f90
deleted file mode 100644
index 9a8b3f6690b14b87aab81805d67c413139149fb6..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/profilern.f90
+++ /dev/null
@@ -1,715 +0,0 @@
-!MNH_LIC Copyright 2002-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_PROFILER_n
-! ##########################
-!
-INTERFACE
-!
- SUBROUTINE PROFILER_n( PZ, PRHODREF, &
- PU, PV, PW, PTH, PR, PSV, PTKE, &
- PTS, PP, PAER, PCIT, PSEA )
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZ ! z array
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PU ! horizontal wind X component
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PV ! horizontal wind Y component
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW ! vertical wind
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTH ! potential temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PR ! water mixing ratios
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSV ! Scalar variables
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE ! turbulent kinetic energy
-REAL, DIMENSION(:,:), INTENT(IN) :: PTS ! surface temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PP ! pressure
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PAER ! aerosol extinction
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! ice concentration
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! for radar
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE PROFILER_n
-!
-END INTERFACE
-!
-END MODULE MODI_PROFILER_n
-!
-! ########################################################
- SUBROUTINE PROFILER_n( PZ, PRHODREF, &
- PU, PV, PW, PTH, PR, PSV, PTKE, &
- PTS, PP, PAER, PCIT, PSEA )
-! ########################################################
-!
-!
-!
-!!**** *PROFILER_n* - (advects and) stores
-!! stations/s in the model
-!!
-!! PURPOSE
-!! -------
-!
-!
-!!** METHOD
-!! ------
-!!
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! Pierre TULET / Valery Masson * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 15/02/2002
-!! March 2013 : C.Lac : Corrections for 1D + new fields (RARE,THV,DD,FF)
-!! April 2014 : C.Lac : Call RADAR only if ICE3
-!! C.Lac 10/2016 Add visibility diagnostic
-!! March,28, 2018 (P. Wautelet) replace TEMPORAL_DIST by DATETIME_DISTANCE
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
-! M. Taufour 05/07/2021: modify RARE for hydrometeors containing ice and add bright band calculation for RARE
-! P. Wautelet 09/02/2022: add message when some variables not computed
-! + bugfix: put values in variables in this case
-! + move some operations outside a do loop
-! P. Wautelet 04/2022: restructure profilers for better performance, reduce memory usage and correct some problems/bugs
-! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY: XCPD, XG, XLAM_CRAD, XLIGHTSPEED, XP00, XPI, XRD, XRHOLW, XRV, XTT
-USE MODD_DIAG_IN_RUN
-USE MODD_GRID, ONLY: XBETA, XLON0, XRPK
-USE MODD_NSV, ONLY: NSV_C2R2, NSV_C2R2BEG, NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_NR
-USE MODD_PARAMETERS, ONLY: JPVEXT, XUNDEF
-USE MODD_PARAM_ICE_n, ONLY: LSNOW_T_I => LSNOW_T
-USE MODD_PARAM_LIMA, ONLY: LSNOW_T_L => LSNOW_T, &
- XALPHAR_L => XALPHAR, XNUR_L => XNUR, XALPHAS_L => XALPHAS, XNUS_L => XNUS, &
- XALPHAG_L => XALPHAG, XNUG_L => XNUG, XALPHAI_L => XALPHAI, XNUI_L => XNUI, &
- XRTMIN_L => XRTMIN, XALPHAC_L => XALPHAC, XNUC_L => XNUC
-USE MODD_PARAM_LIMA_COLD, ONLY: XDI_L => XDI, XLBEXI_L => XLBEXI, XLBI_L => XLBI, XAI_L => XAI, XBI_L => XBI, XC_I_L => XC_I, &
- XLBEXS_L => XLBEXS, XLBS_L => XLBS, XCCS_L => XCCS, &
- XAS_L => XAS, XBS_L => XBS, XCXS_L => XCXS, &
- XLBDAS_MAX_L => XLBDAS_MAX, XLBDAS_MIN_L => XLBDAS_MIN, &
- XNS_L => XNS, XTRANS_MP_GAMMAS_L=>XTRANS_MP_GAMMAS
-USE MODD_PARAM_LIMA_MIXED, ONLY: XDG_L => XDG, XLBEXG_L => XLBEXG, XLBG_L => XLBG, XCCG_L => XCCG, &
- XAG_L => XAG, XBG_L => XBG, XCXG_L => XCXG, XCG_L => XCG
-USE MODD_PARAM_LIMA_WARM, ONLY: XLBEXR_L => XLBEXR, XLBR_L => XLBR, XBR_L => XBR, XAR_L => XAR, &
- XBC_L => XBC, XAC_L => XAC
-USE MODD_PARAM_n, ONLY: CCLOUD, CRAD, CSURF
-USE MODD_PROFILER_n
-USE MODD_RAIN_ICE_DESCR_n, ONLY: XALPHAR_I => XALPHAR, XNUR_I => XNUR, XLBEXR_I => XLBEXR, &
- XLBR_I => XLBR, XCCR_I => XCCR, XBR_I => XBR, XAR_I => XAR, &
- XALPHAC_I => XALPHAC, XNUC_I => XNUC, &
- XLBC_I => XLBC, XBC_I => XBC, XAC_I => XAC, &
- XALPHAC2_I => XALPHAC2, XNUC2_I => XNUC2, &
- XALPHAS_I => XALPHAS, XNUS_I => XNUS, XLBEXS_I => XLBEXS, &
- XLBS_I => XLBS, XCCS_I => XCCS, XAS_I => XAS, XBS_I => XBS, XCXS_I => XCXS, &
- XALPHAG_I => XALPHAG, XNUG_I => XNUG, XDG_I => XDG, XLBEXG_I => XLBEXG, &
- XLBG_I => XLBG, XCCG_I => XCCG, XAG_I => XAG, XBG_I => XBG, XCXG_I => XCXG, XCG_I => XCG, &
- XALPHAI_I => XALPHAI, XNUI_I => XNUI, XDI_I => XDI, XLBEXI_I => XLBEXI, &
- XLBI_I => XLBI, XAI_I => XAI, XBI_I => XBI, XC_I_I => XC_I, &
- XNS_I => XNS, XRTMIN_I => XRTMIN, XCONC_LAND, XCONC_SEA, &
- XLBDAS_MAX_I => XLBDAS_MAX, XLBDAS_MIN_I => XLBDAS_MIN, &
- XTRANS_MP_GAMMAS_I => XTRANS_MP_GAMMAS
-!
-USE MODE_FGAU, ONLY: GAULAG
-USE MODE_FSCATTER, ONLY: BHMIE, QEPSI, QEPSW, MG, MOMG
-USE MODE_MSG
-USE MODE_STATPROF_TOOLS, ONLY: STATPROF_INSTANT, STATPROF_INTERP_2D, STATPROF_INTERP_3D, &
- STATPROF_INTERP_3D_U, STATPROF_INTERP_3D_V
-!
-USE MODI_GPS_ZENITH_GRID
-USE MODI_WATER_SUM
-!
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZ ! z array
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PU ! horizontal wind X component
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PV ! horizontal wind Y component
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW ! vertical wind
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTH ! potential temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PR ! water mixing ratios
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSV ! Scalar variables
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE ! turbulent kinetic energy
-REAL, DIMENSION(:,:), INTENT(IN) :: PTS ! surface temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PP ! pressure
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PAER ! aerosol extinction
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! ice concentration
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! for radar
-!
-!-------------------------------------------------------------------------------
-!
-! 0.2 declaration of local variables
-!
-!
-INTEGER, PARAMETER :: JPTS_GAULAG = 9 ! number of points for Gauss-Laguerre quadrature
-!
-INTEGER :: IKB
-INTEGER :: IKE
-INTEGER :: IKU
-!
-!
-REAL, DIMENSION(SIZE(PSV,1),SIZE(PSV,2),SIZE(PSV,3),SIZE(PSV,4)) :: ZWORK
-REAL, DIMENSION(SIZE(PSV,1),SIZE(PSV,2),SIZE(PSV,3),SIZE(PAER,4)) :: ZWORK2
-!
-INTEGER :: IN ! time index
-INTEGER :: JSV ! loop counter
-INTEGER :: JK ! loop
-INTEGER :: JP ! loop for profilers
-INTEGER :: IKRAD
-!
-REAL,DIMENSION(SIZE(PZ,3)) :: ZU_PROFILER ! horizontal wind speed profile at station location (along x)
-REAL,DIMENSION(SIZE(PZ,3)) :: ZV_PROFILER ! horizontal wind speed profile at station location (along y)
-REAL,DIMENSION(SIZE(PZ,3)) :: ZFF ! horizontal wind speed profile at station location
-REAL,DIMENSION(SIZE(PZ,3)) :: ZDD ! horizontal wind speed profile at station location
-REAL,DIMENSION(SIZE(PZ,3)) :: ZRHOD ! dry air density in moist mixing profile at station location
-REAL,DIMENSION(SIZE(PZ,3)) :: ZRV ! water vapour mixing ratio profile at station location
-REAL,DIMENSION(SIZE(PZ,3)) :: ZT ! temperature profile at station location
-REAL,DIMENSION(SIZE(PZ,3)) :: ZTV ! virtual temperature profile at station location
-REAL,DIMENSION(SIZE(PZ,3)) :: ZPRES ! pressure profile at station location
-REAL,DIMENSION(SIZE(PZ,3)) :: ZE ! water vapour partial pressure profile at station location
-REAL,DIMENSION(SIZE(PZ,3)) :: ZZ ! altitude of model levels at station location
-REAL,DIMENSION(SIZE(PZ,3)-1) :: ZZHATM ! altitude of mass point levels at station location
-REAL :: ZGAM ! rotation between meso-nh base and spherical lat-lon base.
-!
-REAL :: XZS_GPS ! GPS station altitude
-REAL :: ZIWV ! integrated water vapour at station location
-REAL :: ZZM_STAT ! altitude at station location
-REAL :: ZTM_STAT ! temperature at station location
-REAL :: ZTV_STAT ! virtual temperature at station location
-REAL :: ZPM_STAT ! pressure at station location
-REAL :: ZEM_STAT ! water vapour partial pressure at station location
-REAL :: ZZTD_PROFILER ! ZTD at station location
-REAL :: ZZHD_PROFILER ! ZHD at station location
-REAL :: ZZWD_PROFILER ! ZWD at station location
-REAL :: ZZHDR ! ZHD correction at station location
-REAL :: ZZWDR ! ZWD correction at station location
-!
-REAL,DIMENSION(SIZE(PTH,1),SIZE(PTH,2)) :: ZZTD,ZZHD,ZZWD
-REAL,DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZTEMP,ZTHV,ZTEMPV
-REAL,DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZVISIGUL, ZVISIKUN
-REAL :: ZK1,ZK2,ZK3 ! k1, k2 and K3 atmospheric refractivity constants
-REAL :: ZRDSRV ! XRD/XRV
-!
-! specific to cloud radar
-INTEGER :: JLOOP ! loop counter
-REAL, DIMENSION(SIZE(PR,3)) :: ZTEMPZ! vertical profile of temperature
-REAL, DIMENSION(SIZE(PR,3)) :: ZRHODREFZ ! vertical profile of dry air density of the reference state
-REAL, DIMENSION(SIZE(PR,3)) :: ZCIT ! pristine ice concentration
-REAL, DIMENSION(SIZE(PR,3)) :: ZCCI,ZCCR,ZCCC ! ICE,RAIN CLOUD concentration (LIMA)
-REAL, DIMENSION(SIZE(PR,3),SIZE(PR,4)+1) :: ZRZ ! vertical profile of hydrometeor mixing ratios
-REAL :: ZA, ZB, ZCC, ZCX, ZALPHA, ZNS, ZNU, ZLB, ZLBEX, ZRHOHYD ! generic microphysical parameters
-INTEGER :: JJ ! loop counter for quadrature
-COMPLEX :: QMW,QMI,QM,QB,QEPSIW,QEPSWI ! dielectric parameter
-REAL :: ZAETOT,ZAETMP,ZREFLOC,ZQSCA,ZQBACK,ZQEXT ! temporary scattering parameters
-REAL,DIMENSION(:),ALLOCATABLE :: ZAELOC,ZZMZ ! temporary arrays
-REAL :: ZLBDA ! slope distribution parameter
-REAL :: ZDELTA_EQUIV ! mass-equivalent Gauss-Laguerre point
-REAL :: ZFW ! liquid fraction
-REAL :: ZFPW ! weight for mixed-phase reflectivity
-REAL :: ZN ! number concentration
-REAL,DIMENSION(:),ALLOCATABLE :: ZX,ZW ! Gauss-Laguerre points and weights
-REAL,DIMENSION(:),ALLOCATABLE :: ZRTMIN ! local values for XRTMIN
-LOGICAL :: GCALC
-!----------------------------------------------------------------------------
-!
-!* 2. PRELIMINARIES
-! -------------
-!
-!* 2.0 Refractivity coeficients
-! ------------------------
-! Bevis et al. (1994)
-ZK1 = 0.776 ! K/Pa
-ZK2 = 0.704 ! K/Pa
-ZK3 = 3739. ! K2/Pa
-ZRDSRV=XRD/XRV
-!
-!* 2.1 Indices
-! -------
-!
-IKU = SIZE(PZ,3) ! nombre de niveaux sur la verticale
-IKB = JPVEXT+1
-IKE = IKU-JPVEXT
-!
-!----------------------------------------------------------------------------
-!
-!* 3.4 instant of storage
-! ------------------
-!
-CALL STATPROF_INSTANT( TPROFILERS_TIME, IN )
-IF ( IN < 1 ) RETURN !No profiler storage at this time step
-!
-!----------------------------------------------------------------------------
-!
-!* 8. DATA RECORDING
-! --------------
-!
-!PW: TODO: ne faire le calcul que si necessaire (presence de profileurs locaux,...)
-ZTEMP(:,:,:)=PTH(:,:,:)*(PP(:,:,:)/ XP00) **(XRD/XCPD)
-! Theta_v
-ZTHV(:,:,:) = PTH(:,:,:) / (1.+WATER_SUM(PR(:,:,:,:)))*(1.+PR(:,:,:,1)/ZRDSRV)
-! virtual temperature
-ZTEMPV(:,:,:)=ZTHV(:,:,:)*(PP(:,:,:)/ XP00) **(XRD/XCPD)
-CALL GPS_ZENITH_GRID(PR(:,:,:,1),ZTEMP,PP,ZZTD,ZZHD,ZZWD)
-
-IF ( CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' ) THEN
- ! Gultepe formulation
- ZVISIGUL(:,:,:) = 10E5 !default value
- WHERE ( (PR(:,:,:,2) /=0. ) .AND. (PSV(:,:,:,NSV_C2R2BEG+1) /=0. ) )
- ZVISIGUL(:,:,:) =1.002/(PR(:,:,:,2)*PRHODREF(:,:,:)*PSV(:,:,:,NSV_C2R2BEG+1))**0.6473
- END WHERE
-END IF
-
-IF ( CCLOUD /= 'NONE' .AND. CCLOUD /= 'REVE' ) THEN
- ! Kunkel formulation
- ZVISIKUN(:,:,:) = 10E5 !default value
- WHERE ( PR(:,:,:,2) /=0 )
- ZVISIKUN(:,:,:) =0.027/(10**(-8)+(PR(:,:,:,2)/(1+PR(:,:,:,2))*PRHODREF(:,:,:)*1000))**0.88
- END WHERE
-END IF
-!
-PROFILER: DO JP = 1, NUMBPROFILER_LOC
- ZZ(:) = STATPROF_INTERP_3D( TPROFILERS(JP), PZ )
- ZRHOD(:) = STATPROF_INTERP_3D( TPROFILERS(JP), PRHODREF )
- ZPRES(:) = STATPROF_INTERP_3D( TPROFILERS(JP), PP )
- ZU_PROFILER(:) = STATPROF_INTERP_3D_U( TPROFILERS(JP), PU )
- ZV_PROFILER(:) = STATPROF_INTERP_3D_V( TPROFILERS(JP), PV )
- ZGAM = (XRPK * (TPROFILERS(JP)%XLON - XLON0) - XBETA)*(XPI/180.)
- ZFF(:) = SQRT(ZU_PROFILER(:)**2 + ZV_PROFILER(:)**2)
- DO JK=1,IKU
- IF (ZU_PROFILER(JK) >=0. .AND. ZV_PROFILER(JK) > 0.) &
- ZDD(JK) = ATAN(ABS(ZU_PROFILER(JK)/ZV_PROFILER(JK))) * 180./XPI + 180.
- IF (ZU_PROFILER(JK) >0. .AND. ZV_PROFILER(JK) <= 0.) &
- ZDD(JK) = ATAN(ABS(ZV_PROFILER(JK)/ZU_PROFILER(JK))) * 180./XPI + 270.
- IF (ZU_PROFILER(JK) <=0. .AND. ZV_PROFILER(JK) < 0.) &
- ZDD(JK) = ATAN(ABS(ZU_PROFILER(JK)/ZV_PROFILER(JK))) * 180./XPI
- IF (ZU_PROFILER(JK) <0. .AND. ZV_PROFILER(JK) >= 0.) &
- ZDD(JK) = ATAN(ABS(ZV_PROFILER(JK)/ZU_PROFILER(JK))) * 180./XPI + 90.
- IF (ZU_PROFILER(JK) == 0. .AND. ZV_PROFILER(JK) == 0.) &
- ZDD(JK) = XUNDEF
- END DO
- ! GPS IWV and ZTD
- XZS_GPS=TPROFILERS(JP)%XZ
- IF ( ABS( ZZ(IKB)-XZS_GPS ) < 150 ) THEN ! distance between real and model orography ok
- ZRV(:) = STATPROF_INTERP_3D( TPROFILERS(JP), PR(:,:,:,1) )
- ZT(:) = STATPROF_INTERP_3D( TPROFILERS(JP), ZTEMP )
- ZE(:) = ZPRES(:)*ZRV(:)/(ZRDSRV+ZRV(:))
- ZTV(:) = STATPROF_INTERP_3D( TPROFILERS(JP), ZTEMPV )
- ZZTD_PROFILER = STATPROF_INTERP_2D( TPROFILERS(JP), ZZTD )
- ZZHD_PROFILER = STATPROF_INTERP_2D( TPROFILERS(JP), ZZHD )
- ZZWD_PROFILER = STATPROF_INTERP_2D( TPROFILERS(JP), ZZWD )
- ZIWV = 0.
- DO JK=IKB,IKE
- ZIWV=ZIWV+ZRHOD(JK)*ZRV(JK)*(ZZ(JK+1)-ZZ(JK))
- END DO
- IF (ZZ(IKB) < XZS_GPS) THEN ! station above the model orography
- DO JK=IKB+1,IKE
- IF ( ZZ(JK) < XZS_GPS) THEN ! whole layer to remove
- ZZHDR=( 1.E-6 * ZK1 * ZPRES(JK-1) * ( ZZ(JK) - ZZ(JK-1) ) / ZTV(JK-1))
- ZZWDR=( 1.E-6 * ( (ZK2-ZRDSRV*ZK1) + ( ZK3/ZT(JK-1) ) ) * &
- ZE(JK-1)* ( ZZ(JK) - ZZ(JK-1) ) / ZT(JK-1) )
- ZZHD_PROFILER=ZZHD_PROFILER-ZZHDR
- ZZWD_PROFILER=ZZWD_PROFILER-ZZWDR
- ZZTD_PROFILER=ZZTD_PROFILER-ZZHDR-ZZWDR
- ELSE ! partial layer to remove
- ZZHDR=( 1.E-6 * ZK1 * ZPRES(JK-1) * ( XZS_GPS - ZZ(JK-1) ) / ZTV(JK-1))
- ZZWDR=( 1.E-6 * ( (ZK2-ZRDSRV*ZK1) + ( ZK3/ZT(JK-1) ) ) * &
- ZE(JK-1)* ( XZS_GPS - ZZ(JK-1) ) / ZT(JK-1) )
- ZZHD_PROFILER=ZZHD_PROFILER-ZZHDR
- ZZWD_PROFILER=ZZWD_PROFILER-ZZWDR
- ZZTD_PROFILER=ZZTD_PROFILER-ZZHDR-ZZWDR
- EXIT
- END IF
- END DO
- ELSE ! station below the model orography
-! Extrapolate variables below the model orography assuming constant T&Tv gradients,
-! constant rv and hydrostatic law
- ZZHATM(:)=0.5*(ZZ(1:IKU-1)+ZZ(2:IKU))
- ZZM_STAT=0.5*(XZS_GPS+ZZ(IKB))
- ZTM_STAT=ZT(IKB) + ( (ZZM_STAT-ZZHATM(IKB))*&
- ( ZT(IKB)- ZT(IKB+1) )/(ZZHATM(IKB)-ZZHATM(IKB+1)) )
- ZTV_STAT=ZTV(IKB) + ( (ZZM_STAT-ZZHATM(IKB))*&
- ( ZTV(IKB)- ZTV(IKB+1) )/(ZZHATM(IKB)-ZZHATM(IKB+1)) )
- ZPM_STAT = ZPRES(IKB) * EXP(XG *(ZZM_STAT-ZZHATM(IKB))&
- /(XRD* 0.5 *(ZTV_STAT+ZTV(IKB))))
- ZEM_STAT = ZPM_STAT * ZRV(IKB) / ( ZRDSRV + ZRV(IKB) )
-! add contribution below the model orography
- ZZHDR=( 1.E-6 * ZK1 * ZPM_STAT * ( ZZ(IKB) - XZS_GPS ) / ZTV_STAT )
- ZZWDR=( 1.E-6 * ( (ZK2-ZRDSRV*ZK1) + (ZK3/ZTM_STAT) )&
- * ZEM_STAT* ( ZZ(IKB) - XZS_GPS ) / ZTM_STAT )
- ZZHD_PROFILER=ZZHD_PROFILER+ZZHDR
- ZZWD_PROFILER=ZZWD_PROFILER+ZZWDR
- ZZTD_PROFILER=ZZTD_PROFILER+ZZHDR+ZZWDR
- END IF
- TPROFILERS(JP)%XIWV(IN)= ZIWV
- TPROFILERS(JP)%XZTD(IN)= ZZTD_PROFILER
- TPROFILERS(JP)%XZWD(IN)= ZZWD_PROFILER
- TPROFILERS(JP)%XZHD(IN)= ZZHD_PROFILER
- ELSE
- CMNHMSG(1) = 'altitude of profiler ' // TRIM( TPROFILERS(JP)%CNAME ) // ' is too far from orography'
- CMNHMSG(2) = 'some variables are therefore not computed (IWV, ZTD, ZWD, ZHD)'
- CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'PROFILER_n', OLOCAL = .TRUE. )
- TPROFILERS(JP)%XIWV(IN)= XUNDEF
- TPROFILERS(JP)%XZTD(IN)= XUNDEF
- TPROFILERS(JP)%XZWD(IN)= XUNDEF
- TPROFILERS(JP)%XZHD(IN)= XUNDEF
- END IF
- TPROFILERS(JP)%XZON (IN,:) = ZU_PROFILER(:) * COS(ZGAM) + ZV_PROFILER(:) * SIN(ZGAM)
- TPROFILERS(JP)%XMER (IN,:) = - ZU_PROFILER(:) * SIN(ZGAM) + ZV_PROFILER(:) * COS(ZGAM)
- TPROFILERS(JP)%XFF (IN,:) = ZFF(:)
- TPROFILERS(JP)%XDD (IN,:) = ZDD(:)
- TPROFILERS(JP)%XW (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), PW )
- TPROFILERS(JP)%XTH (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), PTH )
- TPROFILERS(JP)%XTHV (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), ZTHV )
- IF ( CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' ) TPROFILERS(JP)%XVISIGUL(IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), ZVISIGUL )
- IF ( CCLOUD /= 'NONE' .AND. CCLOUD /= 'REVE' ) TPROFILERS(JP)%XVISIKUN(IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), ZVISIKUN )
- TPROFILERS(JP)%XZZ (IN,:) = ZZ(:)
- TPROFILERS(JP)%XRHOD(IN,:) = ZRHOD(:)
- IF ( CCLOUD == 'ICE3' .OR. CCLOUD == 'ICE4' ) &
- TPROFILERS(JP)%XCIZ(IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), PCIT )
-! add RARE
- ! initialization CRARE and CRARE_ATT + LWC and IWC
- TPROFILERS(JP)%XCRARE(IN,:) = 0.
- TPROFILERS(JP)%XCRARE_ATT(IN,:) = 0.
- TPROFILERS(JP)%XLWCZ (IN,:) = 0.
- TPROFILERS(JP)%XIWCZ (IN,:) = 0.
- IF (CCLOUD=="LIMA" .OR. CCLOUD=="ICE3" ) THEN ! only for ICE3 and LIMA
- TPROFILERS(JP)%XLWCZ (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), (PR(:,:,:,2)+PR(:,:,:,3))*PRHODREF(:,:,:) )
- TPROFILERS(JP)%XIWCZ (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), (PR(:,:,:,4)+PR(:,:,:,5)+PR(:,:,:,6))*PRHODREF(:,:,:) )
- ZTEMPZ(:)=STATPROF_INTERP_3D( TPROFILERS(JP), ZTEMP(:,:,:) )
- ZRHODREFZ(:)=STATPROF_INTERP_3D( TPROFILERS(JP), PRHODREF(:,:,:) )
- ZCIT(:)=STATPROF_INTERP_3D( TPROFILERS(JP), PCIT(:,:,:) )
- IF (CCLOUD=="LIMA") THEN
- ZCCI(:)=STATPROF_INTERP_3D( TPROFILERS(JP), PSV(:,:,:,NSV_LIMA_NI) )
- ZCCR(:)=STATPROF_INTERP_3D( TPROFILERS(JP), PSV(:,:,:,NSV_LIMA_NR) )
- ZCCC(:)=STATPROF_INTERP_3D( TPROFILERS(JP), PSV(:,:,:,NSV_LIMA_NC) )
- END IF
- DO JLOOP=3,6
- ZRZ(:,JLOOP)=STATPROF_INTERP_3D( TPROFILERS(JP), PR(:,:,:,JLOOP) )
- END DO
- IF (CSURF=="EXTE") THEN
- DO JK=1,IKU
- ZRZ(JK,2)=STATPROF_INTERP_2D( TPROFILERS(JP), PR(:,:,JK,2)*PSEA(:,:) ) ! becomes cloud mixing ratio over sea
- ZRZ(JK,7)=STATPROF_INTERP_2D( TPROFILERS(JP), PR(:,:,JK,2)*(1.-PSEA(:,:)) ) ! becomes cloud mixing ratio over land
- END DO
- ELSE
- ZRZ(:,2)=STATPROF_INTERP_3D( TPROFILERS(JP), PR(:,:,:,2) )
- ZRZ(:,7)=0.
- END IF
- ALLOCATE(ZAELOC(IKU))
- !
- ZAELOC(:)=0.
- ! initialization of quadrature points and weights
- ALLOCATE(ZX(JPTS_GAULAG),ZW(JPTS_GAULAG))
- CALL GAULAG(JPTS_GAULAG,ZX,ZW) ! for integration over diameters
- ! initialize minimum values
- ALLOCATE(ZRTMIN(SIZE(PR,4)+1))
- IF (CCLOUD == 'LIMA') THEN
- ZRTMIN(2)=XRTMIN_L(2) ! cloud water over sea
- ZRTMIN(3)=XRTMIN_L(3)
- ZRTMIN(4)=XRTMIN_L(4)
- ZRTMIN(5)=1E-10
- ZRTMIN(6)=XRTMIN_L(6)
- ZRTMIN(7)=XRTMIN_L(2) ! cloud water over land
- ELSE
- ZRTMIN(2)=XRTMIN_I(2) ! cloud water over sea
- ZRTMIN(3)=XRTMIN_I(3)
- ZRTMIN(4)=XRTMIN_I(4)
- ZRTMIN(5)=1E-10
- ZRTMIN(6)=XRTMIN_I(6)
- ZRTMIN(7)=XRTMIN_I(2) ! cloud water over land
- END IF
- ! compute cloud radar reflectivity from vertical profiles of temperature
- ! and mixing ratios
- DO JK=1,IKU
- QMW=SQRT(QEPSW(ZTEMPZ(JK),XLIGHTSPEED/XLAM_CRAD))
- QMI=SQRT(QEPSI(ZTEMPZ(JK),XLIGHTSPEED/XLAM_CRAD))
- DO JLOOP=2,7
- IF (CCLOUD == 'LIMA') THEN
- GCALC=(ZRZ(JK,JLOOP)>ZRTMIN(JLOOP).AND.(JLOOP.NE.4.OR.ZCCI(JK)>0.).AND.&
- (JLOOP.NE.3.OR.ZCCR(JK)>0.).AND.((JLOOP.NE.2.AND.JLOOP.NE.7).OR.ZCCC(JK)>0.))
- ELSE
- GCALC=(ZRZ(JK,JLOOP)>ZRTMIN(JLOOP).AND.(JLOOP.NE.4.OR.ZCIT(JK)>0.))
- END IF
- IF (GCALC) THEN
- SELECT CASE(JLOOP)
- CASE(2) ! cloud water over sea
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAC_L
- ZB=XBC_L
- ZCC=ZCCC(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAC_L
- ZNU=XNUC_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ELSE
- ZA=XAC_I
- ZB=XBC_I
- ZCC=XCONC_SEA
- ZCX=0.
- ZALPHA=XALPHAC2_I
- ZNU=XNUC2_I
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- END IF
- CASE(3) ! rain water
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAR_L
- ZB=XBR_L
- ZCC=ZCCR(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAR_L
- ZNU=XNUR_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ELSE
- ZA=XAR_I
- ZB=XBR_I
- ZCC=XCCR_I
- ZCX=-1.
- ZALPHA=XALPHAR_I
- ZNU=XNUR_I
- ZLB=XLBR_I
- ZLBEX=XLBEXR_I
- END IF
- CASE(4) ! pristine ice
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAI_L
- ZB=XBI_L
- ZCC=ZCCI(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAI_L
- ZNU=XNUI_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX) ! because ZCC not included in XLBI
- ZFW=0
- ELSE
- ZA=XAI_I
- ZB=XBI_I
- ZCC=ZCIT(JK)
- ZCX=0.
- ZALPHA=XALPHAI_I
- ZNU=XNUI_I
- ZLBEX=XLBEXI_I
- ZLB=XLBI_I*ZCC**(-ZLBEX) ! because ZCC not included in XLBI
- ZFW=0
- END IF
- CASE(5) ! snow
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAS_L
- ZB=XBS_L
- ZCC=XCCS_L
- ZCX=XCXS_L
- ZALPHA=XALPHAS_L
- ZNU=XNUS_L
- ZNS=XNS_L
- ZLB=XLBS_L
- ZLBEX=XLBEXS_L
- ZFW=0
- ELSE
- ZA=XAS_I
- ZB=XBS_I
- ZCC=XCCS_I
- ZCX=XCXS_I
- ZALPHA=XALPHAS_I
- ZNU=XNUS_I
- ZNS=XNS_I
- ZLB=XLBS_I
- ZLBEX=XLBEXS_I
- ZFW=0
- END IF
- CASE(6) ! graupel
- !If temperature between -10 and 10B0C and Mr and Mg over min
- !threshold: melting graupel
- ! with liquid water fraction Fw=Mr/(Mr+Mg) else dry graupel
- ! (Fw=0)
- IF( ZTEMPZ(JK) > XTT-10 .AND. ZTEMPZ(JK) < XTT+10 &
- .AND. ZRZ(JK,3) > ZRTMIN(3) ) THEN
- ZFW=ZRZ(JK,3)/(ZRZ(JK,3)+ZRZ(JK,JLOOP))
- ELSE
- ZFW=0
- END IF
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAG_L
- ZB=XBG_L
- ZCC=XCCG_L
- ZCX=XCXG_L
- ZALPHA=XALPHAG_L
- ZNU=XNUG_L
- ZLB=XLBG_L
- ZLBEX=XLBEXG_L
- ELSE
- ZA=XAG_I
- ZB=XBG_I
- ZCC=XCCG_I
- ZCX=XCXG_I
- ZALPHA=XALPHAG_I
- ZNU=XNUG_I
- ZLB=XLBG_I
- ZLBEX=XLBEXG_I
- END IF
- CASE(7) ! cloud water over land
- IF (CCLOUD == 'LIMA') THEN
- ZA=XAC_L
- ZB=XBC_L
- ZCC=ZCCC(JK)*ZRHODREFZ(JK)
- ZCX=0.
- ZALPHA=XALPHAC_L
- ZNU=XNUC_L
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- ELSE
- ZA=XAC_I
- ZB=XBC_I
- ZCC=XCONC_LAND
- ZCX=0.
- ZALPHA=XALPHAC_I
- ZNU=XNUC_I
- ZLBEX=1.0/(ZCX-ZB)
- ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
- END IF
- END SELECT
- IF ( JLOOP == 5 .AND. CCLOUD=='LIMA'.AND.LSNOW_T_L ) THEN
- IF (ZTEMPZ(JK)>XTT-10.) THEN
- ZLBDA = MAX(MIN(XLBDAS_MAX_L, 10**(14.554-0.0423*ZTEMPZ(JK))),XLBDAS_MIN_L)*XTRANS_MP_GAMMAS_L
- ELSE
- ZLBDA = MAX(MIN(XLBDAS_MAX_L, 10**(6.226-0.0106*ZTEMPZ(JK))),XLBDAS_MIN_L)*XTRANS_MP_GAMMAS_L
- END IF
- ZN=ZNS*ZRHODREFZ(JK)*ZRZ(JK,JLOOP)*ZLBDA**ZB
- ELSE IF (JLOOP.EQ.5 .AND. (CCLOUD=='ICE3'.AND.LSNOW_T_I) ) THEN
- IF (ZTEMPZ(JK)>XTT-10.) THEN
- ZLBDA = MAX(MIN(XLBDAS_MAX_I, 10**(14.554-0.0423*ZTEMPZ(JK))),XLBDAS_MIN_I)*XTRANS_MP_GAMMAS_I
- ELSE
- ZLBDA = MAX(MIN(XLBDAS_MAX_I, 10**(6.226-0.0106*ZTEMPZ(JK))),XLBDAS_MIN_I)*XTRANS_MP_GAMMAS_I
- END IF
- ZN=ZNS*ZRHODREFZ(JK)*ZRZ(JK,JLOOP)*ZLBDA**ZB
- ELSE
- ZLBDA=ZLB*(ZRHODREFZ(JK)*ZRZ(JK,JLOOP))**ZLBEX
- ZN=ZCC*ZLBDA**ZCX
- END IF
- ZREFLOC=0.
- ZAETMP=0.
- DO JJ=1,JPTS_GAULAG ! Gauss-Laguerre quadrature
- ZDELTA_EQUIV=ZX(JJ)**(1./ZALPHA)/ZLBDA
- SELECT CASE(JLOOP)
- CASE(2,3,7)
- QM=QMW
- CASE(4,5,6)
- ! pristine ice, snow, dry graupel
- ZRHOHYD=MIN(6.*ZA*ZDELTA_EQUIV**(ZB-3.)/XPI,.92*XRHOLW)
- QM=sqrt(MG(QMI**2,CMPLX(1,0),ZRHOHYD/.92/XRHOLW))
- ! water inclusions in ice in air
- QEPSWI=MG(QMW**2,QM**2,ZFW)
- ! ice in air inclusions in water
- QEPSIW=MG(QM**2,QMW**2,1.-ZFW)
- !MG weighted rule (Matrosov 2008)
- IF(ZFW .LT. 0.37) THEN
- ZFPW=0
- ELSE IF(ZFW .GT. 0.63) THEN
- ZFPW=1
- ELSE
- ZFPW=(ZFW-0.37)/(0.63-0.37)
- ENDIF
- QM=sqrt(QEPSWI*(1.-ZFPW)+QEPSIW*ZFPW)
- END SELECT
- CALL BHMIE(XPI/XLAM_CRAD*ZDELTA_EQUIV,QM,ZQEXT,ZQSCA,ZQBACK)
- ZREFLOC=ZREFLOC+ZQBACK*ZX(JJ)**(ZNU-1)*ZDELTA_EQUIV**2*ZW(JJ)
- ZAETMP =ZAETMP +ZQEXT *ZX(JJ)**(ZNU-1)*ZDELTA_EQUIV**2*ZW(JJ)
- END DO
- ZREFLOC=ZREFLOC*(XLAM_CRAD/XPI)**4*ZN/(4.*GAMMA(ZNU)*.93)
- ZAETMP=ZAETMP * XPI *ZN/(4.*GAMMA(ZNU))
- TPROFILERS(JP)%XCRARE(IN,JK)=TPROFILERS(JP)%XCRARE(IN,JK)+ZREFLOC
- ZAELOC(JK)=ZAELOC(JK)+ZAETMP
- END IF
- END DO
- END DO
- ! apply attenuation
- ALLOCATE(ZZMZ(IKU))
- ZZMZ = ZZ(:) ! STATPROF_INTERP_3D( TPROFILERS(JP), ZZM(:,:,:) )
-! ZZMZ(1)=ZZM_STAT
- ! zenith
- ZAETOT=1.
- DO JK = 2,IKU
- ! attenuation from ZAELOC(JK) and ZAELOC(JK-1)
- ZAETOT=ZAETOT*EXP(-(ZAELOC(JK-1)+ZAELOC(JK))*(ZZMZ(JK)-ZZMZ(JK-1)))
- TPROFILERS(JP)%XCRARE_ATT(IN,JK)=TPROFILERS(JP)%XCRARE(IN,JK)*ZAETOT
- END DO
- DEALLOCATE(ZZMZ,ZAELOC)
- ! m^3 b mm^6/m^3 b dBZ
- WHERE(TPROFILERS(JP)%XCRARE(IN,:)>0)
- TPROFILERS(JP)%XCRARE(IN,:)=10.*LOG10(1.E18*TPROFILERS(JP)%XCRARE(IN,:))
- ELSEWHERE
- TPROFILERS(JP)%XCRARE(IN,:)=XUNDEF
- END WHERE
- WHERE(TPROFILERS(JP)%XCRARE_ATT(IN,:)>0)
- TPROFILERS(JP)%XCRARE_ATT(IN,:)=10.*LOG10(1.E18*TPROFILERS(JP)%XCRARE_ATT(IN,:))
- ELSEWHERE
- TPROFILERS(JP)%XCRARE_ATT(IN,:)=XUNDEF
- END WHERE
- DEALLOCATE(ZX,ZW,ZRTMIN)
- END IF ! end LOOP ICE3
-! end add RARE
-!!
- TPROFILERS(JP)%XP (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), PP )
- !
- DO JSV=1,SIZE(PR,4)
- TPROFILERS(JP)%XR (IN,:,JSV) = STATPROF_INTERP_3D( TPROFILERS(JP), PR(:,:,:,JSV) )
- END DO
- ZWORK(:,:,:,:)=PSV(:,:,:,:)
- ZWORK(:,:,1,:)=PSV(:,:,2,:)
- DO JSV=1,SIZE(PSV,4)
- TPROFILERS(JP)%XSV (IN,:,JSV) = STATPROF_INTERP_3D( TPROFILERS(JP), ZWORK(:,:,:,JSV) )
- END DO
- ZWORK2(:,:,:,:) = 0.
- DO JK=IKB,IKE
- IKRAD = JK - JPVEXT
- ZWORK2(:,:,JK,:)=PAER(:,:,IKRAD,:)
- END DO
- DO JSV=1,SIZE(PAER,4)
- TPROFILERS(JP)%XAER(IN,:,JSV) = STATPROF_INTERP_3D( TPROFILERS(JP), ZWORK2(:,:,:,JSV) )
- END DO
- IF (SIZE(PTKE)>0) TPROFILERS(JP)%XTKE (IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), PTKE )
- !
- IF (LDIAG_IN_RUN) THEN
- TPROFILERS(JP)%XT2M (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_T2M )
- TPROFILERS(JP)%XQ2M (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_Q2M )
- TPROFILERS(JP)%XHU2M (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_HU2M )
- TPROFILERS(JP)%XZON10M(IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_ZON10M )
- TPROFILERS(JP)%XMER10M(IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_MER10M )
- TPROFILERS(JP)%XRN (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_RN )
- TPROFILERS(JP)%XH (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_H )
- TPROFILERS(JP)%XLE (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_LE )
- TPROFILERS(JP)%XLEI (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_LEI )
- TPROFILERS(JP)%XGFLUX (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_GFLUX )
- IF (CRAD /= 'NONE') THEN
- TPROFILERS(JP)%XSWD (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_SWD )
- TPROFILERS(JP)%XSWU (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_SWU )
- TPROFILERS(JP)%XLWD (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_LWD )
- TPROFILERS(JP)%XLWU (IN) = STATPROF_INTERP_2D( TPROFILERS(JP), XCURRENT_LWU )
- END IF
- TPROFILERS(JP)%XTKE_DISS(IN,:) = STATPROF_INTERP_3D( TPROFILERS(JP), XCURRENT_TKE_DISS )
- END IF
-END DO PROFILER
-!
-!----------------------------------------------------------------------------
-!
-END SUBROUTINE PROFILER_n
diff --git a/src/mesonh/ext/radar_scattering.f90 b/src/mesonh/ext/radar_scattering.f90
deleted file mode 100644
index 047cb5800666f7797f23594b33835e2a59d99dd9..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/radar_scattering.f90
+++ /dev/null
@@ -1,2088 +0,0 @@
-!MNH_LIC Copyright 2004-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ######spl
- MODULE MODI_RADAR_SCATTERING
-! #############################
-!
-INTERFACE
- SUBROUTINE RADAR_SCATTERING(PT_RAY,PRHODREF_RAY,PR_RAY,PI_RAY,PCIT_RAY,PS_RAY,PG_RAY,PVDOP_RAY, &
- PELEV,PX_H,PX_V,PW_H,PW_V,PZE,PBU_MASK_RAY,PCR_RAY,PH_RAY)
-REAL, DIMENSION(:,:,:,:,:,:),INTENT(IN) :: PT_RAY ! temperature interpolated along the rays
-REAL, DIMENSION(:,:,:,:,:,:),INTENT(IN) :: PRHODREF_RAY !
-REAL, DIMENSION(:,:,:,:,:,:),INTENT(IN) :: PR_RAY ! rainwater mixing ratio interpolated along the rays
-REAL, DIMENSION(:,:,:,:,:,:),INTENT(IN) :: PI_RAY ! pristine ice mixing ratio interpolated along the rays
-REAL, DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PCIT_RAY ! pristine ice concentration interpolated along the rays
-REAL, DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PS_RAY !aggregates mixing ratio interpolated along the rays
-REAL, DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PG_RAY ! graupel mixing ratio interpolated along the rays
-REAL, DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PVDOP_RAY !Doppler radial velocity interpolated along the rays
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PELEV ! elevation
-REAL, DIMENSION(:), INTENT(IN) :: PX_H ! Gaussian horizontal nodes
-REAL, DIMENSION(:), INTENT(IN) :: PX_V ! Gaussian vertical nodes
-REAL, DIMENSION(:), INTENT(IN) :: PW_H ! Gaussian horizontal weights
-REAL, DIMENSION(:), INTENT(IN) :: PW_V ! Gaussian vertical weights
-REAL,DIMENSION(:,:,:,:,:), INTENT(INOUT) :: PZE ! 5D matrix (iradar, ielev, iaz, irangestep, ivar) containing the radar variables that will be calculated
-!in polar or cartesian projection (same projection as the observation grid)
-! convective/stratiform
-REAL, DIMENSION(:,:,:,:,:,:),INTENT(INOUT) :: PBU_MASK_RAY
-REAL, DIMENSION(:,:,:,:,:,:),OPTIONAL,INTENT(IN) :: PCR_RAY ! rainwater concentration interpolated along the rays
-REAL, DIMENSION(:,:,:,:,:,:),OPTIONAL,INTENT(IN) :: PH_RAY ! hail mixing ratio interpolated along the rays
- END SUBROUTINE RADAR_SCATTERING
-END INTERFACE
-END MODULE MODI_RADAR_SCATTERING
-!
-! ######spl
- SUBROUTINE RADAR_SCATTERING(PT_RAY,PRHODREF_RAY,PR_RAY,PI_RAY,PCIT_RAY, &
- PS_RAY,PG_RAY,PVDOP_RAY,PELEV,PX_H,PX_V,PW_H,PW_V,PZE,PBU_MASK_RAY,PCR_RAY,PH_RAY)
-! ##############################
-!
-!!**** *RADAR_SCATTERING* - computes radar reflectivities.
-!!
-!! PURPOSE
-!! -------
-!! Compute equivalent reflectivities of a mixed phase cloud.
-!!
-!!** METHOD
-!! ------
-!! The reflectivities are computed using the n(D) * sigma(D) formula. The
-!! equivalent reflectiviy is the sum of the reflectivity produced by the
-!! the raindrops and the equivalent reflectivities of the ice crystals.
-!! The latter are computed using the mass-equivalent diameter.
-!! Four types of diffusion are possible : Rayleigh, Mie, T-matrix, and
-!! Rayleigh-Gans (Kerker, 1969, Chap. 10; Battan, 1973, Sec. 5.4; van de
-!! Hulst, 1981, Sec. 6.32; Doviak and Zrnic, 1993, p. 249; Bringi and
-!! Chandrasekar, 2001, Chap. 2).
-!! The integration over diameters for Mie and T-matrix methods is done by
-!! using Gauss-Laguerre quadrature (Press et al. 1986). Attenuation is taken
-!! into account by computing the extinction efficiency and correcting
-!! reflectivities along the beam path.
-!! Gaussian quadrature methods are used to model the beam broadening (Gauss-
-!! Hermite or Gauss-Legendre, see Press et al. 1986).
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CST
-!! XLIGHTSPEED
-!! XPI
-!! Module MODD_ARF
-!!
-!! REFERENCE
-!! ---------
-!! Press, W. H., B. P. Flannery, S. A. Teukolsky et W. T. Vetterling, 1986:
-!! Numerical Recipes: The Art of Scientific Computing. Cambridge University
-!! Press, 818 pp.
-!! Probert-Jones, J. R., 1962 : The radar equation in meteorology. Quart.
-!! J. Roy. Meteor. Soc., 88, 485-495.
-!!
-!! AUTHOR
-!! ------
-!! O. Caumont & V. Ducrocq * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 26/03/2004
-!! O. Caumont 09/09/2009 minor changes to compute radial velocities when no
-!! hydrometeors so as to emulate wind lidar
-!! O. Caumont 21/12/2009 correction of bugs to compute KDP.
-!! O. Caumont 11/02/2010 thresholding and conversion from linear to
-!! log values after interpolation instead of before.
-!! G.Tanguy 25/03/2010 Introduction of MODD_TMAT and ALLOCATE/DEALLOCATE
-!! C.Augros 2014 New simulator for T matrice
-!! G.Delautier 10/2014 : Mise a jour simulateur T-matrice pour LIMA
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LUNIT
-USE MODD_PARAMETERS
-USE MODD_PARAM_ICE_n, ONLY: LSNOW_T_I=>LSNOW_T
-USE MODD_RAIN_ICE_DESCR_n, ONLY: XALPHAR_I=>XALPHAR,XNUR_I=>XNUR,XDR_I=>XDR,XLBEXR_I=>XLBEXR,&
- XLBR_I=>XLBR,XCCR_I=>XCCR,XBR_I=>XBR,XCR_I=>XCR,&
- XALPHAS_I=>XALPHAS,XNUS_I=>XNUS,XDS_I=>XDS,XLBEXS_I=>XLBEXS,&
- XLBS_I=>XLBS,XCCS_I=>XCCS,XNS_I=>XNS,XAS_I=>XAS,XBS_I=>XBS,XCXS_I=>XCXS,XCS_I=>XCS,&
- XALPHAG_I=>XALPHAG,XNUG_I=>XNUG,XDG_I=>XDG,XLBEXG_I=>XLBEXG,&
- XLBG_I=>XLBG,XCCG_I=>XCCG,XAG_I=>XAG,XBG_I=>XBG,XCXG_I=>XCXG,XCG_I=>XCG,&
- XALPHAH_I=>XALPHAH,XNUH_I=>XNUH,XDH_I=>XDH,XLBEXH_I=>XLBEXH,&
- XLBH_I=>XLBH,XCCH_I=>XCCH,XAH_I=>XAH,XBH_I=>XBH,XCXH_I=>XCXH,XCH_I=>XCH,&
- XALPHAI_I=>XALPHAI,XNUI_I=>XNUI,XDI_I=>XDI,XLBEXI_I=>XLBEXI,&
- XLBI_I=>XLBI,XAI_I=>XAI,XBI_I=>XBI,XC_I_I=>XC_I,&
- XRTMIN_I=>XRTMIN, &
- XLBDAS_MAX_I=>XLBDAS_MAX,XLBDAS_MIN_I=>XLBDAS_MIN,XTRANS_MP_GAMMAS_I=>XTRANS_MP_GAMMAS
-!!LIMA
-USE MODD_PARAM_LIMA_WARM, ONLY: XDR_L=>XDR,XLBEXR_L=>XLBEXR,XLBR_L=>XLBR,XBR_L=>XBR,XCR_L=>XCR
-USE MODD_PARAM_LIMA_COLD, ONLY: XDI_L=>XDI,XLBEXI_L=>XLBEXI,XLBI_L=>XLBI,XAI_L=>XAI,XBI_L=>XBI,XC_I_L=>XC_I,&
- XDS_L=>XDS,XLBEXS_L=>XLBEXS,XLBS_L=>XLBS,XCCS_L=>XCCS,XNS_L=>XNS,XAS_L=>XAS,XBS_L=>XBS,&
- XCXS_L=>XCXS,XCS_L=>XCS,&
- XLBDAS_MAX_L=>XLBDAS_MAX,XLBDAS_MIN_L=>XLBDAS_MIN,XTRANS_MP_GAMMAS_L=>XTRANS_MP_GAMMAS
-
-USE MODD_PARAM_LIMA_MIXED, ONLY:XDG_L=>XDG,XLBEXG_L=>XLBEXG,XLBG_L=>XLBG,XCCG_L=>XCCG,XAG_L=>XAG,XBG_L=>XBG,XCXG_L=>XCXG,XCG_L=>XCG
-USE MODD_PARAM_LIMA, ONLY: XALPHAR_L=>XALPHAR,XNUR_L=>XNUR,XALPHAS_L=>XALPHAS,XNUS_L=>XNUS,&
- XALPHAG_L=>XALPHAG,XNUG_L=>XNUG, XALPHAI_L=>XALPHAI,XNUI_L=>XNUI,&
- XRTMIN_L=>XRTMIN, LSNOW_T_L=>LSNOW_T
-!!LIMA
-USE MODD_RADAR, ONLY:XLAM_RAD,XSTEP_RAD,NBELEV,NDIFF,LATT,NPTS_GAULAG,LQUAD,XVALGROUND,NDGS, &
- LFALL,LWBSCS,LWREFL,XREFLVDOPMIN,XREFLMIN,LSNRT,XSNRMIN
-USE MODD_TMAT
-!
-USE MODE_ARF
-USE MODE_FSCATTER
-USE MODE_READTMAT
-USE MODE_FGAU , ONLY:GAULAG
-USE MODI_GAMMA, ONLY:GAMMA
-!
-USE MODD_LUNIT
-USE MODE_IO_FILE, ONLY: IO_File_close, IO_File_open
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
-USE MODE_MSG
-
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-!
-REAL,DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PT_RAY ! temperature interpolated along the rays
-REAL,DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PRHODREF_RAY !
-REAL,DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PR_RAY ! rainwater mixing ratio interpolated along the rays
-REAL,DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PI_RAY ! pristine ice mixing ratio interpolated along the rays
-REAL,DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PCIT_RAY !pristine ice concentration interpolated along the rays
-REAL,DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PS_RAY !aggregates mixing ratio interpolated along the rays
-REAL,DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PG_RAY ! graupel mixing ratio interpolated along the rays
-REAL,DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PVDOP_RAY !Doppler radial velocity interpolated along the rays
-REAL,DIMENSION(:,:,:,:), INTENT(IN) :: PELEV ! elevation
-REAL,DIMENSION(:), INTENT(IN) :: PX_H ! Gaussian horizontal nodes
-REAL,DIMENSION(:), INTENT(IN) :: PX_V ! Gaussian vertical nodes
-REAL,DIMENSION(:), INTENT(IN) :: PW_H ! Gaussian horizontal weights
-REAL,DIMENSION(:), INTENT(IN) :: PW_V ! Gaussian vertical weights
-REAL,DIMENSION(:,:,:,:,:), INTENT(INOUT) :: PZE ! gate equivalent reflectivity factor (horizontal & vertical)
-! convective/stratiform
-REAL,DIMENSION(:,:,:,:,:,:),INTENT(INOUT) :: PBU_MASK_RAY
-! /convective/stratiform
-REAL, DIMENSION(:,:,:,:,:,:),OPTIONAL,INTENT(IN) :: PCR_RAY ! rainwater concentration interpolated along the rays
-REAL, DIMENSION(:,:,:,:,:,:),OPTIONAL,INTENT(IN) :: PH_RAY ! hail mixing ratio interpolated along the rays
-!
-!* 0.2 Declarations of local variables :
-!
-REAL, DIMENSION(:,:,:,:,:,:,:),ALLOCATABLE :: ZREFL
-!1: ZHH (dBZ), 2: ZDR, 3: KDP, 4: CSR (0 pr air clair, 1 pour stratiforme, 2 pour convectif)
-!5-8: ZER, ZEI, ZES,ZEG
-!9 : VRU (vitesse radiale)
-!10-13 : AER, AEI, AES, AEG
-!14-17: ATR, ATI, ATS, ATG
-!18-20: RhoHV, PhiDP, DeltaHV
-
-REAL, DIMENSION(:,:,:,:,:,:,:),ALLOCATABLE :: ZAELOC ! local attenuation
-REAL, DIMENSION(:,:,:),ALLOCATABLE :: ZAETOT ! 1: total attenuation, 2: // vertical
-REAL :: ZAERINT,ZAEIINT,ZAESINT,ZAEGINT,ZAEHINT ! total attenuation horizontal
-REAL :: ZAVRINT,ZAVSINT,ZAVGINT,ZAVHINT ! total attenuation vertical
-!
-REAL,DIMENSION(:),ALLOCATABLE :: ZX,ZW ! Gauss-Laguerre points and weights
-!
-REAL,DIMENSION(4) :: ZREFLOC
-REAL,DIMENSION(2) :: ZAETMP
-REAL,DIMENSION(:),ALLOCATABLE :: ZVTEMP ! temp var for Gaussian quadrature 8 : r_r, 9 : r_i, 10 : r_s , 11 : r_g
-REAL :: ZCXR=-1.0 ! for rain N ~ 1/N_0 (in Kessler parameterization)
-REAL :: ZDMELT_FACT ! factor used to compute the equivalent melted diameter
-REAL :: ZEQICE=0.224! factor used to convert the ice crystals reflectivity into an equivalent liquid water reflectivity (from Smith, JCAM 84)
-REAL :: ZEXP ! anciliary parameter
-REAL :: ZLBDA ! slope distribution parameter
-REAL :: ZN ! Number concentration
-REAL :: ZFRAC_ICE,ZD,ZDE ! auxiliary variables
-REAL :: ZQSCA
-REAL,DIMENSION(2) :: ZQEXT
-REAL,DIMENSION(3) :: ZQBACK ! Q_b(HH),Q_b(VV) (backscattering efficiencies at horizontal and vertical polarizations, resp.)
-!REAL :: P=DACOS(-1D0)
-REAL :: ZRHOI ! pristine ice density (from m=a*D**b),
-REAL :: ZRHOPI=916. !pure ice density (kg/m3)
-COMPLEX :: ZNUM, ZDEN !for calculation of ice dielectri cconstant
-COMPLEX :: ZQM,ZQMW,ZQMI,ZQK,ZQB, ZEPSI ! dielectric parameters
-REAL :: ZS11_CARRE_R,ZS22_CARRE_R,ZRE_S22S11_R,ZIM_S22S11_R
-REAL :: ZS11_CARRE_I,ZS22_CARRE_I,ZRE_S22S11_I,ZIM_S22S11_I
-REAL :: ZS11_CARRE_S,ZS22_CARRE_S,ZRE_S22S11_S,ZIM_S22S11_S
-REAL :: ZS11_CARRE_G,ZS22_CARRE_G,ZRE_S22S11_G,ZIM_S22S11_G
-REAL :: ZS11_CARRE_H,ZS22_CARRE_H,ZRE_S22S11_H,ZIM_S22S11_H
-REAL :: ZS11_CARRE_T,ZS22_CARRE_T,ZRE_S22S11_T,ZIM_S22S11_T
-REAL :: ZRE_S22FMS11F,ZIM_S22FT,ZIM_S11FT
-
-REAL :: ZM
-!
-INTEGER :: INBRAD,IIELV,INBAZIM,INBSTEPMAX,INPTS_H,INPTS_V ! sizes of the arrays
-INTEGER :: IEL
-INTEGER :: JI,JL,JEL,JAZ,JH,JV,JJ,JT ! Loop variables of control
-REAL :: ZLB ! depolarization factor along the spheroid symmetry axis
-REAL :: ZCXI=0. ! should be defined with other parameters of microphysical scheme
-REAL :: ZCR,ZCI,ZCS,ZCG,ZCH ! coefficients to take into account fall speeds when simulating Doppler winds
-REAL, DIMENSION(:,:,:,:),ALLOCATABLE :: ZCONC_BIN
-INTEGER :: IMAX
-LOGICAL :: LPART_MASK ! indicates a partial mask along the beam
-
-!
-INTEGER :: IZER,IZEI,IZES,IZEG
-INTEGER :: IVDOP,IRHV,IPDP,IDHV
-INTEGER :: IAER,IAEI,IAES,IAEG
-INTEGER :: IAVR,IAVI,IAVS,IAVG
-INTEGER :: IATR,IATI,IATS,IATG
-INTEGER :: IRHR, IRHS, IRHG, IZDA, IZDS, IZDG, IKDR, IKDS, IKDG
-INTEGER :: IZEH, IRHH,IKDH,IZDH ! hail
-INTEGER :: IAEH,IAVH,IATH
-!
-!for ZSNR threshold
-REAL ::ZDISTRAD,ZSNR,ZSNR_R,ZSNR_S,ZSNR_I,ZSNR_G,ZSNR_H,ZZHH,ZZE_R,ZZE_I,ZZE_S,ZZE_G,ZZE_H
-LOGICAL :: GTHRESHOLD_V, GTHRESHOLD_Z,GTHRESHOLD_ZR,GTHRESHOLD_ZI,GTHRESHOLD_ZS,GTHRESHOLD_ZG,GTHRESHOLD_ZH
-
-!--------- TO READ T-MATRIX TABLE --------
-CHARACTER(LEN=6) :: YBAND
-CHARACTER(LEN=1) ::YTYPE
-CHARACTER(LEN=1),DIMENSION(5) :: YTAB_TYPE
-CHARACTER(LEN=25),DIMENSION(5) :: YFILE_COEFINT
-
-REAL,DIMENSION(5) :: ZELEV_MIN,ZELEV_MAX,ZELEV_STEP,&
-ZTC_MIN,ZTC_MAX,ZTC_STEP,ZFW_MIN,ZFW_MAX,ZFW_STEP
-INTEGER :: IRESP,ILINE,INB_M
-INTEGER,DIMENSION(5) :: INB_ELEV,INB_TC,INB_FW,INB_LINE
-
-REAL, DIMENSION(:),ALLOCATABLE :: ZTC_T_R, ZTC_T_S, ZTC_T_G, ZTC_T_W
-REAL, DIMENSION(:),ALLOCATABLE :: ZELEV_T_R, ZELEV_T_S, ZELEV_T_G, ZELEV_T_W
-REAL, DIMENSION(:),ALLOCATABLE :: ZFW_T_S, ZFW_T_G, ZFW_T_W
-REAL, DIMENSION(:),ALLOCATABLE :: ZM_T_R, ZM_T_S, ZM_T_G, ZM_T_W
-REAL, DIMENSION(:),ALLOCATABLE :: ZS11_CARRE_T_R, ZS11_CARRE_T_S, ZS11_CARRE_T_G, ZS11_CARRE_T_W
-REAL, DIMENSION(:),ALLOCATABLE :: ZS22_CARRE_T_R, ZS22_CARRE_T_S, ZS22_CARRE_T_G, ZS22_CARRE_T_W
-REAL, DIMENSION(:),ALLOCATABLE :: ZRE_S22S11_T_R, ZRE_S22S11_T_S, ZRE_S22S11_T_G, ZRE_S22S11_T_W
-REAL, DIMENSION(:),ALLOCATABLE :: ZIM_S22S11_T_R, ZIM_S22S11_T_S, ZIM_S22S11_T_G, ZIM_S22S11_T_W
-REAL, DIMENSION(:),ALLOCATABLE :: ZIM_S22FT_T_R, ZIM_S22FT_T_S, ZIM_S22FT_T_G, ZIM_S22FT_T_W
-REAL, DIMENSION(:),ALLOCATABLE :: ZIM_S11FT_T_R, ZIM_S11FT_T_S, ZIM_S11FT_T_G, ZIM_S11FT_T_W
-REAL, DIMENSION(:),ALLOCATABLE :: ZRE_S22FMS11FT_T_R, ZRE_S22FMS11FT_T_S, ZRE_S22FMS11FT_T_G, ZRE_S22FMS11FT_T_W
-REAL, DIMENSION(:),ALLOCATABLE :: ZTC_T_H ,ZELEV_T_H ,ZFW_T_H,ZM_T_H,ZS11_CARRE_T_H,ZS22_CARRE_T_H,ZRE_S22S11_T_H
-REAL, DIMENSION(:),ALLOCATABLE :: ZIM_S22S11_T_H,ZIM_S22FT_T_H,ZIM_S11FT_T_H,ZRE_S22FMS11FT_T_H
-INTEGER,DIMENSION(16):: ITMAT
-REAL:: ZELEV_RED,ZTC_RED,ZM_RED,ZFW_RED
-INTEGER :: JIND
-REAL,DIMENSION(7,16) :: KMAT_COEF !matrice contenant tous les coef interpolés
- !pour chaque val inf et sup de ELEV_t
-REAL :: ZEXPM_MIN, ZEXPM_STEP, ZEXPM_MAX,ZM_MIN
-REAL :: ZFW !water fraction inside melting graupel (ZFW=0 for rain, snow and dry graupel). used only with NDIFF=7: Tmatrix
-INTEGER :: ILUOUT0,IUNIT
-!
-! MODIF GAELLE POUR LIMA
-!
-LOGICAL :: GLIMA,GHAIL
-REAL,DIMENSION(5) :: ZCC_MIN,ZCC_MAX, ZCC_STEP
-INTEGER,DIMENSION(5):: INB_CC
-REAL, DIMENSION(:),ALLOCATABLE :: ZCC_T_R
-REAL :: ZCC_RED
-LOGICAL :: GCALC
-REAL :: ZCC
-REAL, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: ZM_6D,ZCC_6D
-REAL :: ZC
-!
-REAL :: ZCCR,ZLBR,ZLBEXR,ZDR,ZALPHAR,ZNUR,ZBR
-REAL :: ZCCS,ZLBS,ZLBEXS,ZDS,ZALPHAS,ZNUS,ZAS,ZBS,ZCXS,ZNS
-REAL :: ZCCG,ZLBG,ZLBEXG,ZDG,ZALPHAG,ZNUG,ZAG,ZBG,ZCXG
-REAL :: ZCCH,ZLBH,ZLBEXH,ZDH,ZALPHAH,ZNUH,ZAH,ZBH,ZCXH
-REAL :: ZLBI,ZLBEXI,ZDI,ZALPHAI,ZNUI,ZAI,ZBI
-REAL,DIMENSION(:),ALLOCATABLE :: ZRTMIN
-CHARACTER(LEN=100) :: YMSG
-TYPE(TFILEDATA),POINTER :: TZFILE
-!
-!* 1. INITIALISATION
-!--------------
-ILUOUT0 = TLUOUT0%NLU
-TZFILE => NULL()
-!
-IF (PRESENT(PCR_RAY)) THEN
- GLIMA=.TRUE.
-ELSE
- GLIMA=.FALSE.
-ENDIF
-IF (PRESENT(PH_RAY)) THEN
- GHAIL=.TRUE.
-ELSE
- GHAIL=.FALSE.
-ENDIF
-!
-!
-!
- ZS11_CARRE_R=0
- ZS22_CARRE_R=0
- ZRE_S22S11_R=0
- ZIM_S22S11_R=0
- ZS11_CARRE_I=0
- ZS22_CARRE_I=0
- ZRE_S22S11_I=0
- ZIM_S22S11_I=0
- ZS11_CARRE_S=0
- ZS22_CARRE_S=0
- ZRE_S22S11_S=0
- ZIM_S22S11_S=0
- ZS11_CARRE_G=0
- ZS22_CARRE_G=0
- ZRE_S22S11_G=0
- ZIM_S22S11_G=0
- ZS11_CARRE_H=0
- ZS22_CARRE_H=0
- ZRE_S22S11_H=0
- ZIM_S22S11_H=0
-! Initialisation varibales microphysiques
-IF (GLIMA) THEN ! LIMA
- ZLBR=XLBR_L
- ZLBEXR=XLBEXR_L
- ZDR=XDR_L
- ZALPHAR=XALPHAR_L
- ZNUR=XNUR_L
- ZBR=XBR_L
- ZCCS=XCCS_L
- ZCXS=XCXS_L
- ZLBS=XLBS_L
- ZLBEXS=XLBEXS_L
- ZNS=XNS_L
- ZDS=XDS_L
- ZALPHAS=XALPHAS_L
- ZNUS=XNUS_L
- ZAS=XAS_L
- ZBS=XBS_L
- ZCCG=XCCG_L
- ZCXG=XCXG_L
- ZLBG=XLBG_L
- ZLBEXG=XLBEXG_L
- ZDG=XDG_L
- ZALPHAG=XALPHAG_L
- ZNUG=XNUG_L
- ZAG=XAG_L
- ZBG=XBG_L
- ZLBI=XLBI_L
- ZLBEXI=XLBEXI_L
- ZDI=XDI_L
- ZALPHAI=XALPHAI_L
- ZNUI=XNUI_L
- ZAI=XAI_L
- ZBI=XBI_L
- ALLOCATE(ZRTMIN(SIZE(XRTMIN_L)))
- ZRTMIN=XRTMIN_L
-ELSE ! ICE3
- ZCCR=XCCR_I
- ZLBR=XLBR_I
- ZLBEXR=XLBEXR_I
- ZDR=XDR_I
- ZALPHAR=XALPHAR_I
- ZNUR=XNUR_I
- ZBR=XBR_I
- ZCCS=XCCS_I
- ZCXS=XCXS_I
- ZLBS=XLBS_I
- ZLBEXS=XLBEXS_I
- ZNS=XNS_I
- ZDS=XDS_I
- ZALPHAS=XALPHAS_I
- ZNUS=XNUS_I
- ZAS=XAS_I
- ZBS=XBS_I
- ZCCG=XCCG_I
- ZCXG=XCXG_I
- ZLBG=XLBG_I
- ZLBEXG=XLBEXG_I
- ZDG=XDG_I
- ZALPHAG=XALPHAG_I
- ZNUG=XNUG_I
- ZAG=XAG_I
- ZBG=XBG_I
- ZLBI=XLBI_I
- ZLBEXI=XLBEXI_I
- ZDI=XDI_I
- ZALPHAI=XALPHAI_I
- ZNUI=XNUI_I
- ZAI=XAI_I
- ZBI=XBI_I
- ALLOCATE(ZRTMIN(SIZE(XRTMIN_I)))
- ZRTMIN=XRTMIN_I
- IF (GHAIL) THEN
- ZCCH=XCCH_I
- ZCXH=XCXH_I
- ZLBH=XLBH_I
- ZLBEXH=XLBEXH_I
- ZDH=XDH_I
- ZALPHAH=XALPHAH_I
- ZNUH=XNUH_I
- ZAH=XAH_I
- ZBH=XBH_I
- ENDIF
-ENDIF
-!
-! initialisation of refractivity indices
-! 1 : ZHH
-! 2 : ZDR
-! 3 : KDP
-! 4 : CSR
-IZER=5 ! ZER
-IZEI=IZER+1 ! ZEI
-IZES=IZEI+1 ! ZES
-IZEG=IZES+1 ! ZEG
-IF (GHAIL) THEN
- IZEH=IZEG+1 !ZEH
- IVDOP=IZEH+1 !VRU
-ELSE
- IVDOP=IZEG+1 !VRU
-END IF
-IF (LATT) THEN
- IF (GHAIL) THEN
- IAER=IVDOP+1
- IAEI=IAER+1
- IAES=IAEI+1
- IAEG=IAES+1
- IAEH=IAEG+1
- IAVR=IAEH+1
- IAVI=IAVR+1
- IAVS=IAVI+1
- IAVG=IAVS+1
- IAVH=IAVG+1
- IATR=IAVH+1
- IATI=IATR+1
- IATS=IATI+1
- IATG=IATS+1
- IATH=IATG+1
- IRHV=IATH+1
- ELSE
- IAER=IVDOP+1
- IAEI=IAER+1
- IAES=IAEI+1
- IAEG=IAES+1
- IAVR=IAEG+1
- IAVI=IAVR+1
- IAVS=IAVI+1
- IAVG=IAVS+1
- IATR=IAVG+1
- IATI=IATR+1
- IATS=IATI+1
- IATG=IATS+1
- IRHV=IATG+1
- ENDIF
-ELSE
- IRHV=IVDOP+1
-ENDIF
-IPDP=IRHV+1
-IDHV=IPDP+1
-IRHR=IDHV+1
-IRHS=IRHR+1
-IRHG=IRHS+1
-IF (GHAIL) THEN
- IRHH=IRHG+1
- IZDA=IRHH+1
-ELSE
- IZDA=IRHG+1
-ENDIF
-IZDS=IZDA+1
-IZDG=IZDS+1
-IF (GHAIL) THEN
- IZDH=IZDG+1
- IKDR=IZDH+1
-ELSE
- IKDR=IZDG+1
-ENDIF
-IKDS=IKDR+1
-IKDG=IKDS+1
-IF (GHAIL) THEN
- IKDH=IKDG+1
-ENDIF
-!
-!
-!
-INBRAD=SIZE(PT_RAY,1)
-IIELV=SIZE(PT_RAY,2)
-INBAZIM=SIZE(PT_RAY,3)
-INBSTEPMAX=SIZE(PT_RAY,4)
-INPTS_H=SIZE(PT_RAY,5)
-INPTS_V=SIZE(PT_RAY,6)
-!
-! Initialisation for radial winds
-IF(LFALL) THEN
- IF (GLIMA) THEN
- ZCR=XCR_L
- ZCI=XC_I_L
- ZCS=XCS_L
- ZCG=XCG_L
- ELSE
- ZCR=XCR_I
- ZCI=XC_I_I
- ZCS=XCS_I
- ZCG=XCG_I
- IF (GHAIL) ZCH=XCH_I
- ENDIF
-ELSE
- ZCR=0.
- ZCI=0.
- ZCS=0.
- ZCG=0.
- IF (GHAIL) ZCH=0.
-END IF
-
-! Calculation of nodes and weights for the Gauss-Laguerre quadrature
-! for Mie and T-matrix and RG
-IF(NDIFF/=0) THEN
- ALLOCATE(ZX(NPTS_GAULAG),ZW(NPTS_GAULAG)) !NPTS_GAULAG : number of points for the quadrature
- CALL GAULAG(NPTS_GAULAG,ZX,ZW)
-END IF
-!
-!
-IMAX=SIZE(PZE,5)
-WRITE(ILUOUT0,*) "-----------------"
-WRITE(ILUOUT0,*) "Radar scattering"
-WRITE(ILUOUT0,*) "-----------------"
-WRITE(ILUOUT0,*) 'Nombre de variables dans PZE: ',IMAX
-
-IF(.NOT.LWREFL) IMAX=IMAX+1
-
-ALLOCATE(ZREFL(INBRAD,IIELV,INBAZIM,INBSTEPMAX,INPTS_H,INPTS_V,IMAX))
-ZREFL(:,:,:,:,:,:,:)=0.
-IF(LATT) THEN
- ZREFL(:,:,:,:,:,:,IATR:IATG)=1.
- IF (GHAIL) ZREFL(:,:,:,:,:,:,IATH)=1.
-END IF
-PZE(:,:,:,:,:)=0.
-IF (LATT)THEN
- ALLOCATE(ZAELOC(INBRAD,IIELV,INBAZIM,INBSTEPMAX,INPTS_H,INPTS_V,2))
- ALLOCATE(ZAETOT(INPTS_H,INPTS_V,2))
- ZAELOC(:,:,:,:,:,:,:)=0. ! initialization of attenuation stuff (alpha_e for first gate)
- ZAETOT(:,:,:)=1. ! initialization of attenuation stuff (total attenuation)
-END IF
-WRITE(ILUOUT0,*) 'BEFORE LOOP DIFFUSION'
-
-IF(LWBSCS) THEN
- ALLOCATE(ZCONC_BIN(INBRAD,IIELV,INBAZIM,INBSTEPMAX))
- ZCONC_BIN(:,:,:,:)=0.
-END IF
-
-WRITE(ILUOUT0,*) "XCCR:",ZCCR
-WRITE(ILUOUT0,*) "XLBR:",ZLBR
-WRITE(ILUOUT0,*) "XLBEXR:",ZLBEXR
-
-WRITE(ILUOUT0,*) "XCCS:",ZCCS
-WRITE(ILUOUT0,*) "XLBS:",ZLBS
-WRITE(ILUOUT0,*) "XLBEXS:",ZLBEXS
-
-WRITE(ILUOUT0,*) "XCCG:",ZCCG
-WRITE(ILUOUT0,*) "XLBG:",ZLBG
-WRITE(ILUOUT0,*) "XLBEXG:",ZLBEXG
-
-IF (GHAIL) THEN
- WRITE(ILUOUT0,*) "XCCH:",ZCCH
- WRITE(ILUOUT0,*) "XLBH:",ZLBH
- WRITE(ILUOUT0,*) "XLBEXH:",ZLBEXH
-ENDIF
-!
-IF (GLIMA .AND. NDIFF==7) THEN
- IF (ZALPHAR/=1 .AND. ZNUR /=2.) THEN
- WRITE(ILUOUT0,*) " ERROR : TMATRICE TABLE ARE MADE WITH XALPHAR=1 XNUR=2"
- WRITE(ILUOUT0,*) " FOR CCLOUD=LIMA. PLEASE CHANGE THIS VALUES OR PROVIDE "
- WRITE(ILUOUT0,*) " NEW TMATRICE TABLES "
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RADAR_SCATTERING','')
- ENDIF
-ELSE
- IF (ZALPHAR/=1 .AND. ZNUR /=1.) THEN
- WRITE(ILUOUT0,*) " ERROR : TMATRICE TABLE ARE MADE WITH XALPHAR=1 XNUR=1"
- WRITE(ILUOUT0,*) " FOR CCLOUD=ICE3. PLEASE CHANGE THIS VALUEs OR PROVIDE "
- WRITE(ILUOUT0,*) " NEW TMATRICE TABLES "
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RADAR_SCATTERING','')
- ENDIF
-ENDIF
-
-!---------------------------------------------
-! LOOP OVER EVERYTHING
-!--------------------------------------------
-IF(NDIFF==7) THEN
- YTAB_TYPE(1)='r'
- YTAB_TYPE(2)='s'
- YTAB_TYPE(3)='g'
- YTAB_TYPE(4)='w'
- YTAB_TYPE(5)='h'
- ! definition des paramètres de lecture de la table T-matrice
- ! all mixing ratio
- ZEXPM_MIN=-7.
- ZEXPM_STEP=0.01
- ZEXPM_MAX=-2.
- ZM_MIN=10**ZEXPM_MIN
- ! rain
- ZELEV_MIN(1)=0.0
- ZELEV_STEP(1)=4.0
- ZELEV_MAX(1)=12.0
- ZTC_MIN(1)=-20.0
- ZTC_STEP(1)=1.0
- ZTC_MAX(1)=40.0
- ZFW_MIN(1)=0.0
- ZFW_STEP(1)=0.1
- ZFW_MAX(1)=0.0
- IF (GLIMA) THEN
- ZCC_MIN(1)=1.8
- ZCC_STEP(1)=0.02
- ZCC_MAX(1)=6
- ELSE
- ZCC_MIN(1)=1.
- ZCC_STEP(1)=1.
- ZCC_MAX(1)=1.
- ENDIF
- ! snow + graupel
- ZELEV_MIN(2:3)=0.0
- ZELEV_STEP(2:3)=12.0
- ZELEV_MAX(2:3)=12.0
- ZTC_MIN(2:3)=-70.0
- ZTC_STEP(2:3)=1.0
- ZTC_MAX(2:3)=10.0
- ZFW_MIN(2:3)=0.0
- ZFW_STEP(2:3)=0.1
- ZFW_MAX(2:3)=0.0
- ZCC_MIN(2:3)=1.
- ZCC_STEP(2:3)=1.
- ZCC_MAX(2:3)=1.
- ! wet graupel
- ZELEV_MIN(4)=0.0
- ZELEV_STEP(4)=4.0
- ZELEV_MAX(4)=12.0
- ZTC_MIN(4)=-10.0
- ZTC_STEP(4)=1.0
- ZTC_MAX(4)=10.0
- ZFW_MIN(4)=0.0
- ZFW_STEP(4)=0.1
- ZFW_MAX(4)=1.0
- ZCC_MIN(4)=1.
- ZCC_STEP(4)=1.
- ZCC_MAX(4)=1.
- ! hail
- ZELEV_MIN(5)=0.0
- ZELEV_STEP(5)=4.0
- ZELEV_MAX(5)=12.0
- ZTC_MIN(5)=-20.0
- ZTC_STEP(5)=1.0
- ZTC_MAX(5)=30.0
- ZFW_MIN(5)=0.
- ZFW_STEP(5)=0.1
- ZFW_MAX(5)=0.0
- ZCC_MIN(5)=1.
- ZCC_STEP(5)=1.
- ZCC_MAX(5)=1.
- DO JT=1,5
- INB_ELEV(JT)=NINT((ZELEV_MAX(JT)-ZELEV_MIN(JT))/ZELEV_STEP(JT))+1
- INB_TC(JT)=NINT((ZTC_MAX(JT)-ZTC_MIN(JT))/ZTC_STEP(JT))+1
- INB_FW(JT)=NINT((ZFW_MAX(JT)-ZFW_MIN(JT))/ZFW_STEP(JT))+1
- INB_M=NINT((ZEXPM_MAX-ZEXPM_MIN)/ZEXPM_STEP)+1
- INB_CC(JT)=NINT((ZCC_MAX(JT)-ZCC_MIN(JT))/ZCC_STEP(JT))+1
- INB_LINE(JT)=INB_ELEV(JT)*INB_TC(JT)*INB_FW(JT)*INB_M*INB_CC(JT)
- ENDDO
-ENDIF
-
-!---------------------------------------------
-! LOOP OVER EVERYTHING
-!--------------------------------------------
- !============== loop over radars =================
-WRITE(ILUOUT0,*) "INBRAD",INBRAD
-DO JI=1,INBRAD
- WRITE(ILUOUT0,*) "JI",JI
- WRITE(ILUOUT0,*) "XLAM_RAD(JI):",XLAM_RAD(JI)
-
- IF(NDIFF==7) THEN ! If T-MATRIX
- !---------------------------------------------------------------------------------------------
- ! 0. LECTURE DES TABLES TMAT POUR PLUIE, NEIGE, GRAUPEL
- ! en fonction de la bande frequence
- !---------------------------------------------------------------------------------------------
- IF ( XLAM_RAD(JI)==0.1062) THEN
- YBAND='S106.2'
- ELSEIF (XLAM_RAD(JI) ==0.0532 ) THEN
- YBAND='C053.2'
- ELSEIF (XLAM_RAD(JI)==0.0319 ) THEN
- YBAND='X031.9'
- ELSE
- WRITE(ILUOUT0,*) "ERROR RADAR_SCATTERING"
- WRITE(ILUOUT0,*) "Tmatrice tables are only available for XLAM_RAD=0.1062"
- WRITE(ILUOUT0,*) "or XLAM_RAD=0.0532 or XLAM_RAD=0.0319"
- WRITE(ILUOUT0,*) "change XLAM_RAD in namelist or compute new tmatrice table"
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RADAR_SCATTERING','')
- ENDIF
-
- !************ fichiers Min Max Pas et Coef Tmat ***********
- DO JT=1,5 !types (r, s, g, w, h)
-
- YTYPE=YTAB_TYPE(JT)
- IF (JT .EQ. 1) THEN
- IF (GLIMA) THEN
- YFILE_COEFINT(JT)='TmatCoefInt_LIMA_'//YBAND//YTYPE
- ELSE
- YFILE_COEFINT(JT)='TmatCoefInt_ICE3_'//YBAND//YTYPE
- ENDIF
- ELSE
- YFILE_COEFINT(JT)='TmatCoefInt_'//YBAND//YTYPE
- ENDIF
- YFILE_COEFINT(JT)=TRIM(ADJUSTL(YFILE_COEFINT(JT)))
- ENDDO
- !lookup tables for rain
- ALLOCATE (ZTC_T_R(INB_LINE(1)),ZELEV_T_R(INB_LINE(1)),ZCC_T_R(INB_LINE(1)),ZM_T_R(INB_LINE(1)),&
- ZS11_CARRE_T_R(INB_LINE(1)),ZS22_CARRE_T_R(INB_LINE(1)), ZRE_S22S11_T_R(INB_LINE(1)),ZIM_S22S11_T_R(INB_LINE(1)),&
- ZRE_S22FMS11FT_T_R(INB_LINE(1)),ZIM_S22FT_T_R(INB_LINE(1)),ZIM_S11FT_T_R(INB_LINE(1)))
-
- !lookup tables for snow
- ALLOCATE (ZTC_T_S(INB_LINE(2)),ZELEV_T_S(INB_LINE(2)),ZFW_T_S(INB_LINE(2)),ZM_T_S(INB_LINE(2)),&
- ZS11_CARRE_T_S(INB_LINE(2)),ZS22_CARRE_T_S(INB_LINE(2)),ZRE_S22S11_T_S(INB_LINE(2)),ZIM_S22S11_T_S(INB_LINE(2)),&
- ZRE_S22FMS11FT_T_S(INB_LINE(2)),ZIM_S22FT_T_S(INB_LINE(2)),ZIM_S11FT_T_S(INB_LINE(2)))
-
- !lookup tables for graupel
- ALLOCATE (ZTC_T_G(INB_LINE(3)),ZELEV_T_G(INB_LINE(3)),ZFW_T_G(INB_LINE(3)),ZM_T_G(INB_LINE(3)),&
- ZS11_CARRE_T_G(INB_LINE(3)),ZS22_CARRE_T_G(INB_LINE(3)), ZRE_S22S11_T_G(INB_LINE(3)),ZIM_S22S11_T_G(INB_LINE(3)),&
- ZRE_S22FMS11FT_T_G(INB_LINE(3)),ZIM_S22FT_T_G(INB_LINE(3)),ZIM_S11FT_T_G(INB_LINE(3)))
-
- !lookup tables for wet graupel
- ALLOCATE (ZTC_T_W(INB_LINE(4)),ZELEV_T_W(INB_LINE(4)),ZFW_T_W(INB_LINE(4)),ZM_T_W(INB_LINE(4)),&
- ZS11_CARRE_T_W(INB_LINE(4)),ZS22_CARRE_T_W(INB_LINE(4)), ZRE_S22S11_T_W(INB_LINE(4)),ZIM_S22S11_T_W(INB_LINE(4)),&
- ZRE_S22FMS11FT_T_W(INB_LINE(4)),ZIM_S22FT_T_W(INB_LINE(4)),ZIM_S11FT_T_W(INB_LINE(4)))
-
- IF (GHAIL) THEN
- !lookup tables for hail
- ALLOCATE (ZTC_T_H(INB_LINE(5)),ZELEV_T_H(INB_LINE(5)),ZFW_T_H(INB_LINE(5)),ZM_T_H(INB_LINE(5)),&
- ZS11_CARRE_T_H(INB_LINE(5)),ZS22_CARRE_T_H(INB_LINE(5)), ZRE_S22S11_T_H(INB_LINE(5)),ZIM_S22S11_T_H(INB_LINE(5)),&
- ZRE_S22FMS11FT_T_H(INB_LINE(5)),ZIM_S22FT_T_H(INB_LINE(5)),ZIM_S11FT_T_H(INB_LINE(5)))
- ENDIF
- !===== Lecture des tables ===========
-
- 6003 FORMAT (E11.4,2X,E9.3,2X,E10.4,2X,E10.4,2X,E12.5,2X,E12.5,2X,&
- E12.5,2X,E12.5,2X,E12.5,2X,E12.5,2X,E12.5)
-
- !rain
- CALL IO_File_add2list(TZFILE,YFILE_COEFINT(1),'TXT','READ')
- CALL IO_File_open(TZFILE,KRESP=IRESP)
- IUNIT = TZFILE%NLU
- IF ( IRESP /= 0 ) THEN
- WRITE(YMSG,*) "problem opening file ",TRIM(YFILE_COEFINT(1))
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RADAR_SCATTERING',YMSG)
- ENDIF
- ILINE=1
- DO WHILE (ILINE .LE. INB_LINE(1))
- READ( UNIT=IUNIT,FMT=6003, IOSTAT=IRESP ) ZTC_T_R(ILINE),ZELEV_T_R(ILINE),&
- ZCC_T_R(ILINE),ZM_T_R(ILINE),ZS11_CARRE_T_R(ILINE),ZS22_CARRE_T_R(ILINE),ZRE_S22S11_T_R(ILINE),&
- ZIM_S22S11_T_R(ILINE),ZRE_S22FMS11FT_T_R(ILINE),ZIM_S22FT_T_R(ILINE),ZIM_S11FT_T_R(ILINE)
- ILINE=ILINE+1
- ENDDO
- CALL IO_File_close(TZFILE)
- TZFILE => NULL()
- WRITE(ILUOUT0,*) "NLIGNE rain",ILINE
- ILINE=2
- WRITE(ILUOUT0,*) "ILINE=",ILINE
- WRITE(ILUOUT0,*) "ZTC_T_R(ILINE),ZELEV_T_R(ILINE),ZCC_T_R(ILINE)",&
- ZTC_T_R(ILINE),ZELEV_T_R(ILINE),ZCC_T_R(ILINE)
- WRITE(ILUOUT0,*) "ZM_T_R(ILINE),ZS11_CARRE_T_R(ILINE),ZS22_CARRE_T_R(ILINE),ZRE_S22S11_T_R(ILINE)",&
- ZM_T_R(ILINE),ZS11_CARRE_T_R(ILINE),ZS22_CARRE_T_R(ILINE),ZRE_S22S11_T_R(ILINE)
- WRITE(ILUOUT0,*) "ZIM_S22S11_T_R(ILINE),ZRE_S22FMS11FT_T_R(ILINE),ZIM_S22FT_T_R(ILINE),ZIM_S11FT_T_R(ILINE)",&
- ZIM_S22S11_T_R(ILINE),ZRE_S22FMS11FT_T_R(ILINE),ZIM_S22FT_T_R(ILINE),ZIM_S11FT_T_R(ILINE)
-
- !snow
- CALL IO_File_add2list(TZFILE,YFILE_COEFINT(2),'TXT','READ')
- CALL IO_File_open(TZFILE,KRESP=IRESP)
- IUNIT = TZFILE%NLU
- IF ( IRESP /= 0 ) THEN
- WRITE(YMSG,*) "problem opening file ",TRIM(YFILE_COEFINT(2))
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RADAR_SCATTERING',YMSG)
- ENDIF
- ILINE=1
- DO WHILE (ILINE .LE. INB_LINE(2))
- READ( UNIT=IUNIT,FMT=6003, IOSTAT=IRESP ) ZTC_T_S(ILINE),ZELEV_T_S(ILINE),&
- ZFW_T_S(ILINE),ZM_T_S(ILINE),ZS11_CARRE_T_S(ILINE),ZS22_CARRE_T_S(ILINE),ZRE_S22S11_T_S(ILINE),&
- ZIM_S22S11_T_S(ILINE),ZRE_S22FMS11FT_T_S(ILINE),ZIM_S22FT_T_S(ILINE),ZIM_S11FT_T_S(ILINE)
- ILINE=ILINE+1
- ENDDO
- CALL IO_File_close(TZFILE)
- TZFILE => NULL()
- WRITE(ILUOUT0,*) "NLIGNE snow",ILINE
- ILINE=2
- WRITE(ILUOUT0,*) "ILINE=",ILINE
- WRITE(ILUOUT0,*) "ZTC_T_S(ILINE),ZELEV_T_S(ILINE),ZFW_T_S(ILINE)",&
- ZTC_T_S(ILINE),ZELEV_T_S(ILINE),ZFW_T_S(ILINE)
- WRITE(ILUOUT0,*) "ZM_T_S(ILINE),ZS11_CARRE_T_S(ILINE),ZS22_CARRE_T_S(ILINE),ZRE_S22S11_T_S(ILINE)",&
- ZM_T_S(ILINE),ZS11_CARRE_T_S(ILINE),ZS22_CARRE_T_S(ILINE),ZRE_S22S11_T_S(ILINE)
- WRITE(ILUOUT0,*) "ZIM_S22S11_T_S(ILINE),ZRE_S22FMS11FT_T_S(ILINE),ZIM_S22FT_T_S(ILINE),ZIM_S11FT_T_S(ILINE)",&
- ZIM_S22S11_T_S(ILINE),ZRE_S22FMS11FT_T_S(ILINE),ZIM_S22FT_T_S(ILINE),ZIM_S11FT_T_S(ILINE)
-
- !graupel
- CALL IO_File_add2list(TZFILE,YFILE_COEFINT(3),'TXT','READ')
- CALL IO_File_open(TZFILE,KRESP=IRESP)
- IUNIT = TZFILE%NLU
- IF ( IRESP /= 0 ) THEN
- WRITE(YMSG,*) "problem opening file ",TRIM(YFILE_COEFINT(3))
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RADAR_SCATTERING',YMSG)
- ENDIF
- ILINE=1
- DO WHILE (ILINE .LE. INB_LINE(3))
- READ( UNIT=IUNIT, FMT=6003,IOSTAT=IRESP ) ZTC_T_G(ILINE),ZELEV_T_G(ILINE),&
- ZFW_T_G(ILINE),ZM_T_G(ILINE),ZS11_CARRE_T_G(ILINE),ZS22_CARRE_T_G(ILINE),ZRE_S22S11_T_G(ILINE),&
- ZIM_S22S11_T_G(ILINE),ZRE_S22FMS11FT_T_G(ILINE),ZIM_S22FT_T_G(ILINE),ZIM_S11FT_T_G(ILINE)
- ILINE=ILINE+1
- ENDDO
- CALL IO_File_close(TZFILE)
- TZFILE => NULL()
- WRITE(ILUOUT0,*) "NLIGNE graupel",ILINE
- ILINE=2
- WRITE(ILUOUT0,*) "ILINE=",ILINE
- WRITE(ILUOUT0,*) "ZTC_T_G(ILINE),ZELEV_T_G(ILINE)",&
- ZTC_T_G(ILINE),ZELEV_T_G(ILINE)
- WRITE(ILUOUT0,*) "ZM_T_G(ILINE),ZS11_CARRE_T_G(ILINE),ZS22_CARRE_T_G(ILINE),ZRE_S22S11_T_G(ILINE)",&
- ZM_T_G(ILINE),ZS11_CARRE_T_G(ILINE),ZS22_CARRE_T_G(ILINE),ZRE_S22S11_T_G(ILINE)
- WRITE(ILUOUT0,*) "ZIM_S22S11_T_G(ILINE),ZRE_S22FMS11FT_T_G(ILINE),ZIM_S22FT_T_G(ILINE),ZIM_S11FT_T_G(ILINE)",&
- ZIM_S22S11_T_G(ILINE),ZRE_S22FMS11FT_T_G(ILINE),ZIM_S22FT_T_G(ILINE),ZIM_S11FT_T_G(ILINE)
-
- !wet graupel
- CALL IO_File_add2list(TZFILE,YFILE_COEFINT(4),'TXT','READ')
- CALL IO_File_open(TZFILE,KRESP=IRESP)
- IUNIT = TZFILE%NLU
- IF ( IRESP /= 0 ) THEN
- WRITE(YMSG,*) "problem opening file ",TRIM(YFILE_COEFINT(4))
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RADAR_SCATTERING',YMSG)
- ENDIF
- ILINE=1
- DO WHILE (ILINE .LE. INB_LINE(4))
- READ( UNIT=IUNIT, FMT=6003,IOSTAT=IRESP ) ZTC_T_W(ILINE),ZELEV_T_W(ILINE),&
- ZFW_T_W(ILINE),ZM_T_W(ILINE),ZS11_CARRE_T_W(ILINE),ZS22_CARRE_T_W(ILINE),ZRE_S22S11_T_W(ILINE),&
- ZIM_S22S11_T_W(ILINE),ZRE_S22FMS11FT_T_W(ILINE),ZIM_S22FT_T_W(ILINE),ZIM_S11FT_T_W(ILINE)
- ILINE=ILINE+1
- ENDDO
- CALL IO_File_close(TZFILE)
- TZFILE => NULL()
- WRITE(ILUOUT0,*) "NLIGNE wet graupel",ILINE
- ILINE=2
- WRITE(ILUOUT0,*) "ILINE=",ILINE
- WRITE(ILUOUT0,*) "ZTC_T_W(ILINE),ZELEV_T_W(ILINE)", ZTC_T_W(ILINE),ZELEV_T_W(ILINE)
- WRITE(ILUOUT0,*) "ZM_T_W(ILINE),ZS11_CARRE_T_W(ILINE),ZS22_CARRE_T_W(ILINE),ZRE_S22S11_T_W(ILINE)",&
- ZM_T_W(ILINE),ZS11_CARRE_T_W(ILINE),ZS22_CARRE_T_W(ILINE),ZRE_S22S11_T_W(ILINE)
- WRITE(ILUOUT0,*) "ZIM_S22S11_T_W(ILINE),ZRE_S22FMS11FT_T_W(ILINE),ZIM_S22FT_T_W(ILINE),ZIM_S11FT_T_W(ILINE)",&
- ZIM_S22S11_T_W(ILINE),ZRE_S22FMS11FT_T_W(ILINE),ZIM_S22FT_T_W(ILINE),ZIM_S11FT_T_W(ILINE)
-
- !hail
- IF (GHAIL) THEN
- CALL IO_File_add2list(TZFILE,YFILE_COEFINT(5),'TXT','READ')
- CALL IO_File_open(TZFILE,KRESP=IRESP)
- IUNIT = TZFILE%NLU
- IF ( IRESP /= 0 ) THEN
- WRITE(YMSG,*) "problem opening file ",TRIM(YFILE_COEFINT(5))
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RADAR_SCATTERING',YMSG)
- ENDIF
- ILINE=1
- DO WHILE (ILINE .LE. INB_LINE(5))
- READ( UNIT=IUNIT, FMT=6003,IOSTAT=IRESP ) ZTC_T_H(ILINE),ZELEV_T_H(ILINE),&
- ZFW_T_H(ILINE),ZM_T_H(ILINE),ZS11_CARRE_T_H(ILINE),ZS22_CARRE_T_H(ILINE),ZRE_S22S11_T_H(ILINE),&
- ZIM_S22S11_T_H(ILINE),ZRE_S22FMS11FT_T_H(ILINE),ZIM_S22FT_T_H(ILINE),ZIM_S11FT_T_H(ILINE)
- ILINE=ILINE+1
- ENDDO
- CALL IO_File_close(TZFILE)
- TZFILE => NULL()
- WRITE(ILUOUT0,*) "NLIGNE hail",ILINE
- ILINE=2
- WRITE(ILUOUT0,*) "ILINE=",ILINE
- WRITE(ILUOUT0,*) "ZTC_T_H(ILINE),ZELEV_T_H(ILINE)", ZTC_T_H(ILINE),ZELEV_T_H(ILINE)
- WRITE(ILUOUT0,*) "ZM_T_H(ILINE),ZS11_CARRE_T_H(ILINE),ZS22_CARRE_T_H(ILINE),ZRE_S22S11_T_H(ILINE)",&
- ZM_T_W(ILINE),ZS11_CARRE_T_H(ILINE),ZS22_CARRE_T_H(ILINE),ZRE_S22S11_T_H(ILINE)
- WRITE(ILUOUT0,*) "ZIM_S22S11_T_H(ILINE),ZRE_S22FMS11FT_T_H(ILINE),ZIM_S22FT_T_H(ILINE),ZIM_S11FT_T_H(ILINE)",&
- ZIM_S22S11_T_H(ILINE),ZRE_S22FMS11FT_T_H(ILINE),ZIM_S22FT_T_H(ILINE),ZIM_S11FT_T_H(ILINE)
- ENDIF
- ENDIF !END IF T-MATRIX => END OF LOOKUP TABLE READING
-
- !============== loop over elevations =================
- IEL=NBELEV(JI)
- WRITE(ILUOUT0,*) "NBELEV(JI)",NBELEV(JI)
- WRITE(ILUOUT0,*) "INPTS_V",INPTS_V
- DO JEL=1,IEL
- WRITE(ILUOUT0,*) "JEL",JEL
- JL=1
- JV=1
- WRITE(ILUOUT0,*) "JL,JV",JL,JV
- WRITE(ILUOUT0,*) "PELEV(JI,JEL,JL,JV)*180./XPI",PELEV(JI,JEL,JL,JV)*180./XPI
- JL=INBSTEPMAX
- JV=INPTS_V
- WRITE(ILUOUT0,*) "JL,JV",JL,JV
- WRITE(ILUOUT0,*) "PELEV(JI,JEL,JL,JV)*180./XPI",PELEV(JI,JEL,JL,JV)*180./XPI
- !============== loop over azimuths =================
- DO JAZ=1,INBAZIM
- DO JH=1,INPTS_H !horizontal discretization of the beam
- DO JV=1,INPTS_V ! vertical discretization (we go down to check partial masks)
- IF(LATT) THEN
- ZAERINT=1.
- ZAVRINT=1.
- ZAEIINT=1.
- ZAESINT=1.
- ZAVSINT=1.
- ZAEGINT=1.
- ZAVGINT=1.
- ZAEHINT=1.
- ZAVHINT=1.
- END IF
- !Loop over the ranges for one azimuth. If the range is masked, the reflectivity for all the consecutive ranges is set to 0
- LPART_MASK=.FALSE.
- LOOPJL: DO JL=1,INBSTEPMAX
- IF(LPART_MASK) THEN ! THIS RAY IS MASKED
- ZREFL(JI,JEL,JAZ,JL:INBSTEPMAX,JH,JV,1)=0.
- EXIT LOOPJL
- ELSE
- ! if not underground or outside of the MESO-NH domain (PT_RAY : temperature interpolated along the rays)
- IF(PT_RAY(JI,JEL,JAZ,JL,JH,JV) /= -XUNDEF) THEN
- !
- !---------------------------------------------------------------------------------------------------
- !* 2. RAINDROPS
- ! ---------
- !
- IF(SIZE(PR_RAY,1) > 0) THEN ! if PR_RAY is available for at least one radar
- !contenu en hydrometeore
- ZM=PRHODREF_RAY(JI,JEL,JAZ,JL,JH,JV)*PR_RAY(JI,JEL,JAZ,JL,JH,JV)
- IF (GLIMA) ZCC=PRHODREF_RAY(JI,JEL,JAZ,JL,JH,JV)*PCR_RAY(JI,JEL,JAZ,JL,JH,JV)
- !ZM_MIN : min value for rain content (10**-7 <=> Z=-26 dBZ)mixing ratio
- IF (GLIMA) THEN
- GCALC=((ZM > ZM_MIN).AND.(ZCC > 10**ZCC_MIN(1)))
- ELSE
- GCALC=(ZM > ZM_MIN)
- ENDIF
- IF(GCALC ) THEN
- !calculation of the dielectrique constant (permittitivité relative)
- ! for liquid water from function QEPSW
- !(defined in mode_fscatter.f90 => equation 3.6 p 64)
- YTYPE='r'
- ZQMW=SQRT(QEPSW(PT_RAY(JI,JEL,JAZ,JL,JH,JV),XLIGHTSPEED/XLAM_RAD(JI)))
- !ZLBDA : slope distribution parameter (equation 2.6 p 23)
- IF (GLIMA) THEN
- ZLBDA=( ZLBR*ZCC / ZM )**ZLBEXR
- ELSE
- ZLBDA=ZLBR*(ZM)**ZLBEXR
- ENDIF
- ZQK=(ZQMW**2-1.)/(ZQMW**2+2.) !dielectric factor (3.43 p 56)
- ZFW=0 !Liquid water fraction (only for melting graupel => 0 for rain)
-
- !compteur=compteur+1
- !---------------------------------------------------
- ! ------------ DIFFUSION --------------
- !---------------------------------------------------
- !******************************* NDIFF=0 or 4 *********************************
- IF(NDIFF==0.OR.NDIFF==4) THEN ! Rayleigh
- !ZREFLOC(1:2) : Zh et Zv = int(sigma(D)*N(D)) (eq 1.6 p 16)
- !with N(D) formulation (eq 2.2 p 23) and sigma Rayleigh (3.41 p 55)
- !MOMG : gamma function defined in mong.f90
- !XCCR = 1.E7; XLBEXR = -0.25! Marshall-Palmer law (radar_rain_ice.f90)
- !ZCXR : -1 (Xi coeff in equation 2.3 p 23)
- ZREFLOC(1:2)=1.E18*ZCCR*ZLBDA**(ZCXR-6.)*MOMG(ZALPHAR,ZNUR,6.)
- IF(LWREFL) THEN ! weighting by reflectivities
- !ZREFL(...,IVDOP)=radial velocity (IVDOP=9), weighted by reflectivity and
- !taking into account raindrops fall velocity (ZCR = 842, XDR = 0.8 -> 2.8 p23 et 2.1 p24)
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=-ZCR*SIN(PELEV(JI,JEL,JL,JV)) &
- *1.E18*ZCCR*ZLBDA**(ZCXR-6.-ZDR)*MOMG(ZALPHAR,ZNUR,6.+ZDR)
- ELSE
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)=ZCCR*ZLBDA**ZCXR ! N0j of equation 2.3 p23 (density of particules)
- !projection of fall velocity only
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=-ZCR*SIN(PELEV(JI,JEL,JL,JV)) &
- *ZCCR*ZLBDA**(ZCXR-ZDR)*MOMG(ZALPHAR,ZNUR,ZDR)
- END IF ! end weighting by reflectivities
- IF(LATT) THEN ! Calculation of Extinction coefficient
- IF(NDIFF==0) THEN ! Rayleigh 3rd order : calculation from equations
- ! 3.39 p55 : extinction coeff = int(extinction_section(D) * N(D))
- ! 2.2 and 2.3 p23: simplification of int(D**p * N(D)) and N0j
- ! 3.42 p57 : extinction_section(D)
- ZAETMP(:)=ZCCR*ZLBDA**ZCXR*(XPI**2/XLAM_RAD(JI)*AIMAG(ZQK)&
- *MOMG(ZALPHAR,ZNUR,ZBR)/ZLBDA**ZBR)
- ELSE ! Rayleigh 6th order ! eq 3.52 p 58 for extinction coefficient
- ZAETMP(:)=ZCCR*ZLBDA**ZCXR*(XPI**2/XLAM_RAD(JI)*AIMAG(ZQK)&
- *MOMG(ZALPHAR,ZNUR,ZBR)/ZLBDA**ZBR &
- +XPI**4/15./XLAM_RAD(JI)**3*AIMAG(ZQK**2*(ZQMW**4+27.*ZQMW**2+38.) &
- /(2.*ZQMW**2+3.))*MOMG(ZALPHAR,ZNUR,5.*ZBR/3.)/ZLBDA**(5.*ZBR/3.)&
- +2.*XPI**5/3. /XLAM_RAD(JI)**4*REAL(ZQK**2) &
- *MOMG(ZALPHAR,ZNUR,2.*ZBR) /ZLBDA**(2.*ZBR))
- END IF
- END IF ! end IF(LATT)
- ZRE_S22S11_R=0
- ZIM_S22S11_R=0
- ZS22_CARRE_R=0
- ZS11_CARRE_R=0
- !******************************* NDIFF==7 ************************************
- ELSE IF(NDIFF==7) THEN !T-matrix
- ZREFLOC(:)=0
- IF(LATT) ZAETMP(:)=0
- IF (GLIMA) THEN
- CALL CALC_KTMAT_LIMA(PELEV(JI,JEL,JL,JV),&
- PT_RAY(JI,JEL,JAZ,JL,JH,JV),ZCC,ZM,&
- ZELEV_MIN(1),ZELEV_MAX(1),ZELEV_STEP(1),&
- ZTC_MIN(1),ZTC_MAX(1),ZTC_STEP(1),&
- ZCC_MIN(1),ZCC_MAX(1),ZCC_STEP(1),&
- ZEXPM_MIN,ZEXPM_MAX,ZEXPM_STEP,&
- ITMAT,ZELEV_RED,ZTC_RED,ZCC_RED,ZM_RED)
- ELSE
- CALL CALC_KTMAT(PELEV(JI,JEL,JL,JV),&
- PT_RAY(JI,JEL,JAZ,JL,JH,JV),ZFW,ZM,&
- ZELEV_MIN(1),ZELEV_MAX(1),ZELEV_STEP(1),&
- ZTC_MIN(1),ZTC_MAX(1),ZTC_STEP(1),&
- ZFW_MIN(1),ZFW_MAX(1),ZFW_STEP(1),&
- ZEXPM_MIN,ZEXPM_MAX,ZEXPM_STEP,&
- ITMAT,ZELEV_RED,ZTC_RED,ZFW_RED,ZM_RED)
- ENDIF
- IF (ITMAT(1) .NE. -NUNDEF) THEN
- DO JIND=1,SIZE(KMAT_COEF,2),1
- KMAT_COEF(1,JIND)=ZS11_CARRE_T_R(ITMAT(JIND))
- KMAT_COEF(2,JIND)=ZS22_CARRE_T_R(ITMAT(JIND))
- KMAT_COEF(3,JIND)=ZRE_S22S11_T_R(ITMAT(JIND))
- KMAT_COEF(4,JIND)=ZIM_S22S11_T_R(ITMAT(JIND))
- KMAT_COEF(5,JIND)=ZRE_S22FMS11FT_T_R(ITMAT(JIND))
- KMAT_COEF(6,JIND)=ZIM_S22FT_T_R(ITMAT(JIND))
- KMAT_COEF(7,JIND)=ZIM_S11FT_T_R(ITMAT(JIND))
- ENDDO
- IF (GLIMA) THEN
- CALL INTERPOL(ZELEV_RED,ZTC_RED,ZCC_RED,ZM_RED,KMAT_COEF,ZS11_CARRE_R,ZS22_CARRE_R,&
- ZRE_S22S11_R,ZIM_S22S11_R,ZRE_S22FMS11F,ZIM_S22FT,ZIM_S11FT)
- ELSE
- CALL INTERPOL(ZELEV_RED,ZTC_RED,ZFW_RED,ZM_RED,KMAT_COEF,ZS11_CARRE_R,ZS22_CARRE_R,&
- ZRE_S22S11_R,ZIM_S22S11_R,ZRE_S22FMS11F,ZIM_S22FT,ZIM_S11FT)
- ENDIF
- ELSE
- ZS11_CARRE_R=0
- ZS22_CARRE_R=0
- ZRE_S22S11_R=0
- ZIM_S22S11_R=0
- ZRE_S22FMS11F=0
- ZIM_S22FT=0
- ZIM_S11FT=0
- END IF
- ZREFLOC(1)=1.E18*(XLAM_RAD(JI))**4/(XPI**5*.93)*4*XPI*ZS22_CARRE_R
- ZREFLOC(2)=1.E18*(XLAM_RAD(JI))**4/(XPI**5*.93)*4*XPI*ZS11_CARRE_R
- ZREFLOC(3)=180.E3/XPI*XLAM_RAD(JI)*ZRE_S22FMS11F
- IF (GLIMA) THEN
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)*ZREFLOC(1) &
- -ZCR*SIN(PELEV(JI,JEL,JL,JV))*ZREFLOC(1) &
- *1.E18*(XLAM_RAD(JI)/XPI)**4/.93*ZCC/4./ZLBDA**(2+ZDR)
- ELSE
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)*ZREFLOC(1) &
- -ZCR*SIN(PELEV(JI,JEL,JL,JV))*ZREFLOC(1) &
- *1.E18*(XLAM_RAD(JI)/XPI)**4/.93*ZCCR/4./ZLBDA**(3+ZDR)
- ENDIF
- IF(LATT) THEN
- ZAETMP(1)=ZIM_S22FT*XLAM_RAD(JI)*2
- ZAETMP(2)=ZIM_S11FT*XLAM_RAD(JI)*2
- END IF
- !******************************* NDIFF=1 or 3 *********************************
- ! Gauss Laguerre integration
- ELSE ! MIE OR T-MATRIX OR RAYLEIGH FOR ELLIPSOIDES
- ZREFLOC(:)=0.
- IF(LATT) ZAETMP(:)=0.
- DO JJ=1,NPTS_GAULAG ! ****** Gauss-Laguerre quadrature
- SELECT CASE(NDIFF)
- CASE(1) ! *************** NDIFF=1 MIE *****************
- ! subroutine BHMIE defined in mode_fscatter.f90
- ! calculate extinction coefficient ZQEXT(1),scattering : ZQSCA
- ! and backscattering ZQBACK(1) on the horizontal plan (spheroid)
- CALL BHMIE(XPI/XLAM_RAD(JI)*ZX(JJ)/ZLBDA,ZQMW,ZQEXT(1),ZQSCA,ZQBACK(1))
- ZQBACK(2)=ZQBACK(1) !=> same because sphere
- ZQEXT(2)=ZQEXT(1) ! modif Clotilde 23/04/2012
- ZQBACK(3)=0. !=> 0 because sphere
- CASE(3) !****************** NDIFF==3 RG RAYLEIGH FOR ELLIPSOIDES ***********************
- IF(ARF(ZX(JJ)/ZLBDA)==1.) THEN
- ZLB=1./3.
- ELSE
- ZLB=1./(ARF(ZX(JJ)/ZLBDA))**2-1. ! f**2
- ZLB=(1.+ZLB)/ZLB*(1.-ATAN(SQRT(ZLB))/SQRT(ZLB)) ! lambda_b
- IF(ZX(JJ)/ZLBDA>16.61E-3) PRINT*, 'Negative axis ratio; reduce NPTS_GAULAG.'
- END IF
- ! equation 3.44 p 56 (ZX**4 instead of ZX**6 but ZQBACK is multiplied after by ZX**2)
- ZQBACK(1)=4.*(XPI/XLAM_RAD(JI)*ZX(JJ)/ZLBDA)**4&
- *ABS((ZQMW**2-1.)/3./(1.+.5*(1.-ZLB)*(ZQMW**2-1.)))**2
- ! equation 3.45 p 56
- ZQBACK(2)=4.*(XPI/XLAM_RAD(JI)*ZX(JJ)/ZLBDA)**4*ABS((ZQMW**2-1.)/3.*&
- (SIN(PELEV(JI,JEL,JL,JV))**2/(1.+.5*(1.-ZLB)*(ZQMW**2-1.))+& ! PELEV=PI+THETA_I
- COS(PELEV(JI,JEL,JL,JV))**2/(1.+ZLB*(ZQMW**2-1.))) )**2 !
- ! KDP from equation 3.49
- ZQBACK(3)=ZX(JJ)/ZLBDA**3*REAL((ZQMW**2-1.)**2*(3.*ZLB-1.)/(2.+(ZQMW**2-1.)*(ZLB+1.) &
- +ZLB*(1.-ZLB)*(ZQMW**2-1.)**2))
- IF(LATT) THEN
- ! equations 3.48 and 3.49 p57
- ZQEXT(1)=4.*(XPI/XLAM_RAD(JI)*ZX(JJ)/ZLBDA)*AIMAG((ZQMW**2-1.)/3./(1.+.5*(1.-ZLB)*(ZQMW**2-1.)))
- ZQEXT(2)=4.*(XPI/XLAM_RAD(JI)*ZX(JJ)/ZLBDA)*AIMAG((ZQMW**2-1.)/3.*&
- (SIN(PELEV(JI,JEL,JL,JV))**2/(1.+.5*(1.-ZLB)*(ZQMW**2-1.))+& ! PELEV=PI+THETA_I
- COS(PELEV(JI,JEL,JL,JV))**2/(1.+ZLB*(ZQMW**2-1.))))
- END IF
- END SELECT !end SELECT NDIFF
- !incrementation of the reflectivity and Kdp(1,2,3,4 for Zh, Zv, )
- !with the backscattering coefficients for each point of the GAULAG distribution
- ! or each diameter D
- ZREFLOC(1:3)=ZREFLOC(1:3)+ZQBACK(1:3)*ZX(JJ)**2*ZW(JJ)
- ZREFLOC(4)=ZREFLOC(4)+ZQBACK(1)*ZX(JJ)**(2+ZDR)*ZW(JJ)
- !same for attenuation with extinction coefficient
- IF(LATT) ZAETMP(:)=ZAETMP(:)+ZQEXT(:)*ZX(JJ)**2*ZW(JJ)
- END DO ! ****** end loop Gauss-Laguerre quadrature
-
- ZREFLOC(1:2)=1.E18*ZREFLOC(1:2)*(XLAM_RAD(JI)/XPI)**4/.93*ZCCR/4./ZLBDA**3
- ZREFLOC(3)=ZREFLOC(3)*XPI**2/6./XLAM_RAD(JI)*ZCCR/ZLBDA &
- *180.E3/XPI ! (in deg/km)
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)*ZREFLOC(1) &
- -ZCR*SIN(PELEV(JI,JEL,JL,JV))*ZREFLOC(4) &
- *1.E18*(XLAM_RAD(JI)/XPI)**4/.93*ZCCR/4./ZLBDA**(3+ZDR)
-
- !********* for all cases with Gauss-Laguerre integration
- ZRE_S22S11_R=0
- ZIM_S22S11_R=0
- ZS22_CARRE_R=0
- ZS11_CARRE_R=0
- IF(LATT) ZAETMP(:)=ZAETMP(:)*XPI*ZCCR*ZLBDA**(ZCXR-2.*ZBR/3.)/(4.*GAMMA(ZNUR))
- END IF ! ****************** End if for each type of diffusion ************************
- !incrementation of ZHH, ZDR and KDP
- ZREFL(JI,JEL,JAZ,JL,JH,JV,1:3)=ZREFL(JI,JEL,JAZ,JL,JH,JV,1:3)+ZREFLOC(1:3)
- ! ZER (Z due to raindrops)
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IZER)=ZREFLOC(1)
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IZDA)=ZREFLOC(2) !Zvv for ZDR due to rain
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IKDR)=ZREFLOC(3) !Zvv for ZDR due to rain
-
- ! RhoHV due to rain
- IF (ZS22_CARRE_R*ZS11_CARRE_R .GT. 0) THEN
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IRHR)=SQRT(ZRE_S22S11_R**2+ZIM_S22S11_R**2)/SQRT(ZS22_CARRE_R*ZS11_CARRE_R)
- ELSE
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IRHR)=1
- END IF
- IF(LATT) THEN
- ZAELOC(JI,JEL,JAZ,JL,JH,JV,:)=ZAETMP(:) ! specific attenuation due to rain
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IAER)=ZAETMP(1)
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IAVR)=ZAETMP(2)
- ! for ranges over 1, correction of attenuation on reflectivity due to rain
- IF(JL>1) THEN
- ZAERINT=ZAERINT*EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAER)*XSTEP_RAD)
- ZAVRINT=ZAVRINT*EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAVR)*XSTEP_RAD)
- END IF
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IZER)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IZER)*ZAERINT ! Z_r attenuated
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IZDA)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IZDA)*ZAVRINT ! ZVr attenuated
- END IF !end IF(LATT)
- END IF
- ! mimimum rainwater mixing ratio
- ! Total attenuation even if no hydrometeors (equation 1.7 p 17)
- IF(LATT.AND.JL>1) ZREFL(JI,JEL,JAZ,JL,JH,JV,IATR)=ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IATR) &
- *EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAER)*XSTEP_RAD)
- END IF ! **************** end RAIN (end IF SIZE(PR_RAY,1) > 0)
- !
- !---------------------------------------------------------------------------------------------------
- !* 3. PRISTINE ICE
- ! ---------
- !
- IF (SIZE(PI_RAY,1)>0) THEN
- ZM=PRHODREF_RAY(JI,JEL,JAZ,JL,JH,JV)*PI_RAY(JI,JEL,JAZ,JL,JH,JV) !ice content
- IF (PRHODREF_RAY(JI,JEL,JAZ,JL,JH,JV)==-XUNDEF .OR. PI_RAY(JI,JEL,JAZ,JL,JH,JV)==-XUNDEF) ZM=-XUNDEF
- IF (GLIMA) THEN
- ZC=PRHODREF_RAY(JI,JEL,JAZ,JL,JH,JV)*PCIT_RAY(JI,JEL,JAZ,JL,JH,JV)
- IF (PRHODREF_RAY(JI,JEL,JAZ,JL,JH,JV)==-XUNDEF .OR. PCIT_RAY(JI,JEL,JAZ,JL,JH,JV)==-XUNDEF) ZC=-XUNDEF
- ELSE
- ZC=PCIT_RAY(JI,JEL,JAZ,JL,JH,JV)
- ENDIF
- IF(ZM>ZM_MIN .AND. ZC> 527.82) THEN
- ! cit > 527.82 otherwise pbs due to interpolation
- !ice dielectric constant (QPESI defined in mode_fscatter, equation 3.65 p 65)
- ZEPSI=QEPSI(PT_RAY(JI,JEL,JAZ,JL,JH,JV),XLIGHTSPEED/XLAM_RAD(JI))
- ZQMI=SQRT(ZEPSI)
- ZQK=(ZQMI**2-1.)/(ZQMI**2+2.)
- !see 3.77 p68 : to replace Dg by an equivalent diameter De of pure ice, a multiplicative
- !melting factor has to be added
- ZDMELT_FACT=(6.*ZAI)/(XPI*.92*XRHOLW)
- ZEXP=2.*ZBI !XBI = 2.5 (Plates) in ini_radar.f90 (bj tab 2.1 p24)
- !ZLBDA : slope distribution parameter (equation 2.6 p 23)
- IF (GLIMA) THEN
- ZLBDA=(ZLBI*ZC/ZM)**ZLBEXI
- ELSE
- ZLBDA=ZLBI*(ZM/ZC)**ZLBEXI
- ENDIF
- ! Rayleigh or Rayleigh-Gans (=> Rayleigh) or Rayleigh with 6th order for attenuation
- ! (pristine ice = sphere),
- IF(NDIFF==0.OR.NDIFF==3.OR.NDIFF==4) THEN
- !ZREFLOC(1:2) : Zh et Zv from equation 2.2 p23 and Cristals parameters
- !ZEQICE=0.224 (radar_rain_ice.f90) factor used to convert the ice crystals
- !reflectivity into an equivalent liquid water reflectivity (from Smith, JCAM 84)
- ZREFLOC(1:2)=ZEQICE*.92**2*ZDMELT_FACT**2*1.E18*ZC &
- *ZLBDA**(ZCXI-ZEXP)*MOMG(ZALPHAI,ZNUI,ZEXP)
- ZREFLOC(3)=0.
- IF(LWREFL) THEN ! weighting by reflectivities
- !calculation of radial velocity
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)&
- -ZCI*SIN(PELEV(JI,JEL,JL,JV))*ZEQICE*.92**2*ZDMELT_FACT**2&
- *1.E18*ZC*ZLBDA**(ZCXI-ZEXP-ZDI)&
- *MOMG(ZALPHAI,ZNUI,ZEXP+ZDI)
- ELSE
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)&
- +ZC*ZLBDA**ZCXI
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)&
- -ZCI*SIN(PELEV(JI,JEL,JL,JV))&
- *ZC&
- *ZLBDA**(ZCXI-ZDI)*MOMG(ZALPHAI,ZNUI,ZDI)
- END IF
- IF(LATT) THEN ! Calculation of Extinction coefficient
- ! Rayleigh 3rd order
- IF(NDIFF==0.OR.NDIFF==3) THEN
- ZAETMP(:)=ZC*ZLBDA**ZCXI&
- *(ZDMELT_FACT*XPI**2/XLAM_RAD(JI)*AIMAG(ZQK)&
- *MOMG(ZALPHAI,ZNUI,ZBI)/ZLBDA**ZBI)
- ! Rayleigh 6th order
- ELSE
- ZAETMP(:)=ZC*ZLBDA**ZCXI*(&
- ZDMELT_FACT*XPI**2/XLAM_RAD(JI)*AIMAG(ZQK)&
- *MOMG(ZALPHAI,ZNUI,ZBI)/ZLBDA**ZBI&
- +ZDMELT_FACT**(5./3.)*XPI**4/15./XLAM_RAD(JI)**3&
- *AIMAG(ZQK**2*(ZQMI**4+27.*ZQMI**2+38.)&
- /(2.*ZQMI**2+3.))*MOMG(ZALPHAI,ZNUI,5.*ZBI/3.)/ZLBDA**(5.*ZBI/3.) &
- +ZDMELT_FACT**2*2.*XPI**5/3. /XLAM_RAD(JI)**4*REAL(ZQK**2)&
- *MOMG(ZALPHAI,ZNUI,2.*ZBI)/ZLBDA**(2.*ZBI))
- END IF
- END IF
- ELSE ! (if NDIFF=1 or NDIFF=7) => MIE (if choice=T-Matrix => Mie)
- ZREFLOC(:)=0.
- IF(LATT) ZAETMP(:)=0.
- DO JJ=1,NPTS_GAULAG ! ****** Gauss-Laguerre quadrature
- ZD=ZX(JJ)**(1./ZALPHAI)/ZLBDA !equivaut au ZDELTA_EQUIV olivier
- ZRHOI=6*ZAI*ZD**(ZBI-3.)/XPI !pristine ice density
- ZNUM=1.+2.*ZRHOI*(ZEPSI-1.)/(ZRHOPI*(ZEPSI+2.))
- ZDEN=1.-ZRHOI*(ZEPSI-1.)/(ZRHOPI*(ZEPSI+2.))
- ZQM=sqrt(ZNUM/ZDEN)
- CALL BHMIE(XPI/XLAM_RAD(JI)*ZD,ZQM,ZQEXT(1),ZQSCA,ZQBACK(1))
- ZQBACK(2)=ZQBACK(1)
- ZQEXT(2)=ZQEXT(1) ! modif Clotilde 23/04/2012
- ZQBACK(3)=0.
- ZREFLOC(1:3)=ZREFLOC(1:3)+ZQBACK(1:3)*ZX(JJ)**(ZNUI-1.)*ZD**2*ZW(JJ)
- ZREFLOC(4)=ZREFLOC(4)+ZQBACK(1)*ZX(JJ)**(ZNUI-1.+ZDI/ZALPHAI)*ZD**2*ZW(JJ)
- IF(LATT) ZAETMP(:)=ZAETMP(:)+ZQEXT(:)*ZX(JJ)**(ZNUI-1.)*ZD**2*ZW(JJ)
- END DO ! **************** end loop Gauss-Laguerre quadrature
-
- ZREFLOC(1:2)=ZREFLOC(1:2)*1.E18*(XLAM_RAD(JI)/XPI)**4/.93*ZC &
- *ZLBDA**(ZCXI)/(4.*GAMMA(ZNUI))
-
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)&
- +PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)*ZREFLOC(1) &
- -ZCI*SIN(PELEV(JI,JEL,JL,JV))*ZREFLOC(4) &
- *1.E18*(XLAM_RAD(JI)/XPI)**4*ZC &
- *ZLBDA**(ZCXI-ZDI)/(4.*GAMMA(ZNUI)*.93)
- IF(LATT) ZAETMP(:)=ZAETMP(:)*XPI*ZC*ZLBDA**(ZCXI)/(4.*GAMMA(ZNUI))
- END IF !**************** end loop for each type of diffusion
- ZREFL(JI,JEL,JAZ,JL,JH,JV,1:3)=ZREFL(JI,JEL,JAZ,JL,JH,JV,1:3)+ZREFLOC(1:3)
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IZEI)=ZREFLOC(1) ! z_e due to pristine ice
- IF(LATT) THEN
- ZAELOC(JI,JEL,JAZ,JL,JH,JV,:)=ZAELOC(JI,JEL,JAZ,JL,JH,JV,:)+ZAETMP(:)
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IAEI)=ZAETMP(1)
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IAVI)=ZAETMP(2)
- IF(JL>1) ZAEIINT=ZAEIINT*EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAEI)*XSTEP_RAD)
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IZEI)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IZEI)*ZAEIINT ! Z_i attenuated
- END IF
- END IF !********************* end IF (SIZE(PI_RAY,1)>0)
-
- ! Total attenuation even if no hydrometeors
- IF(LATT.AND.JL>1) ZREFL(JI,JEL,JAZ,JL,JH,JV,IATI)=ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IATI) &
- *EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAEI)*XSTEP_RAD)
- ZRE_S22S11_I=0
- ZIM_S22S11_I=0
- ZS22_CARRE_I=0
- ZS11_CARRE_I=0
- END IF !******************** end IF (SIZE(PI_RAY,1)>0)
- !---------------------------------------------------------------------------------------------------
- !* 4. SNOW
- ! -----
- IF (SIZE(PS_RAY,1)>0) THEN
- ZM=PRHODREF_RAY(JI,JEL,JAZ,JL,JH,JV)*PS_RAY(JI,JEL,JAZ,JL,JH,JV) !snow content
- IF(ZM > ZM_MIN) THEN
- YTYPE='s'
- !ZQMI: same formulation than for ice because snow is simulated only
- !above melting leyer (3.5.4 p 67)
- ZFW=0
- ZQMI=SQRT(QEPSI(PT_RAY(JI,JEL,JAZ,JL,JH,JV),XLIGHTSPEED/XLAM_RAD(JI)))
- ZQK=(ZQMI**2-1.)/(ZQMI**2+2.) !ajout de Clotilde 23/04/2012
- ZDMELT_FACT=6.*ZAS/(XPI*.92*XRHOLW)
- ZEXP=2.*ZBS !XBS = 1.9 in ini_radar.f90 (bj tab 2.1 p24)
- !dans ini_rain_ice.f90 :
- IF (GLIMA .AND. LSNOW_T_L) THEN
- IF (PT_RAY(JI,JEL,JAZ,JL,JH,JV)>263.15) THEN
- ZLBDA = MAX(MIN(XLBDAS_MAX_L, 10**(14.554-0.0423*PT_RAY(JI,JEL,JAZ,JL,JH,JV))),XLBDAS_MIN_L) &
- *XTRANS_MP_GAMMAS_L
- ELSE
- ZLBDA = MAX(MIN(XLBDAS_MAX_L, 10**(6.226-0.0106*PT_RAY(JI,JEL,JAZ,JL,JH,JV))),XLBDAS_MIN_L) &
- *XTRANS_MP_GAMMAS_L
- END IF
- ZN=ZNS*ZM*ZLBDA**ZBS
- ELSE IF (.NOT.GLIMA .AND. LSNOW_T_I) THEN
- IF (PT_RAY(JI,JEL,JAZ,JL,JH,JV)>263.15) THEN
- ZLBDA = MAX(MIN(XLBDAS_MAX_I, 10**(14.554-0.0423*PT_RAY(JI,JEL,JAZ,JL,JH,JV))),XLBDAS_MIN_I) &
- *XTRANS_MP_GAMMAS_I
- ELSE
- ZLBDA = MAX(MIN(XLBDAS_MAX_I, 10**(6.226-0.0106*PT_RAY(JI,JEL,JAZ,JL,JH,JV))),XLBDAS_MIN_I) &
- *XTRANS_MP_GAMMAS_I
- END IF
- ZN=ZNS*ZM*ZLBDA**ZBS
- ELSE
- ZLBDA= ZLBS*(ZM)**ZLBEXS
- ZN=ZCCS*ZLBDA**ZCXS
- END IF
- ! Rayleigh or Rayleigh-Gans or Rayleigh with 6th order for attenuation
- IF(NDIFF==0.OR.NDIFF==3.OR.NDIFF==4) THEN
- ZREFLOC(1:2)=ZEQICE*.92**2*ZDMELT_FACT**2*1.E18*ZN*ZLBDA**(ZEXP)*MOMG(ZALPHAS,ZNUS,ZEXP)
- ZREFLOC(3)=0.
- IF(LWREFL) THEN ! weighting by reflectivities
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)&
- -ZCS*SIN(PELEV(JI,JEL,JL,JV))*ZEQICE*.92**2*ZDMELT_FACT**2&
- *1.E18*ZN*ZLBDA**(ZEXP-ZDS)*MOMG(ZALPHAS,ZNUS,ZEXP+ZDS)
- ELSE
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)+ZN
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)&
- -ZCS*SIN(PELEV(JI,JEL,JL,JV))&
- *ZN*ZLBDA**(ZDS)*MOMG(ZALPHAS,ZNUS,ZDS)
- END IF
- IF(LATT) THEN
- IF(NDIFF==0.OR.NDIFF==3) THEN
- ZAETMP(:)=ZN*(ZDMELT_FACT*XPI**2/XLAM_RAD(JI)*AIMAG(ZQK)&
- *MOMG(ZALPHAS,ZNUS,ZBS)/ZLBDA**ZBS)
- ELSE
- ZAETMP(:)=ZN*(ZDMELT_FACT*XPI**2/XLAM_RAD(JI)*AIMAG(ZQK) &
- *MOMG(ZALPHAS,ZNUS,ZBS)/ZLBDA**ZBS &
- +ZDMELT_FACT**(5./3.)*XPI**4/15./XLAM_RAD(JI)**3 &
- *AIMAG(ZQK**2*(ZQMI**4+27.*ZQMI**2+38.) &
- /(2.*ZQMI**2+3.))*MOMG(ZALPHAS,ZNUS,5.*ZBS/3.)/ZLBDA**(5.*ZBS/3.) &
- +ZDMELT_FACT**2 *2.*XPI**5/3. /XLAM_RAD(JI)**4*REAL(ZQK**2) &
- *MOMG(ZALPHAS,ZNUS,2.*ZBS)/ZLBDA**(2.*ZBS))
- END IF
- END IF
- ZRE_S22S11_S=0
- ZIM_S22S11_S=0
- ZS22_CARRE_S=0
- ZS11_CARRE_S=0
- !******************************* NDIFF==7 ************************************
- ELSE IF(NDIFF==7) THEN
-
- ZREFLOC(:)=0
- IF(LATT) ZAETMP(:)=0
- CALL CALC_KTMAT(PELEV(JI,JEL,JL,JV), PT_RAY(JI,JEL,JAZ,JL,JH,JV),&
- ZFW,ZM,&
- ZELEV_MIN(2),ZELEV_MAX(2),ZELEV_STEP(2),&
- ZTC_MIN(2),ZTC_MAX(2),ZTC_STEP(2),&
- ZFW_MIN(2),ZFW_MAX(2),ZFW_STEP(2),&
- ZEXPM_MIN,ZEXPM_MAX,ZEXPM_STEP,&
- ITMAT,ZELEV_RED,ZTC_RED,ZFW_RED,ZM_RED)
-
- IF (ITMAT(1) .NE. -NUNDEF) THEN
- DO JIND=1,SIZE(KMAT_COEF,2),1
- KMAT_COEF(1,JIND)=ZS11_CARRE_T_S(ITMAT(JIND))
- KMAT_COEF(2,JIND)=ZS22_CARRE_T_S(ITMAT(JIND))
- KMAT_COEF(3,JIND)=ZRE_S22S11_T_S(ITMAT(JIND))
- KMAT_COEF(4,JIND)=ZIM_S22S11_T_S(ITMAT(JIND))
- KMAT_COEF(5,JIND)=ZRE_S22FMS11FT_T_S(ITMAT(JIND))
- KMAT_COEF(6,JIND)=ZIM_S22FT_T_S(ITMAT(JIND))
- KMAT_COEF(7,JIND)=ZIM_S11FT_T_S(ITMAT(JIND))
- ENDDO
- CALL INTERPOL(ZELEV_RED,ZTC_RED,ZFW_RED,ZM_RED,KMAT_COEF,ZS11_CARRE_S,ZS22_CARRE_S,&
- ZRE_S22S11_S,ZIM_S22S11_S,ZRE_S22FMS11F,ZIM_S22FT,ZIM_S11FT)
- ELSE
- ZS11_CARRE_S=0
- ZS22_CARRE_S=0
- ZRE_S22S11_S=0
- ZIM_S22S11_S=0
- ZRE_S22FMS11F=0
- ZIM_S22FT=0
- ZIM_S11FT=0
- END IF
- ZREFLOC(1)=1.E18*(XLAM_RAD(JI))**4/(XPI**5*.93)*4*XPI*ZS22_CARRE_S
- ZREFLOC(2)=1.E18*(XLAM_RAD(JI))**4/(XPI**5*.93)*4*XPI*ZS11_CARRE_S
- ZREFLOC(3)=180.E3/XPI*XLAM_RAD(JI)*ZRE_S22FMS11F
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)*ZREFLOC(1) &
- -ZCS*SIN(PELEV(JI,JEL,JL,JV))*ZREFLOC(1) &
- *1.E18*(XLAM_RAD(JI)/XPI)**4/.93*(ZN*ZLBDA**(-ZCXS))/4./ZLBDA**(3+ZDS)
- IF(LATT) THEN
- ZAETMP(1)=ZIM_S22FT*XLAM_RAD(JI)*2
- ZAETMP(2)=ZIM_S11FT*XLAM_RAD(JI)*2
- END IF
- ELSE ! MIE
- ZREFLOC(:)=0.
- IF(LATT) ZAETMP(:)=0.
- DO JJ=1,NPTS_GAULAG ! ****** Gauss-Laguerre quadrature
- ZD=ZX(JJ)**(1./ZALPHAS)/ZLBDA
- ZDE=ZDMELT_FACT**(1./3.)*ZD**(ZBS/3.)
- CALL BHMIE(XPI/XLAM_RAD(JI)*ZDE,ZQMI,ZQEXT(1),ZQSCA,ZQBACK(1))
- ZQBACK(2)=ZQBACK(1)
- ZQEXT(2)=ZQEXT(1) ! modif Clotilde 23/04/2012
- ZQBACK(3)=0.
- ZREFLOC(1:3)=ZREFLOC(1:3)+ZQBACK(1:3)*ZX(JJ)**(ZNUS-1.+2.*ZBS/3./ZALPHAS)*ZW(JJ)
- ZREFLOC(4)=ZREFLOC(4)+ZQBACK(1)*ZX(JJ)**(ZNUS-1.+2.*ZBS/3./ZALPHAS+ZDS/ZALPHAS)*ZW(JJ)
- IF(LATT) ZAETMP(:)=ZAETMP(:)+ZQEXT(:)*ZX(JJ)**(ZNUS-1.+2.*ZBS/3./ZALPHAS)*ZW(JJ)
- END DO ! ****** end loop Gauss-Laguerre quadrature
- ZREFLOC(1:2)=1.E18*(XLAM_RAD(JI)/XPI)**4*ZN*ZLBDA**(-2.*ZBS/3.)/&
- (4.*GAMMA(ZNUS)*.93)*ZDMELT_FACT**(2./3.)*ZREFLOC(1:2)
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)&
- +PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)*ZREFLOC(1) &
- -ZCS*SIN(PELEV(JI,JEL,JL,JV))*ZREFLOC(4) &
- *1.E18*(XLAM_RAD(JI)/XPI)**4*ZN &
- *ZLBDA**(2.*ZBS/3.-ZDS)/ &
- (4.*GAMMA(ZNUS)*.93)*ZDMELT_FACT**(2./3.)
- IF(LATT) ZAETMP(:)=ZAETMP(:)*XPI*ZN*ZLBDA**(-2.*ZBS/3.)/(4.*GAMMA(ZNUS))&
- *ZDMELT_FACT**(2./3.)
- ZRE_S22S11_S=0
- ZIM_S22S11_S=0
- ZS22_CARRE_S=0
- ZS11_CARRE_S=0
- END IF !**************** end loop for each type of diffusion
- ZREFL(JI,JEL,JAZ,JL,JH,JV,1:3)=ZREFL(JI,JEL,JAZ,JL,JH,JV,1:3)+ZREFLOC(1:3)
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IZES)=ZREFLOC(1) ! Z_e due to snow
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IZDS)=ZREFLOC(2) !Zvv for ZDR due to snow
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IKDS)=ZREFLOC(3) !Zvv for ZDR due to snow
- IF (ZS22_CARRE_S*ZS11_CARRE_S .GT. 0) THEN
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IRHS)=SQRT(ZRE_S22S11_S**2+ZIM_S22S11_S**2)/SQRT(ZS22_CARRE_S*ZS11_CARRE_S)
- ELSE
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IRHS)=1
- END IF
- IF(LATT) THEN
- ZAELOC(JI,JEL,JAZ,JL,JH,JV,:)=ZAELOC(JI,JEL,JAZ,JL,JH,JV,:)+ZAETMP(:)
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IAES)=ZAETMP(1)
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IAVS)=ZAETMP(2)
- IF(JL>1) THEN
- ZAESINT=ZAESINT*EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAES)*XSTEP_RAD)
- ZAVSINT=ZAVSINT*EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAVS)*XSTEP_RAD)
- ENDIF
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IZES)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IZES)*ZAESINT ! Z_s attenuated
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IZDS)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IZDS)*ZAVSINT ! ZVs attenuated
- END IF !end IF(LATT)
- END IF !end IF(PS_RAY(JI,JEL,JAZ,JL,JH,JV) > ...)
-
-
- ! Total attenuation even if no hydrometeors
- IF(LATT.AND.JL>1) ZREFL(JI,JEL,JAZ,JL,JH,JV,IATS)=ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IATS) &
- *EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAES)*XSTEP_RAD)
- END IF !END IF (SIZE(PS_RAY,1)>0)
- !---------------------------------------------------------------------------------------------------
- !* 5. GRAUPEL
- ! -------
- !
- !ZDG=.5 ! from Bringi & Chandrasekar 2001, p. 433
- IF (SIZE(PG_RAY,1)>0) THEN
- ZM=PRHODREF_RAY(JI,JEL,JAZ,JL,JH,JV)*PG_RAY(JI,JEL,JAZ,JL,JH,JV) !graupel content
- IF(ZM > ZM_MIN) THEN
- YTYPE='g'
- ZQMI=SQRT(QEPSI(MIN(PT_RAY(JI,JEL,JAZ,JL,JH,JV),XTT),XLIGHTSPEED/XLAM_RAD(JI)))
- ZQMW=SQRT(QEPSW(MAX(PT_RAY(JI,JEL,JAZ,JL,JH,JV),XTT),XLIGHTSPEED/XLAM_RAD(JI)))
- !ini_radar.f90 : ZCXG = -0.5 XBG = 2.8 ( Xj et bj tab 2.1 p 24)
- !ini_rain_ice.f90 : XLBEXG = 1.0/(XCXG-XBG) XAG = 19.6 (aj tab 2.1 p 24)
- !XLBG = ( XAG*XCCG*MOMG(XALPHAG,XNUG,XBG) )**(-XLBEXG) (eq 2.6 p 23)
- IF (PR_RAY(JI,JEL,JAZ,JL,JH,JV) > ZRTMIN(3) ) THEN
- ZFW=PR_RAY(JI,JEL,JAZ,JL,JH,JV)/(PR_RAY(JI,JEL,JAZ,JL,JH,JV)+PG_RAY(JI,JEL,JAZ,JL,JH,JV))
- ELSE
- ZFW=0.
- END IF
- ZLBDA=ZLBG*(PRHODREF_RAY(JI,JEL,JAZ,JL,JH,JV)*PG_RAY(JI,JEL,JAZ,JL,JH,JV))**ZLBEXG
- !XTT : température du point triple de l'eau (273.16 K <=> 0.1 °C)
- IF(PT_RAY(JI,JEL,JAZ,JL,JH,JV) > XTT) THEN ! mixture of ice and water
- ZFRAC_ICE = .85 !(see p 68)
- ELSE ! only ice
- ZFRAC_ICE=1.
- END IF
- ! from eq 3.77 p 68
- !XRHOLW=1000 (initialized in ini_cst.f90)
- ZDMELT_FACT=6.*ZAG/(XPI*XRHOLW*((1.-ZFRAC_ICE)+ZFRAC_ICE*0.92))
- ZEXP=2.*ZBG
- !Calculation of the refractive index from Bohren and Battan (3.72 p66)
- ZQB=2.*ZQMW**2*(2.*ZQMI**2*LOG(ZQMI/ZQMW)/(ZQMI**2-ZQMW**2)-1.)/(ZQMI**2-ZQMW**2) !Beta (3.73 p66)
- ZQM=SQRT(((1.-ZFRAC_ICE)*ZQMW**2+ZFRAC_ICE*ZQB*ZQMI**2)/(1.-ZFRAC_ICE+ZFRAC_ICE*ZQB)) ! Bohren & Battan (1982) 3.72 p66
- ZQK=(ZQM**2-1.)/(ZQM**2+2.)
- !Rayleigh, Rayleigh for ellipsoides or Rayleigh 6th order
- IF(NDIFF==0.OR.NDIFF==3.OR.NDIFF==4) THEN
- ZREFLOC(1:2)=ABS(ZQK)**2/.93*ZDMELT_FACT**2*1.E18*ZCCG*ZLBDA**(ZCXG-ZEXP)*MOMG(ZALPHAG,ZNUG,ZEXP)
- ZREFLOC(3)=0.
- IF(LWREFL) THEN ! weighting by reflectivities
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)&
- -ZCG*SIN(PELEV(JI,JEL,JL,JV))*ABS(ZQK)**2/.93*ZDMELT_FACT**2&
- *1.E18*ZCCG*ZLBDA**(ZCXG-ZEXP-ZDG)*MOMG(ZALPHAG,ZNUG,ZEXP+ZDG)
- ELSE
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)+ZCCG*ZLBDA**ZCXG
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)&
- -ZCG*SIN(PELEV(JI,JEL,JL,JV))&
- *ZCCG*ZLBDA**(ZCXG-ZDG)*MOMG(ZALPHAG,ZNUG,ZDG)
- END IF !end IF(LWREFL)
- IF(LATT) THEN
- IF(NDIFF==0.OR.NDIFF==3) THEN
- ZAETMP(:)=ZCCG*ZLBDA**ZCXG*(ZDMELT_FACT*XPI**2/XLAM_RAD(JI)*AIMAG(ZQK) &
- *MOMG(ZALPHAG,ZNUG,ZBG)/ZLBDA**ZBG)
- ELSE
- ZAETMP(:)=ZCCG*ZLBDA**ZCXG*(ZDMELT_FACT*XPI**2/XLAM_RAD(JI)*AIMAG(ZQK) &
- *MOMG(ZALPHAG,ZNUG,ZBG)/ZLBDA**ZBG&
- +ZDMELT_FACT**(5./3.)*XPI**4/15./XLAM_RAD(JI)**3 &
- *AIMAG(ZQK**2*(ZQM**4+27.*ZQM**2+38.) &
- /(2.*ZQM**2+3.))*MOMG(ZALPHAG,ZNUG,5.*ZBG/3.)/ZLBDA**(5.*ZBG/3.)&
- +ZDMELT_FACT**2 *2.*XPI**5/3. /XLAM_RAD(JI)**4*REAL(ZQK**2) &
- *MOMG(ZALPHAG,ZNUG,2.*ZBG) /ZLBDA**(2.*ZBG))
- END IF ! end IF(NDIFF==0.OR.NDIFF==3)
- END IF ! end IF(LATT)
- ZRE_S22S11_G=0
- ZIM_S22S11_G=0
- ZS22_CARRE_G=0
- ZS11_CARRE_G=0
- !******************************* NDIFF==7 TmatInt ************************************
- ELSE IF(NDIFF==7) THEN
- ZREFLOC(:)=0
- IF(LATT) ZAETMP(:)=0
- IF (ZFW < 0.01) THEN !******** DRY GRAUPEL
- CALL CALC_KTMAT(PELEV(JI,JEL,JL,JV), PT_RAY(JI,JEL,JAZ,JL,JH,JV),&
- ZFW,ZM,&
- ZELEV_MIN(3),ZELEV_MAX(3),ZELEV_STEP(3),&
- ZTC_MIN(3),ZTC_MAX(3),ZTC_STEP(3),&
- ZFW_MIN(3),ZFW_MAX(3),ZFW_STEP(3),&
- ZEXPM_MIN,ZEXPM_MAX,ZEXPM_STEP,&
- ITMAT,ZELEV_RED,ZTC_RED,ZFW_RED,ZM_RED)
- IF (ITMAT(1) .NE. -NUNDEF) THEN
- DO JIND=1,SIZE(KMAT_COEF,2),1
- KMAT_COEF(1,JIND)=ZS11_CARRE_T_G(ITMAT(JIND))
- KMAT_COEF(2,JIND)=ZS22_CARRE_T_G(ITMAT(JIND))
- KMAT_COEF(3,JIND)=ZRE_S22S11_T_G(ITMAT(JIND))
- KMAT_COEF(4,JIND)=ZIM_S22S11_T_G(ITMAT(JIND))
- KMAT_COEF(5,JIND)=ZRE_S22FMS11FT_T_G(ITMAT(JIND))
- KMAT_COEF(6,JIND)=ZIM_S22FT_T_G(ITMAT(JIND))
- KMAT_COEF(7,JIND)=ZIM_S11FT_T_G(ITMAT(JIND))
- ENDDO
- CALL INTERPOL(ZELEV_RED,ZTC_RED,ZFW_RED,ZM_RED,KMAT_COEF,ZS11_CARRE_G,ZS22_CARRE_G,&
- ZRE_S22S11_G,ZIM_S22S11_G,ZRE_S22FMS11F,ZIM_S22FT,ZIM_S11FT)
- ELSE
- ZS11_CARRE_G=0
- ZS22_CARRE_G=0
- ZRE_S22S11_G=0
- ZIM_S22S11_G=0
- ZRE_S22FMS11F=0
- ZIM_S22FT=0
- ZIM_S11FT=0
- END IF
- ELSE !ZFW >= 0.01 ************** WET GRAUPEL
- CALL CALC_KTMAT(PELEV(JI,JEL,JL,JV),PT_RAY(JI,JEL,JAZ,JL,JH,JV),&
- ZFW,ZM,&
- ZELEV_MIN(4),ZELEV_MAX(4),ZELEV_STEP(4),&
- ZTC_MIN(4),ZTC_MAX(4),ZTC_STEP(4),&
- ZFW_MIN(4),ZFW_MAX(4),ZFW_STEP(4),&
- ZEXPM_MIN,ZEXPM_MAX,ZEXPM_STEP,&
- ITMAT,ZELEV_RED,ZTC_RED,ZFW_RED,ZM_RED)
- IF (ITMAT(1) .NE. -NUNDEF) THEN
- DO JIND=1,SIZE(KMAT_COEF,2),1
- KMAT_COEF(1,JIND)=ZS11_CARRE_T_W(ITMAT(JIND))
- KMAT_COEF(2,JIND)=ZS22_CARRE_T_W(ITMAT(JIND))
- KMAT_COEF(3,JIND)=ZRE_S22S11_T_W(ITMAT(JIND))
- KMAT_COEF(4,JIND)=ZIM_S22S11_T_W(ITMAT(JIND))
- KMAT_COEF(5,JIND)=ZRE_S22FMS11FT_T_W(ITMAT(JIND))
- KMAT_COEF(6,JIND)=ZIM_S22FT_T_W(ITMAT(JIND))
- KMAT_COEF(7,JIND)=ZIM_S11FT_T_W(ITMAT(JIND))
- ENDDO
- CALL INTERPOL(ZELEV_RED,ZTC_RED,ZFW_RED,ZM_RED,KMAT_COEF,ZS11_CARRE_G,ZS22_CARRE_G,&
- ZRE_S22S11_G,ZIM_S22S11_G,ZRE_S22FMS11F,ZIM_S22FT,ZIM_S11FT)
- ELSE
- ZS11_CARRE_G=0
- ZS22_CARRE_G=0
- ZRE_S22S11_G=0
- ZIM_S22S11_G=0
- ZRE_S22FMS11F=0
- ZIM_S22FT=0
- ZIM_S11FT=0
- END IF
- END IF!END IF (ZFW<0.01)
- ZREFLOC(1)=1.E18*(XLAM_RAD(JI))**4/(XPI**5*.93)*4*XPI*ZS22_CARRE_G
- ZREFLOC(2)=1.E18*(XLAM_RAD(JI))**4/(XPI**5*.93)*4*XPI*ZS11_CARRE_G
- ZREFLOC(3)=180.E3/XPI*XLAM_RAD(JI)*ZRE_S22FMS11F
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)*ZREFLOC(1) &
- -ZCG*SIN(PELEV(JI,JEL,JL,JV))*ZREFLOC(1) &
- *1.E18*(XLAM_RAD(JI)/XPI)**4/.93*ZCCG/4./ZLBDA**(3+ZDG)
- IF(LATT) THEN
- ZAETMP(1)=ZIM_S22FT*XLAM_RAD(JI)*2
- ZAETMP(2)=ZIM_S11FT*XLAM_RAD(JI)*2
- END IF
- ELSE ! Mie (NDIFF=1)
- ZREFLOC(:)=0.
- IF(LATT) ZAETMP(:)=0.
- DO JJ=1,NPTS_GAULAG ! ****** Gauss-Laguerre quadrature
- ZD=ZX(JJ)**(1./ZALPHAG)/ZLBDA
- ZDE=ZDMELT_FACT**(1./3.)*ZD**(ZBG/3.)
- CALL BHMIE(XPI/XLAM_RAD(JI)*ZDE,ZQM,ZQEXT(1),ZQSCA,ZQBACK(1))
- ZQBACK(2)=ZQBACK(1)
- ZQEXT(2)=ZQEXT(1) ! modif Clotilde 23/04/2012
- ZQBACK(3)=0.
- ZREFLOC(1:3)=ZREFLOC(1:3)+ZQBACK(1:3)*ZX(JJ)**(ZNUG-1.+2.*ZBG/3./ZALPHAG)*ZW(JJ)
- ZREFLOC(4)=ZREFLOC(4)+ZQBACK(1)*ZX(JJ)**(ZNUG-1.+2.*ZBG/3./ZALPHAG+ZDG/ZALPHAG)*ZW(JJ)
- IF(LATT) ZAETMP(:)=ZAETMP(:)+ZQEXT(:)*ZX(JJ)**(ZNUG-1.+2.*ZBG/3./ZALPHAG)*ZW(JJ)
- END DO ! ****** end loop on diameter (Gauss-Laguerre)
- ZREFLOC(1:2)=ZREFLOC(1:2)*1.E18*(XLAM_RAD(JI)/XPI)**4*ZCCG &
- *ZLBDA**(ZCXG-2.*ZBG/3.)/(4.*GAMMA(ZNUG)*.93)*ZDMELT_FACT**(2./3.)
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP) &
- +PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)*ZREFLOC(1) &
- -ZCG*SIN(PELEV(JI,JEL,JL,JV))*ZREFLOC(4) &
- *1.E18*(XLAM_RAD(JI)/XPI)**4*ZCCG &
- *ZLBDA**(ZCXG-2.*ZBG/3.-ZDG)/(4.*GAMMA(ZNUG)*.93)*ZDMELT_FACT**(2./3.)
- IF(LATT) ZAETMP(:)=ZAETMP(:)*XPI*ZCCG*ZLBDA**(ZCXG-2.*ZBG/3.)/(4.*GAMMA(ZNUG)) &
- *ZDMELT_FACT**(2./3.)
- ZRE_S22S11_G=0
- ZIM_S22S11_G=0
- ZS22_CARRE_G=0
- ZS11_CARRE_G=0 !0 in case of Mie
- END IF !**************** end loop for each type of diffusion : IF(NDIFF==0.OR.NDIFF==3.OR.NDIFF==4)
- ZREFL(JI,JEL,JAZ,JL,JH,JV,1:3)=ZREFL(JI,JEL,JAZ,JL,JH,JV,1:3)+ZREFLOC(1:3)
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IZEG)=ZREFLOC(1) ! z_e due to graupel
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IZDG)=ZREFLOC(2) !Zvv for ZDR due to graupel
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IKDG)=ZREFLOC(3) !Zvv for ZDR due to graupel
-
- IF (ZS22_CARRE_G*ZS11_CARRE_G .GT. 0) THEN
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IRHG)=SQRT(ZRE_S22S11_G**2+ZIM_S22S11_G**2)/SQRT(ZS22_CARRE_G*ZS11_CARRE_G)
- ELSE
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IRHG)=1
- END IF
- IF(LATT) THEN
- ZAELOC(JI,JEL,JAZ,JL,JH,JV,:)=ZAELOC(JI,JEL,JAZ,JL,JH,JV,:)+ZAETMP(:)
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IAEG)=ZAETMP(1)
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IAVG)=ZAETMP(2)
- IF(JL>1) THEN
- ZAEGINT=ZAEGINT*EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAEG)*XSTEP_RAD)
- ZAVGINT=ZAVGINT*EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAVG)*XSTEP_RAD)
- END IF
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IZEG)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IZEG)*ZAEGINT ! Z_g attenuated
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IZDG)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IZDG)*ZAVGINT ! Z_g attenuated
- END IF !end IF(LATT)
- END IF !**************** IF(PG_RAY(JI,JEL,JAZ,JL,JH,JV) > XRTMIN(6))
-
- ! Total attenuation even if no hydrometeors
- IF(LATT.AND.JL>1) ZREFL(JI,JEL,JAZ,JL,JH,JV,IATG)=ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IATG) &
- *EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAEG)*XSTEP_RAD)
-
- END IF ! **************** end GRAUPEL (end IF SIZE(PG_RAY,1) > 0)
- !-----------------------------------------------------------------------------------------------
- !-----------------------------------------------------------------------------------------------
-!**********************************
-!**********************************
-!**********************************
-!**********************************
-
-
-!---------------------------------------------------------------------------------------------------
- !* 6. HAIL
- ! -------
- !
- !
- IF (GHAIL) THEN
- ZM=PRHODREF_RAY(JI,JEL,JAZ,JL,JH,JV)*PH_RAY(JI,JEL,JAZ,JL,JH,JV) !graupel content
- IF(ZM > ZM_MIN) THEN
- YTYPE='h'
- ZQMI=SQRT(QEPSI(MIN(PT_RAY(JI,JEL,JAZ,JL,JH,JV),XTT),XLIGHTSPEED/XLAM_RAD(JI)))
- ZQMW=SQRT(QEPSW(MAX(PT_RAY(JI,JEL,JAZ,JL,JH,JV),XTT),XLIGHTSPEED/XLAM_RAD(JI)))
- !ini_radar.f90 : ZCXG = -0.5 XBG = 2.8 ( Xj et bj tab 2.1 p 24)
- !ini_rain_ice.f90 : XLBEXG = 1.0/(XCXG-XBG) XAG = 19.6 (aj tab 2.1 p 24)
- !XLBG = ( XAG*XCCG*MOMG(XALPHAG,XNUG,XBG) )**(-XLBEXG) (eq 2.6 p 23)
-ZFW=0 !????????
- ZLBDA=ZLBH*(PRHODREF_RAY(JI,JEL,JAZ,JL,JH,JV)*PH_RAY(JI,JEL,JAZ,JL,JH,JV))**ZLBEXH
- !XTT : température du point triple de l'eau (273.16 K <=> 0.1 °C)
- IF(PT_RAY(JI,JEL,JAZ,JL,JH,JV) > XTT) THEN ! mixture of ice and water
- ZFRAC_ICE = .85 !(see p 68)
- ELSE ! only ice
- ZFRAC_ICE=1.
- END IF
- ! from eq 3.77 p 68
- !XRHOLW=1000 (initialized in ini_cst.f90)
- ZDMELT_FACT=6.*ZAG/(XPI*XRHOLW*((1.-ZFRAC_ICE)+ZFRAC_ICE*0.92))
- ZEXP=2.*ZBH
- !Calculation of the refractive index from Bohren and Battan (3.72 p66)
- ZQB=2.*ZQMW**2*(2.*ZQMI**2*LOG(ZQMI/ZQMW)/(ZQMI**2-ZQMW**2)-1.)/(ZQMI**2-ZQMW**2) !Beta (3.73 p66)
- ZQM=SQRT(((1.-ZFRAC_ICE)*ZQMW**2+ZFRAC_ICE*ZQB*ZQMI**2)/(1.-ZFRAC_ICE+ZFRAC_ICE*ZQB)) ! Bohren & Battan (1982) 3.72 p66
- ZQK=(ZQM**2-1.)/(ZQM**2+2.)
- !Rayleigh, Rayleigh for ellipsoides or Rayleigh 6th order
- IF(NDIFF==0.OR.NDIFF==3.OR.NDIFF==4) THEN
- ZREFLOC(1:2)=ABS(ZQK)**2/.93*ZDMELT_FACT**2*1.E18*ZCCH*ZLBDA**(ZCXH-ZEXP)*MOMG(ZALPHAH,ZNUH,ZEXP)
- ZREFLOC(3)=0.
- IF(LWREFL) THEN ! weighting by reflectivities
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)&
- -ZCH*SIN(PELEV(JI,JEL,JL,JV))*ABS(ZQK)**2/.93*ZDMELT_FACT**2&
- *1.E18*ZCCH*ZLBDA**(ZCXH-ZEXP-ZDH)*MOMG(ZALPHAH,ZNUH,ZEXP+ZDH)
- ELSE
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)+ZCCH*ZLBDA**ZCXH
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)&
- -ZCH*SIN(PELEV(JI,JEL,JL,JV))&
- *ZCCH*ZLBDA**(ZCXH-ZDH)*MOMG(ZALPHAH,ZNUH,ZDH)
- END IF !end IF(LWREFL)
- IF(LATT) THEN
- IF(NDIFF==0.OR.NDIFF==3) THEN
- ZAETMP(:)=ZCCH*ZLBDA**ZCXH*(ZDMELT_FACT*XPI**2/XLAM_RAD(JI)*AIMAG(ZQK) &
- *MOMG(ZALPHAH,ZNUH,ZBH)/ZLBDA**ZBH)
- ELSE
- ZAETMP(:)=ZCCH*ZLBDA**ZCXH*(ZDMELT_FACT*XPI**2/XLAM_RAD(JI)*AIMAG(ZQK) &
- *MOMG(ZALPHAH,ZNUH,ZBH)/ZLBDA**ZBH&
- +ZDMELT_FACT**(5./3.)*XPI**4/15./XLAM_RAD(JI)**3 &
- *AIMAG(ZQK**2*(ZQM**4+27.*ZQM**2+38.) &
- /(2.*ZQM**2+3.))*MOMG(ZALPHAH,ZNUH,5.*ZBH/3.)/ZLBDA**(5.*ZBH/3.)&
- +ZDMELT_FACT**2 *2.*XPI**5/3. /XLAM_RAD(JI)**4*REAL(ZQK**2) &
- *MOMG(ZALPHAH,ZNUH,2.*ZBH) /ZLBDA**(2.*ZBH))
- END IF ! end IF(NDIFF==0.OR.NDIFF==3)
- END IF ! end IF(LATT)
- ZRE_S22S11_H=0
- ZIM_S22S11_H=0
- ZS22_CARRE_H=0
- ZS11_CARRE_H=0
- !******************************* NDIFF==7 TmatInt ************************************
- ELSE IF(NDIFF==7) THEN
- ZREFLOC(:)=0
- IF(LATT) ZAETMP(:)=0
- CALL CALC_KTMAT(PELEV(JI,JEL,JL,JV), PT_RAY(JI,JEL,JAZ,JL,JH,JV),&
- ZFW,ZM,&
- ZELEV_MIN(3),ZELEV_MAX(3),ZELEV_STEP(3),&
- ZTC_MIN(3),ZTC_MAX(3),ZTC_STEP(3),&
- ZFW_MIN(3),ZFW_MAX(3),ZFW_STEP(3),&
- ZEXPM_MIN,ZEXPM_MAX,ZEXPM_STEP,&
- ITMAT,ZELEV_RED,ZTC_RED,ZFW_RED,ZM_RED)
- IF (ITMAT(1) .NE. -NUNDEF) THEN
- DO JIND=1,SIZE(KMAT_COEF,2),1
- KMAT_COEF(1,JIND)=ZS11_CARRE_T_H(ITMAT(JIND))
- KMAT_COEF(2,JIND)=ZS22_CARRE_T_H(ITMAT(JIND))
- KMAT_COEF(3,JIND)=ZRE_S22S11_T_H(ITMAT(JIND))
- KMAT_COEF(4,JIND)=ZIM_S22S11_T_H(ITMAT(JIND))
- KMAT_COEF(5,JIND)=ZRE_S22FMS11FT_T_H(ITMAT(JIND))
- KMAT_COEF(6,JIND)=ZIM_S22FT_T_H(ITMAT(JIND))
- KMAT_COEF(7,JIND)=ZIM_S11FT_T_H(ITMAT(JIND))
- ENDDO
- CALL INTERPOL(ZELEV_RED,ZTC_RED,ZFW_RED,ZM_RED,KMAT_COEF,ZS11_CARRE_H,ZS22_CARRE_H,&
- ZRE_S22S11_H,ZIM_S22S11_H,ZRE_S22FMS11F,ZIM_S22FT,ZIM_S11FT)
- ELSE
- ZS11_CARRE_H=0
- ZS22_CARRE_H=0
- ZRE_S22S11_H=0
- ZIM_S22S11_H=0
- ZRE_S22FMS11F=0
- ZIM_S22FT=0
- ZIM_S11FT=0
- END IF
- ZREFLOC(1)=1.E18*(XLAM_RAD(JI))**4/(XPI**5*.93)*4*XPI*ZS22_CARRE_H
- ZREFLOC(2)=1.E18*(XLAM_RAD(JI))**4/(XPI**5*.93)*4*XPI*ZS11_CARRE_H
- ZREFLOC(3)=180.E3/XPI*XLAM_RAD(JI)*ZRE_S22FMS11F
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)*ZREFLOC(1) &
- -ZCH*SIN(PELEV(JI,JEL,JL,JV))*ZREFLOC(1) &
- *1.E18*(XLAM_RAD(JI)/XPI)**4/.93*ZCCH/4./ZLBDA**(3+ZDH)
- IF(LATT) THEN
- ZAETMP(1)=ZIM_S22FT*XLAM_RAD(JI)*2
- ZAETMP(2)=ZIM_S11FT*XLAM_RAD(JI)*2
- END IF
- ELSE ! Mie (NDIFF=1)
- ZREFLOC(:)=0.
- IF(LATT) ZAETMP(:)=0.
- DO JJ=1,NPTS_GAULAG ! ****** Gauss-Laguerre quadrature
- ZD=ZX(JJ)**(1./ZALPHAH)/ZLBDA
- ZDE=ZDMELT_FACT**(1./3.)*ZD**(ZBH/3.)
- CALL BHMIE(XPI/XLAM_RAD(JI)*ZDE,ZQM,ZQEXT(1),ZQSCA,ZQBACK(1))
- ZQBACK(2)=ZQBACK(1)
- ZQEXT(2)=ZQEXT(1) ! modif Clotilde 23/04/2012
- ZQBACK(3)=0.
- ZREFLOC(1:3)=ZREFLOC(1:3)+ZQBACK(1:3)*ZX(JJ)**(ZNUH-1.+2.*ZBH/3./ZALPHAH)*ZW(JJ)
- ZREFLOC(4)=ZREFLOC(4)+ZQBACK(1)*ZX(JJ)**(ZNUH-1.+2.*ZBH/3./ZALPHAH+ZDH/ZALPHAH)*ZW(JJ)
- IF(LATT) ZAETMP(:)=ZAETMP(:)+ZQEXT(:)*ZX(JJ)**(ZNUH-1.+2.*ZBH/3./ZALPHAH)*ZW(JJ)
- END DO ! ****** end loop on diameter (Gauss-Laguerre)
- ZREFLOC(1:2)=ZREFLOC(1:2)*1.E18*(XLAM_RAD(JI)/XPI)**4*ZCCH &
- *ZLBDA**(ZCXH-2.*ZBH/3.)/(4.*GAMMA(ZNUH)*.93)*ZDMELT_FACT**(2./3.)
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP) &
- +PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)*ZREFLOC(1) &
- -ZCH*SIN(PELEV(JI,JEL,JL,JV))*ZREFLOC(4) &
- *1.E18*(XLAM_RAD(JI)/XPI)**4*ZCCH &
- *ZLBDA**(ZCXH-2.*ZBH/3.-ZDH)/(4.*GAMMA(ZNUH)*.93)*ZDMELT_FACT**(2./3.)
- IF(LATT) ZAETMP(:)=ZAETMP(:)*XPI*ZCCH*ZLBDA**(ZCXH-2.*ZBH/3.)/(4.*GAMMA(ZNUH)) &
- *ZDMELT_FACT**(2./3.)
- ZRE_S22S11_H=0
- ZIM_S22S11_H=0
- ZS22_CARRE_H=0
- ZS11_CARRE_H=0 !0 in case of Mie
- END IF !**************** end loop for each type of diffusion : IF(NDIFF==0.OR.NDIFF==3.OR.NDIFF==4)
- ZREFL(JI,JEL,JAZ,JL,JH,JV,1:3)=ZREFL(JI,JEL,JAZ,JL,JH,JV,1:3)+ZREFLOC(1:3)
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IZEH)=ZREFLOC(1) ! z_e due to graupel
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IZDH)=ZREFLOC(2) !Zvv for ZDR due to graupel
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IKDH)=ZREFLOC(3) !Zvv for ZDR due to graupel
-
- IF (ZS22_CARRE_H*ZS11_CARRE_H .GT. 0) THEN
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IRHH)=SQRT(ZRE_S22S11_H**2+ZIM_S22S11_H**2)/SQRT(ZS22_CARRE_H*ZS11_CARRE_H)
- ELSE
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IRHH)=1
- END IF
- IF(LATT) THEN
- ZAELOC(JI,JEL,JAZ,JL,JH,JV,:)=ZAELOC(JI,JEL,JAZ,JL,JH,JV,:)+ZAETMP(:)
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IAEH)=ZAETMP(1)
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IAVH)=ZAETMP(2)
- IF(JL>1) THEN
- ZAEHINT=ZAEHINT*EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAEH)*XSTEP_RAD)
- ZAVHINT=ZAVHINT*EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAVH)*XSTEP_RAD)
- END IF
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IZEH)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IZEH)*ZAEHINT ! Z_g attenuated
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IZDH)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IZDH)*ZAVHINT ! Z_g attenuated
- END IF !end IF(LATT)
- END IF !**************** IF(PH_RAY(JI,JEL,JAZ,JL,JH,JV) > XRTMIN(6))
-
- ! Total attenuation even if no hydrometeors
- IF(LATT.AND.JL>1) ZREFL(JI,JEL,JAZ,JL,JH,JV,IATH)=ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IATH) &
- *EXP(-2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IAEH)*XSTEP_RAD)
-
- END IF ! **************** end HAIL (end IF SIZE(PH_RAY,1) > 0)
- !-----------------------------------------------------------------------------------------------
- !-----------------------------------------------------------------------------------------------
-!**********************************
-!**********************************
-!**********************************
-!**********************************
-
- IF(LWREFL) THEN ! weighting by reflectivities
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)&
- +PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)*ZREFL(JI,JEL,JAZ,JL,JH,JV,1)
- ELSE IF(LWBSCS) THEN ! weighting by hydrometeor concentrations
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)&
- +PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)*ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)
- ELSE IF(ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)/=0.) THEN ! no weighting
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)/ZREFL(JI,JEL,JAZ,JL,JH,JV,IMAX)&
- +PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)
- END IF
- !Calculation of Phidp (ZREFL(JI,JEL,JAZ,JL,JH,JV,IPDP) is initialized to 0 before the loop
- IF (JL>1) ZREFL(JI,JEL,JAZ,JL,JH,JV,IPDP)=ZREFL(JI,JEL,JAZ,JL-1,JH,JV,IPDP)+ &
- 2.*ZREFL(JI,JEL,JAZ,JL-1,JH,JV,3)*XSTEP_RAD*1D-3
-
- !Calculation of RhoHV and DeltaHV
- ZRE_S22S11_T=ZRE_S22S11_R+ZRE_S22S11_I+ZRE_S22S11_S+ZRE_S22S11_G+ZRE_S22S11_H
- ZIM_S22S11_T=ZIM_S22S11_R+ZIM_S22S11_I+ZIM_S22S11_S+ZIM_S22S11_G+ZIM_S22S11_H
- ZS22_CARRE_T=ZS22_CARRE_R+ZS22_CARRE_I+ZS22_CARRE_S+ZS22_CARRE_G+ZS22_CARRE_H
- ZS11_CARRE_T=ZS11_CARRE_R+ZS11_CARRE_I+ZS11_CARRE_S+ZS11_CARRE_G+ZS11_CARRE_H
- !RhoHV
- IF ((ZS22_CARRE_T*ZS11_CARRE_T)>0.) THEN
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IRHV)=SQRT(ZRE_S22S11_T**2+ZIM_S22S11_T**2)/SQRT(ZS22_CARRE_T*ZS11_CARRE_T)
- ELSE
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IRHV)=-XUNDEF
- END IF
- !DeltaHV
- IF (ZRE_S22S11_T/=0) THEN
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IDHV)=180/XPI*ATAN(ZIM_S22S11_T/ZRE_S22S11_T)
- ELSE
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IDHV)=0
- END IF
- ELSE !if temperature is not defined
- ZREFL(JI,JEL,JAZ,JL,JH,JV,1:2)=XVALGROUND
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=XVALGROUND
- LPART_MASK=.TRUE.
- END IF !end condition : IF(PT_RAY(JI,JEL,JAZ,JL,JH,JV) /= -XUNDEF) => if temperature is defined
- END IF !end condition : IF(LPART_MASK) => if pixel is not masked
- END DO LOOPJL
- END DO !JV
- END DO !JH
- END DO !JAZ
- END DO !JEL
- !
- IF (NDIFF == 7 ) THEN
- !lookup tables for rain
- DEALLOCATE (ZTC_T_R,ZELEV_T_R,ZM_T_R,ZS11_CARRE_T_R,ZS22_CARRE_T_R,&
- ZRE_S22S11_T_R,ZIM_S22S11_T_R,ZRE_S22FMS11FT_T_R,ZIM_S22FT_T_R,ZIM_S11FT_T_R)
- !lookup tables for snow
- DEALLOCATE (ZTC_T_S,ZELEV_T_S,ZM_T_S,ZS11_CARRE_T_S,ZS22_CARRE_T_S,&
- ZRE_S22S11_T_S,ZIM_S22S11_T_S,ZRE_S22FMS11FT_T_S,ZIM_S22FT_T_S,ZIM_S11FT_T_S)
- !lookup tables for graupel
- DEALLOCATE (ZTC_T_G,ZELEV_T_G,ZM_T_G,ZS11_CARRE_T_G,ZS22_CARRE_T_G,&
- ZRE_S22S11_T_G,ZIM_S22S11_T_G,ZRE_S22FMS11FT_T_G,ZIM_S22FT_T_G,ZIM_S11FT_T_G)
- !lookup tables for wet graupel
- DEALLOCATE (ZTC_T_W,ZELEV_T_W,ZM_T_W,ZS11_CARRE_T_W,ZS22_CARRE_T_W,&
- ZRE_S22S11_T_W,ZIM_S22S11_T_W,ZRE_S22FMS11FT_T_W,ZIM_S22FT_T_W,ZIM_S11FT_T_W)
- IF (GHAIL) THEN
- !lookup tables for hail
- DEALLOCATE (ZTC_T_H,ZELEV_T_H,ZM_T_H,ZS11_CARRE_T_H,ZS22_CARRE_T_H,&
- ZRE_S22S11_T_H,ZIM_S22S11_T_H,ZRE_S22FMS11FT_T_H,ZIM_S22FT_T_H,ZIM_S11FT_T_H)
- ENDIF
- ENDIF
-END DO !JI
-!
-! attenuation in dB/km
-IF(LATT) ZREFL(:,:,:,:,:,:,IAER:IAEH)=4343.*2.*ZREFL(:,:,:,:,:,:,IAER:IAEH) ! horizontal specific attenuation
-IF(LATT) ZREFL(:,:,:,:,:,:,IAVR:IAVH)=4343.*2.*ZREFL(:,:,:,:,:,:,IAVR:IAVH) ! vertical specific attenuation
-! convective/stratiform
-ZREFL(:,:,:,:,:,:,4)=PBU_MASK_RAY(:,:,:,:,:,:) ! CSR
-! /convective/stratiform
-
-WRITE(ILUOUT0,*) 'NB ZREFL MIN MAX :', MINVAL(ZREFL(:,:,:,:,:,:,:)),MAXVAL(ZREFL(:,:,:,:,:,:,:))
-WRITE(ILUOUT0,*) 'NB ZREFL VALGROUND :', COUNT(ZREFL(:,:,:,:,:,:,:) ==XVALGROUND)
-WRITE(ILUOUT0,*) 'NB ZREFL -XUNDEF :', COUNT(ZREFL(:,:,:,:,:,:,:) ==-XUNDEF)
-WRITE(ILUOUT0,*) 'NB ZREFL > 0 :', COUNT(ZREFL(:,:,:,:,:,:,:)>0.)
-WRITE(ILUOUT0,*) 'NB ZREFL = 0 :', COUNT(ZREFL(:,:,:,:,:,:,:)==0.)
-WRITE(ILUOUT0,*) 'NB ZREFL < 0 :', COUNT(ZREFL(:,:,:,:,:,:,:) < 0.)-COUNT( ZREFL(:,:,:,:,:,:,:)==XVALGROUND)
-!---------------------------------------------------------------------------------------------------
-!* 6. FINAL STEP : TOTAL ATTENUATION AND EQUIVALENT REFLECTIVITY FACTOR
-! ---------------------------------------------------------------
-!
-ALLOCATE(ZVTEMP(IMAX))
-DO JI=1,INBRAD
- IEL=NBELEV(JI)
- DO JEL=1,IEL
- DO JAZ=1,INBAZIM
- IF (LATT) ZAETOT(:,:,1:2)=1.
- PZE(JI,JEL,JAZ,1,IPDP)=0
- DO JL=1,INBSTEPMAX
- ! if no undef point in gate JL and at least one point where T is defined
- IF(COUNT(ZREFL(JI,JEL,JAZ,JL,:,:,1)==-XUNDEF)==0.AND. &
- COUNT(ZREFL(JI,JEL,JAZ,JL,:,:,1)==XVALGROUND)==0.AND. &
- COUNT(PT_RAY(JI,JEL,JAZ,JL,:,:)/=-XUNDEF)/=0) THEN
- DO JH=1,INPTS_H
- ZVTEMP(:)=0.
- DO JV=1,INPTS_V ! Loop on Jv
- !if range is over 1, attenuation is added
- IF (JL > 1) THEN
- IF(LATT) THEN ! we use ZALPHAE0=alpha_0 from last gate
- !Total attenuation
- ZAETOT(JH,JV,1:2)=ZAETOT(JH,JV,1:2)*EXP(-2.*ZAELOC(JI,JEL,JAZ,JL-1,JH,JV,:)*XSTEP_RAD)
- !Zhh, Zvv
- ZREFL(JI,JEL,JAZ,JL,JH,JV,1:2)=ZREFL(JI,JEL,JAZ,JL,JH,JV,1:2)*ZAETOT(JH,JV,1:2)!attenuated reflectivity
- !Z for Radial velocity
- IF(LWREFL) ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)*ZAETOT(JH,JV,1)
- END IF !end IF(LATT)
- END IF !end IF (JL > 1)
- IF(.NOT.(LWREFL.AND.LWBSCS)) THEN
- ZREFL(JI,JEL,JAZ,JL,JH,JV,IVDOP)=PVDOP_RAY(JI,JEL,JAZ,JL,JH,JV)
- END IF
- ! Quadrature on vertical reflectivities +VDOP
- IF(LQUAD) THEN
- ZVTEMP(:)=ZVTEMP(:)+ZREFL(JI,JEL,JAZ,JL,JH,JV,:)*PW_V(ABS((2*JV-INPTS_V-1)/2)+1) &
- *EXP(-2.*LOG(2.)*PX_V(ABS((2*JV-INPTS_V-1)/2)+1)**2)
- ELSE
- ZVTEMP(:)=ZVTEMP(:)+ZREFL(JI,JEL,JAZ,JL,JH,JV,:)*PW_V(ABS((2*JV-INPTS_V-1)/2)+1)
- END IF
- END DO ! End loop on JV
-!
- IF(LQUAD) THEN
- PZE(JI,JEL,JAZ,JL,:)=PZE(JI,JEL,JAZ,JL,:)+ZVTEMP(1:SIZE(PZE,5))*PW_H(ABS((2*JH-INPTS_H-1)/2)+1) &
- *EXP(-2.*LOG(2.)*PX_H(ABS((2*JH-INPTS_H-1)/2)+1)**2)
- IF(LWBSCS) ZCONC_BIN(JI,JEL,JAZ,JL)=ZCONC_BIN(JI,JEL,JAZ,JL)+ZVTEMP(IMAX)* &
- PW_H(ABS((2*JH-INPTS_H-1)/2)+1)*EXP(-2.*LOG(2.)*PX_H(ABS((2*JH-INPTS_H-1)/2)+1)**2)
- ELSE
- PZE(JI,JEL,JAZ,JL,:)=PZE(JI,JEL,JAZ,JL,:)+ZVTEMP(1:SIZE(PZE,5))*PW_H(ABS((2*JH-INPTS_H-1)/2)+1)
- IF(LWBSCS) ZCONC_BIN(JI,JEL,JAZ,JL)=ZCONC_BIN(JI,JEL,JAZ,JL)+ZVTEMP(IMAX)* &
- PW_H(ABS((2*JH-INPTS_H-1)/2)+1)
- END IF !end IF(LQUAD)
- END DO ! End loop on JH
-
- IF(LQUAD) THEN
- PZE(JI,JEL,JAZ,JL,:)=PZE(JI,JEL,JAZ,JL,:)*2.*LOG(2.)/XPI
- IF(LWBSCS) ZCONC_BIN(JI,JEL,JAZ,JL)=ZCONC_BIN(JI,JEL,JAZ,JL)*2.*LOG(2.)/XPI
- ELSE
- PZE(JI,JEL,JAZ,JL,:)=PZE(JI,JEL,JAZ,JL,:)/XPI
- IF(LWBSCS) ZCONC_BIN(JI,JEL,JAZ,JL)=ZCONC_BIN(JI,JEL,JAZ,JL)/XPI
- END IF !end IF(LQUAD)
-!
- !**** Thresholding: with ZSNR, or with XREFLVDOPMIN and XREFLMIN
- ZSNR=-XUNDEF
- ZSNR_R=-XUNDEF
- ZSNR_I=-XUNDEF
- ZSNR_S=-XUNDEF
- ZSNR_G=-XUNDEF
- ZSNR_H=-XUNDEF
- ZZHH=PZE(JI,JEL,JAZ,JL,1)
- ZZE_R=PZE(JI,JEL,JAZ,JL,IZER)
- ZZE_I=PZE(JI,JEL,JAZ,JL,IZEI)
- ZZE_S=PZE(JI,JEL,JAZ,JL,IZES)
- ZZE_G=PZE(JI,JEL,JAZ,JL,IZEG)
- IF (GHAIL) ZZE_H=PZE(JI,JEL,JAZ,JL,IZEH)
- ZDISTRAD=JL*XSTEP_RAD !radar distance in meters
- IF (LSNRT) THEN
- IF (ZZHH/=XVALGROUND .AND. ZZHH/=-XUNDEF.AND.ZZHH/=0) THEN
- ZSNR=10*LOG10(ZZHH)-20*LOG10(ZDISTRAD/(100*10**3))
- END IF
- IF (ZZE_R/=XVALGROUND .AND. ZZE_R/=-XUNDEF.AND.ZZE_R/=0) THEN
- ZSNR_R=10*LOG10(ZZE_R)-20*LOG10(ZDISTRAD/(100*10**3))
- END IF
- IF (ZZE_I/=XVALGROUND .AND. ZZE_I/=-XUNDEF.AND.ZZE_I/=0) THEN
- ZSNR_I=10*LOG10(ZZE_I)-20*LOG10(ZDISTRAD/(100*10**3))
- END IF
- IF (ZZE_S/=XVALGROUND .AND. ZZE_S/=-XUNDEF.AND.ZZE_S/=0) THEN
- ZSNR_S=10*LOG10(ZZE_S)-20*LOG10(ZDISTRAD/(100*10**3))
- END IF
- IF (ZZE_G/=XVALGROUND .AND. ZZE_G/=-XUNDEF.AND.ZZE_G/=0) THEN
- ZSNR_G=10*LOG10(ZZE_G)-20*LOG10(ZDISTRAD/(100*10**3))
- END IF
- IF (GHAIL) THEN
- IF (ZZE_H/=XVALGROUND .AND. ZZE_H/=-XUNDEF.AND.ZZE_H/=0) THEN
- ZSNR_H=10*LOG10(ZZE_H)-20*LOG10(ZDISTRAD/(100*10**3))
- END IF
- END IF
- GTHRESHOLD_V=(ZSNR>=XSNRMIN)
- GTHRESHOLD_Z=GTHRESHOLD_V
- GTHRESHOLD_ZR=(ZSNR_R>=XSNRMIN)
- GTHRESHOLD_ZI=(ZSNR_I>=XSNRMIN)
- GTHRESHOLD_ZS=(ZSNR_S>=XSNRMIN)
- GTHRESHOLD_ZG=(ZSNR_G>=XSNRMIN)
- IF (GHAIL) GTHRESHOLD_ZH=(ZSNR_H>=XSNRMIN)
- ELSE
- GTHRESHOLD_V=(ZZHH>=10**(XREFLVDOPMIN/10.))
- GTHRESHOLD_Z=(ZZHH>=10**(XREFLMIN/10.))
- GTHRESHOLD_ZR=(ZZE_R>=10**(XREFLMIN/10.))
- GTHRESHOLD_ZI=(ZZE_I>=10**(XREFLMIN/10.))
- GTHRESHOLD_ZS=(ZZE_S>=10**(XREFLMIN/10.))
- GTHRESHOLD_ZG=(ZZE_G>=10**(XREFLMIN/10.))
- IF (GHAIL) GTHRESHOLD_ZH=(ZZE_H>=10**(XREFLMIN/10.))
- END IF
- !--- Doppler velocities
- IF(GTHRESHOLD_V) THEN
- IF(LWREFL) THEN
- !change Clotilde 27/04/2012 to avoid division by zero and floating point exception
- IF (PZE(JI,JEL,JAZ,JL,1)/=0) THEN
- PZE(JI,JEL,JAZ,JL,IVDOP)=PZE(JI,JEL,JAZ,JL,IVDOP)/PZE(JI,JEL,JAZ,JL,1)
- END IF
- ELSE IF(LWBSCS) THEN
- IF(ZCONC_BIN(JI,JEL,JAZ,JL)>0.) THEN
- PZE(JI,JEL,JAZ,JL,IVDOP)=PZE(JI,JEL,JAZ,JL,IVDOP)/ZCONC_BIN(JI,JEL,JAZ,JL)
- ELSE
- PZE(JI,JEL,JAZ,JL,IVDOP)=-XUNDEF
- END IF !end IF(ZCONC_BIN(JI,JEL,JAZ,JL)>0.)
- END IF !end IF(LWREFL)
- ELSE
- PZE(JI,JEL,JAZ,JL,IVDOP)=-XUNDEF
- END IF !end IF(GTHRESHOLD_V)
-
- !--- Zhh, Zvv et variables globales
- IF(GTHRESHOLD_Z .EQV. .FALSE.) THEN
- PZE(JI,JEL,JAZ,JL,1:4)=-XUNDEF
- PZE(JI,JEL,JAZ,JL,IRHV:IDHV)=-XUNDEF
- END IF
- !--- ZER, ZDA, KDR, RHR
- IF(GTHRESHOLD_ZR .EQV. .FALSE.) THEN
- PZE(JI,JEL,JAZ,JL,IZER)=-XUNDEF
- PZE(JI,JEL,JAZ,JL,IZDA)=-XUNDEF
- PZE(JI,JEL,JAZ,JL,IKDR)=-XUNDEF
- PZE(JI,JEL,JAZ,JL,IRHR)=-XUNDEF
- END IF
- !--- ZES, ZDS, KDS, RHS
- IF(GTHRESHOLD_ZS .EQV. .FALSE.) THEN
- PZE(JI,JEL,JAZ,JL,IZES)=-XUNDEF
- PZE(JI,JEL,JAZ,JL,IZDS)=-XUNDEF
- PZE(JI,JEL,JAZ,JL,IKDS)=-XUNDEF
- PZE(JI,JEL,JAZ,JL,IRHS)=-XUNDEF
- END IF
-
- !--- ZEG, ZDG, KDG, RHG
- IF(GTHRESHOLD_ZG .EQV. .FALSE.) THEN
- PZE(JI,JEL,JAZ,JL,IZEG)=-XUNDEF
- PZE(JI,JEL,JAZ,JL,IZDG)=-XUNDEF
- PZE(JI,JEL,JAZ,JL,IKDG)=-XUNDEF
- PZE(JI,JEL,JAZ,JL,IRHG)=-XUNDEF
- END IF
- !--- ZEH, ZDH, KDH, RHH
- IF (GHAIL) THEN
- IF(GTHRESHOLD_ZH .EQV. .FALSE.) THEN
- PZE(JI,JEL,JAZ,JL,IZEH)=-XUNDEF
- PZE(JI,JEL,JAZ,JL,IZDH)=-XUNDEF
- PZE(JI,JEL,JAZ,JL,IKDH)=-XUNDEF
- PZE(JI,JEL,JAZ,JL,IRHH)=-XUNDEF
- END IF
- END IF
- !--- ZEI
- IF(GTHRESHOLD_ZI .EQV. .FALSE.) THEN
- PZE(JI,JEL,JAZ,JL,IZEI)=-XUNDEF
- END IF
- ELSE
- ! ground clutter or outside Meso-NH domain
- !(IF T not defined or if one undef point at least in gate)
- PZE(JI,JEL,JAZ,JL,:)=XVALGROUND
- END IF
- IF(PZE(JI,JEL,JAZ,JL,1) < 0. .AND. PZE(JI,JEL,JAZ,JL,1)/=-XUNDEF) THEN ! flag bin when underground => xvalground si < 0?
- PZE(JI,JEL,JAZ,JL,:)=XVALGROUND
- END IF ! end IF(PZE(JI,JEL,JAZ,JL,1) < 0.)
- END DO ! end DO JL=1,INBSTEPMAX
- END DO !end DO JAZ=1,INBAZIM
- END DO !end DO JEL=1,IEL
-END DO !end DO JI=1,INBRAD
-DEALLOCATE(ZREFL,ZVTEMP,ZRTMIN)
-WRITE(ILUOUT0,*) '*****************FIN RADAR_SCATTERING ***********************'
-WRITE(ILUOUT0,*) 'NB PZE MIN MAX :', MINVAL(PZE(:,:,:,:,IZEI)),MAXVAL(PZE(:,:,:,:,IZEI))
-WRITE(ILUOUT0,*) 'NB PZE VALGROUND :', COUNT(PZE(:,:,:,:,IZEI) ==XVALGROUND)
-WRITE(ILUOUT0,*) 'NB PZE -XUNDEF :', COUNT(PZE(:,:,:,:,IZEI) ==-XUNDEF)
-WRITE(ILUOUT0,*) 'NB PZE > 0 :', COUNT(PZE(:,:,:,:,IZEI)>0.)
-WRITE(ILUOUT0,*) 'NB PZE = 0 :', COUNT(PZE(:,:,:,:,IZEI)==0.)
-WRITE(ILUOUT0,*) 'NB PZE < 0 :', COUNT(PZE(:,:,:,:,IZEI) < 0.)-COUNT(PZE(:,:,:,:,IZEI) ==XVALGROUND)
-IF(NDIFF/=0) DEALLOCATE(ZX,ZW)
-IF (LATT) DEALLOCATE(ZAELOC,ZAETOT)
-WRITE(ILUOUT0,*) 'END OF RADAR SCATTERING'
-END SUBROUTINE RADAR_SCATTERING
-
diff --git a/src/mesonh/ext/radiations.f90 b/src/mesonh/ext/radiations.f90
deleted file mode 100644
index f4db08bfc04972b30b309785a0a7e1a05b2bcd1c..0000000000000000000000000000000000000000
--- 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_n
-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_all_data_grib_case.f90 b/src/mesonh/ext/read_all_data_grib_case.f90
deleted file mode 100644
index eec912f59b18bf5c7e0a2a137a3136a38264955c..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/read_all_data_grib_case.f90
+++ /dev/null
@@ -1,2611 +0,0 @@
-!MNH_LIC Copyright 1998-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_READ_ALL_DATA_GRIB_CASE
-! #################################
-INTERFACE
-SUBROUTINE READ_ALL_DATA_GRIB_CASE(HFILE,TPPRE_REAL1,HGRIB,TPPGDFILE, &
- PTIME_HORI,KVERB,ODUMMY_REAL )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-CHARACTER(LEN=4), INTENT(IN) :: HFILE ! which file ('ATM0','ATM1' or 'CHEM')
-TYPE(TFILEDATA),POINTER,INTENT(INOUT) :: TPPRE_REAL1 ! PRE_REAL1 file
-CHARACTER(LEN=28), INTENT(IN) :: HGRIB ! name of the GRIB file
-TYPE(TFILEDATA), INTENT(IN) :: TPPGDFILE ! physiographic data file
-INTEGER, INTENT(IN) :: KVERB ! verbosity level
-LOGICAL, INTENT(IN) :: ODUMMY_REAL ! flag to interpolate dummy fields
-REAL, INTENT(INOUT) :: PTIME_HORI ! time spent in hor. interpolations
-!
-END SUBROUTINE READ_ALL_DATA_GRIB_CASE
-!
-END INTERFACE
-END MODULE MODI_READ_ALL_DATA_GRIB_CASE
-! ##########################################################################
- SUBROUTINE READ_ALL_DATA_GRIB_CASE(HFILE,TPPRE_REAL1,HGRIB,TPPGDFILE, &
- PTIME_HORI,KVERB,ODUMMY_REAL )
-! ##########################################################################
-!
-!!**** *READ_ALL_DATA_GRIB_CASE* - reads data for the initialization of real cases.
-!!
-!! PURPOSE
-!! -------
-! This routine reads the two input files :
-! The PGD which is closed after reading
-! The GRIB file
-! Projection is read in READ_LFIFM_PGD (MODD_GRID).
-! Grid and definition of large domain are read in PGD file and Grib files.
-! The PGD files are also read in READ_LFIFM_PGD.
-! The PGD file is closed.
-! The MESO-NH domain is defined from PRE_REAL1.nam inputs in SET_SUBDOMAIN_CEP.
-! Vertical grid is defined in READ_VER_GRID.
-! PGD fields are stored on MESO-NH domain (in TRUNC_PGD).
-!!
-!!** METHOD
-!! ------
-!! 0. Declarations
-!! 1. Declaration of arguments
-!! 2. Declaration of local variables
-!! 1. Read PGD file
-!! 1. Domain restriction
-!! 2. Coordinate conversion to lat,lon system
-!! 2. Read Grib fields
-!! 3. Vertical grid
-!! 4. Free all temporary allocations
-!!
-!! EXTERNAL
-!! --------
-!! subroutine READ_LFIFM_PGD : to read PGD file
-!! subroutine SET_SUBDOMAIN : to define the horizontal MESO-NH domain.
-!! subroutine READ_VER_GRID : to read the vertical grid in namelist file.
-!! subroutine HORIBL : horizontal bilinear interpolation
-!! subroutine XYTOLATLON : projection from conformal to lat,lon
-!!
-!! Module MODI_SET_SUBDOMAIN : interface for subroutine SET_SUBDOMAIN
-!! Module MODI_READ_VER_GRID : interface for subroutine READ_VER_GRID
-!! Module MODI_HORIBL : interface for subroutine HORIBL
-!! Module MODI_XYTOLATLON : interface for subroutine XYTOLATLON
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! Module MODD_CONF : contains configuration variables for all models.
-!! NVERB : verbosity level for output-listing
-!! Module MODD_LUNIT : contains logical unit names for all models
-!! TLUOUT0 : name of output-listing
-!! Module MODD_PGDDIM : contains dimension of PGD fields
-!! NPGDIMAX: dimension along x (no external point)
-!! NPGDJMAX: dimension along y (no external point)
-!! Module MODD_PARAMETERS
-!! JPHEXT
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book 1 : Informations on ISBA model (soil moisture)
-!! "Encoding and decoding Grib data", John D.Chambers, ECMWF, October 95
-!! "A guide to Grib", John D.Stackpole, National weather service, March 94
-!!
-!! AUTHOR
-!! ------
-!!
-!! J. Pettre and V. Bousquet
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 20/11/98
-!! 15/03/99 (V. Masson) phasing with new PGD fields
-!! 21/04/99 (V. Masson) bug in mask definitions for max Y index
-!! 22/04/99 (V. Masson) optimizer bug in u,v loop
-!! --> splitting of the loop
-!! and splitting of the routine in more
-!! contains
-!! 28/05/99 (V. Bousquet) bug in wind interpolated variable for
-!! Arpege
-!! 31/05/99 (V. Masson) set pressure points (given on a regular grid at ECMWF)
-!! on orography points (assuming the last are included in the former)
-!! pressure computation from parameters A and B
-!! (instead of interpolation from grib grid)
-!! 20/07/00 (V. Masson) increase the threshold for land_sea index
-!! 22/11/00 (P. Tulet) add INTERPOL_SV to initialize SV fields
-!! (I. Mallet) from MOCAGE model (IMODE=3)
-!! 01/02/01 (D. Gazen) add INI_NSV
-!! 18/05/01 (P. Jabouille) problem with 129 grib code
-!! 05/12/01 (I. Mallet) add Aladin reunion model
-!! 02/10/02 (I. Mallet) 2 orography fields for CEP (SFC, ML=1)
-!! 01/12/03 (D. Gazen) change Chemical scheme interface
-!! 01/2004 (V. Masson) removes surface (externalization)
-!! 01/06/02 (O.Nuissier) filtering of tropical cyclone
-!! 01/05/04 (P. Tulet) add INTERPOL_SV to initialize SV dust
-!! and aerosol fields
-!! 08/06/2010 (G. Tanguy) replace GRIBEX by GRIB_API : change
-!! of all the subroutine
-!! 05/12/2016 (G.Delautier) length of HGRID for grib_api > 1.14
-!! 08/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
-!! Pergaud : 2018 add GFS
-!! 01/2019 (G.Delautier via Q.Rodier) for GRIB2 ARPEGE and AROME from EPYGRAM
-!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
-! P. Wautelet 14/03/2019: correct ZWS when variable not present in file
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-! Q. Rodier 16/09/2019: switch of GRIB number ID for orography in ARPEGE/AROME in EPyGrAM
-! Q. Rodier 27/01/2020: switch of GRIB number ID for orography and hydrometeors in ARPEGE/AROME in EPyGrAM v1.3.7
-! Q. Rodier 21/04/2020: correction GFS u and v wind component written in the right vertical order
-! Q. Rodier 02/09/2020: Read and interpol geopotential height for interpolation on isobaric surface Grid of NCEP
-! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
-!JP Chaboureau 02/08/2021: add ERA5 reanalysis in pressure levels
-!JP Chaboureau 18/10/2022: correction on vertical level for GFS and ERA5 reanalyses in pressure levels
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-!------------
-!
-USE MODE_DATETIME
-USE MODE_IO_FILE, ONLY: IO_File_close
-USE MODE_MSG
-USE MODE_TIME
-USE MODE_THERMO
-USE MODE_TOOLS, ONLY: UPCASE
-use mode_tools_ll, only: GET_DIM_EXT_ll
-!
-USE MODI_READ_HGRID_n
-USE MODI_READ_VER_GRID
-USE MODI_XYTOLATLON
-USE MODI_HORIBL
-USE MODI_INI_NSV
-USE MODI_REMOVAL_VORTEX
-USE MODI_CH_OPEN_INPUT
-!
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_FIELD_n, ONLY: XZWS, XZWS_DEFAULT
-USE MODD_CONF
-USE MODD_CONF_n
-USE MODD_CST
-USE MODD_LUNIT
-USE MODD_PARAMETERS
-USE MODD_GRID
-USE MODD_GRID_n
-USE MODD_DIM_n
-USE MODD_PARAM_n, ONLY : CTURB
-USE MODD_TIME
-USE MODD_TIME_n
-USE MODD_CH_MNHC_n, ONLY : LUSECHEM,LUSECHAQ,LUSECHIC,LCH_PH
-USE MODD_CH_M9_n, ONLY : NEQ , CNAMES
-USE MODD_CH_AEROSOL, ONLY: CORGANIC, NCARB, NSOA, NSP, LORILAM,&
- JPMODE, LVARSIGI, LVARSIGJ
-USE MODD_NSV , ONLY : NSV
-USE MODD_HURR_CONF, ONLY : LFILTERING,CFILTERING
-USE MODD_PREP_REAL
-USE MODE_MODELN_HANDLER
-!JUAN REALZ
-USE MODE_MPPDB
-!JUAN REALZ
-!
-USE GRIB_API
-!
-IMPLICIT NONE
-!
-!* 0.1. Declaration of arguments
-! ------------------------
-!
-CHARACTER(LEN=4), INTENT(IN) :: HFILE ! which file ('ATM0','ATM1' or 'CHEM')
-TYPE(TFILEDATA),POINTER,INTENT(INOUT) :: TPPRE_REAL1! PRE_REAL1 file
-CHARACTER(LEN=28), INTENT(IN) :: HGRIB ! name of the GRIB file
-TYPE(TFILEDATA), INTENT(IN) :: TPPGDFILE ! physiographic data file
-INTEGER, INTENT(IN) :: KVERB ! verbosity level
-LOGICAL, INTENT(IN) :: ODUMMY_REAL ! flag to interpolate dummy fields
-REAL, INTENT(INOUT) :: PTIME_HORI ! time spent in hor. interpolations
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-! General purpose variables
-INTEGER :: ILUOUT0 ! Unit used for output msg.
-INTEGER :: IRESP ! Return code of FM-routines
-INTEGER :: IRET ! Return code from subroutines
-INTEGER(KIND=kindOfInt) :: IRET_GRIB ! Return code from subroutines
-INTEGER, PARAMETER :: JP_GFS=31 ! number of pressure levels for GFS model
-INTEGER, PARAMETER :: JP_ERA=37 ! number of pressure levels for ERA5 reanalysis
-REAL :: ZA,ZB,ZC ! Dummy variables
-REAL :: ZD,ZE,ZF ! |
-REAL :: ZTEMP ! |
-INTEGER :: JI,JJ ! Dummy counters
-INTEGER :: JLOOP1,JLOOP2 ! |
-INTEGER :: JLOOP3,JLOOP4 ! |
-INTEGER :: JLOOP ! |
-! Variables used by the PGD reader
-CHARACTER(LEN=28) :: YPGD_NAME ! not used - dummy argument
-CHARACTER(LEN=28) :: YPGD_DAD_NAME ! not used - dummy argument
-CHARACTER(LEN=2) :: YPGD_TYPE ! not used - dummy argument
-! PGD Grib definition variables
-INTEGER :: INO ! Number of points of the grid
-INTEGER :: IIU ! Number of points along X
-INTEGER :: IJU ! Number of points along Y
-REAL, DIMENSION(:), ALLOCATABLE :: ZXOUT ! mapping PGD -> Grib (lon.)
-REAL, DIMENSION(:), ALLOCATABLE :: ZYOUT ! mapping PGD -> Grib (lat.)
-REAL, DIMENSION(:), ALLOCATABLE :: ZLONOUT ! mapping PGD -> Grib (lon.)
-REAL, DIMENSION(:), ALLOCATABLE :: ZLATOUT ! mapping PGD -> Grib (lat.)
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZXM ! X of PGD mass points
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZYM ! Y of PGD mass points
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZLATM ! Lat of PGD mass points
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZLONM ! Lon of PGD mass points
-! Variable involved in the task of reading the grib file
-INTEGER(KIND=kindOfInt) :: IUNIT ! unit of the grib file
-CHARACTER(LEN=50) :: HGRID ! type of grid
-INTEGER :: IPAR ! Parameter identifier
-INTEGER :: ITYP ! type of level (Grib code table 3)
-INTEGER :: ILEV1 ! level definition
-INTEGER :: ILEV2 ! level definition
-INTEGER :: IMODEL ! Type of Grib file :
- ! 0 -> ECMWF
- ! 1 -> METEO FRANCE - ALADIN/AROME
- ! 2 -> METEO FRANCE - ALADIN-REUNION
- ! 3 -> METEO FRANCE - ARPEGE
- ! 4 -> METEO FRANCE - ARPEGE
- ! 5 -> METEO FRANCE - MOCAGE
- ! 10 -> NCEP - GFS
-INTEGER :: ICENTER ! number of center
-INTEGER :: ISIZE ! size of grib message
-INTEGER(KIND=kindOfInt) :: ICOUNT ! number of messages in the file
-INTEGER(KIND=kindOfInt),DIMENSION(:),ALLOCATABLE :: IGRIB ! number of the grib in memory
-INTEGER :: INUM ,INUM_ZS ! number of a grib message
-REAL,DIMENSION(:),ALLOCATABLE :: ZPARAM ! parameter of grib grid
-INTEGER,DIMENSION(:),ALLOCATABLE :: IINLO ! longitude of grib grid
-INTEGER(KIND=kindOfInt),DIMENSION(:),ALLOCATABLE :: IINLO_GRIB ! longitude of grib grid
-REAL,DIMENSION(:),ALLOCATABLE :: ZPARAM_ZS ! parameter of grib grid for ZS
-INTEGER,DIMENSION(:),ALLOCATABLE :: IINLO_ZS ! longitude of grib grid for ZS
-REAL,DIMENSION(:),ALLOCATABLE :: ZVALUE ! Intermediate array
-REAL,DIMENSION(:),ALLOCATABLE :: ZOUT ! Intermediate arrays
-! Grib grid definition variables
-INTEGER :: INI ! Number of points
-INTEGER :: INLEVEL ! Number of levels
-INTEGER :: ISTARTLEVEL ! First level (0 or 1)
-TYPE(DATE_TIME) :: TPTCUR ! Date & time of the grib file data
-INTEGER :: ITWOZS
-! surface pressure
-REAL, DIMENSION(:), ALLOCATABLE :: ZPS_G ! Grib data : Ps
-REAL, DIMENSION(:), ALLOCATABLE :: ZLNPS_G ! Grib data : ln(Ps)
-REAL, DIMENSION(:), ALLOCATABLE :: ZWORK_LNPS ! Grib data on zs grid: ln(Ps)
-INTEGER :: INJ,INJ_ZS
-! orography
-CHARACTER(LEN=50) :: HGRID_ZS ! type of grid
-!
-! Reading and projection of the wind vectors u, v
-REAL :: ZALPHA ! Angle of rotation
-REAL, DIMENSION(:), ALLOCATABLE :: ZTU_LS ! Intermediate array for U
-REAL, DIMENSION(:), ALLOCATABLE :: ZTV_LS ! | V
-REAL :: ZLATPOLE ! Arpege stretching pole latitude
-REAL :: ZLONPOLE ! Arpege stretching pole longitude
-REAL :: ZLAT,ZLON ! Lat,lon of current point
-REAL :: ZCOS,ZSIN ! cos,sin of rotation matrix
-REAL, DIMENSION(:), ALLOCATABLE :: ZTU0_LS ! Arpege temp array for U
-REAL, DIMENSION(:), ALLOCATABLE :: ZTV0_LS ! | V
-!
-! variables for hurricane filtering
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZTVF_LS,ZMSLP_LS
-REAL :: ZGAMREF ! Standard atmosphere lapse rate (K/m)
-! date
-INTEGER :: ITIME
-INTEGER :: IDATE
-INTEGER :: ITIMESTEP
-CHARACTER(LEN=10) :: CSTEPUNIT
-CHARACTER(LEN=15) :: YVAL
-!chemistery field
-CHARACTER(LEN=16) :: YPRE_MOC="PRE_MOC1.nam"
-INTEGER, DIMENSION(:), ALLOCATABLE :: INUMGRIB, INUMLEV ! grib
-INTEGER, DIMENSION(:), ALLOCATABLE :: INUMLEV1, INUMLEV2 !numbers
-INTEGER :: IMOC
-INTEGER :: IVAR
-INTEGER :: ICHANNEL
-INTEGER :: INDX
-INTEGER :: INACT
-CHARACTER(LEN=40) :: YINPLINE ! input line
-CHARACTER(LEN=16) :: YFIELD
-CHARACTER, PARAMETER :: YPTAB = CHAR(9) ! TAB character is ASCII : 9
-CHARACTER, PARAMETER :: YPCOM = CHAR(44)! COMma character is ASCII : 44
-CHARACTER(LEN=40), DIMENSION(:), ALLOCATABLE :: YMNHNAME ! species names
-INTEGER :: JN, JNREAL ! loop control variables
-CHARACTER(LEN=40) :: YFORMAT
-CHARACTER(LEN=100) :: YMSG
-! temperature and humidity
-INTEGER :: IT,IQ
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZPF_G ! Pressure (flux point)
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZPM_G ! Pressure (mass point)
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZEXNF_G ! Exner fct. (flux point)
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZEXNM_G ! Exner fct. (mass point)
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZGH_G ! Geopotential Height
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZT_G ! Temperature
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZQ_G ! Specific humidity
-REAL, DIMENSION(:), ALLOCATABLE :: ZH_G ! Relative humidity
-REAL, DIMENSION(:), ALLOCATABLE :: ZTHV_G ! Theta V
-REAL, DIMENSION(:), ALLOCATABLE :: ZRV_G ! Vapor mixing ratio
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZPF_LS ! Pressure (flux point)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZPM_LS ! Pressure (mass point)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEXNF_LS ! Exner fct. (flux point)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEXNM_LS ! Exner fct. (mass point)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZH_LS ! Relative humidity
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRV_LS ! Vapor mixing ratio
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHV_LS ! Theta V
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTEV_LS ! T V
-REAL, DIMENSION(:), ALLOCATABLE :: ZPV ! vertical level in grib file
-INTEGER :: IPVPRESENT ,IPV
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZR_DUM
-INTEGER :: IMI
-TYPE(TFILEDATA),POINTER :: TZFILE
-INTEGER, DIMENSION(JP_GFS) :: IP_GFS ! list of pressure levels for GFS model
-INTEGER, DIMENSION(JP_ERA) :: IP_ERA ! list of pressure levels for ERA5 reanalysis
-INTEGER :: IVERSION,ILEVTYPE
-LOGICAL :: GFIND ! to test if sea wave height is found
-!---------------------------------------------------------------------------------------
-IP_GFS=(/1000,975,950,925,900,850,800,750,700,650,600,550,500,450,400,350,300,&
- 250,200,150,100,70,50,30,20,10,7,5,3,2,1/)
-IP_ERA=(/1000,975,950,925,900,875,850,825,800,775,750,700,650,600,550,500,450,&
- 400,350,300,250,225,200,175,150,125,100,70,50,30,20,10,7,5,3,2,1/)
-!
-TZFILE => NULL()
-!
-IMI = GET_CURRENT_MODEL_INDEX()
-!
-!* 1. READ PGD FILE
-! -------------
-!
-ILUOUT0 = TLUOUT0%NLU
-CALL READ_HGRID_n(TPPGDFILE,YPGD_NAME,YPGD_DAD_NAME,YPGD_TYPE)
-!
-! 1.1 Domain restriction
-!
-!JUAN REALZ
-CALL GET_DIM_EXT_ll('B',IIU,IJU)
-!!$IIU=NIMAX + 2*JPHEXT
-!!$IJU=NJMAX + 2*JPHEXT
-!JUAN REALZ
-INO = IIU * IJU
-!
-!
-! 1.2 Coordinate conversion to lat,lon system
-!
-ALLOCATE (ZXM(IIU,IJU))
-ALLOCATE (ZYM(IIU,IJU))
-ALLOCATE (ZLONM(IIU,IJU))
-ALLOCATE (ZLATM(IIU,IJU))
-ZXM(:,:) = SPREAD(XXHATM(:),2,IJU)
-ZYM(:,:) = SPREAD(XYHATM(:),1,IIU)
-CALL SM_XYTOLATLON_A (XLAT0,XLON0,XRPK,XLATORI,XLONORI,ZXM,ZYM,ZLATM,ZLONM, &
- IIU,IJU)
-ALLOCATE (ZLONOUT(INO))
-ALLOCATE (ZLATOUT(INO))
-JLOOP1 = 0
-DO JJ = 1, IJU
- ZLONOUT(JLOOP1+1:JLOOP1+IIU) = ZLONM(1:IIU,JJ)
- ZLATOUT(JLOOP1+1:JLOOP1+IIU) = ZLATM(1:IIU,JJ)
- JLOOP1 = JLOOP1 + IIU
-ENDDO
-DEALLOCATE (ZLATM)
-DEALLOCATE (ZLONM)
-DEALLOCATE (ZYM)
-DEALLOCATE (ZXM)
-!
-ALLOCATE (ZXOUT(INO))
-ALLOCATE (ZYOUT(INO))
-!
-!---------------------------------------------------------------------------------------
-!
-!* 2. READ GRIB FIELDS
-! ----------------
-!
-IF (HFILE(1:3)=='ATM' .OR. HFILE=='CHEM') THEN
- WRITE (ILUOUT0,'(A,A4)') ' -- Grib reader started for ',HFILE
-ELSE
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE','bad input argument')
-END IF
-!
-!* 2.1 Charge in memory the grib messages
-!
-! open grib file
-CALL GRIB_OPEN_FILE(IUNIT,HGRIB,'R',IRET_GRIB)
-IF (IRET_GRIB /= 0) THEN
- WRITE(YMSG,*) 'Error opening the grib file ',TRIM(HGRIB),', error code ', IRET_GRIB
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
-END IF
-! count the messages in the file
-CALL GRIB_COUNT_IN_FILE(IUNIT,ICOUNT,IRET_GRIB)
-IF (IRET_GRIB /= 0) THEN
- WRITE(YMSG,*) 'Error in reading the grib file ',TRIM(HGRIB),', error code ', IRET_GRIB
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
-END IF
-ALLOCATE(IGRIB(ICOUNT))
-! initialize the tabular with a negativ number
-! ( all the IGRIB will be different )
-IGRIB(:)=-12
-!charge all the message in memory
-DO JLOOP=1,ICOUNT
-CALL GRIB_NEW_FROM_FILE(IUNIT,IGRIB(JLOOP),IRET_GRIB)
-IF (IRET_GRIB /= 0) THEN
- WRITE(YMSG,*) 'Error in reading the grib file - ILOOP=',JLOOP,' - error code ', IRET_GRIB
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
-END IF
-END DO
-! close the grib file
-CALL GRIB_CLOSE_FILE(IUNIT)
-!
-!
-!---------------------------------------------------------------------------------------
-!* 2.2 Research center with the first message
-!---------------------------------------------------------------------------------------
-!
-CALL GRIB_GET(IGRIB(1),'centre',ICENTER,IRET_GRIB)
-IF (IRET_GRIB /= 0) THEN
- WRITE(YMSG,*) 'Error in reading center - error code ', IRET_GRIB
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
-END IF
-CALL GRIB_GET(IGRIB(1),'typeOfGrid',HGRID,IRET_GRIB)
-IF (IRET_GRIB /= 0) THEN
- WRITE(YMSG,*) 'Error in reading type of grid - error code ', IRET_GRIB
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
-END IF
-!
-IMODEL = -1
-SELECT CASE (ICENTER)
- CASE (98)
- WRITE (ILUOUT0,'(A)') &
- ' | Grib file from European Center for Medium-range Weather Forecast'
- IMODEL = 0
- ALLOCATE(ZPARAM(6))
- CASE (85)
- SELECT CASE (HGRID)
- CASE('lambert')
- WRITE (ILUOUT0,'(A)') ' | Grib file from French Weather Service - Arome france model'
- CALL GRIB_GET(IGRIB(1),'editionNumber',IVERSION,IRET_GRIB)
- IF (IVERSION==2) THEN
- IMODEL = 6 ! GRIB2 since summer 2018 (epygram)
- ELSE
- IMODEL = 1 ! GRIB1 befor summer 2018 (lfi2mv)
- ENDIF
- ALLOCATE(ZPARAM(10))
- CASE('mercator')
- WRITE (ILUOUT0,'(A)') ' | Grib file from French Weather Service - Aladin reunion model'
- IMODEL = 2
- ALLOCATE(ZPARAM(9))
-
- CASE('unknown_PLPresent','reduced_stretched_rotated_gg')
- WRITE (ILUOUT0,'(A)') ' | Grib file from French Weather Service - Arpege model'
- ALLOCATE(ZPARAM(10))
- CALL GRIB_GET(IGRIB(1),'editionNumber',IVERSION,IRET_GRIB)
- IF (IVERSION==2) THEN
- IMODEL = 7 ! GRIB2 since summer 2018 (epygram)
- ELSE
- IMODEL = 3 ! GRIB1 befor summer 2018 (lfi2mv)
- ENDIF
-
- CASE('regular_gg')
- WRITE (ILUOUT0,'(A)') ' | Grib file from French Weather Service - Arpege model'
- WRITE (ILUOUT0,'(A)') 'but same grid as ECMWF model (unstretched)'
- IMODEL = 4
- ALLOCATE(ZPARAM(10))
- CASE('regular_ll')
- WRITE (ILUOUT0,'(A)') ' | Grib file from French Weather Service - Mocage model'
- IMODEL = 5
- ALLOCATE(ZPARAM(6))
- END SELECT
- CASE (7)
- WRITE (ILUOUT0,'(A)') ' | Grib file from National Center for Environmental Prediction'
- IMODEL = 10
- ALLOCATE(ZPARAM(6))
-END SELECT
-IF (IMODEL==-1) THEN
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE','unsupported Grib file format')
-END IF
-!
-!---------------------------------------------------------------------------------------
-!* 2.3 Read and interpol orography
-!---------------------------------------------------------------------------------------
-!
-WRITE (ILUOUT0,'(A)') ' | Searching orography'
-SELECT CASE (IMODEL)
- CASE(0) ! ECMWF
- CALL SEARCH_FIELD(IGRIB,INUM_ZS,KPARAM=129)
- IF(INUM_ZS < 0) THEN
- WRITE (ILUOUT0,'(A)')'Orography is missing - abort'
- END IF
- CASE(3,4,5) ! arpege et mocage
- CALL SEARCH_FIELD(IGRIB,INUM_ZS,KPARAM=8)
- IF(INUM_ZS < 0) THEN
- WRITE (ILUOUT0,'(A)')'Orography is missing - abort'
- ENDIF
- CASE(1,2) ! aladin et aladin reunion
- CALL SEARCH_FIELD(IGRIB,INUM_ZS,KPARAM=6)
- IF(INUM_ZS < 0) THEN
- WRITE (ILUOUT0,'(A)')'Orography is missing - abort'
- ENDIF
- CASE(6,7) ! arpege and arome GRIB2
- CALL SEARCH_FIELD(IGRIB,INUM_ZS,KDIS=0,KCAT=3,KNUMBER=4)
- IF(INUM_ZS < 0) THEN
- CALL SEARCH_FIELD(IGRIB,INUM_ZS,KDIS=0,KCAT=193,KNUMBER=5)
- IF(INUM_ZS < 0) THEN
- WRITE (ILUOUT0,'(A)')'Orography is missing - abort'
- END IF
- ENDIF
- CASE(10) ! NCEP
- CALL SEARCH_FIELD(IGRIB,INUM_ZS,KDIS=0,KCAT=3,KNUMBER=5,KTFFS=1)
- IF(INUM_ZS < 0) THEN
- WRITE (ILUOUT0,'(A)')'Orography is missing - abort'
- ENDIF
-END SELECT
-ZPARAM(:)=-999.
-CALL GRIB_GET(IGRIB(INUM_ZS),'Nj',INJ,IRET_GRIB)
-ALLOCATE(IINLO(INJ))
-CALL COORDINATE_CONVERSION(IMODEL,IGRIB(INUM_ZS),IIU,IJU,ZLONOUT,ZLATOUT,&
- ZXOUT,ZYOUT,INI,ZPARAM,IINLO)
-ALLOCATE(ZPARAM_ZS(SIZE(ZPARAM)))
-ZPARAM_ZS=ZPARAM
-ALLOCATE(IINLO_ZS(SIZE(IINLO)))
-IINLO_ZS=IINLO
-CALL GRIB_GET_SIZE(IGRIB(INUM_ZS),'values',ISIZE)
-ALLOCATE(ZVALUE(ISIZE))
-CALL GRIB_GET(IGRIB(INUM_ZS),'values',ZVALUE)
-ALLOCATE(ZOUT(INO))
-CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
- ZVALUE,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
-DEALLOCATE(IINLO)
-DEALLOCATE(ZVALUE)
-!
-IF (IMODEL/=10) THEN ! others than NCEP
- ! Data given in archives are multiplied by the gravity acceleration
- ZOUT = ZOUT / XG
-END IF
-!
-! Stores the field in a 2 dimension array
-IF (HFILE(1:3)=='ATM') THEN
- ALLOCATE (XZS_LS(IIU,IJU))
- ALLOCATE (XZSMT_LS(IIU,IJU))
- CALL ARRAY_1D_TO_2D (INO,ZOUT,IIU,IJU,XZS_LS)
- XZSMT_LS = XZS_LS ! no smooth orography in this case
-ELSE IF (HFILE=='CHEM') THEN
- ALLOCATE (XZS_SV_LS(IIU,IJU))
- CALL ARRAY_1D_TO_2D (INO,ZOUT,IIU,IJU,XZS_SV_LS)
-END IF
-DEALLOCATE (ZOUT)
-!
-!---------------------------------------------------------------------------------------
-!* 2.3 bis Read and interpol Sea Wave significant height
-!---------------------------------------------------------------------------------------
-WRITE (ILUOUT0,'(A)') ' | Searching sea wave significant height'
-SELECT CASE (IMODEL)
- CASE(0) ! ECMWF
- ALLOCATE (XZWS(IIU,IJU))
- GFIND=.FALSE.
- !
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=140229)
- IF(INUM < 0) THEN
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=229)
- !
- IF(INUM < 0) THEN
- WRITE (YVAL,'( E15.8 )') XZWS_DEFAULT
- WRITE (ILUOUT0,'(A)')' | !!! WARNING !!! Sea wave height is missing in '// &
- 'the GRIB file - the default value of '//TRIM(YVAL)//' meters is used'
- XZWS = XZWS_DEFAULT
- ELSE
- GFIND=.TRUE.
- END IF
- ELSE
- GFIND=.TRUE.
- END IF
- !
- IF (GFIND) THEN
- !!!!!!!!!!! Faire en sorte de le faire que pour le CASE(0)
- ! Sea wave significant height disponible uniquement pour ECMWF
- ! recuperation du tableau de valeurs
- CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
- ALLOCATE(IINLO(INJ))
- CALL COORDINATE_CONVERSION(IMODEL,IGRIB(INUM),IIU,IJU,ZLONOUT,ZLATOUT,&
- ZXOUT,ZYOUT,INI,ZPARAM,IINLO)
- ALLOCATE(ZVALUE(ISIZE))
- CALL GRIB_GET(IGRIB(INUM),'values',ZVALUE)
- ! Change 9999 value to -1
- WHERE(ZVALUE.EQ.9999.) ZVALUE=0.
- ALLOCATE(ZOUT(INO))
- CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
- ZVALUE,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
- DEALLOCATE(IINLO)
- DEALLOCATE(ZVALUE)
- ! Stores the field in a 2 dimension array
- CALL ARRAY_1D_TO_2D (INO,ZOUT,IIU,IJU,XZWS)
- DEALLOCATE (ZOUT)
- END IF
-END SELECT
-!
-!---------------------------------------------------------------------------------------
-!* 2.4 Interpolation surface pressure
-!---------------------------------------------------------------------------------------
-!
-!* 2.4.1 Read pressure
-!
-WRITE (ILUOUT0,'(A)') ' | Searching pressure'
-
-SELECT CASE (IMODEL)
- CASE(0) ! ECMWF
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=152)
- IF( INUM < 0 ) THEN
- WRITE (ILUOUT0,'(A)') ' | Logarithm of surface pressure is missing. It is then supposed that'
- WRITE (ILUOUT0,'(A)') ' | this ECMWF file has atmospheric fields on pressure levels (e.g. ERA5)'
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=134)
- IMODEL = 11
- END IF
- CASE(1,2,3,4,5) ! arpege mocage aladin et aladin reunion
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=1)
- CASE(6,7) ! NEW AROME,ARPEGE
- CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=3,KNUMBER=0)
- CASE(10) ! NCEP
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=134)
-END SELECT
-IF( INUM < 0 ) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'surface pressure is missing' )
-! recuperation du tableau de valeurs
-CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
-ALLOCATE(ZVALUE(ISIZE))
-CALL GRIB_GET(IGRIB(INUM),'values',ZVALUE)
-! determination des tableaux ZPS_G et ZLNPS_G
-SELECT CASE (IMODEL)
- CASE(0,6,7) ! ECMWF
- ALLOCATE (ZPS_G (ISIZE))
- ALLOCATE (ZLNPS_G(ISIZE))
- ZLNPS_G(:) = ZVALUE(1:ISIZE)
- ZPS_G (:) = EXP(ZVALUE(1:ISIZE))
- CASE(1,2,3,4,5,10,11) ! arpege mocage aladin aladin-reunion NCEP ERA5
- ALLOCATE (ZPS_G (ISIZE))
- ALLOCATE (ZLNPS_G(ISIZE))
- ZPS_G (:) = ZVALUE(1:ISIZE)
- ZLNPS_G(:) = LOG(ZVALUE(1:ISIZE))
-END SELECT
-DEALLOCATE (ZVALUE)
-!
-!* 2.4.2 Removes pressure points not on orography points
-! (if pressure is on a regular grid)
-CALL GRIB_GET(IGRIB(INUM),'typeOfGrid',HGRID)
-CALL GRIB_GET(IGRIB(INUM_ZS),'typeOfGrid',HGRID_ZS)
-CALL GRIB_GET(IGRIB(INUM),'Nj',INJ)
-CALL GRIB_GET(IGRIB(INUM_ZS),'Nj',INJ_ZS)
-!
-IF ( HGRID(1:7)=='regular' .AND. HGRID_ZS(1:7)=='reduced' .AND.&
- INJ == INJ_ZS) THEN
- call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', &
- 'HGRID(1:7)==regular .AND. HGRID_ZS(1:7)==reduced .AND. INJ == INJ_ZS' )
-ELSE
- ALLOCATE(ZWORK_LNPS(SIZE(ZLNPS_G)))
- ZWORK_LNPS(:) = ZLNPS_G(:)
-ENDIF
-!
-IF (HFILE(1:3)=='ATM') THEN
- ALLOCATE (XPS_LS(IIU,IJU))
-ELSE IF (HFILE=='CHEM') THEN
- ALLOCATE (XPS_SV_LS(IIU,IJU))
-END IF
-!
-ALLOCATE(IINLO(INJ))
-CALL COORDINATE_CONVERSION(IMODEL,IGRIB(INUM),IIU,IJU,ZLONOUT,ZLATOUT,&
- ZXOUT,ZYOUT,INI,ZPARAM,IINLO)
-ALLOCATE(ZOUT(INO))
-CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI,&
- ZWORK_LNPS,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE. )
-DEALLOCATE(ZWORK_LNPS)
-DEALLOCATE(IINLO)
-!
-!* 2.4.3 conversion to surface pressure
-!
-ZOUT=EXP(ZOUT)
-IF (HFILE(1:3)=='ATM') THEN
- CALL ARRAY_1D_TO_2D (INO,ZOUT,IIU,IJU,XPS_LS(:,:))
-ELSE IF (HFILE=='CHEM') THEN
- CALL ARRAY_1D_TO_2D (INO,ZOUT,IIU,IJU,XPS_SV_LS(:,:))
-END IF
-!JUAN REALZ
-CALL MPPDB_CHECK2D(XZS_LS,"XZS_LS",PRECISION)
-!JUAN REALZ
-DEALLOCATE (ZOUT)
-DEALLOCATE (ZLNPS_G)
-!
-!---------------------------------------------------------------------------------------
-!* 2.5 Interpolation temperature and humidity
-!---------------------------------------------------------------------------------------
-!
-!* 2.5.1 Read T and Q on each level
-!
-WRITE (ILUOUT0,'(A)') ' | Reading T and Q fields'
-!
-IF (IMODEL/=10.AND.IMODEL/=11) THEN
- SELECT CASE (IMODEL)
- CASE(0) ! ECMWF
- ISTARTLEVEL=1
- IT=130
- IQ=133
- CASE(1,2,3,4,5) ! arpege mocage aladin et aladin reunion
- IT=11
- IQ=51
- ISTARTLEVEL=1
- CASE(6,7) !GRIB2 AROME AND ARPEGE
- IT=130
- IQ=133
- ISTARTLEVEL=1
- END SELECT
-
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IT,KLEV1=ISTARTLEVEL)
- IF(INUM < 0) THEN
- ISTARTLEVEL=0
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IT,KLEV1=ISTARTLEVEL)
- ENDIF
- IF(INUM < 0) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'air temperature is missing' )
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IQ,KLEV1=ISTARTLEVEL)
- IF(INUM < 0) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'atmospheric specific humidity is missing' )
-ELSEIF (IMODEL==10) THEN ! NCEP
- ISTARTLEVEL=1000
- IT=130
- IQ=157
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IT,KLEV1=ISTARTLEVEL)
- IF(INUM < 0) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'air temperature is missing' )
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IQ,KLEV1=ISTARTLEVEL)
- IF(INUM < 0) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'atmospheric relative humidity is missing' )
-ELSE ! ERA5
- ISTARTLEVEL=1000
- IT=130
- IQ=133
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IT,KLEV1=ISTARTLEVEL)
- IF(INUM < 0) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'air temperature is missing' )
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IQ,KLEV1=ISTARTLEVEL)
- IF(INUM < 0) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'atmospheric specific humidity is missing' )
-ENDIF
-!
-IF (IMODEL/=10.AND.IMODEL/=11) THEN ! others than NCEP AND ERA5
- CALL GRIB_GET(IGRIB(INUM),'NV',INLEVEL)
- INLEVEL = NINT(INLEVEL / 2.) - 1
- CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
-ELSE
- IF (IMODEL==10) THEN
- INLEVEL=JP_GFS
- ELSE
- INLEVEL=JP_ERA
- END IF
-END IF
-!
-ALLOCATE (ZT_G(ISIZE,INLEVEL))
-ALLOCATE (ZQ_G(ISIZE,INLEVEL))
-!
-IF (IMODEL/=10.AND.IMODEL/=11) THEN ! others than NCEP AND ERA5
- DO JLOOP1=1, INLEVEL
- ILEV1 = JLOOP1-1+ISTARTLEVEL
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IQ,KLEV1=ILEV1)
- IF (INUM< 0) THEN
- WRITE(YMSG,*) 'atmospheric humidity level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
- END IF
- CALL GRIB_GET(IGRIB(INUM),'values',ZQ_G(:,INLEVEL-JLOOP1+1))
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IT,KLEV1=ILEV1)
- IF (INUM< 0) THEN
- WRITE(YMSG,*) 'atmospheric temperature level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
- END IF
- CALL GRIB_GET(IGRIB(INUM),'values',ZT_G(:,INLEVEL-JLOOP1+1))
- CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB)
- END DO
-ELSEIF (IMODEL==10) THEN ! NCEP
- DO JLOOP1=1, INLEVEL
- ILEV1 = IP_GFS(JLOOP1)
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IQ,KLEV1=ILEV1)
- IF (INUM< 0) THEN
- WRITE(YMSG,*) 'atmospheric humidity level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
- END IF
- CALL GRIB_GET(IGRIB(INUM),'values',ZQ_G(:,JLOOP1),IRET_GRIB)
- CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=0,KNUMBER=0,KLEV1=ILEV1,KTFFS=100)
- IF (INUM< 0) THEN
- WRITE(YMSG,*) 'atmospheric temperature level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
- END IF
- CALL GRIB_GET(IGRIB(INUM),'values',ZT_G(:,JLOOP1),IRET_GRIB)
- CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB)
- END DO
-ELSE ! ERA5
- DO JLOOP1=1, INLEVEL
- ILEV1 = IP_ERA(JLOOP1)
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IQ,KLEV1=ILEV1)
- IF (INUM< 0) THEN
- WRITE(YMSG,*) 'atmospheric humidity level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
- END IF
- CALL GRIB_GET(IGRIB(INUM),'values',ZQ_G(:,JLOOP1),IRET_GRIB)
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IT,KLEV1=ILEV1)
- IF (INUM< 0) THEN
- WRITE(YMSG,*) 'atmospheric temperature level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
- END IF
- CALL GRIB_GET(IGRIB(INUM),'values',ZT_G(:,JLOOP1),IRET_GRIB)
- CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB)
- END DO
-END IF
-
-ALLOCATE(IINLO(INJ))
-CALL COORDINATE_CONVERSION(IMODEL,IGRIB(INUM),IIU,IJU,ZLONOUT,ZLATOUT,&
- ZXOUT,ZYOUT,INI,ZPARAM,IINLO)
-!
-!* 2.5.2 Load level definition parameters A and B
-!
-IF (IMODEL/=10.AND.IMODEL/=11) THEN ! others than NCEP AND ERA5
-
- IF (HFILE(1:3)=='ATM') THEN
- XP00_LS = 101325.
- ELSE IF (HFILE=='CHEM') THEN
- XP00_SV_LS = 101325.
- END IF
-!
- IF (INLEVEL > 0) THEN
- IF (HFILE(1:3)=='ATM') THEN
- ALLOCATE (XA_LS(INLEVEL))
- ALLOCATE (XB_LS(INLEVEL))
- ELSE IF (HFILE=='CHEM') THEN
- ALLOCATE (XA_SV_LS(INLEVEL))
- ALLOCATE (XB_SV_LS(INLEVEL))
- END IF
-!
- CALL GRIB_GET(IGRIB(INUM),'PVPresent',IPVPRESENT)
- IF (IPVPRESENT==1) THEN
- CALL GRIB_GET_SIZE(IGRIB(INUM),'pv',IPV)
- ALLOCATE(ZPV(IPV))
- CALL GRIB_GET(IGRIB(INUM),'pv',ZPV)
- ELSE
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE','there is no PV value in this message')
- ENDIF
- SELECT CASE (IMODEL)
- CASE (0,3,4,6,7)
- DO JLOOP1 = 1, INLEVEL
- XA_LS(1 + INLEVEL - JLOOP1) = ZPV(1+JLOOP1) / XP00_LS
- XB_LS(1 + INLEVEL - JLOOP1) = ZPV(2+INLEVEL+JLOOP1)
- END DO
- CASE (1,2)
- JLOOP2 = 2
- DO JLOOP1 = 1, INLEVEL
- JLOOP2 = JLOOP2 + 1
- XA_LS(1 + INLEVEL - JLOOP1) = ZPV(JLOOP2)
- JLOOP2 = JLOOP2 + 1
- XB_LS(1 + INLEVEL - JLOOP1) = ZPV(JLOOP2)
- END DO
- CASE (5)
- DO JLOOP1 = 1, INLEVEL
- IF (HFILE(1:3)=='ATM') THEN
- XA_LS(1 + INLEVEL - JLOOP1) = ZPV(1+ JLOOP1) / XP00_LS**2
- XB_LS(1 + INLEVEL - JLOOP1) = ZPV(2+INLEVEL+JLOOP1)
- ELSE IF (HFILE=='CHEM') THEN
- XA_SV_LS(1 + INLEVEL - JLOOP1) = ZPV(1+ JLOOP1) / XP00_LS**2
- XB_SV_LS(1 + INLEVEL - JLOOP1) = ZPV(2+INLEVEL+JLOOP1)
- END IF
- END DO
- END SELECT
- ELSE
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE','level definition section is missing')
- END IF
-ELSE
- ALLOCATE (XA_LS(INLEVEL))
- ALLOCATE (XB_LS(0))
- IF (IMODEL==10) THEN
- XA_LS = 100.*IP_GFS
- ELSE
- XA_LS = 100.*IP_ERA
- END IF
-END IF
-!
-!* 2.5.3 Compute atmospheric pressure on grib grid
-!
-WRITE (ILUOUT0,'(A)') ' | Atmospheric pressure on Grib grid is being computed'
-
-ALLOCATE (ZPF_G(INI,INLEVEL))
-IF (IMODEL/=10.AND.IMODEL/=11) THEN ! others than NCEP and ERA5
- IF (HFILE(1:3)=='ATM') THEN
- ZPF_G(:,:) = SPREAD(XA_LS,1,INI)*XP00_LS + &
- SPREAD(XB_LS,1,INI)*SPREAD(ZPS_G(1:INI),2,INLEVEL)
- ELSE IF (HFILE=='CHEM') THEN
- ZPF_G(:,:) = SPREAD(XA_SV_LS,1,INI)*XP00_SV_LS + &
- SPREAD(XB_SV_LS,1,INI)*SPREAD(ZPS_G(1:INI),2,INLEVEL)
- END IF
-ELSE
- IF (IMODEL==10) THEN
- ZPF_G(:,:) = 100.*SPREAD(IP_GFS,1,INI)
- ELSE
- ZPF_G(:,:) = 100.*SPREAD(IP_ERA,1,INI)
- END IF
-END IF
-DEALLOCATE (ZPS_G)
-!
-ALLOCATE (ZEXNF_G(INI,INLEVEL))
-ZEXNF_G(:,:) = (ZPF_G(:,:)/XP00)**(XRD/XCPD)
-!
-ALLOCATE (ZEXNM_G(INI,INLEVEL))
-ZEXNM_G(:,1:INLEVEL-1) = (ZEXNF_G(:,1:INLEVEL-1)-ZEXNF_G(:,2:INLEVEL)) / &
- (LOG(ZEXNF_G(:,1:INLEVEL-1))-LOG(ZEXNF_G(:,2:INLEVEL)))
-ZEXNM_G(:,INLEVEL) = (ZPF_G(:,INLEVEL)/2./XP00)**(XRD/XCPD)
-!
-IF (IMODEL==10.OR.IMODEL==11) ZEXNM_G(:,:)=ZEXNF_G(:,:) ! for GFS and ERA5 on pressure levels
-!
-DEALLOCATE (ZEXNF_G)
-DEALLOCATE (ZPF_G)
-!
-ALLOCATE (ZPM_G(INI,INLEVEL))
-ZPM_G(:,:) = XP00*(ZEXNM_G(:,:))**(XCPD/XRD)
-!
-!* 2.5.4 Compute the relative humidity and the interpolate Thetav, P, Q and H
-!
-IF (IMODEL==1) THEN
- ! search cloud_water in Arome case (forecast)
- ISTARTLEVEL = 1
- IPAR=246
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ISTARTLEVEL)
- IF (INUM < 0) THEN
- ISTARTLEVEL = 0
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ISTARTLEVEL)
- END IF
- IF (INUM > 0) THEN
- WRITE (ILUOUT0,'(A)') ' | Grib file from French Weather Service - Arome model (forecast)'
- LCPL_AROME=.TRUE.
- NRR=6
- END IF
- ! search also turbulent kinetic energy
- ISTARTLEVEL = 1
- IPAR=251
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ISTARTLEVEL)
- IF (INUM < 0) THEN
- ISTARTLEVEL = 0
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ISTARTLEVEL)
- END IF
- IF (INUM > 0) CTURB='TKEL'
-END IF
-
-IF (IMODEL==6) THEN ! GRIB2 AROME
-! search cloud_water in Arome case (forecast)
- ISTARTLEVEL = 1
- CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=6,KNUMBER=6,KLEV1=ISTARTLEVEL)
- IF (INUM < 0) THEN
- ISTARTLEVEL = 0
- CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=6,KNUMBER=6,KLEV1=ISTARTLEVEL)
- END IF
- IF (INUM < 0) THEN
- ISTARTLEVEL = 1
- CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=0,KLEV1=ISTARTLEVEL)
- END IF
- IF (INUM > 0) THEN
- WRITE (ILUOUT0,'(A)') ' | Grib file from French Weather Service - Arome model (forecast)'
- LCPL_AROME=.TRUE.
- NRR=6
- END IF
- ! search also turbulent kinetic energy
- ISTARTLEVEL = 1
- CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=19,KNUMBER=11,KLEV1=ISTARTLEVEL)
- IF (INUM < 0) THEN
- ISTARTLEVEL = 0
- CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=19,KNUMBER=11,KLEV1=ISTARTLEVEL)
- END IF
- IF (INUM > 0) CTURB='TKEL'
-END IF
-!
-!
-WRITE (ILUOUT0,'(A)') ' | Computing relative humidity on each level'
-ALLOCATE (ZH_G(INI))
-ALLOCATE (ZH_LS(IIU,IJU,INLEVEL))
-IF (HFILE(1:3)=='ATM') THEN
- ALLOCATE (XT_LS(IIU,IJU,INLEVEL))
- ALLOCATE (XQ_LS(IIU,IJU,INLEVEL,NRR)) ; XQ_LS=0.
-ELSE IF (HFILE=='CHEM') THEN
- ALLOCATE (XT_SV_LS(IIU,IJU,INLEVEL))
- ALLOCATE (XQ_SV_LS(IIU,IJU,INLEVEL,1))
-END IF
-IF (CTURB=='TKEL') THEN
- IF (ALLOCATED(XTKE_LS)) DEALLOCATE(XTKE_LS)
- ALLOCATE(XTKE_LS(IIU,IJU,INLEVEL)) ; XTKE_LS=0.
-ELSE
- IF (ALLOCATED(XTKE_LS)) DEALLOCATE(XTKE_LS)
- ALLOCATE(XTKE_LS(0,0,0))
-END IF
-ALLOCATE (ZTHV_LS(IIU,IJU,INLEVEL))
-ALLOCATE (ZTHV_G(INI))
-ALLOCATE (ZRV_G(INI))
-ALLOCATE (ZOUT(INO))
-IF (IMODEL/=10) THEN ! others than NCEP
- DO JLOOP1=1, INLEVEL
- !
- ! Compute Theta V and relative humidity on grib grid
- !
- ! (1/rv) = (1/q) - 1
- ! Thetav = T . (P0/P)^(Rd/Cpd) . ( (1 + (Rv/Rd).rv) / (1 + rv) )
- ! Hu = P / ( ( (Rd/Rv) . ((1/rv) - 1) + 1) . Es(T) )
- !
- ZRV_G(:) = 1. / (1./MAX(ZQ_G(:,JLOOP1),1.E-12) - 1.)
- !
- ZTHV_G(:)=ZT_G(:,JLOOP1) * ((XP00/ZPM_G(:,JLOOP1))**(XRD/XCPD)) * &
- ((1. + XRV*ZRV_G(:)/XRD) / (1. + ZRV_G(:)))
- !
- ZH_G(1:INI) = 100. * ZPM_G(:,JLOOP1) / ( (XRD/XRV)*(1./ZRV_G(:)+1.)*SM_FOES(ZT_G(:,JLOOP1)) )
- ZH_G(:) = MAX(MIN(ZH_G(:),100.),0.)
- !
- ! Interpolation : H
- CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
- ZH_G,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
- CALL ARRAY_1D_TO_2D (INO,ZOUT,IIU,IJU,ZH_LS(:,:,JLOOP1))
- ZH_LS(:,:,JLOOP1) = MAX(MIN(ZH_LS(:,:,JLOOP1),100.),0.)
- !
- ! interpolation : Theta V
- CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
- ZTHV_G,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
- CALL ARRAY_1D_TO_2D (INO,ZOUT,IIU,IJU,ZTHV_LS(:,:,JLOOP1))
- !
- END DO
-ELSE !GFS and ERA5 on pressure levels
- DO JLOOP1=1, INLEVEL
- ZH_G(:) =ZQ_G(:,JLOOP1)
- ZRV_G(:) = (XRD/XRV)*SM_FOES(ZT_G(:,JLOOP1))*0.01*ZH_G(:) &
- /(ZPM_G(:,JLOOP1) -SM_FOES(ZT_G(:,JLOOP1))*0.01*ZH_G(:))
- ZTHV_G(:)=ZT_G(:,JLOOP1) * ((XP00/ZPM_G(:,JLOOP1))**(XRD/XCPD)) * &
- ((1. + XRV*ZRV_G(:)/XRD) / (1. + ZRV_G(:)))
- !
- ! Interpolation : H
- CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
- ZH_G,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
- CALL ARRAY_1D_TO_2D (INO,ZOUT,IIU,IJU,ZH_LS(:,:,JLOOP1))
- ZH_LS(:,:,JLOOP1) = MAX(MIN(ZH_LS(:,:,JLOOP1),100.),0.)
- !
- ! interpolation : Theta V
- CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
- ZTHV_G,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
- CALL ARRAY_1D_TO_2D (INO,ZOUT,IIU,IJU,ZTHV_LS(:,:,JLOOP1))
- !
- END DO
-END IF
-
-DEALLOCATE (ZOUT)
-
-
-!---------------------------------------------------------------------------------------
-!* 2.5.4.2 Read and interpol geopotential height for interpolation on isobaric surface Grid of NCEP
-!---------------------------------------------------------------------------------------
-!
-ALLOCATE (ZGH_G(ISIZE,INLEVEL))
-!
-IF (IMODEL==10.OR.IMODEL==11) THEN !NCEP or ERA5 with pressure grid only
- DO JLOOP1=1, INLEVEL
- IF (IMODEL==10) THEN
- ILEV1 = IP_GFS(JLOOP1)
- CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=3,KNUMBER=5,KLEV1=ILEV1)
- ELSE
- ILEV1 = IP_ERA(JLOOP1)
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=129,KLEV1=ILEV1)
- END IF
- IF (INUM< 0) THEN
- !callabortstop
- WRITE(YMSG,*) 'Geopotential height level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
- END IF
- !
- CALL GRIB_GET(IGRIB(INUM),'values',ZGH_G(:,JLOOP1),IRET_GRIB)
- CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB)
- !
- IF (IMODEL/=10) THEN
- ! Data given in archives are multiplied by the gravity acceleration
- ZGH_G(:,JLOOP1) = ZGH_G(:,JLOOP1) / XG
- END IF
- !
- END DO
- !
- CALL COORDINATE_CONVERSION(IMODEL,IGRIB(INUM_ZS),IIU,IJU,ZLONOUT,ZLATOUT,&
- ZXOUT,ZYOUT,INI,ZPARAM,IINLO)
- !
- ALLOCATE(ZOUT(INO))
- ALLOCATE(XGH_LS(IIU,IJU,INLEVEL))
- !
- DO JLOOP1=1, INLEVEL
- CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
- ZGH_G(:,JLOOP1),INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
- CALL ARRAY_1D_TO_2D (INO,ZOUT,IIU,IJU,XGH_LS(:,:,JLOOP1))
- END DO
- DEALLOCATE(ZOUT)
-END IF
-!
-!* 2.5.5 Compute atmospheric pressure on MESO-NH grid
-!
-WRITE (ILUOUT0,'(A)') ' | Atmospheric pressure on the Meso-NH grid is being computed'
-ALLOCATE (ZPF_LS(IIU,IJU,INLEVEL))
-IF (IMODEL/=10.AND.IMODEL/=11) THEN ! others than NCEP and ERA5
- IF (HFILE(1:3)=='ATM') THEN
- ZPF_LS(:,:,:) = SPREAD(SPREAD(XA_LS,1,IIU),2,IJU)*XP00_LS + &
- SPREAD(SPREAD(XB_LS,1,IIU),2,IJU)*SPREAD(XPS_LS,3,INLEVEL)
- ELSE IF (HFILE=='CHEM') THEN
- ZPF_LS(:,:,:) = SPREAD(SPREAD(XA_SV_LS,1,IIU),2,IJU)*XP00_LS + &
- SPREAD(SPREAD(XB_SV_LS,1,IIU),2,IJU)*SPREAD(XPS_SV_LS,3,INLEVEL)
- END IF
-ELSE
- IF(IMODEL==10) THEN
- ZPF_LS(:,:,:) = 100.*SPREAD(SPREAD(IP_GFS,1,IIU),2,IJU)
- ELSE
- ZPF_LS(:,:,:) = 100.*SPREAD(SPREAD(IP_ERA,1,IIU),2,IJU)
- END IF
-END IF
-!
-ALLOCATE (ZEXNF_LS(IIU,IJU,INLEVEL))
-ZEXNF_LS(:,:,:) = (ZPF_LS(:,:,:)/XP00)**(XRD/XCPD)
-!
-ALLOCATE (ZEXNM_LS(IIU,IJU,INLEVEL))
-ZEXNM_LS(:,:,1:INLEVEL-1) = (ZEXNF_LS(:,:,1:INLEVEL-1)-ZEXNF_LS(:,:,2:INLEVEL)) / &
- (LOG(ZEXNF_LS(:,:,1:INLEVEL-1))-LOG(ZEXNF_LS(:,:,2:INLEVEL)))
-ZEXNM_LS(:,:,INLEVEL) = (ZPF_LS(:,:,INLEVEL)/2./XP00)**(XRD/XCPD)
-!
-IF (IMODEL==10.OR.IMODEL==11) ZEXNM_LS(:,:,:)=ZEXNF_LS(:,:,:) ! for GFS and ERA5 on pressure levels
-!
-DEALLOCATE (ZEXNF_LS)
-DEALLOCATE (ZPF_LS)
-!
-ALLOCATE (ZPM_LS(IIU,IJU,INLEVEL))
-ZPM_LS(:,:,:) = XP00*(ZEXNM_LS(:,:,:))**(XCPD/XRD)
-!
-!* 2.5.6 Compute the vapor mixing ratio and the final specific humdity
-!
-! The vapor mixing ratio is calculated by an interating process on rv and
-! Thetav. Have a look to MODE_THERMO for further informations.
-ALLOCATE (ZR_DUM(IIU,IJU,INLEVEL,1))
-ALLOCATE (ZRV_LS(IIU,IJU,INLEVEL))
-ALLOCATE (ZTEV_LS(IIU,IJU,INLEVEL))
-ZTEV_LS(:,:,:) = ZTHV_LS(:,:,:) * ZEXNM_LS(:,:,:)
-ZRV_LS(:,:,:) = SM_PMR_HU(ZPM_LS(:,:,:), &
-ZTEV_LS(:,:,:),ZH_LS(:,:,:),ZR_DUM(:,:,:,:),KITERMAX=100)
-IF (HFILE(1:3)=='ATM') THEN
- XQ_LS(:,:,:,1) = ZRV_LS(:,:,:) / (1. + ZRV_LS(:,:,:))
-ELSE IF (HFILE=='CHEM') THEN
- XQ_SV_LS(:,:,:,1) = ZRV_LS(:,:,:) / (1. + ZRV_LS(:,:,:))
-ENDIF
-!JUAN
-CALL MPPDB_CHECK3D(XQ_LS(:,:,:,1),"XQ_LS",PRECISION)
-!JUAN
-DEALLOCATE (ZTEV_LS)
-DEALLOCATE (ZH_LS)
-DEALLOCATE (ZR_DUM)
-!
-!* 2.5.7 Compute T from the interpolated Theta V
-!
-! T = Thetav . (P/P0)^(Rd/Cpd) . ((1 + rv) / (1 + (Rv/Rd).rv))
-!!
-IF (HFILE(1:3)=='ATM') THEN
- XT_LS(:,:,:) = ZTHV_LS(:,:,:) * ZEXNM_LS(:,:,:) &
- * ((1.+ZRV_LS(:,:,:))/(1.+(XRV/XRD)*ZRV_LS(:,:,:)))
- CALL MPPDB_CHECK3D(XT_LS,"XT_LS",PRECISION)
-ELSE IF (HFILE=='CHEM') THEN
- XT_SV_LS(:,:,:) = ZTHV_LS(:,:,:) * ZEXNM_LS(:,:,:) &
- * ((1.+ZRV_LS(:,:,:))/(1.+(XRV/XRD)*ZRV_LS(:,:,:)))
- CALL MPPDB_CHECK3D(XT_SV_LS,"XT_SV_LS",PRECISION)
-ENDIF
-!
-DEALLOCATE (ZRV_LS)
-DEALLOCATE (ZTHV_LS)
-DEALLOCATE (ZPM_LS)
-DEALLOCATE (ZEXNM_LS)
-!
-!* 2.5.8 Read the other specific ratios (if Arome model)
-!
-IF (NRR >1) THEN
- IF (IMODEL==1) THEN
- WRITE (ILUOUT0,'(A)') ' | Reading Q fields (except humidity)'
- DO JLOOP2=1,NRR-1
- IPAR=246+JLOOP2-1
- DO JLOOP1=1, INLEVEL
- ILEV1 = JLOOP1-1+ISTARTLEVEL
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ILEV1)
-
- IF (INUM < 0) THEN
- WRITE(YMSG,*) 'Specific ratio ',IPAR,' at level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
- END IF
- CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
- ALLOCATE(ZVALUE(ISIZE))
- CALL GRIB_GET(IGRIB(INUM),'values',ZVALUE)
- ALLOCATE(ZOUT(INO))
- CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
- ZVALUE,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
- CALL ARRAY_1D_TO_2D(INO,ZOUT,IIU,IJU,XQ_LS(:,:,INLEVEL-JLOOP1+1,1+JLOOP2))
- DEALLOCATE (ZVALUE)
- DEALLOCATE (ZOUT)
- END DO
- END DO
- ELSE ! GRIB2 AROME IMODEL =6
- WRITE (ILUOUT0,'(A)') ' | Reading Q fields (except humidity)'
- DO JLOOP1=1, INLEVEL
- ILEV1 = JLOOP1-1+ISTARTLEVEL
- CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=83,KLEV1=ILEV1)
-
- IF (INUM < 0) THEN
- WRITE(YMSG,*) 'Specific ratio ',IPAR,' at level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
- END IF
- CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
- ALLOCATE(ZVALUE(ISIZE))
- CALL GRIB_GET(IGRIB(INUM),'values',ZVALUE)
- ALLOCATE(ZOUT(INO))
- CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
- ZVALUE,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
- CALL ARRAY_1D_TO_2D(INO,ZOUT,IIU,IJU,XQ_LS(:,:,INLEVEL-JLOOP1+1,2))
- DEALLOCATE (ZVALUE)
- DEALLOCATE (ZOUT)
- END DO
-
- DO JLOOP1=1, INLEVEL
- ILEV1 = JLOOP1-1+ISTARTLEVEL
- CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=85,KLEV1=ILEV1)
-
- IF (INUM < 0) THEN
- WRITE(YMSG,*) 'Specific ratio for rain at level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
- END IF
- CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
- ALLOCATE(ZVALUE(ISIZE))
- CALL GRIB_GET(IGRIB(INUM),'values',ZVALUE)
- ALLOCATE(ZOUT(INO))
- CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
- ZVALUE,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
- CALL ARRAY_1D_TO_2D(INO,ZOUT,IIU,IJU,XQ_LS(:,:,INLEVEL-JLOOP1+1,3))
- DEALLOCATE (ZVALUE)
- DEALLOCATE (ZOUT)
- END DO
-
-
- DO JLOOP1=1, INLEVEL
- ILEV1 = JLOOP1-1+ISTARTLEVEL
- CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=84,KLEV1=ILEV1)
- IF (INUM < 0) THEN
- WRITE(YMSG,*) 'Specific ratio for ICE at level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
- END IF
- CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
- ALLOCATE(ZVALUE(ISIZE))
- CALL GRIB_GET(IGRIB(INUM),'values',ZVALUE)
- ALLOCATE(ZOUT(INO))
- CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
- ZVALUE,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
- CALL ARRAY_1D_TO_2D(INO,ZOUT,IIU,IJU,XQ_LS(:,:,INLEVEL-JLOOP1+1,4))
- DEALLOCATE (ZVALUE)
- DEALLOCATE (ZOUT)
- END DO
-
-
- DO JLOOP1=1, INLEVEL
- ILEV1 = JLOOP1-1+ISTARTLEVEL
- CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=86,KLEV1=ILEV1)
- IF (INUM < 0) THEN
- WRITE(YMSG,*) 'Specific ratio ',IPAR,' at level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
- END IF
- CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
- ALLOCATE(ZVALUE(ISIZE))
- CALL GRIB_GET(IGRIB(INUM),'values',ZVALUE)
- ALLOCATE(ZOUT(INO))
- CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
- ZVALUE,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
- CALL ARRAY_1D_TO_2D(INO,ZOUT,IIU,IJU,XQ_LS(:,:,INLEVEL-JLOOP1+1,5))
- DEALLOCATE (ZVALUE)
- DEALLOCATE (ZOUT)
- END DO
-
-
- DO JLOOP1=1, INLEVEL
- ILEV1 = JLOOP1-1+ISTARTLEVEL
- CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=201,KLEV1=ILEV1)
- IF (INUM < 0) THEN
- WRITE(YMSG,*) 'Specific ratio ',IPAR,' at level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
- END IF
- CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
- ALLOCATE(ZVALUE(ISIZE))
- CALL GRIB_GET(IGRIB(INUM),'values',ZVALUE)
- ALLOCATE(ZOUT(INO))
- CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
- ZVALUE,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
- CALL ARRAY_1D_TO_2D(INO,ZOUT,IIU,IJU,XQ_LS(:,:,INLEVEL-JLOOP1+1,6))
- DEALLOCATE (ZVALUE)
- DEALLOCATE (ZOUT)
- END DO
- END IF
-END IF
-!
-IF (CTURB=='TKEL') THEN
- WRITE (ILUOUT0,'(A)') ' | Reading TKE field'
- DO JLOOP1=1, INLEVEL
- ILEV1 = JLOOP1-1+ISTARTLEVEL
- IF (IMODEL==1) THEN
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=251,KLEV1=ILEV1)
- ELSE ! case 6 new arome
- CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=19,KNUMBER=11,KLEV1=ILEV1)
- END IF
- IF (INUM < 0) THEN
- WRITE(YMSG,*) 'TKE at level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
- END IF
- CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
- ALLOCATE(ZVALUE(ISIZE))
- CALL GRIB_GET(IGRIB(INUM),'values',ZVALUE)
- ALLOCATE(ZOUT(INO))
- CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
- ZVALUE,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
- CALL ARRAY_1D_TO_2D(INO,ZOUT,IIU,IJU,XTKE_LS(:,:,INLEVEL-JLOOP1+1))
- DEALLOCATE (ZVALUE)
- DEALLOCATE (ZOUT)
- END DO
-END IF
-DEALLOCATE(IINLO)
-!
-!---------------------------------------------------------------------------------------
-!* 2.6 Interpolation of MOCAGE variable
-!---------------------------------------------------------------------------------------
-
-IF (IMODEL==5) THEN
- LUSECHEM = .TRUE.
- IF (LORILAM) THEN
- CORGANIC = "MPMPO"
- LVARSIGI = .TRUE.
- LVARSIGJ = .TRUE.
- END IF
- ! initialise NSV_* variables
- CALL INI_NSV(IMI)
- IF( HFILE=='ATM0' ) THEN
- ALLOCATE (XSV_LS(IIU,IJU,INLEVEL,NSV))
- ELSE IF (HFILE=='CHEM' ) THEN
- DEALLOCATE(XSV_LS)
- ALLOCATE (XSV_LS(IIU,IJU,INLEVEL,NSV))
- ELSE
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE','Mocage model: Bad input argument in read_all_data_grib_case')
- END IF
- XSV_LS(:,:,:,:) = 0.
- ILEV1=-1
-!
- WRITE (ILUOUT0,'(A,A4,A)') ' | Reading Mocage species (ppv) from ',HFILE,' file'
-!
-!* 2.6.1 read mocage species
-!
-! open input file
- CALL CH_OPEN_INPUT(YPRE_MOC, "MOC2MESONH", TZFILE, ILUOUT0, KVERB)
- ICHANNEL = TZFILE%NLU
-!
-! read number of mocage species to transfer into mesonh
- READ(ICHANNEL, *) IMOC
- IF (KVERB >= 5) WRITE(ILUOUT0,*) "number of mocage species to transfer into mesonh : ", IMOC
-!
-! read data input format
- READ(ICHANNEL,"(A)") YFORMAT
- YFORMAT=UPCASE(YFORMAT)
- IF (KVERB >= 5) WRITE(ILUOUT0,*) "input format is: ", YFORMAT
-!
-! allocate fields
- ALLOCATE(YMNHNAME(IMOC))
- ALLOCATE(INUMGRIB(IMOC))
-!
-! read variables names and Grib code
- IF (INDEX(YFORMAT,'A') < INDEX(YFORMAT,'I')) THEN
- DO JI = 1, IMOC
- READ(ICHANNEL,YFORMAT) YMNHNAME(JI), INUMGRIB(JI)
- WRITE(ILUOUT0,YFORMAT) YMNHNAME(JI), INUMGRIB(JI)
- END DO
- ELSE
- DO JI = 1, IMOC
- READ(ICHANNEL,YFORMAT) INUMGRIB(JI), YMNHNAME(JI)
- WRITE(ILUOUT0,YFORMAT) INUMGRIB(JI), YMNHNAME(JI)
- END DO
- ENDIF
- !
- ! close file
- CALL IO_File_close(TZFILE)
- TZFILE => NULL()
- !
- !* 2.6.2 exchange mocage values onto prognostic variables XSV_LS
- !
- IF (KVERB >= 10) WRITE(ILUOUT0,'(A,I4)') ' NEQ=',NEQ
- !
- DO JNREAL = 1, NEQ
- INACT = 0
- search_loop2 : DO JN = 1, IMOC
- IF (CNAMES(JNREAL) .EQ. YMNHNAME(JN)) THEN
- INACT = JN
- EXIT search_loop2
- END IF
- END DO search_loop2
- IF (INACT .NE. 0) THEN
- DO JLOOP1=1, INLEVEL
- ILEV1 = JLOOP1
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=INUMGRIB(JN),KLEV1=ILEV1)
- IF (INUM < 0) THEN
- WRITE(YMSG,*) 'Atmospheric ',INUMGRIB(JN),' grib chemical species level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
- END IF
- CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB)
- ALLOCATE(IINLO(INJ))
- CALL COORDINATE_CONVERSION(IMODEL,IGRIB(INUM),IIU,IJU,ZLONOUT,ZLATOUT,&
- ZXOUT,ZYOUT,INI,ZPARAM,IINLO)
- CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
- ALLOCATE(ZVALUE(ISIZE))
- CALL GRIB_GET(IGRIB(INUM),'values',ZVALUE)
- ALLOCATE(ZOUT(INO))
- CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
- ZVALUE,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.TRUE. )
- CALL ARRAY_1D_TO_2D(INO,ZOUT,IIU,IJU, &
- XSV_LS(:,:,INLEVEL-JLOOP1+1,JNREAL))
- DEALLOCATE (ZVALUE)
- DEALLOCATE (ZOUT)
- DEALLOCATE(IINLO)
- END DO
- END IF
- END DO
- XSV_LS(:,:,:,:) = MAX(XSV_LS(:,:,:,:),0.)
-ELSE
- LORILAM = .FALSE.
- LUSECHEM = .FALSE.
- ! initialise NSV_* variables
- CALL INI_NSV(1)
- IF (NSV > 0) THEN
- ALLOCATE (XSV_LS(IIU,IJU,INLEVEL,NSV))
- XSV_LS(:,:,:,:) = 0.
- ELSE
- ALLOCATE(XSV_LS(0,0,0,0))
- END IF
-END IF
-!
-!---------------------------------------------------------------------------------------
-!* 2.7 Search, read, interpolate and project winds
-!---------------------------------------------------------------------------------------
-!
-! The way winds are processed depends upon the type of archive :
-!
-! -> ECMWF, NCEP
-! Winds are projected from a standard lat,lon grid to MesoNH grid. This correcponds to
-! a rotation of an angle :
-! Alpha = k.(L-L0) - Beta
-! k,L0 and Beta definiiton parameter of MesoNH grid
-! L longitude of the point of the tangent coordinate system
-!
-! -> Aladin
-! The grid used by Aladin files is the same than the one of MesoNH. !
-! So we have 2 sets of parameters :
-! k L0 Beta for MesoNH
-! k' L0' Beta' for Aladin (Beta'=0 for Aladin)
-! We applied twice the formula seen for standard lat,lon grid and we get :
-! Alpha = k.(L-L0) - Beta - k'.(L-L0')
-!
-! -> Arpege
-! Arpege winds are given on the tangent coordinate system of the stretched grid.
-! Therefore they have first to be projected on a standard lat,lon grid. This is done
-! before the interpolation. The projection formulas were given by Meteo France.
-! After this projection, the file is simil
-!
-IF (HFILE(1:3)=='ATM') THEN
-ISTARTLEVEL = 1
-ALLOCATE (XU_LS(IIU,IJU,INLEVEL))
-ALLOCATE (XV_LS(IIU,IJU,INLEVEL))
-ALLOCATE (ZTU_LS(INO))
-ALLOCATE (ZTV_LS(INO))
-!
-SELECT CASE (IMODEL)
- CASE (0,6,7)
- IPAR = 131
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ISTARTLEVEL)
- IF (INUM< 0) THEN
- ISTARTLEVEL = 0
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ISTARTLEVEL)
- END IF
- CASE (1,2,3)
- IPAR = 33
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ISTARTLEVEL)
- IF (INUM < 0) THEN
- ISTARTLEVEL = 0
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ISTARTLEVEL)
- END IF
- CASE (10,11)
- IPAR = 131
- ISTARTLEVEL = 1
-END SELECT
-
-DO JLOOP1 = ISTARTLEVEL, ISTARTLEVEL+INLEVEL-1
- IF (IMODEL/=10.AND.IMODEL/=11) THEN ! others than NCEP and ERA5
- ILEV1 = JLOOP1
- ELSE
- IF(IMODEL==10) THEN
- ILEV1 = IP_GFS(INLEVEL+ISTARTLEVEL-JLOOP1)
- ELSE
- ILEV1 = IP_ERA(INLEVEL+ISTARTLEVEL-JLOOP1)
- END IF
- END IF
- ! read component u
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ILEV1)
- IF (INUM < 0) THEN
- WRITE(YMSG,*) 'wind vector component "u" at level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
- END IF
- CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
- ALLOCATE(ZVALUE(ISIZE))
- CALL GRIB_GET(IGRIB(INUM),'values',ZVALUE)
- IF (IMODEL==3.OR.(IMODEL==7)) THEN
- ALLOCATE(ZTU0_LS(INI))
- ZTU0_LS(:) = ZVALUE(:)
- ELSE
- CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB)
- IF(ALLOCATED(IINLO)) DEALLOCATE (IINLO)
- ALLOCATE(IINLO(INJ))
- CALL COORDINATE_CONVERSION(IMODEL,IGRIB(INUM),IIU,IJU,ZLONOUT,ZLATOUT,&
- ZXOUT,ZYOUT,INI,ZPARAM,IINLO)
- ALLOCATE(ZOUT(INO))
- CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
- ZVALUE,INO,ZXOUT,ZYOUT,ZOUT,.TRUE.,PTIME_HORI,.FALSE. )
- ZTU_LS(:) = ZOUT(:)
- DEALLOCATE(IINLO)
- DEALLOCATE(ZOUT)
- END IF
- DEALLOCATE (ZVALUE)
- ! read component v and perform interpolation if not Arpege grid
- IF (IMODEL/=10.AND.IMODEL/=11) THEN ! others than NCEP and ERA5
- ILEV1 = JLOOP1
- ELSE
- IF(IMODEL==10) THEN
- ILEV1 = IP_GFS(INLEVEL+ISTARTLEVEL-JLOOP1)
- ELSE
- ILEV1 = IP_ERA(INLEVEL+ISTARTLEVEL-JLOOP1)
- END IF
- END IF
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR+1,KLEV1=ILEV1)
- IF (INUM < 0) THEN
- WRITE(YMSG,*) 'wind vector component "v" at level ',JLOOP1,' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
- END IF
- CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
- ALLOCATE(ZVALUE(ISIZE))
- CALL GRIB_GET(IGRIB(INUM),'values',ZVALUE)
- IF ((IMODEL==3).OR.(IMODEL==7)) THEN
- CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB)
- ALLOCATE(IINLO(INJ))
- CALL COORDINATE_CONVERSION(IMODEL,IGRIB(INUM),IIU,IJU,ZLONOUT,ZLATOUT,&
- ZXOUT,ZYOUT,INI,ZPARAM,IINLO)
- ALLOCATE(ZTV0_LS(INI))
- ZTV0_LS(:) = ZVALUE(:)
- ELSE
- CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB)
- ALLOCATE(IINLO(INJ))
- CALL COORDINATE_CONVERSION(IMODEL,IGRIB(INUM),IIU,IJU,ZLONOUT,ZLATOUT,&
- ZXOUT,ZYOUT,INI,ZPARAM,IINLO)
- ALLOCATE(ZOUT(INO))
- CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
- ZVALUE,INO,ZXOUT,ZYOUT,ZOUT,.TRUE.,PTIME_HORI,.FALSE.)
- ZTV_LS(:) = ZOUT(:)
- DEALLOCATE(ZOUT)
- END IF
- DEALLOCATE (ZVALUE)
- ! interpolations for arpege grid
- IF ((IMODEL==3).OR.(IMODEL==7)) THEN
- ! Comes back to real winds instead of stretched winds
- ! (but still with components according to Arpege grid axes)
- ZLATPOLE = ZPARAM(7) * XPI/180.
- ZLONPOLE = ZPARAM(8) * XPI/180.
- ZC = ZPARAM(9)
- ZD = ZC * ZC
- JLOOP3 = 0
- JLOOP4 = 1
- ZLAT = ZPARAM(3) * XPI / 180.
- DO JLOOP2=1, INI
- ZLON = JLOOP3 * 2. * XPI / IINLO(JLOOP4)
- ! Compute the scale factor
- ZA = ((1.+ZD) - (1.-ZD)*SIN(ZLAT)) / (2. * ZC)
- ZTU0_LS(JLOOP2) = ZTU0_LS(JLOOP2) * ZA
- ZTV0_LS(JLOOP2) = ZTV0_LS(JLOOP2) * ZA
- ! next parallel
- JLOOP3 = JLOOP3 + 1
- IF (JLOOP3 == IINLO(JLOOP4)) THEN
- JLOOP3 = 0
- ZLAT = ZLAT + (((ZPARAM(5)-ZPARAM(3))/(ZPARAM(2)-1)) * XPI / 180.)
- JLOOP4 = JLOOP4 + 1
- END IF
- END DO
- !
- ! interpolation
- CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,&
- INI,ZTU0_LS,INO,ZXOUT,ZYOUT,ZTU_LS,.TRUE.,PTIME_HORI,.FALSE.)
- CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,&
- INI,ZTV0_LS,INO,ZXOUT,ZYOUT,ZTV_LS,.TRUE.,PTIME_HORI,.FALSE.)
- DEALLOCATE(IINLO)
- !
- ! Rotation of the components from Arpege grid axes to real sphere axes
- !
- DO JLOOP2=1, INO
- ZLAT = ZYOUT(JLOOP2) * XPI / 180.
- ZLON = ZXOUT(JLOOP2) * XPI / 180.
- ! Compute the rotation matrix
- ZA = (ZD+1.) + (ZD-1.)*SIN(ZLAT)
- ZB = (ZD-1.) + (ZD+1.)*SIN(ZLAT)
- ZE = 2.*ZC*COS(ZLATPOLE)*COS(ZLAT)*COS(ZLON) + ZB*SIN(ZLATPOLE)
- IF (ABS(ZE) .GE. ABS(ZA)) THEN
- ZF = -2.*ZC*COS(ZLATPOLE)/ ( COS(ZLAT)* ((ZD+1.)+(ZD-1.)*SIN(ZLATPOLE)) )
- ZSIN = -ZF*SIN(ZLONPOLE-ZLON)
- ZCOS = ZF*COS(ZLONPOLE-ZLON)
- ELSE
- ZF = 1. / SQRT(ZA*ZA - ZE*ZE)
- ZSIN = -COS(ZLATPOLE)*SIN(ZLON)*ZA*ZF
- ZCOS = (2.*ZC*SIN(ZLATPOLE)*COS(ZLAT)-ZB*COS(ZLATPOLE)*COS(ZLON))*ZF
- ENDIF
- ZTEMP = ZTU_LS(JLOOP2)
- ZTU_LS(JLOOP2) = ZCOS*ZTEMP - ZSIN*ZTV_LS(JLOOP2)
- ZTV_LS(JLOOP2) = ZSIN*ZTEMP + ZCOS*ZTV_LS(JLOOP2)
- END DO
- END IF
- !
- ! Rotation of the components from the real sphere axes (Arpege, CEP)
- ! or model axes (Aladin) to MESO-NH axes
- !
- JLOOP4=0
- DO JJ=1,IJU
- DO JI=1,IIU
- JLOOP4=JLOOP4+1
- IF (IMODEL==2 .OR. IMODEL==1 ) THEN
- IF (IMODEL==2) THEN ! ALADIN REUNION
- ZALPHA=0
- ELSE !ALADIN
- ZALPHA = (XRPK*(ZLONOUT(JLOOP4)-XLON0)-XBETA) - &
- (SIN(ZPARAM(9)*XPI/180.)*(ZLONOUT(JLOOP4)-ZPARAM(10)))
- ENDIF
- ELSE ! CEP, ARPEGE (after projection)
- ZALPHA = XRPK*(ZLONOUT(JLOOP4)-XLON0)-XBETA
- ENDIF
- ZALPHA = ZALPHA * XPI / 180.
- XU_LS(JI,JJ,INLEVEL+ISTARTLEVEL-JLOOP1)= &
- ZTU_LS(JLOOP4)*COS(ZALPHA) - ZTV_LS(JLOOP4)*SIN(ZALPHA)
- XV_LS(JI,JJ,INLEVEL+ISTARTLEVEL-JLOOP1)= &
- ZTU_LS(JLOOP4)*SIN(ZALPHA) + ZTV_LS(JLOOP4)*COS(ZALPHA)
- ENDDO
- ENDDO
- IF ((IMODEL==3).OR.(IMODEL==7)) THEN ! deallocation of Arpege arrays
- DEALLOCATE (ZTU0_LS)
- DEALLOCATE (ZTV0_LS)
- END IF
-END DO
-DEALLOCATE (ZTU_LS)
-DEALLOCATE (ZTV_LS)
-IF(ALLOCATED(IINLO)) DEALLOCATE (IINLO)
-END IF
-!
-!-------------------------------------------------------------------------------
-!* 2.8 Filter the characteristics of the large-scale vortex
-!-------------------------------------------------------------------------------
-IF (HFILE(1:3)=='ATM' .AND. LFILTERING) THEN
- WRITE (ILUOUT0,'(A)') ' | Starting the filtering of the fields to remove large-scale vortex'
- IF (INDEX(CFILTERING,'Q')/=0) THEN
- WRITE (ILUOUT0,'(A)') ' -> Filtering of Q is now available!'
- WRITE (ILUOUT0,'(A,A5)') ' CFILTERING= ',CFILTERING
- ENDIF
- !
- IF (INDEX(CFILTERING,'P')/=0) THEN
- ! compute reduced surface pressure
- ALLOCATE(ZTVF_LS(IIU,IJU),ZMSLP_LS(IIU,IJU))
- ! compute pressure reduced to first level above mean sea level
- ! (rather than above ground level)
- ZGAMREF=-6.5E-3
- !virtual temperature at the first level above ground
- ZTVF_LS(:,:) = XT_LS(:,:,1)*(1.+XQ_LS(:,:,1,1)*(XRV/XRD-1))
- !virtual temperature averaged between first level above ground
- ! and first level above sea level
- ZTVF_LS(:,:) = ZTVF_LS(:,:)-0.5*ZGAMREF*XZS_LS(:,:)
- ZMSLP_LS(:,:)=XPS_LS(:,:)*EXP(XG*XZS_LS(:,:)/(XRD*ZTVF_LS(:,:)))
- ENDIF
- !
- IF (INDEX(CFILTERING,'P')==0) THEN
- IF (INDEX(CFILTERING,'Q')==0) THEN
- CALL REMOVAL_VORTEX(XZS_LS,XU_LS,XV_LS,XT_LS)
- ELSE
- CALL REMOVAL_VORTEX(XZS_LS,XU_LS,XV_LS,XT_LS,PQ_LS=XQ_LS(:,:,:,1))
- ENDIF
- ELSE
- IF (INDEX(CFILTERING,'Q')==0) THEN
- CALL REMOVAL_VORTEX(XZS_LS,XU_LS,XV_LS,XT_LS,PPS_LS=ZMSLP_LS)
- ELSE
- CALL REMOVAL_VORTEX(XZS_LS,XU_LS,XV_LS,XT_LS,PQ_LS=XQ_LS(:,:,:,1),PPS_LS=ZMSLP_LS)
- ENDIF
- XPS_LS(:,:) = ZMSLP_LS(:,:)*EXP(-XG*XZS_LS(:,:)/(XRD*ZTVF_LS(:,:)))
- DEALLOCATE(ZTVF_LS,ZMSLP_LS)
- ENDIF
- !
-END IF
-!
-!---------------------------------------------------------------------------------------
-!* 2.9 Read date
-!---------------------------------------------------------------------------------------
-!
-WRITE (ILUOUT0,'(A)') ' | Reading date'
-CALL GRIB_GET(IGRIB(INUM),'dataDate',IDATE,IRET_GRIB)
-CALL GRIB_GET(IGRIB(INUM),'dataTime',ITIME,IRET_GRIB)
-TPTCUR%xtime=ITIME/100*3600+(ITIME-(ITIME/100)*100)*60
-TPTCUR%nyear=IDATE/10000
-TPTCUR%nmonth=INT((IDATE-TPTCUR%nyear*10000)/100)
-TPTCUR%nday=IDATE-TPTCUR%nyear*10000-TPTCUR%nmonth*100
-CALL GRIB_GET(IGRIB(INUM),'startStep',ITIMESTEP,IRET_GRIB)
-CALL GRIB_GET(IGRIB(INUM),'stepUnits',CSTEPUNIT,IRET_GRIB)
-IF (IMODEL==0.OR.IMODEL==11) THEN
- ITWOZS=0
- IF ((TPTCUR%nyear ==2000).AND.(TPTCUR%nmonth >11)) ITWOZS=1
- IF ((TPTCUR%nyear ==2000).AND.(TPTCUR%nmonth ==11)) THEN
- IF ( (TPTCUR%nday >20 ) .OR. &
- ((TPTCUR%nday ==20 ).AND.(TPTCUR%xtime >=64800 ))) ITWOZS=1
- END IF
- IF ( TPTCUR%nyear ==2001 ) ITWOZS=1
- IF ((TPTCUR%nyear ==2002).AND.(TPTCUR%nmonth <11)) ITWOZS=1
- IF ((TPTCUR%nyear ==2002).AND.(TPTCUR%nmonth ==11)) THEN
- IF ( (TPTCUR%nday <24 ) .OR. &
- ((TPTCUR%nday ==25 ).AND.(TPTCUR%xtime <64800 ))) ITWOZS=1
- END IF
- IF (ITWOZS==1) &
- WRITE(ILUOUT0,*) ' Check that both orography fields on 1st model level and on surface are used.'
-END IF
-
-CALL MPPDB_CHECK3D(XU_LS,"XU_LS",PRECISION)
-CALL MPPDB_CHECK3D(XV_LS,"XV_LS",PRECISION)
-
-SELECT CASE (CSTEPUNIT) ! Time unit indicator
- CASE ('h') !hour
- TPTCUR%xtime = TPTCUR%xtime + ITIMESTEP*3600.
- CASE ('m') !minute
- TPTCUR%xtime = TPTCUR%xtime + ITIMESTEP*60.
- CASE ('s') !minute
- TPTCUR%xtime = TPTCUR%xtime + ITIMESTEP
- CASE DEFAULT
- WRITE (ILUOUT0,'(A,A,A)') ' | error CSTEPUNIT=',CSTEPUNIT, ' is different of s,m or h'
-END SELECT
-CALL DATETIME_CORRECTDATE(TPTCUR)
-IF (HFILE(1:3)=='ATM') THEN
- CALL SM_PRINT_TIME(TPTCUR,TLUOUT0,'MESONH current date')
- TDTCUR = TPTCUR
- TDTMOD = TPTCUR
- TDTSEG = TPTCUR
- TDTEXP = TPTCUR
-ELSE IF (HFILE=='CHEM') THEN
- CALL SM_PRINT_TIME(TPTCUR,TLUOUT0,'current date in MesoNH format')
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!* 2.10 Read and interpolate dummy fields listed in free-format part of nml file
-!-------------------------------------------------------------------------------
-IF (ODUMMY_REAL) THEN
- !
- WRITE (ILUOUT0,'(A)') ' | Try to read 2D dummy fields'
- !
- !* 2.10.1 read 2D dummy fields
- !
- ! close file
- CALL IO_File_close(TPPRE_REAL1)
- ! open input file
- CALL CH_OPEN_INPUT(TPPRE_REAL1%CNAME, "DUMMY_2D", TZFILE, ILUOUT0, KVERB)
- ICHANNEL = TZFILE%NLU
- !
- ! read number of dummy 2D fields to transfer into mesonh
- READ(ICHANNEL, *) IMOC
- IF (KVERB >= 5) WRITE(ILUOUT0,*) "number of dummy fields to transfer into Mesonh : ", IMOC
- ALLOCATE(XDUMMY_2D(IIU,IJU,IMOC),CDUMMY_2D(IMOC))
- ALLOCATE(INUMGRIB(IMOC),INUMLEV(IMOC),INUMLEV1(IMOC),INUMLEV2(IMOC))
- INUMLEV(:)=-1 ; INUMLEV1(:)=-1 ; INUMLEV2(:)=-1
- !
- IVAR=0
- ! read variables names and Grib codes
- DO JI = 1, IMOC
- READ(ICHANNEL,'(A)') YINPLINE
- YINPLINE= TRIM(ADJUSTL(YINPLINE))
- IF (LEN_TRIM(YINPLINE) == 0) CYCLE ! skip blank line
- ! transform tab and comma character into blank
- DO JJ=1,LEN_TRIM(YINPLINE)
- IF (YINPLINE(JJ:JJ)==YPTAB .OR. YINPLINE(JJ:JJ)==YPCOM) YINPLINE(JJ:JJ)= ' '
- END DO
- IF (KVERB >= 10) WRITE(ILUOUT0,*) 'Line read : ', YINPLINE
- ! extract field name
- INDX= INDEX(YINPLINE,' ')
- YFIELD= YINPLINE(1:INDX-1)
- IF (KVERB >= 5) WRITE(ILUOUT0,*) 'Field being treated : ', YFIELD
- ITYP=105
- ILEV1=-1
- ILEV2=-1
- ! extract the parameter indicator
- YINPLINE= ADJUSTL(YINPLINE(INDX:))
- INDX= INDEX(YINPLINE,' ')
- IF (INDX == 1) THEN
- WRITE(ILUOUT0,*) ' Parameter indicator is missing. ',YFIELD,' not treated.'
- CYCLE
- END IF
- IVAR=IVAR+1
- READ(YINPLINE(1:INDX-1),*) IPAR
- IF (NVERB>=5) WRITE(ILUOUT0,*) ' Parameter indicator: ',IPAR
- ! extract the level indicator (optional)
- YINPLINE= ADJUSTL(YINPLINE(INDX:))
- INDX= INDEX(YINPLINE,' ')
- IF (INDX /= 1) THEN
- READ(YINPLINE(1:INDX-1),*) ITYP
- IF (NVERB>=5) WRITE(ILUOUT0,*) ' Level indicator is indicated: ',ITYP
- END IF
- ! extract the first level value (optional)
- YINPLINE= ADJUSTL(YINPLINE(INDX:))
- INDX= INDEX(YINPLINE,' ')
- IF (INDX /= 1) THEN
- READ(YINPLINE(1:INDX-1),*) ILEV1
- IF (NVERB>=5) WRITE(ILUOUT0,*) ' Level1 value is indicated: ',ILEV1
- END IF
- ! extract the second level value (optional)
- YINPLINE= ADJUSTL(YINPLINE(INDX:))
- INDX= INDEX(YINPLINE,' ')
- IF (INDX /= 1) THEN
- READ(YINPLINE(1:INDX-1),*) ILEV2
- IF (NVERB>=5) WRITE(ILUOUT0,*) ' Level2 value is indicated: ',ILEV2
- END IF
- !
- CDUMMY_2D(IVAR)=YFIELD ; INUMGRIB(IVAR)=IPAR
- INUMLEV(IVAR)=ITYP ; INUMLEV1(IVAR)=ILEV1 ; INUMLEV2(IVAR)=ILEV2
- !
- END DO
- !
- CALL IO_File_close(TZFILE)
- TZFILE => NULL()
- !
- IF (NVERB>=10) THEN
- WRITE(ILUOUT0,*) CDUMMY_2D(1:IVAR)
- WRITE(ILUOUT0,*) INUMGRIB(1:IVAR)
- WRITE(ILUOUT0,*) INUMLEV(1:IVAR)
- WRITE(ILUOUT0,*) INUMLEV1(1:IVAR)
- WRITE(ILUOUT0,*) INUMLEV2(1:IVAR)
- END IF
- !
- IF (IVAR /= IMOC) THEN
- WRITE (ILUOUT0,'(A,I3,A,I3,A)') ' -> Number of correct lines (',IVAR,') is different of ',IMOC,' - abort'
- WRITE(YMSG,*) 'number of correct lines (',IVAR,') is different of ',IMOC
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
- END IF
- !
- !* 2.10.2 read and interpolate variables onto dummy variables XDUMMY_2D
- !
- DO JI = 1, IMOC
- WRITE(ILUOUT0,'(A,4(I3,1X))') CDUMMY_2D(JI),INUMGRIB(JI),INUMLEV(JI),INUMLEV1(JI),INUMLEV2(JI)
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ILEV1)
- IF (INUM < 0) THEN
- WRITE (ILUOUT0,'(A,I3,A,I2,A)') ' -> 2D field ',INUMGRIB(JI),' is missing - abort'
- WRITE(YMSG,*) '2D field ',INUMGRIB(JI),' is missing'
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
- END IF
- CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB)
- ALLOCATE(IINLO(INJ))
- CALL COORDINATE_CONVERSION(IMODEL,IGRIB(INUM),IIU,IJU,ZLONOUT,ZLATOUT,&
- ZXOUT,ZYOUT,INI,ZPARAM,IINLO)
- CALL GRIB_GET_SIZE(IGRIB(INUM),'values',ISIZE)
- ALLOCATE(ZVALUE(ISIZE))
- CALL GRIB_GET(IGRIB(INUM_ZS),'values',ZVALUE)
- ALLOCATE(ZOUT(INO))
- CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
- ZVALUE,INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE. )
- DEALLOCATE(IINLO)
- DEALLOCATE(ZVALUE)
- CALL ARRAY_1D_TO_2D(INO,ZOUT,IIU,IJU,XDUMMY_2D(:,:,JI))
- DEALLOCATE (ZOUT)
- END DO
-!
-ENDIF
-!
-!---------------------------------------------------------------------------------------
-!
-!* 3. VERTICAL GRID
-!
-IF (HFILE(1:3)=='ATM') THEN
- WRITE (ILUOUT0,'(A)') ' | Reading of vertical grid in progress'
- CALL READ_VER_GRID(TPPRE_REAL1)
-END IF
-
-!
-!---------------------------------------------------------------------------------------
-!
-!* 4. Free all temporary allocations
-!
-DEALLOCATE (ZLATOUT)
-DEALLOCATE (ZLONOUT)
-DEALLOCATE (ZXOUT)
-DEALLOCATE (ZYOUT)
-DEALLOCATE(ZPARAM)
-DEALLOCATE(ZPARAM_ZS)
-DEALLOCATE(IINLO_ZS)
-DO JLOOP=1,ICOUNT
- CALL GRIB_RELEASE(IGRIB(JLOOP))
-ENDDO
-DEALLOCATE(IGRIB)
-
-WRITE (ILUOUT0,'(A,A4,A)') ' -- Grib decoder for ',HFILE,' file ended successfully'
-!
-!---------------------------------------------------------------------------------------
-!---------------------------------------------------------------------------------------
-!---------------------------------------------------------------------------------------
-!
-!
-
-!
-CONTAINS
-!
-!
-! ##########################################################################
- SUBROUTINE ARRAY_1D_TO_2D (KN1,P1,KL1,KL2,P2)
-! ##########################################################################
-!
-! Small routine used to store a linear array into a 2 dimension array
-!
-IMPLICIT NONE
-INTEGER, INTENT(IN) :: KN1
-REAL,DIMENSION(KN1), INTENT(IN) :: P1
-INTEGER, INTENT(IN) :: KL1
-INTEGER, INTENT(IN) :: KL2
-REAL,DIMENSION(KL1,KL2),INTENT(OUT) :: P2
-INTEGER :: JLOOP1_A1T2
-INTEGER :: JLOOP2_A1T2
-INTEGER :: JPOS_A1T2
-!
-IF (KN1 < KL1*KL2) THEN
- CALL PRINT_MSG(NVERB_FATAL,'GEN','ARRAY_1D_TO_2D','sizes do not match')
-END IF
-JPOS_A1T2 = 1
-DO JLOOP2_A1T2 = 1, KL2
- DO JLOOP1_A1T2 = 1, KL1
- P2(JLOOP1_A1T2,JLOOP2_A1T2) = P1(JPOS_A1T2)
- JPOS_A1T2 = JPOS_A1T2 + 1
- END DO
-END DO
-END SUBROUTINE ARRAY_1D_TO_2D
-!
-!
-!---------------------------------------------------------------------------------------
-!---------------------------------------------------------------------------------------
-!---------------------------------------------------------------------------------------
-!#################################################################################
-SUBROUTINE SEARCH_FIELD(KGRIB,KNUM,KPARAM,KDIS,KCAT,KNUMBER,KLEV1,KTFFS)
-!#################################################################################
-! search the grib message corresponding to KPARAM,KLTYPE,KLEV1,KLEV2 in all
-! the KGIRB messages
-!
-USE MODD_LUNIT
-USE GRIB_API
-!
-IMPLICIT NONE
-!
-!
-INTEGER(KIND=kindOfInt),DIMENSION(:),INTENT(IN) :: KGRIB ! number of grib messages
-INTEGER,INTENT(OUT) :: KNUM ! number of the message researched
-INTEGER,INTENT(IN),OPTIONAL :: KPARAM ! INdicator of parameter/paramId
-INTEGER,INTENT(IN),OPTIONAL :: KDIS ! Discipline (GRIB2)
-INTEGER,INTENT(IN),OPTIONAL :: KCAT ! Catégorie (GRIB2)
-INTEGER,INTENT(IN),OPTIONAL :: KNUMBER ! parameterNumber (GRIB2)
-INTEGER,INTENT(IN),OPTIONAL :: KLEV1 ! Level
-INTEGER,INTENT(IN),OPTIONAL :: KTFFS ! TypeOfFirstFixedSurface
-!
-! Declaration of local variables
-!
-INTEGER :: IFOUND ! Number of correct parameters
-INTEGER :: ISEARCH ! Number of correct parameters to find
-INTEGER :: IRET ! error code
-INTEGER :: IPARAM,IDIS,ICAT,INUMBER,ITFFS
-INTEGER :: ILEV1 ! Level parameter 1
-INTEGER :: JLOOP ! Dummy counter
-INTEGER :: IVERSION
-! Variables used to display messages
-INTEGER :: ILUOUT0 ! Logical unit number of the listing
-!
-ILUOUT0 = TLUOUT0%NLU
-!
-ISEARCH=0
-! Initialize as not found
-KNUM = -1
-!
-IF (PRESENT(KPARAM)) ISEARCH=ISEARCH+1
-IF (PRESENT(KDIS)) ISEARCH=ISEARCH+1
-IF (PRESENT(KCAT)) ISEARCH=ISEARCH+1
-IF (PRESENT(KNUMBER)) ISEARCH=ISEARCH+1
-IF (PRESENT(KLEV1)) ISEARCH=ISEARCH+1
-IF(PRESENT(KTFFS)) ISEARCH=ISEARCH+1
-!
-DO JLOOP=1,SIZE(KGRIB)
- IFOUND = 0
- !
- CALL GRIB_GET(KGRIB(JLOOP),'editionNumber',IVERSION,IRET_GRIB)
- IF (IRET_GRIB > 0) THEN
- WRITE (ILUOUT0,'(A)')' | Error encountered in the Grib file, skipping field'
- CYCLE
- ELSE IF (IRET_GRIB == -6) THEN
- WRITE (ILUOUT0,'(A)')' | ECMWF pseudo-Grib data encountered, skipping field'
- CYCLE
- ENDIF
- !
- IF (PRESENT(KTFFS)) THEN
- CALL GRIB_GET(KGRIB(JLOOP),'typeOfFirstFixedSurface',ITFFS,IRET_GRIB)
- IF (IRET_GRIB > 0) THEN
- WRITE (ILUOUT0,'(A)')' | Error encountered in the Grib file, skipping field'
- CYCLE
- ELSE IF (IRET_GRIB == -6) THEN
- WRITE (ILUOUT0,'(A)')' | ECMWF pseudo-Grib data encountered, skipping field'
- CYCLE
- ENDIF
- IF (ITFFS==KTFFS) THEN
- IFOUND = IFOUND + 1
- ELSE
- CYCLE
- ENDIF
- ENDIF
-
- IF (PRESENT(KPARAM)) THEN
- IF (IVERSION == 2) THEN
- CALL GRIB_GET(KGRIB(JLOOP),'paramId',IPARAM,IRET_GRIB)
- ELSE
- CALL GRIB_GET(KGRIB(JLOOP),'indicatorOfParameter',IPARAM,IRET_GRIB)
- ENDIF
- IF (IRET_GRIB > 0) THEN
- WRITE (ILUOUT0,'(A)')' | Error encountered in the Grib file, skipping field'
- CYCLE
- ELSE IF (IRET_GRIB == -6) THEN
- WRITE (ILUOUT0,'(A)')' | ECMWF pseudo-Grib data encountered, skipping field'
- CYCLE
- ENDIF
- IF (IPARAM==KPARAM) THEN
- IFOUND = IFOUND + 1
- ELSE
- CYCLE
- ENDIF
- ENDIF
- !
- IF (PRESENT(KDIS)) THEN
- CALL GRIB_GET(KGRIB(JLOOP),'discipline',IDIS,IRET_GRIB)
- IF (IRET_GRIB > 0) THEN
- WRITE (ILUOUT0,'(A)')' | Error encountered in the Grib file, skipping field'
- CYCLE
- ELSE IF (IRET_GRIB == -6) THEN
- WRITE (ILUOUT0,'(A)')' | ECMWF pseudo-Grib data encountered, skipping field'
- CYCLE
- ENDIF
- IF (IDIS==KDIS) THEN
- IFOUND = IFOUND + 1
- ELSE
- CYCLE
- ENDIF
- ENDIF
- IF (PRESENT(KCAT)) THEN
- CALL GRIB_GET(KGRIB(JLOOP),'parameterCategory',ICAT,IRET_GRIB)
- IF (IRET_GRIB > 0) THEN
- WRITE (ILUOUT0,'(A)')' | Error encountered in the Grib file, skipping field'
- CYCLE
- ELSE IF (IRET_GRIB == -6) THEN
- WRITE (ILUOUT0,'(A)')' | ECMWF pseudo-Grib data encountered, skipping field'
- CYCLE
- ENDIF
- IF (ICAT==KCAT) THEN
- IFOUND = IFOUND + 1
- ELSE
- CYCLE
- ENDIF
- ENDIF
- IF (PRESENT(KNUMBER)) THEN
- CALL GRIB_GET(KGRIB(JLOOP),'parameterNumber',INUMBER,IRET_GRIB)
- IF (IRET_GRIB > 0) THEN
- WRITE (ILUOUT0,'(A)')' | Error encountered in the Grib file, skipping field'
- CYCLE
- ELSE IF (IRET_GRIB == -6) THEN
- WRITE (ILUOUT0,'(A)')' | ECMWF pseudo-Grib data encountered, skipping field'
- CYCLE
- ENDIF
- IF (INUMBER==KNUMBER) THEN
- IFOUND = IFOUND + 1
- ELSE
- CYCLE
- ENDIF
- ENDIF
- !
- IF(PRESENT(KLEV1)) THEN
- CALL GRIB_GET(KGRIB(JLOOP),'topLevel',ILEV1,IRET_GRIB)
- IF (IRET_GRIB > 0) THEN
- WRITE (ILUOUT0,'(A)')' | Error encountered in the Grib file, skipping field'
- CYCLE
- ELSE IF (IRET_GRIB == -6) THEN
- WRITE (ILUOUT0,'(A)')' | ECMWF pseudo-Grib data encountered, skipping field'
- CYCLE
- ENDIF
- IF (ILEV1==KLEV1) THEN
- IFOUND = IFOUND + 1
- ELSE
- CYCLE
- ENDIF
- ENDIF
- !
- IF (IFOUND == ISEARCH) THEN
- KNUM=JLOOP
- EXIT
- ELSE ! field not found
- KNUM=-1
- END IF
-END DO
-!
-END SUBROUTINE SEARCH_FIELD
-!#################################################################################
-SUBROUTINE COORDINATE_CONVERSION(KMODEL,KGRIB,KNOLON,KNOLARG,&
- PLONOUT,PLATOUT,PLXOUT,PLYOUT,KNI,PPARAM,KINLO)
-!#################################################################################
-!perform coordinate conversion from lat/lon system to x,y (depends on the grib
-! type)
-!! AUTHOR
-!! ------
-!!
-!! G. Tanguy
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-!! Original 08/06/2010
-
-USE MODD_CST
-USE MODI_LATLONTOXY
-USE GRIB_API
-!
-IMPLICIT NONE
-!
-!
-INTEGER(KIND=kindOfInt),INTENT(IN) :: KGRIB ! number of the grib message
-INTEGER,INTENT(IN) :: KMODEL ! number of the model
-INTEGER,INTENT(OUT) :: KNI ! number of points
-INTEGER,INTENT(IN) :: KNOLON,KNOLARG ! Number of output points
-REAL,DIMENSION( KNOLON*KNOLARG),INTENT(IN) :: PLONOUT ! Output coordinate,
-REAL,DIMENSION( KNOLON*KNOLARG),INTENT(IN) :: PLATOUT ! lat/lon system
-REAL,DIMENSION( KNOLON*KNOLARG),INTENT(INOUT) :: PLXOUT ! Converted output coordinates
-REAL,DIMENSION( KNOLON*KNOLARG),INTENT(INOUT) :: PLYOUT ! (depends on Grib Grid type)
-REAL,DIMENSION(:),INTENT(INOUT) :: PPARAM ! output parameters of
-! the grid to avoid many calculations
-INTEGER,DIMENSION(:),INTENT(INOUT) :: KINLO ! Number of points along a parallel
-!===============================
-INTEGER :: IINLA ! Number of points along a meridian
-INTEGER :: JLOOP1,JLOOP2 ! Dummy counter
-INTEGER :: INO ! Number of output points
-REAL :: ZILA1 ! Grib first point latitude
-REAL :: ZILO1 ! Grib first point longitude
-REAL :: ZILA2 ! Grib last point latitude
-REAL :: ZILO2 ! Grib last point longitude
-REAL :: ZILASP ! Grib streching pole lat
-REAL :: ZILOSP ! Grib streching pole lon
-LOGICAL :: GREADY ! Used to test if projection is needed
-INTEGER :: ILENX ! nb points in X
-INTEGER :: ILENY ! nb points in Y
-INTEGER :: IEARTH !
-REAL :: ZSTRECH ! streching of arpege grid
-INTEGER(KIND=kindOfInt) :: IMISSING ! dummy variable
-! Aladin projection
-REAL :: ZALALAT0 ! Grid definition parameters
-REAL :: ZALALON0 ! |
-REAL :: ZALALATOR ! |
-REAL :: ZALALONOR ! |
-REAL :: ZALARPK ! |
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZXM ! Intermediate arrays
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZYM ! |
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZLONM ! |
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZLATM ! |
-! CEP projection
-REAL, DIMENSION(:), ALLOCATABLE :: ZLATGRIB
-REAL, DIMENSION(:), ALLOCATABLE :: ZLONGRIB
-INTEGER :: INBLATGRIB,INBLONGRIB
-!JUAN
-INTEGER(KIND=kindOfInt),DIMENSION(:),ALLOCATABLE :: INLO_GRIB ! Number of points along a parallel
-!JUAN
-!
-!--------------------------------------------------------------------------------
-!
-!JUAN
-ALLOCATE(INLO_GRIB(SIZE(KINLO)))
-!JUAN
-INO= KNOLON*KNOLARG
-SELECT CASE (KMODEL)
-!
-CASE(0,5,11) ! CEP/MOCAGE/ERA5
-! en theorie il faut ces 4 lignes
-! CALL GRIB_GET(KGRIB,'latitudeOfFirstGridPointInDegrees',ZILA1)
-! CALL GRIB_GET(KGRIB,'longitudeOfFirstGridPointInDegrees',ZILO1)
-! CALL GRIB_GET(KGRIB,'latitudeOfLastGridPointInDegrees',ZILA2)
-! CALL GRIB_GET(KGRIB,'longitudeOfLastGridPointInDegrees',ZILO2)
-! pourtant au passage de GRIB1 a GRIB2 les arrondi etait fait differement
-! et on n'obtenais pas les meme resultat entre un fichier grib1 et le meme
-! convertit en GRIB2
-! Du coup en faisant ce qui suit on prend une valeur recalculee par grib_api
-! suivant l'ordre N de la gausienne donc plus precise et donc la meme entre le
-! GRIB1 et le GRIB2
- CALL GRIB_GET(KGRIB,'Nj',IINLA,IRET_GRIB)
- CALL GRIB_GET_SIZE(KGRIB,'latitudes',INBLATGRIB)
- CALL GRIB_GET_SIZE(KGRIB,'longitudes',INBLONGRIB)
- ALLOCATE(ZLATGRIB(INBLATGRIB))
- ALLOCATE(ZLONGRIB(INBLONGRIB))
- CALL GRIB_GET(KGRIB,'latitudes',ZLATGRIB)
- CALL GRIB_GET(KGRIB,'longitudes',ZLONGRIB)
- ZILA1=MAXVAL(ZLATGRIB)
- ZILO1=MINVAL(ZLONGRIB)
- ZILA2=MINVAL(ZLATGRIB)
- ZILO2=MAXVAL(ZLONGRIB)
- KNI=0
- CALL GRIB_IS_MISSING(KGRIB,'pl',IMISSING,IRET_GRIB)
- IF (IRET_GRIB /= 0 .OR. IMISSING==1) THEN ! pl not present
- CALL GRIB_GET(KGRIB,'Ni',INLO_GRIB(1),IRET_GRIB)
- INLO_GRIB(2:)=INLO_GRIB(1)
- KNI=IINLA*INLO_GRIB(1)
- GREADY= (PPARAM(1)==INLO_GRIB(1) .AND. PPARAM(2)==IINLA .AND.&
- PPARAM(3)==ZILA1 .AND. PPARAM(4)==ZILO1 .AND.&
- PPARAM(5)==ZILA2 .AND. PPARAM(6)==ZILO2)
- PPARAM(1)=INLO_GRIB(1)
- PPARAM(2)=IINLA
- PPARAM(3)=ZILA1
- PPARAM(4)=ZILO1
- PPARAM(5)=ZILA2
- PPARAM(6)=ZILO2
- ELSE ! pl present in the grib
- CALL GRIB_GET(KGRIB,'pl',INLO_GRIB)
- DO JLOOP1=1 ,IINLA
- KNI = KNI + INLO_GRIB(JLOOP1)
- ENDDO
- GREADY= (PPARAM(1)==INLO_GRIB(1) .AND.&
- PPARAM(3)==ZILA1 .AND. PPARAM(4)==ZILO1 .AND.&
- PPARAM(5)==ZILA2 .AND. PPARAM(6)==ZILO2)
- PPARAM(1)=INLO_GRIB(1)
- PPARAM(2)=IINLA
- PPARAM(3)=ZILA1
- PPARAM(4)=ZILO1
- PPARAM(5)=ZILA2
- PPARAM(6)=ZILO2
- END IF
- IF (.NOT. GREADY) THEN
- PLXOUT=PLONOUT
- PLYOUT=PLATOUT
- ENDIF
-!
-CASE(1,6) ! ALADIN
-!
- CALL GRIB_GET(KGRIB,'Nj',IINLA,IRET_GRIB)
- CALL GRIB_GET(KGRIB,'Ni',INLO_GRIB(1),IRET_GRIB)
- INLO_GRIB(2:)=INLO_GRIB(1)
- CALL GRIB_GET(KGRIB,'DxInMetres',ILENX)
- CALL GRIB_GET(KGRIB,'DyInMetres',ILENY)
- CALL GRIB_GET(KGRIB,'LoVInDegrees',ZALALON0)
- CALL GRIB_GET(KGRIB,'Latin1InDegrees',ZALALAT0)
- KNI = IINLA*INLO_GRIB(1)
- ZILA1 = 0.
- ZILO1 = 0.
- ZILA2 = ZILA1 + (IINLA -1)*ILENY
- ZILO2 = ZILO1 + (INLO_GRIB(1)-1)*ILENX
- GREADY= (PPARAM(1)==INLO_GRIB(1) .AND. PPARAM(2)==IINLA .AND.&
- PPARAM(3)==ZILA1 .AND. PPARAM(4)==ZILO1 .AND.&
- PPARAM(5)==ZILA2 .AND. PPARAM(6)==ZILO2.AND.&
- PPARAM(7)==ILENX .AND. PPARAM(8)==ILENY.AND.&
- PPARAM(9)==ZALALAT0 .AND. PPARAM(10)==ZALALON0)
- IF(.NOT. GREADY) THEN
- PPARAM(1)=INLO_GRIB(1)
- PPARAM(2)=IINLA
- PPARAM(3)=ZILA1
- PPARAM(4)=ZILO1
- PPARAM(5)=ZILA2
- PPARAM(6)=ZILO2
- PPARAM(7)=ILENX
- PPARAM(8)=ILENY
- PPARAM(9)=ZALALAT0
- PPARAM(10)=ZALALON0
-!
- IF (ZALALON0 > 180.) ZALALON0 = ZALALON0 - 360.
- CALL GRIB_GET(KGRIB,'latitudeOfFirstGridPointInDegrees',ZALALATOR)
- CALL GRIB_GET(KGRIB,'longitudeOfFirstGridPointInDegrees',ZALALONOR)
- IF (ZALALONOR > 180.) ZALALONOR = ZALALONOR - 360.
- ZALARPK = SIN(ZALALAT0/180.*XPI)
- ALLOCATE (ZXM(KNOLON,KNOLARG))
- ALLOCATE (ZYM(KNOLON,KNOLARG))
- ALLOCATE (ZLONM(KNOLON,KNOLARG))
- ALLOCATE (ZLATM(KNOLON,KNOLARG))
- JLOOP1=0
- DO JLOOP2=1, KNOLARG
- ZLONM(1:KNOLON,JLOOP2) = PLONOUT(1+JLOOP1:KNOLON+JLOOP1)
- ZLATM(1:KNOLON,JLOOP2) = PLATOUT(1+JLOOP1:KNOLON+JLOOP1)
- JLOOP1 = JLOOP1+KNOLON
- END DO
- CALL SM_LATLONTOXY_A (ZALALAT0,ZALALON0,ZALARPK,ZALALATOR,ZALALONOR, &
- ZXM,ZYM,ZLATM,ZLONM,KNOLON,KNOLARG,6367470.)
- JLOOP1=0
- DO JLOOP2=1, KNOLARG
- PLXOUT(1+JLOOP1:KNOLON+JLOOP1)=ZXM(1:KNOLON,JLOOP2)
- PLYOUT(1+JLOOP1:KNOLON+JLOOP1)=ZYM(1:KNOLON,JLOOP2)
- JLOOP1 = JLOOP1+KNOLON
- ENDDO
- DEALLOCATE (ZLATM)
- DEALLOCATE (ZLONM)
- DEALLOCATE (ZYM)
- DEALLOCATE (ZXM)
- END IF
-!
-CASE(2) ! ALADIN REUNION
-!
- CALL GRIB_GET(KGRIB,'Nj',IINLA,IRET_GRIB)
- CALL GRIB_GET(KGRIB,'Ni',INLO_GRIB(1),IRET_GRIB)
- INLO_GRIB(2:)=INLO_GRIB(1)
- CALL GRIB_GET(KGRIB,'DiInMetres',ILENX)
- CALL GRIB_GET(KGRIB,'DjInMetres',ILENY)
- CALL GRIB_GET(KGRIB,'LaDInDegrees',ZALALAT0)
- KNI = IINLA*INLO_GRIB(1)
- ZILA1 = 0.
- ZILO1 = 0.
- ZILA2 = ZILA1 + (IINLA -1)*ILENY
- ZILO2 = ZILO1 + (INLO_GRIB(1)-1)*ILENX
- GREADY= (PPARAM(1)==INLO_GRIB(1) .AND. PPARAM(2)==IINLA .AND.&
- PPARAM(3)==ZILA1 .AND. PPARAM(4)==ZILO1 .AND.&
- PPARAM(5)==ZILA2 .AND. PPARAM(6)==ZILO2.AND.&
- PPARAM(7)==ILENX .AND. PPARAM(8)==ILENY.AND.&
- PPARAM(9)==ZALALAT0)
- IF(.NOT. GREADY) THEN
- PPARAM(1)=INLO_GRIB(1)
- PPARAM(2)=IINLA
- PPARAM(3)=ZILA1
- PPARAM(4)=ZILO1
- PPARAM(5)=ZILA2
- PPARAM(6)=ZILO2
- PPARAM(7)=ILENX
- PPARAM(8)=ILENY
- PPARAM(9)=ZALALAT0
- ZALALON0 = 0.
- CALL GRIB_GET(KGRIB,'latitudeOfFirstGridPointInDegrees',ZALALATOR)
- CALL GRIB_GET(KGRIB,'longitudeOfFirstGridPointInDegrees',ZALALONOR)
- IF (ZALALONOR > 180.) ZALALONOR = ZALALONOR - 360.
- ZALARPK = 0
- ALLOCATE (ZXM(KNOLON,KNOLARG))
- ALLOCATE (ZYM(KNOLON,KNOLARG))
- ALLOCATE (ZLONM(KNOLON,KNOLARG))
- ALLOCATE (ZLATM(KNOLON,KNOLARG))
- JLOOP1=0
- DO JLOOP2=1, KNOLARG
- ZLONM(1:KNOLON,JLOOP2) = PLONOUT(1+JLOOP1:KNOLON+JLOOP1)
- ZLATM(1:KNOLON,JLOOP2) = PLATOUT(1+JLOOP1:KNOLON+JLOOP1)
- JLOOP1 = JLOOP1+KNOLON
- END DO
- CALL GRIB_GET(KGRIB,'earthIsOblate',IEARTH)
- IF (IEARTH==0) THEN
- CALL SM_LATLONTOXY_A (ZALALAT0,ZALALON0,ZALARPK,ZALALATOR,ZALALONOR, &
- ZXM,ZYM,ZLATM,ZLONM,KNOLON,KNOLARG,6367470.)
- ELSE
- CALL SM_LATLONTOXY_A (ZALALAT0,ZALALON0,ZALARPK,ZALALATOR,ZALALONOR, &
- ZXM,ZYM,ZLATM,ZLONM,KNOLON,KNOLARG)
- END IF
- JLOOP1=0
- DO JLOOP2=1, KNOLARG
- PLXOUT(1+JLOOP1:KNOLON+JLOOP1)=ZXM(1:KNOLON,JLOOP2)
- PLYOUT(1+JLOOP1:KNOLON+JLOOP1)=ZYM(1:KNOLON,JLOOP2)
- JLOOP1 = JLOOP1+KNOLON
- ENDDO
- DEALLOCATE (ZLATM)
- DEALLOCATE (ZLONM)
- DEALLOCATE (ZYM)
- DEALLOCATE (ZXM)
- END IF
-!
-CASE(3,4,7) ! ARPEGE
-!
-!print*,"=========COORDINATE CONVERSION CASE ARPEGE ============="
-! PROBLEME AVEC LES GRIB d'EPYGRAM
-! dans longitudeOfLastGridPointInDegrees on la la longitude du dernier point du
-! tableau (donc au pole sud)
-! dans les GRIB1 ont avait la valeur max du tableau des longitude (donc Ã
-! l'equateur)
- CALL GRIB_GET(KGRIB,'latitudeOfFirstGridPointInDegrees',ZILA1)
- CALL GRIB_GET(KGRIB,'longitudeOfFirstGridPointInDegrees',ZILO1)
- CALL GRIB_GET(KGRIB,'latitudeOfLastGridPointInDegrees',ZILA2)
- CALL GRIB_GET(KGRIB,'longitudeOfLastGridPointInDegrees',ZILO2)
- CALL GRIB_GET(KGRIB,'latitudeOfStretchingPoleInDegrees',ZILASP)
- CALL GRIB_GET(KGRIB,'longitudeOfStretchingPoleInDegrees',ZILOSP)
- CALL GRIB_GET(KGRIB,'stretchingFactor',ZSTRECH)
- CALL GRIB_GET(KGRIB,'Nj',IINLA,IRET_GRIB)
-!
- KNI=0
- CALL GRIB_IS_MISSING(KGRIB,'pl',IRET_GRIB)
- IF (IRET_GRIB == 1) THEN ! regular
- CALL GRIB_GET(KGRIB,'Ni',INLO_GRIB(1),IRET_GRIB)
- INLO_GRIB(2:)=INLO_GRIB(1)
- KNI=IINLA*INLO_GRIB(1)
- GREADY= (PPARAM(1)==INLO_GRIB(1) .AND. PPARAM(2)==IINLA .AND.&
- PPARAM(3)==ZILA1 .AND. PPARAM(4)==ZILO1 .AND.&
- PPARAM(5)==ZILA2 .AND. PPARAM(6)==ZILO2 .AND.&
- PPARAM(7)==ZILASP .AND. PPARAM(8)==ZILOSP .AND.&
- PPARAM(9)==ZSTRECH)
- ELSE ! quasi-regular
- CALL GRIB_GET(KGRIB,'pl',INLO_GRIB)
- DO JLOOP1=1 ,IINLA
- KNI = KNI + INLO_GRIB(JLOOP1)
- ENDDO
- ZILO2=360.-360./(MAXVAL(INLO_GRIB))
- GREADY= (PPARAM(1)==INLO_GRIB(1) .AND.&
- PPARAM(3)==ZILA1 .AND. PPARAM(4)==ZILO1 .AND.&
- PPARAM(5)==ZILA2 .AND. PPARAM(6)==ZILO2 .AND.&
- PPARAM(7)==ZILASP .AND. PPARAM(8)==ZILOSP .AND.&
- PPARAM(9)==ZSTRECH)
- END IF
-!
- IF (.NOT. GREADY) THEN
- CALL ARPEGE_STRETCH_A(INO,ZILASP,ZILOSP, &
- ZSTRECH,PLATOUT,PLONOUT,PLYOUT,PLXOUT)
- PPARAM(1)=INLO_GRIB(1)
- PPARAM(2)=IINLA
- PPARAM(3)=ZILA1
- PPARAM(4)=ZILO1
- PPARAM(5)=ZILA2
- PPARAM(6)=ZILO2
- PPARAM(7)=ZILASP
- PPARAM(8)=ZILOSP
- PPARAM(9)=ZSTRECH
- END IF
-!
-CASE(10) ! NCEP
-!
- CALL GRIB_GET(KGRIB,'latitudeOfFirstGridPointInDegrees',ZILA1)
- CALL GRIB_GET(KGRIB,'longitudeOfFirstGridPointInDegrees',ZILO1)
- CALL GRIB_GET(KGRIB,'latitudeOfLastGridPointInDegrees',ZILA2)
- CALL GRIB_GET(KGRIB,'longitudeOfLastGridPointInDegrees',ZILO2)
- CALL GRIB_GET(KGRIB,'Nj',IINLA,IRET_GRIB)
- CALL GRIB_GET(KGRIB,'Ni',INLO_GRIB(1),IRET_GRIB)
- INLO_GRIB(2:)=INLO_GRIB(1)
- KNI=IINLA*INLO_GRIB(1)
- GREADY= (PPARAM(1)==INLO_GRIB(1) .AND. PPARAM(2)==IINLA .AND.&
- PPARAM(3)==ZILA1 .AND. PPARAM(4)==ZILO1 .AND.&
- PPARAM(5)==ZILA2 .AND. PPARAM(6)==ZILO2)
- PPARAM(1)=INLO_GRIB(1)
- PPARAM(2)=IINLA
- PPARAM(3)=ZILA1
- PPARAM(4)=ZILO1
- PPARAM(5)=ZILA2
- PPARAM(6)=ZILO2
- IF (.NOT. GREADY) THEN
- PLXOUT=PLONOUT
- PLYOUT=PLATOUT
- ENDIF
-END SELECT
-!JUAN
-KINLO=INLO_GRIB
-!JUAN
-END SUBROUTINE COORDINATE_CONVERSION
-!
-! ###################################################################
- SUBROUTINE ARPEGE_STRETCH_A(KN,PLAP,PLOP,PCOEF,PLAR,PLOR,PLAC,PLOC)
-! ###################################################################
-!!**** *ARPEGE_STRETCH_A* - Projection to Arpege stretched grid
-!!
-!! PURPOSE
-!! -------
-!!
-!! Projection from standard Lat,Lon grid to Arpege stretched grid
-!!
-!! METHOD
-!! ------
-!!
-!! The projection is defined in two steps :
-!! 1. A rotation to place the stretching pole at the north pole
-!! 2. The stretching
-!! This routine is a basic implementation of the informations founded in
-!! 'Note de travail Arpege nr.3'
-!! 'Transformation de coordonnees'
-!! J.F.Geleyn 1988
-!! This document describes a slightly different transformation in 3 steps. Only the
-!! two first steps are to be taken in account (at the time of writing this paper has
-!! not been updated).
-!!
-!! EXTERNAL
-!! --------
-!!
-!! Module MODD_CST
-!! XPI
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! This routine is based on :
-!! 'Note de travail ARPEGE' number 3
-!! by J.F. GELEYN (may 1988)
-!!
-!! AUTHOR
-!! ------
-!!
-!! V.Bousquet
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-!! Original 07/01/1999
-!!
-!----------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ---------------
-!
-USE MODD_CST
-!
-IMPLICIT NONE
-!
-!* 0.1. Declaration of arguments
-! -----------------------------
-!
-INTEGER, INTENT(IN) :: KN ! Number of points to convert
-REAL, INTENT(IN) :: PLAP ! Latitude of stretching pole
-REAL, INTENT(IN) :: PLOP ! Longitude of stretching pole
-REAL, INTENT(IN) :: PCOEF ! Stretching coefficient
-REAL, DIMENSION(KN), INTENT(IN) :: PLAR ! Lat. of points
-REAL, DIMENSION(KN), INTENT(IN) :: PLOR ! Lon. of points
-REAL, DIMENSION(KN), INTENT(OUT) :: PLAC ! Computed pseudo-lat. of points
-REAL, DIMENSION(KN), INTENT(OUT) :: PLOC ! Computed pseudo-lon. of points
-!
-!* 0.2. Declaration of local variables
-! -----------------------------------
-!
-REAL :: ZSINSTRETCHLA ! Sine of stretching point lat.
-REAL :: ZSINSTRETCHLO ! Sine of stretching point lon.
-REAL :: ZCOSSTRETCHLA ! Cosine of stretching point lat.
-REAL :: ZCOSSTRETCHLO ! Cosine of stretching point lon.
-REAL :: ZSINLA ! Sine of computed point latitude
-REAL :: ZSINLO ! Sine of computed point longitude
-REAL :: ZCOSLA ! Cosine of computed point latitude
-REAL :: ZCOSLO ! Cosine of computed point longitude
-REAL :: ZSINLAS ! Sine of point's pseudo-latitude
-REAL :: ZSINLOS ! Sine of point's pseudo-longitude
-REAL :: ZCOSLOS ! Cosine of point's pseudo-lon.
-REAL :: ZA,ZB,ZD ! Dummy variables used for
-REAL :: ZX,ZY ! computations
-!
-INTEGER :: JLOOP1 ! Dummy loop counter
-!
-!----------------------------------------------------------------------------
-!
-ZSINSTRETCHLA = SIN(PLAP*XPI/180.)
-ZCOSSTRETCHLA = COS(PLAP*XPI/180.)
-ZSINSTRETCHLO = SIN(PLOP*XPI/180.)
-ZCOSSTRETCHLO = COS(PLOP*XPI/180.)
-! L = longitude (0 = Greenwich, + toward east)
-! l = latitude (90 = N.P., -90 = S.P.)
-! p stands for stretching pole
-PLAC(:) = PLAR(:) * XPI / 180.
-PLOC(:) = PLOR(:) * XPI / 180.
-! A = 1 + c.c
-ZA = 1. + PCOEF*PCOEF
-! B = 1 - c.c
-ZB = 1. - PCOEF*PCOEF
-DO JLOOP1=1, KN
- ZSINLA = SIN(PLAC(JLOOP1))
- ZCOSLA = COS(PLAC(JLOOP1))
- ZSINLO = SIN(PLOC(JLOOP1))
- ZCOSLO = COS(PLOC(JLOOP1))
- ! X = cos(Lp-L)
- ZX = ZCOSLO*ZCOSSTRETCHLO + ZSINLO*ZSINSTRETCHLO
- ! Y = sin(Lp-L)
- ZY = ZSINSTRETCHLO*ZCOSLO - ZSINLO*ZCOSSTRETCHLO
- ! D = (1+c.c) + (1-c.c)(sin lp.sin l + cos lp.cos l.cos(Lp-L))
- ZD = ZA + ZB*(ZSINSTRETCHLA*ZSINLA+ZCOSSTRETCHLA*ZCOSLA*ZX)
- ! (1-c.c)+(1+c.c)((sin lp.sin l + cos lp.cos l.cos(Lp-L))
- ! sin lr = -------------------------------------------------------
- ! D
- ZSINLAS = (ZB + ZA*(ZSINSTRETCHLA*ZSINLA+ZCOSSTRETCHLA*ZCOSLA*ZX)) / ZD
- ! D' = D * cos lr
- ZD = ZD * (AMAX1(1e-6,SQRT(1.-ZSINLAS*ZSINLAS)))
- ! 2.c.(cos lp.sin l - sin lp.cos l.cos(Lp-L))
- ! cos Lr = -------------------------------------------
- ! D'
- ZCOSLOS = 2.*PCOEF*(ZCOSSTRETCHLA*ZSINLA-ZSINSTRETCHLA*ZCOSLA*ZX) / ZD
- ! 2.c.cos l.cos(Lp-L)
- ! sin Lr = -------------------
- ! D'
- ZSINLOS = 2.*PCOEF*(ZCOSLA*ZY) / ZD
- ! saturations (corrects calculation errors)
- ZSINLAS = MAX(ZSINLAS,-1.)
- ZSINLAS = MIN(ZSINLAS, 1.)
- ZCOSLOS = MAX(ZCOSLOS,-1.)
- ZCOSLOS = MIN(ZCOSLOS, 1.)
- ! back from sine & cosine
- PLAC(JLOOP1) = ASIN(ZSINLAS)
- IF (ZSINLOS>0) THEN
- PLOC(JLOOP1) = ACOS(ZCOSLOS)
- ELSE
- PLOC(JLOOP1) = -ACOS(ZCOSLOS)
- ENDIF
-ENDDO
-PLOC(:) = PLOC(:) * 180. / XPI
-PLAC(:) = PLAC(:) * 180. / XPI
-RETURN
-END SUBROUTINE ARPEGE_STRETCH_A
-!
-!
-END SUBROUTINE READ_ALL_DATA_GRIB_CASE
diff --git a/src/mesonh/ext/read_desfmn.f90 b/src/mesonh/ext/read_desfmn.f90
deleted file mode 100644
index b65cce7aaf57610c6eac1e4d383bc036497b137b..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/read_desfmn.f90
+++ /dev/null
@@ -1,887 +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_DESFM_n
-! ######################
-!
-INTERFACE
-!
- SUBROUTINE READ_DESFM_n(KMI,TPDATAFILE,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 )
-!
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PARAMETERS
-!
-INTEGER, INTENT(IN) :: KMI ! Model index
-TYPE(TFILEDATA), INTENT(IN) :: TPDATAFILE ! Datafile
-CHARACTER (LEN=5), INTENT(OUT) :: HCONF ! configuration var. linked to FMfile
-LOGICAL, INTENT(OUT) :: OFLAT ! Logical for zero orography
-LOGICAL, INTENT(OUT) :: OUSERV ! use Rv mixing ratio
-LOGICAL, INTENT(OUT) :: OUSERC ! use Rc mixing ratio
-LOGICAL, INTENT(OUT) :: OUSERR ! use Rr mixing ratio
-LOGICAL, INTENT(OUT) :: OUSERI ! use Ri mixing ratio
-LOGICAL, INTENT(OUT) :: OUSECI ! use Ci concentration of Ice cristals
-LOGICAL, INTENT(OUT) :: OUSERS ! use Rs mixing ratio
-LOGICAL, INTENT(OUT) :: OUSERG ! use Rg mixing ratio
-LOGICAL, INTENT(OUT) :: OUSERH ! use Rh mixing ratio
-LOGICAL, INTENT(OUT) :: OUSECHEM ! Chemical flag
-LOGICAL, INTENT(OUT) :: OUSECHAQ ! Aqueous Chemical flag
-LOGICAL, INTENT(OUT) :: OUSECHIC ! Ice phase Chemical flag
-LOGICAL, INTENT(OUT) :: OCH_PH ! pH flag
-LOGICAL, INTENT(OUT) :: OCH_CONV_LINOX ! LiNOX flag
-LOGICAL, INTENT(OUT) :: OLG ! lagrangian flag
-LOGICAL, INTENT(OUT) :: OSALT ! Sea Salt flag
-LOGICAL, INTENT(OUT) :: ODUST ! Dust flag
-LOGICAL, INTENT(OUT) :: OPASPOL ! Passive pollutant flag
-LOGICAL, INTENT(OUT) :: OFIRE ! Blaze flag
-#ifdef MNH_FOREFIRE
-LOGICAL, INTENT(OUT) :: OFOREFIRE! ForeFire flag
-#endif
-LOGICAL, INTENT(OUT) :: OLNOX_EXPLICIT ! explicit LNOx flag
-LOGICAL, INTENT(OUT) :: OCONDSAMP! Conditional sampling flag
-LOGICAL, INTENT(OUT) :: OBLOWSNOW ! Blowing snow flag
-LOGICAL, INTENT(OUT) :: OORILAM ! Orilam flag
-LOGICAL, INTENT(OUT) :: OCHTRANS ! Deep convection on scalar
-LOGICAL,DIMENSION(JPMODELMAX),INTENT(OUT) :: ODEPOS_DST ! Dust Wet Deposition flag
-LOGICAL,DIMENSION(JPMODELMAX),INTENT(OUT) :: ODEPOS_SLT ! Sea Salt Wet Deposition flag
-LOGICAL,DIMENSION(JPMODELMAX),INTENT(OUT) :: ODEPOS_AER ! Aerosols Wet Deposition flag
-INTEGER, INTENT(OUT) :: KRIMX, KRIMY ! number of points for the
- ! horizontal relaxation for the outermost verticals
-INTEGER, INTENT(OUT) :: KSV_USER ! number of additional scalar
- ! variables in FMfile
-CHARACTER (LEN=4), INTENT(OUT) :: HTURB ! Kind of turbulence parameterization
- ! used to produce the FMfile
-CHARACTER (LEN=4), INTENT(OUT) :: HTOM ! Kind of third order moment
-LOGICAL, INTENT(OUT) :: ORMC01 ! flag for RMC01 SBL computations
-CHARACTER (LEN=4), INTENT(OUT) :: HRAD ! Kind of radiation scheme
-CHARACTER (LEN=4), INTENT(OUT) :: HDCONV ! Kind of deep convection scheme
-CHARACTER (LEN=4), INTENT(OUT) :: HSCONV ! Kind of shallow convection scheme
-CHARACTER (LEN=4), INTENT(OUT) :: HCLOUD ! Kind of microphysical scheme
-CHARACTER (LEN=4), INTENT(OUT) :: HELEC ! Kind of electrical scheme
-CHARACTER (LEN=*), INTENT(OUT) :: HEQNSYS! type of equations' system
-END SUBROUTINE READ_DESFM_n
-!
-END INTERFACE
-!
-END MODULE MODI_READ_DESFM_n
-! #########################################################################
- SUBROUTINE READ_DESFM_n(KMI,TPDATAFILE,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 )
-! #########################################################################
-!
-!!**** *READ_DESFM_n * - routine to read the descriptor file DESFM
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to read the descriptor file called
-! DESFM.
-!
-!!
-!!** METHOD
-!! ------
-!! The descriptor file is read. Namelists (NAMXXXn) which contain
-!! informations 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.
-!! Some attributes of the FMfile are saved in order to check coherence
-!! between initial file and the segment to perform (description given by
-!! EXSEG file), i.e. :
-!! - the configuration which has been used to produce the initial file
-!! (CCONF)
-!! - logical switch for flat configuration (zero orography) in initial file
-!! (LFLAT)
-!! - kind of moist variables in initial file (LUSERV,LUSERC,LUSERR,
-!! LUSERI,LUSERS,LUSERG,LUSERH)
-!! - number of additional scalar variables in initial file (NSV_USER)
-!! - kind of turbulence parameterization used to produce the initial
-!! file (CTURB)
-!! - kind of mixing length used to produce the initial
-!! file (CTURBLEN)
-!! - time step of each model stored in PTSTEP_OLD, to correct the initial
-!! field at t-dt in routine READ_FIELD in case of time step change
-!! - type of equation system in order to verify that the anelastic is the
-!! same for the initila file generation and the run
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODN_CONF : CCONF,LFLAT,CEQNSYS
-!!
-!! Module MODN_CONF1 : LUSERV,LUSERC,LUSERR,LUSERI,LUSECI,
-!! LUSERS,LUSERG,LUSERH
-!!
-!! Module MODN_PARAM1 : CTURB,CRAD,CDCONV,CSCONV
-!!
-!! Module MODN_TURB$n : CTURBLEN
-!!
-!! Module MODN_DYN$n : NRIMX,NRIMY
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of the documentation (routine READ_DESFM_n)
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Ducrocq * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 07/06/94
-!! Modifications 17/10/94 (Stein) For LCORIO
-!! Modifications 26/10/94 (Stein) remove NAM_GET from the Namelists
-!! present in DESFM + change the namelist names
-!! Modifications 09/01/95 (Stein) add the turbulence scheme
-!! Modifications 09/01/95 (Stein) add the 1D switch
-!! Modifications 13/02/95 (Stein) save HTURBLEN
-!! Modifications 30/06/95 (Stein) add new namelists
-!! Modifications 18/08/95 (Lafore) time step change
-!! Modifications 15/09/95 (Pinty) add the radiations
-!! Modifications 06/02/96 (J.Vila) add the new scalar advection scheme
-!! Modifications 20/02/96 (Stein) add the LES namelist + cleaning
-!! Modifications 25/04/96 (Suhre) add NAM_BLANK
-!! Modifications 25/04/96 (Suhre) add NAM_FRC
-!! Modifications 25/04/96 (Suhre) add NAM_CH_MNHCn and NAM_CH_SOLVER
-!! Modifications 11/04/96 (Pinty) add the ice concentration
-!! Modifications 11/01/97 (Pinty) add the deep convection
-!! Modifications 22/07/96 (Lafore) gridnesting implementation
-!! Modifications 22/06/97 (Stein ) save the equations' system+ cleaning
-!! Modifications 09/07/97 (Masson) add NAM_PARAM_GROUND
-!! Modifications 25/08/97 (Masson) add HGROUND
-!! Modifications 25/10/97 (Stein ) new namelists
-!! Modification 04/06/00 (Pinty) add C2R2 scheme
-!! Modification 22/01/01 (Gazen) Add OUSECHEM and OLG
-!! Modification 15/10/01 (Mallet) allow namelists in different orders
-!! Modification 29/11/02 (Pinty) add C3R5, ICE2, ICE4, ELEC
-!! Modification 01/2004 (Masson) removes surface (externalization)
-!! Modification 01/2005 (Masson) removes 1D and 2D switches
-!! Modification 03/2005 (Tulet) add dust, aerosols
-!! Modification 03/2006 (O.Geoffroy) Add KHKO scheme
-!! Modification 04/2010 (M. Leriche) Add aqueous + ice chemistry
-!! Modification 07/2013 (Bosseur & Filippi) Adds Forefire
-!! Modification 01/2015 (C. Barthe) Add explicit LNOx
-!! Modification 2016 (B.VIE) LIMA
-!! Modification 11/2016 (Ph. Wautelet) Allocate/initialise some output/backup structures
-!! Modification 02/2018 (Q.Libois) 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 02/2021 (F.Auguste) add IBM
-!! (T.Nagel) add turbulence recycling
-!! (E.Jezequel) add stations read from CSV file
-! A. Costes 12/2021: add Blaze fire model
-! P. Wautelet 27/04/2022: add namelist for profilers
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_PARAMETERS
-!
-USE MODN_BACKUP
-USE MODN_BUDGET
-USE MODN_CONF
-USE MODN_DYN
-USE MODN_NESTING
-USE MODN_OUTPUT
-USE MODN_LES
-USE MODN_CONF_n
-USE MODN_DYN_n
-USE MODN_ADV_n
-USE MODN_PARAM_n
-USE MODN_PARAM_RAD_n
-USE MODN_PARAM_ECRAD_n
-USE MODN_PARAM_KAFR_n
-USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALLN_INIT
-USE MODD_PARAM_ICE_n, ONLY : PARAM_ICEN_INIT
-USE MODD_PARAM_LIMA, ONLY: PARAM_LIMA_INIT
-USE MODN_LUNIT_n
-USE MODN_LBC_n
-USE MODN_NUDGING_n
-USE MODD_TURB_n, ONLY: TURBN_INIT, CTOM, LRMC01
-USE MODD_NEB_n, ONLY: NEBN_INIT
-USE MODN_FRC
-USE MODN_BLANK_n
-USE MODN_CH_SOLVER_n
-USE MODN_CH_MNHC_n
-USE MODN_PARAM_C2R2, ONLY : HPARAM_CCN_C2R2=>HPARAM_CCN,HINI_CCN_C2R2=>HINI_CCN, &
- HTYPE_CCN_C2R2=>HTYPE_CCN,LRAIN_C2R2=>LRAIN, &
- LSEDC_C2R2=>LSEDC,LACTIT_C2R2=>LACTIT,XCHEN_C2R2=>XCHEN, &
- XKHEN_C2R2=>XKHEN,XMUHEN_C2R2=>XMUHEN, &
- XBETAHEN_C2R2=>XBETAHEN,XCONC_CCN_C2R2=>XCONC_CCN, &
- XR_MEAN_CCN_C2R2=>XR_MEAN_CCN,XLOGSIG_CCN_C2R2=>XLOGSIG_CCN, &
- XFSOLUB_CCN_C2R2=>XFSOLUB_CCN,XACTEMP_CCN_C2R2=>XACTEMP_CCN, &
- XALPHAC_C2R2=>XALPHAC,XNUC_C2R2=>XNUC,XALPHAR_C2R2=>XALPHAR, &
- XNUR_C2R2=>XNUR,XAERDIFF_C2R2=>XAERDIFF, &
- XAERHEIGHT_C2R2=>XAERHEIGHT,NAM_PARAM_C2R2
-USE MODN_PARAM_C1R3, ONLY : XALPHAI_C1R3=>XALPHAI,XNUI_C1R3=>XNUI,XALPHAS_C1R3=>XALPHAS, &
- XNUS_C1R3=>XNUS,XALPHAG_C1R3=>XALPHAG,XNUG_C1R3=>XNUG, &
- XFACTNUC_DEP_C1R3=>XFACTNUC_DEP, &
- XFACTNUC_CON_C1R3=>XFACTNUC_CON,LSEDI_C1R3=>LSEDI, &
- LHHONI_C1R3=>LHHONI,CPRISTINE_ICE_C1R3,CHEVRIMED_ICE_C1R3, &
- NAM_PARAM_C1R3
-USE MODN_ELEC
-USE MODN_SERIES
-USE MODN_SERIES_n
-USE MODN_TURB_CLOUD
-USE MODN_CH_ORILAM
-USE MODN_DUST
-USE MODN_SALT
-USE MODN_PASPOL
-USE MODN_VISCOSITY
-USE MODN_DRAG_n
-#ifdef MNH_FOREFIRE
-USE MODN_FOREFIRE
-#endif
-USE MODN_CONDSAMP
-USE MODN_LATZ_EDFLX
-USE MODN_2D_FRC
-USE MODN_BLOWSNOW_n
-USE MODN_BLOWSNOW
-USE MODN_PROFILER_n
-USE MODN_STATION_n
-!
-! USE MODN_FLYERS
-!
-USE MODE_MSG
-USE MODE_POS
-USE MODN_RECYCL_PARAM_n
-USE MODN_IBM_PARAM_n
-USE MODD_IBM_LSF, ONLY: LIBM_LSF
-!
-USE MODN_FIRE_n
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-INTEGER, INTENT(IN) :: KMI ! Model index
-TYPE(TFILEDATA), INTENT(IN) :: TPDATAFILE ! Datafile
-CHARACTER (LEN=5), INTENT(OUT) :: HCONF ! configuration var. linked to FMfile
-LOGICAL, INTENT(OUT) :: OFLAT ! Logical for zero orography
-LOGICAL, INTENT(OUT) :: OUSERV ! use Rv mixing ratio
-LOGICAL, INTENT(OUT) :: OUSERC ! use Rc mixing ratio
-LOGICAL, INTENT(OUT) :: OUSERR ! use Rr mixing ratio
-LOGICAL, INTENT(OUT) :: OUSERI ! use Ri mixing ratio
-LOGICAL, INTENT(OUT) :: OUSECI ! use Ci concentration of Ice cristals
-LOGICAL, INTENT(OUT) :: OUSERS ! use Rs mixing ratio
-LOGICAL, INTENT(OUT) :: OUSERG ! use Rg mixing ratio
-LOGICAL, INTENT(OUT) :: OUSERH ! use Rh mixing ratio
-LOGICAL, INTENT(OUT) :: OUSECHEM ! Chemical flag
-LOGICAL, INTENT(OUT) :: OUSECHAQ ! Aqueous Chemical flag
-LOGICAL, INTENT(OUT) :: OUSECHIC ! Ice phase Chemical flag
-LOGICAL, INTENT(OUT) :: OCH_PH ! pH flag
-LOGICAL, INTENT(OUT) :: OCH_CONV_LINOX ! LiNOX flag
-LOGICAL, INTENT(OUT) :: OLG ! lagrangian flag
-INTEGER, INTENT(OUT) :: KRIMX, KRIMY ! number of points for the
- ! horizontal relaxation for the outermost verticals
-INTEGER, INTENT(OUT) :: KSV_USER ! number of additional scalar
- ! variables in FMfile
-CHARACTER (LEN=4), INTENT(OUT) :: HTURB ! Kind of turbulence parameterization
- ! used to produce the FMfile
-CHARACTER (LEN=4), INTENT(OUT) :: HTOM ! Kind of third order moment
-LOGICAL, INTENT(OUT) :: ORMC01 ! flag for RMC01 SBL computations
-CHARACTER (LEN=4), INTENT(OUT) :: HRAD ! Kind of radiation scheme
-CHARACTER (LEN=4), INTENT(OUT) :: HDCONV ! Kind of deep convection scheme
-CHARACTER (LEN=4), INTENT(OUT) :: HSCONV ! Kind of shallow convection scheme
-CHARACTER (LEN=4), INTENT(OUT) :: HCLOUD ! Kind of microphysical scheme
-CHARACTER (LEN=4), INTENT(OUT) :: HELEC ! Kind of electrical scheme
-CHARACTER (LEN=*), INTENT(OUT) :: HEQNSYS! type of equations' system
-LOGICAL, INTENT(OUT) :: OSALT ! Sea Salt flag
-LOGICAL, INTENT(OUT) :: OPASPOL ! Passive pollutant flag
-LOGICAL, INTENT(OUT) :: OFIRE ! Blaze flag
-#ifdef MNH_FOREFIRE
-LOGICAL, INTENT(OUT) :: OFOREFIRE ! ForeFire flag
-#endif
-LOGICAL, INTENT(OUT) :: OLNOX_EXPLICIT ! explicit LNOx flag
-LOGICAL, INTENT(OUT) :: OCONDSAMP! Conditional sampling flag
-LOGICAL, INTENT(OUT) :: OBLOWSNOW! Blowing snow flag
-LOGICAL, INTENT(OUT) :: ODUST ! Dust flag
-LOGICAL, INTENT(OUT) :: OORILAM ! Dust flag
-LOGICAL, INTENT(OUT) :: OCHTRANS ! Deep convection on scalar
- ! variables flag
-LOGICAL,DIMENSION(JPMODELMAX),INTENT(OUT) :: ODEPOS_DST ! Dust Wet Deposition flag
-LOGICAL,DIMENSION(JPMODELMAX),INTENT(OUT) :: ODEPOS_SLT ! Sea Salt Wet Deposition flag
-LOGICAL,DIMENSION(JPMODELMAX),INTENT(OUT) :: ODEPOS_AER ! Aerosols Wet Deposition flag
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: ILUDES, & ! logical unit numbers of
- ILUOUT ! DESFM file and output listing
-LOGICAL :: GFOUND ! Return code when searching namelist
-LOGICAL,DIMENSION(JPMODELMAX),SAVE :: LTEMPDEPOS_DST ! Dust Moist flag
-LOGICAL,DIMENSION(JPMODELMAX),SAVE :: LTEMPDEPOS_SLT ! Sea Salt Moist flag
-LOGICAL,DIMENSION(JPMODELMAX),SAVE :: LTEMPDEPOS_AER ! Orilam Moist flag
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. READ DESFM FILE
-! ---------------
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','READ_DESFM_n','called for '//TRIM(TPDATAFILE%CNAME))
-!
-IF (.NOT.ASSOCIATED(TPDATAFILE%TDESFILE)) &
- CALL PRINT_MSG(NVERB_FATAL,'IO','READ_DESFM_n','TDESFILE not associated for '//TRIM(TPDATAFILE%CNAME))
-!
-ILUDES = TPDATAFILE%TDESFILE%NLU
-ILUOUT = TLUOUT%NLU
-!
-CALL POSNAM(ILUDES,'NAM_LUNITN',GFOUND)
-CALL INIT_NAM_LUNITN
-IF (GFOUND) THEN
- READ(UNIT=ILUDES,NML=NAM_LUNITn)
- CALL UPDATE_NAM_LUNITN
-END IF
-CALL POSNAM(ILUDES,'NAM_CONFN',GFOUND)
-CALL INIT_NAM_CONFN
-IF (GFOUND) THEN
- READ(UNIT=ILUDES,NML=NAM_CONFn)
- CALL UPDATE_NAM_CONFN
-END IF
-CALL POSNAM(ILUDES,'NAM_DYNN',GFOUND)
-CALL INIT_NAM_DYNN
-IF (GFOUND) THEN
- READ(UNIT=ILUDES,NML=NAM_DYNn)
- CALL UPDATE_NAM_DYNN
-END IF
-CALL POSNAM(ILUDES,'NAM_ADVN',GFOUND)
-CALL INIT_NAM_ADVN
-IF (GFOUND) THEN
- READ(UNIT=ILUDES,NML=NAM_ADVn)
- CALL UPDATE_NAM_ADVN
-END IF
-CALL POSNAM(ILUDES,'NAM_PARAMN',GFOUND)
-CALL INIT_NAM_PARAMn
-IF (GFOUND) THEN
- READ(UNIT=ILUDES,NML=NAM_PARAMn)
- CALL UPDATE_NAM_PARAMn
-END IF
-CALL POSNAM(ILUDES,'NAM_PARAM_RADN',GFOUND)
-CALL INIT_NAM_PARAM_RADn
-IF (GFOUND) THEN
- READ(UNIT=ILUDES,NML=NAM_PARAM_RADn)
- CALL UPDATE_NAM_PARAM_RADn
-END IF
-#ifdef MNH_ECRAD
-CALL POSNAM(ILUDES,'NAM_PARAM_ECRADN',GFOUND)
-CALL INIT_NAM_PARAM_ECRADn
-IF (GFOUND) THEN
- READ(UNIT=ILUDES,NML=NAM_PARAM_ECRADn)
- CALL UPDATE_NAM_PARAM_ECRADn
-END IF
-#endif
-CALL POSNAM(ILUDES,'NAM_PARAM_KAFRN',GFOUND)
-CALL INIT_NAM_PARAM_KAFRn
-IF (GFOUND) THEN
- READ(UNIT=ILUDES,NML=NAM_PARAM_KAFRn)
- CALL UPDATE_NAM_PARAM_KAFRn
-END IF
-CALL PARAM_MFSHALLN_INIT(CPROGRAM, ILUDES, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
-CALL POSNAM(ILUDES,'NAM_LBCN',GFOUND)
-CALL INIT_NAM_LBCn
-IF (GFOUND) THEN
- READ(UNIT=ILUDES,NML=NAM_LBCn)
- CALL UPDATE_NAM_LBCn
-END IF
-CALL POSNAM(ILUDES,'NAM_NUDGINGN',GFOUND)
-CALL INIT_NAM_NUDGINGn
-IF (GFOUND) THEN
- READ(UNIT=ILUDES,NML=NAM_NUDGINGn)
- CALL UPDATE_NAM_NUDGINGn
-END IF
-CALL TURBN_INIT(CPROGRAM, ILUDES, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
-CALL NEBN_INIT(CPROGRAM, ILUDES, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
-CALL PARAM_ICEN_INIT(CPROGRAM, ILUDES, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
-CALL POSNAM(ILUDES,'NAM_CH_MNHCN',GFOUND)
-CALL INIT_NAM_CH_MNHCn
-IF (GFOUND) THEN
- READ(UNIT=ILUDES,NML=NAM_CH_MNHCn)
- CALL UPDATE_NAM_CH_MNHCn
-END IF
-CALL POSNAM(ILUDES,'NAM_CH_SOLVERN',GFOUND)
-CALL INIT_NAM_CH_SOLVERn
-IF (GFOUND) THEN
- READ(UNIT=ILUDES,NML=NAM_CH_SOLVERn)
- CALL UPDATE_NAM_CH_SOLVERn
-END IF
-CALL POSNAM(ILUDES,'NAM_DRAGN',GFOUND)
-CALL INIT_NAM_DRAGn
-IF (GFOUND) THEN
- READ(UNIT=ILUDES,NML=NAM_DRAGn)
- CALL UPDATE_NAM_DRAGn
-END IF
-CALL POSNAM(ILUDES,'NAM_IBM_PARAMN',GFOUND,ILUOUT)
-CALL INIT_NAM_IBM_PARAMn
-IF (GFOUND) THEN
- READ(UNIT=ILUDES,NML=NAM_IBM_PARAMn)
- CALL UPDATE_NAM_IBM_PARAMn
-END IF
-CALL POSNAM(ILUDES,'NAM_RECYCL_PARAMN',GFOUND,ILUOUT)
-CALL INIT_NAM_RECYCL_PARAMn
-IF (GFOUND) THEN
- READ(UNIT=ILUDES,NML=NAM_RECYCL_PARAMn)
- CALL UPDATE_NAM_RECYCL_PARAMn
-END IF
-CALL POSNAM(ILUDES,'NAM_SERIESN',GFOUND,ILUOUT)
-CALL INIT_NAM_SERIESn
-IF (GFOUND) THEN
- READ(UNIT=ILUDES,NML=NAM_SERIESn)
- CALL UPDATE_NAM_SERIESn
-END IF
-CALL POSNAM(ILUDES,'NAM_BLOWSNOWN',GFOUND,ILUOUT)
-CALL INIT_NAM_BLOWSNOWn
-IF (GFOUND) THEN
- READ(UNIT=ILUDES,NML=NAM_BLOWSNOWn)
- CALL UPDATE_NAM_BLOWSNOWn
-END IF
-CALL POSNAM(ILUDES,'NAM_BLANKN',GFOUND,ILUOUT)
-CALL INIT_NAM_BLANKn
-IF (GFOUND) THEN
- READ(UNIT=ILUDES,NML=NAM_BLANKn)
- CALL UPDATE_NAM_BLANKn
-END IF
-CALL POSNAM(ILUDES,'NAM_PROFILERN',GFOUND,ILUOUT)
-CALL INIT_NAM_PROFILERn
-IF (GFOUND) THEN
- READ(UNIT=ILUDES,NML=NAM_PROFILERN)
- CALL UPDATE_NAM_PROFILERn
-END IF
-CALL POSNAM(ILUDES,'NAM_STATIONN',GFOUND,ILUOUT)
-CALL INIT_NAM_STATIONn
-IF (GFOUND) THEN
- READ(UNIT=ILUDES,NML=NAM_STATIONn)
- CALL UPDATE_NAM_STATIONn
-END IF
-CALL POSNAM(ILUDES,'NAM_FIREN',GFOUND,ILUOUT)
-CALL INIT_NAM_FIREn
-IF (GFOUND) THEN
- READ(UNIT=ILUDES,NML=NAM_FIREn)
- CALL UPDATE_NAM_FIREn
-END IF
-!
-!
-IF (KMI == 1) THEN
- CALL POSNAM(ILUDES,'NAM_CONF',GFOUND)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_CONF)
- CALL POSNAM(ILUDES,'NAM_DYN',GFOUND)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_DYN)
- CALL POSNAM(ILUDES,'NAM_NESTING',GFOUND)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_NESTING)
- CALL POSNAM(ILUDES,'NAM_BACKUP',GFOUND)
- IF (GFOUND) THEN
- 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=ILUDES,NML=NAM_BACKUP)
- ELSE
- CALL POSNAM(ILUDES,'NAM_FMOUT',GFOUND)
- IF (GFOUND) CALL PRINT_MSG(NVERB_FATAL,'IO','READ_DESFM_n','use namelist NAM_BACKUP instead of namelist NAM_FMOUT')
- END IF
- CALL POSNAM(ILUDES,'NAM_OUTPUT',GFOUND)
- IF (GFOUND) THEN
- 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=ILUDES,NML=NAM_OUTPUT)
- END IF
-! Note: it is not useful to read the budget namelists in the .des files
-! The values here (if present in file) don't need to be compared with the ones in the EXSEGn files
-! CALL POSNAM(ILUDES,'NAM_BUDGET',GFOUND)
-! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BUDGET)
-! CALL POSNAM(ILUDES,'NAM_BU_RU',GFOUND)
-! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RU)
-! CALL POSNAM(ILUDES,'NAM_BU_RV',GFOUND)
-! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RV)
-! CALL POSNAM(ILUDES,'NAM_BU_RW',GFOUND)
-! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RW)
-! CALL POSNAM(ILUDES,'NAM_BU_RTH',GFOUND)
-! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RTH)
-! CALL POSNAM(ILUDES,'NAM_BU_RTKE',GFOUND)
-! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RTKE)
-! CALL POSNAM(ILUDES,'NAM_BU_RRV',GFOUND)
-! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRV)
-! CALL POSNAM(ILUDES,'NAM_BU_RRC',GFOUND)
-! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRC)
-! CALL POSNAM(ILUDES,'NAM_BU_RRR',GFOUND)
-! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRR)
-! CALL POSNAM(ILUDES,'NAM_BU_RRI',GFOUND)
-! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRI)
-! CALL POSNAM(ILUDES,'NAM_BU_RRS',GFOUND)
-! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRS)
-! CALL POSNAM(ILUDES,'NAM_BU_RRG',GFOUND)
-! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRG)
-! CALL POSNAM(ILUDES,'NAM_BU_RRH',GFOUND)
-! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRH)
-! CALL POSNAM(ILUDES,'NAM_BU_RSV',GFOUND)
-! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RSV)
- CALL POSNAM(ILUDES,'NAM_LES',GFOUND)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_LES)
- CALL POSNAM(ILUDES,'NAM_PDF',GFOUND)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_PDF)
- CALL POSNAM(ILUDES,'NAM_FRC',GFOUND)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_FRC)
- CALL POSNAM(ILUDES,'NAM_PARAM_C2R2',GFOUND)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_PARAM_C2R2)
- CALL POSNAM(ILUDES,'NAM_PARAM_C1R3',GFOUND)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_PARAM_C1R3)
- CALL PARAM_LIMA_INIT(CPROGRAM, ILUDES, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
- CALL POSNAM(ILUDES,'NAM_ELEC',GFOUND)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_ELEC)
- CALL POSNAM(ILUDES,'NAM_SERIES',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_SERIES)
- CALL POSNAM(ILUDES,'NAM_TURB_CLOUD',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_TURB_CLOUD)
- CALL POSNAM(ILUDES,'NAM_CH_ORILAM',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_CH_ORILAM)
- CALL POSNAM(ILUDES,'NAM_DUST',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_DUST)
- CALL POSNAM(ILUDES,'NAM_SALT',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_SALT)
- CALL POSNAM(ILUDES,'NAM_PASPOL',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_PASPOL)
-#ifdef MNH_FOREFIRE
- CALL POSNAM(ILUDES,'NAM_FOREFIRE',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_FOREFIRE)
-#endif
- CALL POSNAM(ILUDES,'NAM_CONDSAMP',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_CONDSAMP)
- CALL POSNAM(ILUDES,'NAM_BLOWSNOW',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BLOWSNOW)
- CALL POSNAM(ILUDES,'NAM_2D_FRC',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_2D_FRC)
- LTEMPDEPOS_DST(:) = LDEPOS_DST(:)
- LTEMPDEPOS_SLT(:) = LDEPOS_SLT(:)
- LTEMPDEPOS_AER(:) = LDEPOS_AER(:)
- CALL POSNAM(ILUDES,'NAM_LATZ_EDFLX',GFOUND)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_LATZ_EDFLX)
- CALL POSNAM(ILUDES,'NAM_VISC',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_VISC)
-! Note: it is not useful to read the FLYERS/AIRCRAFTS/BALLOONS namelists in the .des files
-! The values here (if present in file) don't need to be compared with the ones in the EXSEGn files
-! CALL POSNAM(ILUDES,'NAM_FLYERS',GFOUND,ILUOUT)
-! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_FLYERS)
-! CALL POSNAM(ILUSEG,'NAM_AIRCRAFTS',GFOUND,ILUOUT)
-! IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_AIRCRAFTS)
-! CALL POSNAM(ILUSEG,'NAM_BALLOONS',GFOUND,ILUOUT)
-! IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BALLOONS)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. SAVE SOME FMFILE ATTRIBUTES
-! ---------------------------
-HCONF = CCONF
-OFLAT = LFLAT
-OUSERV = LUSERV
-OUSERC = LUSERC
-OUSERR = LUSERR
-OUSERI = LUSERI
-OUSECI = LUSECI
-OUSERS = LUSERS
-OUSERG = LUSERG
-OUSERH = LUSERH
-OUSECHEM = LUSECHEM
-OUSECHAQ = LUSECHAQ
-OUSECHIC = LUSECHIC
-OCH_PH = LCH_PH
-OCH_CONV_LINOX = LCH_CONV_LINOX
-ODUST = LDUST
-ODEPOS_DST(KMI) = LTEMPDEPOS_DST(KMI)
-ODEPOS_SLT(KMI) = LTEMPDEPOS_SLT(KMI)
-ODEPOS_AER(KMI) = LTEMPDEPOS_AER(KMI)
-OCHTRANS = LCHTRANS
-OSALT = LSALT
-OORILAM = LORILAM
-OLG = LLG
-OPASPOL = LPASPOL
-OFIRE = LBLAZE
-#ifdef MNH_FOREFIRE
-OFOREFIRE = LFOREFIRE
-#endif
-OLNOX_EXPLICIT = LLNOX_EXPLICIT
-OCONDSAMP= LCONDSAMP
-OBLOWSNOW= LBLOWSNOW
-! Initially atmosphere free of blowing snow particles
-IF(KMI>1) OBLOWSNOW=.FALSE.
-KRIMX = NRIMX
-KRIMY = NRIMY
-KSV_USER = NSV_USER
-HTURB = CTURB
-HTOM = CTOM
-ORMC01 = LRMC01
-HRAD = CRAD
-HDCONV = CDCONV
-HSCONV = CSCONV
-HCLOUD = CCLOUD
-HELEC = CELEC
-HEQNSYS = CEQNSYS
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. WRITE DESFM ON OUTPUT LISTING
-! ------------------------------
-!
-IF (NVERB >= 10) THEN
- WRITE(UNIT=ILUOUT,FMT="(/,'DESCRIPTOR OF INITIAL FILE FOR MODEL ',I2)") KMI
- WRITE(UNIT=ILUOUT,FMT="( '------------------------------------ ' )")
-!
- WRITE(UNIT=ILUOUT,FMT="('********** LOGICAL UNITSn **********')")
- WRITE(UNIT=ILUOUT,NML=NAM_LUNITn)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** CONFIGURATIONn **********')")
- WRITE(UNIT=ILUOUT,NML=NAM_CONFn)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** DYNAMICn ****************')")
- WRITE(UNIT=ILUOUT,NML=NAM_DYNn)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** ADVECTIONn **************')")
- WRITE(UNIT=ILUOUT,NML=NAM_ADVn)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** PARAMETERIZATIONSn ******')")
- WRITE(UNIT=ILUOUT,NML=NAM_PARAMn)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** RADIATIONSn *************')")
- WRITE(UNIT=ILUOUT,NML=NAM_PARAM_RADn)
-!
-#ifdef MNH_ECRAD
- WRITE(UNIT=ILUOUT,FMT="('********** ECRAD RADIATIONSn *************')")
- WRITE(UNIT=ILUOUT,NML=NAM_PARAM_ECRADn)
-#endif
-!
- WRITE(UNIT=ILUOUT,FMT="('********** DEEP CONVECTIONn ********')")
- WRITE(UNIT=ILUOUT,NML=NAM_PARAM_KAFRn)
-!
- WRITE(UNIT=ILUOUT,FMT="('*** MASS FLUX SHALLOW CONVECTION ***')")
- CALL PARAM_MFSHALLN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** LBCn ********************')")
- WRITE(UNIT=ILUOUT,NML=NAM_LBCn)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** TURBn *******************')")
- CALL TURBN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** NEBn *******************')")
- CALL NEBN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** DRAGn *******************')")
- WRITE(UNIT=ILUOUT,NML=NAM_DRAGn)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** IBM FORCING *************')")
- WRITE(UNIT=ILUOUT,NML=NAM_IBM_PARAMn)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** RECYLING *************')")
- WRITE(UNIT=ILUOUT,NML=NAM_RECYCL_PARAMn)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** NUDGINGn ****************')")
- WRITE(UNIT=ILUOUT,NML=NAM_NUDGINGn)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** CHEMICAL MONITORn *******')")
- WRITE(UNIT=ILUOUT,NML=NAM_CH_MNHCn)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** CHEMICAL SOLVER *********')")
- WRITE(UNIT=ILUOUT,NML=NAM_CH_SOLVERn)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** BLOWSNOWn ***************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BLOWSNOWn)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** BLANKn ******************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BLANKn)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** PROFILERn *****************')")
- WRITE(UNIT=ILUOUT,NML=NAM_PROFILERn)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** STATIONn ******************')")
- WRITE(UNIT=ILUOUT,NML=NAM_STATIONn)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ ICE SCHEME ***********************')")
- CALL PARAM_ICEN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** BLAZE *******************')")
- WRITE(UNIT=ILUOUT,NML=NAM_FIREn)
-!
- IF (KMI==1) THEN
- WRITE(UNIT=ILUOUT,FMT="(/,'PART OF INITIAL FILE COMMON TO ALL THE MODELS')")
- WRITE(UNIT=ILUOUT,FMT="( '---------------------------------------------')")
-!
- WRITE(UNIT=ILUOUT,FMT="('************ CONFIGURATION ********************')")
- WRITE(UNIT=ILUOUT,NML=NAM_CONF)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ DYNAMIC **************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_DYN)
-!
-! Budget namelists not read anymore in READ_DESFM_n
-! WRITE(UNIT=ILUOUT,FMT="('************ BUDGET ***************************')")
-! WRITE(UNIT=ILUOUT,NML=NAM_BUDGET)
-! !
-! WRITE(UNIT=ILUOUT,FMT="('************ U BUDGET *************************')")
-! WRITE(UNIT=ILUOUT,NML=NAM_BU_RU)
-! !
-! WRITE(UNIT=ILUOUT,FMT="('************ V BUDGET *************************')")
-! WRITE(UNIT=ILUOUT,NML=NAM_BU_RV)
-! !
-! WRITE(UNIT=ILUOUT,FMT="('************ W BUDGET *************************')")
-! WRITE(UNIT=ILUOUT,NML=NAM_BU_RW)
-! !
-! WRITE(UNIT=ILUOUT,FMT="('************ TH BUDGET ************************')")
-! WRITE(UNIT=ILUOUT,NML=NAM_BU_RTH)
-! !
-! WRITE(UNIT=ILUOUT,FMT="('************ TKE BUDGET ***********************')")
-! WRITE(UNIT=ILUOUT,NML=NAM_BU_RTKE)
-! !
-! WRITE(UNIT=ILUOUT,FMT="('************ RV BUDGET ************************')")
-! WRITE(UNIT=ILUOUT,NML=NAM_BU_RRV)
-! !
-! WRITE(UNIT=ILUOUT,FMT="('************ RC BUDGET ************************')")
-! WRITE(UNIT=ILUOUT,NML=NAM_BU_RRC)
-! !
-! WRITE(UNIT=ILUOUT,FMT="('************ RR BUDGET ************************')")
-! WRITE(UNIT=ILUOUT,NML=NAM_BU_RRR)
-! !
-! WRITE(UNIT=ILUOUT,FMT="('************ RI BUDGET ************************')")
-! WRITE(UNIT=ILUOUT,NML=NAM_BU_RRI)
-! !
-! WRITE(UNIT=ILUOUT,FMT="('************ RS BUDGET ************************')")
-! WRITE(UNIT=ILUOUT,NML=NAM_BU_RRS)
-! !
-! WRITE(UNIT=ILUOUT,FMT="('************ RG BUDGET ************************')")
-! WRITE(UNIT=ILUOUT,NML=NAM_BU_RRG)
-! !
-! WRITE(UNIT=ILUOUT,FMT="('************ RH BUDGET ************************')")
-! WRITE(UNIT=ILUOUT,NML=NAM_BU_RRH)
-! !
-! WRITE(UNIT=ILUOUT,FMT="('************ SVx BUDGET ***********************')")
-! WRITE(UNIT=ILUOUT,NML=NAM_BU_RSV)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ LES ******************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_LES)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ PDF ******************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_PDF)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ FORCING **************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_FRC)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ ORILAM SCHEME ********************')")
- WRITE(UNIT=ILUOUT,NML=NAM_CH_ORILAM)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ SALT SCHEME **********************')")
- WRITE(UNIT=ILUOUT,NML=NAM_SALT)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ DUST SCHEME **********************')")
- WRITE(UNIT=ILUOUT,NML=NAM_DUST)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ PASSIVE POLLUTANT ***************')")
- WRITE(UNIT=ILUOUT,NML=NAM_PASPOL)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ VISCOSITY ***************')")
- WRITE(UNIT=ILUOUT,NML=NAM_VISC)
-!
-#ifdef MNH_FOREFIRE
- WRITE(UNIT=ILUOUT,FMT="('************ FOREFIRE ***************')")
- WRITE(UNIT=ILUOUT,NML=NAM_FOREFIRE)
-!
-#endif
-!
- WRITE(UNIT=ILUOUT,FMT="('************ CONDITIONAL SAMPLING *************')")
- WRITE(UNIT=ILUOUT,NML=NAM_CONDSAMP)
- !
- WRITE(UNIT=ILUOUT,FMT="('********** BLOWING SNOW SCHEME******************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BLOWSNOW)
-!
- IF( CCLOUD == 'C2R2' ) THEN
- WRITE(UNIT=ILUOUT,FMT="('************ C2R2 SCHEME **********************')")
- WRITE(UNIT=ILUOUT,NML=NAM_PARAM_C2R2)
- END IF
-!
- IF( CCLOUD == 'KHKO' ) THEN !modif
- WRITE(UNIT=ILUOUT,FMT="('************ KHKO SCHEME **********************')")
- WRITE(UNIT=ILUOUT,NML=NAM_PARAM_C2R2)
- END IF
-!
- IF( CCLOUD == 'C3R5' ) THEN
- WRITE(UNIT=ILUOUT,FMT="('************ C3R5 SCHEME **********************')")
- WRITE(UNIT=ILUOUT,NML=NAM_PARAM_C2R2)
- WRITE(UNIT=ILUOUT,NML=NAM_PARAM_C1R3)
- END IF
-!
- IF( CCLOUD == 'LIMA' ) THEN
- WRITE(UNIT=ILUOUT,FMT="('************ LIMA SCHEME **********************')")
- CALL PARAM_LIMA_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
- END IF
-!
- IF (CELEC /= 'NONE') THEN
- WRITE(UNIT=ILUOUT,FMT="('************ ELEC SCHEME **********************')")
- WRITE(UNIT=ILUOUT,NML=NAM_ELEC)
- END IF
-!
- END IF
-!
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE READ_DESFM_n
diff --git a/src/mesonh/ext/read_exsegn.f90 b/src/mesonh/ext/read_exsegn.f90
deleted file mode 100644
index dfb02a2dc0931de75a7fef446a8576081aa97087..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/read_exsegn.f90
+++ /dev/null
@@ -1,3033 +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 MODD_PARAM_ICE_n, ONLY : PARAM_ICEN_INIT, PARAM_ICEN, CSUBG_AUCV_RC, CSUBG_AUCV_RI
-USE MODN_PARAM_KAFR_n
-USE MODD_PARAM_LIMA, ONLY : FINI_CCN=>HINI_CCN,PARAM_LIMA_INIT,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 MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALLN_INIT
-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 MODD_TURB_n, ONLY: TURBN_INIT, CTOM, CTURBDIM, LRMC01, LHARAT, &
- LCLOUDMODIFLM, CTURBLEN_CLOUD, XCEI_MIN, XCEI_MAX
-USE MODD_NEB_n, ONLY: NEBN_INIT, LSIGMAS, LSUBG_COND, CCONDENS, LSTATNW
-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_LBCN
-CALL INIT_NAM_NUDGINGN
-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 PARAM_MFSHALLN_INIT(CPROGRAM, ILUSEG, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
-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 TURBN_INIT(CPROGRAM, ILUSEG, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
-CALL NEBN_INIT(CPROGRAM, ILUSEG, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
-CALL PARAM_ICEN_INIT(CPROGRAM, ILUSEG, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
-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_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 PARAM_LIMA_INIT(CPROGRAM, ILUSEG, .FALSE., ILUOUT, .FALSE., .TRUE., .FALSE., 0)
- 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_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 TURBN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
-CALL NEBN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
-!
-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 PARAM_MFSHALLN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
-!
-! The test on the CSOLVER name is made elsewhere
-!
-CALL PARAM_ICEN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
-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 PARAM_LIMA_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .TRUE., 0)
-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
-! Consistency checks between phyex modules
-IF ((CSUBG_AUCV_RC == 'ADJU' .OR. CSUBG_AUCV_RI == 'ADJU') .AND. CCONDENS /= 'GAUS') THEN
- CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'READ_EXSEGN', &
- &"CSUBG_AUCV_RC and/or CSUBG_AUCV_RI cannot be 'ADJU' if CCONDENS is not 'GAUS'")
-ENDIF
-IF (.NOT. LHARAT .AND. LSTATNW) THEN
- CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'READ_EXSEGN', &
- &'LSTATNW only tested in combination with HARATU and EDMFm!')
-ENDIF
-!
-!-------------------------------------------------------------------------------!
-!* 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_RC == '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_RC = '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_RC == '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_RC IS PUT TO "NONE"'
-!
- CSUBG_AUCV_RC = '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_RC == '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_RC 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_RC == '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_RC is SET to NONE'
- CSUBG_AUCV_RC='NONE'
- END IF
-!
- IF (CSUBG_AUCV_RC == '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_RC is SET to NONE'
- CSUBG_AUCV_RC='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_RC /= '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_RC is SET to NONE'
- CSUBG_AUCV_RC='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 (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
-!
-!
-!* 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(LCLOUDMODIFLM .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=", &
- & ", 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_LBCN
-CALL UPDATE_NAM_NUDGINGN
-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/read_field.f90 b/src/mesonh/ext/read_field.f90
deleted file mode 100644
index d86c67557c62c692ede13db25b29122ca62055f1..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/read_field.f90
+++ /dev/null
@@ -1,1700 +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_FIELD
-! ######################
-!
-INTERFACE
-!
- SUBROUTINE READ_FIELD(KOCEMI,TPINIFILE,KIU,KJU,KKU, &
- HGETTKET,HGETRVT,HGETRCT,HGETRRT,HGETRIT,HGETCIT,HGETZWS, &
- HGETRST,HGETRGT,HGETRHT,HGETSVT,HGETSRCT,HGETSIGS,HGETCLDFR,HGETICEFR, &
- HGETBL_DEPTH,HGETSBL_DEPTH,HGETPHC,HGETPHR,HUVW_ADV_SCHEME, &
- HTEMP_SCHEME,KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, &
- KSIZELBXTKE_ll,KSIZELBYTKE_ll, &
- KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, &
- PUM,PVM,PWM,PDUM,PDVM,PDWM, &
- PUT,PVT,PWT,PTHT,PPABST,PTKET,PRTKEMS, &
- PRT,PSVT,PZWS,PCIT,PDRYMASST,PDRYMASSS, &
- PSIGS,PSRCT,PCLDFR,PICEFR,PBL_DEPTH,PSBL_DEPTH,PWTHVMF,PPHC,PPHR, &
- PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM, PLSZWSM, &
- PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
- PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
- KFRC,TPDTFRC,PUFRC,PVFRC,PWFRC,PTHFRC,PRVFRC, &
- PTENDTHFRC,PTENDRVFRC,PGXTHFRC,PGYTHFRC,PPGROUNDFRC,PATC, &
- PTENDUFRC,PTENDVFRC, &
- KADVFRC,TPDTADVFRC,PDTHFRC,PDRVFRC, &
- KRELFRC,TPDTRELFRC, PTHREL, PRVREL, &
- PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M, &
- PRUS_PRES,PRVS_PRES,PRWS_PRES,PRTHS_CLD,PRRS_CLD,PRSVS_CLD, &
- PIBM_LSF,PIBM_XMUT,PUMEANW,PVMEANW,PWMEANW,PUMEANN,PVMEANN, &
- PWMEANN,PUMEANE,PVMEANE,PWMEANE,PUMEANS,PVMEANS,PWMEANS, &
- PLSPHI,PBMAP,PFMASE,PFMAWC,PFMWINDU,PFMWINDV,PFMWINDW,PFMHWS )
-!
-USE MODD_IO, ONLY : TFILEDATA
-USE MODD_TIME ! for type DATE_TIME
-!
-!
-INTEGER, INTENT(IN) :: KOCEMI !Ocan model index
-TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE !Initial file
-INTEGER, INTENT(IN) :: KIU, KJU, KKU
- ! array sizes in x, y and z directions
-!
-CHARACTER (LEN=*), INTENT(IN) :: HGETTKET, &
- HGETRVT,HGETRCT,HGETRRT, &
- HGETRIT,HGETRST,HGETRGT,HGETRHT, &
- HGETCIT,HGETSRCT, HGETZWS, &
- HGETSIGS, HGETCLDFR, HGETICEFR, &
- HGETBL_DEPTH, HGETSBL_DEPTH, &
- HGETPHC, HGETPHR
-CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVT
-!
-! GET indicators to know wether a given variable should or not be read in the
-! FM file at time t-deltat and t
-CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME ! advection scheme for wind
-CHARACTER(LEN=4), INTENT(IN) :: HTEMP_SCHEME ! advection scheme for wind
-!
-! sizes of the West-east total LB area
-INTEGER, INTENT(IN) :: KSIZELBX_ll,KSIZELBXU_ll ! for T,V,W and u
-INTEGER, INTENT(IN) :: KSIZELBXTKE_ll ! for TKE
-INTEGER, INTENT(IN) :: KSIZELBXR_ll,KSIZELBXSV_ll ! for Rx and SV
-! sizes of the North-south total LB area
-INTEGER, INTENT(IN) :: KSIZELBY_ll,KSIZELBYV_ll ! for T,U,W and v
-INTEGER, INTENT(IN) :: KSIZELBYTKE_ll ! for TKE
-INTEGER, INTENT(IN) :: KSIZELBYR_ll,KSIZELBYSV_ll ! for Rx and SV
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PUM,PVM,PWM ! U,V,W at t-dt
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDUM,PDVM,PDWM ! Difference on U,V,W
- ! between t+dt and t-dt
-REAL, DIMENSION(:,:), INTENT(OUT) :: PBL_DEPTH ! BL depth
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSBL_DEPTH ! SBL depth
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTHVMF ! MassFlux buoyancy flux
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PUT,PVT,PWT ! U,V,W at t
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHT,PTKET ! theta, tke and
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRTKEMS ! tke adv source
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPABST ! pressure at t
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRT,PSVT ! moist and scalar
- ! variables at t
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PZWS
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCT ! turbulent flux
- ! <s'Rc'> at t
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCIT ! ice conc. at t
-REAL, INTENT(OUT) :: PDRYMASST ! Md(t)
-REAL, INTENT(OUT) :: PDRYMASSS ! d Md(t) / dt
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS ! =sqrt(<s's'>) for the
- ! Subgrid Condensation
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PICEFR ! cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPHC ! pH value in cloud water
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPHR ! pH value in rainwater
-! Larger Scale fields
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSUM,PLSVM,PLSWM ! Wind
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSTHM, PLSRVM ! Mass
-! LB fields
-REAL, DIMENSION(:,:), INTENT(OUT) :: PLSZWSM ! significant height of sea waves
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXUM,PLBXVM,PLBXWM ! Wind
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXTHM ! Mass
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYUM,PLBYVM,PLBYWM ! Wind
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYTHM ! Mass
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXTKEM ! TKE
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYTKEM
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PLBXRM ,PLBXSVM ! Moisture and SV
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PLBYRM ,PLBYSVM ! in x and y-dir.
-! Forcing fields
-INTEGER, INTENT(IN) :: KFRC ! number of forcing
-TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TPDTFRC ! date of forcing profs.
-REAL, DIMENSION(:,:), INTENT(OUT) :: PUFRC,PVFRC,PWFRC ! forcing variables
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHFRC,PRVFRC
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTENDUFRC,PTENDVFRC
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTENDTHFRC,PTENDRVFRC,PGXTHFRC,PGYTHFRC
-REAL, DIMENSION(:), INTENT(OUT) :: PPGROUNDFRC
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PATC
-INTEGER, INTENT(IN) :: KADVFRC ! number of forcing
-TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TPDTADVFRC ! date of forcing profs.
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PDTHFRC, PDRVFRC
-INTEGER, INTENT(IN) :: KRELFRC ! number of forcing
-TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TPDTRELFRC ! date of forcing profs.
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PTHREL, PRVREL
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M ! Eddy fluxes
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS_PRES, PRVS_PRES, PRWS_PRES
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS_CLD
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS_CLD, PRSVS_CLD
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PIBM_LSF,PIBM_XMUT
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANW,PVMEANW,PWMEANW
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANN,PVMEANN,PWMEANN
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANE,PVMEANE,PWMEANE
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANS,PVMEANS,PWMEANS
-!
-! Fire Model fields
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSPHI ! Fire Model Level Set function Phi [-]
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBMAP ! Fire Model Burning map [s]
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMASE ! Fire Model Available Sensible Energy [J/m2]
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMAWC ! Fire Model Available Water Content [kg/m2]
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMWINDU ! Fire Model filtered u wind [m/s]
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMWINDV ! Fire Model filtered v wind [m/s]
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMWINDW ! Fire Model filtered w wind [m/s]
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMHWS ! Fire Model filtered horizontal wind speed [m/s]
-!
-END SUBROUTINE READ_FIELD
-!
-END INTERFACE
-!
-END MODULE MODI_READ_FIELD
-!
-! ########################################################################
- SUBROUTINE READ_FIELD(KOCEMI,TPINIFILE,KIU,KJU,KKU, &
- HGETTKET,HGETRVT,HGETRCT,HGETRRT,HGETRIT,HGETCIT,HGETZWS, &
- HGETRST,HGETRGT,HGETRHT,HGETSVT,HGETSRCT,HGETSIGS,HGETCLDFR,HGETICEFR, &
- HGETBL_DEPTH,HGETSBL_DEPTH,HGETPHC,HGETPHR,HUVW_ADV_SCHEME, &
- HTEMP_SCHEME,KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, &
- KSIZELBXTKE_ll,KSIZELBYTKE_ll, &
- KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, &
- PUM,PVM,PWM,PDUM,PDVM,PDWM, &
- PUT,PVT,PWT,PTHT,PPABST,PTKET,PRTKEMS, &
- PRT,PSVT,PZWS,PCIT,PDRYMASST,PDRYMASSS, &
- PSIGS,PSRCT,PCLDFR,PICEFR,PBL_DEPTH,PSBL_DEPTH,PWTHVMF,PPHC,PPHR, &
- PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,PLSZWSM, &
- PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
- PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
- KFRC,TPDTFRC,PUFRC,PVFRC,PWFRC,PTHFRC,PRVFRC, &
- PTENDTHFRC,PTENDRVFRC,PGXTHFRC,PGYTHFRC,PPGROUNDFRC,PATC, &
- PTENDUFRC,PTENDVFRC, &
- KADVFRC,TPDTADVFRC,PDTHFRC,PDRVFRC, &
- KRELFRC,TPDTRELFRC, PTHREL, PRVREL, &
- PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M, &
- PRUS_PRES,PRVS_PRES,PRWS_PRES,PRTHS_CLD,PRRS_CLD,PRSVS_CLD, &
- PIBM_LSF,PIBM_XMUT,PUMEANW,PVMEANW,PWMEANW,PUMEANN,PVMEANN, &
- PWMEANN,PUMEANE,PVMEANE,PWMEANE,PUMEANS,PVMEANS,PWMEANS, &
- PLSPHI,PBMAP,PFMASE,PFMAWC,PFMWINDU,PFMWINDV,PFMWINDW,PFMHWS )
-! ########################################################################
-!
-!!**** *READ_FIELD* - routine to read prognostic and surface fields
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to initialize prognostic and
-! surface fields by reading their value in initial file or by setting
-! them to a fixed value.
-!
-!!** METHOD
-!! ------
-!! According to the get indicators, the prognostics fields are :
-!! - initialized by reading their value in the LFIFM file
-!! if the corresponding indicators are equal to 'READ'
-!! - initialized to zero if the corresponding indicators
-!! are equal to 'INIT'
-!! - not initialized if their corresponding indicators
-!! are equal to 'SKIP'
-!!
-!! In case of time step change, all fields at t-dt are (linearly)
-!! interpolated to get a consistant initial state before the segment
-!! integration
-!!
-!! EXTERNAL
-!! --------
-!! FMREAD : to read data in LFIFM file
-!! INI_LS : to initialize larger scale fields
-!! INI_LB : to initialize "2D" surfacic LB fields
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CONF : NVERB,CCONF,CPROGRAM
-!!
-!! Module MODD_CTURB : XTKEMIN
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of the documentation (routine READ_FIELD)
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Ducrocq * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 15/06/94
-!! modification 22/11/94 add the pressure function (J.Stein)
-!! modification 22/11/94 add the LS fields (J.Stein)
-!! modification 06/01/95 add Md(t) (J.P.Lafore)
-!! 26/03/95 add EPS var (J. Cuxart)
-!! 30/06/95 add var related to the Subgrid condensation
-!! (J.Stein)
-!! 18/08/95 time step change case (J.P.Lafore)
-!! 01/03/96 add the cloud fraction (J. Stein)
-!! modification 13/12/95 add fmread of the forcing variables
-!! (M.Georgelin)
-!! modification 13/02/96 external control of the forcing (J.-P. Pinty)
-!! 11/04/96 add the ice concentration (J.-P. Pinty)
-!! 27/01/97 read ISVR 3D fields of SV (J.-P. Pinty)
-!! 26/02/97 "surfacic" LS fieds introduction (J.P.Lafore)
-!! (V MASSON) 03/03/97 positivity control for time step change
-!! 10/04/97 proper treatment of minima for LS-fields (J.P.Lafore)
-!! J. Stein 22/06/97 use the absolute pressure
-!! J. Stein 22/10/97 cleaning + add the LB fields for u,v,w,theta,Rv
-!! P. Bechtold 22/01/98 add SST and surface pressure forcing
-!! V. Ducrocq 14/08/98 //, remove KIINF,KJINF,KISUP,KJSUP,
-!! and introduce INI_LS and INI_LB
-!! J. Stein 22/01/99 add the reading of STORAGE_TYPE to improve
-!! the START case when the file contains 2
-!! instants MT
-!! D. Gazen 22/01/01 use MODD_NSV to handle NSV floating indices
-!! for the current model
-!! V. Masson 01/2004 removes surface (externalization)
-!! J.-P. Pinty 06/05/04 treat NSV_* for C1R3 and ELEC
-!! 05/06 Remove EPS
-!! M. Leriche 04/10 add pH in cloud water and rainwater
-!! M. Leriche 07/10 treat NSV_* for ice phase chemical species
-!! C.Lac 11/11 Suppress all the t-Dt fields
-!! M.Tomasini,
-!! P. Peyrille 06/12 2D west african monsoon : add reading of ADV forcing and addy fluxes
-!! C.Lac 03/13 add prognostic supersaturation for C2R2/KHKO
-!! Bosseur & Filippi 07/13 Adds Forefire
-!! M. Leriche 11/14 correct bug in pH initialization
-!! C.Lac 12/14 correction for reproducibility START/RESTA
-!! Modification 01/2016 (JP Pinty) Add LIMA
-!! M. Leriche 02/16 treat gas and aq. chemicals separately
-!! C.Lac 10/16 CEN4TH with RKC4 + Correction on RK loop
-!! 09/2017 Q.Rodier add LTEND_UV_FRC
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! V. Vionnet 07/17: add blowing snow scheme
-! P. Wautelet 01/2019: corrected intent of PDUM,PDVM,PDWM (OUT->INOUT)
-! P. Wautelet 13/02/2019: removed PPABSM and PTSTEP dummy arguments (bugfix: PPABSM was intent(OUT))
-! S. Bielli 02/2019: Sea salt : significant sea wave height influences salt emission; 5 salt modes
-! P. Wautelet 14/03/2019: correct ZWS when variable not present in file
-! M. Leriche 10/06/2019: in restart case read all immersion modes for LIMA
-! B. Vie 06/2020: Add prognostic supersaturation for LIMA
-! F. Auguste 02/2021: add fields necessary for IBM
-! T. Nagel 02/2021: add fields necessary for turbulence recycling
-! JL. Redelsperger 03/2021: add necessary variables for Ocean LES case
-! A. Costes 12/2021: add Blaze fire model
-! P. Wautelet 04/02/2022: use TSVLIST to manage metadata of scalar variables
-!!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_2D_FRC, ONLY: L2D_ADV_FRC, L2D_REL_FRC
-USE MODD_ADV_n, ONLY: CTEMP_SCHEME, LSPLIT_CFL
-USE MODD_BLOWSNOW_n, ONLY: XSNWCANO
-USE MODD_CONF, ONLY: CCONF, CPROGRAM, L1D, LFORCING, NVERB
-USE MODD_CONF_n, ONLY: IDX_RVT, IDX_RCT, IDX_RRT, IDX_RIT, IDX_RST, IDX_RGT, IDX_RHT
-USE MODD_CST, ONLY: XALPW, XBETAW, XCPD, XGAMW, XMD, XMV, XP00, XRD
-USE MODD_TURB_n, ONLY: XTKEMIN
-USE MODD_DYN_n, ONLY: LOCEAN
-use modd_field, only: tfieldmetadata, tfieldlist, NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED, &
- TYPEDATE, TYPEREAL, TYPELOG, TYPEINT
-USE MODD_FIELD_n, only: XZWS_DEFAULT
-USE MODD_FIRE_n, ONLY: CWINDFILTER, LBLAZE, LRESTA_ASE, LRESTA_AWC, LRESTA_EWAM, LRESTA_WLIM, LWINDFILTER
-USE MODD_IBM_PARAM_n, ONLY: LIBM
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LATZ_EDFLX, ONLY: LTH_FLX, LUV_FLX
-USE MODD_LUNIT_N, ONLY: TLUOUT
-USE MODD_NSV, ONLY: NSV, NSV_C2R2BEG, NSV_C2R2END, NSV_CSBEG, NSV_CSEND, &
-#ifdef MNH_FOREFIRE
- NSV_FFBEG, NSV_FFEND, &
-#endif
- NSV_PPBEG, NSV_PPEND, NSV_SNW, NSV_USER, TSVLIST
-USE MODD_OCEANH, ONLY: NFRCLT, NINFRT, XSSOLA_T, XSSUFL_T, XSSTFL_T, XSSVFL_T
-USE MODD_PARAM_C2R2, ONLY: LSUPSAT
-USE MODD_PARAMETERS, ONLY: XUNDEF
-USE MODD_PARAM_n, ONLY: CSCONV
-USE MODD_RECYCL_PARAM_n, ONLY: LRECYCLE, LRECYCLN, LRECYCLS, LRECYCLW, NR_COUNT
-USE MODD_REF, ONLY: LCOUPLES
-USE MODD_TIME, ONLY: DATE_TIME
-!
-use mode_field, only: Find_field_id_from_mnhname
-USE MODE_IO_FIELD_READ, only: IO_Field_read
-USE MODE_MSG
-USE MODE_TOOLS, ONLY: UPCASE
-!
-USE MODI_INI_LB
-USE MODI_INI_LS
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-INTEGER, INTENT(IN) :: KOCEMI !Ocan model index
-TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE !Initial file
-INTEGER, INTENT(IN) :: KIU, KJU, KKU
- ! array sizes in x, y and z directions
-!
-CHARACTER (LEN=*), INTENT(IN) :: HGETTKET, &
- HGETRVT,HGETRCT,HGETRRT, &
- HGETRIT,HGETRST,HGETRGT,HGETRHT, &
- HGETCIT,HGETSRCT, HGETZWS, &
- HGETSIGS, HGETCLDFR, HGETICEFR, &
- HGETBL_DEPTH, HGETSBL_DEPTH, &
- HGETPHC, HGETPHR
-CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVT
-!
-! GET indicators to know wether a given variable should or not be read in the
-! FM file at time t-deltat and t
-!
-CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME ! advection scheme for wind
-CHARACTER(LEN=4), INTENT(IN) :: HTEMP_SCHEME ! advection scheme for wind
-!
-! sizes of the West-east total LB area
-INTEGER, INTENT(IN) :: KSIZELBX_ll,KSIZELBXU_ll ! for T,V,W and u
-INTEGER, INTENT(IN) :: KSIZELBXTKE_ll ! for TKE
-INTEGER, INTENT(IN) :: KSIZELBXR_ll,KSIZELBXSV_ll ! for Rx and SV
-! sizes of the North-south total LB area
-INTEGER, INTENT(IN) :: KSIZELBY_ll,KSIZELBYV_ll ! for T,U,W and v
-INTEGER, INTENT(IN) :: KSIZELBYTKE_ll ! for TKE
-INTEGER, INTENT(IN) :: KSIZELBYR_ll,KSIZELBYSV_ll ! for Rx and SV
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PUM,PVM,PWM ! U,V,W at t-dt
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDUM,PDVM,PDWM ! Difference on U,V,W
- ! between t+dt and t-dt
-REAL, DIMENSION(:,:), INTENT(OUT) :: PBL_DEPTH ! BL depth
-REAL, DIMENSION(:,:), INTENT(OUT) :: PSBL_DEPTH ! SBL depth
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTHVMF ! MassFlux buoyancy flux
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PUT,PVT,PWT ! U,V,W at t
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHT,PTKET ! theta, tke and
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRTKEMS ! tke adv source
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPABST ! pressure at t
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRT,PSVT ! moist and scalar
- ! variables at t
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PZWS
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCT ! turbulent flux
- ! <s'Rc'> at t
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCIT ! ice conc. at t
-REAL, INTENT(OUT) :: PDRYMASST ! Md(t)
-REAL, INTENT(OUT) :: PDRYMASSS ! d Md(t) / dt
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS ! =sqrt(<s's'>) for the
- ! Subgrid Condensation
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PICEFR ! cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPHC ! pH value in cloud water
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPHR ! pH value in rainwater
-!
-!
-! Larger Scale fields
-REAL, DIMENSION(:,:), INTENT(OUT) :: PLSZWSM ! significant height of sea waves
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSUM,PLSVM,PLSWM ! Wind
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSTHM, PLSRVM ! Mass
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXUM,PLBXVM,PLBXWM ! Wind
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXTHM ! Mass
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYUM,PLBYVM,PLBYWM ! Wind
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYTHM ! Mass
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXTKEM ! TKE
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYTKEM
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PLBXRM ,PLBXSVM ! Moisture and SV
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PLBYRM ,PLBYSVM ! in x and y-dir.
-!
-!
-! Forcing fields
-INTEGER, INTENT(IN) :: KFRC ! number of forcing
-TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TPDTFRC ! date of forcing profs.
-REAL, DIMENSION(:,:), INTENT(OUT) :: PUFRC,PVFRC,PWFRC ! forcing variables
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHFRC,PRVFRC
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTENDUFRC,PTENDVFRC
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTENDTHFRC,PTENDRVFRC,PGXTHFRC,PGYTHFRC
-REAL, DIMENSION(:), INTENT(OUT) :: PPGROUNDFRC
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PATC
-INTEGER, INTENT(IN) :: KADVFRC ! number of forcing
-TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TPDTADVFRC ! date of forcing profs.
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PDTHFRC, PDRVFRC
-INTEGER, INTENT(IN) :: KRELFRC ! number of forcing
-TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TPDTRELFRC ! date of forcing profs.
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PTHREL, PRVREL
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M ! Eddy fluxes
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS_PRES, PRVS_PRES, PRWS_PRES
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS_CLD
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS_CLD, PRSVS_CLD
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PIBM_LSF ! LSF for IBM
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PIBM_XMUT ! Turbulent viscosity
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANW,PVMEANW,PWMEANW ! Velocity average at West boundary
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANN,PVMEANN,PWMEANN ! Velocity average at North boundary
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANE,PVMEANE,PWMEANE ! Velocity average at East boundary
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANS,PVMEANS,PWMEANS ! Velocity average at South boundary
-! Fire Model fields
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSPHI ! Fire Model Level Set function Phi [-]
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBMAP ! Fire Model Burning map [s]
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMASE ! Fire Model Available Sensible Energy [J/m2]
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMAWC ! Fire Model Available Water Content [kg/m2]
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMWINDU ! Fire Model filtered u wind [m/s]
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMWINDV ! Fire Model filtered v wind [m/s]
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMWINDW ! Fire Model filtered v wind [m/s]
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFMHWS ! Fire Model filtered horizontal wind speed [m/s]
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: IID
-INTEGER :: ILUOUT ! Unit number for prints
-INTEGER :: IRESP
-INTEGER :: ISV ! total number of scalar variables
-INTEGER :: JSV ! Loop index for additional scalar variables
-INTEGER :: JKLOOP,JRR ! Loop indexes
-INTEGER :: IIUP,IJUP ! size of working window arrays
-INTEGER :: JT ! loop index
-LOGICAL :: GLSOURCE ! switch for the source term (for ini_ls and ini_lb)
-LOGICAL :: ZLRECYCL ! switch if turbulence recycling is activated
-LOGICAL :: GOLDFILEFORMAT
-CHARACTER(LEN=3) :: YFRC ! To mark the different forcing dates
-CHARACTER(LEN=3) :: YNUM3
-CHARACTER(LEN=15) :: YVAL
-REAL, DIMENSION(KIU,KJU,KKU) :: ZWORK ! to compute supersaturation
-TYPE(TFIELDMETADATA) :: TZFIELD
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. INITIALIZATION
-! ---------------
-!
-GLSOURCE=.FALSE.
-ZWORK = 0.0
-!
-!If TPINIFILE file was written with a MesoNH version < 5.6, some variables had different names or were not available
-GOLDFILEFORMAT = ( TPINIFILE%NMNHVERSION(1) < 5 &
- .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) < 6 ) )
-!-------------------------------------------------------------------------------
-!
-!* 2. READ PROGNOSTIC VARIABLES
-! -------------------------
-!
-!* 2.1 Time t:
-!
-IF (TPINIFILE%NMNHVERSION(1)<5) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('UT',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CMNHNAME = 'UM'
- CALL IO_Field_read(TPINIFILE,TZFIELD,PUT)
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME('VT',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CMNHNAME = 'VM'
- CALL IO_Field_read(TPINIFILE,TZFIELD,PVT)
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME('WT',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CMNHNAME = 'WM'
- CALL IO_Field_read(TPINIFILE,TZFIELD,PWT)
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME('THT',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CMNHNAME = 'THM'
- CALL IO_Field_read(TPINIFILE,TZFIELD,PTHT)
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME('PABST',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CMNHNAME = 'PABSM'
- CALL IO_Field_read(TPINIFILE,TZFIELD,PPABST)
-ELSE
- CALL IO_Field_read(TPINIFILE,'UT',PUT)
- CALL IO_Field_read(TPINIFILE,'VT',PVT)
- CALL IO_Field_read(TPINIFILE,'WT',PWT)
- CALL IO_Field_read(TPINIFILE,'THT',PTHT)
- CALL IO_Field_read(TPINIFILE,'PABST',PPABST)
-ENDIF
-!
-SELECT CASE(HGETTKET)
- CASE('READ')
- IF (TPINIFILE%NMNHVERSION(1)<5) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('TKET',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CMNHNAME = 'TKEM'
- CALL IO_Field_read(TPINIFILE,TZFIELD,PTKET)
- ELSE
- CALL IO_Field_read(TPINIFILE,'TKET',PTKET)
- END IF
- IF ( ( (TPINIFILE%NMNHVERSION(1)==5 .AND. TPINIFILE%NMNHVERSION(2)>0) .OR. TPINIFILE%NMNHVERSION(1)>5 ) &
- .AND. (CCONF == 'RESTA') .AND. LSPLIT_CFL) THEN
- CALL IO_Field_read(TPINIFILE,'TKEMS',PRTKEMS)
- END IF
- CASE('INIT')
- PTKET(:,:,:) = XTKEMIN
- PRTKEMS(:,:,:) = 0.
-END SELECT
-!
-SELECT CASE(HGETZWS)
- CASE('READ')
- CALL IO_Field_read(TPINIFILE,'ZWS',PZWS,IRESP)
- !If the field ZWS is not in the file, set its value to XZWS_DEFAULT
- !ZWS is present in files since MesoNH 5.4.2
- IF ( IRESP/=0 ) THEN
- WRITE (YVAL,'( E15.8 )') XZWS_DEFAULT
- CALL PRINT_MSG(NVERB_WARNING,'IO','READ_FIELD','ZWS not found in file: using default value: '//TRIM(YVAL)//' m')
- PZWS(:,:) = XZWS_DEFAULT
- END IF
-
- CASE('INIT')
- PZWS(:,:)=0.
-END SELECT
-!
-SELECT CASE(HGETRVT) ! vapor
- CASE('READ')
- IF (TPINIFILE%NMNHVERSION(1)<5) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('RVT',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CMNHNAME = 'RVM'
- CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RVT))
- ELSE
- CALL IO_Field_read(TPINIFILE,'RVT',PRT(:,:,:,IDX_RVT))
- END IF
- CASE('INIT')
- PRT(:,:,:,IDX_RVT) = 0.
-END SELECT
-!
-SELECT CASE(HGETRCT) ! cloud
- CASE('READ')
- IF (TPINIFILE%NMNHVERSION(1)<5) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('RCT',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CMNHNAME = 'RCM'
- CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RCT))
- ELSE
- CALL IO_Field_read(TPINIFILE,'RCT',PRT(:,:,:,IDX_RCT))
- END IF
- CASE('INIT')
- PRT(:,:,:,IDX_RCT) = 0.
-END SELECT
-!
-SELECT CASE(HGETRRT) ! rain
- CASE('READ')
- IF (TPINIFILE%NMNHVERSION(1)<5) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('RRT',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CMNHNAME = 'RRM'
- CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RRT))
- ELSE
- CALL IO_Field_read(TPINIFILE,'RRT',PRT(:,:,:,IDX_RRT))
- END IF
- CASE('INIT')
- PRT(:,:,:,IDX_RRT) = 0.
-END SELECT
-!
-SELECT CASE(HGETRIT) ! cloud ice
- CASE('READ')
- IF (TPINIFILE%NMNHVERSION(1)<5) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('RIT',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CMNHNAME = 'RIM'
- CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RIT))
- ELSE
- CALL IO_Field_read(TPINIFILE,'RIT',PRT(:,:,:,IDX_RIT))
- END IF
- CASE('INIT')
- PRT(:,:,:,IDX_RIT) = 0.
-END SELECT
-!
-SELECT CASE(HGETRST) ! snow
- CASE('READ')
- IF (TPINIFILE%NMNHVERSION(1)<5) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('RST',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CMNHNAME = 'RSM'
- CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RST))
- ELSE
- CALL IO_Field_read(TPINIFILE,'RST',PRT(:,:,:,IDX_RST))
- END IF
- CASE('INIT')
- PRT(:,:,:,IDX_RST) = 0.
-END SELECT
-!
-SELECT CASE(HGETRGT) ! graupel
- CASE('READ')
- IF (TPINIFILE%NMNHVERSION(1)<5) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('RGT',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CMNHNAME = 'RGM'
- CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RGT))
- ELSE
- CALL IO_Field_read(TPINIFILE,'RGT',PRT(:,:,:,IDX_RGT))
- END IF
- CASE('INIT')
- PRT(:,:,:,IDX_RGT) = 0.
-END SELECT
-!
-SELECT CASE(HGETRHT) ! hail
- CASE('READ')
- IF (TPINIFILE%NMNHVERSION(1)<5) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('RHT',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CMNHNAME = 'RHM'
- CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RHT))
- ELSE
- CALL IO_Field_read(TPINIFILE,'RHT',PRT(:,:,:,IDX_RHT))
- END IF
- CASE('INIT')
- PRT(:,:,:,IDX_RHT) = 0.
-END SELECT
-!
-SELECT CASE(HGETCIT) ! ice concentration
- CASE('READ')
- IF (SIZE(PCIT) /= 0 ) CALL IO_Field_read(TPINIFILE,'CIT',PCIT)
- CASE('INIT')
- PCIT(:,:,:)=0.
-END SELECT
-!
-IF (LIBM .AND. CPROGRAM=='MESONH') THEN
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'LSFP', &
- CLONGNAME = 'LSFP', &
- CSTDNAME = '', &
- CUNITS = 'm', &
- CDIR = 'XY', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- !
- CALL IO_Field_read(TPINIFILE,TZFIELD,PIBM_LSF)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'XMUT', &
- CLONGNAME = 'XMUT', &
- CSTDNAME = '', &
- CUNITS = 'm2 s-1', &
- CDIR = 'XY', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- !
- CALL IO_Field_read(TPINIFILE,TZFIELD,PIBM_XMUT)
- !
-ENDIF
-!
-TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'RECYCLING', &
- CLONGNAME = 'RECYCLING', &
- CSTDNAME = '', &
- CUNITS = '', &
- CDIR = '--', &
- CCOMMENT = '', &
- NGRID = 1, &
- NTYPE = TYPELOG, &
- NDIMS = 0, &
- LTIMEDEP = .FALSE. )
-CALL IO_Field_read(TPINIFILE,TZFIELD,ZLRECYCL,IRESP)
-!If field not found (file from older version of MesoNH) => set ZLRECYCL to false
-IF ( IRESP /= 0 ) ZLRECYCL = .FALSE.
-
-IF (ZLRECYCL) THEN
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'RCOUNT', &
- CLONGNAME = 'RCOUNT', &
- CSTDNAME = '', &
- CUNITS = '', &
- CDIR = '--', &
- NGRID = 1, &
- NTYPE = TYPEINT, &
- NDIMS = 0, &
- LTIMEDEP = .TRUE., &
- CCOMMENT = 'Incremental counter for averaging purpose' )
- CALL IO_Field_read(TPINIFILE,TZFIELD,NR_COUNT)
- !
- IF (NR_COUNT .NE. 0) THEN
- IF (LRECYCLW) THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'URECYCLW', &
- CLONGNAME = 'URECYCLW', &
- CSTDNAME = '', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- NGRID = 2, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
- LTIMEDEP = .TRUE., &
- CCOMMENT = 'UMEAN-WEST side plan for recycling purpose' )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PUMEANW)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'VRECYCLW', &
- CLONGNAME = 'VRECYCLW', &
- CSTDNAME = '', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- NGRID = 3, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
- LTIMEDEP = .TRUE., &
- CCOMMENT = 'VMEAN-WEST side plan for recycling purpose' )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PVMEANW)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'WRECYCLW', &
- CLONGNAME = 'WRECYCLW', &
- CSTDNAME = '', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- NGRID = 4, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
- LTIMEDEP = .TRUE., &
- CCOMMENT = 'WMEAN-WEST side plan for recycling purpose' )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PWMEANW)
- !
- ENDIF
- IF (LRECYCLN) THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'URECYCLN', &
- CLONGNAME = 'URECYCLN', &
- CSTDNAME = '', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- NGRID = 2, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
- LTIMEDEP = .TRUE., &
- CCOMMENT = 'UMEAN-NORTH side plan for recycling purpose' )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PUMEANN)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'VRECYCLN', &
- CLONGNAME = 'VRECYCLN', &
- CSTDNAME = '', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- NGRID = 3, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
- LTIMEDEP = .TRUE., &
- CCOMMENT = 'VMEAN-NORTH side plan for recycling purpose' )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PVMEANN)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'WRECYCLN', &
- CLONGNAME = 'WRECYCLN', &
- CSTDNAME = '', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- NGRID = 4, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
- LTIMEDEP = .TRUE., &
- CCOMMENT = 'WMEAN-NORTH side plan for recycling purpose' )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PWMEANN)
- !
- ENDIF
- IF (LRECYCLE) THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'URECYCLE', &
- CLONGNAME = 'URECYCLE', &
- CSTDNAME = '', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- NGRID = 2, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
- LTIMEDEP = .TRUE., &
- CCOMMENT = 'UMEAN-EAST side plan for recycling purpose' )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PUMEANE)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'VRECYCLE', &
- CLONGNAME = 'VRECYCLE', &
- CSTDNAME = '', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- NGRID = 3, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
- LTIMEDEP = .TRUE., &
- CCOMMENT = 'VMEAN-EAST side plan for recycling purpose' )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PVMEANE)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'WRECYCLE', &
- CLONGNAME = 'WRECYCLE', &
- CSTDNAME = '', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- NGRID = 4, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
- LTIMEDEP = .TRUE., &
- CCOMMENT = 'WMEAN-EAST side plan for recycling purpose' )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PWMEANE)
- !
- ENDIF
- IF (LRECYCLS) THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'URECYCLS', &
- CLONGNAME = 'URECYCLS', &
- CSTDNAME = '', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- NGRID = 2, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
- LTIMEDEP = .TRUE., &
- CCOMMENT = 'UMEAN-SOUTH side plan for recycling purpose' )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PUMEANS)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'VRECYCLS', &
- CLONGNAME = 'VRECYCLS', &
- CSTDNAME = '', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- NGRID = 3, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
- LTIMEDEP = .TRUE., &
- CCOMMENT = 'VMEAN-SOUTH side plan for recycling purpose' )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PVMEANS)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'WRECYCLS', &
- CLONGNAME = 'WRECYCLS', &
- CSTDNAME = '', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- NGRID = 4, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
- LTIMEDEP = .TRUE., &
- CCOMMENT = 'WMEAN-SOUTH side plan for recycling purpose' )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PWMEANS)
- ENDIF
- ENDIF
-ENDIF
-
-! Blaze fire model
-IF (LBLAZE .AND. CCONF=='RESTA') THEN
- ! Blaze is not compliant with MNHVERSION(1)<5
- ! Blaze begins with MNH 5.3.1
- CALL IO_Field_read(TPINIFILE,'FMPHI',PLSPHI,IRESP)
- IF (IRESP /= 0) PLSPHI(:,:,:) = 0.
- CALL IO_Field_read(TPINIFILE,'FMBMAP',PBMAP,IRESP)
- IF (IRESP /= 0) PBMAP(:,:,:) = -1.
- CALL IO_Field_read(TPINIFILE,'FMASE',PFMASE,IRESP)
- IF(IRESP == 0) THEN
- ! flag for the use of restart value for ASE initialization
- LRESTA_ASE = .TRUE.
- ELSE
- CALL PRINT_MSG( NVERB_WARNING, 'IO', 'READ_FIELD', 'PFMASE set to 0' )
- PFMASE(:,:,:) = 0.
- END IF
- CALL IO_Field_read(TPINIFILE,'FMAWC',PFMAWC,IRESP)
- ! flag for the use of restart value for AWC initialization
- IF(IRESP == 0) THEN
- LRESTA_AWC = .TRUE.
- ELSE
- CALL PRINT_MSG( NVERB_WARNING, 'IO', 'READ_FIELD', 'PFMAWC set to 0' )
- PFMAWC(:,:,:) = 0.
- END IF
- ! read wind on fire grid if present
- IF (LWINDFILTER) THEN
- ! read in file only if wind filtering is required
- SELECT CASE(CWINDFILTER)
- CASE('EWAM')
- ! read u
- CALL IO_Field_read(TPINIFILE,'FMWINDU',PFMWINDU,IRESP)
- ! flag for EWAM filtered u wind
- IF(IRESP == 0) THEN
- LRESTA_EWAM = .TRUE.
- ELSE
- CALL PRINT_MSG( NVERB_WARNING, 'IO', 'READ_FIELD', 'PFMWINDU set to 0' )
- PFMWINDU(:,:,:) = 0.
- END IF
- ! read v
- CALL IO_Field_read(TPINIFILE,'FMWINDV',PFMWINDV,IRESP)
- ! flag for EWAM filtered v wind
- IF(IRESP == 0 .AND. LRESTA_EWAM) THEN
- ! u and v fields found
- LRESTA_EWAM = .TRUE.
- ELSE
- ! u or v fields NOT found
- LRESTA_EWAM = .FALSE.
- END IF
- IF (IRESP /= 0) THEN
- CALL PRINT_MSG( NVERB_WARNING, 'IO', 'READ_FIELD', 'PFMWINDV set to 0' )
- PFMWINDV(:,:,:) = 0.
- END IF
- ! read w
- CALL IO_Field_read(TPINIFILE,'FMWINDW',PFMWINDW,IRESP)
- ! flag for EWAM filtered w wind
- IF(IRESP == 0 .AND. LRESTA_EWAM) THEN
- ! u and v and w fields found
- LRESTA_EWAM = .TRUE.
- ELSE
- ! u or v or w fields NOT found
- LRESTA_EWAM = .FALSE.
- END IF
- IF (IRESP /= 0) THEN
- CALL PRINT_MSG( NVERB_WARNING, 'IO', 'READ_FIELD', 'PFMWINDW set to 0' )
- PFMWINDW(:,:,:) = 0.
- END IF
-
- CASE('WLIM')
- CALL IO_Field_read(TPINIFILE,'FMHWS',PFMHWS,IRESP)
- ! flag for WLIM filtered horizontal wind speed
- IF(IRESP == 0) THEN
- LRESTA_WLIM = .TRUE.
- ELSE
- CALL PRINT_MSG( NVERB_WARNING, 'IO', 'READ_FIELD', 'PFMHWS set to 0' )
- PFMHWS(:,:,:) = 0.
- END IF
- END SELECT
- END IF
-END IF
-!
-! Scalar Variables Reading : Users, C2R2, C1R3, LIMA, ELEC, Chemical SV
-!
-ISV= SIZE(PSVT,4)
-!
-DO JSV = 1, NSV ! initialize according to the get indicators
- SELECT CASE( HGETSVT(JSV) )
- CASE ('READ')
- TZFIELD = TSVLIST(JSV)
-
- IF ( GOLDFILEFORMAT ) THEN
- IF ( ( JSV >= 1 .AND. JSV <= NSV_USER ) .OR. &
- ( JSV >= NSV_PPBEG .AND. JSV <= NSV_PPEND ) .OR. &
-#ifdef MNH_FOREFIRE
- ( JSV >= NSV_FFBEG .AND. JSV <= NSV_FFEND ) .OR. &
-#endif
- ( JSV >= NSV_CSBEG .AND. JSV <= NSV_CSEND ) ) THEN
- !Some variables were written with an other name in MesoNH < 5.6
- WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'SVT',JSV
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CSTDNAME = ''
- TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
- ELSE
- !Scalar variables were written with a T suffix in older versions
- TZFIELD%CMNHNAME = TRIM( TZFIELD%CMNHNAME ) // 'T'
- TZFIELD%CLONGNAME = TRIM( TZFIELD%CLONGNAME ) // 'T'
- END IF
- END IF
-
- CALL IO_Field_read( TPINIFILE, TZFIELD, PSVT(:,:,:,JSV), IRESP )
-
- IF ( IRESP /= 0 ) THEN
- CALL PRINT_MSG( NVERB_WARNING, 'IO', 'READ_FIELD', 'PSVT set to 0 for ' // TRIM( TZFIELD%CMNHNAME ) )
- PSVT(:,:,:,JSV) = 0.
- END IF
-
- CASE ('INIT')
- PSVT(:,:,:,JSV) = 0.
-
- IF ( JSV == NSV_C2R2END ) THEN
- IF ( LSUPSAT .AND. (HGETRVT == 'READ') ) THEN
- ZWORK(:,:,:) = (PPABST(:,:,:)/XP00 )**(XRD/XCPD)
- ZWORK(:,:,:) = PTHT(:,:,:)*ZWORK(:,:,:)
- ZWORK(:,:,:) = EXP(XALPW-XBETAW/ZWORK(:,:,:)-XGAMW*LOG(ZWORK(:,:,:)))
- !rvsat
- ZWORK(:,:,:) = (XMV / XMD)*ZWORK(:,:,:)/(PPABST(:,:,:)-ZWORK(:,:,:))
- ZWORK(:,:,:) = PRT(:,:,:,IDX_RVT)/ZWORK(:,:,:)
- PSVT(:,:,:,NSV_C2R2END ) = ZWORK(:,:,:)
- END IF
- END IF
-
- END SELECT
-END DO
-
-DO JSV = NSV_PPBEG, NSV_PPEND
- SELECT CASE( HGETSVT(JSV) )
- CASE ('READ')
- WRITE( YNUM3, '( I3.3 )' ) JSV
-
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'ATC' // YNUM3, &
- CSTDNAME = '', &
- CLONGNAME = 'ATC' // YNUM3, &
- CCOMMENT = 'X_Y_Z_ATC' // YNUM3, &
- CUNITS = 'm-3', &
- CDIR = 'XY', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
-
- CALL IO_Field_read( TPINIFILE, TZFIELD, PATC(:,:,:,JSV-NSV_PPBEG+1), IRESP )
-
- IF ( IRESP /= 0 ) THEN
- PATC(:,:,:,JSV-NSV_PPBEG+1) = 0.
- ENDIF
-
- CASE ('INIT')
- PATC(:,:,:,JSV-NSV_PPBEG+1) = 0.
-
- END SELECT
-END DO
-
-IF ( NSV_SNW >= 1 ) THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'generic for SNOWCANO_M', &
- CUNITS = 'kg kg-1', &
- CDIR = 'XY', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- DO JSV = 1, NSV_SNW
- SELECT CASE(HGETSVT(JSV))
- CASE ('READ')
- WRITE(TZFIELD%CMNHNAME,'(A10,I3.3)')'SNOWCANO_M',JSV
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- WRITE(TZFIELD%CCOMMENT,'(A6,A8,I3.3)') 'X_Y_Z_','SNOWCANO',JSV
- CALL IO_Field_read( TPINIFILE, TZFIELD, XSNWCANO(:,:,JSV) )
- CASE ('INIT')
- XSNWCANO(:,:,JSV) = 0.
- END SELECT
- END DO
-END IF
-!
-IF (CCONF == 'RESTA') THEN
- IF (CTEMP_SCHEME/='LEFR') THEN
- CALL IO_Field_read(TPINIFILE,'US_PRES',PRUS_PRES)
- CALL IO_Field_read(TPINIFILE,'VS_PRES',PRVS_PRES)
- CALL IO_Field_read(TPINIFILE,'WS_PRES',PRWS_PRES)
- END IF
- IF (LSPLIT_CFL) THEN
- CALL IO_Field_read(TPINIFILE,'THS_CLD',PRTHS_CLD)
- DO JRR = 1, SIZE(PRT,4)
- SELECT CASE(JRR)
- CASE (1)
- CALL IO_Field_read(TPINIFILE,'RVS_CLD',PRRS_CLD(:,:,:,JRR))
- CASE (2)
- CALL IO_Field_read(TPINIFILE,'RCS_CLD',PRRS_CLD(:,:,:,JRR))
- CASE (3)
- CALL IO_Field_read(TPINIFILE,'RRS_CLD',PRRS_CLD(:,:,:,JRR))
- CASE (4)
- CALL IO_Field_read(TPINIFILE,'RIS_CLD',PRRS_CLD(:,:,:,JRR))
- CASE (5)
- CALL IO_Field_read(TPINIFILE,'RSS_CLD',PRRS_CLD(:,:,:,JRR))
- CASE (6)
- CALL IO_Field_read(TPINIFILE,'RGS_CLD',PRRS_CLD(:,:,:,JRR))
- CASE (7)
- CALL IO_Field_read(TPINIFILE,'RHS_CLD',PRRS_CLD(:,:,:,JRR))
- CASE DEFAULT
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_FIELD','PRT is too big')
- END SELECT
- END DO
- DO JSV = NSV_C2R2BEG,NSV_C2R2END
- IF (JSV == NSV_C2R2BEG ) THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'RSVS_CLD1', &
- CSTDNAME = '', &
- CLONGNAME = 'RSVS_CLD1', &
- CUNITS = '1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_RHS_CLD', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PRSVS_CLD(:,:,:,JSV))
- END IF
- IF (JSV == NSV_C2R2BEG ) THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'RSVS_CLD2', &
- CSTDNAME = '', &
- CLONGNAME = 'RSVS_CLD2', &
- CUNITS = '1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_RHS_CLD', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PRSVS_CLD(:,:,:,JSV))
- END IF
- END DO
- END IF
-END IF
-!
-!* 2.1 Time t-dt:
-!
-IF (CPROGRAM=='MESONH' .AND. HUVW_ADV_SCHEME(1:3)=='CEN' .AND. &
- HTEMP_SCHEME == 'LEFR' ) THEN
- IF (CCONF=='RESTA') THEN
- CALL IO_Field_read(TPINIFILE,'UM', PUM)
- CALL IO_Field_read(TPINIFILE,'VM', PVM)
- CALL IO_Field_read(TPINIFILE,'WM', PWM)
- CALL IO_Field_read(TPINIFILE,'DUM',PDUM)
- CALL IO_Field_read(TPINIFILE,'DVM',PDVM)
- CALL IO_Field_read(TPINIFILE,'DWM',PDWM)
- ELSE
- PUM = PUT
- PVM = PVT
- PWM = PWT
- END IF
-END IF
-!
-!* 2.2a 3D LS fields
-!
-!
-CALL INI_LS(TPINIFILE,HGETRVT,GLSOURCE,PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,PLSZWSM)
-!
-!
-!* 2.2b 2D "surfacic" LB fields
-!
-!
-CALL INI_LB(TPINIFILE,GLSOURCE,ISV, &
- KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, &
- KSIZELBXTKE_ll,KSIZELBYTKE_ll, &
- KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, &
- HGETTKET,HGETRVT,HGETRCT,HGETRRT,HGETRIT,HGETRST, &
- HGETRGT,HGETRHT,HGETSVT, &
- PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, &
- PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM )
-!
-!
-!* 2.3 Some special variables:
-!
-CALL IO_Field_read(TPINIFILE,'DRYMASST',PDRYMASST) ! dry mass
-IF (CCONF=='RESTA') THEN
- CALL IO_Field_read(TPINIFILE,'DRYMASSS',PDRYMASSS,IRESP) ! dry mass tendency
-
- ! DRYMASSS was not written in backup files before MesoNH 5.5.1
- IF ( IRESP /= 0 ) THEN
- CALL PRINT_MSG( NVERB_WARNING, 'IO', 'READ_FIELD', 'PDRYMASSS set to 0 for ' // TRIM( TZFIELD%CMNHNAME ) )
- PDRYMASSS = 0.
- END IF
-ELSE
- PDRYMASSS=XUNDEF ! should not be used
-END IF
-!
-SELECT CASE(HGETSRCT) ! turbulent flux SRC at time t
- CASE('READ')
- CALL IO_Field_read(TPINIFILE,'SRCT',PSRCT)
- CASE('INIT')
- PSRCT(:,:,:)=0.
-END SELECT
-!
-SELECT CASE(HGETSIGS) ! subgrid condensation
- CASE('READ')
- CALL IO_Field_read(TPINIFILE,'SIGS',PSIGS)
- CASE('INIT')
- PSIGS(:,:,:)=0.
-END SELECT
-!
-SELECT CASE(HGETPHC) ! pH in cloud water
- CASE('READ')
- CALL IO_Field_read(TPINIFILE,'PHC',PPHC)
- CASE('INIT')
- PPHC(:,:,:)=0.
-END SELECT
-!
-SELECT CASE(HGETPHR) ! pH in rainwater
- CASE('READ')
- CALL IO_Field_read(TPINIFILE,'PHR',PPHR)
- CASE('INIT')
- PPHR(:,:,:)=0.
-END SELECT
-!
-IRESP=0
-IF(HGETCLDFR=='READ') THEN ! cloud fraction
- CALL IO_Field_read(TPINIFILE,'CLDFR',PCLDFR,IRESP)
-ENDIF
-IF(HGETCLDFR=='INIT' .OR. IRESP /= 0) THEN
- IF(SIZE(PRT,4) > 3) THEN
- WHERE(PRT(:,:,:,2)+PRT(:,:,:,4) > 1.E-30)
- PCLDFR(:,:,:) = 1.
- ELSEWHERE
- PCLDFR(:,:,:) = 0.
- ENDWHERE
- ELSE
- WHERE(PRT(:,:,:,2) > 1.E-30)
- PCLDFR(:,:,:) = 1.
- ELSEWHERE
- PCLDFR(:,:,:) = 0.
- ENDWHERE
- ENDIF
-ENDIF
-!
-IRESP=0
-IF(HGETICEFR=='READ') THEN ! cloud fraction
- CALL IO_Field_read(TPINIFILE,'ICEFR',PICEFR,IRESP)
-ENDIF
-IF(HGETCLDFR=='INIT' .OR. IRESP /= 0) THEN
- IF(SIZE(PRT,4) > 3) THEN
- WHERE(PRT(:,:,:,4) > 1.E-30)
- PICEFR(:,:,:) = 1.
- ELSEWHERE
- PICEFR(:,:,:) = 0.
- ENDWHERE
- ELSE
- PICEFR(:,:,:) = 0.
- ENDIF
-ENDIF
-!
-!* boundary layer depth
-!
-IF (HGETBL_DEPTH=='READ') THEN
- CALL IO_Field_read(TPINIFILE,'BL_DEPTH',PBL_DEPTH)
-ELSE
- PBL_DEPTH(:,:)=XUNDEF
-END IF
-!
-!* surface boundary layer depth
-!
-IF (HGETSBL_DEPTH=='READ') THEN
- CALL IO_Field_read(TPINIFILE,'SBL_DEPTH',PSBL_DEPTH)
-ELSE
- PSBL_DEPTH(:,:)=0.
-END IF
-!
-!* Contribution from MAss Flux parameterizations to vert. flux of buoyancy
-!
-SELECT CASE(HGETTKET)
- CASE('READ')
- IF (CSCONV=='EDKF') THEN
- CALL IO_Field_read(TPINIFILE,'WTHVMF',PWTHVMF)
- ELSE
- PWTHVMF(:,:,:)=0
- ENDIF
- CASE('INIT')
- PWTHVMF(:,:,:)=0.
-END SELECT
-!-------------------------------------------------------------------------------
-!
-!* 2.4 READ FORCING VARIABLES
-! ----------------------
-!
-! READ FIELD ONLY FOR MODEL1 (identical for all model in GN)
-IF (LOCEAN .AND. (.NOT.LCOUPLES) .AND. (KOCEMI==1)) THEN
-!
- CALL IO_Field_read(TPINIFILE,'NFRCLT',NFRCLT)
- CALL IO_Field_read(TPINIFILE,'NINFRT',NINFRT)
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'SSUFL_T', &
- CSTDNAME = '', &
- CLONGNAME = 'SSUFL', &
- CUNITS = 'kg m-1 s-1', &
- CDIR = '--', &
- CCOMMENT = 'sfc stress along U to force ocean LES', &
- NGRID = 0, &
- NTYPE = TYPEREAL, &
- NDIMS = 1, &
- LTIMEDEP = .FALSE. )
- ALLOCATE(XSSUFL_T(NFRCLT))
- CALL IO_Field_read(TPINIFILE,TZFIELD,XSSUFL_T(:))
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'SSVFL_T', &
- CSTDNAME = '', &
- CLONGNAME = 'SSVFL', &
- CUNITS = 'kg m-1 s-1', &
- CDIR = '--', &
- CCOMMENT = 'sfc stress along V to force ocean LES', &
- NGRID = 0, &
- NTYPE = TYPEREAL, &
- NDIMS = 1, &
- LTIMEDEP = .FALSE. )
- ALLOCATE(XSSVFL_T(NFRCLT))
- CALL IO_Field_read(TPINIFILE,TZFIELD,XSSVFL_T(:))
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'SSTFL_T', &
- CSTDNAME = '', &
- CLONGNAME = 'SSTFL', &
- CUNITS = 'kg m3 K m s-1', &
- CDIR = '--', &
- CCOMMENT = 'sfc total heat flux to force ocean LES', &
- NGRID = 0, &
- NTYPE = TYPEREAL, &
- NDIMS = 1, &
- LTIMEDEP = .FALSE. )
- ALLOCATE(XSSTFL_T(NFRCLT))
- CALL IO_Field_read(TPINIFILE,TZFIELD,XSSTFL_T(:))
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'SSOLA_T', &
- CSTDNAME = '', &
- CLONGNAME = 'SSOLA', &
- CUNITS = 'kg m3 K m s-1', &
- CDIR = '--', &
- CCOMMENT = 'sfc solar flux to force ocean LES', &
- NGRID = 0, &
- NTYPE = TYPEREAL, &
- NDIMS = 1, &
- LTIMEDEP = .FALSE. )
- ALLOCATE(XSSOLA_T(NFRCLT))
- CALL IO_Field_read(TPINIFILE,TZFIELD,XSSOLA_T(:))
-!
-END IF ! ocean sfc forcing end
-
-!
-IF ( LFORCING ) THEN
- DO JT=1,KFRC
-!
- WRITE (YFRC,'(I3.3)') JT
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'DTFRC'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'DTFRC'//YFRC, &
- CUNITS = 'seconds since YYYY-MM-DD HH:MM:SS.S', &
- CDIR = '--', &
- CCOMMENT = 'Date of forcing profile '//YFRC, &
- NGRID = 0, &
- NTYPE = TYPEDATE, &
- NDIMS = 0, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_read(TPINIFILE,TZFIELD,TPDTFRC(JT))
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'UFRC'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'UFRC'//YFRC, &
- CUNITS = 'm s-1', &
- CDIR = '--', &
- CCOMMENT = 'Zonal component of horizontal forcing wind', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 1, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PUFRC(:,JT))
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'VFRC'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'VFRC'//YFRC, &
- CUNITS = 'm s-1', &
- CDIR = '--', &
- CCOMMENT = 'Meridian component of horizontal forcing wind', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 1, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PVFRC(:,JT))
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'WFRC'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'WFRC'//YFRC, &
- CUNITS = 'm s-1', &
- CDIR = '--', &
- CCOMMENT = 'Vertical forcing wind', &
- NGRID = 4, &
- NTYPE = TYPEREAL, &
- NDIMS = 1, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PWFRC(:,JT))
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'THFRC'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'THFRC'//YFRC, &
- CUNITS = 'K', &
- CDIR = '--', &
- CCOMMENT = 'Forcing potential temperature', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 1, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PTHFRC(:,JT))
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'RVFRC'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'RVFRC'//YFRC, &
- CUNITS = 'kg kg-1', &
- CDIR = '--', &
- CCOMMENT = 'Forcing vapor mixing ratio', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 1, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PRVFRC(:,JT))
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'TENDTHFRC'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'TENDTHFRC'//YFRC, &
- CUNITS = 'K s-1', &
- CDIR = '--', &
- CCOMMENT = 'Large-scale potential temperature tendency for forcing', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 1, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PTENDTHFRC(:,JT))
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'TENDRVFRC'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'TENDRVFRC'//YFRC, &
- CUNITS = 'kg kg-1 s-1', &
- CDIR = '--', &
- CCOMMENT = 'Large-scale vapor mixing ratio tendency for forcing', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 1, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PTENDRVFRC(:,JT))
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'GXTHFRC'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'GXTHFRC'//YFRC, &
- CUNITS = 'K m-1', &
- CDIR = '--', &
- CCOMMENT = 'Large-scale potential temperature gradient for forcing', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 1, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PGXTHFRC(:,JT))
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'GYTHFRC'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'GYTHFRC'//YFRC, &
- CUNITS = 'K m-1', &
- CDIR = '--', &
- CCOMMENT = 'Large-scale potential temperature gradient for forcing', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 1, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PGYTHFRC(:,JT))
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'PGROUNDFRC'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'PGROUNDFRC'//YFRC, &
- CUNITS = 'Pa', &
- CDIR = '--', &
- CCOMMENT = 'Forcing ground pressure', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 0, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PPGROUNDFRC(JT))
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'TENDUFRC'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'TENDUFRC'//YFRC, &
- CUNITS = 'm s-1', &
- CDIR = '--', &
- CCOMMENT = 'Large-scale U tendency for forcing', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 1, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PTENDUFRC(:,JT))
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'TENDVFRC'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'TENDVFRC'//YFRC, &
- CUNITS = 'm s-1', &
- CDIR = '--', &
- CCOMMENT = 'Large-scale V tendency for forcing', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 1, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PTENDVFRC(:,JT))
- END DO
-END IF
-!
-!-------------------------------------------------------------------------------
-IF (L2D_ADV_FRC) THEN
-
- DO JT=1,KADVFRC
- WRITE (YFRC,'(I3.3)') JT
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'DTADV'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'DTADV'//YFRC, &
- CUNITS = 'seconds since YYYY-MM-DD HH:MM:SS.S', &
- CDIR = '--', &
- CCOMMENT = 'Date and time of the advecting forcing '//YFRC, &
- NGRID = 0, &
- NTYPE = TYPEDATE, &
- NDIMS = 0, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_read(TPINIFILE,TZFIELD,TPDTADVFRC(JT))
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'TH_ADV'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'TH_ADV'//YFRC, &
- CUNITS = 'K s-1', &
- CDIR = '--', &
- CCOMMENT = '', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PDTHFRC(:,:,:,JT))
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'Q_ADV'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'Q_ADV'//YFRC, &
- CUNITS = 'kg kg-1 s-1', &
- CDIR = '--', &
- CCOMMENT = '', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PDRVFRC(:,:,:,JT))
- ENDDO
-ENDIF
-!
-IF (L2D_REL_FRC) THEN
-
- DO JT=1,KRELFRC
- WRITE (YFRC,'(I3.3)') JT
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'DTREL'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'DTREL'//YFRC, &
- CUNITS = 'seconds since YYYY-MM-DD HH:MM:SS.S', &
- CDIR = '--', &
- CCOMMENT = 'Date and time of the relaxation forcing '//YFRC, &
- NGRID = 0, &
- NTYPE = TYPEDATE, &
- NDIMS = 0, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_read(TPINIFILE,TZFIELD,TPDTRELFRC(JT))
- !
- ! Relaxation
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'TH_REL'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'TH_REL'//YFRC, &
- CUNITS = 'K', &
- CDIR = '--', &
- CCOMMENT = '', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PTHREL(:,:,:,JT))
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'Q_REL'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'Q_REL'//YFRC, &
- CUNITS = 'kg kg-1', &
- CDIR = '--', &
- CCOMMENT = '', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_read(TPINIFILE,TZFIELD,PRVREL(:,:,:,JT))
- ENDDO
-ENDIF
-!
-IF (LUV_FLX) THEN
- IF ( CCONF /= 'START' .OR. CPROGRAM=='SPAWN ' ) THEN
- CALL IO_Field_read(TPINIFILE,'VU_FLX',PVU_FLUX_M)
- ELSE IF (CCONF == 'START') THEN
- PVU_FLUX_M(:,:,:)=0.
- END IF
-ENDIF
-!
-IF (LTH_FLX) THEN
- IF ( CCONF /= 'START' .OR. CPROGRAM=='SPAWN ' ) THEN
- CALL IO_Field_read(TPINIFILE,'VT_FLX',PVTH_FLUX_M)
- CALL IO_Field_read(TPINIFILE,'WT_FLX',PWTH_FLUX_M)
- ELSE IF (CCONF == 'START') THEN
- PWTH_FLUX_M(:,:,:)=0.
- PVTH_FLUX_M(:,:,:)=0.
- END IF
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 3. PRINT ON OUTPUT-LISTING
-! ----------------------
-!
-IF (NVERB >= 10 .AND. .NOT. L1D) THEN
- IIUP = SIZE(PUT,1)
- IJUP = SIZE(PVT,2)
- ILUOUT= TLUOUT%NLU
-!
- WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PUT values:'
- WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK '
- DO JKLOOP=1,KKU
- WRITE(ILUOUT,FMT=*) PUT(1,1,JKLOOP),PUT(IIUP/2,IJUP/2,JKLOOP), &
- PUT(IIUP,KJU,JKLOOP),JKLOOP
- END DO
-!
- WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PVT values:'
- WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK '
- DO JKLOOP=1,KKU
- WRITE(ILUOUT,FMT=*) PVT(1,1,JKLOOP),PVT(IIUP/2,IJUP/2,JKLOOP), &
- PVT(IIUP,IJUP,JKLOOP),JKLOOP
- END DO
-!
- WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PWT values:'
- WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK '
- DO JKLOOP=1,KKU
- WRITE(ILUOUT,FMT=*) PWT(1,1,JKLOOP),PWT(IIUP/2,IJUP/2,JKLOOP), &
- PWT(IIUP,IJUP,JKLOOP),JKLOOP
- END DO
-!
- WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PTHT values:'
- WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK '
- DO JKLOOP=1,KKU
- WRITE(ILUOUT,FMT=*) PTHT(1,1,JKLOOP),PTHT(IIUP/2,IJUP/2,JKLOOP), &
- PTHT(IIUP,IJUP,JKLOOP),JKLOOP
- END DO
-!
- IF(SIZE(PTKET,1) /=0) THEN
- WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PTKET values:'
- WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK '
- DO JKLOOP=1,KKU
- WRITE(ILUOUT,FMT=*) PTKET(1,1,JKLOOP),PTKET(IIUP/2,IJUP/2,JKLOOP), &
- PTKET(IIUP,IJUP,JKLOOP),JKLOOP
- END DO
- END IF
-!
- IF (SIZE(PRT,4) /= 0) THEN
- WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PRT values:'
- DO JRR = 1, SIZE(PRT,4)
- WRITE(ILUOUT,FMT=*) 'JRR = ',JRR
- WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK '
- DO JKLOOP=1,KKU
- WRITE(ILUOUT,FMT=*) PRT(1,1,JKLOOP,JRR),PRT(IIUP/2,IJUP/2,JKLOOP,JRR), &
- PRT(IIUP,IJUP,JKLOOP,JRR),JKLOOP
- END DO
- END DO
-!
- END IF
-!
- IF (SIZE(PSVT,4) /= 0) THEN
- WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PSVT values:'
- DO JRR = 1, SIZE(PSVT,4)
- WRITE(ILUOUT,FMT=*) 'JRR = ',JRR
- WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK '
- DO JKLOOP=1,KKU
- WRITE(ILUOUT,FMT=*) PSVT(1,1,JKLOOP,JRR),PSVT(IIUP/2,IJUP/2,JKLOOP,JRR), &
- PSVT(IIUP,IJUP,JKLOOP,JRR),JKLOOP
- END DO
- END DO
-!
- END IF
-END IF
-!-------------------------------------------------------------------------------
-!
-!
-END SUBROUTINE READ_FIELD
diff --git a/src/mesonh/ext/read_precip_field.f90 b/src/mesonh/ext/read_precip_field.f90
deleted file mode 100644
index 1267beea757dd57efdedb88d79264cefd58a738c..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/read_precip_field.f90
+++ /dev/null
@@ -1,299 +0,0 @@
-!MNH_LIC Copyright 1996-2020 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! #############################
- MODULE MODI_READ_PRECIP_FIELD
-! #############################
-!
-!
-!
-INTERFACE
-!
- SUBROUTINE READ_PRECIP_FIELD(TPINIFILE,HPROGRAM,HCONF, &
- HGETRCT,HGETRRT,HGETRST,HGETRGT,HGETRHT, &
- PINPRC,PACPRC,PINDEP,PACDEP,PINPRR,PINPRR3D,PEVAP3D, &
- PACPRR,PINPRS,PACPRS,PINPRG,PACPRG,PINPRH,PACPRH )
-!
-USE MODD_IO, ONLY : TFILEDATA
-!
-!* 0.1 declarations of arguments
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
-CHARACTER (LEN=*), INTENT(IN) :: HPROGRAM !
-CHARACTER (LEN=*), INTENT(IN) :: HCONF !
-!
-CHARACTER (LEN=*), INTENT(IN) :: HGETRCT, HGETRRT, HGETRST, HGETRGT, HGETRHT
- ! Get indicator RCT,RRT,RST,RGT,RHT
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Droplet instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PACPRC ! Droplet accumulated precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Droplet instant deposition
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PACDEP ! Droplet accumulated dep
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! Rain precipitation flux 3D
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evaporation flux 3D
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PACPRR ! Rain accumulated precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PACPRS ! Snow accumulated precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PACPRG ! Graupel accumulated precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PACPRH ! Hail accumulated precip
-!
-END SUBROUTINE READ_PRECIP_FIELD
-!
-END INTERFACE
-!
-END MODULE MODI_READ_PRECIP_FIELD
-!
-! ##############################################################################
- SUBROUTINE READ_PRECIP_FIELD(TPINIFILE,HPROGRAM,HCONF, &
- HGETRCT,HGETRRT,HGETRST,HGETRGT,HGETRHT, &
- PINPRC,PACPRC,PINDEP,PACDEP,PINPRR,PINPRR3D,PEVAP3D, &
- PACPRR,PINPRS,PACPRS,PINPRG,PACPRG,PINPRH,PACPRH )
-! ##############################################################################
-!
-!!**** *READ_PRECIP_FIELD* - routine to read precipitation surface fields
-!!
-!! PURPOSE
-!! -------
-! Initialize precipitation fields by reading their value in an initial
-! MNH file.
-!
-!!** METHOD
-!! ------
-!!
-!!
-!!
-!! EXTERNAL
-!! --------
-!! FMREAD : to read data in LFIFM file
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of the documentation (routine READ_PRECIP_FIELD)
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty *Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 13/06/96
-!! (J. Viviand) 04/02/97 convert precipitation rates in m/s
-!! (V. Ducrocq) 14/08/98 // remove KIINF,KJINF,KISUP,KJSUP
-!! (JP Pinty) 29/11/02 add C3R5, ICE2, ICE4
-!! (C.Lac) 04/03/13 add YGETxxx for FIT scheme
-!! 10/2016 (C.Lac) Add droplet deposition
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
-!!
-!-----------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-
-use modd_field, only: tfieldmetadata, tfieldlist
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PARAM_ICE_n, ONLY: LDEPOSC
-USE MODD_PARAM_C2R2, ONLY: LDEPOC
-USE MODD_PARAM_LIMA, ONLY: MDEPOC=>LDEPOC
-!
-use mode_field, only: Find_field_id_from_mnhname
-USE MODE_IO_FIELD_READ, only: IO_Field_read
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
-CHARACTER (LEN=*), INTENT(IN) :: HPROGRAM !
-CHARACTER (LEN=*), INTENT(IN) :: HCONF !
-!
-CHARACTER (LEN=*), INTENT(IN) :: HGETRCT, HGETRRT, HGETRST, HGETRGT, HGETRHT
- ! Get indicator RCT,RRT,RST,RGT,RHT
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Droplet instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PACPRC ! Droplet accumulated precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Droplet instant deposition
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PACDEP ! Droplet accumulated dep
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! Rain precipitation flux 3D
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evaporation flux 3D
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PACPRR ! Rain accumulated precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PACPRS ! Snow accumulated precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PACPRG ! Graupel accumulated precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PACPRH ! Hail accumulated precip
-!
-!* 0.2 declarations of local variables
-!
-REAL, DIMENSION(SIZE(PINPRR,1),SIZE(PINPRR,2)) :: Z2D ! 2D array to read data
-REAL, DIMENSION(SIZE(PINPRR3D,1),SIZE(PINPRR3D,2),SIZE(PINPRR3D,3)) :: Z3D ! 3D array to read data
- ! in initial file
-INTEGER :: IID
-INTEGER :: IRESP
-CHARACTER(LEN=4) :: YGETRCT,YGETRRT,YGETRST,YGETRGT,YGETRHT
-TYPE(TFIELDMETADATA) :: TZFIELD
-!
-!-------------------------------------------------------------------------------
-!
-!* 1.. INITIALIZATION
-! ----------------
-!
-IF ((HPROGRAM == 'MESONH') .AND. (HCONF == 'START')) THEN
- YGETRCT = 'INIT'
- YGETRRT = 'INIT'
- YGETRST = 'INIT'
- YGETRGT = 'INIT'
- YGETRHT = 'INIT'
-ELSE
- YGETRCT = HGETRCT
- YGETRRT = HGETRRT
- YGETRST = HGETRST
- YGETRGT = HGETRGT
- YGETRHT = HGETRHT
-END IF
-!-------------------------------------------------------------------------------
-!
-!* 2.. READ PROGNOSTIC VARIABLES
-! -------------------------
-!
-IF (SIZE(PINPRC) /= 0 ) THEN
- SELECT CASE(YGETRCT)
- CASE ('READ')
- CALL FIND_FIELD_ID_FROM_MNHNAME('INPRC',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
- IF (IRESP == 0) PINPRC(:,:)=Z2D(:,:)/(1000.*3600.)
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRC',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm'
- CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
- IF (IRESP == 0) PACPRC(:,:)=Z2D(:,:)/(1000.)
- CASE ('INIT')
- PINPRC(:,:) = 0.0
- PACPRC(:,:) = 0.0
- END SELECT
-END IF
-!
-IF (SIZE(PINDEP) /= 0 ) THEN
- SELECT CASE(YGETRCT)
- CASE ('READ')
- CALL FIND_FIELD_ID_FROM_MNHNAME('INDEP',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
- IF (IRESP == 0) PINDEP(:,:)=Z2D(:,:)/(1000.*3600.)
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME('ACDEP',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm'
- CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
- IF (IRESP == 0) PACDEP(:,:)=Z2D(:,:)/(1000.)
- CASE ('INIT')
- PINDEP(:,:) = 0.0
- PACDEP(:,:) = 0.0
- END SELECT
-END IF
-!
-IF (SIZE(PINPRR) /= 0 ) THEN
- SELECT CASE(YGETRRT)
- CASE ('READ')
- CALL FIND_FIELD_ID_FROM_MNHNAME('INPRR',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
- IF (IRESP == 0) PINPRR(:,:)=Z2D(:,:)/(1000.*3600.)
- !
- CALL IO_Field_read(TPINIFILE,'INPRR3D',Z3D,IRESP)
- IF (IRESP == 0) PINPRR3D(:,:,:)=Z3D(:,:,:)
- !
- CALL IO_Field_read(TPINIFILE,'EVAP3D',Z3D,IRESP)
- IF (IRESP == 0) PEVAP3D(:,:,:)=Z3D(:,:,:)
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRR',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm'
- CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
- IF (IRESP == 0) PACPRR(:,:)=Z2D(:,:)/(1000.)
- CASE ('INIT')
- PINPRR(:,:) = 0.0
- PINPRR3D(:,:,:) = 0.0
- PEVAP3D(:,:,:) = 0.0
- PACPRR(:,:) = 0.0
- END SELECT
-END IF
-!
-IF (SIZE(PINPRS) /= 0 ) THEN
- SELECT CASE(YGETRST)
- CASE ('READ')
- CALL FIND_FIELD_ID_FROM_MNHNAME('INPRS',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
- IF (IRESP == 0) PINPRS(:,:)=Z2D(:,:)/(1000.*3600.)
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRS',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm'
- CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
- IF (IRESP == 0) PACPRS(:,:)=Z2D(:,:)/(1000.)
- CASE ('INIT')
- PINPRS(:,:) = 0.0
- PACPRS(:,:) = 0.0
- END SELECT
-END IF
-!
-IF (SIZE(PINPRG) /= 0 ) THEN
- SELECT CASE(YGETRGT)
- CASE ('READ')
- CALL FIND_FIELD_ID_FROM_MNHNAME('INPRG',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
- IF (IRESP == 0) PINPRG(:,:)=Z2D(:,:)/(1000.*3600.)
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRG',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm'
- CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
- IF (IRESP == 0) PACPRG(:,:)=Z2D(:,:)/(1000.)
- CASE ('INIT')
- PINPRG(:,:) = 0.0
- PACPRG(:,:) = 0.0
- END SELECT
-END IF
-!
-IF (SIZE(PINPRH) /= 0 ) THEN
- SELECT CASE(YGETRHT)
- CASE ('READ')
- CALL FIND_FIELD_ID_FROM_MNHNAME('INPRH',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
- IF (IRESP == 0) PINPRH(:,:)=Z2D(:,:)/(1000.*3600.)
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRH',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm'
- CALL IO_Field_read(TPINIFILE,TZFIELD,Z2D,IRESP)
- IF (IRESP == 0) PACPRH(:,:)=Z2D(:,:)/(1000.)
- CASE ('INIT')
- PINPRH(:,:) = 0.0
- PACPRH(:,:) = 0.0
- END SELECT
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE READ_PRECIP_FIELD
diff --git a/src/mesonh/ext/resolved_cloud.f90 b/src/mesonh/ext/resolved_cloud.f90
index aec42c0535e375182860e9e1ff46049510d13234..a78ace969ea25378dbf3945f822977ea770627a3 100644
--- a/src/mesonh/ext/resolved_cloud.f90
+++ b/src/mesonh/ext/resolved_cloud.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -7,7 +7,7 @@
MODULE MODI_RESOLVED_CLOUD
! ##########################
INTERFACE
- SUBROUTINE RESOLVED_CLOUD ( HCLOUD, HACTCCN, HSCONV, HMF_CLOUD, &
+ SUBROUTINE RESOLVED_CLOUD ( HCLOUD, HELEC, HACTCCN, HSCONV, HMF_CLOUD, &
KRR, KSPLITR, KSPLITG, KMI, KTCOUNT, &
HLBCX, HLBCY, TPFILE, HRAD, HTURBDIM, &
OSUBG_COND, OSIGMAS, HSUBG_AUCV, &
@@ -30,6 +30,7 @@ INTERFACE
USE MODD_IO, ONLY: TFILEDATA
!
CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! kind of cloud
+CHARACTER(LEN=4), INTENT(IN) :: HELEC ! kind of electrical scheme
CHARACTER(LEN=4), INTENT(IN) :: HACTCCN ! kind of CCN activation scheme
! paramerization
CHARACTER(LEN=4), INTENT(IN) :: HSCONV ! Shallow convection scheme
@@ -146,8 +147,8 @@ END SUBROUTINE RESOLVED_CLOUD
END INTERFACE
END MODULE MODI_RESOLVED_CLOUD
!
-! ##########################################################################
- SUBROUTINE RESOLVED_CLOUD ( HCLOUD, HACTCCN, HSCONV, HMF_CLOUD, &
+! ##################################################################################
+ SUBROUTINE RESOLVED_CLOUD ( HCLOUD, HELEC, HACTCCN, HSCONV, HMF_CLOUD, &
KRR, KSPLITR, KSPLITG, KMI, KTCOUNT, &
HLBCX, HLBCY, TPFILE, HRAD, HTURBDIM, &
OSUBG_COND, OSIGMAS, HSUBG_AUCV, &
@@ -166,7 +167,7 @@ END MODULE MODI_RESOLVED_CLOUD
PINDEP, PSUPSAT, PNACT, PNPRO,PSSPRO, PRAINFR, &
PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
PSEA,PTOWN )
-! ##########################################################################
+! ##################################################################################
!
!!**** * - compute the resolved clouds and precipitation
!!
@@ -284,38 +285,51 @@ END MODULE MODI_RESOLVED_CLOUD
! 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
+! C. Barthe 20/03/2023: to avoid duplicating sources, cloud electrification is integrated in the microphysics
+! CELLS can be used with rain_ice with LRED=T and with LIMA with LPTSPLIT=T
+! the adjustement for cloud electricity is also externalized
!-------------------------------------------------------------------------------
!
!* 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_n, ONLY: NEBN, CCONDENS, CLAMBDA3
-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_n, ONLY: CSEDIM, LADJ_BEFORE, LADJ_AFTER, LRED, PARAM_ICEN
-USE MODD_PARAM_LIMA, ONLY: LADJ, LPTSPLIT, LSPRO, NMOD_CCN, NMOD_IFN, NMOD_IMM, NMOM_I
+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_ELEC_DESCR, ONLY: ELEC_DESCR, LSEDIM_BEARD, LIAGGS_LATHAM
+USE MODD_ELEC_n, ONLY: XEFIELDU, XEFIELDV, XEFIELDW
+USE MODD_ELEC_PARAM, ONLY: ELEC_PARAM
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_NEB_n, ONLY: NEBN, CCONDENS, CLAMBDA3
+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, &
+ NSV_ELECBEG, NSV_ELECEND
+USE MODD_PARAM_C2R2, ONLY: LSUPSAT
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
+USE MODD_PARAM_ICE_n, ONLY: CSEDIM, LADJ_BEFORE, LADJ_AFTER, LRED, PARAM_ICEN
+USE MODD_PARAM_LIMA, ONLY: LADJ, LPTSPLIT, LSPRO, NMOD_CCN, NMOD_IFN, NMOD_IMM, NMOM_I
USE MODD_RAIN_ICE_DESCR_n, ONLY: XRTMIN, RAIN_ICE_DESCRN
USE MODD_RAIN_ICE_PARAM_n, ONLY: RAIN_ICE_PARAMN
-USE MODD_SALT, ONLY: LSALT
-USE MODD_TURB_n, ONLY: TURBN
+USE MODD_REF, ONLY: XTHVREFZ
+USE MODD_SALT, ONLY: LSALT
+USE MODD_TURB_n, ONLY: TURBN
!
USE MODE_ll
USE MODE_FILL_DIMPHYEX, ONLY: FILL_DIMPHYEX
use mode_sources_neg_correct, only: Sources_neg_correct
!
+USE MODI_AER2LIMA
USE MODI_C2R2_ADJUST
+USE MODI_ELEC_ADJUST
USE MODI_FAST_TERMS
USE MODI_GET_HALO
USE MODI_ICE_ADJUST
+USE MODI_ICE_ADJUST_ELEC
+USE MODI_ION_SOURCE_ELEC
USE MODI_KHKO_NOTADJUST
USE MODI_LIMA
USE MODI_LIMA_ADJUST
@@ -326,10 +340,10 @@ USE MODI_LIMA_NOTADJUST
USE MODI_LIMA_WARM
USE MODI_RAIN_C2R2_KHKO
USE MODI_RAIN_ICE
+USE MODI_RAIN_ICE_ELEC
USE MODI_RAIN_ICE_OLD
USE MODI_SHUMAN
USE MODI_SLOW_TERMS
-USE MODI_AER2LIMA
!
IMPLICIT NONE
!
@@ -338,6 +352,7 @@ IMPLICIT NONE
!
!
CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! kind of cloud paramerization
+CHARACTER(LEN=4), INTENT(IN) :: HELEC ! kind of electrical scheme
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
@@ -487,12 +502,20 @@ 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
+!
+! variables for cloud electricity
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCND, ZDEP
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRCS_BEF, ZRIS_BEF
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZQCT, ZQRT, ZQIT, ZQST, ZQGT, ZQHT, ZQPIT, ZQNIT
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZQCS, ZQRS, ZQIS, ZQSS, ZQGS, ZQHS, ZQPIS, ZQNIS
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLATHAM_IAGGS ! E Function to simulate
+ ! enhancement of IAGGS
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEFIELDW
+LOGICAL :: GELEC ! if true, cloud electrification is activated
+!
ZSIGQSAT2D(:,:) = PSIGQSAT
!
!------------------------------------------------------------------------------
@@ -546,17 +569,17 @@ END IF
!
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))
+ 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))
+ 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) * &
@@ -570,8 +593,8 @@ CALL AER2LIMA(ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,:),&
PRHODJ(:,:,:) / PTSTEP
PSVS(:,:,:,NSV_LIMA_IFN_FREE+1) = ZSVT(:,:,:,NSV_LIMA_IFN_FREE+1) * &
PRHODJ(:,:,:) / PTSTEP
-
-DEALLOCATE(ZSVT)
+ !
+ DEALLOCATE(ZSVT)
END IF
!UPG*PT
@@ -594,15 +617,15 @@ 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,:,:)
+ 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
@@ -647,62 +670,89 @@ IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO' &
PSVT(:,:,IKE+1,ISVBEG:ISVEND) = PSVT(:,:,IKE,ISVBEG:ISVEND)
ENDIF
!
+! Same thing for cloud electricity
+IF (HELEC(1:3) == 'ELE') THEN
+ ! Transformation into physical tendencies
+ DO JSV = NSV_ELECBEG, NSV_ELECEND
+ PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) / PRHODJ(:,:,:)
+ ENDDO
+ !
+ ! complete the lateral boundaries to avoid possible problems
+ DO JI = 1, JPHEXT
+ ! positive ion source
+ PSVS(JI,:,:,NSV_ELECBEG) = PSVS(IIB,:,:,NSV_ELECBEG)
+ PSVS(IIE+JI,:,:,NSV_ELECBEG) = PSVS(IIE,:,:,NSV_ELECBEG)
+ PSVS(:,JI,:,NSV_ELECBEG) = PSVS(:,IJB,:,NSV_ELECBEG)
+ PSVS(:,IJE+JI,:,NSV_ELECBEG) = PSVS(:,IJE,:,NSV_ELECBEG)
+ ! source of hydrometeor charge
+ PSVS(JI,:,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
+ PSVS(IIE+JI,:,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
+ PSVS(:,JI,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
+ PSVS(:,IJE+JI,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
+ ! negative ion source
+ PSVS(JI,:,:,NSV_ELECEND) = PSVS(IIB,:,:,NSV_ELECEND)
+ PSVS(IIE+JI,:,:,NSV_ELECEND) = PSVS(IIE,:,:,NSV_ELECEND)
+ PSVS(:,JI,:,NSV_ELECEND) = PSVS(:,IJB,:,NSV_ELECEND)
+ PSVS(:,IJE+JI,:,NSV_ELECEND) = PSVS(:,IJE,:,NSV_ELECEND)
+ END DO
+ !
+ ! complete the physical boundaries to avoid some computations
+ IF(GWEST .AND. HLBCX(1) /= 'CYCL') PSVT(IIB-1,:,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
+ IF(GEAST .AND. HLBCX(2) /= 'CYCL') PSVT(IIE+1,:,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
+ IF(GSOUTH .AND. HLBCY(1) /= 'CYCL') PSVT(:,IJB-1,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
+ IF(GNORTH .AND. HLBCY(2) /= 'CYCL') PSVT(:,IJE+1,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
+ !
+ ! complete the vertical boundaries
+ PSVS(:,:,IKB-1,NSV_ELECBEG) = PSVS(:,:,IKB,NSV_ELECBEG) ! Positive ion
+ PSVT(:,:,IKB-1,NSV_ELECBEG) = PSVT(:,:,IKB,NSV_ELECBEG)
+ PSVS(:,:,IKB-1,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0 ! Hydrometeor charge
+ PSVS(:,:,IKE+1,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
+ PSVT(:,:,IKB-1,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
+ PSVT(:,:,IKE+1,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0
+ PSVS(:,:,IKB-1,NSV_ELECEND) = PSVS(:,:,IKB,NSV_ELECEND) ! Negative ion
+ PSVT(:,:,IKB-1,NSV_ELECEND) = PSVT(:,:,IKB,NSV_ELECEND)
+END IF
+!
+!
+!-------------------------------------------------------------------------------
!
!* 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 )
+call Sources_neg_correct( hcloud, helec, 'NEGA', krr, ptstep, ppabst, ptht, prt, pths, prs, psvs, prhodj )
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. CLOUD ELECTRICITY
+! -----------------
+!
+!++cb++ 01/06/23
+!IF (HELEC == 'ELE4') &
+IF (HELEC(1:3) == 'ELE') THEN
+!--cb--
!
-!* 3.4 Limitations of Na and Nc to the CCN max number concentration
+!* 4.1 Ion source from drift motion and cosmic rays
!
-! 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
+ CALL ION_SOURCE_ELEC (KTCOUNT, KRR, HLBCX, HLBCY, &
+ PRHODREF, PRHODJ, PRT, &
+ PSVT(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
+ PSVS(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
+ XEFIELDU, XEFIELDV, XEFIELDW )
+!
+!* 4.2 Compute the coefficient that modifies the efficiency of IAGGS
+!
+ ALLOCATE(ZLATHAM_IAGGS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ IF (LIAGGS_LATHAM) THEN
+ ZLATHAM_IAGGS(:,:,:) = 1.0 + 0.4E-10 * MIN( 2.25E10, &
+ XEFIELDU(:,:,:)**2+XEFIELDV(:,:,:)**2+XEFIELDW(:,:,:)**2 )
+ ELSE
+ ZLATHAM_IAGGS(:,:,:) = 1.0
+ END IF
+ELSE
+ ALLOCATE(ZLATHAM_IAGGS(0,0,0))
+END IF
!
!
!-------------------------------------------------------------------------------
@@ -796,6 +846,13 @@ SELECT CASE ( HCLOUD )
!
allocate( zexn( size( pzz, 1 ), size( pzz, 2 ), size( pzz, 3 ) ) )
ZEXN(:,:,:)= (PPABST(:,:,:)/CST%XP00)**(CST%XRD/CST%XCPD)
+
+ IF (HELEC == 'ELE4') THEN
+ ALLOCATE( ZCND (SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3)) )
+ ALLOCATE( ZDEP (SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3)) )
+ ALLOCATE( ZRCS_BEF(SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3)) )
+ ALLOCATE( ZRIS_BEF(SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3)) )
+ END IF
!
!* 9.1 Compute the explicit microphysical sources
!
@@ -805,6 +862,13 @@ SELECT CASE ( HCLOUD )
ENDDO
ZZZ = MZF( PZZ )
IF(LRED .AND. LADJ_BEFORE) THEN
+ IF (HELEC == 'ELE4') THEN
+ ! save the cloud droplets and ice crystals m.r. source before adjustement
+ ZRCS_BEF(:,:,:) = PRS(:,:,:,2)
+ ZRIS_BEF(:,:,:) = PRS(:,:,:,4)
+ END IF
+ !
+ ! Performe the saturation ajdustment
CALL ICE_ADJUST (YLDIMPHYEX,CST, RAIN_ICE_PARAMN, NEBN, TURBN, &
PARAM_ICEN, TBUCONF, KRR, &
'ADJU', &
@@ -823,34 +887,171 @@ SELECT CASE ( HCLOUD )
TBUDGETS=TBUDGETS,KBUDGETS=SIZE(TBUDGETS), &
PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
+ !
+ IF (HELEC == 'ELE4') THEN
+ ! Compute the condensation and sublimation rates
+ ZCND(:,:,:) = PRS(:,:,:,2) - ZRCS_BEF(:,:,:)
+ ZDEP(:,:,:) = PRS(:,:,:,4) - ZRIS_BEF(:,:,:)
+ !
+ ! Compute the charge exchanged during evaporation of cloud droplets (negative ZCND) and
+ ! during sublimation of ice crystals (negative ZDEP)
+ CALL ELEC_ADJUST (KRR, PRHODJ, HCLOUD, 'ADJU', &
+ PRC=ZRCS_BEF(:,:,:)*PTSTEP, PRI=ZRIS_BEF(:,:,:)*PTSTEP, &
+ PQC=PSVS(:,:,:,NSV_ELECBEG+1)*PTSTEP, &
+ PQI=PSVS(:,:,:,NSV_ELECBEG+3)*PTSTEP, &
+ PQCS=PSVS(:,:,:,NSV_ELECBEG+1), PQIS=PSVS(:,:,:,NSV_ELECBEG+3),&
+ PQPIS=PSVS(:,:,:,NSV_ELECBEG), PQNIS=PSVS(:,:,:,NSV_ELECEND), &
+ PCND=ZCND, PDEP=ZDEP)
+ END IF
ENDIF
IF (LRED) THEN
- CALL RAIN_ICE (YLDIMPHYEX,CST, PARAM_ICEN, RAIN_ICE_PARAMN, &
- RAIN_ICE_DESCRN, TBUCONF, &
- 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 )
+ IF (HELEC == 'ELE4') THEN
+ ! to match with PHYEX, electric charge variables are no more optional, but their size
+ ! depends on the activation (or not) of the electrification scheme
+ GELEC = .TRUE.
+ ALLOCATE(ZQPIT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQNIT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQCT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQRT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQIT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQST(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQGT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQPIS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQNIS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQCS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQRS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQIS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQSS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQGS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ZQPIT(:,:,:) = PSVT(:,:,:,NSV_ELECBEG)
+ ZQCT(:,:,:) = PSVT(:,:,:,NSV_ELECBEG+1)
+ ZQRT(:,:,:) = PSVT(:,:,:,NSV_ELECBEG+2)
+ ZQIT(:,:,:) = PSVT(:,:,:,NSV_ELECBEG+3)
+ ZQST(:,:,:) = PSVT(:,:,:,NSV_ELECBEG+4)
+ ZQGT(:,:,:) = PSVT(:,:,:,NSV_ELECBEG+5)
+ ZQNIT(:,:,:) = PSVT(:,:,:,NSV_ELECEND)
+ ZQPIS(:,:,:) = PSVS(:,:,:,NSV_ELECBEG)
+ ZQCS(:,:,:) = PSVS(:,:,:,NSV_ELECBEG+1)
+ ZQRS(:,:,:) = PSVS(:,:,:,NSV_ELECBEG+2)
+ ZQIS(:,:,:) = PSVS(:,:,:,NSV_ELECBEG+3)
+ ZQSS(:,:,:) = PSVS(:,:,:,NSV_ELECBEG+4)
+ ZQGS(:,:,:) = PSVS(:,:,:,NSV_ELECBEG+5)
+ ZQNIS(:,:,:) = PSVS(:,:,:,NSV_ELECEND)
+ IF (LSEDIM_BEARD) THEN
+ ALLOCATE(ZEFIELDW(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ZEFIELDW(:,:,:) = XEFIELDW(:,:,:)
+ ELSE
+ ALLOCATE(ZEFIELDW(0,0,0))
+ END IF
+ ELSE
+ GELEC = .FALSE.
+ ALLOCATE(ZQPIT(0,0,0))
+ ALLOCATE(ZQNIT(0,0,0))
+ ALLOCATE(ZQCT(0,0,0))
+ ALLOCATE(ZQRT(0,0,0))
+ ALLOCATE(ZQIT(0,0,0))
+ ALLOCATE(ZQST(0,0,0))
+ ALLOCATE(ZQGT(0,0,0))
+ ALLOCATE(ZQPIS(0,0,0))
+ ALLOCATE(ZQNIS(0,0,0))
+ ALLOCATE(ZQCS(0,0,0))
+ ALLOCATE(ZQRS(0,0,0))
+ ALLOCATE(ZQIS(0,0,0))
+ ALLOCATE(ZQSS(0,0,0))
+ ALLOCATE(ZQGS(0,0,0))
+ ALLOCATE(ZEFIELDW(0,0,0))
+ END IF
+ ALLOCATE(ZQHT(0,0,0))
+ ALLOCATE(ZQHS(0,0,0))
+ !
+ CALL RAIN_ICE (YLDIMPHYEX,CST, PARAM_ICEN, RAIN_ICE_PARAMN, RAIN_ICE_DESCRN, &
+ ELEC_PARAM, ELEC_DESCR, TBUCONF, GELEC, LSEDIM_BEARD, &
+ XTHVREFZ(IKB), HCLOUD, &
+ 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), &
+ ZQPIT, ZQCT, ZQRT, ZQIT, ZQST, ZQGT, ZQNIT, &
+ ZQPIS, ZQCS, ZQRS, ZQIS, ZQSS, ZQGS, ZQNIS, &
+ ZEFIELDW, ZLATHAM_IAGGS, &
+ PSEA,PTOWN, PFPR=ZFPR )
+ !
+ IF (HELEC == 'ELE4') THEN
+ PSVT(:,:,:,NSV_ELECBEG) = ZQPIT(:,:,:)
+ PSVT(:,:,:,NSV_ELECBEG+1) = ZQCT(:,:,:)
+ PSVT(:,:,:,NSV_ELECBEG+2) = ZQRT(:,:,:)
+ PSVT(:,:,:,NSV_ELECBEG+3) = ZQIT(:,:,:)
+ PSVT(:,:,:,NSV_ELECBEG+4) = ZQST(:,:,:)
+ PSVT(:,:,:,NSV_ELECBEG+5) = ZQGT(:,:,:)
+ PSVT(:,:,:,NSV_ELECEND) = ZQNIT(:,:,:)
+ PSVS(:,:,:,NSV_ELECBEG) = ZQPIS(:,:,:)
+ PSVS(:,:,:,NSV_ELECBEG+1) = ZQCS(:,:,:)
+ PSVS(:,:,:,NSV_ELECBEG+2) = ZQRS(:,:,:)
+ PSVS(:,:,:,NSV_ELECBEG+3) = ZQIS(:,:,:)
+ PSVS(:,:,:,NSV_ELECBEG+4) = ZQSS(:,:,:)
+ PSVS(:,:,:,NSV_ELECBEG+5) = ZQGS(:,:,:)
+ PSVS(:,:,:,NSV_ELECEND) = ZQNIS(:,:,:)
+ END IF
+ DEALLOCATE(ZQPIT)
+ DEALLOCATE(ZQNIT)
+ DEALLOCATE(ZQCT)
+ DEALLOCATE(ZQRT)
+ DEALLOCATE(ZQIT)
+ DEALLOCATE(ZQST)
+ DEALLOCATE(ZQGT)
+ DEALLOCATE(ZQHT)
+ DEALLOCATE(ZQPIS)
+ DEALLOCATE(ZQNIS)
+ DEALLOCATE(ZQCS)
+ DEALLOCATE(ZQRS)
+ DEALLOCATE(ZQIS)
+ DEALLOCATE(ZQSS)
+ DEALLOCATE(ZQGS)
+ DEALLOCATE(ZQHS)
+ DEALLOCATE(ZEFIELDW)
+ !
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)
+ IF (HELEC == 'ELE3') THEN
+ ! --> old version of the electrification scheme
+ ! Should be removed in a future version of MNH once the new electrification scheme is fully validated
+ ! Compute the explicit microphysical sources and the explicit charging rates
+ CALL RAIN_ICE_ELEC (OSEDIC, HSUBG_AUCV, OWARM, &
+ KSPLITR, PTSTEP, KMI, KRR, &
+ PZZ, 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, &
+ PSVT(:,:,:,NSV_ELECBEG), PSVT(:,:,:,NSV_ELECBEG+1), &
+ PSVT(:,:,:,NSV_ELECBEG+2), PSVT(:,:,:,NSV_ELECBEG+3), &
+ PSVT(:,:,:,NSV_ELECBEG+4), PSVT(:,:,:,NSV_ELECBEG+5), &
+ PSVT(:,:,:,NSV_ELECEND), &
+ PSVS(:,:,:,NSV_ELECBEG), PSVS(:,:,:,NSV_ELECBEG+1), &
+ PSVS(:,:,:,NSV_ELECBEG+2), PSVS(:,:,:,NSV_ELECBEG+3), &
+ PSVS(:,:,:,NSV_ELECBEG+4), PSVS(:,:,:,NSV_ELECBEG+5), &
+ PSVS(:,:,:,NSV_ELECEND), &
+ PSEA, PTOWN )
+ 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
END IF
!
@@ -858,26 +1059,68 @@ SELECT CASE ( HCLOUD )
!
!
IF (.NOT. LRED .OR. (LRED .AND. LADJ_AFTER) ) THEN
- CALL ICE_ADJUST (YLDIMPHYEX,CST, RAIN_ICE_PARAMN, NEBN, TURBN, &
- PARAM_ICEN, TBUCONF, KRR, &
- 'DEPI', &
- 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 )
+ IF (HELEC == 'ELE4') THEN
+ ! save the cloud droplets and ice crystals m.r. source before adjustement
+ ZRCS_BEF(:,:,:) = PRS(:,:,:,2)
+ ZRIS_BEF(:,:,:) = PRS(:,:,:,4)
+ END IF
+ !
+ ! Perform the saturation ajdustment
+ IF (HELEC == 'ELE3') THEN
+ ! --> old version of the electrification scheme
+ CALL ICE_ADJUST_ELEC (KRR, KMI, HRAD, HTURBDIM, &
+ HSCONV, HMF_CLOUD, &
+ OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT, &
+ PRHODJ, PEXNREF, PSIGS, PPABST, ZZZ, &
+ PMFCONV, PCF_MF, PRC_MF, PRI_MF, &
+ PRT(:,:,:,1), PRT(:,:,:,2), PRS(:,:,:,1), PRS(:,:,:,2), &
+ PTHS, PSRCS, PCLDFR, &
+ PRT(:,:,:,3), PRS(:,:,:,3), PRT(:,:,:,4), PRS(:,:,:,4), &
+ PRT(:,:,:,5), PRS(:,:,:,5), PRT(:,:,:,6), PRS(:,:,:,6), &
+ PSVT(:,:,:,NSV_ELECBEG), PSVS(:,:,:,NSV_ELECBEG), &
+ PSVT(:,:,:,NSV_ELECBEG+1), PSVS(:,:,:,NSV_ELECBEG+1), &
+ PSVT(:,:,:,NSV_ELECBEG+2), PSVS(:,:,:,NSV_ELECBEG+2), &
+ PSVT(:,:,:,NSV_ELECBEG+3), PSVS(:,:,:,NSV_ELECBEG+3), &
+ PSVT(:,:,:,NSV_ELECBEG+4), PSVS(:,:,:,NSV_ELECBEG+4), &
+ PSVT(:,:,:,NSV_ELECBEG+5), PSVS(:,:,:,NSV_ELECBEG+5), &
+ PSVT(:,:,:,NSV_ELECEND), PSVS(:,:,:,NSV_ELECEND) )
+ ELSE
+ CALL ICE_ADJUST (YLDIMPHYEX,CST, RAIN_ICE_PARAMN, NEBN, TURBN, &
+ PARAM_ICEN, TBUCONF, KRR, 'DEPI', &
+ 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 )
+ !
+ IF (HELEC == 'ELE4') THEN
+ ! Compute the condensation and sublimation rates
+ ZCND(:,:,:) = PRS(:,:,:,2) - ZRCS_BEF(:,:,:)
+ ZDEP(:,:,:) = PRS(:,:,:,4) - ZRIS_BEF(:,:,:)
+ !
+ ! Compute the charge exchanged during evaporation of cloud droplets (negative ZCND) and
+ ! during sublimation of ice crystals (negative ZDEP)
+ CALL ELEC_ADJUST (KRR, PRHODJ, HCLOUD, 'DEPI', &
+ PRC=ZRCS_BEF(:,:,:)*PTSTEP, PRI=ZRIS_BEF(:,:,:)*PTSTEP, &
+ PQC=PSVS(:,:,:,NSV_ELECBEG+1)*PTSTEP, &
+ PQI=PSVS(:,:,:,NSV_ELECBEG+3)*PTSTEP, &
+ PQCS=PSVS(:,:,:,NSV_ELECBEG+1), PQIS=PSVS(:,:,:,NSV_ELECBEG+3),&
+ PQPIS=PSVS(:,:,:,NSV_ELECBEG), PQNIS=PSVS(:,:,:,NSV_ELECEND), &
+ PCND=ZCND, PDEP=ZDEP)
+ END IF
+ END IF
END IF
-
+!
deallocate( zexn )
!
CASE ('ICE4')
@@ -896,6 +1139,13 @@ SELECT CASE ( HCLOUD )
ENDDO
ZZZ = MZF( PZZ )
IF(LRED .AND. LADJ_BEFORE) THEN
+ IF (HELEC == 'ELE4') THEN
+ ! save the cloud droplets and ice crystals m.r. source before adjustement
+ ZRCS_BEF(:,:,:) = PRS(:,:,:,2)
+ ZRIS_BEF(:,:,:) = PRS(:,:,:,4)
+ END IF
+ !
+ ! Perform the saturation ajdustment
CALL ICE_ADJUST (YLDIMPHYEX,CST, RAIN_ICE_PARAMN, NEBN, TURBN, &
PARAM_ICEN, TBUCONF, KRR, &
'ADJU', &
@@ -915,23 +1165,143 @@ SELECT CASE ( HCLOUD )
PRH=PRS(:,:,:,7)*PTSTEP, &
PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
+ !
+ IF (HELEC == 'ELE4') THEN
+ ! Compute the condensation and sublimation rates
+ ZCND(:,:,:) = PRS(:,:,:,2) - ZRCS_BEF(:,:,:)
+ ZDEP(:,:,:) = PRS(:,:,:,4) - ZRIS_BEF(:,:,:)
+ !
+ ! Compute the charge exchanged during evaporation of cloud droplets (negative ZCND) and
+ ! during sublimation of ice crystals (negative ZDEP)
+ CALL ELEC_ADJUST (KRR, PRHODJ, HCLOUD, 'ADJU', &
+ PRC=ZRCS_BEF(:,:,:)*PTSTEP, PRI=ZRIS_BEF(:,:,:)*PTSTEP, &
+ PQC=PSVS(:,:,:,NSV_ELECBEG+1)*PTSTEP, &
+ PQI=PSVS(:,:,:,NSV_ELECBEG+3)*PTSTEP, &
+ PQCS=PSVS(:,:,:,NSV_ELECBEG+1), PQIS=PSVS(:,:,:,NSV_ELECBEG+3),&
+ PQPIS=PSVS(:,:,:,NSV_ELECBEG), PQNIS=PSVS(:,:,:,NSV_ELECEND), &
+ PCND=ZCND, PDEP=ZDEP )
+ END IF
ENDIF
IF (LRED) THEN
- CALL RAIN_ICE (YLDIMPHYEX,CST, PARAM_ICEN, RAIN_ICE_PARAMN, &
- RAIN_ICE_DESCRN, TBUCONF, &
- 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 )
+ IF (HELEC == 'ELE4') THEN
+ ! to match with PHYEX, electric charge variables are no more optional, but their size
+ ! depends on the activation (or not) of the electrification scheme
+ GELEC = .TRUE.
+ ALLOCATE(ZQPIT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQNIT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQCT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQRT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQIT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQST(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQGT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQHT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQPIS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQNIS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQCS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQRS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQIS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQSS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQGS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ALLOCATE(ZQHS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ZQPIT(:,:,:) = PSVT(:,:,:,NSV_ELECBEG)
+ ZQCT(:,:,:) = PSVT(:,:,:,NSV_ELECBEG+1)
+ ZQRT(:,:,:) = PSVT(:,:,:,NSV_ELECBEG+2)
+ ZQIT(:,:,:) = PSVT(:,:,:,NSV_ELECBEG+3)
+ ZQST(:,:,:) = PSVT(:,:,:,NSV_ELECBEG+4)
+ ZQGT(:,:,:) = PSVT(:,:,:,NSV_ELECBEG+5)
+ ZQHT(:,:,:) = PSVT(:,:,:,NSV_ELECBEG+6)
+ ZQNIT(:,:,:) = PSVT(:,:,:,NSV_ELECEND)
+ ZQPIS(:,:,:) = PSVS(:,:,:,NSV_ELECBEG)
+ ZQCS(:,:,:) = PSVS(:,:,:,NSV_ELECBEG+1)
+ ZQRS(:,:,:) = PSVS(:,:,:,NSV_ELECBEG+2)
+ ZQIS(:,:,:) = PSVS(:,:,:,NSV_ELECBEG+3)
+ ZQSS(:,:,:) = PSVS(:,:,:,NSV_ELECBEG+4)
+ ZQGS(:,:,:) = PSVS(:,:,:,NSV_ELECBEG+5)
+ ZQHS(:,:,:) = PSVS(:,:,:,NSV_ELECBEG+6)
+ ZQNIS(:,:,:) = PSVS(:,:,:,NSV_ELECEND)
+ IF (LSEDIM_BEARD) THEN
+ ALLOCATE(ZEFIELDW(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)))
+ ZEFIELDW(:,:,:) = XEFIELDW(:,:,:)
+ ELSE
+ ALLOCATE(ZEFIELDW(0,0,0))
+ END IF
+ ELSE
+ GELEC = .FALSE.
+ ALLOCATE(ZQPIT(0,0,0))
+ ALLOCATE(ZQNIT(0,0,0))
+ ALLOCATE(ZQCT(0,0,0))
+ ALLOCATE(ZQRT(0,0,0))
+ ALLOCATE(ZQIT(0,0,0))
+ ALLOCATE(ZQST(0,0,0))
+ ALLOCATE(ZQGT(0,0,0))
+ ALLOCATE(ZQHT(0,0,0))
+ ALLOCATE(ZQPIS(0,0,0))
+ ALLOCATE(ZQNIS(0,0,0))
+ ALLOCATE(ZQCS(0,0,0))
+ ALLOCATE(ZQRS(0,0,0))
+ ALLOCATE(ZQIS(0,0,0))
+ ALLOCATE(ZQSS(0,0,0))
+ ALLOCATE(ZQGS(0,0,0))
+ ALLOCATE(ZQHS(0,0,0))
+ ALLOCATE(ZEFIELDW(0,0,0))
+ END IF
+ !
+ CALL RAIN_ICE (YLDIMPHYEX,CST, PARAM_ICEN, RAIN_ICE_PARAMN, RAIN_ICE_DESCRN, &
+ ELEC_PARAM, ELEC_DESCR, TBUCONF, GELEC, LSEDIM_BEARD, &
+ XTHVREFZ(IKB), HCLOUD, &
+ 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), &
+ ZQPIT, ZQCT, ZQRT, ZQIT, ZQST, ZQGT, ZQNIT, &
+ ZQPIS, ZQCS, ZQRS, ZQIS, ZQSS, ZQGS, ZQNIS, &
+ ZEFIELDW, ZLATHAM_IAGGS, &
+ PSEA, PTOWN, &
+ PRT(:,:,:,7), PRS(:,:,:,7), PINPRH, PFPR=ZFPR, &
+ PQHT=ZQHT, PQHS=ZQHS )
+ !
+ IF (HELEC == 'ELE4') THEN
+ PSVT(:,:,:,NSV_ELECBEG) = ZQPIT(:,:,:)
+ PSVT(:,:,:,NSV_ELECBEG+1) = ZQCT(:,:,:)
+ PSVT(:,:,:,NSV_ELECBEG+2) = ZQRT(:,:,:)
+ PSVT(:,:,:,NSV_ELECBEG+3) = ZQIT(:,:,:)
+ PSVT(:,:,:,NSV_ELECBEG+4) = ZQST(:,:,:)
+ PSVT(:,:,:,NSV_ELECBEG+5) = ZQGT(:,:,:)
+ PSVT(:,:,:,NSV_ELECBEG+6) = ZQHT(:,:,:)
+ PSVT(:,:,:,NSV_ELECEND) = ZQNIT(:,:,:)
+ PSVS(:,:,:,NSV_ELECBEG) = ZQPIS(:,:,:)
+ PSVS(:,:,:,NSV_ELECBEG+1) = ZQCS(:,:,:)
+ PSVS(:,:,:,NSV_ELECBEG+2) = ZQRS(:,:,:)
+ PSVS(:,:,:,NSV_ELECBEG+3) = ZQIS(:,:,:)
+ PSVS(:,:,:,NSV_ELECBEG+4) = ZQSS(:,:,:)
+ PSVS(:,:,:,NSV_ELECBEG+5) = ZQGS(:,:,:)
+ PSVS(:,:,:,NSV_ELECBEG+6) = ZQHS(:,:,:)
+ PSVS(:,:,:,NSV_ELECEND) = ZQNIS(:,:,:)
+ END IF
+ DEALLOCATE(ZQPIT)
+ DEALLOCATE(ZQNIT)
+ DEALLOCATE(ZQCT)
+ DEALLOCATE(ZQRT)
+ DEALLOCATE(ZQIT)
+ DEALLOCATE(ZQST)
+ DEALLOCATE(ZQGT)
+ DEALLOCATE(ZQHT)
+ DEALLOCATE(ZQPIS)
+ DEALLOCATE(ZQNIS)
+ DEALLOCATE(ZQCS)
+ DEALLOCATE(ZQRS)
+ DEALLOCATE(ZQIS)
+ DEALLOCATE(ZQSS)
+ DEALLOCATE(ZQGS)
+ DEALLOCATE(ZQHS)
+ DEALLOCATE(ZEFIELDW)
+ !
ELSE
CALL RAIN_ICE_OLD (YLDIMPHYEX, OSEDIC, CSEDIM, HSUBG_AUCV, OWARM, 1, IKU, 1, &
KSPLITR, PTSTEP, KRR, &
@@ -941,36 +1311,57 @@ SELECT CASE ( HCLOUD )
PRT(:,:,:,5), PRT(:,:,:,6), &
PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
- PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
+ PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
PINPRS, PINPRG, PSIGS,PINDEP, PRAINFR, &
PSEA, PTOWN, &
- PRT(:,:,:,7), PRS(:,:,:,7), PINPRH, PFPR=ZFPR)
+ 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_PARAMN, NEBN, TURBN, &
- PARAM_ICEN, TBUCONF, KRR, &
- 'DEPI', &
- 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 )
+ IF (HELEC == 'ELE4') THEN
+ ! save the cloud droplets and ice crystals m.r. source before adjustement
+ ZRCS_BEF(:,:,:) = PRS(:,:,:,2)
+ ZRIS_BEF(:,:,:) = PRS(:,:,:,4)
+ END IF
+ !
+ ! Perform the saturation ajdustment
+ CALL ICE_ADJUST (YLDIMPHYEX,CST, RAIN_ICE_PARAMN, NEBN, TURBN, &
+ PARAM_ICEN, TBUCONF, KRR, 'DEPI', &
+ 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 )
+ !
+ IF (HELEC == 'ELE4') THEN
+ ! Compute the condensation and sublimation rates
+ ZCND(:,:,:) = PRS(:,:,:,2) - ZRCS_BEF(:,:,:)
+ ZDEP(:,:,:) = PRS(:,:,:,4) - ZRIS_BEF(:,:,:)
+ !
+ ! Compute the charge exchanged during evaporation of cloud droplets (negative ZCND) and
+ ! during sublimation of ice crystals (negative ZDEP)
+ CALL ELEC_ADJUST (KRR, PRHODJ, HCLOUD, 'ADJU', &
+ PRC=ZRCS_BEF(:,:,:)*PTSTEP, PRI=ZRIS_BEF(:,:,:)*PTSTEP, &
+ PQC=PSVS(:,:,:,NSV_ELECBEG+1)*PTSTEP, &
+ PQI=PSVS(:,:,:,NSV_ELECBEG+3)*PTSTEP, &
+ PQCS=PSVS(:,:,:,NSV_ELECBEG+1), PQIS=PSVS(:,:,:,NSV_ELECBEG+3),&
+ PQPIS=PSVS(:,:,:,NSV_ELECBEG), PQNIS=PSVS(:,:,:,NSV_ELECEND), &
+ PCND=ZCND, PDEP=ZDEP )
+ END IF
END IF
deallocate( zexn )
@@ -983,74 +1374,123 @@ SELECT CASE ( HCLOUD )
!* 12.1 Compute the explicit microphysical sources
!
CASE ('LIMA')
- !
+ !
+ IF (HELEC == 'ELE4') THEN
+ GELEC = .TRUE.
+ ELSE
+ GELEC = .FALSE.
+ END IF
+ !
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, &
+ IF (LPTSPLIT) THEN
+ IF (GELEC) THEN
+ CALL LIMA (YLDIMPHYEX,CST, RAIN_ICE_DESCRN, RAIN_ICE_PARAMN, &
+ ELEC_DESCR, ELEC_PARAM, &
+ TBUCONF,TBUDGETS,SIZE(TBUDGETS), &
+ PTSTEP, GELEC, HCLOUD, &
+ PRHODREF, PEXNREF, ZDZZ, XTHVREFZ(IKB), &
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
+ PEVAP3D, PCLDFR, PICEFR, PRAINFR, ZFPR, &
+ ZLATHAM_IAGGS, XEFIELDW, &
+ PSVT(:,:,:,NSV_ELECBEG:NSV_ELECEND), &
+ PSVS(:,:,:,NSV_ELECBEG:NSV_ELECEND) )
+ ELSE
+ CALL LIMA (YLDIMPHYEX,CST, RAIN_ICE_DESCRN, RAIN_ICE_PARAMN, &
+ ELEC_DESCR, ELEC_PARAM, &
+ TBUCONF,TBUDGETS,SIZE(TBUDGETS), &
+ PTSTEP, GELEC, HCLOUD, &
+ PRHODREF, PEXNREF, ZDZZ, XTHVREFZ(IKB), &
+ 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, &
+ ZLATHAM_IAGGS )
+ END IF
+ 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
+ IF (HELEC == 'ELE4') THEN
+ ! save the cloud droplets and ice crystals m.r. source before adjustement
+ ZRCS_BEF(:,:,:) = PRS(:,:,:,2)
+ ZRIS_BEF(:,:,:) = PRS(:,:,:,4)
+ END IF
+ !
+ 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
+ !
+ IF (HELEC == 'ELE4') THEN
+ ! Compute the condensation and sublimation rates
+ ZCND(:,:,:) = PRS(:,:,:,2) - ZRCS_BEF(:,:,:)
+ ZDEP(:,:,:) = PRS(:,:,:,4) - ZRIS_BEF(:,:,:)
+ ! Compute the charge exchanged during evaporation of cloud droplets (negative ZCND) and
+ ! during sublimation of ice crystals (negative ZDEP)
+ CALL ELEC_ADJUST (KRR, PRHODJ, HCLOUD, 'CEDS', &
+ PRC=ZRCS_BEF(:,:,:)*PTSTEP, PRI=ZRIS_BEF(:,:,:)*PTSTEP, &
+ PQC=PSVS(:,:,:,NSV_ELECBEG+1)*PTSTEP, &
+ PQI=PSVS(:,:,:,NSV_ELECBEG+3)*PTSTEP, &
+ PQCS=PSVS(:,:,:,NSV_ELECBEG+1), PQIS=PSVS(:,:,:,NSV_ELECBEG+3),&
+ PQPIS=PSVS(:,:,:,NSV_ELECBEG), PQNIS=PSVS(:,:,:,NSV_ELECEND), &
+ PCND=ZCND, PDEP=ZDEP )
+ END IF
!
END SELECT
!
+IF (ALLOCATED(ZLATHAM_IAGGS)) DEALLOCATE(ZLATHAM_IAGGS)
+!
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
@@ -1080,12 +1520,11 @@ IF(HCLOUD=='ICE3' .OR. HCLOUD=='ICE4' ) THEN
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 )
-
-!-------------------------------------------------------------------------------
+call Sources_neg_correct( hcloud, helec, 'NECON', krr, ptstep, ppabst, ptht, prt, pths, prs, psvs, prhodj )
!
+!-------------------------------------------------------------------------------
!
!* 13. SWITCH BACK TO THE PROGNOSTIC VARIABLES
! ---------------------------------------
@@ -1101,7 +1540,22 @@ IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA')
PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) * PRHODJ(:,:,:)
ENDDO
ENDIF
-
+!
+IF (HELEC /= 'NONE') THEN
+ DO JSV = NSV_ELECBEG, NSV_ELECEND
+ PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) * PRHODJ(:,:,:)
+ END DO
+!
+!++cb-- ce qui suit n'est plus present en version standard en 5-6 : pourquoi ?
+! Note that the LiNOx Conc. (in mol/mol) is PSVS (:,::,NSV_LNOXBEG)
+! but there is no need to *PRHODJ(:,:,:) as it is done implicitly
+! during unit conversion in flash_geom.
+!
+ PSVS(:,:,:,NSV_ELECBEG) = MAX(0., PSVS(:,:,:,NSV_ELECBEG))
+ PSVS(:,:,:,NSV_ELECEND) = MAX(0., PSVS(:,:,:,NSV_ELECEND))
+END IF
+!
+!
!-------------------------------------------------------------------------------
!
END SUBROUTINE RESOLVED_CLOUD
diff --git a/src/mesonh/ext/rrcolss.f90 b/src/mesonh/ext/rrcolss.f90
deleted file mode 100644
index 0dac2fa04b4ba96dba68bb07e5ded522557851ea..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/rrcolss.f90
+++ /dev/null
@@ -1,315 +0,0 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ###################
- MODULE MODI_RRCOLSS
-! ###################
-!
-INTERFACE
-!
- SUBROUTINE RRCOLSS( KND, PALPHAS, PNUS, PALPHAR, PNUR, &
- PESR, PEXMASSR, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR, &
- PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
- PDINFTY, PRRCOLSS, PAG, PBS, PAS )
-!
-INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DS and DR
-!
-REAL, INTENT(IN) :: PALPHAS ! First shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUS ! Second shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PALPHAR ! First shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUR ! Second shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PESR ! Efficiency of aggregates collecting rain
-REAL, INTENT(IN) :: PEXMASSR ! Mass exponent of rain
-REAL, INTENT(IN) :: PFALLS ! Fall speed constant of aggregates
-REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of aggregates
-REAL, INTENT(IN) :: PFALLEXPS ! Fall speed exponential of aggregates (Thompson 2008)
-REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain
-REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain
-REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of aggregates
-REAL, INTENT(IN) :: PLBDARMAX ! Maximun slope of size distribution of rain
-REAL, INTENT(IN) :: PLBDASMIN ! Minimun slope of size distribution of aggregates
-REAL, INTENT(IN) :: PLBDARMIN ! Minimun slope of size distribution of rain
-REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
- ! which the diameter integration is performed
-REAL, INTENT(IN) :: PAG, PBS, PAS
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRRCOLSS! Scaled fall speed difference in
- ! the mass collection kernel as a
- ! function of LAMBDAX and LAMBDAZ
-!
- END SUBROUTINE RRCOLSS
-!
-END INTERFACE
-!
- END MODULE MODI_RRCOLSS
-! ########################################################################
- SUBROUTINE RRCOLSS( KND, PALPHAS, PNUS, PALPHAR, PNUR, &
- PESR, PEXMASSR, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR, &
- PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
- PDINFTY, PRRCOLSS, PAG, PBS, PAS )
-! ########################################################################
-!
-!
-!
-!!**** * - Build up a look-up table containing the scaled fall speed
-!! difference between size distributed particles of aggregates and Z
-!!
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to integrate numerically the scaled fall
-!! speed difference between aggregates and rain for use in collection
-!! kernels. A first integral of the form
-!!
-!! infty Dz_max
-!! / /
-!! |{| }
-!! |{| E_xz (Dx+Dz)^2 |cxDx^dx-czDz^dz| Dz^bz n(Dz) dDz} n(Dx) dDx
-!! |{| }
-!! / /
-!! 0 Dz_min
-!!
-!! is evaluated and normalised by a second integral of the form
-!!
-!! infty
-!! / /
-!! |{| }
-!! |{| (Dx+Dz)^2 Dz^bz n(Dz) dDz} n(Dx) dDx
-!! |{| }
-!! / /
-!! 0
-!!
-!! The result is stored in a two-dimensional array.
-!!
-!!** METHOD
-!! ------
-!! The free parameters of the size distribution function of aggregates and Z
-!! (slope parameter LAMBDA) are discretized with a geometrical rate in a
-!! specific range
-!! LAMBDA = exp( (Log(LAMBDA_max) - Log(LAMBDA_min))/N_interval )
-!! The two above integrals are performed using the trapezoidal scheme.
-!!
-!! EXTERNAL
-!! --------
-!! MODI_GENERAL_GAMMA: Generalized gamma distribution law
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! MODD_CST : XPI,XRHOLW
-!! MODD_RAIN_ICE_DESCR: XAS,XAS,XBS
-!!
-!! REFERENCE
-!! ---------
-!! B.S. Ferrier , 1994 : A Double-Moment Multiple-Phase Four-Class
-!! Bulk Ice Scheme,JAS,51,249-280.
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 8/11/95
-!!
-! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-! J. Wurtz 03/2022: new snow characteristics
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE MODI_GENERAL_GAMMA
-!
-USE MODD_CST
-USE MODD_RAIN_ICE_DESCR_n
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 Declarations of dummy arguments
-! -------------------------------
-!
-!
-INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DS and DR
-!
-REAL, INTENT(IN) :: PALPHAS ! First shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUS ! Second shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PALPHAR ! First shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUR ! Second shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PESR ! Efficiency of aggregates collecting rain
-REAL, INTENT(IN) :: PEXMASSR ! Mass exponent of rain
-REAL, INTENT(IN) :: PFALLS ! Fall speed constant of aggregates
-REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of aggregates
-REAL, INTENT(IN) :: PFALLEXPS ! Fall speed exponential of aggregates (Thompson 2008)
-REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain
-REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain
-REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of aggregates
-REAL, INTENT(IN) :: PLBDARMAX ! Maximun slope of size distribution of rain
-REAL, INTENT(IN) :: PLBDASMIN ! Minimun slope of size distribution of aggregates
-REAL, INTENT(IN) :: PLBDARMIN ! Minimun slope of size distribution of rain
-REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
- ! which the diameter integration is performed
-REAL, INTENT(IN) :: PAG, PBS, PAS
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRRCOLSS! Scaled fall speed difference in
- ! the mass collection kernel as a
- ! function of LAMBDAX and LAMBDAZ
-!
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-!
-INTEGER :: JLBDAS ! Slope index of the size distribution of aggregates
-INTEGER :: JLBDAR ! Slope index of the size distribution of rain
-INTEGER :: JDS ! Diameter index of a particle of aggregates
-INTEGER :: JDR ! Diameter index of a particle of rain
-!
-INTEGER :: INR ! Number of diameter step for the partial integration
-!
-!
-REAL :: ZLBDAS ! Current slope parameter LAMBDA of aggregates
-REAL :: ZLBDAR ! Current slope parameter LAMBDA of rain
-REAL :: ZDLBDAS ! Growth rate of the slope parameter LAMBDA of aggregates
-REAL :: ZDLBDAR ! Growth rate of the slope parameter LAMBDA of rain
-REAL :: ZDDS ! Integration step of the diameter of aggregates
-REAL :: ZDDSCALR! Integration step of the diameter of rain (scaling integral)
-REAL :: ZDDCOLLR! Integration step of the diameter of rain (fallspe integral)
-REAL :: ZDS ! Current diameter of the particle aggregates
-REAL :: ZDR ! Current diameter of the rain
-REAL :: ZDRMAX ! Maximal diameter of the raindrops where the integration ends
-REAL :: ZCOLLR ! Single integral of the mass weighted fall speed difference
- ! over the spectrum of rain
-REAL :: ZCOLLDRMAX ! Maximum ending point for the partial integral
-REAL :: ZCOLLSR ! Double integral of the mass weighted fall speed difference
- ! over the spectra of aggregates and rain
-REAL :: ZSCALR ! Single integral of the scaling factor over
- ! the spectrum of rain
-REAL :: ZSCALSR ! Double integral of the scaling factor over
- ! the spectra of aggregates and rain
-REAL :: ZFUNC ! Ancillary function
-REAL :: ZCST1
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1 COMPUTE THE SCALED VELOCITY DIFFERENCE IN THE MASS
-!* COLLECTION KERNEL,
-! -------------------------------------------------
-!
-!
-!
-!* 1.0 Initialization
-!
-PRRCOLSS(:,:) = 0.0
-ZCST1 = (3.0/XPI)/XRHOLW
-!
-!* 1.1 Compute the growth rate of the slope factors LAMBDA
-!
-ZDLBDAS = EXP( LOG(PLBDASMAX/PLBDASMIN)/REAL(SIZE(PRRCOLSS(:,:),1)-1) )
-ZDLBDAR = EXP( LOG(PLBDARMAX/PLBDARMIN)/REAL(SIZE(PRRCOLSS(:,:),2)-1) )
-!
-!* 1.2 Scan the slope factors LAMBDAX and LAMBDAZ
-!
-DO JLBDAS = 1,SIZE(PRRCOLSS(:,:),1)
- ZLBDAS = PLBDASMIN * ZDLBDAS ** (JLBDAS-1)
-!
-!* 1.3 Compute the diameter steps
-!
- ZDDS = PDINFTY / (REAL(KND) * ZLBDAS)
- DO JLBDAR = 1,SIZE(PRRCOLSS(:,:),2)
- ZLBDAR = PLBDARMIN * ZDLBDAR ** (JLBDAR-1)
-!
-!* 1.4 Initialize the collection integrals
-!
- ZSCALSR = 0.0
- ZCOLLSR = 0.0
-!
-!* 1.5 Compute the diameter steps
-!
- ZDDSCALR = PDINFTY / (REAL(KND) * ZLBDAR)
-!
-!* 1.6 Scan over the diameters DS and DR
-!
- DO JDS = 1,KND-1
- ZDS = ZDDS * REAL(JDS)
- ZSCALR = 0.0
- ZCOLLR = 0.0
- DO JDR = 1,KND-1
- ZDR = ZDDSCALR * REAL(JDR)
-!
-!* 1.7 Compute the normalization factor by integration over the
-! dimensional spectrum of rain
-!
- ZSCALR = ZSCALR + (ZDS+ZDR)**2 * ZDR**PEXMASSR &
- * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR)
- END DO
-!
-!* 1.8 Compute the scaled fall speed difference by partial
-! integration over the dimensional spectrum of rain
-!
- ZFUNC = PAG - PAS*ZDS**(PBS-3.0) ! approximate limit is Ds=240 microns
- IF( ZFUNC>0.0 ) THEN
- ZDRMAX = ZDS*( ZCST1*ZFUNC )**0.3333333
- ELSE
- ZDRMAX = PDINFTY / ZLBDAR
- END IF
- IF( ZDS>1.0E-4 ) THEN ! allow computation if Ds>100 microns
- ! corresponding to a maximal density of the aggregates of XRHOLW
- IF( ZDRMAX >= 0.5*ZDDSCALR ) THEN
- INR = CEILING( ZDRMAX/ZDDSCALR )
- ZDDCOLLR = ZDRMAX / REAL(INR)
- IF (INR>=KND ) THEN
- INR = KND
- ZDDCOLLR = ZDDSCALR
- END IF
- DO JDR = 1,INR-1
- ZDR = ZDDCOLLR * REAL(JDR)
- ZCOLLR = ZCOLLR + (ZDS+ZDR)**2 * ZDR**PEXMASSR &
- * PESR * ABS(PFALLS*ZDS**PEXFALLS * EXP(-(PFALLEXPS*ZDS)**PALPHAS)-PFALLR*ZDR**PEXFALLR) &
- * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR)
- END DO
- ZCOLLDRMAX = (ZDS+ZDRMAX)**2 * ZDRMAX**PEXMASSR &
- * PESR * ABS(PFALLS*ZDS**PEXFALLS* EXP(-(PFALLEXPS*ZDS)**PALPHAS)-PFALLR*ZDRMAX**PEXFALLR) &
- * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDRMAX)
- ZCOLLR = (ZCOLLR + 0.5*ZCOLLDRMAX)*(ZDDCOLLR/ZDDSCALR)
-!
-!* 1.9 Compute the normalization factor by integration over the
-! dimensional spectrum of aggregates
-!
- ZFUNC = GENERAL_GAMMA(PALPHAS,PNUS,ZLBDAS,ZDS)
- ZSCALSR = ZSCALSR + ZSCALR * ZFUNC
-!
-!* 1.10 Compute the scaled fall speed difference by integration over
-! the dimensional spectrum of aggregates
-!
- ZCOLLSR = ZCOLLSR + ZCOLLR * ZFUNC
- END IF
-!
-! Otherwise ZDRMAX = 0.0 so the density of the graupel cannot be reached
-! and so PRRCOLSS(JLBDAS,JLBDAR) = 0.0 !
-!
- END IF
- END DO
-!
-!* 1.11 Scale the fall speed difference
-!
- IF( ZSCALSR>0.0 ) PRRCOLSS(JLBDAS,JLBDAR) = ZCOLLSR / ZSCALSR
- END DO
-END DO
-!
-END SUBROUTINE RRCOLSS
diff --git a/src/mesonh/ext/rscolrg.f90 b/src/mesonh/ext/rscolrg.f90
deleted file mode 100644
index 26969afcd4b3282beafb10e659a0b0d547cfc125..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/rscolrg.f90
+++ /dev/null
@@ -1,315 +0,0 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ###################
- MODULE MODI_RSCOLRG
-! ###################
-!
-INTERFACE
-!
- SUBROUTINE RSCOLRG( KND, PALPHAS, PZNUS, PALPHAR, PNUR, &
- PESR, PEXMASSS, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR, &
- PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
- PDINFTY, PRSCOLRG,PAG, PBS, PAS )
-!
-INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DS and DR
-!
-REAL, INTENT(IN) :: PALPHAS ! First shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PZNUS ! Second shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PALPHAR ! First shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUR ! Second shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PESR ! Efficiency of the aggregates collecting rain
-REAL, INTENT(IN) :: PEXMASSS ! Mass exponent of the aggregates
-REAL, INTENT(IN) :: PFALLS ! Fall speed constant of the aggregates
-REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of the aggregates
-REAL, INTENT(IN) :: PFALLEXPS ! Fall speed exponential constant of the aggregates
-REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain
-REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain
-REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of the aggregates
-REAL, INTENT(IN) :: PLBDARMAX ! Maximun slope of size distribution of rain
-REAL, INTENT(IN) :: PLBDASMIN ! Minimun slope of size distribution of the aggregates
-REAL, INTENT(IN) :: PLBDARMIN ! Minimun slope of size distribution of rain
-REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
- ! which the diameter integration is performed
-REAL, INTENT(IN) :: PAG, PBS, PAS
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRSCOLRG! Scaled fall speed difference in
- ! the mass collection kernel as a
- ! function of LAMBDAX and LAMBDAZ
-!
- END SUBROUTINE RSCOLRG
-!
-END INTERFACE
-!
- END MODULE MODI_RSCOLRG
-! ########################################################################
- SUBROUTINE RSCOLRG( KND, PALPHAS, PZNUS, PALPHAR, PNUR, &
- PESR, PEXMASSS, PFALLS, PEXFALLS, PFALLEXPS, PFALLR, PEXFALLR, &
- PLBDASMAX, PLBDARMAX, PLBDASMIN, PLBDARMIN, &
- PDINFTY, PRSCOLRG,PAG, PBS, PAS )
-! ########################################################################
-!
-!
-!
-!!**** * - Build up a look-up table containing the scaled fall speed
-!! difference between size distributed particles of the aggregates and Z
-!!
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to integrate numerically the scaled fall
-!! speed difference between aggregates and rain for use in collection
-!! kernels. A first integral of the form
-!!
-!! infty Dz_max
-!! / /
-!! |{| }
-!! |{| E_xz (Dx+Dz)^2 |cxDx^dx-czDz^dz| Dz^bz n(Dz) dDz} n(Dx) dDx
-!! |{| }
-!! / /
-!! 0 Dz_min
-!!
-!! is evaluated and normalised by a second integral of the form
-!!
-!! infty
-!! / /
-!! |{| }
-!! |{| (Dx+Dz)^2 Dz^bz n(Dz) dDz} n(Dx) dDx
-!! |{| }
-!! / /
-!! 0
-!!
-!! The result is stored in a two-dimensional array.
-!!
-!!** METHOD
-!! ------
-!! The free parameters of the size distribution function of the aggregates
-!! and Z (slope parameter LAMBDA) are discretized with a geometrical rate
-!! in a specific range
-!! LAMBDA = exp( (Log(LAMBDA_max) - Log(LAMBDA_min))/N_interval )
-!! The two above integrals are performed using the trapezoidal scheme.
-!!
-!! EXTERNAL
-!! --------
-!! MODI_GENERAL_GAMMA: Generalized gamma distribution law
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! MODD_CST : XPI,XRHOLW
-!! MODD_RAIN_ICE_DESCR: XAS,XAS,XBS
-!!
-!! REFERENCE
-!! ---------
-!! B.S. Ferrier , 1994 : A Double-Moment Multiple-Phase Four-Class
-!! Bulk Ice Scheme,JAS,51,249-280.
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 8/11/95
-!!
-! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-! J. Wurtz 03/2022: new snow characteristics
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODI_GENERAL_GAMMA
-!
-USE MODD_CST
-USE MODD_RAIN_ICE_DESCR_n
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments
-! -------------------------------
-!
-!
-INTEGER, INTENT(IN) :: KND ! Number of discrete size intervals in DS and DR
-!
-REAL, INTENT(IN) :: PALPHAS ! First shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PZNUS ! Second shape parameter of the aggregates
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PALPHAR ! First shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PNUR ! Second shape parameter of the rain
- ! size distribution (generalized gamma law)
-REAL, INTENT(IN) :: PESR ! Efficiency of the aggregates collecting rain
-REAL, INTENT(IN) :: PEXMASSS ! Mass exponent of the aggregates
-REAL, INTENT(IN) :: PFALLS ! Fall speed constant of the aggregates
-REAL, INTENT(IN) :: PEXFALLS ! Fall speed exponent of the aggregates
-REAL, INTENT(IN) :: PFALLEXPS ! Fall speed exponential constant of the aggregates
-REAL, INTENT(IN) :: PFALLR ! Fall speed constant of rain
-REAL, INTENT(IN) :: PEXFALLR ! Fall speed exponent of rain
-REAL, INTENT(IN) :: PLBDASMAX ! Maximun slope of size distribution of the aggregates
-REAL, INTENT(IN) :: PLBDARMAX ! Maximun slope of size distribution of rain
-REAL, INTENT(IN) :: PLBDASMIN ! Minimun slope of size distribution of the aggregates
-REAL, INTENT(IN) :: PLBDARMIN ! Minimun slope of size distribution of rain
-REAL, INTENT(IN) :: PDINFTY ! Factor to define the largest diameter up to
- ! which the diameter integration is performed
-REAL, INTENT(IN) :: PAG, PBS, PAS
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRSCOLRG! Scaled fall speed difference in
- ! the mass collection kernel as a
- ! function of LAMBDAX and LAMBDAZ
-!
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-!
-INTEGER :: JLBDAS ! Slope index of the size distribution of the aggregates
-INTEGER :: JLBDAR ! Slope index of the size distribution of rain
-INTEGER :: JDS ! Diameter index of a particle of the aggregates
-INTEGER :: JDR ! Diameter index of a particle of rain
-!
-INTEGER :: INR ! Number of diameter step for the partial integration
-!
-REAL :: ZLBDAS ! Current slope parameter LAMBDA of the aggregates
-REAL :: ZLBDAR ! Current slope parameter LAMBDA of rain
-REAL :: ZDLBDAS ! Growth rate of the slope parameter LAMBDA of the aggregates
-REAL :: ZDLBDAR ! Growth rate of the slope parameter LAMBDA of rain
-REAL :: ZDDS ! Integration step of the diameter of the aggregates
-REAL :: ZDDSCALR! Integration step of the diameter of rain (scaling integral)
-REAL :: ZDDCOLLR! Integration step of the diameter of rain (fallspe integral)
-REAL :: ZDS ! Current diameter of the particle aggregates
-REAL :: ZDR ! Current diameter of the raindrops
-REAL :: ZDRMIN ! Minimal diameter of the raindrops where the integration starts
-REAL :: ZDRMAX ! Maximal diameter of the raindrops where the integration ends
-REAL :: ZCOLLR ! Single integral of the mass weighted fall speed difference
- ! over the spectrum of rain
-REAL :: ZCOLLDRMIN ! Minimum ending point for the partial integral
-REAL :: ZCOLLSR ! Double integral of the mass weighted fall speed difference
- ! over the spectra of the aggregates and rain
-REAL :: ZSCALR ! Single integral of the scaling factor over
- ! the spectrum of rain
-REAL :: ZSCALSR ! Double integral of the scaling factor over
- ! the spectra of the aggregates and rain
-REAL :: ZFUNC ! Ancillary function
-REAL :: ZCST1
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1 COMPUTE THE SCALED VELOCITY DIFFERENCE IN THE MASS
-!* COLLECTION KERNEL,
-! -------------------------------------------------
-!
-!
-!* 1.0 Initialization
-!
-PRSCOLRG(:,:) = 0.0
-ZCST1 = (3.0/XPI)/XRHOLW
-!
-!* 1.1 Compute the growth rate of the slope factors LAMBDA
-!
-ZDLBDAR = EXP( LOG(PLBDARMAX/PLBDARMIN)/REAL(SIZE(PRSCOLRG(:,:),1)-1) )
-ZDLBDAS = EXP( LOG(PLBDASMAX/PLBDASMIN)/REAL(SIZE(PRSCOLRG(:,:),2)-1) )
-!
-!* 1.2 Scan the slope factors LAMBDAX and LAMBDAZ
-!
-DO JLBDAR = 1,SIZE(PRSCOLRG(:,:),1)
- ZLBDAR = PLBDARMIN * ZDLBDAR ** (JLBDAR-1)
- ZDRMAX = PDINFTY / ZLBDAR
-!
-!* 1.3 Compute the diameter steps
-!
- ZDDSCALR = PDINFTY / (REAL(KND) * ZLBDAR)
- DO JLBDAS = 1,SIZE(PRSCOLRG(:,:),2)
- ZLBDAS = PLBDASMIN * ZDLBDAS ** (JLBDAS-1)
-!
-!* 1.4 Initialize the collection integrals
-!
- ZSCALSR = 0.0
- ZCOLLSR = 0.0
-!
-!* 1.5 Compute the diameter steps
-!
- ZDDS = PDINFTY / (REAL(KND) * ZLBDAS)
-!
-!* 1.6 Scan over the diameters DS and DR
-!
- DO JDS = 1,KND-1
- ZDS = ZDDS * REAL(JDS)
- ZSCALR = 0.0
- ZCOLLR = 0.0
- DO JDR = 1,KND-1
- ZDR = ZDDSCALR * REAL(JDR)
-!
-!* 1.7 Compute the normalization factor by integration over the
-! dimensional spectrum of rain
-!
- ZSCALR = ZSCALR + (ZDS+ZDR)**2 * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR)
- END DO
-!
-!* 1.8 Compute the scaled fall speed difference by partial
-! integration over the dimensional spectrum of rain
-!
- ZFUNC = PAG - PAS*ZDS**(PBS-3.0) ! approximate limit is Ds=240 microns
- IF( ZFUNC>0.0 ) THEN
- ZDRMIN = ZDS*( ZCST1*ZFUNC )**0.3333333
- ELSE
- ZDRMIN = 0.0
- END IF
- IF( ZDS>1.0E-4 ) THEN ! allow computation if Ds>100 microns
- ! corresponding to a maximal density of the aggregates of XRHOLW
- IF( (ZDRMAX-ZDRMIN) >= 0.5*ZDDSCALR ) THEN
- INR = CEILING( (ZDRMAX-ZDRMIN)/ZDDSCALR )
- ZDDCOLLR = (ZDRMAX-ZDRMIN) / REAL(INR)
- DO JDR = 1,INR-1
- ZDR = ZDDCOLLR * REAL(JDR) + ZDRMIN
- ZCOLLR = ZCOLLR + (ZDS+ZDR)**2 &
- * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDR) &
- * PESR * ABS(PFALLS*ZDS**PEXFALLS*EXP(-(ZDS*PFALLEXPS)**PALPHAS)-PFALLR*ZDR**PEXFALLR)
- END DO
- IF( ZDRMIN>0.0 ) THEN
- ZCOLLDRMIN = (ZDS+ZDRMIN)**2 &
- * GENERAL_GAMMA(PALPHAR,PNUR,ZLBDAR,ZDRMIN) &
- * PESR * ABS(PFALLS*ZDS**PEXFALLS*EXP(-(ZDS*PFALLEXPS)**PALPHAS)-PFALLR*ZDRMIN**PEXFALLR)
- ELSE
- ZCOLLDRMIN = 0.0
- END IF
- ZCOLLR = (ZCOLLR + 0.5*ZCOLLDRMIN)*(ZDDCOLLR/ZDDSCALR)
-!
-!* 1.9 Compute the normalization factor by integration over the
-! dimensional spectrum of the aggregates
-!
- ZFUNC = (ZDS**PEXMASSS) * GENERAL_GAMMA(PALPHAS,PZNUS,ZLBDAS,ZDS)
- ZSCALSR = ZSCALSR + ZSCALR * ZFUNC
-!
-!* 1.10 Compute the scaled fall speed difference by integration over
-! the dimensional spectrum of the aggregates
-!
- ZCOLLSR = ZCOLLSR + ZCOLLR * ZFUNC
-!
-! Otherwise ZDRMIN>ZDRMAX so PRRCOLSS(JLBDAS,JLBDAR) = 0.0 !
-!
- END IF
-!
-! Otherwise ZDRMAX = 0.0 so the density of the graupel cannot be reached
-! and so PRRCOLSS(JLBDAS,JLBDAR) = 0.0 !
-!
- END IF
- END DO
-!
-!* 1.10 Scale the fall speed difference
-!
- IF( ZSCALSR>0.0 ) PRSCOLRG(JLBDAR,JLBDAS) = ZCOLLSR / ZSCALSR
- END DO
-END DO
-!
-END SUBROUTINE RSCOLRG
diff --git a/src/mesonh/ext/series_cloud_elec.f90 b/src/mesonh/ext/series_cloud_elec.f90
deleted file mode 100644
index c740922db924e0a69472a670046a154571f3977e..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/series_cloud_elec.f90
+++ /dev/null
@@ -1,618 +0,0 @@
-!MNH_LIC Copyright 2010-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_SERIES_CLOUD_ELEC
-! #############################
-!
-INTERFACE
- SUBROUTINE SERIES_CLOUD_ELEC (KTCOUNT, PTSTEP, &
- PZZ, PRHODJ, PRHODREF, PEXNREF, &
- PRT, PRS, PSVT, &
- PTHT, PWT, PPABST, PCIT, &
- TPFILE_SERIES_CLOUD_ELEC, &
- PINPRR )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
-!
-REAL, INTENT(IN) :: PTSTEP ! Double time step except for cold start
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Moist variables at time t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRS ! Moist variable sources
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Scalar variable at time t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWT ! Vertical velocity at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! ab. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Pristine ice number
- ! concentration at time t
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE_SERIES_CLOUD_ELEC
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
-!
-END SUBROUTINE SERIES_CLOUD_ELEC
-END INTERFACE
-END MODULE MODI_SERIES_CLOUD_ELEC
-!
-!
-! ###############################################################
- SUBROUTINE SERIES_CLOUD_ELEC (KTCOUNT, PTSTEP, &
- PZZ, PRHODJ, PRHODREF, PEXNREF, &
- PRT, PRS, PSVT, &
- PTHT, PWT, PPABST, PCIT, &
- TPFILE_SERIES_CLOUD_ELEC, &
- PINPRR )
-! ###############################################################
-!
-!!**** * -
-!!
-!! PURPOSE
-!! -------
-!!
-!! METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! C. Bovalo * LA *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original : Avril 2010
-!! Modifications:
-!! C. Barthe * LACy * Dec. 2010 add some parameters
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! Philippe Wautelet: 10/01/2019: use NEWUNIT argument of OPEN
-!! Philippe Wautelet: 22/01/2019: use standard FLUSH statement instead of non standard intrinsics
-! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-!
-!-------------------------------------------------------------------------------
-!
-! 0. DECLARATIONS
-! ------------
-!
-USE MODD_CONF, ONLY: CEXP
-USE MODD_CST
-USE MODD_DYN_n, ONLY: XDXHATM, XDYHATM
-USE MODD_ELEC_DESCR
-USE MODD_ELEC_PARAM
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELECEND
-USE MODD_PARAMETERS
-USE MODD_RAIN_ICE_DESCR_n
-USE MODD_RAIN_ICE_PARAM_n
-USE MODD_REF
-
-USE MODI_MOMG
-USE MODI_RADAR_RAIN_ICE
-
-USE MODE_ELEC_ll
-USE MODE_ll
-use mode_tools, only: Countjv
-
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
-!
-REAL, INTENT(IN) :: PTSTEP ! Double time step except for cold start
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Moist variables at time t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRS ! Moist variable sources
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Scalar variable at time t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWT ! Vertical velocity at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! ab. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Pristine ice number
- ! concentration at time t
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE_SERIES_CLOUD_ELEC
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
-!
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: II, IJ, IK
-INTEGER :: IIB,IIE ! Indices for the first and last inner mass point along x
-INTEGER :: IJB,IJE ! Indices for the first and last inner mass point along y
-INTEGER :: IKB,IKE ! Indices for the first and last inner mass point along z
-INTEGER :: JCOUNT_STOP
-INTEGER :: ICOUNT ! counter for iwp computation
-INTEGER :: IPROC ! my proc number
-INTEGER :: IPROC_MAX ! proc that contains max value
-INTEGER :: IINFO_ll ! return code of parallel routine
-INTEGER :: ILU ! unit number for IO
-!
-INTEGER, SAVE :: JCOUNT
-!
-INTEGER, DIMENSION(SIZE(PRT,1),SIZE(PRT,2)) :: IFLAG
-!
-REAL :: ZRHO00 ! Surface reference air density
-REAL :: ZMASS_SP ! Precipitation snow mass (kg)
-REAL :: ZMASS_GP ! Precipitation graupel mass (kg)
-REAL :: ZFLUX_I ! Ice crystal mass flux (kg m/s)
-REAL :: ZFLUX_SP ! Precipitation snow mass flux (kg m/s)
-REAL :: ZFLUX_SNP ! Non precipitation snow mass flux (kg m/s)
-REAL :: ZFLUX_G ! Graupel mass flux (kg m/s)
-REAL :: ZCLD_TOP_REF ! Cloud top height (m) from radar refl.
-REAL :: ZCLD_TOP_MR ! Cloud top height (m) from mixing ratio
-REAL :: ZICE_MASS ! Ice mass (kg)
-!
-REAL, SAVE :: ZMASS_C ! Cloud water mass (kg)
-REAL, SAVE :: ZMASS_R ! Rain water mass (kg)
-REAL, SAVE :: ZMASS_I ! Ice crystal mass (kg)
-REAL, SAVE :: ZMASS_S ! Snow mass (kg)
-REAL, SAVE :: ZMASS_G ! Graupel mass (kg)
-REAL, SAVE :: ZMASS_ICE_P ! Precipitation ice mass (kg)
-REAL, SAVE :: ZFLUX_PROD ! Ice mass flux product (kg^2 m^2/s^2)
-REAL, SAVE :: ZFLUX_PRECIP ! Precipitation ice mass flux (kg m/s)
-REAL, SAVE :: ZFLUX_NPRECIP ! Non-precipitation ice mass flux (kg m/s)
-REAL, SAVE :: ZVOL_UP5 ! Updraft volume for W > 5 m/s (m^3)
-REAL, SAVE :: ZVOL_UP10 ! Updraft volume for W > 10 m/s (m^3)
-REAL, SAVE :: ZWMAX ! Maximum vertical velocity (m/s)
-REAL, SAVE :: ZVOL_G ! Graupel volume (m^3)
-REAL, SAVE :: ZIWP ! Ice water path (kg/m^2)
-REAL, SAVE :: ZCTH_MR ! Cloud top height / m.r. > 1.e-4 kg/kg (m)
-REAL, SAVE :: ZCTH_REF ! Cloud top height / Z > 20 dBZ (m)
-REAL, SAVE :: ZCLD_VOL ! Cloud volume (m^3)
-REAL, SAVE :: ZDBZMAX ! Max radar reflectivity (dBZ)
-REAL, SAVE :: ZINPRR ! Rain instant precip. (mm/H)
-REAL, SAVE :: ZMAX_INPRR ! Maximum rain instant. precip. (mm/H)
-!
-REAL, DIMENSION(SIZE(XRTMIN)) :: ZRTMIN
-! XRTMIN = Minimum value for the mixing ratio
-! ZRTMIN = Minimum value for the source (tendency)
-!
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: &
- ZTCT ! Temperature in Degrees Celsius
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: &
- ZWORK31, ZWORK32, ZWORK33, ZWORK34
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCLOUD
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLAMBDAS
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLAMBDAG
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZVTS
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZVTG
-!
-LOGICAL, SAVE :: GFIRSTCALL = .TRUE.
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. COMPUTE THE LOOP BOUNDS AND SOME PARAMETERS
-! -------------------------------------------
-!
-JCOUNT_STOP = INT(NTSAVE_SERIES/PTSTEP)
-!
-!* 1.1 beginning and end indexes of the physical subdomain
-!
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IKB = 1 + JPVEXT
-IKE = SIZE(PZZ,3) - JPVEXT
-!
-!
-!* 1.2 compute some parameters
-!
-! temperature : K -> C
-ZTCT(:,:,:) = (PTHT(:,:,:) * (PPABST(:,:,:) / XP00)**(XRD/XCPD)) - XTT
-!
-! total mixing ratio
-ALLOCATE(ZCLOUD(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)))
-ZCLOUD(:,:,:) = 0.
-ZCLOUD(IIB:IIE,IJB:IJE,IKB:IKE) = PRT(IIB:IIE,IJB:IJE,IKB:IKE,2) + &
- PRT(IIB:IIE,IJB:IJE,IKB:IKE,3) + &
- PRT(IIB:IIE,IJB:IJE,IKB:IKE,4) + &
- PRT(IIB:IIE,IJB:IJE,IKB:IKE,5) + &
- PRT(IIB:IIE,IJB:IJE,IKB:IKE,6)
-!
-!
-!* 1.3 compute the terminal fall speed
-!
-! the mean terminal fall speed is computed following:
-! V_mean = Int(v(D) n(D) dD) / Int(n(D) dD)
-!
-ALLOCATE(ZLAMBDAS(SIZE(PRT,1), SIZE(PRT,2), SIZE(PRT,3)))
-ALLOCATE(ZLAMBDAG(SIZE(PRT,1), SIZE(PRT,2), SIZE(PRT,3)))
-ALLOCATE(ZVTS(SIZE(PRT,1), SIZE(PRT,2), SIZE(PRT,3)))
-ALLOCATE(ZVTG(SIZE(PRT,1), SIZE(PRT,2), SIZE(PRT,3)))
-!
-ZLAMBDAS(:,:,:) = 0.
-ZLAMBDAG(:,:,:) = 0.
-ZVTS(:,:,:) = 0.
-ZVTG(:,:,:) = 0.
-!
-! Surface reference air density
-ZRHO00 = XP00 / (XRD * XTHVREFZ(IKB))
-!
-! for snow
-WHERE (PRT(:,:,:,5) .GT. 1.E-12)
- ZLAMBDAS(:,:,:) = MIN(XLBDAS_MAX, &
- XLBS * (PRHODREF(:,:,:) * &
- MAX(PRT(:,:,:,5), XRTMIN(5)))**XLBEXS)
- ZVTS(:,:,:) = XCS * MOMG(XALPHAS, XNUS, XBS+XDS) * ZLAMBDAS(:,:,:)**(-XDS) * &
- (ZRHO00 / PRHODREF(:,:,:))**XCEXVT / MOMG(XALPHAS, XNUS, XBS)
-ELSEWHERE
- ZLAMBDAS(:,:,:) = 0.
- ZVTS(:,:,:) = 0.
-END WHERE
-!
-! for graupel
-WHERE(PRT(:,:,:,6) .GT. 1.E-12)
- ZLAMBDAG(:,:,:) = XLBG * (PRHODREF(:,:,:) * &
- MAX(PRT(:,:,:,6), XRTMIN(6)))**XLBEXG
- ZVTG(:,:,:) = XCG * MOMG(XALPHAG, XNUG, XBG+XDG) * ZLAMBDAG(:,:,:)**(-XDG) * &
- (ZRHO00 / PRHODREF(:,:,:))**XCEXVT / MOMG(XALPHAG, XNUG, XBG)
-ELSEWHERE
- ZLAMBDAG(:,:,:) = 0.
- ZVTG(:,:,:) = 0.
-END WHERE
-!
-DEALLOCATE(ZLAMBDAS)
-DEALLOCATE(ZLAMBDAG)
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. INITIALIZE THE VARIABLES
-! ------------------------
-!
-IF (GFIRSTCALL) THEN
- GFIRSTCALL = .FALSE.
-!
- JCOUNT = 0
- ZMASS_C = 0.
- ZMASS_R = 0.
- ZMASS_I = 0.
- ZMASS_S = 0.
- ZMASS_G = 0.
- ZMASS_ICE_P = 0.
- ZFLUX_PROD = 0.
- ZFLUX_PRECIP = 0.
- ZFLUX_NPRECIP = 0.
- ZVOL_UP5 = 0.
- ZVOL_UP10 = 0.
- ZVOL_G = 0.
- ZWMAX = 0.
- ZDBZMAX = 0.
- ZCTH_REF = 0.
- ZCTH_MR = 0.
- ZCLD_VOL = 0.
- ZINPRR = 0.
- ZMAX_INPRR = 0.
-END IF
-!
-ZICE_MASS = 0.
-ZMASS_SP = 0.
-ZMASS_GP = 0.
-ZFLUX_I = 0.
-ZFLUX_SP = 0.
-ZFLUX_SNP = 0.
-ZFLUX_G = 0.
-ZCLD_TOP_REF = 0.
-ZCLD_TOP_MR = 0.
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. COMPUTE THE DYNAMICAL AND MICROPHYSICAL PARAMETERS
-! --------------------------------------------------
-!
-JCOUNT = JCOUNT + 1
-!
-!* 3.1 compute the maximum vertical velocity
-!
-ZWMAX = ZWMAX + MAXVAL(PWT(IIB:IIE,IJB:IJE,IKB:IKE))
-!
-!
-!* 3.2 compute the maximum radar reflectivity
-!
-CALL RADAR_RAIN_ICE (PRT, PCIT, PRHODREF, ZTCT, &
- ZWORK31, ZWORK32, ZWORK33, ZWORK34)
-!
-ZDBZMAX = ZDBZMAX + MAXVAL(ZWORK31(IIB:IIE,IJB:IJE,IKB:IKE))
-!
-!
-!* 3.3 compute the mass of the different microphysical species
-!
-ZMASS_C = ZMASS_C + SUM(PRT(IIB:IIE,IJB:IJE,IKB:IKE,2) * &
- PRHODJ(IIB:IIE,IJB:IJE,IKB:IKE))
-!
-ZMASS_R = ZMASS_R + SUM(PRT(IIB:IIE,IJB:IJE,IKB:IKE,3) * &
- PRHODJ(IIB:IIE,IJB:IJE,IKB:IKE))
-!
-ZMASS_I = ZMASS_I + SUM(PRT(IIB:IIE,IJB:IJE,IKB:IKE,4) * &
- PRHODJ(IIB:IIE,IJB:IJE,IKB:IKE))
-!
-ZMASS_S = ZMASS_S + SUM(PRT(IIB:IIE,IJB:IJE,IKB:IKE,5) * &
- PRHODJ(IIB:IIE,IJB:IJE,IKB:IKE))
-!
-ZMASS_G = ZMASS_G + SUM(PRT(IIB:IIE,IJB:IJE,IKB:IKE,6) * &
- PRHODJ(IIB:IIE,IJB:IJE,IKB:IKE))
-!
-!
-!* 3.4 compute the ice mass fluxes
-!
-!* 3.4.1 non-precipitation ice mass flux
-!
-IFLAG(:,:) = 0
-ICOUNT = 0
-!
-DO II = IIB, IIE
- DO IJ = IJB, IJE
- DO IK = IKB, IKE
-!
-!* 3.4.1 non-precipitation ice crystal mass flux
-!
- IF (ZTCT(II,IJ,IK) .LT. 0. .AND. PWT(II,IJ,IK) .GT. 0.) THEN
- ZFLUX_I = ZFLUX_I + &
- PWT(II,IJ,IK) * PRT(II,IJ,IK,4) * PRHODJ(II,IJ,IK)
- END IF
-!
-!* 3.4.2 non-precipitation snow mass flux
-!
- IF (ZTCT(II,IJ,IK) .LT. 0. .AND. PWT(II,IJ,IK) .GT. ZVTS(II,IJ,IK)) THEN
- ZFLUX_SNP = ZFLUX_SNP + &
- (PWT(II,IJ,IK) - ZVTS(II,IJ,IK)) * PRT(II,IJ,IK,5) * &
- PRHODJ(II,IJ,IK)
- END IF
-!
-!* 3.4.3 precipitation snow mass flux
-!
- IF (ZTCT(II,IJ,IK) .LT. 0. .AND. PWT(II,IJ,IK) .LT. ZVTS(II,IJ,IK)) THEN
- ZMASS_SP = ZMASS_SP + PRT(II,IJ,IK,5) * PRHODJ(II,IJ,IK)
- ZFLUX_SP = ZFLUX_SP + &
- (PWT(II,IJ,IK) - ZVTS(II,IJ,IK)) * PRT(II,IJ,IK,5) * &
- PRHODJ(II,IJ,IK)
- END IF
-!
-!* 3.4.4 precipitation graupel mass flux
-!
- IF (ZTCT(II,IJ,IK) .LT. 0. .AND. PWT(II,IJ,IK) .LT. ZVTG(II,IJ,IK)) THEN
- ZMASS_GP = ZMASS_GP + PRT(II,IJ,IK,6) * PRHODJ(II,IJ,IK)
- ZFLUX_G = ZFLUX_G + &
- (PWT(II,IJ,IK) - ZVTG(II,IJ,IK)) * PRT(II,IJ,IK,6) * &
- PRHODJ(II,IJ,IK)
- END IF
-!
-!
-!* 3.5 compute the updraft volume
-!
-! Updraft volume for W > 5 m/s
- IF (ZTCT(II,IJ,IK) .LT. -5. .AND. PWT(II,IJ,IK) .GT. 5.) THEN
- ZVOL_UP5 = ZVOL_UP5 + XDXHATM * XDYHATM * &
- (PZZ(II,IJ,IK+1) - PZZ(II,IJ,IK-1)) / 2.
- END IF
-!
-! Updraft volume for W > 10 m/s
- IF (ZTCT(II,IJ,IK) .LT. -5. .AND. PWT(II,IJ,IK) .GT. 10.) THEN
- ZVOL_UP10 = ZVOL_UP10 + XDXHATM * XDYHATM * &
- (PZZ(II,IJ,IK+1) - PZZ(II,IJ,IK-1)) / 2.
- END IF
-!
-!
-!* 3.6 total ice mass
-!
- IF (ZTCT(II,IJ,IK) .LT. -10. .AND. ZWORK31(II,IJ,IK) .GT. 18.) THEN
- ZICE_MASS = ZICE_MASS + (PRT(II,IJ,IK,4) + PRT(II,IJ,IK,5) + PRT(II,IJ,IK,6)) * &
- PRHODJ(II,IJ,IK)
- IFLAG(II,IJ) = IFLAG(II,IJ) + 1
- END IF
- END DO ! end loop ik
-!
- IF (IFLAG(II,IJ) .GE. 1) THEN
- ICOUNT = ICOUNT + 1
- END IF
- END DO ! end loop ij
-END DO ! end loop ii
-!
-DEALLOCATE(ZVTS)
-DEALLOCATE(ZVTG)
-!
-!
-!* 3.7 precipitation and non precipitation ice mass flux product
-!
-IF (ZFLUX_G .LT. 0. .AND. ZFLUX_I .GT. 0.) THEN
- ZFLUX_PROD = ZFLUX_PROD - (ZFLUX_I + ZFLUX_SNP) * (ZFLUX_G + ZFLUX_SP)
-END IF
-!
-! precipitation ice mass flux
-IF ((ZFLUX_G+ZFLUX_SP) .LT. 0.) THEN
- ZFLUX_PRECIP = ZFLUX_PRECIP - (ZFLUX_G + ZFLUX_SP)
-END IF
-!
-! non-precipitation ice mass flux
-IF ((ZFLUX_I+ZFLUX_SNP) .GT. 0.) THEN
- ZFLUX_NPRECIP = ZFLUX_NPRECIP + (ZFLUX_I + ZFLUX_SNP)
-END IF
-!
-!
-!* 3.8 compute the precipitation ice mass
-!
-IF ((ZMASS_GP .GT. 0.) .OR. (ZMASS_SP .GT. 0.)) THEN
- ZMASS_ICE_P = ZMASS_ICE_P + ZMASS_GP + ZMASS_SP
-END IF
-!
-!
-!* 3.9 compute the ice water path
-!
-CALL SUM_ELEC_ll(ZICE_MASS)
-CALL SUM_ELEC_ll(ICOUNT)
-!
-IF (ICOUNT .GT. 0) THEN
- ZIWP = ZIWP + ZICE_MASS / (REAL(ICOUNT) * XDXHATM * XDYHATM)
-END IF
-!
-!
-!* 3.10 compute the cloud top height
-!
-DO II = IIB, IIE
- DO IJ = IJB, IJE
- DO IK = IKB, IKE
-! maximum height of the 20 dBZ echo
- IF (ZWORK31(II,IJ,IK) .GT. 20. .AND. PZZ(II,IJ,IK) .GT. ZCLD_TOP_REF) THEN
- ZCLD_TOP_REF = PZZ(II,IJ,IK)
- END IF
-!
-! maximum height with mixing ratio > 1.e-4
- IF (ZCLOUD(II,IJ,IK) .GT. 1.E-4 .AND. PZZ(II,IJ,IK) .GT. ZCLD_TOP_REF) THEN
- ZCLD_TOP_MR = PZZ(II,IJ,IK)
- END IF
-!
-!
-!* 3.11 compute the cloud volume
-!
- IF (ZCLOUD(II,IJ,IK) .GT. 1.E-4) THEN
- ZCLD_VOL = ZCLD_VOL + XDXHATM * XDYHATM * &
- (PZZ(II,IJ,IK+1) - PZZ(II,IJ,IK-1)) / 2.
- END IF
-!
- END DO
- END DO
-END DO
-!
-DEALLOCATE(ZCLOUD)
-!
-ZCTH_MR = ZCTH_MR + ZCLD_TOP_MR
-ZCTH_REF = ZCTH_REF + ZCLD_TOP_REF
-!
-!
-!* 3.12 compute the instantaneous precipitation rate
-!
-ZMAX_INPRR = ZMAX_INPRR + MAXVAL(PINPRR(IIB:IIE,IJB:IJE))
-ZINPRR = ZINPRR + SUM(PINPRR(IIB:IIE,IJB:IJE))
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. FROM LOCAL TO GLOBAL VARIABLES
-! ------------------------------
-!
-CALL MAX_ELEC_ll (ZCTH_REF, IPROC_MAX)
-CALL MAX_ELEC_ll (ZCTH_MR, IPROC_MAX)
-CALL MAX_ELEC_ll (ZDBZMAX, IPROC_MAX)
-CALL MAX_ELEC_ll (ZMAX_INPRR,IPROC_MAX)
-CALL MAX_ELEC_ll (ZWMAX, IPROC_MAX)
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 5. SAVE THE DATA IN AN ASCII FILE
-! ------------------------------
-!
-CALL MYPROC_ELEC_ll(IPROC)
-!
-IF (JCOUNT == JCOUNT_STOP) THEN
-!
- ZINPRR = ZINPRR * 3.6E6 ! m/s --> mm/H
- ZMAX_INPRR = ZMAX_INPRR * 3.6E6 ! m/s --> mm/H
-!
- CALL REDUCESUM_ll (ZVOL_UP5, IINFO_ll)
- CALL REDUCESUM_ll (ZVOL_UP10, IINFO_ll)
- CALL REDUCESUM_ll (ZMASS_C, IINFO_ll)
- CALL REDUCESUM_ll (ZMASS_R, IINFO_ll)
- CALL REDUCESUM_ll (ZMASS_I, IINFO_ll)
- CALL REDUCESUM_ll (ZMASS_S, IINFO_ll)
- CALL REDUCESUM_ll (ZMASS_G, IINFO_ll)
- CALL REDUCESUM_ll (ZMASS_ICE_P, IINFO_ll)
- CALL REDUCESUM_ll (ZFLUX_PROD, IINFO_ll)
- CALL REDUCESUM_ll (ZFLUX_PRECIP, IINFO_ll)
- CALL REDUCESUM_ll (ZFLUX_NPRECIP, IINFO_ll)
- CALL REDUCESUM_ll (ZCLD_VOL, IINFO_ll)
- CALL REDUCESUM_ll (ZINPRR, IINFO_ll)
-!
- IF (IPROC == 0) THEN
- ILU = TPFILE_SERIES_CLOUD_ELEC%NLU
- WRITE (ILU, FMT='(I6,19(E12.4))') &
- INT(KTCOUNT*PTSTEP), & ! time
- ZCTH_REF/REAL(JCOUNT), & ! cloud top height from Z
- ZCTH_MR/REAL(JCOUNT), & ! cloud top height from m.r.
- ZDBZMAX/REAL(JCOUNT), & ! maximum radar reflectivity
- ZWMAX/REAL(JCOUNT), & ! maximum vertical velocity
- ZVOL_UP5/REAL(JCOUNT), & ! updraft volume for W > 5 m/s
- ZVOL_UP10/REAL(JCOUNT), & ! updraft volume for W > 10 m/s
- ZMASS_C/REAL(JCOUNT), & ! cloud droplets mass
- ZMASS_R/REAL(JCOUNT), & ! rain mass
- ZMASS_I/REAL(JCOUNT), & ! ice crystal mass
- ZMASS_S/REAL(JCOUNT), & ! snow mass
- ZMASS_G/REAL(JCOUNT), & ! graupel mass
- ZMASS_ICE_P/REAL(JCOUNT), & ! precipitation ice mass
- ZFLUX_PROD/REAL(JCOUNT), & ! ice mass flux product
- ZFLUX_PRECIP/REAL(JCOUNT), & ! precipitation ice mass flux
- ZFLUX_NPRECIP/REAL(JCOUNT), & ! non-precipitation ice mass flux
- ZIWP/REAL(JCOUNT), & ! ice water path
- ZCLD_VOL/REAL(JCOUNT), & ! cloud volume
- ZINPRR/REAL(JCOUNT), & ! Rain instant precip
- ZMAX_INPRR/REAL(JCOUNT) ! maximum rain instant. precip.
- FLUSH(UNIT=ILU)
- END IF
-!
- JCOUNT = 0
- ZMASS_C = 0.
- ZMASS_R = 0.
- ZMASS_I = 0.
- ZMASS_S = 0.
- ZMASS_G = 0.
- ZMASS_ICE_P = 0.
- ZFLUX_PROD = 0.
- ZFLUX_PRECIP = 0.
- ZFLUX_NPRECIP = 0.
- ZVOL_UP5 = 0.
- ZVOL_UP10 = 0.
- ZWMAX = 0.
- ZDBZMAX = 0.
- ZCTH_REF = 0.
- ZCTH_MR = 0.
- ZIWP = 0.
- ZCLD_VOL = 0.
- ZINPRR = 0.
- ZMAX_INPRR = 0.
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-CONTAINS
-!
-!-------------------------------------------------------------------------------
-! ##############################################
- FUNCTION MOMG0D(PALPHA, PNU, PP) RESULT(PMOMG)
-! ##############################################
-!
-USE MODI_GAMMA
-!
-IMPLICIT NONE
-!
-REAL, INTENT(IN) :: PALPHA, PNU
-REAL, INTENT(IN) :: PP
-REAL :: PMOMG
-!
-!
-PMOMG = GAMMA(PNU+PP/PALPHA) / GAMMA(PNU)
-!
-END FUNCTION MOMG0D
-!
-!-------------------------------------------------------------------------------
-
-!
-END SUBROUTINE SERIES_CLOUD_ELEC
diff --git a/src/mesonh/ext/set_conc_ice_c1r3.f90 b/src/mesonh/ext/set_conc_ice_c1r3.f90
deleted file mode 100644
index 0dfe34119bcd614b71adf0c7c6e3e9d8a8e006b4..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/set_conc_ice_c1r3.f90
+++ /dev/null
@@ -1,129 +0,0 @@
-!MNH_LIC Copyright 2001-2018 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_SET_CONC_ICE_C1R3
-! #############################
-!
-INTERFACE
-!
- SUBROUTINE SET_CONC_ICE_C1R3 (PRHODREF,PRT,PSVT)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT ! microphysical mixing ratios
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! microphys. concentrations
-!
-!
-END SUBROUTINE SET_CONC_ICE_C1R3
-!
-END INTERFACE
-!
-END MODULE MODI_SET_CONC_ICE_C1R3
-!
-! ##########################################################
- SUBROUTINE SET_CONC_ICE_C1R3 (PRHODREF,PRT,PSVT)
-! ##########################################################
-!
-!!**** *SET_CONC_ICE_C1R3 * - initialize the ice crystal
-!! concentration for a RESTArt simulation of the C1R3 scheme
-!!
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to initialize the pristine ice crystal
-!! concentrations when the cloud ice mixing ratios are only available.
-!! This routine is used to initialize the small ice crystal concentrations
-!! using the r_i of a previous ICE3 run but also to compute the LB tendencies
-!! in ONE_WAY$n in case of grid-nesting when the optional argument PTIME is
-!! set (a C3R5 run embedded in a ICE3 run).
-!!
-!!** METHOD
-!! ------
-!! The method uses the contact nucleation formulation of Meyers as a rough
-!! estimate (a function of the temperature). A limiting value of XCONCI_MAX
-!! is also assumed in the case of very cold temperatures
-!!
-!! EXTERNAL
-!! --------
-!! None
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_ICE_C1R3_DESCR, ONLY : XRTMIN, XCTMIN
-!! Module MODD_ICE_C1R3_PARAM, ONLY : XCONCI_INI
-!! Module MODD_CONF, ONLY : NVERB
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of documentation ( routine SET_CONC_ICE_C1R3 )
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 15/04/01
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY : XRHOLI
-USE MODD_CONF, ONLY : NVERB
-USE MODD_ICE_C1R3_DESCR, ONLY : XRTMIN, XCTMIN
-USE MODD_ICE_C1R3_PARAM, ONLY : XCONCI_MAX, XNUC_CON, XEXTT_CON, XEX_CON
-USE MODD_LUNIT_n, ONLY : TLUOUT
-USE MODD_RAIN_ICE_DESCR_n, ONLY : XAI, XBI
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT ! microphysical mixing ratios
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! microphys. concentrations
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: IRESP ! Return code of FM routines
-INTEGER :: ILUOUT ! Logical unit number of output-listing
-!
-!
-!-------------------------------------------------------------------------------
-!* 1. RETRIEVE LOGICAL UNIT NUMBER
-! ----------------------------
-!
-ILUOUT = TLUOUT%NLU
-!
-!* 2. INITIALIZATION
-! --------------
-!
-! Assume the ice crystal concentration according to the
-! contact nucleation formulation of Meyers et al. (1992)
-!
-WHERE ( PRT(:,:,:,4) > XRTMIN(4) )
- PSVT(:,:,:,4) = MIN( PRHODREF(:,:,:) / &
- ( XRHOLI * XAI*(10.E-06)**XBI * PRT(:,:,:,4) ), &
- XCONCI_MAX )
- PSVT(:,:,:,5) = 0.0
-END WHERE
-WHERE ( PRT(:,:,:,4) <= XRTMIN(4) )
- PRT(:,:,:,4) = 0.0
- PSVT(:,:,:,4) = 0.0
- PSVT(:,:,:,5) = 0.0
-END WHERE
-IF( NVERB >= 5 ) THEN
- WRITE (UNIT=ILUOUT,FMT=*) "!INI_MODEL$n: The cloud ice concentration has "
- WRITE (UNIT=ILUOUT,FMT=*) "been roughly initialised to a value of 1 per liter"
-END IF
-!
-END SUBROUTINE SET_CONC_ICE_C1R3
diff --git a/src/mesonh/ext/set_msk.f90 b/src/mesonh/ext/set_msk.f90
deleted file mode 100644
index ba4da88bfda2972c8bff2174907cb9e2d884710a..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/set_msk.f90
+++ /dev/null
@@ -1,286 +0,0 @@
-!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ######spl
- MODULE MODI_SET_MSK
-!####################
-!
-INTERFACE
-!
-SUBROUTINE SET_MSK(PRT,PRHODREF,OBU_MSK)
-!
-REAL , DIMENSION (:,:,:,:),INTENT(IN) :: PRT
-REAL , DIMENSION (:,:,:),INTENT(IN) :: PRHODREF
-LOGICAL , DIMENSION (:,:,:),INTENT(OUT) :: OBU_MSK
-!
-END SUBROUTINE SET_MSK
-!
-END INTERFACE
-!
-END MODULE MODI_SET_MSK
-!
-! ######spl
- SUBROUTINE SET_MSK(PRT,PRHODREF,OBU_MSK)
-! ###############################
-!
-!!****SET_MSK** -routine to define the mask based on SET_MASK
-!!
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to test the occurence or not of the
-! different criteria, used to compute the budgets. It also updates the
-! number of occurence of the different criteria.
-!
-!!** METHOD
-!! ------
-!! According to each criterion associated to one zone, the mask is
-!! set to TRUE at each point where the criterion is confirmed, at each
-!! time step of the model.
-!!
-!!
-!! EXTERNAL
-!! --------
-!! NONE
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of MESO-NH documentation (routine BUDGET)
-!!
-!!
-!! AUTHOR
-!! ------
-!! J. Nicolau * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 27/02/95
-!! T.Montmerle 15/07/96 Computation of masks for convective and stratiform parts
-!! Biju Thomas 29/03/99 Identified nonprecipitating convective cells and only
-!! precipitating anvils as stratiform part
-!! O. Caumont 09/04/08 Use in RADAR_SIMULATOR
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_FIELD_n
-USE MODD_RAIN_ICE_PARAM_n , ONLY : XFSEDR,XEXSEDR
-USE MODD_RAIN_ICE_DESCR_n , ONLY : XCEXVT
-USE MODD_CST , ONLY : XRHOLW
-USE MODD_PARAMETERS
-USE MODD_CONF
-USE MODE_ll
-USE MODD_LUNIT, ONLY : TLUOUT0
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-!
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 Declarations of arguments :
-!
-REAL , DIMENSION (:,:,:,:),INTENT(IN) :: PRT
-REAL , DIMENSION (:,:,:),INTENT(IN) :: PRHODREF
-LOGICAL , DIMENSION (:,:,:),INTENT(OUT) :: OBU_MSK
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: IIB,IJB ! Lower bounds and Upper bounds
-INTEGER :: IIE,IJE ! of the physical sub-domain
-INTEGER :: IKB,IKE ! in x, y and z directions
-INTEGER :: IIU,IJU!,IKU
-!
-REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZMASK ! signature de l'insertion
- ! dans un masque (0 ou 1.)
-REAL,DIMENSION(:,:), ALLOCATABLE :: ZCONVECT ! signature du domaine convectif
-REAL,DIMENSION(:,:), ALLOCATABLE :: ZSURFPP ! precipitation au sol
-REAL,DIMENSION(:,:), ALLOCATABLE :: ZMAXWATER ! teneur maximale en eau
- ! recensee sur la verticale
-REAL,DIMENSION(:,:), ALLOCATABLE :: ZMIMX,ZMIPX ! I,I+1 and I,I-1 precipitation sums
-REAL,DIMENSION(:,:), ALLOCATABLE :: ZMEANX_MY,ZMEANX_PY ! J,J+1 and J,J-1 precipitation sums
-REAL,DIMENSION(:,:), ALLOCATABLE :: ZMEANX, ZMEANXY
-REAL :: ZAVER_PR,ZREPSILON,ZTOTWATER,ZREPSILON1
-REAL :: ZCRS,ZCEXRS,ZCEXVT,ZREPSILON2,ZREPSILON3
-INTEGER :: I,J,JILOOP,JJLOOP,JKLOOP
-INTEGER :: ILUOUT0
-INTEGER :: IRESP
-INTEGER :: IBUIL,IBUJL,IBUIH,IBUJH
-!INTEGER :: IBUSIL,IBUSJL,IBUSIH,IBUSJH
-!INTEGER :: IINFO_ll ! return code of parallel routine
-!TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
-!-------------------------------------------------------------------------------
-!
-ILUOUT0 = TLUOUT0%NLU
-!
-!* 1. COMPUTES THE PHYSICAL SUBDOMAIN BOUNDS
-! ---------------------------------------
-!
-IKB = 1 + JPVEXT
-IKE = SIZE(PRT,3) - JPVEXT
-IIU = SIZE(PRT,1)
-IJU = SIZE(PRT,2)
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-!
-! ----------------------
-ALLOCATE( ZMASK(IIU,IJU,4) )
-ALLOCATE( ZSURFPP(IIU,IJU) )
-ALLOCATE(ZMIMX(IIU,IJU),ZMIPX(IIU,IJU),ZMEANX(IIU,IJU))
-ALLOCATE(ZMEANX_MY(IIU,IJU),ZMEANX_PY(IIU,IJU),ZMEANXY(IIU,IJU))
-ALLOCATE( ZCONVECT(IIU,IJU) )
-ALLOCATE( ZMAXWATER(IIU,IJU) )
-!
-!* 2. DEFINITION OF THE MASK
-! ----------------------
-! initialization to FALSE on the extended subdomain
-OBU_MSK(:,:,:)=.FALSE.
-ZMASK(:,:,:)=0.
-ZSURFPP(:,:)=0.
-ZCONVECT(:,:)=0.
-ZMAXWATER(:,:)=0.
-ZREPSILON=5.E-6
-ZREPSILON1=5.E-4
-ZREPSILON2=5.0
-ZREPSILON3=5.E-6
-ZAVER_PR=0.
-
-!**********************************************************************
-! CAUTION: Definition of parameters
-! depends on the model configuration WARM or COLD
-! -----------------------------------------------
-
-!**********************************************************************
-!partie a activer pour le cas chaud, en activant USE MODD_CLOUDPAR et en
-!desactivant USE MODD_RAIN_ICE_PARAM et USE MODD_RAIN_ICE_DESCR qui servent
-!au cas froid. En activant tout, XCEXVT est defini deux fois, donc une fois
-!de trop.
-!**********************************************************************
-!IF (CCLOUD == 'REVE' .OR. CCLOUD == 'KESS' .OR. CCLOUD == 'KES2') THEN
-! ZCRS=XCRS
-! ZCEXRS=XCEXRS
-! ZCEXVT=XCEXVT
-!ELSE IF (CCLOUD == 'ICE3') THEN
-!**********************************************************************
-
- ZCRS=XFSEDR
- ZCEXRS=XEXSEDR
- ZCEXVT=XCEXVT
-!END IF
-
-! Total solid and liquid water (qr+qc+qs+qi+qg) (= cloudy area)
-! -------------------------------------------------------------
-
-DO JKLOOP=IKB,IKE
- DO JJLOOP=IJB,IJE
- DO JILOOP=IIB,IIE
- ZTOTWATER = PRT(JILOOP,JJLOOP,JKLOOP,2) &
- +PRT(JILOOP,JJLOOP,JKLOOP,3) &
- +PRT(JILOOP,JJLOOP,JKLOOP,4) &
- +PRT(JILOOP,JJLOOP,JKLOOP,5) &
- +PRT(JILOOP,JJLOOP,JKLOOP,6)
- ZMAXWATER(JILOOP,JJLOOP)=MAX(ZMAXWATER(JILOOP,JJLOOP),ZTOTWATER)
- END DO
- END DO
-END DO
-
-! Computation of ground precipitation
-! -----------------------------------
-
-! Precipitation (mm/h)
-ZSURFPP(IIB:IIE,IJB:IJE)=ZCRS*PRT(IIB:IIE,IJB:IJE,IKB,3)**ZCEXRS &
- *PRHODREF(IIB:IIE,IJB:IJE,IKB)**(ZCEXRS-ZCEXVT)*3.6E6/XRHOLW
-
-! Lateral Boundaries for Precipitation
-! (cyclic case in Y-direction, OPEN in X-direction)
- ZSURFPP(1,IJB:IJE)=ZSURFPP(IIB,IJB:IJE)
- ZSURFPP(IIU,IJB:IJE)=ZSURFPP(IIE,IJB:IJE)
- ZSURFPP(1:IIU,1)=ZSURFPP(1:IIU,IJB)
- ZSURFPP(1:IIU,IJU)=ZSURFPP(1:IIU,IJE)
-
-!
-! Predefinition of the Convective region criteria
-! ------------------------------------------------
-ZMIPX(:,:)=0.
-ZMIMX(:,:)=0.
-ZMEANX(:,:)=0.
-!
-ZMIPX(1:IIU-1,:)=ZSURFPP(1:IIU-1,:)+ZSURFPP(2:IIU,:)
-ZMIMX(2:IIU,:)=ZSURFPP(2:IIU,:)+ZSURFPP(1:IIU-1,:)
-
-DO J=IJB+1,IJE-1
- DO I=3,IIE-1
- ZAVER_PR=(SUM(ZSURFPP(I-2:I+2,J-2:J+2))-ZSURFPP(I,J))/24.
-
-! threshold at 4 mm/h
- IF(ZSURFPP(I,J) >= MAX(4.,2.*ZAVER_PR) &
- .AND.(ZMAXWATER(I,J) >= ZREPSILON)) ZCONVECT(I-1:I+1,J-1:J+1)=1.
- IF(ZSURFPP(I,J) >= 20.) ZCONVECT(I,J)=1.
- IF(ZMAXWATER(I,J) >= ZREPSILON)THEN
- DO JKLOOP=2,IKE
- IF(PRT(I,J,JKLOOP,2) >= ZREPSILON1) ZCONVECT(I,J)=1.
- IF(XWT(I,J,JKLOOP) >= ZREPSILON2) ZCONVECT(I,J)=1.
- END DO
- END IF
- END DO
-END DO
-
-!------------------------------------------
-!* MASK Definition
-!------------------------------------------
-IBUIL=IIB+1
-IBUIH = IIE-1
-IBUJL = IJB+1
-IBUJH = IJE-1
-DO JILOOP=IBUIL,IBUIH
- DO JJLOOP=IBUJL,IBUJH
-!------------------------------------------
-!* Zone 1: Convective Zone
-!------------------------------------------
- ZMASK(JILOOP,JJLOOP,1)=ZCONVECT(JILOOP,JJLOOP)
-!------------------------------------------
-!* Zone 2: Stratiforme Zone
-!------------------------------------------
- IF (ZMAXWATER(JILOOP,JJLOOP) >= 10.*ZREPSILON.AND.ZMASK(JILOOP,JJLOOP,1)/=1.) THEN
- DO JKLOOP=IKB,IKE
- IF(PRT(JILOOP,JJLOOP,JKLOOP,3) >= ZREPSILON3) ZMASK(JILOOP,JJLOOP,2)=1.
- END DO
- END IF
-!------------------------------------------
-!* Zone 3: Clear air Zone
-!------------------------------------------
- IF (ZMASK(JILOOP,JJLOOP,1)/=1. .AND. ZMASK(JILOOP,JJLOOP,2)/=1.) ZMASK(JILOOP,JJLOOP,3)=1.
-!------------------------------------------
-!* Zone 4: Total Domain
-!------------------------------------------
- ZMASK(JILOOP,JJLOOP,4)=1.
-
- END DO
-END DO
-!
-!-----------------------------------------------------------------------
-!
-
-OBU_MSK(IIB:IIE,IJB:IJE,:)=ZMASK(IIB:IIE,IJB:IJE,:)>0.8
-
-
-!
-!* 2. INCREASE IN SURFACE ARRAY
-! -------------------------
-!
-DEALLOCATE( ZMASK )
-DEALLOCATE( ZCONVECT )
-DEALLOCATE( ZSURFPP )
-DEALLOCATE( ZMAXWATER )
-DEALLOCATE(ZMIMX,ZMIPX,ZMEANX)
-DEALLOCATE(ZMEANX_MY,ZMEANX_PY,ZMEANXY)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE SET_MSK
diff --git a/src/mesonh/ext/set_rsou.f90 b/src/mesonh/ext/set_rsou.f90
deleted file mode 100644
index 6c2ea6b2f9203cc2eca4d01697a0975155c40f95..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/set_rsou.f90
+++ /dev/null
@@ -1,1640 +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_SET_RSOU
-! ####################
-!
-INTERFACE
-!
- SUBROUTINE SET_RSOU(TPFILE,TPEXPREFILE,HFUNU,HFUNV,KILOC,KJLOC,OBOUSS,&
- PJ,OSHIFT,PCORIOZ)
-!
-USE MODD_IO, ONLY : TFILEDATA
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! outpput data file
-TYPE(TFILEDATA), INTENT(IN) :: TPEXPREFILE ! input data file
-CHARACTER(LEN=*), INTENT(IN) :: HFUNU ! type of variation of U
- ! in y direction
-CHARACTER(LEN=*), INTENT(IN) :: HFUNV ! type of variation of V
- ! in x direction
-INTEGER, INTENT(IN) :: KILOC ! I Localisation of vertical profile
-INTEGER, INTENT(IN) :: KJLOC ! J Localisation of vertical profile
-LOGICAL, INTENT(IN) :: OBOUSS ! logical switch for Boussinesq version
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PJ ! jacobien
-LOGICAL, INTENT(IN) :: OSHIFT ! logical switch for vertical shift
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT), OPTIONAL :: PCORIOZ ! Coriolis parameter
- ! (exceptionnaly 3D array)
-!
-END SUBROUTINE SET_RSOU
-!
-END INTERFACE
-!
-END MODULE MODI_SET_RSOU
-!
-! ########################################################################
- SUBROUTINE SET_RSOU(TPFILE,TPEXPREFILE,HFUNU,HFUNV,KILOC,KJLOC,OBOUSS, &
- PJ,OSHIFT,PCORIOZ)
-! ########################################################################
-!
-!!**** *SET_RSOU * - to initialize mass fiels from a radiosounding
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to initialize the mass field (theta,r,
-! thetavrefz,rhorefz) on model grid from a radiosounding located at point
-! (KILOC,KJLOC).
-!
-! The free-formatted part of EXPRE file contains the radiosounding data.The data
-! are stored in following order :
-!
-! - year,month,day, time (these variables are read in PREINIT program)
-! - kind of data in EXPRE file (see below for more explanations about
-! YKIND)
-! - ZGROUND
-! - PGROUND
-! - temperature variable at ground ( depending on the data Kind )
-! - moist variable at ground ( depending on the data Kind )
-! - number of wind data levels ( variable ILEVELU)
-! - height , dd , ff |
-! or or | ILEVELU times
-! pressure, U , V |
-! - number of mass levels ( variable ILEVELM), including the ground
-! level
-! - height , T , Td |
-! or or or | (ILEVELM-1) times
-! pressure, THeta_Dry , Mixing Ratio |
-! or or |
-! THeta_V , relative HUmidity|
-!
-! NB : the first mass level is at ground
-!
-! The following kind of data is permitted :
-! YKIND = 'STANDARD' : ZGROUND, PGROUND, TGROUND, TDGROUND
-! (Pressure, dd, ff) ,
-! (Pressure, T, Td)
-! YKIND = 'PUVTHVMR' : zGROUND, PGROUND, ThvGROUND, RGROUND
-! (Pressure, U, V) ,
-! (Pressure, THv, R)
-! YKIND = 'PUVTHVHU' : zGROUND, PGROUND, ThvGROUND, HuGROUND
-! (Pressure, U, V) ,
-! (Pressure, THv, Hu)
-! YKIND = 'ZUVTHVHU' : zGROUND, PGROUND, ThvGROUND, HuGROUND
-! (height, U, V) ,
-! (height, THv, Hu)
-! YKIND = 'ZUVTHVMR' : zGROUND, PGROUND, ThvGROUND, RGROUND
-! (height, U, V) ,
-! (height, THv, R)
-! YKIND = 'PUVTHDMR' : zGROUND, PGROUND, ThdGROUND, RGROUND
-! (Pressure, U, V) ,
-! (Pressure, THd, R)
-! YKIND = 'PUVTHDHU' : zGROUND, PGROUND, ThdGROUND, HuGROUND
-! (Pressure, U, V) ,
-! (Pressure, THd, Hu)
-! YKIND = 'ZUVTHDMR' : zGROUND, PGROUND, ThdGROUND,
-! RGROUND
-! (height, U, V) ,
-! (height, THd, R)
-! YKIND = 'PUVTHU' : ZGROUND, PGROUND, TGROUND, HuGROUND
-! (Pressure, U, V) ,
-! (Pressure, T, Hu)
-!
-! For ocean-LES case the following kind of data is permitted
-!
-! YKIND = 'IDEALOCE' : ZGROUND (Water depth),PGROUND(Sfc Atmos Press),
-! TGROUND (SST), RGROUND (SSS)
-! (Depth , U, V) starting from sfc
-! (Depth, T, S)
-! (Time, LE, H, SW_d,SW_u,LW_d,LW_u,Stress_X,Stress_Y)
-!
-! YKIND = 'STANDOCE' : (Depth , Temp, Salinity, U, V) starting from sfc
-! (Time, LE, H, SW_d,SW_u,LW_d,LW_u,Stress_X,Stress_Y)
-!
-!!** METHOD
-!! ------
-!! The radiosounding is first read, then data are converted in order to
-!! always obtain the following variables (case YKIND = 'ZUVTHVMR') :
-!! (height,U,V) and (height,Thetav,r) which are the model variables.
-!! That is to say :
-!! - YKIND = 'STANDARD' :
-!! dd,ff converted in U,V
-!! Td + pressure ----> r
-!! T,r ---> Tv + pressure ----> thetav
-!! Pressure + thetav + ZGROUND ----> height (for mass levels)
-!! Thetav at mass levels ----> thetav at wind levels
-!! Pressure + thetav + ZGROUND + PGROUND ---->height (for wind levels)
-!! - YKIND = 'PUVTHVMR' :
-!! Pressure + thetav + ZGROUND ----> height (for mass levels)
-!! Thetav at mass levels ----> thetav at wind levels
-!! Pressure + thetav + ZGROUND + PGROUND ---->height (for wind levels)
-!! - YKIND = 'PUVTHVHU' :
-!! thetav + pressure ----> Tv +pressure +Hu ----> r
-!! Pressure + thetav + ZGROUND ----> height (for mass levels)
-!! Thetav at mass levels ----> thetav at wind levels
-!! Pressure + thetav + ZGROUND + PGROUND ---->height (for wind levels)
-!! - YKIND = 'ZUVTHVHU' :
-!! height +thetav + PGROUND -----> pressure (for mass levels)
-!! thetav + pressure ----> Tv +pressure +Hu ----> r
-!! - YKIND = 'PUVTHDVMR' :
-!! thetad + r ----> thetav
-!! pressure + thetav + ZGROUND ----> height (for mass levels)
-!! Thetav at mass levels ----> thetav at wind levels
-!! Pressure + thetav + ZGROUND + PGROUND ---->height (for wind levels)
-!! - YKIND = 'PUVTHDHU' :
-!! thetad + pressure -----> T
-!! T + pressure + Hu -----> r
-!! thetad + r -----> thetav
-!! pressure + thetav + ZGROUND ----> height (for mass levels)
-!! Thetav at mass levels ----> thetav at wind levels
-!! Pressure + thetav + ZGROUND + PGROUND ---->height (for wind levels)
-!! - YKIND = 'ZUVTHDHU' :
-!! thetad + r -----> thetav
-!! - YKIND = 'PUVTHU' :
-!! T + pressure -----> thetad
-!! T + pressure + Hu -----> r
-!! thetad + r -----> thetav
-!! pressure + thetav + ZGROUND ----> height (for mass levels)
-!! Thetav at mass levels ----> thetav at wind levels
-!!
-!! The following basic formula are used :
-!! Rd es(Td)
-!! r = -- ----------
-!! Rv P - es(Td)
-!!
-!! 1 + (Rv/Rd) r
-!! Tv = -------------- T
-!! 1 + r
-!!
-!! P00 Rd/Cpd 1 + (Rv/Rd) r
-!! Thetav = Tv ( ---- ) = Thetad ( --------------)
-!! P 1 + r
-!! The integration of hydrostatic relation is used to compute height from
-!! pressure and vice-versa. This is done by HEIGHT_PRESS and PRESS_HEIGHT
-!! routines.
-!!
-!! Then, these data are interpolated on a vertical grid which is
-!! a mixed grid calaculated with VERT_COORD from the vertical levels of MNH
-!! grid and with a constant ororgraphy equal to the altitude of the vertical
-!! profile (ZZGROUND) (It permits to keep low levels information with a
-!! shifting function (as in PREP_REAL_CASE))
-!!
-!! Then, the 3D mass and wind fields are deduced in SET_MASS
-!!
-!!
-!! EXTERNAL
-!! --------
-!! SET_MASS : to compute mass field on 3D-model grid
-!! Module MODE_THERMO : contains thermodynamic routines
-!! SM_FOES : To compute saturation vapor pressure from
-!! temperature
-!! SM_PMR_HU : to compute vapor mixing ratio from pressure, virtual
-!! temperature and relative humidity
-!! HEIGHT_PRESS : to compute height from pressure and thetav
-!! by integration of hydrostatic relation
-!! PRESS_HEIGHT : to compute pressure from height and thetav
-!! by integration of hydrostatic relation
-!! THETAVPU_THETAVPM : to interpolate thetav on wind levels
-!! from thetav on mass levels
-!!
-!! Module MODI_HEIGHT_PRESS : interface for function HEIGHT_PRESS
-!! Module MODI_PRESS_HEIGHT : interface for function PRESS_HEIGHT
-!! Module MODI_THETAVPU_THETAVPM : interface for function
-!! THETAVPU_THETVPM
-!! Module MODI_SET_MASS : interface for subroutine SET_MASS
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CST : contains physical constants
-!! XPI : Pi
-!! XRV : Gas constant for vapor
-!! XRD : Gas constant for dry air
-!! XCPD : Specific heat for dry air at constant pressure
-!!
-!! Module MODD_LUNIT1 : contains logical unit names
-!! TLUOUT : name of output-listing
-!!
-!! Module MODD_CONF : contains configuration variables for all models.
-!! NVERB : verbosity level for output-listing
-!!
-!! Module MODD_GRID1 : contains grid variables
-!! XZHAT : height of w-levels of vertical model grid without orography
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of MESO-NH documentation (routine SET_RSOU)
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Ducrocq * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 25/08/94
-!! J.Stein 06/12/94 change the way to prescribe the horizontal wind
-!! variations + cleaning
-!! J.Stein 18/01/95 bug corrections in the ILEVELM readings
-!! J.Stein 16/04/95 put the same names of the declarative modules
-!! in the descriptive part
-!! J.Stein 30/01/96 use the RS ground pressure to initialize the
-!! hydrostatic pressure computation
-!! V.Masson 02/09/96 add allocation of ZTHVU in two cases
-!! P.Jabouille 14/02/96 bug in extrapolation of ZMRM below the first level
-!! Jabouille/Masson 05/12/02 add ZUVTHLMR case and hydrometeor initialization
-!! P.Jabouille 29/10/03 add hydrometeor initialization for ZUVTHDMR case
-!! G. Tanguy 26/10/10 change the interpolation of the RS : we use now a
-!! mixed grid (PREP_REAL_CASE method)
-!! add PUVTHU case
-!! V.Masson 12/08/13 Parallelization of the initilization profile
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 19/04/2019: removed unused dummy arguments and variables
-! JL Redelsperger 01/2021: Ocean LES cases added
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CONF
-USE MODD_CONF_n
-USE MODD_CST
-USE MODD_NEB_n, ONLY: NEBN
-USE MODD_DYN_n, ONLY: LOCEAN
-USE MODD_FIELD_n
-USE MODD_GRID
-USE MODD_GRID_n
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_NETCDF
-USE MODD_OCEANH
-USE MODD_PARAMETERS, ONLY: JPHEXT
-USE MODD_TYPE_DATE
-!
-USE MODE_ll
-USE MODE_MSG
-USE MODE_THERMO
-!
-USE MODI_COMPUTE_EXNER_FROM_GROUND
-USE MODI_HEIGHT_PRESS
-USE MODI_PRESS_HEIGHT
-USE MODI_SET_MASS
-USE MODI_SHUMAN
-USE MODI_THETAVPU_THETAVPM
-USE MODI_VERT_COORD
-!
-USE NETCDF ! for reading the NR files
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 Declarations of arguments :
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! outpput data file
-TYPE(TFILEDATA), INTENT(IN) :: TPEXPREFILE ! input data file
-CHARACTER(LEN=*), INTENT(IN) :: HFUNU ! type of variation of U
- ! in y direction
-CHARACTER(LEN=*), INTENT(IN) :: HFUNV ! type of variation of V
- ! in x direction
-INTEGER, INTENT(IN) :: KILOC ! I Localisation of vertical profile
-INTEGER, INTENT(IN) :: KJLOC ! J Localisation of vertical profile
-LOGICAL, INTENT(IN) :: OBOUSS ! logical switch for Boussinesq version
-LOGICAL, INTENT(IN) :: OSHIFT ! logical switch for vertical shift
-REAL, DIMENSION(:,:,:), INTENT(OUT), OPTIONAL :: PCORIOZ ! Coriolis parameter
- ! (exceptionnaly 3D array)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PJ ! jacobien
-!
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: ILUPRE ! logical unit number of the EXPRE return code
-INTEGER :: ILUOUT ! Logical unit number for output-listing
-! local variables for reading sea sfc flux forcing for ocean model
-INTEGER :: IFRCLT
-REAL, DIMENSION(:), ALLOCATABLE :: ZSSUFL_T,ZSSVFL_T,ZSSTFL_T,ZSSOLA_T !
-TYPE (DATE_TIME), DIMENSION(:), ALLOCATABLE :: ZFRCLT ! date/time of sea surface forcings
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! variables read in EXPRE file at the RS/CTD levels
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-CHARACTER(LEN=8) :: YKIND ! Kind of variables in
- ! EXPRE FILE
-INTEGER :: ILEVELU ! number of wind levels
-REAL, DIMENSION(:), ALLOCATABLE :: ZHEIGHTU ! Height at wind levels
-REAL, DIMENSION(:), ALLOCATABLE :: ZPRESSU ! Pressure at wind levels
-REAL, DIMENSION(:), ALLOCATABLE :: ZTHVU ! Thetav at wind levels
-REAL, DIMENSION(:), ALLOCATABLE :: ZU,ZV ! wind components
-REAL, DIMENSION(:), ALLOCATABLE :: ZDD,ZFF ! dd (direction) and ff(force)
- ! for wind
-REAL :: ZZGROUND,ZPGROUND ! height and Pressure at ground
-REAL :: ZTGROUND,ZTHVGROUND,ZTHDGROUND,ZTHLGROUND, &
- ZTDGROUND,ZMRGROUND,ZHUGROUND
- ! temperature and moisture
- ! variables at ground
-INTEGER :: ILEVELM ! number of mass levels
-REAL, DIMENSION(:), ALLOCATABLE :: ZHEIGHTM ! Height at mass levels
-REAL, DIMENSION(:), ALLOCATABLE :: ZPRESSM ! Pressure at mass levels
-REAL, DIMENSION(:), ALLOCATABLE :: ZTHV ! Thetav at mass levels
-REAL, DIMENSION(:), ALLOCATABLE :: ZTHD ! Theta (dry) at mass levels
-REAL, DIMENSION(:), ALLOCATABLE :: ZTHL ! Thetal at mass levels
-REAL, DIMENSION(:), ALLOCATABLE :: ZTH ! Theta at mass levels
-REAL, DIMENSION(:), ALLOCATABLE :: ZT ! Temperature at mass levels
-REAL, DIMENSION(:), ALLOCATABLE :: ZMR ! Vapor mixing ratio at mass levels
-REAL, DIMENSION(:), ALLOCATABLE :: ZMRC ! cloud mixing ratio at mass levels
-REAL, DIMENSION(:), ALLOCATABLE :: ZMRI ! ice mixing ratio or cloud concentration
-REAL, DIMENSION(:), ALLOCATABLE :: ZRT ! total mixing ratio
-REAL, DIMENSION(:), ALLOCATABLE :: ZPRESS ! pressure at mass level
-REAL, DIMENSION(:), ALLOCATABLE :: ZHU ! relative humidity at mass levels
-REAL, DIMENSION(:), ALLOCATABLE :: ZTD ! Td at mass levels
-REAL, DIMENSION(:), ALLOCATABLE :: ZTV ! Tv at mass levels
-REAL, DIMENSION(:), ALLOCATABLE :: ZEXN
-REAL, DIMENSION(:), ALLOCATABLE :: ZCPH
-REAL, DIMENSION(:), ALLOCATABLE :: ZLVOCPEXN
-REAL, DIMENSION(:), ALLOCATABLE :: ZLSOCPEXN
-REAL, DIMENSION(SIZE(XZHAT)) :: ZZFLUX_PROFILE ! altitude of flux points on the initialization columns
-REAL, DIMENSION(SIZE(XZHAT)) :: ZZMASS_PROFILE ! altitude of mass points on the initialization columns
-!
-! fields on the grid of the model without orography
-!
-REAL, DIMENSION(SIZE(XZHAT)) :: ZUW,ZVW ! Wind at w model grid levels
-REAL, DIMENSION(SIZE(XZHAT)) :: ZMRM ! vapor mixing ratio at mass model
- !grid levels
-REAL, DIMENSION(SIZE(XZHAT)) :: ZMRCM,ZMRIM
-REAL, DIMENSION(SIZE(XZHAT)) :: ZTHVM ! Temperature at mass model grid levels
-REAL, DIMENSION(SIZE(XZHAT)) :: ZTHLM ! Thetal at mass model grid levels
-REAL, DIMENSION(SIZE(XZHAT)) :: ZTHM ! Thetal at mass model grid levels
-REAL, DIMENSION(SIZE(XZHAT)) :: ZRHODM ! density at mass model grid level
-REAL, DIMENSION(:), ALLOCATABLE :: ZMRT ! Total Vapor mixing ratio at mass levels on mixed grid
-REAL, DIMENSION(:), ALLOCATABLE :: ZEXNMASS ! exner fonction at mass level
-REAL, DIMENSION(:), ALLOCATABLE :: ZEXNFLUX ! exner fonction at flux level
-REAL :: ZEXNSURF ! exner fonction at surface
-REAL, DIMENSION(:), ALLOCATABLE :: ZPREFLUX ! pressure at flux model grid level
-REAL, DIMENSION(:), ALLOCATABLE :: ZFRAC_ICE ! ice fraction
-REAL, DIMENSION(:), ALLOCATABLE :: ZRSATW, ZRSATI
-REAL :: ZDZSDH,ZDZ1SDH,ZDZ2SDH ! interpolation
- ! working arrays
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZBUF
-!
-INTEGER :: JK,JKLEV,JKU,JKM,JKT,JJ,JI,JO,JLOOP ! Loop indexes
-INTEGER :: IKU ! Upper bound in z direction
-REAL :: ZRDSCPD,ZRADSDG, & ! Rd/Cpd, Pi/180.,
- ZRVSRD,ZRDSRV, & ! Rv/Rd, Rd/Rv
- ZPTOP ! Pressure at domain top
-LOGICAL :: GUSERC ! use of input data cloud
-INTEGER :: IIB, IIE, IJB, IJE
-INTEGER :: IXOR_ll, IYOR_ll
-INTEGER :: IINFO_ll
-LOGICAL :: GPROFILE_IN_PROC ! T : initialization profile is in current processor
-!
-REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT)) ::ZZS_LS
-REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) ::ZZFLUX_MX,ZZMASS_MX ! mixed grid
-!-------------------------------------------------------------------------------
-! For standard ocean version, reading external files
-CHARACTER(LEN=256) :: yinfile, yinfisf ! files to be read
-INTEGER :: IDX
-INTEGER(KIND=CDFINT) :: INZ, INLATI, INLONGI
-INTEGER(KIND=CDFINT) :: incid, ivarid, idimid, idimlen
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZOC_TEMPERATURE,ZOC_SALINITY,ZOC_U,ZOC_V
-REAL, DIMENSION(:), ALLOCATABLE :: ZOC_DEPTH
-REAL, DIMENSION(:), ALLOCATABLE :: ZOC_LE,ZOC_H
-REAL, DIMENSION(:), ALLOCATABLE :: ZOC_SW_DOWN,ZOC_SW_UP,ZOC_LW_DOWN,ZOC_LW_UP
-REAL, DIMENSION(:), ALLOCATABLE :: ZOC_TAUX,ZOC_TAUY
-
-!--------------------------------------------------------------------------------
-!
-!* 1. PROLOGUE : INITIALIZE SOME CONSTANTS, RETRIEVE LOGICAL
-! UNIT NUMBERS AND READ KIND OF DATA IN EXPRE FILE
-! -------------------------------------------------------
-!
-CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
-CALL GET_OR_ll('B',IXOR_ll,IYOR_ll)
-!
-!* 1.1 initialize some constants
-!
-ZRDSCPD = XRD / XCPD
-ZRADSDG = XPI/180.
-ZRVSRD = XRV/XRD
-ZRDSRV = XRD/XRV
-!
-!* 1.2 Retrieve logical unit numbers
-!
-ILUPRE = TPEXPREFILE%NLU
-ILUOUT = TLUOUT%NLU
-!
-!* 1.3 Read data kind in EXPRE file
-!
-READ(ILUPRE,*) YKIND
-WRITE(ILUOUT,*) 'YKIND read in set_rsou: ', YKIND
-!
-IF(LUSERC .AND. YKIND/='PUVTHDMR' .AND. YKIND/='ZUVTHDMR' .AND. YKIND/='ZUVTHLMR') THEN
- CALL PRINT_MSG(NVERB_FATAL,'GEN','SET_RSOU','hydrometeors are not allowed for YKIND = '//trim(YKIND))
-ENDIF
-!
-IF(YKIND=='ZUVTHLMR' .AND. .NOT. LUSERC) THEN
-!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','SET_RSOU','LUSERC=T is required for YKIND=ZUVTHLMR')
-ENDIF
-!
-GUSERC=.FALSE.
-IF(LUSERC .AND. (YKIND == 'PUVTHDMR' .OR. YKIND == 'ZUVTHDMR')) GUSERC=.TRUE.
-!-------------------------------------------------------------------------------
-!
-!* 2. READ DATA AND CONVERT IN (height,U,V), (height,Thetav,r)
-! --------------------------------------------------------
-!
-SELECT CASE(YKIND)
-!
-! 2.0.1 Ocean case 1
-!
- CASE ('IDEALOCE')
-!
- XP00=XP00OCEAN
- ! Read data in PRE_IDEA1.nam
- ! Surface
- WRITE(ILUOUT,FMT=*) 'Reading data for ideal ocean :IDEALOCE'
- READ(ILUPRE,*) ZPTOP ! P_atmosphere at sfc =P top domain
- READ(ILUPRE,*) ZTGROUND ! SST
- READ(ILUPRE,*) ZMRGROUND ! SSS
- WRITE(ILUOUT,FMT=*) 'Patm SST SSS', ZPTOP,ZTGROUND,ZMRGROUND
- READ(ILUPRE,*) ILEVELU ! Read number of Current levels
- ! Allocate required memory
- ALLOCATE(ZHEIGHTU(ILEVELU),ZU(ILEVELU),ZV(ILEVELU))
- ALLOCATE(ZOC_U(ILEVELU,1,1),ZOC_V(ILEVELU,1,1))
- WRITE(ILUOUT,FMT=*) 'Level number for Current in data', ILEVELU
- ! Read U and V at each wind level
- DO JKU = 1,ILEVELU
- READ(ILUPRE,*) ZHEIGHTU(JKU),ZOC_U(JKU,1,1),ZOC_V(JKU,1,1)
- ! WRITE(ILUOUT,FMT=*) 'Leveldata D(m) under sfc: U_cur, V_cur', JKU, ZHEIGHTU(JKU),ZU(JKU),ZV(JKU)
- END DO
- DO JKU=1,ILEVELU
- ! Z axis reoriented as in the model
- IDX = ILEVELU-JKU+1
- ZU(JKU) = ZOC_U(IDX,1,1)
- ZV(JKU) = ZOC_V(IDX,1,1)
- ! ZHEIGHT used only in set_ rsou, defined as such ZHEIGHT(ILEVELM)=H_model
- ! Z oriented in same time to have a model domain axis going
- ! from 0m (ocean bottom/model bottom) towards H (ocean sfc/model top)
- END DO
- ! Read number of mass levels
- READ(ILUPRE,*) ILEVELM
- ! Allocate required memory
- ALLOCATE(ZOC_DEPTH(ILEVELM))
- ALLOCATE(ZHEIGHTM(ILEVELM))
- ALLOCATE(ZTHL(ILEVELM),ZTH(ILEVELM),ZTHV(ILEVELM))
- ALLOCATE(ZMR(ILEVELM),ZRT(ILEVELM))
- ALLOCATE(ZOC_TEMPERATURE(ILEVELM,1,1),ZOC_SALINITY(ILEVELM,1,1))
- ! Read T and S at each mass level
- DO JKM= 2,ILEVELM
- READ(ILUPRE,*) ZOC_DEPTH(JKM),ZOC_TEMPERATURE(JKM,1,1),ZOC_SALINITY(JKM,1,1)
- END DO
- ! Complete the mass arrays with the ground informations read in EXPRE file
- ZOC_DEPTH(1) = 0.
- ZOC_TEMPERATURE(1,1,1)= ZTGROUND
- ZOC_SALINITY(1,1,1)= ZMRGROUND
- !!!!!!!!!!!!!!!!!!!!!!!!Inversing Axis!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Going from the data (axis downward i.e inverse model) grid to the model grid (axis upward)
- ! Uniform bathymetry; depth goes from ocean sfc downwards (data grid)
- ! ZHEIGHT goes from the model domain bottom up to the sfc ocean (top of model domain)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ZZGROUND = 0.
- ZTGROUND = ZOC_TEMPERATURE(ILEVELM,1,1)
- ZMRGROUND = ZOC_SALINITY(ILEVELM,1,1)
- DO JKM= 1,ILEVELM
- ! Z upward axis (oriented as in the model), i.e.
- ! going from 0m (ocean bottom/model bottom) upward to H (ocean sfc/model top)
- ! ZHEIGHT used only in set_ rsou, defined as such ZHEIGHT(ILEVELM)=H_model
- IDX = ILEVELM-JKM+1
- ZTH(JKM) = ZOC_TEMPERATURE(IDX,1,1)
- ZMR(JKM) = ZOC_SALINITY(IDX,1,1)
- ZHEIGHTM(JKM)= ZOC_DEPTH(ILEVELM)- ZOC_DEPTH(IDX)
- WRITE(ILUOUT,FMT=*) 'Model oriented initial data: JKM IDX depth T S ZHEIGHTM', &
- JKM,IDX,ZOC_DEPTH(IDX),ZTH(JKM),ZMR(JKM),ZHEIGHTM(JKM)
- END DO
- ! mass levels of the RS
- ZTHV = ZTH ! TV==THETA=TL
- ZTHL = ZTH
- ZRT = ZMR
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! READ Sea Surface Forcing !
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Reading the forcings from prep_idea1.nam
- READ(ILUPRE,*) IFRCLT ! Number of time-dependent forcing
- IF (IFRCLT > 99*8) THEN
- ! CAUTION: number of forcing times is limited by the WRITE format 99(8E10.3)
- ! and also by the name of forcing variables (format I3.3)
- ! You have to modify those if you need more forcing times
- CALL PRINT_MSG(NVERB_FATAL,'IO','SET_RSOU','maximum forcing times NFRCLT is 99*8')
- END IF
-!
- WRITE(UNIT=ILUOUT,FMT='(" THERE ARE ",I2," SFC FLUX FORCINGs AT:")') IFRCLT
- ALLOCATE(ZFRCLT(IFRCLT))
- ALLOCATE(ZSSUFL_T(IFRCLT)); ZSSUFL_T = 0.0
- ALLOCATE(ZSSVFL_T(IFRCLT)); ZSSVFL_T = 0.0
- ALLOCATE(ZSSTFL_T(IFRCLT)); ZSSTFL_T = 0.0
- ALLOCATE(ZSSOLA_T(IFRCLT)); ZSSOLA_T = 0.0
- DO JKT = 1,IFRCLT
- WRITE(ILUOUT,FMT='(A, I4)') "SET_RSOU/Reading Sea Surface forcing: Number=", JKT
- READ(ILUPRE,*) ZFRCLT(JKT)%nyear, ZFRCLT(JKT)%nmonth, &
- ZFRCLT(JKT)%nday, ZFRCLT(JKT)%xtime
- READ(ILUPRE,*) ZSSUFL_T(JKT)
- READ(ILUPRE,*) ZSSVFL_T(JKT)
- READ(ILUPRE,*) ZSSTFL_T(JKT)
- READ(ILUPRE,*) ZSSOLA_T(JKT)
- END DO
-!
- DO JKT = 1 , IFRCLT
- WRITE(UNIT=ILUOUT,FMT='(F9.0, "s, date:", I3, "/", I3, "/", I5)') &
- ZFRCLT(JKT)%xtime, ZFRCLT(JKT)%nday, &
- ZFRCLT(JKT)%nmonth, ZFRCLT(JKT)%nyear
- END DO
- NINFRT= INT(ZFRCLT(2)%xtime)
- WRITE(ILUOUT,FMT='(A)') &
- "Number U-Stress, V-Stress, Heat turb Flux, Solar Flux Interval(s)",NINFRT
- DO JKT = 1, IFRCLT
- WRITE(ILUOUT,FMT='(I10,99(3F10.2))') JKT, ZSSUFL_T(JKT),ZSSVFL_T(JKT),ZSSTFL_T(JKT)
- END DO
- NFRCLT = IFRCLT
- ALLOCATE(TFRCLT(NFRCLT))
- ALLOCATE(XSSUFL_T(NFRCLT));XSSUFL_T(:)=0.
- ALLOCATE(XSSVFL_T(NFRCLT));XSSVFL_T(:)=0.
- ALLOCATE(XSSTFL_T(NFRCLT));XSSTFL_T(:)=0.
- ALLOCATE(XSSOLA_T(NFRCLT));XSSOLA_T(:)=0.
-!
- DO JKT=1,NFRCLT
- TFRCLT(JKT)= ZFRCLT(JKT)
- XSSUFL_T(JKT)=ZSSUFL_T(JKT)/XRH00OCEAN
- XSSVFL_T(JKT)=ZSSVFL_T(JKT)/XRH00OCEAN
- ! working in SI
- XSSTFL_T(JKT)=ZSSTFL_T(JKT) /(3900.*XRH00OCEAN)
- XSSOLA_T(JKT)=ZSSOLA_T(JKT) /(3900.*XRH00OCEAN)
- END DO
- DEALLOCATE(ZFRCLT)
- DEALLOCATE(ZSSUFL_T)
- DEALLOCATE(ZSSVFL_T)
- DEALLOCATE(ZSSTFL_T)
- DEALLOCATE(ZSSOLA_T)
-!
-!--------------------------------------------------------------------------------
-! 2.0.2 Ocean standard initialize from netcdf files
-! U,V,T,S at Z levels + Forcings at model TOP (sea surface)
-!--------------------------------------------------------------------------------
-!
- CASE ('STANDOCE')
-!
- XP00=XP00OCEAN
- READ(ILUPRE,*) ZPTOP ! P_atmosphere at sfc =P top domain
- READ(ILUPRE,*) YINFILE, YINFISF
- WRITE(ILUOUT,FMT=*) 'Netcdf files to read:', YINFILE, YINFISF
- ! Open file containing initial profiles
- CALL check(nf90_open(yinfile,NF90_NOWRITE,incid), "opening NC file")
- ! Reading dimensions and lengths
- CALL check( nf90_inq_dimid(incid, "depth",idimid), "getting depth dimension id" )
- CALL check( nf90_inquire_dimension(incid, idimid, len=INZ), "getting INZ" )
- CALL check( nf90_inquire_dimension(incid, INT(2,KIND=CDFINT), len=INLONGI), "getting NLONG" )
- CALL check( nf90_inquire_dimension(incid, INT(1,KIND=CDFINT), len=INLATI), "getting NLAT" )
-!
- WRITE(ILUOUT,FMT=*) 'NB LEVLS READ INZ, NLONG NLAT ', INZ, INLONGI,INLATI
- ALLOCATE(ZOC_TEMPERATURE(INLATI,INLONGI,INZ),ZOC_SALINITY(INLATI,INLONGI,INZ))
- ALLOCATE(ZOC_U(INLATI,INLONGI,INZ),ZOC_V(INLATI,INLONGI,INZ))
- ALLOCATE(ZOC_DEPTH(INZ))
- WRITE(ILUOUT,FMT=*) 'NETCDF READING ==> Temp'
- CALL check(nf90_inq_varid(incid,"temperature",ivarid), "getting temp ivarid")
- CALL check(nf90_get_var(incid,ivarid,ZOC_TEMPERATURE), "reading temp")
- WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> salinity'
- CALL check(nf90_inq_varid(incid,"salinity",ivarid), "getting salinity ivarid")
- CALL check(nf90_get_var(incid,ivarid,ZOC_SALINITY), "reading salinity")
- WRITE(ILUOUT,FMT=*) 'Netcdf ==> Reading depth'
- CALL check(nf90_inq_varid(incid,"depth",ivarid), "getting depth ivarid")
- CALL check(nf90_get_var(incid,ivarid,ZOC_DEPTH), "reading depth")
- WRITE(ILUOUT,FMT=*) 'depth: max min ', MAXVAL(ZOC_DEPTH),MINVAL(ZOC_DEPTH)
- WRITE(ILUOUT,FMT=*) 'depth 1 nz: ', ZOC_DEPTH(1),ZOC_DEPTH(INZ)
- WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> Currents'
- CALL check(nf90_inq_varid(incid,"u",ivarid), "getting u ivarid")
- CALL check(nf90_get_var(incid,ivarid,ZOC_U), "reading u")
- CALL check(nf90_inq_varid(incid,"v",ivarid), "getting v ivarid")
- CALL check(nf90_get_var(incid,ivarid,ZOC_V), "reading v")
- CALL check(nf90_close(incid), "closing yinfile")
- WRITE(ILUOUT,FMT=*) 'End of initial file reading'
-!
- DO JKM=1,INZ
- ZOC_TEMPERATURE(1,1,JKM)=ZOC_TEMPERATURE(1,1,JKM)+273.15
- WRITE(ILUOUT,FMT=*) 'Z T(Kelvin) S(Sverdup) U V K',&
- JKM,ZOC_DEPTH(JKM),ZOC_TEMPERATURE(1,1,JKM),ZOC_SALINITY(1,1,JKM),ZOC_U(1,1,JKM),ZOC_V(1,1,JKM), JKM
- ENDDO
- ! number of data levels
- ILEVELM=INZ
- ! Model bottom
- ZTGROUND = ZOC_TEMPERATURE(1,1,ILEVELM)
- ZMRGROUND = ZOC_SALINITY(1,1,ILEVELM)
- ZZGROUND=0.
- ! Allocate required memory
- ALLOCATE(ZHEIGHTM(ILEVELM))
- ALLOCATE(ZT(ILEVELM))
- ALLOCATE(ZTV(ILEVELM))
- ALLOCATE(ZMR(ILEVELM))
- ALLOCATE(ZTHV(ILEVELM))
- ALLOCATE(ZTHL(ILEVELM))
- ALLOCATE(ZRT(ILEVELM))
- ! Going from the inverse model grid (data) to the normal one
- DO JKM= 1,ILEVELM
- ! Z axis reoriented as in the model
- IDX = ILEVELM-JKM+1
- ZT(JKM) = ZOC_TEMPERATURE(1,1,IDX)
- ZMR(JKM) = ZOC_SALINITY(1,1,IDX)
- ! ZHEIGHT used only in set_ rsou, defined as such ZHEIGHT(ILEVELM)=H_model
- ! Z oriented in same time to have a model domain axis going
- ! from 0m (ocean bottom/model bottom) towards H (ocean sfc/model top)
- ! translation/inversion
- ZHEIGHTM(JKM) = -ZOC_DEPTH(IDX) + ZOC_DEPTH(ILEVELM)
- WRITE(ILUOUT,FMT=*) 'End gridmodel comput: JKM IDX depth T S ZHEIGHTM', &
- JKM,IDX,ZOC_DEPTH(IDX),ZT(JKM),ZMR(JKM),ZHEIGHTM(JKM)
- END DO
- ! complete ther variables
- ZTV = ZT
- ZTHV = ZT
- ZRT = ZMR
- ZTHL = ZT
- ZTH = ZT
- ! INIT --- U V -----
- ILEVELU = INZ ! Same nb of levels for u,v,T,S
- !Assume that current and temp are given at same level
- ALLOCATE(ZHEIGHTU(ILEVELU))
- ALLOCATE(ZU(ILEVELU),ZV(ILEVELU))
- ZHEIGHTU=ZHEIGHTM
- DO JKM= 1,ILEVELU
- ! Z axis reoriented as in the model
- IDX = ILEVELU-JKM+1
- ZU(JKM) = ZOC_U(1,1,IDX)
- ZV(JKM) = ZOC_V(1,1,IDX)
- ! ZHEIGHT used only in set_ rsou, defined as such ZHEIGHT(ILEVELM)=H_model
- ! Z oriented in same time to have a model domain axis going
- ! from 0m (ocean bottom/model bottom) towards H (ocean sfc/model top)
- END DO
-!
- DEALLOCATE(ZOC_TEMPERATURE)
- DEALLOCATE(ZOC_SALINITY)
- DEALLOCATE(ZOC_U)
- DEALLOCATE(ZOC_V)
- DEALLOCATE(ZOC_DEPTH)
-!
- ! Reading/initializing surface forcings
-!
- WRITE(ILUOUT,FMT=*) 'netcdf sfc forcings file to be read:',yinfisf
- ! Open of sfc forcing file
- CALL check(nf90_open(yinfisf,NF90_NOWRITE,incid), "opening NC file")
- ! Reading dimension and length
- CALL check( nf90_inq_dimid(incid,"t",idimid), "getting time dimension id" )
- CALL check( nf90_inquire_dimension(incid, idimid, len=idimlen), "getting idimlen " )
-!
- WRITE(ILUOUT,FMT=*) 'nb sfc-forcing time idimlen=',idimlen
- ALLOCATE(ZOC_LE(idimlen))
- ALLOCATE(ZOC_H(idimlen))
- ALLOCATE(ZOC_SW_DOWN(idimlen))
- ALLOCATE(ZOC_SW_UP(idimlen))
- ALLOCATE(ZOC_LW_DOWN(idimlen))
- ALLOCATE(ZOC_LW_UP(idimlen))
- ALLOCATE(ZOC_TAUX(idimlen))
- ALLOCATE(ZOC_TAUY(idimlen))
-!
- WRITE(ILUOUT,FMT=*)'Netcdf Reading ==> LE'
- CALL check(nf90_inq_varid(incid,"LE",ivarid), "getting LE ivarid")
- CALL check(nf90_get_var(incid,ivarid,ZOC_LE), "reading LE flux")
- WRITE(ILUOUT,FMT=*)'Netcdf Reading ==> H'
- CALL check(nf90_inq_varid(incid,"H",ivarid), "getting H ivarid")
- CALL check(nf90_get_var(incid,ivarid,ZOC_H), "reading H flux")
- WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> SW_DOWN'
- CALL check(nf90_inq_varid(incid,"SW_DOWN",ivarid), "getting SW_DOWN ivarid")
- CALL check(nf90_get_var(incid,ivarid,ZOC_SW_DOWN), "reading SW_DOWN")
- WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> SW_UP'
- CALL check(nf90_inq_varid(incid,"SW_UP",ivarid), "getting SW_UP ivarid")
- CALL check(nf90_get_var(incid,ivarid,ZOC_SW_UP), "reading SW_UP")
- WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> LW_DOWN'
- CALL check(nf90_inq_varid(incid,"LW_DOWN",ivarid), "getting LW_DOWN ivarid")
- CALL check(nf90_get_var(incid,ivarid,ZOC_LW_DOWN), "reading LW_DOWN")
- WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> LW_UP'
- CALL check(nf90_inq_varid(incid,"LW_UP",ivarid), "getting LW_UP ivarid")
- CALL check(nf90_get_var(incid,ivarid,ZOC_LW_UP), "reading LW_UP")
- WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> TAUX'
- CALL check(nf90_inq_varid(incid,"TAUX",ivarid), "getting TAUX ivarid")
- CALL check(nf90_get_var(incid,ivarid,ZOC_TAUX), "reading TAUX")
- WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> TAUY'
- CALL check(nf90_inq_varid(incid,"TAUY",ivarid), "getting TAUY ivarid")
- CALL check(nf90_get_var(incid,ivarid,ZOC_TAUY), "reading TAUY")
- CALL check(nf90_close(incid), "closing yinfifs")
-!
- WRITE(ILUOUT,FMT=*) ' Forcing-Number LE H SW_down SW_up LW_down LW_up TauX TauY'
- DO JKM = 1, idimlen
- WRITE(ILUOUT,FMT=*) JKM, ZOC_LE(JKM), ZOC_H(JKM),ZOC_SW_DOWN(JKM),ZOC_SW_UP(JKM),&
- ZOC_LW_DOWN(JKM),ZOC_LW_UP(JKM),ZOC_TAUX(JKM),ZOC_TAUY(JKM)
- ENDDO
- ! IFRCLT FORCINGS at sea surface
- IFRCLT=idimlen
- ALLOCATE(ZFRCLT(IFRCLT))
- ALLOCATE(ZSSUFL_T(IFRCLT)); ZSSUFL_T = 0.0
- ALLOCATE(ZSSVFL_T(IFRCLT)); ZSSVFL_T = 0.0
- ALLOCATE(ZSSTFL_T(IFRCLT)); ZSSTFL_T = 0.0
- ALLOCATE(ZSSOLA_T(IFRCLT)); ZSSOLA_T = 0.0
- DO JKT=1,IFRCLT
- ! Initial file for CINDY-DYNAMO: all fluxes correspond to the absolute value (>0)
- ! modele ocean: axe z dirigé du bas vers la sfc de l'océan
- ! => flux dirigé vers le haut (positif ocean vers l'atmopshere i.e. bas vers le haut)
- ZSSOLA_T(JKT)=ZOC_SW_DOWN(JKT)-ZOC_SW_UP(JKT)
- ZSSTFL_T(JKT)=(ZOC_LW_DOWN(JKT)-ZOC_LW_UP(JKT)-ZOC_LE(JKT)-ZOC_H(JKT))
- ! assume that Tau given on file is along Ox
- ! rho_air UW_air = rho_ocean UW_ocean= N/m2
- ! uw_ocean
- ZSSUFL_T(JKT)=ZOC_TAUX(JKT)
- ZSSVFL_T(JKT)=ZOC_TAUY(JKT)
- WRITE(ILUOUT,FMT=*) 'Forcing Nb Sol NSol UW_oc VW',&
- JKT,ZSSOLA_T(JKT),ZSSTFL_T(JKT),ZSSUFL_T(JKT),ZSSVFL_T(JKT)
- ENDDO
- ! Allocate and Writing the corresponding variables in module MODD_OCEAN_FRC
- NFRCLT=IFRCLT
- ! value to read later on file ?
- NINFRT=600
- ALLOCATE(TFRCLT(NFRCLT))
- ALLOCATE(XSSUFL_T(NFRCLT));XSSUFL_T(:)=0.
- ALLOCATE(XSSVFL_T(NFRCLT));XSSVFL_T(:)=0.
- ALLOCATE(XSSTFL_T(NFRCLT));XSSTFL_T(:)=0.
- ALLOCATE(XSSOLA_T(NFRCLT));XSSOLA_T(:)=0.
- ! on passe en unités SI, signe, etc pour le modele ocean
- ! W/m2 => SI : /(CP_mer * rho_mer)
- ! a revoir dans tt le code pour mettre de svaleurs plus exactes
- DO JKT=1,NFRCLT
- TFRCLT(JKT)= ZFRCLT(JKT)
- XSSUFL_T(JKT)=ZSSUFL_T(JKT)/XRH00OCEAN
- XSSVFL_T(JKT)=ZSSVFL_T(JKT)/XRH00OCEAN
- XSSTFL_T(JKT)=ZSSTFL_T(JKT) /(3900.*XRH00OCEAN)
- XSSOLA_T(JKT)=ZSSOLA_T(JKT) /(3900.*XRH00OCEAN)
- END DO
- DEALLOCATE(ZFRCLT)
- DEALLOCATE(ZSSUFL_T)
- DEALLOCATE(ZSSVFL_T)
- DEALLOCATE(ZSSTFL_T)
- DEALLOCATE(ZSSOLA_T)
- DEALLOCATE(ZOC_LE)
- DEALLOCATE(ZOC_H)
- DEALLOCATE(ZOC_SW_DOWN)
- DEALLOCATE(ZOC_SW_UP)
- DEALLOCATE(ZOC_LW_DOWN)
- DEALLOCATE(ZOC_LW_UP)
- DEALLOCATE(ZOC_TAUX)
- DEALLOCATE(ZOC_TAUY)
- ! END OCEAN STANDARD
-!
-!
-!* 2.1 ATMOSPHERIC STANDARD case : ZGROUND, PGROUND, TGROUND, TDGROUND
-! (Pressure, dd, ff) ,
-! (Pressure, T, Td)
-!
- CASE ('STANDARD')
-
- READ(ILUPRE,*) ZZGROUND ! Read data at ground level
- READ(ILUPRE,*) ZPGROUND
- READ(ILUPRE,*) ZTGROUND
- READ(ILUPRE,*) ZTDGROUND
-!
- READ(ILUPRE,*) ILEVELU ! Read number of wind levels
- ALLOCATE(ZPRESSU(ILEVELU)) ! Allocate memory for arrays to be read
- ALLOCATE(ZDD(ILEVELU),ZFF(ILEVELU))
- ALLOCATE(ZHEIGHTU(ILEVELU)) ! Allocate memory for needed
- ALLOCATE(ZU(ILEVELU),ZV(ILEVELU)) ! arrays
- ALLOCATE(ZTHVU(ILEVELU)) ! Allocate memory for intermediate
- ! arrays
-!
- DO JKU = 1,ILEVELU ! Read data at wind levels
- READ(ILUPRE,*) ZPRESSU(JKU),ZDD(JKU),ZFF(JKU)
- END DO
-!
- READ(ILUPRE,*) ILEVELM ! Read number of mass levels
- ! including the ground level
- ALLOCATE(ZPRESSM(ILEVELM)) ! Allocate memory for arrays to be read
- ALLOCATE(ZT(ILEVELM))
- ALLOCATE(ZTD(ILEVELM))
- ALLOCATE(ZHEIGHTM(ILEVELM)) ! Allocate memory for needed
- ALLOCATE(ZTHV(ILEVELM)) ! arrays
- ALLOCATE(ZMR(ILEVELM))
- ALLOCATE(ZTV(ILEVELM)) ! Allocate memory for intermediate arrays
- ALLOCATE(ZTHL(ILEVELM))
- ALLOCATE(ZRT(ILEVELM))
-!
-!
- DO JKM= 2,ILEVELM ! Read data at mass levels
- READ(ILUPRE,*) ZPRESSM(JKM),ZT(JKM),ZTD(JKM)
- END DO
- ZPRESSM(1)=ZPGROUND ! Mass level 1 is at the ground
- ZT(1)=ZTGROUND
- ZTD(1)=ZTDGROUND
-!
-! recover the North-South and West-East wind components
- ZU(:) = ZFF(:)*COS(ZRADSDG*(270.-ZDD(:)) )
- ZV(:) = ZFF(:)*SIN(ZRADSDG*(270.-ZDD(:)) )
-!
-! compute vapor mixing ratio
- ZMR(:) = SM_FOES(ZTD(:)) &
- / ( (ZPRESSM(:) - SM_FOES(ZTD(:))) * ZRVSRD )
-!
-! compute Tv
- ZTV(:) = ZT(:) * (1. + ZRVSRD * ZMR(:))/(1.+ZMR(:))
-!
-! compute thetav
- ZTHV(:) = ZTV(:) * (XP00/ ZPRESSM(:)) **(ZRDSCPD)
-!
-! compute height at the mass levels of the RS
- ZHEIGHTM(:) = HEIGHT_PRESS(ZPRESSM,ZTHV,ZPGROUND,ZTHV(1),ZZGROUND)
-!
-! compute thetav and height at the wind levels of the RS
- ZTHVU(:) = THETAVPU_THETAVPM(ZPRESSM,ZPRESSU,ZTHV)
- ZHEIGHTU(:) = HEIGHT_PRESS(ZPRESSU,ZTHVU,ZPGROUND,ZTHV(1),ZZGROUND)
-!
-! Compute Thetal and Rt
- ZRT(:)=ZMR(:)
- ZTHL(:)=ZTHV(:)*(1+ZRT(:))/(1+ZRVSRD*ZRT(:))
-!
-!* 2.2 PUVTHVMR case : zGROUND, PGROUND, ThvGROUND, RGROUND
-! (Pressure, U, V) ,
-! (Pressure, THv, R)
-!
- CASE ('PUVTHVMR')
-!
-! Read data at ground level
- READ(ILUPRE,*) ZZGROUND
- READ(ILUPRE,*) ZPGROUND
- READ(ILUPRE,*) ZTHVGROUND
- READ(ILUPRE,*) ZMRGROUND
-!
-! Read number of wind levels
- READ(ILUPRE,*) ILEVELU
-!
-! Allocate the required memory
- ALLOCATE(ZPRESSU(ILEVELU))
- ALLOCATE(ZU(ILEVELU),ZV(ILEVELU))
- ALLOCATE(ZHEIGHTU(ILEVELU))
- ALLOCATE(ZTHVU(ILEVELU))
-!
-! Read the data at each wind level of the RS
- DO JKU =1,ILEVELU
- READ(ILUPRE,*) ZPRESSU(JKU),ZU(JKU),ZV(JKU)
- END DO
-!
-! Read number of mass levels
- READ(ILUPRE,*) ILEVELM
-!
-! Allocate the required memory
- ALLOCATE(ZPRESSM(ILEVELM))
- ALLOCATE(ZHEIGHTM(ILEVELM))
- ALLOCATE(ZTHV(ILEVELM))
- ALLOCATE(ZMR(ILEVELM))
- ALLOCATE(ZTHL(ILEVELM))
- ALLOCATE(ZRT(ILEVELM))
-!
-! Read the data at each mass level of the RS
- DO JKM = 2,ILEVELM
- READ(ILUPRE,*) ZPRESSM(JKM),ZTHV(JKM),ZMR(JKM)
- END DO
-!
-! Complete the mass arrays with the ground informations read in EXPRE file
- ZPRESSM(1) = ZPGROUND
- ZTHV(1) = ZTHVGROUND
- ZMR(1) = ZMRGROUND
-!
-! Compute height of the mass levels of the RS
- ZHEIGHTM(:) = HEIGHT_PRESS(ZPRESSM,ZTHV,ZPGROUND,ZTHV(1),ZZGROUND)
-!
-! Compute thetav and heigth at the wind levels of the RS
- ZTHVU(:) = THETAVPU_THETAVPM(ZPRESSM,ZPRESSU,ZTHV)
- ZHEIGHTU(:) = HEIGHT_PRESS(ZPRESSU,ZTHVU,ZPGROUND,ZTHV(1),ZZGROUND)
-!
-! on interpole thetal(=theta quand il n'y a pas d'eau liquide) et r total
- ZRT(:)=ZMR(:)
- ZTHL(:)=ZTHV(:)*(1+ZRT(:))/(1+ZRVSRD*ZRT(:))
-!
-!* 2.3 PUVTHVHU case : zGROUND, PGROUND, ThvGROUND, HuGROUND
-! (Pressure, U, V) ,
-! (Pressure, THv, Hu)
-!
- CASE ('PUVTHVHU')
-!
-! Read data at ground level
- READ(ILUPRE,*) ZZGROUND
- READ(ILUPRE,*) ZPGROUND
- READ(ILUPRE,*) ZTHVGROUND
- READ(ILUPRE,*) ZHUGROUND
-!
-! Read number of wind levels
- READ(ILUPRE,*) ILEVELU
-!
-! Allocate the required memory
- ALLOCATE(ZPRESSU(ILEVELU))
- ALLOCATE(ZU(ILEVELU),ZV(ILEVELU))
- ALLOCATE(ZHEIGHTU(ILEVELU))
- ALLOCATE(ZTHVU(ILEVELU))
-!
-! Read the data at each wind level of the RS
- DO JKU =1,ILEVELU
- READ(ILUPRE,*) ZPRESSU(JKU),ZU(JKU),ZV(JKU)
- END DO
-!
-! Read number of mass levels
- READ(ILUPRE,*) ILEVELM
-!
-! Allocate the required memory
- ALLOCATE(ZPRESSM(ILEVELM))
- ALLOCATE(ZTHV(ILEVELM))
- ALLOCATE(ZHU(ILEVELM))
- ALLOCATE(ZHEIGHTM(ILEVELM))
- ALLOCATE(ZMR(ILEVELM))
- ALLOCATE(ZTV(ILEVELM))
- ALLOCATE(ZTHL(ILEVELM))
- ALLOCATE(ZRT(ILEVELM))
-!
-! Read the data at each mass level of the RS
- DO JKM = 2,ILEVELM
- READ(ILUPRE,*) ZPRESSM(JKM),ZTHV(JKM),ZHU(JKM)
- END DO
-!
-! Complete the mass arrays with the ground informations read in EXPRE file
- ZPRESSM(1) = ZPGROUND ! Mass level 1 is at the ground
- ZTHV(1) = ZTHVGROUND
- ZHU(1) = ZHUGROUND
-!
-! Compute Tv
- ZTV(:)=ZTHV(:) * (ZPRESSM(:) / XP00) ** ZRDSCPD
-!
-! Compte mixing ratio
- ZMR(:)=SM_PMR_HU(ZPRESSM(:),ZTV(:),ZHU(:),SPREAD(ZMR(:),2,1))
-!
-! Compute height of the mass levels of the RS
- ZHEIGHTM(:) = HEIGHT_PRESS(ZPRESSM,ZTHV,ZPGROUND,ZTHV(1),ZZGROUND)
-!
-! Compute thetav and height of the wind levels of the RS
- ZTHVU(:) = THETAVPU_THETAVPM(ZPRESSM,ZPRESSU,ZTHV)
- ZHEIGHTU(:) = HEIGHT_PRESS(ZPRESSU,ZTHVU,ZPGROUND,ZTHV(1),ZZGROUND)
-!
-! on interpole thetal(=theta quand il n'y a pas d'eau liquide) et r total
- ZRT(:)=ZMR(:)
- ZTHL(:)=ZTHV(:)*(1+ZRT(:))/(1+ZRVSRD*ZRT(:))
-!
-!* 2.4 ZUVTHVHU case : zGROUND, PGROUND, ThvGROUND, HuGROUND
-! (height, U, V) ,
-! (height, THv, Hu)
-!
- CASE ('ZUVTHVHU')
-! Read data at ground level
- READ(ILUPRE,*) ZZGROUND
- READ(ILUPRE,*) ZPGROUND
- READ(ILUPRE,*) ZTHVGROUND
- READ(ILUPRE,*) ZHUGROUND
-!
-! Read number of wind levels
- READ(ILUPRE,*) ILEVELU
-!
-! Allocate the required memory
- ALLOCATE(ZPRESSU(ILEVELU))
- ALLOCATE(ZHEIGHTU(ILEVELU))
- ALLOCATE(ZU(ILEVELU),ZV(ILEVELU))
-!
-!
-! Read the data at each wind level of the RS
- DO JKU = 1,ILEVELU
- READ(ILUPRE,*) ZHEIGHTU(JKU),ZU(JKU),ZV(JKU)
- END DO
-!
-! Read number of mass levels
- READ(ILUPRE,*) ILEVELM
-!
-! Allocate the required memory
- ALLOCATE(ZHEIGHTM(ILEVELM))
- ALLOCATE(ZTHV(ILEVELM))
- ALLOCATE(ZHU(ILEVELM))
- ALLOCATE(ZMR(ILEVELM))
- ALLOCATE(ZPRESSM(ILEVELM))
- ALLOCATE(ZTV(ILEVELM))
- ALLOCATE(ZTHL(ILEVELM))
- ALLOCATE(ZRT(ILEVELM))
-!
-! Read the data at each mass level of the RS
- DO JKM = 2,ILEVELM
- READ(ILUPRE,*) ZHEIGHTM(JKM),ZTHV(JKM),ZHU(JKM)
- END DO
-!
-! Complete the mass arrays with the ground informations read in EXPRE file
- ZHEIGHTM(1) = ZZGROUND ! Mass level 1 is at the ground
- ZTHV(1) = ZTHVGROUND
- ZHU(1) = ZHUGROUND
-!
-! Compute Pressure at the mass levels of the RS
- ZPRESSM= PRESS_HEIGHT(ZHEIGHTM,ZTHV,ZPGROUND,ZTHV(1),ZHEIGHTM(1))
-!
-! Compute Tv and the mixing ratio at the mass levels of the RS
- ZTV(:)=ZTHV(:) * (ZPRESSM(:) / XP00) ** ZRDSCPD
- ZMR(:)=SM_PMR_HU(ZPRESSM(:),ZTV(:),ZHU(:),SPREAD(ZMR(:),2,1))
-!
-! on interpole thetal(=theta quand il n'y a pas d'eau liquide) et r total
- ZRT(:)=ZMR(:)
- ZTHL(:)=ZTHV(:)*(1+ZRT(:))/(1+ZRVSRD*ZRT(:))
-!
-!
-!* 2.5 ZUVTHVMR case : zGROUND, PGROUND, ThvGROUND, RGROUND
-! (height, U, V) ,
-! (height, THv, R)
-!
-!
- CASE ('ZUVTHVMR')
-! Read data at ground level
- READ(ILUPRE,*) ZZGROUND
- READ(ILUPRE,*) ZPGROUND
- READ(ILUPRE,*) ZTHVGROUND
- READ(ILUPRE,*) ZMRGROUND
-!
-! Read number of wind levels
- READ(ILUPRE,*) ILEVELU
-!
-! Allocate the required memory
- ALLOCATE(ZHEIGHTU(ILEVELU))
- ALLOCATE(ZU(ILEVELU),ZV(ILEVELU))
-!
-! Read the data at each wind level of the RS
- DO JKU = 1,ILEVELU
- READ(ILUPRE,*) ZHEIGHTU(JKU),ZU(JKU),ZV(JKU)
- END DO
-!
-! Read number of mass levels
- READ(ILUPRE,*) ILEVELM
-!
-! Allocate the required memory
- ALLOCATE(ZHEIGHTM(ILEVELM))
- ALLOCATE(ZTHV(ILEVELM))
- ALLOCATE(ZMR(ILEVELM))
- ALLOCATE(ZTHL(ILEVELM))
- ALLOCATE(ZRT(ILEVELM))
-!
-! Read the data at each mass level of the RS
- DO JKM=2,ILEVELM
- READ(ILUPRE,*) ZHEIGHTM(JKM),ZTHV(JKM),ZMR(JKM)
- END DO
-!
-! Complete the mass arrays with the ground informations read in EXPRE file
- ZHEIGHTM(1)= ZZGROUND ! Mass level 1 is at the ground
- ZTHV(1) = ZTHVGROUND
- ZMR(1) = ZMRGROUND
-! on interpole thetal(=theta quand il n'y a pas d'eau liquide) et r total
- ZRT(:)=ZMR(:)
- ZTHL(:)=ZTHV(:)*(1+ZRT(:))/(1+ZRVSRD*ZRT(:))
-!
-!
-!* 2.6 PUVTHDMR case : zGROUND, PGROUND, ThdGROUND, RGROUND
-! (Pressure, U, V) ,
-! (Pressure, THd, R)
-!
- CASE ('PUVTHDMR')
-! Read data at ground level
- READ(ILUPRE,*) ZZGROUND
- READ(ILUPRE,*) ZPGROUND
- READ(ILUPRE,*) ZTHDGROUND
- READ(ILUPRE,*) ZMRGROUND
-!
-! Read number of wind levels
- READ(ILUPRE,*) ILEVELU
-!
-! Allocate the required memory
- ALLOCATE(ZPRESSU(ILEVELU))
- ALLOCATE(ZU(ILEVELU),ZV(ILEVELU))
- ALLOCATE(ZTHVU(ILEVELU))
- ALLOCATE(ZHEIGHTU(ILEVELU))
-!
-! Read the data at each wind level of the RS
- DO JKU =1,ILEVELU
- READ(ILUPRE,*) ZPRESSU(JKU),ZU(JKU),ZV(JKU)
- END DO
-!
-! Read number of mass levels
- READ(ILUPRE,*) ILEVELM
-!
-! Allocate the required memory
- ALLOCATE(ZPRESSM(ILEVELM))
- ALLOCATE(ZTHD(ILEVELM))
- ALLOCATE(ZMR(ILEVELM))
- ALLOCATE(ZMRC(ILEVELM))
- ZMRC=0
- ALLOCATE(ZMRI(ILEVELM))
- ZMRI=0
- ALLOCATE(ZHEIGHTM(ILEVELM))
- ALLOCATE(ZTHV(ILEVELM))
- ALLOCATE(ZTHL(ILEVELM))
- ALLOCATE(ZRT(ILEVELM))
-!
-! Read the data at each mass level of the RS
- DO JKM=2,ILEVELM
- IF(LUSERI) THEN
- READ(ILUPRE,*) ZPRESSM(JKM),ZTHD(JKM),ZMR(JKM),ZMRC(JKM),ZMRI(JKM)
- ELSEIF (GUSERC) THEN
- READ(ILUPRE,*) ZPRESSM(JKM),ZTHD(JKM),ZMR(JKM),ZMRC(JKM)
- ELSE
- READ(ILUPRE,*) ZPRESSM(JKM),ZTHD(JKM),ZMR(JKM)
- ENDIF
- END DO
-!
-! Complete the mass arrays with the ground informations read in EXPRE file
- ZPRESSM(1) = ZPGROUND ! Mass level 1 is at the ground
- ZTHD(1) = ZTHDGROUND
- ZMR(1) = ZMRGROUND
- IF(GUSERC) ZMRC(1) = ZMRC(2)
- IF(LUSERI) ZMRI(1) = ZMRI(2)
-!
-! Compute thetav at the mass levels of the RS
- ZTHV(:) = ZTHD(:) * (1. + ZRVSRD *ZMR(:))/(1.+ZMR(:)+ZMRC(:)+ZMRI(:))
-!
-! Compute the heights at the mass levels of the RS
- ZHEIGHTM(:) = HEIGHT_PRESS(ZPRESSM,ZTHV,ZPGROUND,ZTHV(1),ZZGROUND)
-!
-! Compute thetav and heights of the wind levels
- ZTHVU(:) = THETAVPU_THETAVPM(ZPRESSM,ZPRESSU,ZTHV)
- ZHEIGHTU(:) = HEIGHT_PRESS(ZPRESSU,ZTHVU,ZPGROUND,ZTHV(1),ZZGROUND)
-!
-! Compute Theta l and Rt
- IF (.NOT. GUSERC .AND. .NOT. LUSERI) THEN
- ZRT(:)=ZMR(:)
- ZTHL(:)=ZTHV(:)*(1+ZRT(:))/(1+ZRVSRD*ZRT(:))
- ELSE
- ALLOCATE(ZEXN(ILEVELM))
- ALLOCATE(ZT(ILEVELM))
- ALLOCATE(ZCPH(ILEVELM))
- ALLOCATE(ZLVOCPEXN(ILEVELM))
- ALLOCATE(ZLSOCPEXN(ILEVELM))
- ZRT(:)=ZMR(:)+ZMRI(:)+ZMRC(:)
- ZEXN(:)=(ZPRESSM/XP00) ** (XRD/XCPD)
- ZT(:)=ZTHV*(ZPRESSM(:)/XP00)**(ZRDSCPD)*(1+ZRT(:))/(1+ZRVSRD*ZRT(:))
- ZCPH(:)=XCPD+ XCPV * ZMR(:)+ XCL *ZMRC(:) + XCI * ZMRI(:)
- ZLVOCPEXN(:) = (XLVTT + (XCPV-XCL) * (ZT(:)-XTT))/(ZCPH*ZEXN(:))
- ZLSOCPEXN(:) = (XLSTT + (XCPV-XCI) * (ZT(:)-XTT))/(ZCPH*ZEXN(:))
- ZTHL(:)=ZTHV(:)*(1+ZRT(:))/(1+ZRVSRD*ZRT(:))-ZLVOCPEXN(:)*ZMRC(:)-ZLSOCPEXN(:)*ZMRI(:)
- DEALLOCATE(ZEXN)
- DEALLOCATE(ZT)
- DEALLOCATE(ZCPH)
- DEALLOCATE(ZLVOCPEXN)
- DEALLOCATE(ZLSOCPEXN)
- ENDIF
-!
-!
-!* 2.7 PUVTHDHU case : zGROUND, PGROUND, ThdGROUND, HuGROUND
-! (Pressure, U, V) ,
-! (Pressure, THd, Hu)
-!
- CASE ('PUVTHDHU')
-! Read data at ground level
- READ(ILUPRE,*) ZZGROUND
- READ(ILUPRE,*) ZPGROUND
- READ(ILUPRE,*) ZTHDGROUND
- READ(ILUPRE,*) ZHUGROUND
-!
-! Read number of wind levels
- READ(ILUPRE,*) ILEVELU
-!
-! Allocate the required memory
- ALLOCATE(ZPRESSU(ILEVELU))
- ALLOCATE(ZU(ILEVELU),ZV(ILEVELU))
- ALLOCATE(ZTHVU(ILEVELU))
- ALLOCATE(ZHEIGHTU(ILEVELU))
-!
-! Read the data at each wind level of the RS
- DO JKU = 1,ILEVELU
- READ(ILUPRE,*) ZPRESSU(JKU),ZU(JKU),ZV(JKU)
- END DO
-!
-! Read number of mass levels
- READ(ILUPRE,*) ILEVELM
-!
-! Allocate the required memory
- ALLOCATE(ZPRESSM(ILEVELM))
- ALLOCATE(ZTHD(ILEVELM))
- ALLOCATE(ZHU(ILEVELM))
- ALLOCATE(ZHEIGHTM(ILEVELM))
- ALLOCATE(ZTHV(ILEVELM))
- ALLOCATE(ZMR(ILEVELM))
- ALLOCATE(ZT(ILEVELM))
- ALLOCATE(ZTHL(ILEVELM))
- ALLOCATE(ZRT(ILEVELM))
-!
-! Read the data at each mass level of the RS
- DO JKM =2,ILEVELM
- READ(ILUPRE,*) ZPRESSM(JKM),ZTHD(JKM), ZHU(JKM)
- END DO
-! Complete the mass arrays with the ground informations read in EXPRE file
- ZPRESSM(1) = ZPGROUND ! Mass level 1 is at the ground
- ZTHD(1) = ZTHDGROUND
- ZHU(1) = ZHUGROUND
-!
- ZT(:) = ZTHD(:) * (ZPRESSM(:)/XP00)**ZRDSCPD ! compute T and mixing ratio
- ZMR(:) = ZRDSRV*SM_FOES(ZT(:))/((ZPRESSM(:)*100./ZHU(:)) -SM_FOES(ZT(:)))
-
-! Compute thetav at the mass levels of the RS
- ZTHV(:) = ZTHD(:) * (1. + ZRVSRD *ZMR(:))/(1.+ZMR(:))
-!
-! Compute height at mass levels
- ZHEIGHTM(:) = HEIGHT_PRESS(ZPRESSM,ZTHV,ZPGROUND,ZTHV(1),ZZGROUND)
-!
-! Compute thetav and heights of the wind levels
- ZTHVU(:) = THETAVPU_THETAVPM(ZPRESSM,ZPRESSU,ZTHV)
- ZHEIGHTU(:) = HEIGHT_PRESS(ZPRESSU,ZTHVU,ZPGROUND,ZTHV(1),ZZGROUND)
-!
-! Compute thetal and Rt
- ZRT(:)=ZMR(:)
- ZTHL(:)=ZTHV(:)*(1+ZRT(:))/(1+ZRVSRD*ZRT(:))
-!
-!* 2.8 ZUVTHDMR case : zGROUND, PGROUND, ThdGROUND, RGROUND
-! (height, U, V) ,
-! (height, THd, R)
-!
- CASE ('ZUVTHDMR')
-! Read data at ground level
- READ(ILUPRE,*) ZZGROUND
- READ(ILUPRE,*) ZPGROUND
- READ(ILUPRE,*) ZTHDGROUND
- READ(ILUPRE,*) ZMRGROUND
-!
-! Read number of wind levels
- READ(ILUPRE,*) ILEVELU
-!
-! Allocate required memory
- ALLOCATE(ZHEIGHTU(ILEVELU))
- ALLOCATE(ZU(ILEVELU),ZV(ILEVELU))
-!
-! Read the data at each wind level of the RS
- DO JKU = 1,ILEVELU
- READ(ILUPRE,*) ZHEIGHTU(JKU),ZU(JKU),ZV(JKU)
- END DO
-!
-! Read number of mass levels
- READ(ILUPRE,*) ILEVELM
-!
-! Allocate required memory
- ALLOCATE(ZHEIGHTM(ILEVELM))
- ALLOCATE(ZTHD(ILEVELM))
- ALLOCATE(ZMR(ILEVELM))
- ALLOCATE(ZTHV(ILEVELM))
- ALLOCATE(ZMRC(ILEVELM))
- ZMRC=0
- ALLOCATE(ZMRI(ILEVELM))
- ZMRI=0
- ALLOCATE(ZTHL(ILEVELM))
- ALLOCATE(ZRT(ILEVELM))
-!
-! Read the data at each mass level of the RS
- DO JKM= 2,ILEVELM
- IF(LUSERI) THEN
- READ(ILUPRE,*) ZHEIGHTM(JKM),ZTHD(JKM),ZMR(JKM),ZMRC(JKM),ZMRI(JKM)
- ELSEIF (GUSERC) THEN
- READ(ILUPRE,*) ZHEIGHTM(JKM),ZTHD(JKM),ZMR(JKM),ZMRC(JKM)
- ELSE
- READ(ILUPRE,*) ZHEIGHTM(JKM),ZTHD(JKM),ZMR(JKM)
- ENDIF
- END DO
-! Complete the mass arrays with the ground informations read in EXPRE file
- ZHEIGHTM(1) = ZZGROUND ! Mass level 1 is at ground
- ZTHD(1) = ZTHDGROUND
- ZMR(1) = ZMRGROUND
- IF(GUSERC) ZMRC(1) = ZMRC(2)
- IF(LUSERI) ZMRI(1) = ZMRI(2)
-! Compute thetav at the mass levels of the RS
- IF(LUSERI) THEN
- ZTHV(:) = ZTHD(:) * (1. + ZRVSRD *ZMR(:))/(1.+ZMR(:)+ZMRC(:)+ZMRI(:))
- ELSEIF (GUSERC) THEN
- ZTHV(:) = ZTHD(:) * (1. + ZRVSRD *ZMR(:))/(1.+ZMR(:)+ZMRC(:))
- ELSE
- ZTHV(:) = ZTHD(:) * (1. + ZRVSRD *ZMR(:))/(1.+ZMR(:))
- ENDIF
-!
-! Compute Theta l and Rt
- IF (.NOT. GUSERC .AND. .NOT. LUSERI) THEN
- ZRT(:)=ZMR(:)
- ZTHL(:)=ZTHV(:)*(1+ZRT(:))/(1+ZRVSRD*ZRT(:))
- ELSE
- ALLOCATE(ZEXN(ILEVELM))
- ALLOCATE(ZEXNFLUX(ILEVELM))
- ALLOCATE(ZT(ILEVELM))
- ALLOCATE(ZCPH(ILEVELM))
- ALLOCATE(ZLVOCPEXN(ILEVELM))
- ALLOCATE(ZLSOCPEXN(ILEVELM))
- ZRT(:)=ZMR(:)+ZMRI(:)+ZMRC(:)
- ZEXNSURF=(ZPGROUND/XP00) ** (XRD/XCPD)
- CALL COMPUTE_EXNER_FROM_GROUND(ZTHV,ZHEIGHTM,ZEXNSURF,ZEXNFLUX,ZEXN)
- ZT(:)=ZTHV*ZEXN(:)*(1+ZRT(:))/(1+ZRVSRD*ZRT(:))
- ZCPH(:)=XCPD+ XCPV * ZMR(:)+ XCL *ZMRC(:) + XCI * ZMRI(:)
- ZLVOCPEXN(:) = (XLVTT + (XCPV-XCL) * (ZT(:)-XTT))/(ZCPH*ZEXN(:))
- ZLSOCPEXN(:) = (XLSTT + (XCPV-XCI) * (ZT(:)-XTT))/(ZCPH*ZEXN(:))
- ZTHL(:)=ZTHV(:)*(1+ZRT(:))/(1+ZRVSRD*ZRT(:))-ZLVOCPEXN(:)*ZMRC(:)-ZLSOCPEXN(:)*ZMRI(:)
- DEALLOCATE(ZEXN)
- DEALLOCATE(ZEXNFLUX)
- DEALLOCATE(ZT)
- DEALLOCATE(ZCPH)
- DEALLOCATE(ZLVOCPEXN)
- DEALLOCATE(ZLSOCPEXN)
- ENDIF
-!
-! 2.9 ZUVTHLMR case : zGROUND, PGROUND, ThdGROUND, RGROUND
-! (height, U, V)
-! (height, THL, Rt)
-
-!
- CASE ('ZUVTHLMR')
-! Read data at ground level
- READ(ILUPRE,*) ZZGROUND
- READ(ILUPRE,*) ZPGROUND
- READ(ILUPRE,*) ZTHLGROUND
- READ(ILUPRE,*) ZMRGROUND
-!
-! Read number of wind levels
- READ(ILUPRE,*) ILEVELU
-!
-! Allocate required memory
- ALLOCATE(ZHEIGHTU(ILEVELU))
- ALLOCATE(ZU(ILEVELU),ZV(ILEVELU))
-!
-! Read the data at each wind level of the RS
- DO JKU = 1,ILEVELU
- READ(ILUPRE,*) ZHEIGHTU(JKU),ZU(JKU),ZV(JKU)
- END DO
-!
-! Read number of mass levels
- READ(ILUPRE,*) ILEVELM
-!
-! Allocate required memory
- ALLOCATE(ZHEIGHTM(ILEVELM))
- ALLOCATE(ZTHL(ILEVELM))
- ALLOCATE(ZTH(ILEVELM))
- ALLOCATE(ZMR(ILEVELM))
- ALLOCATE(ZTHV(ILEVELM))
- ALLOCATE(ZMRC(ILEVELM))
- ZMRC=0
- ALLOCATE(ZMRI(ILEVELM))
- ZMRI=0
- ALLOCATE(ZRT(ILEVELM))
-!
-! Read the data at each mass level of the RS
- DO JKM= 2,ILEVELM
-! IF(LUSERI) THEN
-! READ(ILUPRE,*) ZHEIGHTM(JKM),ZTHL(JKM),ZMR(JKM),ZMRC(JKM),ZMRI(JKM)
-! ELSEIF (GUSERC) THEN
- IF (GUSERC) THEN
- READ(ILUPRE,*) ZHEIGHTM(JKM),ZTHL(JKM),ZMR(JKM),ZMRC(JKM)
- ELSE
- READ(ILUPRE,*) ZHEIGHTM(JKM),ZTHL(JKM),ZMR(JKM)
- ENDIF
- END DO
-! Complete the mass arrays with the ground informations read in EXPRE file
- ZHEIGHTM(1) = ZZGROUND ! Mass level 1 is at ground
- ZTHL(1) = ZTHLGROUND
- ZMR(1) = ZMRGROUND
- IF(GUSERC) ZMRC(1) = ZMRC(2)
-! IF(LUSERI) ZMRI(1) = ZMRI(2)
-!
-! Compute Rt
- ZRT(:)=ZMR+ZMRC+ZMRI
-!
-!* 2.10 PUVTHU case : zGROUND, PGROUND, TempGROUND, HuGROUND
-! (Pressure, U, V) ,
-! (Pressure, Temp, Hu)
-!
- CASE ('PUVTHU')
-! Read data at ground level
- READ(ILUPRE,*) ZZGROUND
- READ(ILUPRE,*) ZPGROUND
- READ(ILUPRE,*) ZTGROUND
- READ(ILUPRE,*) ZHUGROUND
-!
-! Read number of wind levels
- READ(ILUPRE,*) ILEVELU
-!
-! Allocate the required memory
- ALLOCATE(ZPRESSU(ILEVELU))
- ALLOCATE(ZU(ILEVELU),ZV(ILEVELU))
- ALLOCATE(ZTHVU(ILEVELU))
- ALLOCATE(ZHEIGHTU(ILEVELU))
-!
-! Read the data at each wind level of the RS
- DO JKU = 1,ILEVELU
- READ(ILUPRE,*) ZPRESSU(JKU),ZU(JKU),ZV(JKU)
- END DO
-!
-! Read number of mass levels
- READ(ILUPRE,*) ILEVELM
-!
-! Allocate the required memory
- ALLOCATE(ZPRESSM(ILEVELM))
- ALLOCATE(ZTHD(ILEVELM))
- ALLOCATE(ZHU(ILEVELM))
- ALLOCATE(ZHEIGHTM(ILEVELM))
- ALLOCATE(ZTHV(ILEVELM))
- ALLOCATE(ZMR(ILEVELM))
- ALLOCATE(ZT(ILEVELM))
- ALLOCATE(ZTHL(ILEVELM))
- ALLOCATE(ZRT(ILEVELM))
-
-!
-! Read the data at each mass level of the RS
- DO JKM =2,ILEVELM
- READ(ILUPRE,*) ZPRESSM(JKM),ZT(JKM), ZHU(JKM)
- END DO
-! Complete the mass arrays with the ground informations read in EXPRE file
- ZPRESSM(1) = ZPGROUND ! Mass level 1 is at the ground
- ZT(1) = ZTGROUND
- ZHU(1) = ZHUGROUND
-!
- ZTHD(:) = ZT(:) / (ZPRESSM(:)/XP00)**ZRDSCPD ! compute THD and mixing ratio
- ZMR(:) = ZRDSRV*SM_FOES(ZT(:))/((ZPRESSM(:)*100./ZHU(:)) -SM_FOES(ZT(:)))
-! Compute thetav at the mass levels of the RS
- ZTHV(:) = ZTHD(:) * (1. + ZRVSRD *ZMR(:))/(1.+ZMR(:))
-!
-! Compute height at mass levels
- ZHEIGHTM(:) = HEIGHT_PRESS(ZPRESSM,ZTHV,ZPGROUND,ZTHV(1),ZZGROUND)
-!
-! Compute thetav and heights of the wind levels
- ZTHVU(:) = THETAVPU_THETAVPM(ZPRESSM,ZPRESSU,ZTHV)
- ZHEIGHTU(:) = HEIGHT_PRESS(ZPRESSU,ZTHVU,ZPGROUND,ZTHV(1),ZZGROUND)
-!
-! on interpole thetal(=theta quand il n'y a pas d'eau liquide) et r total
- ZRT(:)=ZMR(:)
- ZTHL(:)=ZTHV(:)*(1+ZRT(:))/(1+ZRVSRD*ZRT(:))
- CASE DEFAULT
- CALL PRINT_MSG(NVERB_FATAL,'GEN','SET_RSOU','data type YKIND='//TRIM(YKIND)//' in PREFILE unknown')
-END SELECT
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. INTERPOLATE ON THE VERTICAL MIXED MODEL GRID
-! ---------------------------------------------------------
-!
-!
-!
-IKU=SIZE(XZHAT)
-!
-!* 3.1 Compute mixed grid
-!
-IF (PRESENT(PCORIOZ)) THEN
-! LGEOSBAL=T (no shift allowed, MNH grid without ororgraphy)
- ZZS_LS(:,:)=0
-ELSE
- IF (OSHIFT) THEN
- ZZS_LS(:,:)=ZZGROUND
- ELSE
- ZZS_LS(:,:)=0
- ENDIF
-ENDIF
-CALL VERT_COORD(LSLEVE,ZZS_LS,ZZS_LS,XLEN1,XLEN2,XZHAT,ZZFLUX_MX)
-ZZMASS_MX(:,:,:)=MZF(ZZFLUX_MX)
-ZZMASS_MX(:,:,IKU)=1.5*ZZFLUX_MX(:,:,IKU)-0.5*ZZFLUX_MX(:,:,IKU-1)
-!
-!* 3.2 Interpolate and extrapolate U and V on w- mixed grid levels
-!
-!* vertical grid at initialization profile location
-GPROFILE_IN_PROC=(KILOC+JPHEXT-IXOR_ll+1>=IIB .AND. KILOC+JPHEXT-IXOR_ll+1<=IIE) &
- & .AND. (KJLOC+JPHEXT-IYOR_ll+1>=IJB .AND. KJLOC+JPHEXT-IYOR_ll+1<=IJE)
-!
-IF (GPROFILE_IN_PROC) THEN
- ZZMASS_PROFILE(:) = ZZMASS_MX(KILOC+JPHEXT-IXOR_ll+1,KJLOC+JPHEXT-IYOR_ll+1,:)
- ZZFLUX_PROFILE(:) = ZZFLUX_MX(KILOC+JPHEXT-IXOR_ll+1,KJLOC+JPHEXT-IYOR_ll+1,:)
-ELSE
- ZZMASS_PROFILE(:) = 0.
- ZZFLUX_PROFILE(:) = 0.
-END IF
-DO JK = 1,IKU
- CALL REDUCESUM_ll(ZZMASS_PROFILE(JK), IINFO_ll)
- CALL REDUCESUM_ll(ZZFLUX_PROFILE(JK), IINFO_ll)
-END DO
-
-! interpolation of U and V
-DO JK = 1,IKU
- IF (ZZFLUX_PROFILE(JK) <= ZHEIGHTU(1)) THEN ! extrapolation below the first level
- ZDZSDH = (ZZFLUX_PROFILE(JK) - ZHEIGHTU(1)) / (ZHEIGHTU(2) - ZHEIGHTU(1))
- ZUW(JK) = ZU(1) + (ZU(2) - ZU(1)) * ZDZSDH
- ZVW(JK) = ZV(1) + (ZV(2) - ZV(1)) * ZDZSDH
- ELSE IF (ZZFLUX_PROFILE(JK) > ZHEIGHTU(ILEVELU) ) THEN ! extrapolation above the last
- ZDZSDH = (ZZFLUX_PROFILE(JK) - ZHEIGHTU(ILEVELU)) & ! level
- / (ZHEIGHTU(ILEVELU) - ZHEIGHTU(ILEVELU-1))
- ZUW(JK) = ZU(ILEVELU) + (ZU(ILEVELU) -ZU(ILEVELU -1)) * ZDZSDH
- ZVW(JK) = ZV(ILEVELU) + (ZV(ILEVELU) -ZV(ILEVELU -1)) * ZDZSDH
- ELSE ! interpolation between the first and last levels
- DO JKLEV = 1,ILEVELU-1
- IF ( (ZZFLUX_PROFILE(JK) > ZHEIGHTU(JKLEV)).AND. &
- (ZZFLUX_PROFILE(JK) <= ZHEIGHTU(JKLEV+1)) )THEN
- ZDZ1SDH = (ZZFLUX_PROFILE(JK) - ZHEIGHTU(JKLEV)) &
- / (ZHEIGHTU(JKLEV+1)-ZHEIGHTU(JKLEV))
- ZDZ2SDH = (ZHEIGHTU(JKLEV+1) - ZZFLUX_PROFILE(JK) ) &
- / (ZHEIGHTU(JKLEV+1)-ZHEIGHTU(JKLEV))
- ZUW(JK) = (ZU(JKLEV) * ZDZ2SDH) + (ZU(JKLEV+1) *ZDZ1SDH)
- ZVW(JK) = (ZV(JKLEV) * ZDZ2SDH) + (ZV(JKLEV+1) *ZDZ1SDH)
- END IF
- END DO
- END IF
-END DO
-!
-!* 3.3 Interpolate and extrapolate Thetav and r on mass mixed grid levels
-!
-ZMRCM=0
-ZMRIM=0
-DO JK = 1,IKU
- IF (ZZMASS_PROFILE(JK) <= ZHEIGHTM(1)) THEN ! extrapolation below the first level
- ZDZSDH = (ZZMASS_PROFILE(JK) - ZHEIGHTM(1)) / (ZHEIGHTM(2) - ZHEIGHTM(1))
- ZTHLM(JK) = ZTHL(1) + (ZTHL(2) - ZTHL(1)) * ZDZSDH
- ZMRM(JK) = ZRT(1) + (ZRT(2) - ZRT(1)) * ZDZSDH
- IF (GUSERC) ZMRCM(JK) = ZMRC(1) + (ZMRC(2) - ZMRC(1)) * ZDZSDH
- IF (LUSERI) ZMRIM(JK) = ZMRI(1) + (ZMRI(2) - ZMRI(1)) * ZDZSDH
- ELSE IF (ZZMASS_PROFILE(JK) > ZHEIGHTM(ILEVELM) ) THEN ! extrapolation above the last
- ZDZSDH = (ZZMASS_PROFILE(JK) - ZHEIGHTM(ILEVELM)) & ! level
- / (ZHEIGHTM(ILEVELM) - ZHEIGHTM(ILEVELM-1))
- ZTHLM(JK) = ZTHL(ILEVELM) + (ZTHL(ILEVELM) -ZTHL(ILEVELM -1)) * ZDZSDH
- ZMRM(JK) = ZRT(ILEVELM) + (ZRT(ILEVELM) -ZRT(ILEVELM -1)) * ZDZSDH
- IF (GUSERC) ZMRCM(JK) = ZMRC(ILEVELM) + (ZMRC(ILEVELM) -ZMRC(ILEVELM -1)) * ZDZSDH
- IF (LUSERI) ZMRIM(JK) = ZMRI(ILEVELM) + (ZMRI(ILEVELM) -ZMRI(ILEVELM -1)) * ZDZSDH
- ELSE ! interpolation between the first and last levels
- DO JKLEV = 1,ILEVELM-1
- IF ( (ZZMASS_PROFILE(JK) > ZHEIGHTM(JKLEV)).AND. &
- (ZZMASS_PROFILE(JK) <= ZHEIGHTM(JKLEV+1)) )THEN
- ZDZ1SDH = (ZZMASS_PROFILE(JK) - ZHEIGHTM(JKLEV)) &
- / (ZHEIGHTM(JKLEV+1)-ZHEIGHTM(JKLEV))
- ZDZ2SDH = (ZHEIGHTM(JKLEV+1) - ZZMASS_PROFILE(JK) ) &
- / (ZHEIGHTM(JKLEV+1)-ZHEIGHTM(JKLEV))
- ZTHLM(JK) = (ZTHL(JKLEV) * ZDZ2SDH) + (ZTHL(JKLEV+1) *ZDZ1SDH)
- ZMRM(JK) = (ZRT(JKLEV) * ZDZ2SDH) + (ZRT(JKLEV+1) *ZDZ1SDH)
- IF (GUSERC) ZMRCM(JK) = (ZMRC(JKLEV) * ZDZ2SDH) + (ZMRC(JKLEV+1) *ZDZ1SDH)
- IF (LUSERI) ZMRIM(JK) = (ZMRI(JKLEV) * ZDZ2SDH) + (ZMRI(JKLEV+1) *ZDZ1SDH)
- END IF
- END DO
- END IF
-END DO
-!
-! Compute thetaV rv ri and Rc with adjustement
-ALLOCATE(ZEXNFLUX(IKU))
-ALLOCATE(ZEXNMASS(IKU))
-ALLOCATE(ZPRESS(IKU))
-ALLOCATE(ZPREFLUX(IKU))
-ALLOCATE(ZFRAC_ICE(IKU))
-ALLOCATE(ZRSATW(IKU))
-ALLOCATE(ZRSATI(IKU))
-ALLOCATE(ZMRT(IKU))
-ALLOCATE(ZBUF(IKU,16))
-ZMRT=ZMRM+ZMRCM+ZMRIM
-ZTHVM=ZTHLM
-!
-IF (LOCEAN) THEN
- ZRHODM(:)=XRH00OCEAN*(1.-XALPHAOC*(ZTHLM(:) - XTH00OCEAN)&
- +XBETAOC* (ZMRM(:) - XSA00OCEAN))
- ZPREFLUX(IKU)=ZPTOP
- DO JK=IKU-1,2,-1
- ZPREFLUX(JK) = ZPREFLUX(JK+1) + XG*ZRHODM(JK)*(ZZFLUX_PROFILE(JK+1)-ZZFLUX_PROFILE(JK))
- END DO
- ZPGROUND=ZPREFLUX(2)
- WRITE(ILUOUT,FMT=*)'ZPGROUND i.e. Pressure at ocean domain bottom',ZPGROUND
- ZTHM=ZTHVM
-ELSE
-! Atmospheric case
- ZEXNSURF=(ZPGROUND/XP00)**(XRD/XCPD)
- DO JLOOP=1,20 ! loop for pression
- CALL COMPUTE_EXNER_FROM_GROUND(ZTHVM,ZZMASS_PROFILE(:),ZEXNSURF,ZEXNFLUX,ZEXNMASS)
- ZPRESS(:)=XP00*(ZEXNMASS(:))**(XCPD/XRD)
- CALL TH_R_FROM_THL_RT(CST,NEBN,SIZE(ZPRESS,1),'T',ZFRAC_ICE,ZPRESS,ZTHLM,ZMRT,ZTHM,ZMRM,ZMRCM,ZMRIM, &
- ZRSATW, ZRSATI,OOCEAN=.FALSE.,&
- PBUF=ZBUF)
- ZTHVM(:)=ZTHM(:)*(1.+XRV/XRD*ZMRM(:))/(1.+(ZMRM(:)+ZMRIM(:)+ZMRCM(:)))
- ENDDO
-ENDIF
-!
-DEALLOCATE(ZEXNFLUX)
-DEALLOCATE(ZEXNMASS)
-DEALLOCATE(ZPRESS)
-DEALLOCATE(ZFRAC_ICE)
-DEALLOCATE(ZRSATW)
-DEALLOCATE(ZRSATI)
-DEALLOCATE(ZMRT)
-DEALLOCATE(ZBUF)
-!-------------------------------------------------------------------------------
-!
-!* 4. COMPUTE FIELDS ON THE MODEL GRID (WITH OROGRAPHY)
-! -------------------------------------------------
-CALL SET_MASS(TPFILE,GPROFILE_IN_PROC, ZZFLUX_PROFILE, &
- KILOC+JPHEXT,KJLOC+JPHEXT,ZZS_LS,ZZMASS_MX,ZZFLUX_MX,ZPGROUND,&
- ZTHVM,ZMRM,ZUW,ZVW,OSHIFT,OBOUSS,PJ,HFUNU,HFUNV, &
- PMRCM=ZMRCM,PMRIM=ZMRIM,PCORIOZ=PCORIOZ)
-!
-DEALLOCATE(ZPREFLUX)
-DEALLOCATE(ZHEIGHTM)
-DEALLOCATE(ZTHV)
-DEALLOCATE(ZMR)
-DEALLOCATE(ZTHL)
-!-------------------------------------------------------------------------------
-CONTAINS
- SUBROUTINE CHECK( ISTATUS, YLOC )
- INTEGER(KIND=CDFINT), INTENT(IN) :: ISTATUS
- CHARACTER(LEN=*), INTENT(IN) :: YLOC
-
- IF( ISTATUS /= NF90_NOERR ) THEN
- CALL PRINT_MSG( NVERB_ERROR, 'IO', 'SET_RSOU', 'error at ' // Trim( yloc) // ': ' // NF90_STRERROR( ISTATUS ) )
- END IF
- END SUBROUTINE check
- !
- INCLUDE "th_r_from_thl_rt.func.h"
- INCLUDE "compute_frac_ice.func.h"
- !
-END SUBROUTINE SET_RSOU
diff --git a/src/mesonh/ext/shallow_mf_pack.f90 b/src/mesonh/ext/shallow_mf_pack.f90
deleted file mode 100644
index 1f76d9759fc4562c5ae5835d9bb994c750ea5f3a..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/shallow_mf_pack.f90
+++ /dev/null
@@ -1,381 +0,0 @@
-!MNH_LIC Copyright 2010-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_SHALLOW_MF_PACK
-! ######################
-!
-INTERFACE
-! #################################################################
- SUBROUTINE SHALLOW_MF_PACK(KRR,KRRL,KRRI, &
- TPFILE,PTIME_LES, &
- PTSTEP, &
- PDZZ, PZZ, PDX,PDY, &
- PRHODJ, PRHODREF, &
- PPABSM, PEXN, &
- PSFTH,PSFRV, &
- PTHM,PRM,PUM,PVM,PTKEM,PSVM, &
- PRTHS,PRRS,PRUS,PRVS,PRSVS, &
- PSIGMF,PRC_MF,PRI_MF,PCF_MF,PFLXZTHVMF )
-! #################################################################
-!!
-use MODD_IO, only: TFILEDATA
-use modd_precision, only: MNHTIME
-!
-!* 1.1 Declaration of Arguments
-!
-!
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
-INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-REAL(kind=MNHTIME),DIMENSION(2), INTENT(OUT) :: PTIME_LES ! time spent in LES computations
-REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height of flux point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! dry density of the
- ! reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXN ! Exner function at t-dt
-
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTH,PSFRV ! normal surface fluxes of theta and Rv
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at t-dt
-REAL, DIMENSION(:,:,:,:),INTENT(IN):: PRM ! water var. at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM ! wind components at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! tke at t-dt
-
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar variable a t-dt
-
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS,PRVS,PRTHS ! Meso-NH sources
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Scalar sources
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGMF,PRC_MF,PRI_MF,PCF_MF ! cloud info for the cloud scheme
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFLXZTHVMF ! Thermal production for TKE scheme
-!
-REAL, INTENT(IN) :: PDX,PDY ! Size of mesh in X/Y directions
-END SUBROUTINE SHALLOW_MF_PACK
-
-END INTERFACE
-!
-END MODULE MODI_SHALLOW_MF_PACK
-
-! #################################################################
- SUBROUTINE SHALLOW_MF_PACK(KRR,KRRL,KRRI, &
- TPFILE,PTIME_LES, &
- PTSTEP, &
- PDZZ, PZZ, PDX,PDY, &
- PRHODJ, PRHODREF, &
- PPABSM, PEXN, &
- PSFTH,PSFRV, &
- PTHM,PRM,PUM,PVM,PTKEM,PSVM, &
- PRTHS,PRRS,PRUS,PRVS,PRSVS, &
- PSIGMF,PRC_MF,PRI_MF,PCF_MF,PFLXZTHVMF )
-! #################################################################
-!!
-!!**** *SHALLOW_MF_PACK* -
-!!
-!!
-!! PURPOSE
-!! -------
-!!**** The purpose of this routine is
-!!
-!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V.Masson 09/2010
-! --------------------------------------------------------------------------
-! Modifications:
-! R. Honnert 07/2012: introduction of vertical wind for the height of the thermal
-! M. Leriche 02/2017: avoid negative values for sv tendencies
-! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
-! S. Riette 11/2016: support for CFRAC_ICE_SHALLOW_MF
-! P. Wautelet 28/03/2019: use MNHTIME for time measurement variables
-! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
-! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY: CST
-USE MODD_NEB_n, ONLY: NEBN
-USE MODD_TURB_n, ONLY: TURBN
-USE MODD_CTURB, ONLY: CSTURB
-USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALLN, LMF_FLX
-USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
-!
-USE MODE_FILL_DIMPHYEX, ONLY: FILL_DIMPHYEX
-!
-USE MODD_BUDGET, ONLY: TBUDGETS,TBUCONF,lbudget_th,nbudget_th
-USE MODD_CONF
-USE MODD_IO, ONLY: TFILEDATA
-use modd_field, ONLY: tfieldmetadata, TYPEREAL
-USE MODD_NSV, ONLY: XSVMIN, NSV_LGBEG, NSV_LGEND
-USE MODD_PARAMETERS
-USE MODD_PARAM_MFSHALL_n
-USE modd_precision, ONLY: MNHTIME
-
-USE mode_budget, ONLY: Budget_store_init, Budget_store_end, Budget_store_add
-USE MODE_IO_FIELD_WRITE, ONLY: IO_Field_write
-
-USE MODI_DIAGNOS_LES_MF
-USE MODI_SHALLOW_MF
-USE MODI_SHUMAN
-!
-IMPLICIT NONE
-
-!* 0.1 Declaration of Arguments
-!
-!
-!
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
-INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-REAL(kind=MNHTIME),DIMENSION(2), INTENT(OUT) :: PTIME_LES ! time spent in LES computations
-REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height of flux point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! dry density of the
- ! reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXN ! Exner function at t-dt
-
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTH,PSFRV ! normal surface fluxes of theta and Rv
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at t-dt
-REAL, DIMENSION(:,:,:,:),INTENT(IN):: PRM ! water var. at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM ! wind components at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! tke at t-dt
-
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar variable a t-dt
-
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS,PRVS,PRTHS ! Meso-NH sources
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Scalar sources
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGMF,PRC_MF,PRI_MF,PCF_MF ! cloud info for the cloud scheme
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFLXZTHVMF ! Thermal production for TKE scheme
-!
-REAL, INTENT(IN) :: PDX,PDY ! Size of mesh in X/Y directions
-!
-! 0.2 Declaration of local variables
-!
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDUDT_TURB ! tendency of U by turbulence only
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDVDT_TURB ! tendency of V by turbulence only
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDTHLDT_TURB ! tendency of thl by turbulence only
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDRTDT_TURB ! tendency of rt by turbulence only
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3),SIZE(PSVM,4)) :: ZDSVDT_TURB ! tendency of Sv by turbulence only
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDUDT_MF ! tendency of U by massflux scheme
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDVDT_MF ! tendency of V by massflux scheme
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDTHLDT_MF ! tendency of thl by massflux scheme
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDRTDT_MF ! tendency of Rt by massflux scheme
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3),SIZE(PSVM,4)) :: ZDSVDT_MF ! tendency of Sv by massflux scheme
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZSIGMF,ZRC_MF,ZRI_MF,ZCF_MF ! cloud info for the cloud scheme
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZFLXZTHVMF ! Thermal production for TKE scheme
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZFLXZTHMF
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZFLXZRMF
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZFLXZUMF
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZFLXZVMF
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZTHL_UP ! updraft characteristics
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZRT_UP ! updraft characteristics
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZRV_UP ! updraft characteristics
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZU_UP ! updraft characteristics
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZV_UP ! updraft characteristics
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZRC_UP ! updraft characteristics
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZRI_UP ! updraft characteristics
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZTHV_UP ! updraft characteristics
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZW_UP ! updraft characteristics
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZFRAC_UP ! updraft characteristics
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZEMF ! updraft characteristics
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDETR ! updraft characteristics
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZENTR ! updraft characteristics
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZUMM ! wind on mass point
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZVMM ! wind on mass point
-!
-INTEGER,DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2)) :: IKLCL,IKETL,IKCTL ! level of LCL,ETL and CTL
-INTEGER :: IIU, IJU, IKU, IKB, IKE, IRR, ISV
-INTEGER :: JK,JRR,JSV ! Loop counters
-
-LOGICAL :: LSTATNW ! switch for HARMONIE-AROME turb physics option
- ! TODO: linked with modd_turbn + init at default_desfmn
-
-TYPE(TFIELDMETADATA) :: TZFIELD
-TYPE(DIMPHYEX_t) :: YLDIMPHYEXPACK
-!------------------------------------------------------------------------
-!
-!!! 1. Initialisation
-CALL FILL_DIMPHYEX(YLDIMPHYEXPACK, SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3))
-!
-! Internal Domain
-IIU=SIZE(PTHM,1)
-IJU=SIZE(PTHM,2)
-IKU=SIZE(PTHM,3)
-IKB=1+JPVEXT
-IKE=IKU-JPVEXT
-!
-! number of moist var
-IRR=SIZE(PRM,4)
-! number of scalar var
-ISV=SIZE(PSVM,4)
-!
-! wind on mass points
-ZUMM=MXF(PUM)
-ZVMM=MYF(PVM)
-!
-!!! 2. Call of the physical parameterization of massflux vertical transport
-!
-LSTATNW = .FALSE.
-!
-CALL SHALLOW_MF(YLDIMPHYEXPACK, CST, NEBN, PARAM_MFSHALLN, TURBN, CSTURB,&
- KRR,KRRL,KRRI,ISV, &
- LNOMIXLG,NSV_LGBEG,NSV_LGEND, &
- PTSTEP, &
- PDZZ, PZZ, &
- PRHODJ,PRHODREF, &
- PPABSM, PEXN, &
- PSFTH,PSFRV, &
- PTHM,PRM,ZUMM,ZVMM,PTKEM,PSVM, &
- ZDUDT_MF,ZDVDT_MF, &
- ZDTHLDT_MF,ZDRTDT_MF,ZDSVDT_MF, &
- ZSIGMF,ZRC_MF,ZRI_MF,ZCF_MF,ZFLXZTHVMF, &
- ZFLXZTHMF,ZFLXZRMF,ZFLXZUMF,ZFLXZVMF, &
- ZTHL_UP,ZRT_UP,ZRV_UP,ZRC_UP,ZRI_UP, &
- ZU_UP, ZV_UP, ZTHV_UP, ZW_UP, &
- ZFRAC_UP,ZEMF,ZDETR,ZENTR, &
- IKLCL,IKETL,IKCTL,PDX,PDY,PRSVS,XSVMIN, &
- TBUCONF, TBUDGETS,SIZE(TBUDGETS) )
-!
-! Fill non-declared-explicit-dimensions output variables
-PSIGMF(:,:,:) = ZSIGMF(:,:,:)
-PRC_MF(:,:,:) = ZRC_MF(:,:,:)
-PRI_MF(:,:,:) = ZRI_MF(:,:,:)
-PCF_MF(:,:,:) = ZCF_MF(:,:,:)
-PFLXZTHVMF(:,:,:) = ZFLXZTHVMF(:,:,:)
-!
-!!! 3. Compute source terms for Meso-NH pronostic variables
-!!! ----------------------------------------------------
-!
-! As the pronostic variable of Meso-Nh are not (yet) the conservative variables
-! the thl tendency is put in th and the rt tendency in rv
-! the adjustment will do later the repartition between vapor and cloud
-PRTHS(:,:,:) = PRTHS(:,:,:) + &
- PRHODJ(:,:,:)*ZDTHLDT_MF(:,:,:)
-PRRS(:,:,:,1) = PRRS(:,:,:,1) + &
- PRHODJ(:,:,:)*ZDRTDT_MF(:,:,:)
-PRUS(:,:,:) = PRUS(:,:,:) +MXM( &
- PRHODJ(:,:,:)*ZDUDT_MF(:,:,:))
-PRVS(:,:,:) = PRVS(:,:,:) +MYM( &
- PRHODJ(:,:,:)*ZDVDT_MF(:,:,:))
-!
-DO JSV=1,ISV
- IF (LNOMIXLG .AND. JSV >= NSV_LGBEG .AND. JSV<= NSV_LGEND) CYCLE
- PRSVS(:,:,:,JSV) = MAX((PRSVS(:,:,:,JSV) + &
- PRHODJ(:,:,:)*ZDSVDT_MF(:,:,:,JSV)),XSVMIN(JSV))
-END DO
-!
-!!! 4. Prints the fluxes in output file
-!
-IF ( LMF_FLX .AND. tpfile%lopened ) THEN
- ! stores the conservative potential temperature vertical flux
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'MF_THW_FLX', &
- CSTDNAME = '', &
- CLONGNAME = 'MF_THW_FLX', &
- CUNITS = 'K m s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_MF_THW_FLX', &
- NGRID = 4, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZTHMF)
- !
- ! stores the conservative mixing ratio vertical flux
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'MF_RCONSW_FLX', &
- CSTDNAME = '', &
- CLONGNAME = 'MF_RCONSW_FLX', &
- CUNITS = 'K m s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_MF_RCONSW_FLX', &
- NGRID = 4, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZRMF)
- !
- ! stores the theta_v vertical flux
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'MF_THVW_FLX', &
- CSTDNAME = '', &
- CLONGNAME = 'MF_THVW_FLX', &
- CUNITS = 'K m s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_MF_THVW_FLX', &
- NGRID = 4, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,PFLXZTHVMF)
- !
- IF (PARAM_MFSHALLN%LMIXUV) THEN
- ! stores the U momentum vertical flux
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'MF_UW_FLX', &
- CSTDNAME = '', &
- CLONGNAME = 'MF_UW_FLX', &
- CUNITS = 'm2 s-2', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_MF_UW_FLX', &
- NGRID = 4, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZUMF)
- !
- ! stores the V momentum vertical flux
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'MF_VW_FLX', &
- CSTDNAME = '', &
- CLONGNAME = 'MF_VW_FLX', &
- CUNITS = 'm2 s-2', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_MF_VW_FLX', &
- NGRID = 4, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZVMF)
- !
- END IF
-END IF
-!
-!!! 5. Externalised LES Diagnostic for Mass Flux Scheme
-!!! ------------------------------------------------
-!
- CALL DIAGNOS_LES_MF(IIU,IJU,IKU,PTIME_LES, &
- ZTHL_UP,ZRT_UP,ZRV_UP,ZRC_UP,ZRI_UP, &
- ZU_UP,ZV_UP,ZTHV_UP,ZW_UP, &
- ZFRAC_UP,ZEMF,ZDETR,ZENTR, &
- ZFLXZTHMF,ZFLXZTHVMF,ZFLXZRMF, &
- ZFLXZUMF,ZFLXZVMF, &
- IKLCL,IKETL,IKCTL )
-!
-END SUBROUTINE SHALLOW_MF_PACK
diff --git a/src/mesonh/ext/spawn_model2.f90 b/src/mesonh/ext/spawn_model2.f90
deleted file mode 100644
index 3511cd27f32930b19e51dac080c7feeb5469d991..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/spawn_model2.f90
+++ /dev/null
@@ -1,1696 +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_SPAWN_MODEL2
-!########################
-!
-INTERFACE
-!
- SUBROUTINE SPAWN_MODEL2 (KRR,KSV_USER,HTURB,HSURF,HCLOUD, &
- HCHEM_INPUT_FILE,HSPAFILE,HSPANBR, &
- HSONFILE,HINIFILE,HINIFILEPGD,OSPAWN_SURF )
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-INTEGER, INTENT(IN) :: KSV_USER ! Number of Users Scalar Variables
-CHARACTER (LEN=4), INTENT(IN) :: HTURB ! Kind of turbulence parameterization
-CHARACTER (LEN=4), INTENT(IN) :: HSURF ! Kind of surface parameterization
-CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of cloud parameterization
- ! model 2 physical domain
-CHARACTER (LEN=*), INTENT(IN) :: HSPAFILE ! possible name of the output FM-file
-CHARACTER (LEN=*), INTENT(IN) :: HSPANBR ! NumBeR associated to the SPAwned file
-CHARACTER (LEN=*), INTENT(IN) :: HSONFILE ! name of the input FM-file SON
-CHARACTER (LEN=80), INTENT(IN) :: HCHEM_INPUT_FILE
-CHARACTER (LEN=*), INTENT(IN) :: HINIFILE ! Input file
-CHARACTER (LEN=*), INTENT(IN) :: HINIFILEPGD ! Input pgd file
-LOGICAL, INTENT(IN) :: OSPAWN_SURF ! flag to spawn surface fields
-!
-END SUBROUTINE SPAWN_MODEL2
-!
-END INTERFACE
-!
-END MODULE MODI_SPAWN_MODEL2
-! ######spl
- SUBROUTINE SPAWN_MODEL2 (KRR,KSV_USER,HTURB,HSURF,HCLOUD, &
- HCHEM_INPUT_FILE,HSPAFILE,HSPANBR, &
- HSONFILE,HINIFILE,HINIFILEPGD,OSPAWN_SURF )
-! #######################################################################
-!
-!!**** *SPAWN_MODEL2 * - subroutine to prepare by horizontal interpolation and
-!! write an initial FM-file spawned from an other FM-file.
-!!
-!! PURPOSE
-!! -------
-!!
-!! Initializes by horizontal interpolation, the model 2 in a sub-domain of
-!! model 1, possibly overwrites model 2 information by model SON1,
-!! and writes the resulting fields in a FM-file.
-!!
-!!
-!!** METHOD
-!! ------
-!!
-!! In this routine, only the model 2 variables are known through the
-!! MODD_... calls.
-!!
-!! The directives to perform the preparation of the initial FM
-!! file are stored in EXSPA.nam file.
-!!
-!! The following SPAWN_MODEL2 routine :
-!!
-!! - sets default values of DESFM files
-!! - reads the namelists part of EXSPA file which gives the
-!! directives concerning the spawning to perform
-!! - controls the domain size of model 2 and initializes its
-!! configuration for parameterizations and LBC
-!! - allocates memory for arrays
-!! - computes the interpolation coefficients needed to spawn model 2
-!! 2 types of interpolations are used:
-!! 1. Clark and Farley (JAS 1984) on 9 points
-!! 2. Bikhardt on 16 points
-!! - initializes fields
-!! - reads SON1 fields and overwrites on common domain
-!! - writes the DESFM file (variables written have been initialized
-!! by reading the DESFM file concerning the model 1)
-!! - writes the LFIFM file.
-!!
-!! Finally some control prints are performed on the output listing.
-!!
-!! EXTERNAL
-!! --------
-!!
-!! Module MODE_GRIDPROJ : contains conformal projection routines
-!! SM_GRIDPROJ : to compute some grid variables, in
-!! case of conformal projection.
-!! Module MODE_GRIDCART : contains cartesian geometry routines
-!! SM_GRIDCART : to compute some grid variables, in
-!! case of cartesian geometry.
-!! SET_REF : to compute rhoJ
-!! TOTAL_DMASS : to compute the total mass of dry air
-!! ANEL_BALANCE2 : to apply an anelastic correction in the case of changing
-!! resolution between the two models
-!! IO_File_open : to open a FM-file (DESFM + LFIFM)
-!! WRITE_DESFM : to write the DESFM file
-!! WRITE_LFIFM : to write the LFIFM file
-!! IO_File_close : to close a FM-file (DESFM + LFIFM)
-!! INI_BIKHARDT2 : initializes Bikhardt coefficients
-!!
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! Module MODD_PARAMETERS : contains parameters
-!! Module MODD_CONF : contains configuration variables for all models
-!! Module MODD_CTURB :
-!! XTKEMIN : mimimum value for the TKE
-!! Module MODD_GRID : contains grid variables for all models
-!! Module USE MODD_DYN : contains configuration for the dynamics
-!! Module MODD_REF : contains reference state variables for
-!! all models
-!!
-!! Module MODD_DIM2 : contains dimensions
-!! Module MODD_CONF2 : contains configuration variables
-!! Module MODD_GRID2 : contains grid variables
-!! Module MODD_TIME2 : contains time variables and uses MODD_TIME
-!! Module MODD_REF2 : contains reference state variables
-!! Module MODD_FIELD2 : contains prognostic variables
-!! Module MODD_LSFIELD2 : contains Larger Scale fields
-!! Module MODD_GR_FIELD2 : contains surface fields
-!! Module MODD_DYN2 : contains dynamic control variables for model 2
-!! Module MODD_LBC2 : contains lbc control variables for model 2
-!! Module MODD_PARAM2 : contains configuration for physical parameterizations
-!!
-!! REFERENCE
-!! ---------
-!!
-!! PROGRAM SPAWN_MODEL2 (Book2 of the documentation)
-!!
-!!
-!! AUTHOR
-!! ------
-!!
-!! J.P. Lafore * METEO-FRANCE *
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-!! Original 11/01/95
-!! Modification 27/04/95 (I.Mallet) remove R from the historical variables
-!! Modification 16/04/96 (Lafore) Different resolution ratio case introduction
-!! Modification 24/04/96 (Lafore & Masson) Initialization of LUSERWs
-!! Modification 24/04/96 (Masson) Correction of positivity on Rw and TKE
-!! Modification 25/04/96 (Masson) Copies of internal zs on external points
-!! Modification 02/05/96 (Stein Jabouille) initialize CCONF
-!! Modification 31/05/96 (Lafore) Cumputing time analysis
-!! Modification 10/06/96 (Masson) Call to anel_balance in all cases
-!! Modification 10/06/96 (Masson) Bikhardt and Clark_and_Farley coefficients
-!! incorporated in modules
-!! Modification 12/06/96 (Masson) default values of NJMAX and KDYRATIO
-!! if 2D version of the model
-!! Modification 13/06/96 (Masson) choice of the name of the spawned file
-!! Modification 30/07/96 (Lafore) MY_NAME and DAD_NAME writing for nesting
-!! Modification 25/09/96 (Masson) grid optionnaly given by a fm file
-!! and number of points given relatively
-!! to model 1
-!! Modification 10/10/96 (Masson) L1D and L2D verifications
-!! Modification 12/11/96 (Masson) allocations of XSRCM and XSRCT
-!! Modification 19/11/96 (Masson) add deep convection
-!! Modification 26/11/96 (Lafore) spawning configuration writing on the FM-file
-!! Modification 26/11/96 (Lafore) replacing of TOTAL_DMASS by REAL_DMASS
-!! Modification 27/02/97 (Lafore) "surfacic" LS fields
-!! Modification 10/04/97 (Lafore) proper treatment of minima
-!! Modification 09/07/97 (Masson) absolute pressure and directional z0
-!! Modification 10/07/97 (Masson) routines SPAWN_PRESSURE2 and DRY_MASS
-!! Modification 17/07/97 (Masson) vertical interpolations and EPS
-!! Modification 29/07/97 (Masson) split mode_lfifm_pgd
-!! Modification 10/08/97 (Lafore) initialization of LUSERV
-!! Modification 14/09/97 (Masson) use of relative humidity
-!! Modification 08/12/97 (Masson) deallocation of model 1 variables
-!! Modification 24/12/97 (Masson) directional z0 parameters and orographies
-!! Modification 20/07/98 (Stein ) add the LB fields
-!! Modification 15/03/99 (Masson) cover types
-!! Modification 15/07/99 (Jabouille) shift domain initialization in INI_SIZE_SPAWN
-!! Modification 04/01/00 (Masson) removes TSZ0 option
-!! Modification 29/11/02 (Pinty) add C3R5, ICE2, ICE4
-!! Modification 07/07/05 (D.Barbary) spawn with 2 input files (father+son1)
-!! Modification 20/05/06 Remove EPS, Clark and Farley interpolation
-!! Replace DRY_MASS by TOTAL_DMASS
-!! Modification 06/12 (M.Tomasini) Interpolation of the advective forcing (ADVFRC)
-!! and of the turbulent fluxes (EDDY_FLUX)
-!! Modification 07/13 (Bosseur & Filippi) Adds Forefire
-!! 24/04/2014 (J.escobar) bypass CRAY internal compiler error on IIJ computation
-!! Modification 06/2014 (C.Lac) Initialization of physical param of
-!! model2 before the call to ini_nsv
-!! Modification 05/02/2015 (M.Moge) parallelization of SPAWNING
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! J.Escobar 02/05/2016 : test ZZS_MAX in //
-!! P.Wautelet 08/07/2016 : removed MNH_NCWRIT define
-!! J.Escobar 12/07/2016 : add test on NRIMY & change the one on NRIMX with >=
-!! Modification 01/2016 (JP Pinty) Add LIMA
-!! 10/2016 (C.Lac) Add droplet deposition
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
-! S. Bielli 02/2019: sea salt: significant sea wave height influences salt emission; 5 salt modes
-! P. Wautelet 22/02/2019: replace Hollerith edit descriptor (deleted from Fortran 95 standard)
-! P. Wautelet 14/03/2019: correct ZWS when variable not present in file
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
-! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
-! P. Wautelet 24/03/2021: bugfix: allocate XLSRVM, XINPAP and XACPAP to zero size when not needed
-!! 03/2021 (JL Redelsperger) Ocean model case
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS ! Declarative modules
-USE MODD_CST
-USE MODD_CONF
-USE MODD_CTURB
-USE MODD_GRID
-USE MODD_REF
-USE MODD_DYN
-USE MODD_NESTING
-USE MODD_SPAWN
-USE MODD_NSV
-USE MODD_PASPOL
-!
-USE MODD_DIM_n
-USE MODD_DYN_n
-USE MODD_CONF_n
-USE MODD_LBC_n
-USE MODD_GRID_n
-USE MODD_TIME_n
-USE MODD_REF_n
-USE MODD_FIELD_n
-USE MODD_LSFIELD_n
-USE MODD_DUMMY_GR_FIELD_n
-USE MODD_PRECIP_n
-USE MODD_ELEC_n
-USE MODD_LUNIT_n
-USE MODD_PARAM_n
-USE MODD_TURB_n
-USE MODD_METRICS_n
-USE MODD_CH_MNHC_n
-USE MODD_PASPOL_n
-!$20140515
-USE MODD_VAR_ll, ONLY : NPROC
-USE MODD_IO, ONLY: TFILEDATA,TFILE_DUMMY,TFILE_SURFEX
-use modd_precision, only: MNHREAL_MPI
-!
-USE MODE_GRIDCART ! Executive modules
-USE MODE_GRIDPROJ
-USE MODE_ll
-USE MODE_MSG
-!
-USE MODI_READ_HGRID
-USE MODI_SPAWN_GRID2
-USE MODI_SPAWN_FIELD2
-USE MODI_SPAWN_SURF
-USE MODI_VER_INTERP_FIELD
-USE MODI_SPAWN_PRESSURE2
-USE MODI_SPAWN_SURF2_RAIN
-USE MODI_SET_REF
-USE MODI_TOTAL_DMASS
-USE MODI_ANEL_BALANCE_n
-USE MODI_WRITE_DESFM_n
-USE MODI_WRITE_LFIFM_n
-USE MODI_METRICS
-USE MODI_INI_BIKHARDT_n
-USE MODI_DEALLOCATE_MODEL1
-USE MODI_BOUNDARIES
-USE MODI_INI_NSV
-!$20140710
-USE MODI_UPDATE_METRICS
-!
-USE MODE_IO_FIELD_READ, only: IO_Field_read
-USE MODE_IO_FIELD_WRITE, only: 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_MODELN_HANDLER
-USE MODE_MPPDB
-!
-USE MODE_THERMO
-!
-USE MODI_SECOND_MNH
-!
-! Modules for EDDY_FLUX
-USE MODD_LATZ_EDFLX
-USE MODD_DEF_EDDY_FLUX_n
-USE MODD_DEF_EDDYUV_FLUX_n
-USE MODD_ADVFRC_n
-USE MODD_RELFRC_n
-USE MODD_2D_FRC
-!
-!USE MODE_LB_ll, ONLY : SET_LB_FIELD_ll
-USE MODI_GET_SIZEX_LB
-USE MODI_GET_SIZEY_LB
-!
-USE MODD_LIMA_PRECIP_SCAVENGING_n
-USE MODD_PARAM_LIMA, ONLY : MDEPOC=>LDEPOC, LSCAV
-USE MODD_PARAM_ICE_n, ONLY : LDEPOSC
-USE MODD_PARAM_C2R2, ONLY : LDEPOC
-USE MODD_PASPOL, ONLY : LPASPOL
-!
-USE MODD_MPIF
-USE MODD_VAR_ll
-use modd_precision, only: LFIINT
-!
-IMPLICIT NONE
-!
-!* 0.1.1 Declarations of global variables not declared in the modules :
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZJ ! Jacobian
-!
-!
-!* 0.1.2 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-INTEGER, INTENT(IN) :: KSV_USER ! Number of Users Scalar Variables
-CHARACTER (LEN=4), INTENT(IN) :: HTURB ! Kind of turbulence parameterization
-CHARACTER (LEN=4), INTENT(IN) :: HSURF ! Kind of surface parameterization
-CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of cloud parameterization
-CHARACTER (LEN=*), INTENT(IN) :: HSPAFILE ! possible name of the output FM-file
-CHARACTER (LEN=*), INTENT(IN) :: HSPANBR ! NumBeR associated to the SPAwned file
-CHARACTER (LEN=*), INTENT(IN) :: HSONFILE ! name of the input FM-file SON
-CHARACTER (LEN=80), INTENT(IN) :: HCHEM_INPUT_FILE
-CHARACTER (LEN=*), INTENT(IN) :: HINIFILE ! Input file
-CHARACTER (LEN=*), INTENT(IN) :: HINIFILEPGD ! Input pgd file
-LOGICAL, INTENT(IN) :: OSPAWN_SURF ! flag to spawn surface fields
-!
-!* 0.1.3 Declarations of local variables :
-!
-!
-INTEGER :: ILUOUT ! Logical unit number for the output listing
-INTEGER(KIND=LFIINT) :: INPRAR ! Number of articles predicted in the LFIFM file
-!
-!
-INTEGER :: IIU ! Upper dimension in x direction
-INTEGER :: IJU ! Upper dimension in y direction
-INTEGER :: IKU ! Upper dimension in z direction
-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 :: JK ! Loop index in z direction
-INTEGER :: JLOOP,JKLOOP ! Loop indexes
-INTEGER :: JSV ! loop index for scalar variables
-INTEGER :: JRR ! loop index for moist variables
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZZS_LS ! large scale interpolated zs
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZZSMT_LS ! large scale interpolated smooth zs
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZZZ_LS ! large scale interpolated z
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHVT ! virtual potential temperature
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZHUT ! relative humidity
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSUMRT ! sum of water ratios
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHOD ! dry density
-!
-REAL :: ZTIME1,ZTIME2,ZSTART,ZEND,ZTOT,ZALL,ZPERCALL ! for computing time analysis
-REAL :: ZGRID2, ZSURF2, ZFIELD2, ZVER, &
- ZPRESSURE2, ZANEL, ZWRITE, ZMISC
-REAL :: ZPERCGRID2,ZPERCSURF2,ZPERCFIELD2, ZPERCVER, &
- ZPERCPRESSURE2, ZPERCANEL, ZPERCWRITE,ZPERCMISC
-!
-INTEGER, DIMENSION(2) :: IIJ
-INTEGER :: IK4000
-INTEGER :: IMI ! Old Model index
-!
-! Spawning variables for the SON 1 (input one)
-INTEGER :: IIMAXSON,IJMAXSON ! physical dimensions
-INTEGER :: IIUSON,IJUSON ! upper dimensions
-INTEGER :: IXSIZESON,IYSIZESON ! sizes according to model1 grid
-INTEGER :: IDXRATIOSON,IDYRATIOSON ! x and y-resolution ratios
-INTEGER :: IXORSON,IYORSON ! horizontal position
-INTEGER :: IXENDSON,IYENDSON !in x and y directions
-! Common indexes for the SON 2 (output one, model2)
-INTEGER :: IIB2 ! indice I Beginning in x direction
-INTEGER :: IJB2 ! indice J Beginning in y direction
-INTEGER :: IIE2 ! indice I End in x direction
-INTEGER :: IJE2 ! indice J End in y direction
-! Common indexes for the SON 1 (input one)
-INTEGER :: IIB1 ! indice I Beginning in x direction
-INTEGER :: IJB1 ! indice J Beginning in y direction
-INTEGER :: IIE1 ! indice I End in x direction
-INTEGER :: IJE1 ! indice J End in y direction
-! Logical for no common domain between the 2 sons or no input son
-LOGICAL :: GNOSON = .TRUE.
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK3D ! working array
-CHARACTER(LEN=28) :: YDAD_SON
-!$
-INTEGER :: IINFO_ll
-TYPE(LIST_ll), POINTER :: TZFIELDS_ll=>NULL() ! list of fields to exchange
-INTEGER :: NXOR_TMP, NYOR_TMP, NXEND_TMP, NYEND_TMP
-INTEGER :: IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU ! dimensions of the
-INTEGER :: IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2 ! West-east LB arrays
-INTEGER :: IISIZEYF,IJSIZEYF,IISIZEYFV,IJSIZEYFV ! dimensions of the
-INTEGER :: IISIZEY4,IJSIZEY4,IISIZEY2,IJSIZEY2 ! North-south LB arrays
-!
-CHARACTER(LEN=4) :: YLBTYPE
-!
-INTEGER,DIMENSION(:,:),ALLOCATABLE :: IJCOUNT
-!
-REAL :: ZZS_MAX, ZZS_MAX_ll
-!
-TYPE(TFILEDATA),POINTER :: TZFILE => NULL()
-TYPE(TFILEDATA),POINTER :: TZSONFILE => NULL()
-!-------------------------------------------------------------------------------
-!
-! Save model index and switch to model 2 variables
-IMI = GET_CURRENT_MODEL_INDEX()
-CALL GOTO_MODEL(2)
-CSTORAGE_TYPE='TT'
-!
-ILUOUT=TLUOUT%NLU
-!
-!* 1. INITIALIZATIONS :
-! ---------------
-!
-!* 1.1 time analysis :
-! -------------
-!
-ZTIME1 = 0
-ZTIME2 = 0
-ZSTART = 0
-ZEND = 0
-ZGRID2 = 0
-ZSURF2 = 0
-ZFIELD2= 0
-ZANEL = 0
-ZWRITE = 0
-ZPERCGRID2 = 0
-ZPERCSURF2 = 0
-ZPERCFIELD2= 0
-ZPERCANEL = 0
-ZPERCWRITE = 0
-!
-CALL SECOND_MNH(ZSTART)
-!
-ZTIME1 = ZSTART
-!
-!* 1.2 deallocates not used model 1 variables :
-! --------------------------------------
-!
-CALL DEALLOCATE_MODEL1(1)
-CALL DEALLOCATE_MODEL1(2)
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 3. PROLOGUE:
-! --------
-!
-!* 3.1 Compute dimensions of model 2 and other indices
-!
-NIMAX_ll = NXSIZE * NDXRATIO
-NJMAX_ll = NYSIZE * NDYRATIO
-!
-IF (NIMAX_ll==1 .AND. NJMAX_ll==1) THEN
- L1D=.TRUE.
- L2D=.FALSE.
-ELSE IF (NJMAX_ll==1) THEN
- L1D=.FALSE.
- L2D=.TRUE.
-ELSE
- L1D=.FALSE.
- L2D=.FALSE.
-END IF
-!
-CALL GET_DIM_EXT_ll('B',IIU,IJU)
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-!
-NIMAX = IIE-IIB+1
-NJMAX = IJE-IJB+1
-!$
-IKU = SIZE(XTHVREFZ,1)
-NKMAX = IKU - 2*JPVEXT ! initialization of NKMAX (MODD_DIM2)
-!
-IKB = 1 + JPVEXT
-IKE = IKU - JPVEXT
-!
-!
-!* 3.2 Position of model 2 domain relative to model 1 and controls
-!
-!$20140506 the condition on NXSIZE*NXRATIO ==IIE-IIB+1 only works for monoproc
-!$then cancel it
-!IF ( (NXSIZE*NDXRATIO) /= (IIE-IIB+1) ) THEN
-! WRITE(ILUOUT,*) 'SPAWN_MODEL2: MODEL 2 DOMAIN X-SIZE INCOHERENT WITH THE', &
-! ' MODEL1 MESH ',' IIB = ',IIB,' IIE = ', IIE ,'NDXRATIO = ',NDXRATIO
-! !callabortstop
-! CALL PRINT_MSG(NVERB_FATAL,'GEN','SPAWN_MODEL2','')
-!END IF
-!$
-!$20140506 the condition on NXSIZE*NXRATIO ==IIE-IIB+1 only works for monoproc
-!$then cancel it
-!IF ( (NYSIZE*NDYRATIO) /= (IJE-IJB+1) ) THEN
-! WRITE(ILUOUT,*) 'SPAWN_MODEL2: MODEL 2 DOMAIN Y-SIZE INCOHERENT WITH THE', &
-! ' MODEL1 MESH ',' IJB = ',IJB,' IJE = ', IJE ,'NDYRATIO = ',NDYRATIO
-! !callabortstop
-! CALL PRINT_MSG(NVERB_FATAL,'GEN','SPAWN_MODEL2','')
-!END IF
-!$
-!
-!* 3.3 Treatement of a SON 1 model (input)
-!
-IF (LEN_TRIM(HSONFILE) /= 0 ) THEN
-!
-! 3.3.1 Opening the son input file and reading the grid
-!
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: spawning with a SON input file :',TRIM(HSONFILE)
- CALL IO_File_add2list(TZSONFILE,TRIM(HSONFILE),'MNH','READ',KLFITYPE=2,KLFIVERB=NVERB)
- CALL IO_File_open(TZSONFILE)
- CALL IO_Field_read(TZSONFILE,'DAD_NAME',YDAD_SON)
- CALL IO_Field_read(TZSONFILE,'IMAX', IIMAXSON)
- CALL IO_Field_read(TZSONFILE,'JMAX', IJMAXSON)
- CALL IO_Field_read(TZSONFILE,'XOR', IXORSON)
- CALL IO_Field_read(TZSONFILE,'YOR', IYORSON)
- CALL IO_Field_read(TZSONFILE,'DXRATIO', IDXRATIOSON)
- CALL IO_Field_read(TZSONFILE,'DYRATIO', IDYRATIOSON)
- !
- IF (ADJUSTL(ADJUSTR(YDAD_SON)).NE.ADJUSTL(ADJUSTR(CMY_NAME(1)))) THEN
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: DAD of SON file is different from the one of model2'
- WRITE(ILUOUT,*) ' DAD of SON = ',TRIM(YDAD_SON),' DAD of model2 = ',TRIM(CMY_NAME(1))
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','SPAWN_MODEL2','DAD of SON file is different from the one of model2')
- END IF
- IF ( IDXRATIOSON /= NDXRATIO ) THEN
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: RATIOX of input SON file is different from the one of model2' ,&
- ' RATIOX SON = ',IDXRATIOSON,' RATIOX model2 = ',NDXRATIO
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','SPAWN_MODEL2','RATIOX of input SON file is different from the one of model2')
- END IF
- IF ( IDYRATIOSON /= NDYRATIO ) THEN
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: RATIOY of input SON file is different from the one of model2' ,&
- ' RATIOY SON = ',IDYRATIOSON,' RATIOY model2 = ',NDYRATIO
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','SPAWN_MODEL2','RATIOY of input SON file is different from the one of model2')
- END IF
- !
- IIUSON=IIMAXSON+2*JPHEXT
- IJUSON=IJMAXSON+2*JPHEXT
-!
-! 3.3.2 Correspondance of indexes between the input SON and model2
-!
- IXSIZESON = IIMAXSON/IDXRATIOSON
- IYSIZESON = IJMAXSON/IDYRATIOSON
- IXENDSON = IXORSON+IXSIZESON
- IYENDSON = IYORSON+IYSIZESON
-! Is a common domain between the input SON and the output son (model2)?
- IF( ( MIN(NXEND-1,IXENDSON)-MAX(NXOR,IXORSON) > 0 ) .OR. &
- ( MIN(NYEND-1,IYENDSON)-MAX(NYOR,IYORSON) > 0 ) ) THEN
- GNOSON=.FALSE.
- ! Common domain for the model2 (output son) indexes
- IIB2 = (MAX(NXOR,IXORSON)-NXOR)*NDXRATIO+1+JPHEXT
- IJB2 = (MAX(NYOR,IYORSON)-NYOR)*NDYRATIO+1+JPHEXT
- IIE2 = (MIN(NXEND-1,IXENDSON)-NXOR)*NDXRATIO+JPHEXT
- IJE2 = (MIN(NYEND-1,IYENDSON)-NYOR)*NDYRATIO+JPHEXT
- ! Common domain for the SON 1 (input one) indexes
- IIB1 = (MAX(NXOR,IXORSON)-IXORSON)*NDXRATIO+1+JPHEXT
- IJB1 = (MAX(NYOR,IYORSON)-IYORSON)*NDYRATIO+1+JPHEXT
- IIE1 = (MIN(NXEND-1,IXENDSON)-IXORSON)*NDXRATIO+JPHEXT
- IJE1 = (MIN(NYEND-1,IYENDSON)-IYORSON)*NDYRATIO+JPHEXT
- !
- WRITE(ILUOUT,*) ' common domain in the SON grid (IB,IE=', &
- 1+JPHEXT,'-',IIMAXSON+JPHEXT,' ; JB,JE=', &
- 1+JPHEXT,'-',IJMAXSON+JPHEXT,'):'
- WRITE(ILUOUT,*) 'I=',IIB1,'->',IIE1,' ; J=',IJB1,'->',IJE1
- WRITE(ILUOUT,*) ' common domain in the model2 grid (IB,IE=', &
- 1+JPHEXT,'-',NXSIZE*NDXRATIO+JPHEXT,' ; JB,JE=', &
- 1+JPHEXT,'-',NYSIZE*NDYRATIO+JPHEXT,'):'
- WRITE(ILUOUT,*) 'I=',IIB2,'->',IIE2,' ; J=',IJB2,'->',IJE2
- ELSE
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: no common domain between input SON and model2:'
- WRITE(ILUOUT,*) ' the input SON fields are not taken into account, spawned fields are computed from model1'
- END IF
-END IF
-!
-!* 3.4 Initialization of model 2 configuration
-!
-NRR = KRR ! for MODD_CONF2
-NSV_USER = KSV_USER
-IF (NSV_CHEM>0) THEN
- LUSECHEM=.TRUE.
- IF (NSV_CHAC>0) THEN
- LUSECHAQ=.TRUE.
- ENDIF
- IF (NSV_CHIC>0) THEN
- LUSECHIC=.TRUE.
- ENDIF
- CCHEM_INPUT_FILE = HCHEM_INPUT_FILE
-END IF
-!
-CTURB = HTURB ! for MODD_PARAM2
-CRAD = 'NONE' ! radiation will have to be restarted
-CSURF = HSURF ! for surface call
-CCLOUD = HCLOUD
-CDCONV = 'NONE' ! deep convection will have to be restarted
-CSCONV = 'NONE' ! shallow convection will have to be restarted
-!
-! cas LIMA
-!
-!IF (HCLOUD=='LIMA') THEN
-! CCLOUD='LIMA'
-! NMOD_CCN=3
-! LSCAV=.FALSE.
-! LAERO_MASS=.FALSE.
-! NMOD_IFN=2
-! NMOD_IMM=1
-! LHHONI=.FALSE.
-!ENDIF
-!
-CALL INI_NSV(2) ! NSV* are set equal for model 2 and model 1.
- ! NSV is set to the total number of SV for model 2
-!
-IF (NRR==0) THEN
- LUSERV=.FALSE. ! as the default is .T.
-ELSE
- IDX_RVT = 1
-END IF
-IF (NRR>1) THEN
- LUSERC=.TRUE.
- IDX_RCT = 2
-END IF
-IF (NRR>2) THEN
- LUSERR=.TRUE.
- IDX_RRT = 2
-END IF
-IF (NRR>3) THEN
- LUSERI=.TRUE.
- IDX_RIT = 2
-END IF
-IF (NRR>4) THEN
- LUSERS=.TRUE.
- IDX_RST = 2
-END IF
-IF (NRR>5) THEN
- LUSERG=.TRUE.
- IDX_RGT = 2
-END IF
-IF (NRR>6) THEN
- LUSERH=.TRUE.
- IDX_RHT = 2
-END IF
-!
-!
-!
-!* 3.5 model 2 configuration in MODD_NESTING to be written
-!* on the FM-file to allow nesting or coupling
-!
-CCPLFILE(:) = ' '
-LSTEADYLS=.TRUE.
-!
-NDXRATIO_ALL(:) = 0
-NDYRATIO_ALL(:) = 0
-NDXRATIO_ALL(2) = NDXRATIO
-NDYRATIO_ALL(2) = NDYRATIO
-NXOR_ALL(2) = NXOR
-NYOR_ALL(2) = NYOR
-NXEND_ALL(2) = NXEND
-NYEND_ALL(2) = NYEND
-!
-!* 3.6 size of the RIM area for lbc
-!
-NRIMX=MIN(JPRIMMAX,IIU/2-1)
-IF ( .NOT. L2D ) THEN
- NRIMY=MIN(JPRIMMAX,IJU/2-1)
-ELSE
- NRIMY=0
-END IF
-IF (NRIMX >= IIU/2-1) THEN ! Error ! this case is not supported - it should be, but there is a bug
- call Print_msg( NVERB_FATAL, 'GEN', 'SPAWN_MODEL2', 'The size of the LBX zone is too big for the size of the subdomains. '// &
- 'Try with less processes, a smaller LBX size or a bigger grid in X.' )
-ENDIF
-IF ( ( .NOT. L2D ) .AND. (NRIMY >= IJU/2-1) ) THEN ! Error ! this case is not supported - it should be, but there is a bug
- call Print_msg( NVERB_FATAL, 'GEN', 'SPAWN_MODEL2', 'The size of the LBY zone is too big for the size of the subdomains. '// &
- 'Try with less processes, a smaller LBY size or a bigger grid in Y.' )
-ENDIF
-!
-LHORELAX_UVWTH=.TRUE.
-LHORELAX_RV=LUSERV
-LHORELAX_RC=LUSERC
-LHORELAX_RR=LUSERR
-LHORELAX_RI=LUSERI
-LHORELAX_RS=LUSERS
-LHORELAX_RG=LUSERG
-LHORELAX_RH=LUSERH
-!
-IF (CTURB/='NONE') LHORELAX_TKE =.TRUE.
-LHORELAX_SV(:)=.FALSE.
-DO JSV=1,NSV
- LHORELAX_SV(JSV)=.TRUE.
-END DO
-IF (NSV_CHEM > 0) LHORELAX_SVCHEM = .TRUE.
-IF (NSV_CHIC > 0) LHORELAX_SVCHIC = .TRUE.
-IF (NSV_C2R2 > 0) LHORELAX_SVC2R2 = .TRUE.
-IF (NSV_C1R3 > 0) LHORELAX_SVC1R3 = .TRUE.
-IF (NSV_ELEC > 0) LHORELAX_SVELEC = .TRUE.
-IF (NSV_AER > 0) LHORELAX_SVAER = .TRUE.
-IF (NSV_DST > 0) LHORELAX_SVDST = .TRUE.
-IF (NSV_SLT > 0) LHORELAX_SVSLT = .TRUE.
-IF (NSV_PP > 0) LHORELAX_SVPP = .TRUE.
-#ifdef MNH_FOREFIRE
-IF (NSV_FF > 0) LHORELAX_SVFF = .TRUE.
-#endif
-IF (NSV_CS > 0) LHORELAX_SVCS = .TRUE.
-LHORELAX_SVLG = .FALSE.
-IF (NSV_LIMA > 0) LHORELAX_SVLIMA = .TRUE.
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. ALLOCATE MEMORY FOR ARRAYS :
-! -----------------------------
-!
-!* 4.1 Global variables absent from the modules :
-!
-ALLOCATE(ZJ(IIU,IJU,IKU))
-!
-!* 4.2 Prognostic (and diagnostic) variables (module MODD_FIELD2) :
-!
-ALLOCATE(XZWS(IIU,IJU)); XZWS(:,:) = XZWS_DEFAULT
-ALLOCATE(XLSZWSM(IIU,IJU))
-ALLOCATE(XUT(IIU,IJU,IKU))
-ALLOCATE(XVT(IIU,IJU,IKU))
-ALLOCATE(XWT(IIU,IJU,IKU))
-ALLOCATE(XTHT(IIU,IJU,IKU))
-IF (CTURB/='NONE') THEN
- ALLOCATE(XTKET(IIU,IJU,IKU))
-ELSE
- ALLOCATE(XTKET(0,0,0))
-END IF
-ALLOCATE(XPABST(IIU,IJU,IKU))
-ALLOCATE(XRT(IIU,IJU,IKU,NRR))
-ALLOCATE(XSVT(IIU,IJU,IKU,NSV))
-!
-IF (CTURB /= 'NONE' .AND. NRR>1) THEN
- ALLOCATE(XSRCT(IIU,IJU,IKU))
- ALLOCATE(XSIGS(IIU,IJU,IKU))
-ELSE
- ALLOCATE(XSRCT(0,0,0))
- ALLOCATE(XSIGS(0,0,0))
-END IF
-!
-!
-!* 4.4 Grid variables (module MODD_GRID2 and MODD_METRICS2):
-!
-ALLOCATE(XXHAT(IIU),XYHAT(IJU),XZHAT(IKU))
-ALLOCATE(XXHATM(IIU),XYHATM(IJU),XZHATM(IKU))
-ALLOCATE(XZTOP)
-ALLOCATE(XMAP(IIU,IJU))
-ALLOCATE(XLAT(IIU,IJU))
-ALLOCATE(XLON(IIU,IJU))
-ALLOCATE(XDXHAT(IIU),XDYHAT(IJU))
-ALLOCATE(XZS(IIU,IJU))
-ALLOCATE(XZSMT(IIU,IJU))
-ALLOCATE(XZZ(IIU,IJU,IKU))
-!
-ALLOCATE(XDXX(IIU,IJU,IKU))
-ALLOCATE(XDYY(IIU,IJU,IKU))
-ALLOCATE(XDZX(IIU,IJU,IKU))
-ALLOCATE(XDZY(IIU,IJU,IKU))
-ALLOCATE(XDZZ(IIU,IJU,IKU))
-!
-ALLOCATE(ZZS_LS(IIU,IJU))
-ALLOCATE(ZZSMT_LS(IIU,IJU))
-ALLOCATE(ZZZ_LS(IIU,IJU,IKU))
-!
-!* 4.5 Reference state variables (module MODD_REF2):
-!
-ALLOCATE(XRHODREF(IIU,IJU,IKU),XTHVREF(IIU,IJU,IKU),XRVREF(IIU,IJU,IKU))
-ALLOCATE(XRHODJ(IIU,IJU,IKU),XEXNREF(IIU,IJU,IKU))
-!
-!* 4.6 Larger Scale fields (module MODD_LSFIELD2):
-!
- ! LS fields for vertical relaxation and diffusion
-ALLOCATE(XLSUM(IIU,IJU,IKU))
-ALLOCATE(XLSVM(IIU,IJU,IKU))
-ALLOCATE(XLSWM(IIU,IJU,IKU))
-ALLOCATE(XLSTHM(IIU,IJU,IKU))
-IF ( NRR >= 1) THEN
- ALLOCATE(XLSRVM(IIU,IJU,IKU))
-ELSE
- ALLOCATE(XLSRVM(0,0,0))
-ENDIF
- ! LB fields for lbc coupling
-!
-!get the size of the local portion of the LB zone in X and Y direction
-CALL GET_SIZEX_LB(NIMAX_ll,NJMAX_ll,NRIMX, &
- IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU, &
- IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2)
-CALL GET_SIZEY_LB(NIMAX_ll,NJMAX_ll,NRIMY, &
- IISIZEYF,IJSIZEYF,IISIZEYFV,IJSIZEYFV, &
- IISIZEY4,IJSIZEY4,IISIZEY2,IJSIZEY2)
-!on fait des choses inutiles avec GET_SIZEX_LB, on pourrait utiliser seulement GET_LOCAL_LB_SIZE_X_ll
-!ILOCLBSIZEX = GET_LOCAL_LB_SIZE_X_ll( NRIMX )
-!ILOCLBSIZEY = GET_LOCAL_LB_SIZE_Y_ll( NRIMY )
-!
- ALLOCATE(XLBXUM(IISIZEXFU,IJU,IKU))
-!! ALLOCATE(XLBXUM(2*NRIMX+2*JPHEXT,IJU,IKU))
-!
-IF ( .NOT. L2D ) THEN
- ALLOCATE(XLBYUM(IIU,IJSIZEYF,IKU))
-!! ALLOCATE(XLBYUM(IIU,2*NRIMY+2*JPHEXT,IKU))
-ELSE
- ALLOCATE(XLBYUM(0,0,0))
-END IF
-!
-ALLOCATE(XLBXVM(IISIZEXF,IJU,IKU))
-!! ALLOCATE(XLBXVM(2*NRIMX+2*JPHEXT,IJU,IKU))
-!
-IF ( .NOT. L2D ) THEN
- IF ( NRIMY == 0 ) THEN
- ALLOCATE(XLBYVM(IIU,IJSIZEY4,IKU))
- ELSE
- ALLOCATE(XLBYVM(IIU,IJSIZEYFV,IKU))
-!! ALLOCATE(XLBYVM(IIU,2*NRIMY+2*JPHEXT,IKU))
- END IF
-ELSE
- ALLOCATE(XLBYVM(0,0,0))
-END IF
-!
-ALLOCATE(XLBXWM(IISIZEXF,IJU,IKU))
-!! ALLOCATE(XLBXWM(2*NRIMX+2*JPHEXT,IJU,IKU))
-!
-IF ( .NOT. L2D ) THEN
- ALLOCATE(XLBYWM(IIU,IJSIZEYF,IKU))
-!! ALLOCATE(XLBYWM(IIU,2*NRIMY+2*JPHEXT,IKU))
-ELSE
- ALLOCATE(XLBYWM(0,0,0))
-END IF
-!
-ALLOCATE(XLBXTHM(IISIZEXF,IJU,IKU))
-!!ALLOCATE(XLBXTHM(2*NRIMX+2*JPHEXT,IJU,IKU))
-!
-IF ( .NOT. L2D ) THEN
- ALLOCATE(XLBYTHM(IIU,IJSIZEYF,IKU))
-!! ALLOCATE(XLBYTHM(IIU,2*NRIMY+2*JPHEXT,IKU))
-ELSE
- ALLOCATE(XLBYTHM(0,0,0))
-END IF
-!
-IF (CTURB /= 'NONE') THEN
- ALLOCATE(XLBXTKEM(IISIZEXF,IJU,IKU))
-!! ALLOCATE(XLBXTKEM(2*NRIMX+2*JPHEXT,IJU,IKU))
-ELSE
- ALLOCATE(XLBXTKEM(0,0,0))
-END IF
-!
-IF (CTURB /= 'NONE' .AND. (.NOT. L2D)) THEN
- ALLOCATE(XLBYTKEM(IIU,IJSIZEYF,IKU))
-!! ALLOCATE(XLBYTKEM(IIU,2*NRIMY+2*JPHEXT,IKU))
-ELSE
- ALLOCATE(XLBYTKEM(0,0,0))
-END IF
-!
-ALLOCATE(XLBXRM(IISIZEXF,IJU,IKU,NRR))
-!!ALLOCATE(XLBXRM(2*NRIMX+2*JPHEXT,IJU,IKU,NRR))
-!
-IF (.NOT. L2D ) THEN
- ALLOCATE(XLBYRM(IIU,IJSIZEYF,IKU,NRR))
-!! ALLOCATE(XLBYRM(IIU,2*NRIMY+2*JPHEXT,IKU,NRR))
-ELSE
- ALLOCATE(XLBYRM(0,0,0,0))
-END IF
-!
-ALLOCATE(XLBXSVM(IISIZEXF,IJU,IKU,NSV))
-!!ALLOCATE(XLBXSVM(2*NRIMX+2*JPHEXT,IJU,IKU,NSV))
-!
-IF (.NOT. L2D ) THEN
- ALLOCATE(XLBYSVM(IIU,IJSIZEYF,IKU,NSV))
-!! ALLOCATE(XLBYSVM(IIU,2*NRIMY+2*JPHEXT,IKU,NSV))
-ELSE
- ALLOCATE(XLBYSVM(0,0,0,0))
-END IF
-!
-NSIZELBX_ll=2*NRIMX+2*JPHEXT
-NSIZELBXU_ll=2*NRIMX+2*JPHEXT
-NSIZELBY_ll=2*NRIMY+2*JPHEXT
-NSIZELBYV_ll=2*NRIMY+2*JPHEXT
-NSIZELBXR_ll=2*NRIMX+2*JPHEXT
-NSIZELBXSV_ll=2*NRIMX+2*JPHEXT
-NSIZELBXTKE_ll=2*NRIMX+2*JPHEXT
-NSIZELBYTKE_ll=2*NRIMY+2*JPHEXT
-NSIZELBYR_ll=2*NRIMY+2*JPHEXT
-NSIZELBYSV_ll=2*NRIMY+2*JPHEXT
-!
-!
-! 4.8 precipitation variables ! same allocations than in ini_micron
-!
-IF (CCLOUD /= 'NONE' .AND. CCLOUD /= 'REVE') THEN
- ALLOCATE(XINPRR(IIU,IJU))
- ALLOCATE(XINPRR3D(IIU,IJU,IKU))
- ALLOCATE(XEVAP3D(IIU,IJU,IKU))
- ALLOCATE(XACPRR(IIU,IJU))
-ELSE
- ALLOCATE(XINPRR(0,0))
- ALLOCATE(XINPRR3D(0,0,0))
- ALLOCATE(XEVAP3D(0,0,0))
- ALLOCATE(XACPRR(0,0))
-END IF
-!
-IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C2R2' &
- .OR. CCLOUD == 'KHKO' .OR. CCLOUD == 'LIMA') THEN
- ALLOCATE(XINPRC(IIU,IJU))
- ALLOCATE(XACPRC(IIU,IJU))
-ELSE
- ALLOCATE(XINPRC(0,0))
- ALLOCATE(XACPRC(0,0))
-END IF
-!
-IF (( CCLOUD(1:3) == 'ICE' .AND.LDEPOSC) .OR. &
- ((CCLOUD=='C2R2' .OR. CCLOUD=='KHKO').AND.LDEPOC) .OR. &
- ( CCLOUD=='LIMA' .AND.MDEPOC)) THEN
- ALLOCATE(XINDEP(IIU,IJU))
- ALLOCATE(XACDEP(IIU,IJU))
-ELSE
- ALLOCATE(XINDEP(0,0))
- ALLOCATE(XACDEP(0,0))
-END IF
-!
-IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C3R5'.OR. CCLOUD == 'LIMA') THEN
- ALLOCATE(XINPRS(IIU,IJU))
- ALLOCATE(XACPRS(IIU,IJU))
-ELSE
- ALLOCATE(XINPRS(0,0))
- ALLOCATE(XACPRS(0,0))
-END IF
-!
-IF (CCLOUD == 'C3R5' .OR. CCLOUD == 'ICE3' .OR. CCLOUD == 'ICE4'.OR. CCLOUD == 'LIMA' ) THEN
- ALLOCATE(XINPRG(IIU,IJU))
- ALLOCATE(XACPRG(IIU,IJU))
-ELSE
- ALLOCATE(XINPRG(0,0))
- ALLOCATE(XACPRG(0,0))
-END IF
-!
-IF (CCLOUD == 'ICE4'.OR. CCLOUD == 'LIMA') THEN
- ALLOCATE(XINPRH(IIU,IJU))
- ALLOCATE(XACPRH(IIU,IJU))
-ELSE
- ALLOCATE(XINPRH(0,0))
- ALLOCATE(XACPRH(0,0))
-END IF
-!
-IF ( CCLOUD=='LIMA' .AND. LSCAV ) THEN
- ALLOCATE(XINPAP(IIU,IJU))
- ALLOCATE(XACPAP(IIU,IJU))
- XINPAP(:,:)=0.0
- XACPAP(:,:)=0.0
-ELSE
- ALLOCATE(XINPAP(0,0))
- ALLOCATE(XACPAP(0,0))
-END IF
-!
-! 4.8bis electric variables
-!
-IF (CELEC /= 'NONE' ) THEN
- ALLOCATE(XNI_SDRYG(IIU,IJU,IKU))
- ALLOCATE(XNI_IDRYG(IIU,IJU,IKU))
- ALLOCATE(XNI_IAGGS(IIU,IJU,IKU))
- ALLOCATE(XEFIELDU(IIU,IJU,IKU))
- ALLOCATE(XEFIELDV(IIU,IJU,IKU))
- ALLOCATE(XEFIELDW(IIU,IJU,IKU))
- ALLOCATE(XESOURCEFW(IIU,IJU,IKU))
- ALLOCATE(XIND_RATE(IIU,IJU,IKU))
- ALLOCATE(XIONSOURCEFW(IIU,IJU,IKU))
- ALLOCATE(XEW(IIU,IJU,IKU))
- ALLOCATE(XCION_POS_FW(IIU,IJU,IKU))
- ALLOCATE(XCION_NEG_FW(IIU,IJU,IKU))
- ALLOCATE(XMOBIL_POS(IIU,IJU,IKU))
- ALLOCATE(XMOBIL_NEG(IIU,IJU,IKU))
-ELSE
- ALLOCATE(XNI_SDRYG(0,0,0))
- ALLOCATE(XNI_IDRYG(0,0,0))
- ALLOCATE(XNI_IAGGS(0,0,0))
- ALLOCATE(XEFIELDU(0,0,0))
- ALLOCATE(XEFIELDV(0,0,0))
- ALLOCATE(XEFIELDW(0,0,0))
- ALLOCATE(XESOURCEFW(0,0,0))
- ALLOCATE(XIND_RATE(0,0,0))
- ALLOCATE(XIONSOURCEFW(0,0,0))
- ALLOCATE(XEW(0,0,0))
- ALLOCATE(XCION_POS_FW(0,0,0))
- ALLOCATE(XCION_NEG_FW(0,0,0))
- ALLOCATE(XMOBIL_POS(0,0,0))
- ALLOCATE(XMOBIL_NEG(0,0,0))
-END IF
-!
-!
-!
-! 4.9 Passive pollutant variable
-!
-IF (LPASPOL) THEN
- ALLOCATE( XATC(IIU,IJU,IKU,NSV_PP) )
- ELSE
- ALLOCATE( XATC(0,0,0,0))
-END IF
-!
-! 4.10 Advective forcing variable for 2D (Modif MT)
-!
-!
-IF (L2D_ADV_FRC) THEN
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: L2D_ADV_FRC IS SET TO ',L2D_ADV_FRC,' SO ADVECTIVE FORCING WILL BE SPAWN: NADVFRC=',NADVFRC
- ALLOCATE(TDTADVFRC(NADVFRC))
- ALLOCATE(XDTHFRC(IIU,IJU,IKU,NADVFRC))
- ALLOCATE(XDRVFRC(IIU,IJU,IKU,NADVFRC))
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: ALLOCATION OF ADV FORCING VARIABLES MADE'
-ELSE
- ALLOCATE(TDTADVFRC(0))
- ALLOCATE(XDTHFRC(0,0,0,0))
- ALLOCATE(XDRVFRC(0,0,0,0))
-END IF
-IF (L2D_REL_FRC) THEN
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: L2D_REL_FRC IS SET TO ',L2D_REL_FRC,' SO RELAXATION FORCING WILL BE SPAWN: NRELFRC=',NRELFRC
- ALLOCATE(TDTRELFRC(NRELFRC))
- ALLOCATE(XTHREL(IIU,IJU,IKU,NRELFRC))
- ALLOCATE(XRVREL(IIU,IJU,IKU,NRELFRC))
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: ALLOCATION OF REL FORCING VARIABLES MADE'
-ELSE
- ALLOCATE(TDTRELFRC(0))
- ALLOCATE(XTHREL(0,0,0,0))
- ALLOCATE(XRVREL(0,0,0,0))
-END IF
-!
-! 4.11 Turbulent fluxes for 2D (Modif MT)
-!
-!
-IF (LUV_FLX) THEN
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: XUV_FLX1 IS SET TO ',XUV_FLX1,' SO XVU_FLUX WILL BE SPAWN'
- ALLOCATE(XVU_FLUX_M(IIU,IJU,IKU))
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: ALLOCATION OF XVU_FLUX_M MADE'
-ELSE
- ALLOCATE(XVU_FLUX_M(0,0,0))
-END IF
-!
-IF (LTH_FLX) THEN
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: XTH_FLX IS SET TO ',XTH_FLX,' SO XVTH_FLUX and XWTH_FLUX WILL BE SPAWN'
- ALLOCATE(XVTH_FLUX_M(IIU,IJU,IKU))
- ALLOCATE(XWTH_FLUX_M(IIU,IJU,IKU))
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: ALLOCATION OF XVTH_FLUX_M and XWTH_FLUX_M MADE'
-ELSE
- ALLOCATE(XVTH_FLUX_M(0,0,0))
- ALLOCATE(XWTH_FLUX_M(0,0,0))
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 5. INITIALIZE ALL THE MODEL VARIABLES
-! ----------------------------------
-!
-!* 5.1 Bikhardt interpolation coefficients computation :
-!
-CALL INI_BIKHARDT_n(NDXRATIO,NDYRATIO,2)
-!
-CALL SECOND_MNH(ZTIME2)
-!
-ZMISC = ZTIME2 - ZTIME1
-!
-!* 5.2 Spatial and Temporal grid (for MODD_GRID2 and MODD_TIME2) :
-!
-CALL SECOND_MNH(ZTIME1)
-!
-IF(NPROC.GT.1)THEN
- CALL GO_TOMODEL_ll(2, IINFO_ll)
- CALL GET_FEEDBACK_COORD_ll(NXOR_TMP,NYOR_TMP,NXEND_TMP,NYEND_TMP,IINFO_ll) !phys domain
-ELSE
- NXOR_TMP = NXOR
- NYOR_TMP = NYOR
- NXEND_TMP= NXEND
- NYEND_TMP = NYEND
-ENDIF
-XZS=0.
-CALL SPAWN_GRID2( NXOR, NYOR, NXEND, NYEND, NDXRATIO, NDYRATIO, &
- XLONORI, XLATORI, XXHAT, XYHAT, XZHAT, XXHATM, XYHATM, XZHATM, &
- XXHAT_ll, XYHAT_ll, XXHATM_ll, XYHATM_ll, &
- XHAT_BOUND, XHATM_BOUND, &
- XZTOP, LSLEVE, XLEN1, XLEN2, &
- XZS, XZSMT, ZZS_LS, ZZSMT_LS, TDTMOD, TDTCUR )
-!
-CALL MPPDB_CHECK2D(ZZS_LS,"SPAWN_MOD2:ZZS_LS",PRECISION)
-CALL MPPDB_CHECK2D(ZZSMT_LS,"SPAWN_MOD2:ZZSMT_LS",PRECISION)
-CALL MPPDB_CHECK2D(XZS,"SPAWN_MOD2:XZS",PRECISION)
-CALL MPPDB_CHECK2D(XZSMT,"SPAWN_MOD2:XZSMT",PRECISION)
-!
-CALL SECOND_MNH(ZTIME2)
-!
-ZGRID2 = ZTIME2 - ZTIME1
-!
-!* 5.3 Calculation of the grid
-!
-ZTIME1 = ZTIME2
-!
-IF (LCARTESIAN) THEN
- CALL SM_GRIDCART(XXHAT,XYHAT,XZHAT,ZZS_LS,LSLEVE,XLEN1,XLEN2,ZZSMT_LS,XDXHAT,XDYHAT,ZZZ_LS,ZJ)
- CALL SM_GRIDCART(XXHAT,XYHAT,XZHAT,XZS ,LSLEVE,XLEN1,XLEN2,XZSMT ,XDXHAT,XDYHAT,XZZ ,ZJ)
-ELSE
- CALL SM_GRIDPROJ( XXHAT, XYHAT, XZHAT, XXHATM, XYHATM, ZZS_LS, &
- LSLEVE, XLEN1, XLEN2, ZZSMT_LS, XLATORI, XLONORI, &
- XMAP, XLAT, XLON, XDXHAT, XDYHAT, ZZZ_LS, ZJ )
- CALL SM_GRIDPROJ( XXHAT, XYHAT, XZHAT, XXHATM, XYHATM, XZS, &
- LSLEVE, XLEN1, XLEN2, XZSMT, XLATORI, XLONORI, &
- XMAP, XLAT, XLON, XDXHAT, XDYHAT, XZZ, ZJ )
-END IF
-!
-!* 5.4 Compute the metric coefficients
-!
-CALL ADD3DFIELD_ll( TZFIELDS_ll, XZZ, 'SPAWN_MODEL2::XZZ' )
-CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
-CALL CLEANLIST_ll(TZFIELDS_ll)
-!
-CALL METRICS(XMAP,XDXHAT,XDYHAT,XZZ,XDXX,XDYY,XDZX,XDZY,XDZZ)
-!
-CALL MPPDB_CHECK3D(XDXX,"spawnmod2-beforeupdate_metrics:XDXX",PRECISION)
-CALL MPPDB_CHECK3D(XDYY,"spawnmod2-beforeupdate_metrics:XDYY",PRECISION)
-CALL MPPDB_CHECK3D(XDZX,"spawnmod2-beforeupdate_metrics:XDZX",PRECISION)
-CALL MPPDB_CHECK3D(XDZY,"spawnmod2-beforeupdate_metrics:XDZY",PRECISION)
-!
-CALL UPDATE_METRICS(CLBCX,CLBCY,XDXX,XDYY,XDZX,XDZY,XDZZ)
-!
-CALL MPPDB_CHECK3D(XDXX,"spawnmod2-aftrupdate_metrics:XDXX",PRECISION)
-CALL MPPDB_CHECK3D(XDYY,"spawnmod2-aftrupdate_metrics:XDYY",PRECISION)
-CALL MPPDB_CHECK3D(XDZX,"spawnmod2-aftrupdate_metrics:XDZX",PRECISION)
-CALL MPPDB_CHECK3D(XDZY,"spawnmod2-aftrupdate_metrics:XDZY",PRECISION)
-!$
-!
-!* 5.5 3D Reference state variables :
-!
-CALL SET_REF( 0, TFILE_DUMMY, &
- XZZ, XZHATM, ZJ, XDXX, XDYY, CLBCX, CLBCY, &
- XREFMASS, XMASS_O_PHI0, XLINMASS, &
- XRHODREF, XTHVREF, XRVREF, XEXNREF, XRHODJ )
-!
-CALL SECOND_MNH(ZTIME2)
-!
-ZMISC = ZMISC + ZTIME2 - ZTIME1
-!
-!* 5.6 Prognostic variables and Larger scale fields :
-!
-ZTIME1 = ZTIME2
-!
-!* horizontal interpolation
-!
-ALLOCATE(ZTHVT(IIU,IJU,IKU))
-ALLOCATE(ZHUT(IIU,IJU,IKU))
-!
-MPPDB_CHECK_LB = .TRUE.
-IF (GNOSON) THEN
- CALL SPAWN_FIELD2 (NXOR,NYOR,NXEND,NYEND,NDXRATIO,NDYRATIO,CTURB, &
- XUT,XVT,XWT,ZTHVT,XRT,ZHUT,XTKET,XSVT,XZWS,XATC, &
- XSRCT,XSIGS, &
- XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XLSZWSM, &
- XDTHFRC,XDRVFRC,XTHREL,XRVREL, &
- XVU_FLUX_M,XVTH_FLUX_M,XWTH_FLUX_M )
- CALL MPPDB_CHECK3D(XUT,"SPAWN_M2 after SPAWN_FIELD2:XUT",PRECISION)
-ELSE
- CALL MPPDB_CHECK3D(XUT,"SPAWN_M2 before SPAWN_FIELD2:XUT",PRECISION)
- CALL SPAWN_FIELD2 (NXOR,NYOR,NXEND,NYEND,NDXRATIO,NDYRATIO,CTURB, &
- XUT,XVT,XWT,ZTHVT,XRT,ZHUT,XTKET,XSVT,XZWS,XATC, &
- XSRCT,XSIGS, &
- XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XLSZWSM, &
- XDTHFRC,XDRVFRC,XTHREL,XRVREL, &
- XVU_FLUX_M, XVTH_FLUX_M,XWTH_FLUX_M, &
- TZSONFILE,IIUSON,IJUSON, &
- IIB2,IJB2,IIE2,IJE2, &
- IIB1,IJB1,IIE1,IJE1 )
- CALL MPPDB_CHECK3D(XUT,"SPAWN_M2 after SPAWN_FIELD2:XUT",PRECISION)
-END IF
-!
-CALL MPPDB_CHECK3D(XUT,"SPAWN_MOD2aftFIELD2:XUT",PRECISION)
-CALL MPPDB_CHECK3D(XVT,"SPAWN_MOD2aftFIELD2:XVT",PRECISION)
-!$
-!* correction of positivity
-!
-IF (SIZE(XLSRVM,1)>0) XLSRVM = MAX(0.,XLSRVM)
-IF (SIZE(XRT,1)>0) XRT = MAX(0.,XRT)
-IF (SIZE(ZHUT,1)>0) ZHUT = MIN(MAX(ZHUT,0.),100.)
-IF (SIZE(XTKET,1)>0) XTKET = MAX(XTKEMIN,XTKET)
-!
-CALL SECOND_MNH(ZTIME2)
-!
-ZFIELD2 = ZTIME2 - ZTIME1
-!
-ZTIME1 = ZTIME2
-!
-!* vertical interpolation
-!
-ZZS_MAX = ABS( MAXVAL(XZS(:,:)))
-CALL MPI_ALLREDUCE(ZZS_MAX, ZZS_MAX_ll, 1, MNHREAL_MPI, MPI_MAX, &
- NMNH_COMM_WORLD,IINFO_ll)
-IF ( (ZZS_MAX_ll>0.) .AND. (NDXRATIO/=1 .OR. NDYRATIO/=1) ) THEN
- CALL MPPDB_CHECK3D(XUT,"SPAWN_M2 before VER_INTERP_FIELD:XUT",PRECISION)
- CALL VER_INTERP_FIELD (CTURB,NRR,NSV,ZZZ_LS,XZZ, &
- XUT,XVT,XWT,ZTHVT,XRT,ZHUT,XTKET,XSVT, &
- XSRCT,XSIGS, &
- XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM )
- !
- CALL MPPDB_CHECK3D(XUT,"SPAWN_M2aftVERINTER:XUT",PRECISION)
- CALL MPPDB_CHECK3D(XVT,"SPAWN_M2aftVERINTER:XVT",PRECISION)
- CALL MPPDB_CHECK3D(XWT,"SPAWN_M2aftVERINTER:XWT",PRECISION)
- CALL MPPDB_CHECK3D(ZHUT,"SPAWN_M2aftVERINTER:ZHUT",PRECISION)
- CALL MPPDB_CHECK3D(XTKET,"SPAWN_M2aftVERINTER:XTKET",PRECISION)
- CALL MPPDB_CHECK3D(XSRCT,"SPAWN_M2aftVERINTER:XSRCT",PRECISION)
-ENDIF
-!
-CALL SECOND_MNH(ZTIME2)
-!
-ZVER = ZTIME2 - ZTIME1
-!
-!* 5.7 Absolute pressure :
-!
-ZTIME1 = ZTIME2
-!
-CALL SPAWN_PRESSURE2(NXOR,NYOR,NXEND,NYEND,NDXRATIO,NDYRATIO, &
- ZZZ_LS,XZZ,ZTHVT,XPABST )
-!
-IF (.NOT.GNOSON) THEN
- ALLOCATE(ZWORK3D(IIUSON,IJUSON,IKU))
- CALL IO_Field_read(TZSONFILE,'PABST',ZWORK3D)
- XPABST(IIB2:IIE2,IJB2:IJE2,:) = ZWORK3D(IIB1:IIE1,IJB1:IJE1,:)
- DEALLOCATE(ZWORK3D)
-END IF
-!
-IF (NVERB>=2) THEN
- IK4000 = COUNT(XZHAT(:)<4000.)
- IIJ = MAXLOC( SUM(ZHUT(IIB:IIE,IJB:IJE,JPVEXT+1:IK4000),3), &
- MASK=COUNT(ZHUT(IIB:IIE,IJB:IJE,JPVEXT+1:IKE) &
- >=MAXVAL(ZHUT(IIB:IIE,IJB:IJE,JPVEXT+1:IKE))-0.01,DIM=3 ) &
- >=1 ) &
- + JPHEXT
- WRITE(ILUOUT,*) ' '
- WRITE(ILUOUT,*) 'humidity (I=',IIJ(1),';J=',IIJ(2),')'
- DO JK=IKB,IKE
- WRITE(ILUOUT,'(F6.2," %")') ZHUT(IIJ(1),IIJ(2),JK)
- END DO
-END IF
-!* 5.8 Retrieve model thermodynamical variables :
-!
-ALLOCATE(ZSUMRT(IIU,IJU,IKU))
-ZSUMRT(:,:,:) = 0.
-IF (NRR==0) THEN
- XTHT(:,:,:) = ZTHVT(:,:,:)
-ELSE
- IF (NDXRATIO/=1 .OR. NDYRATIO/=1) THEN
- XRT(:,:,:,1) = SM_PMR_HU(XPABST(:,:,:), &
- ZTHVT(:,:,:)*(XPABST(:,:,:)/XP00)**(XRD/XCPD), &
- ZHUT(:,:,:),XRT(:,:,:,:),KITERMAX=100 )
- END IF
- !
- DO JRR=1,NRR
- ZSUMRT(:,:,:) = ZSUMRT(:,:,:) + XRT(:,:,:,JRR)
- END DO
- XTHT(:,:,:) = ZTHVT(:,:,:)/(1.+XRV/XRD*XRT(:,:,:,1))*(1.+ZSUMRT(:,:,:))
- CALL MPPDB_CHECK3D(XTHT,"SPAWN_MOD2:XTHT",PRECISION)
-END IF
-!
-DEALLOCATE (ZHUT)
-!
-CALL SECOND_MNH(ZTIME2)
-ZPRESSURE2=ZTIME2-ZTIME1
-!
-!* 5.9 Large Scale field for lbc treatment:
-!
-!
-!* 5.9.1 West-East LB zones
-!
-!
-!JUAN A REVOIR TODO_JPHEXT
-! <<<<<<< spawn_model2.f90
- MPPDB_CHECK_LB = .TRUE.
- CALL MPPDB_CHECK3D(XUT,"SPAWN_MOD2 before lbc treatment:XUT",PRECISION)
- CALL MPPDB_CHECK3D(XVT,"SPAWN_MOD2 before lbc treatment:XVT",PRECISION)
- MPPDB_CHECK_LB = .FALSE.
- YLBTYPE = 'LBU'
- CALL SET_LB_FIELD_ll( YLBTYPE, XUT, XLBXUM, XLBYUM, IIB, IJB, IIE, IJE, 1, 0, 0, 0 )
- ! copy XUT(IIB:IIB+NRIMX,:,:) instead of XUT(IIB-1:IIB-1+NRIMX,:,:) in XLBXUM
- CALL SET_LB_FIELD_ll( YLBTYPE, XVT, XLBXVM, XLBYVM, IIB, IJB, IIE, IJE, 0, 0, 1, 0 )
- ! copy XVT(:,IJB:IJB+NRIMY,:) instead of XVT(:,IJB-1:IJB-1+NRIMY,:) in XLBYVM
- CALL SET_LB_FIELD_ll( YLBTYPE, XWT, XLBXWM, XLBYWM, IIB, IJB, IIE, IJE, 0, 0, 0, 0 )
- CALL SET_LB_FIELD_ll( YLBTYPE, XTHT, XLBXTHM, XLBYTHM, IIB, IJB, IIE, IJE, 0, 0, 0, 0 )
- IF (HTURB /= 'NONE') THEN
- CALL SET_LB_FIELD_ll( YLBTYPE, XTKET, XLBXTKEM, XLBYTKEM, IIB, IJB, IIE, IJE, 0, 0, 0, 0 )
- ENDIF
- IF (NRR >= 1) THEN
- DO JRR =1,NRR
- CALL SET_LB_FIELD_ll( YLBTYPE, XRT(:,:,:,JRR), XLBXRM(:,:,:,JRR), XLBYRM(:,:,:,JRR), IIB, IJB, IIE, IJE, 0, 0, 0, 0 )
- END DO
- END IF
- IF (NSV /= 0) THEN
- DO JSV = 1, NSV
- CALL SET_LB_FIELD_ll( YLBTYPE, XSVT(:,:,:,JSV), XLBXSVM(:,:,:,JSV), XLBYSVM(:,:,:,JSV), IIB, IJB, IIE, IJE, 0, 0, 0, 0 )
- END DO
-!!$=======
-!!$!
-!!$XLBXUM(1:NRIMX+JPHEXT,:,:) = XUT(2:NRIMX+JPHEXT+1,:,:)
-!!$XLBXUM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:) = XUT(IIE+1-NRIMX:IIE+JPHEXT,:,:)
-!!$IF( .NOT. L2D ) THEN
-!!$ XLBYUM(:,1:NRIMY+JPHEXT,:) = XUT(:,1:NRIMY+JPHEXT,:)
-!!$ XLBYUM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:) = XUT(:,IJE+1-NRIMY:IJE+JPHEXT,:)
-!!$END IF
-!!$!
-!!$!* 5.9.2 V variable
-!!$!
-!!$!
-!!$XLBXVM(1:NRIMX+JPHEXT,:,:) = XVT(1:NRIMX+JPHEXT,:,:)
-!!$XLBXVM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:) = XVT(IIE+1-NRIMX:IIE+JPHEXT,:,:)
-!!$IF( .NOT. L2D ) THEN
-!!$ XLBYVM(:,1:NRIMY+JPHEXT,:) = XVT(:,2:NRIMY+JPHEXT+1,:)
-!!$ XLBYVM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:) = XVT(:,IJE+1-NRIMY:IJE+JPHEXT,:)
-!!$END IF
-!!$!
-!!$!* 5.9.3 W variable
-!!$!
-!!$!
-!!$XLBXWM(1:NRIMX+JPHEXT,:,:) = XWT(1:NRIMX+JPHEXT,:,:)
-!!$XLBXWM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:) = XWT(IIE+1-NRIMX:IIE+JPHEXT,:,:)
-!!$IF( .NOT. L2D ) THEN
-!!$ XLBYWM(:,1:NRIMY+JPHEXT,:) = XWT(:,1:NRIMY+JPHEXT,:)
-!!$ XLBYWM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:) = XWT(:,IJE+1-NRIMY:IJE+JPHEXT,:)
-!!$END IF
-!!$!
-!!$!* 5.9.4 TH variable
-!!$!
-!!$!
-!!$XLBXTHM(1:NRIMX+JPHEXT,:,:) = XTHT(1:NRIMX+JPHEXT,:,:)
-!!$XLBXTHM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:) = XTHT(IIE+1-NRIMX:IIE+JPHEXT,:,:)
-!!$IF( .NOT. L2D ) THEN
-!!$ XLBYTHM(:,1:NRIMY+JPHEXT,:) = XTHT(:,1:NRIMY+JPHEXT,:)
-!!$ XLBYTHM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:) = XTHT(:,IJE+1-NRIMY:IJE+JPHEXT,:)
-!!$END IF
-!!$!
-!!$!* 5.9.5 TKE variable
-!!$!
-!!$!
-!!$IF (HTURB /= 'NONE') THEN
-!!$ XLBXTKEM(1:NRIMX+JPHEXT,:,:) = XTKET(1:NRIMX+JPHEXT,:,:)
-!!$ XLBXTKEM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:) = XTKET(IIE+1-NRIMX:IIE+JPHEXT,:,:)
-!!$ IF( .NOT. L2D ) THEN
-!!$ XLBYTKEM(:,1:NRIMY+JPHEXT,:) = XTKET(:,1:NRIMY+JPHEXT,:)
-!!$ XLBYTKEM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:) = XTKET(:,IJE+1-NRIMY:IJE+JPHEXT,:)
-!!$>>>>>>> 1.3.2.4.2.2.2.6.2.3.2.6.2.1
- END IF
-!
-! <<<<<<< spawn_model2.f90
- CALL MPPDB_CHECKLB(XLBXUM,"SPAWN_MOD2 before SPAWN_SURF2_RAIN",PRECISION,'LBXU',NRIMX)
- CALL MPPDB_CHECKLB(XLBXVM,"SPAWN_MOD2 before SPAWN_SURF2_RAIN:XLBXVM",PRECISION,'LBXU',NRIMX)
- CALL MPPDB_CHECKLB(XLBXWM,"SPAWN_MOD2 before SPAWN_SURF2_RAIN:XLBXWM",PRECISION,'LBXU',NRIMX)
- CALL MPPDB_CHECKLB(XLBYUM,"SPAWN_MOD2 before SPAWN_SURF2_RAIN:XLBYUM",PRECISION,'LBYV',NRIMY)
- CALL MPPDB_CHECKLB(XLBYVM,"SPAWN_MOD2 before SPAWN_SURF2_RAIN:XLBYVM",PRECISION,'LBYV',NRIMY)
- CALL MPPDB_CHECKLB(XLBYWM,"SPAWN_MOD2 before SPAWN_SURF2_RAIN:XLBYWM",PRECISION,'LBYV',NRIMY)
-!!$=======
-!!$!* 5.9.6 moist variables
-!!$!
-!!$IF (NRR >= 1) THEN
-!!$ DO JRR =1,NRR
-!!$ XLBXRM(1:NRIMX+JPHEXT,:,:,JRR) = XRT(1:NRIMX+JPHEXT,:,:,JRR)
-!!$ XLBXRM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:,JRR) = XRT(IIE+1-NRIMX:IIE+JPHEXT,:,:,JRR)
-!!$ IF( .NOT. L2D ) THEN
-!!$ XLBYRM(:,1:NRIMY+JPHEXT,:,JRR) = XRT(:,1:NRIMY+JPHEXT,:,JRR)
-!!$ XLBYRM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:,JRR) = XRT(:,IJE+1-NRIMY:IJE+JPHEXT,:,JRR)
-!!$ END IF
-!!$ END DO
-!!$END IF
-!!$!
-!!$!* 5.9.7 scalar variables
-!!$!
-!!$IF (NSV /= 0) THEN
-!!$ DO JSV = 1, NSV
-!!$ XLBXSVM(1:NRIMX+JPHEXT,:,:,JSV) = XSVT(1:NRIMX+JPHEXT,:,:,JSV)
-!!$ XLBXSVM(NRIMX+JPHEXT+1:2*NRIMX+2*JPHEXT,:,:,JSV) = XSVT(IIE+1-NRIMX:IIE+JPHEXT,:,:,JSV)
-!!$ IF( .NOT. L2D ) THEN
-!!$ XLBYSVM(:,1:NRIMY+JPHEXT,:,JSV) = XSVT(:,1:NRIMY+JPHEXT,:,JSV)
-!!$ XLBYSVM(:,NRIMY+JPHEXT+1:2*NRIMY+2*JPHEXT,:,JSV) = XSVT(:,IJE+1-NRIMY:IJE+JPHEXT,:,JSV)
-!!$ END IF
-!!$ END DO
-!!$ENDIF
-!!$>>>>>>> 1.3.2.4.2.2.2.6.2.3.2.6.2.1
-!
-!* 5.10 Surface precipitation computation
-!
-IF (SIZE(XINPRR) /= 0 ) THEN
- IF (GNOSON) &
- CALL SPAWN_SURF2_RAIN (NXOR,NYOR,NXEND,NYEND,NDXRATIO,NDYRATIO, &
- XINPRC,XACPRC,XINDEP,XACDEP,XINPRR,XINPRR3D,XEVAP3D, &
- XACPRR,XINPRS,XACPRS,XINPRG,XACPRG,&
- XINPRH,XACPRH )
- IF (.NOT.GNOSON) &
- CALL SPAWN_SURF2_RAIN (NXOR,NYOR,NXEND,NYEND,NDXRATIO,NDYRATIO, &
- XINPRC,XACPRC,XINDEP,XACDEP,XINPRR,XINPRR3D,XEVAP3D, &
- XACPRR,XINPRS,XACPRS,XINPRG,XACPRG,XINPRH,XACPRH, &
- TZSONFILE,IIUSON,IJUSON, &
- IIB2,IJB2,IIE2,IJE2, &
- IIB1,IJB1,IIE1,IJE1 )
-ENDIF
-!
-!* 5.11 Total mass of dry air Md computation :
-!
-ZTIME1 = ZTIME2
-!
-ALLOCATE(ZRHOD(IIU,IJU,IKU))
-!
-IF (LOCEAN) THEN
- ZRHOD(:,:,:)=XRH00OCEAN*(1.-XALPHAOC*(ZTHVT(:,:,:)-XTH00OCEAN)+XBETAOC*(XRT(:,:,:,1)-XSA00OCEAN))
-ELSE
- ZRHOD(:,:,:)=XPABST(:,:,:)/(XPABST(:,:,:)/XP00)**(XRD/XCPD) &
- /(XRD*ZTHVT(:,:,:)*(1.+ZSUMRT(:,:,:)))
-ENDIF
-!$20140709
- CALL MPPDB_CHECK3D(ZRHOD,"SPAWN_MOD2:ZRHOD",PRECISION)
- CALL MPPDB_CHECK3D(XPABST,"SPAWN_MOD2:XPABST",PRECISION)
- CALL MPPDB_CHECK3D(ZSUMRT,"SPAWN_MOD2:ZSUMRT",PRECISION)
-!$20140710 until here all ok after UPHALO(XZZ)
-!
-CALL TOTAL_DMASS(ZJ,ZRHOD,XDRYMASST)
-!
-DEALLOCATE (ZRHOD)
-DEALLOCATE (ZSUMRT,ZTHVT)
-!
-CALL SECOND_MNH(ZTIME2)
-!
-ZMISC = ZMISC + ZTIME2 - ZTIME1
-!
-!* 5.12 Deallocation of model 1 variables :
-!
-ZTIME1 = ZTIME2
-!
-CALL DEALLOCATE_MODEL1(3)
-!
-CALL SECOND_MNH(ZTIME2)
-!
-ZMISC = ZMISC + ZTIME2 - ZTIME1
-!
-!* 5.13 Anelastic correction :
-!
-CALL SECOND_MNH(ZTIME1)
-!
-IF (.NOT. L1D) THEN
- CALL ANEL_BALANCE_n
- CALL BOUNDARIES ( &
- 0.,CLBCX,CLBCY,NRR,NSV,1, &
- XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, &
- XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
- XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, &
- XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
- XRHODJ,XRHODREF, &
- XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT )
-END IF
-!
-CALL SECOND_MNH(ZTIME2)
-!
-ZANEL = ZTIME2 - ZTIME1
-!
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 6. WRITE THE FMFILE
-! ----------------
-!
-CALL SECOND_MNH(ZTIME1)
-!
-INPRAR = 22 + 2*(4+NRR+NSV) ! 22 = number of grid variables + reference state
- ! variables +dimension variables
- ! 2*(4+NRR+NSV) = number of prognostic variables
- ! at time t and t-dt
-IF ( ( LEN_TRIM(HSPAFILE) /= 0 ) .AND. ( ADJUSTL(HSPAFILE) /= ADJUSTL(CINIFILE) ) ) THEN
- CMY_NAME(2)=HSPAFILE
-ELSE
- CMY_NAME(2)=ADJUSTL(ADJUSTR(CINIFILE)//'.spa'//ADJUSTL(HSPANBR))
- IF (.NOT.GNOSON) &
- CMY_NAME(2)=ADJUSTL(ADJUSTR(CINIFILE)//'.spr'//ADJUSTL(HSPANBR))
-END IF
-!
-CALL IO_File_add2list(TZFILE,CMY_NAME(2),'MNH','WRITE',KLFINPRAR=INPRAR,KLFITYPE=1,KLFIVERB=NVERB)
-!
-CALL IO_File_open(TZFILE)
-!
-CALL WRITE_DESFM_n(2,TZFILE)
-!
-IF (LBAL_ONLY) THEN ! same relation with its DAD for model2 and for model1
- NDXRATIO_ALL(2) = NDXRATIO_ALL(1)
- NDYRATIO_ALL(2) = NDYRATIO_ALL(1)
- NXOR_ALL(2) = NXOR_ALL(1)
- NYOR_ALL(2) = NYOR_ALL(1)
- NXEND_ALL(2) = NXEND_ALL(1)
- NYEND_ALL(2) = NYEND_ALL(1)
- CDAD_NAME(2) = CDAD_NAME(1)
- IF (CDADSPAFILE == '' ) THEN
- IF (NDXRATIO_ALL(1) == 1 .AND. NDYRATIO_ALL(1) == 1 &
- .AND. NXOR_ALL(1) == 1 .AND. NYOR_ALL(1) == 1 ) THEN
- ! for spawning with ratio=1
- ! if the DAD of model 1 is itself, the DAD of model 2 also.
- CDAD_NAME(2)=CMY_NAME(2)
- ENDIF
- ENDIF
- ! case of model with DAD
- IF (CDADSPAFILE /='') CDAD_NAME(2)=CDADSPAFILE
-ELSE
- CDAD_NAME(2)=CMY_NAME(1) ! model 1 becomes the DAD of model 2 (spawned one)
-ENDIF
-!
-CALL IO_Header_write(TZFILE,HDAD_NAME=CDAD_NAME(2))
-CALL WRITE_LFIFM_n(TZFILE,CDAD_NAME(2))
-!
-CALL SECOND_MNH(ZTIME2)
-!
-ZWRITE = ZTIME2 - ZTIME1
-!
-!-------------------------------------------------------------------------------
-!
-!* 7. Surface variables :
-!
-ZTIME1 = ZTIME2
-!
-TFILE_SURFEX => TZFILE
-CALL SPAWN_SURF(HINIFILE,HINIFILEPGD,TZFILE,OSPAWN_SURF)
-NULLIFY(TFILE_SURFEX)
-!
-CALL SECOND_MNH(ZTIME2)
-!
-ZSURF2 = ZTIME2 - ZTIME1
-!
-!-------------------------------------------------------------------------------
-!
-!* 8. CLOSES THE FMFILE
-! -----------------
-!
-CALL IO_File_close(TZFILE)
-IF (ASSOCIATED(TZSONFILE)) THEN
- CALL IO_File_close(TZSONFILE)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 9. PRINTS ON OUTPUT-LISTING
-! ------------------------
-!
-WRITE(ILUOUT,FMT=9900) XZHAT(1)
-!
-DO JLOOP = 2,IKU
- WRITE(ILUOUT,FMT=9901) JLOOP,XZHAT(JLOOP),XZHAT(JLOOP)-XZHAT(JLOOP-1)
-END DO
-!
-IF (NVERB >= 5) THEN
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: LUSERV,LUSERC=',LUSERV,LUSERC
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: LUSERR,LUSERI,LUSERS=',LUSERR,LUSERI,LUSERS
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: LUSERG,LUSERH,NSV=',LUSERG,LUSERH,NSV
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: NRR=',NRR
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: NVERB=',NVERB
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: XLON0,XLAT0,XBETA=',XLON0,XLAT0,XBETA
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: LCARTESIAN=',LCARTESIAN
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: LOCEAN,LCOUPLES=',LOCEAN,LCOUPLES
- IF(LCARTESIAN) THEN
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: No map projection used.'
- ELSE
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: XRPK,XLONORI,XLATORI=',XRPK,XLONORI,XLATORI
- IF (ABS(XRPK) == 1.) THEN
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: Polar stereo used.'
- ELSE IF (XRPK == 0.) THEN
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: Mercator used.'
- ELSE
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: Lambert used, cone factor=',XRPK
- END IF
- END IF
-END IF
-!
-IF (NVERB >= 10) THEN
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: IIB, IJB, IKB=',IIB,IJB,IKB
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: IIU, IJU, IKU=',IIU,IJU,IKU
-END IF
-!
-IF(NVERB >= 10) THEN !Value control
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: Some XZS values:'
- WRITE(ILUOUT,*) XZS(1,IJU),XZS((IIU-1)/2,IJU),XZS(IIU,IJU)
- WRITE(ILUOUT,*) XZS(1,(IJU-1)/2),XZS((IIU-1)/2,(IJU-1)/2),XZS(IIU,(IJU-1)/2)
- WRITE(ILUOUT,*) XZS(1,1) ,XZS((IIU-1)/2,1) ,XZS(IIU,1)
-END IF
-!
-IF(NVERB >= 10) THEN !Value control
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: Some XUT values:'
- WRITE(ILUOUT,*) ' (1,IJU/2,JK) (IIU/2,1,JK) (IIU/2,IJU/2,JK) &
- &(IIU/2,IJU,JK) (IIU,IJU/2,JK)'
- DO JKLOOP=1,IKU
- WRITE(ILUOUT,*) 'JK = ',JKLOOP
- WRITE(ILUOUT,*) XUT(1,IJU/2,JKLOOP),XUT(IIU/2,1,JKLOOP), &
- XUT(IIU/2,IJU/2,JKLOOP),XUT(IIU/2,IJU,JKLOOP), &
- XUT(IIU,IJU/2,JKLOOP)
- END DO
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: Some XVT values:'
- WRITE(ILUOUT,*) ' (1,IJU/2,JK) (IIU/2,1,JK) (IIU/2,IJU/2,JK) &
- &(IIU/2,IJU,JK) (IIU,IJU/2,JK)'
- DO JKLOOP=1,IKU
- WRITE(ILUOUT,*) 'JK = ',JKLOOP
- WRITE(ILUOUT,*) XVT(1,IJU/2,JKLOOP),XVT(IIU/2,1,JKLOOP), &
- XVT(IIU/2,IJU/2,JKLOOP),XVT(IIU/2,IJU,JKLOOP), &
- XVT(IIU,IJU/2,JKLOOP)
- END DO
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: Some XWT values:'
- WRITE(ILUOUT,*) ' (1,IJU/2,JK) (IIU/2,1,JK) (IIU/2,IJU/2,JK) &
- &(IIU/2,IJU,JK) (IIU,IJU/2,JK)'
- DO JKLOOP=1,IKU
- WRITE(ILUOUT,*) 'JK = ',JKLOOP
- WRITE(ILUOUT,*) XWT(1,IJU/2,JKLOOP),XWT(IIU/2,1,JKLOOP), &
- XWT(IIU/2,IJU/2,JKLOOP),XWT(IIU/2,IJU,JKLOOP), &
- XWT(IIU,IJU/2,JKLOOP)
- END DO
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: Some XTHT values:'
- WRITE(ILUOUT,*) ' (1,IJU/2,JK) (IIU/2,1,JK) (IIU/2,IJU/2,JK) &
- &(IIU/2,IJU,JK) (IIU,IJU/2,JK)'
- DO JKLOOP=1,IKU
- WRITE(ILUOUT,*) 'JK = ',JKLOOP
- WRITE(ILUOUT,*) XTHT(1,IJU/2,JKLOOP),XTHT(IIU/2,1,JKLOOP), &
- XTHT(IIU/2,IJU/2,JKLOOP),XTHT(IIU/2,IJU,JKLOOP), &
- XTHT(IIU,IJU/2,JKLOOP)
- END DO
- IF(NRR >= 1) THEN
- WRITE(ILUOUT,*) 'SPAWN_MODEL2: Some XRT values:'
- WRITE(ILUOUT,*) ' (1,IJU/2,JK) (IIU/2,1,JK) (IIU/2,IJU/2,JK) &
- &(IIU/2,IJU,JK) (IIU,IJU/2,JK)'
- DO JKLOOP=1,IKU
- WRITE(ILUOUT,*) 'JK = ',JKLOOP
- WRITE(ILUOUT,*) XRT(1,IJU/2,JKLOOP,1),XRT(IIU/2,1,JKLOOP,1), &
- XRT(IIU/2,IJU/2,JKLOOP,1),XRT(IIU/2,IJU,JKLOOP,1), &
- XRT(IIU,IJU/2,JKLOOP,1)
- END DO
- END IF
- !
- IF (LUV_FLX) THEN
- WRITE(ILUOUT,*)'SPAWN_MODEL2: Some EDDY_FLUX values XVU_FLUX(IIU/2,2,:)=',XVU_FLUX_M(IIU/2,2,:)
- END IF
- !
- IF (LTH_FLX) THEN
- WRITE(ILUOUT,*)'SPAWN_MODEL2: Some EDDY_FLUX values XVTH_FLUX(IIU/2,2,:)=',XVTH_FLUX_M(IIU/2,2,:)
- WRITE(ILUOUT,*)'SPAWN_MODEL2: Some EDDY_FLUX values XWTH_FLUX(IIU/2,2,:)=',XWTH_FLUX_M(IIU/2,2,:)
- END IF
- !
-END IF
-!
-WRITE(ILUOUT,*) 'SPAWN_MODEL2: SPAWN_MODEL2 ENDS CORRECTLY.'
-!
-CALL SECOND_MNH (ZEND)
-!
-ZTOT = ZEND - ZSTART ! for computing time analysis
-!
-ZALL = ZGRID2 + ZSURF2 + ZMISC + ZFIELD2 + ZVER + ZPRESSURE2 + ZANEL + ZWRITE
-!
-ZPERCALL = 100.*ZALL/ZTOT
-!
-ZPERCGRID2 = 100.*ZGRID2/ZTOT
-ZPERCSURF2 = 100.*ZSURF2/ZTOT
-ZPERCMISC = 100.*ZMISC/ZTOT
-ZPERCFIELD2 = 100.*ZFIELD2/ZTOT
-ZPERCVER = 100.*ZVER/ZTOT
-ZPERCPRESSURE2 = 100.*ZPRESSURE2/ZTOT
-ZPERCANEL = 100.*ZANEL/ZTOT
-ZPERCWRITE = 100.*ZWRITE/ZTOT
-!
-WRITE(ILUOUT,*)
-WRITE(ILUOUT,*) ' ------------------------------------------------------------ '
-WRITE(ILUOUT,*) '| |'
-WRITE(ILUOUT,*) '| COMPUTING TIME ANALYSIS in SPAWN_MODEL2 |'
-WRITE(ILUOUT,*) '| |'
-WRITE(ILUOUT,*) '|------------------------------------------------------------|'
-WRITE(ILUOUT,*) '| | | |'
-WRITE(ILUOUT,*) '| ROUTINE NAME | CPU-TIME | PERCENTAGE % |'
-WRITE(ILUOUT,*) '| | | |'
-WRITE(ILUOUT,*) '|---------------------|-------------------|------------------|'
-WRITE(ILUOUT,*) '| | | |'
-WRITE(UNIT=ILUOUT,FMT=1) ZGRID2 ,ZPERCGRID2
-WRITE(UNIT=ILUOUT,FMT=3) ZFIELD2,ZPERCFIELD2
-WRITE(UNIT=ILUOUT,FMT=8) ZVER,ZPERCVER
-WRITE(UNIT=ILUOUT,FMT=7) ZPRESSURE2,ZPERCPRESSURE2
-WRITE(UNIT=ILUOUT,FMT=2) ZSURF2 ,ZPERCSURF2
-WRITE(UNIT=ILUOUT,FMT=4) ZANEL ,ZPERCANEL
-WRITE(UNIT=ILUOUT,FMT=5) ZWRITE ,ZPERCWRITE
-WRITE(UNIT=ILUOUT,FMT=9) ZMISC ,ZPERCMISC
-WRITE(UNIT=ILUOUT,FMT=6) ZTOT ,ZPERCALL
-WRITE(ILUOUT,*) ' ------------------------------------------------------------ '
-!
-! FORMATS
-! -------
-!
-1 FORMAT(' | SPAWN_GRID2 | ',F8.3,' | ',F8.3,' |')
-3 FORMAT(' | SPAWN_FIELD2 | ',F8.3,' | ',F8.3,' |')
-8 FORMAT(' | VER_INTERP_FIELD | ',F8.3,' | ',F8.3,' |')
-7 FORMAT(' | SPAWN_PRESSURE2 | ',F8.3,' | ',F8.3,' |')
-2 FORMAT(' | SPAWN_SURF2 | ',F8.3,' | ',F8.3,' |')
-4 FORMAT(' | ANEL_BALANCE2 | ',F8.3,' | ',F8.3,' |')
-5 FORMAT(' | WRITE | ',F8.3,' | ',F8.3,' |')
-9 FORMAT(' | MISCELLANEOUS | ',F8.3,' | ',F8.3,' |')
-6 FORMAT(' | SPAWN_MODEL2 | ',F8.3,' | ',F8.3,' |')
-!
-!
-CALL IO_File_close(TLUOUT)
-!
-9900 FORMAT(' K = 001 ZHAT = ',E14.7)
-9901 FORMAT(' K = ',I3.3,' ZHAT = ',E14.7,' DZ = ' ,E14.7)
-!
-!-------------------------------------------------------------------------------
-!
-!
-! Switch back to model index of calling routine
-CALL GOTO_MODEL(IMI)
-!
-END SUBROUTINE SPAWN_MODEL2
diff --git a/src/mesonh/ext/switch_sbg_lesn.f90 b/src/mesonh/ext/switch_sbg_lesn.f90
deleted file mode 100644
index 2920680faff50dbca286eaea17c310b045650675..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/switch_sbg_lesn.f90
+++ /dev/null
@@ -1,589 +0,0 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$ $Date$
-!-----------------------------------------------------------------
-!-----------------------------------------------------------------
-! ##########################
- SUBROUTINE SWITCH_SBG_LES_n
-! ##########################
-!
-!!**** *SWITCH_SBG_LESn* - moves LES subgrid quantities from modd_les
-!! to modd_lesn or the contrary.
-!!
-!! PURPOSE
-!! -------
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original June 14, 2002
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_LES
-USE MODD_LES_n
-USE MODD_CONF_n
-USE MODD_NSV
-!
-USE MODI_SECOND_MNH
-!
-IMPLICIT NONE
-!
-REAL :: ZTIME1, ZTIME2
-!-------------------------------------------------------------------------------
-!
-!* 7.4 interactions of resolved and subgrid quantities
-! -----------------------------------------------
-!
-CALL SECOND_MNH(ZTIME1)
-!
-IF (.NOT. ASSOCIATED (X_LES_RES_W_SBG_WThl) ) THEN
-! ______
- CALL LES_ALLOCATE('X_LES_RES_W_SBG_WThl',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <w'w'Thl'>
-! _____
- CALL LES_ALLOCATE('X_LES_RES_W_SBG_Thl2',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <w'Thl'2>
-! _____
- CALL LES_ALLOCATE('X_LES_RES_ddxa_U_SBG_UaU',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <du'/dxa ua'u'>
-! _____
- CALL LES_ALLOCATE('X_LES_RES_ddxa_V_SBG_UaV',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <dv'/dxa ua'v'>
-! _____
- CALL LES_ALLOCATE('X_LES_RES_ddxa_W_SBG_UaW',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <dw'/dxa ua'w'>
-! _______
- CALL LES_ALLOCATE('X_LES_RES_ddxa_W_SBG_UaThl',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <dw'/dxa ua'Thl'>
-! _____
- CALL LES_ALLOCATE('X_LES_RES_ddxa_Thl_SBG_UaW',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <dThl'/dxa ua'w'>
-! ___
- CALL LES_ALLOCATE('X_LES_RES_ddz_Thl_SBG_W2',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <dThl'/dz w'2>
-! _______
- CALL LES_ALLOCATE('X_LES_RES_ddxa_Thl_SBG_UaThl',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <dThl'/dxa ua'Thl'>
-!
- IF (LUSERV) THEN
-! _____
- CALL LES_ALLOCATE('X_LES_RES_W_SBG_WRt',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <w'w'Rt'>
-! ____
- CALL LES_ALLOCATE('X_LES_RES_W_SBG_Rt2',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <w'Rt'2>
-! _______
- CALL LES_ALLOCATE('X_LES_RES_W_SBG_ThlRt',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <w'Thl'Rt'>
-! ______
- CALL LES_ALLOCATE('X_LES_RES_ddxa_W_SBG_UaRt',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <dw'/dxa ua'Rt'>
-! _____
- CALL LES_ALLOCATE('X_LES_RES_ddxa_Rt_SBG_UaW',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <dRt'/dxa ua'w'>
-! ___
- CALL LES_ALLOCATE('X_LES_RES_ddz_Rt_SBG_W2',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <dRt'/dz w'2>
-! ______
- CALL LES_ALLOCATE('X_LES_RES_ddxa_Thl_SBG_UaRt',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <dThl'/dxa ua'Rt'>
-! _______
- CALL LES_ALLOCATE('X_LES_RES_ddxa_Rt_SBG_UaThl',(/NLES_K,NLES_TIMES,NLES_MASKS/))! <dRt'/dxa ua'Thl'>
-! ______
- CALL LES_ALLOCATE('X_LES_RES_ddxa_Rt_SBG_UaRt',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <dRt'/dxa ua'Rt'>
- ELSE
- CALL LES_ALLOCATE('X_LES_RES_W_SBG_WRt',(/0,0,0/))
- CALL LES_ALLOCATE('X_LES_RES_W_SBG_Rt2',(/0,0,0/))
- CALL LES_ALLOCATE('X_LES_RES_W_SBG_ThlRt',(/0,0,0/))
- CALL LES_ALLOCATE('X_LES_RES_ddxa_W_SBG_UaRt',(/0,0,0/))
- CALL LES_ALLOCATE('X_LES_RES_ddxa_Rt_SBG_UaW',(/0,0,0/))
- CALL LES_ALLOCATE('X_LES_RES_ddz_Rt_SBG_W2',(/0,0,0/))
- CALL LES_ALLOCATE('X_LES_RES_ddxa_Thl_SBG_UaRt',(/0,0,0/))
- CALL LES_ALLOCATE('X_LES_RES_ddxa_Rt_SBG_UaThl',(/0,0,0/))
- CALL LES_ALLOCATE('X_LES_RES_ddxa_Rt_SBG_UaRt',(/0,0,0/))
- END IF
-! ______
-CALL LES_ALLOCATE('X_LES_RES_ddxa_W_SBG_UaSv',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <dw'/dxa ua'Sv'>
-! _____
-CALL LES_ALLOCATE('X_LES_RES_ddxa_Sv_SBG_UaW',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <dSv'/dxa ua'w'>
-! ___
-CALL LES_ALLOCATE('X_LES_RES_ddz_Sv_SBG_W2',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/) ) ! <dSv'/dz w'2>
-! ______
-CALL LES_ALLOCATE('X_LES_RES_ddxa_Sv_SBG_UaSv',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <dSv'/dxa ua'Sv'>
-! _____
-CALL LES_ALLOCATE('X_LES_RES_W_SBG_WSv',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <w'w'Sv'>
-! ____
-CALL LES_ALLOCATE('X_LES_RES_W_SBG_Sv2',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <w'Sv'2>
-!
-!
- X_LES_RES_W_SBG_WThl = XLES_RES_W_SBG_WThl
- X_LES_RES_W_SBG_Thl2 = XLES_RES_W_SBG_Thl2
- X_LES_RES_ddxa_U_SBG_UaU = XLES_RES_ddxa_U_SBG_UaU
- X_LES_RES_ddxa_V_SBG_UaV = XLES_RES_ddxa_V_SBG_UaV
- X_LES_RES_ddxa_W_SBG_UaW = XLES_RES_ddxa_W_SBG_UaW
- X_LES_RES_ddxa_W_SBG_UaThl = XLES_RES_ddxa_W_SBG_UaThl
- X_LES_RES_ddxa_Thl_SBG_UaW = XLES_RES_ddxa_Thl_SBG_UaW
- X_LES_RES_ddz_Thl_SBG_W2 = XLES_RES_ddz_Thl_SBG_W2
- X_LES_RES_ddxa_Thl_SBG_UaThl = XLES_RES_ddxa_Thl_SBG_UaThl
- IF (LUSERV) THEN
- X_LES_RES_W_SBG_WRt = XLES_RES_W_SBG_WRt
- X_LES_RES_W_SBG_Rt2 = XLES_RES_W_SBG_Rt2
- X_LES_RES_W_SBG_ThlRt = XLES_RES_W_SBG_ThlRt
- X_LES_RES_ddxa_W_SBG_UaRt = XLES_RES_ddxa_W_SBG_UaRt
- X_LES_RES_ddxa_Rt_SBG_UaW = XLES_RES_ddxa_Rt_SBG_UaW
- X_LES_RES_ddz_Rt_SBG_W2 = XLES_RES_ddz_Rt_SBG_W2
- X_LES_RES_ddxa_Thl_SBG_UaRt= XLES_RES_ddxa_Thl_SBG_UaRt
- X_LES_RES_ddxa_Rt_SBG_UaThl= XLES_RES_ddxa_Rt_SBG_UaThl
- X_LES_RES_ddxa_Rt_SBG_UaRt = XLES_RES_ddxa_Rt_SBG_UaRt
- END IF
- IF (NSV>0) THEN
- X_LES_RES_ddxa_W_SBG_UaSv = XLES_RES_ddxa_W_SBG_UaSv
- X_LES_RES_ddxa_Sv_SBG_UaW = XLES_RES_ddxa_Sv_SBG_UaW
- X_LES_RES_ddz_Sv_SBG_W2 = XLES_RES_ddz_Sv_SBG_W2
- X_LES_RES_ddxa_Sv_SBG_UaSv = XLES_RES_ddxa_Sv_SBG_UaSv
- X_LES_RES_W_SBG_WSv = XLES_RES_W_SBG_WSv
- X_LES_RES_W_SBG_Sv2 = XLES_RES_W_SBG_Sv2
- END IF
-!
-!
- CALL LES_ALLOCATE('X_LES_SUBGRID_U2',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <u'2>
- CALL LES_ALLOCATE('X_LES_SUBGRID_V2',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <v'2>
- CALL LES_ALLOCATE('X_LES_SUBGRID_W2',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'2>
- CALL LES_ALLOCATE('X_LES_SUBGRID_Thl2',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <Thl'2>
- CALL LES_ALLOCATE('X_LES_SUBGRID_UV',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <u'v'>
- CALL LES_ALLOCATE('X_LES_SUBGRID_WU',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'u'>
- CALL LES_ALLOCATE('X_LES_SUBGRID_WV',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'v'>
- CALL LES_ALLOCATE('X_LES_SUBGRID_UThl',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <u'Thl'>
- CALL LES_ALLOCATE('X_LES_SUBGRID_VThl',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <v'Thl'>
- CALL LES_ALLOCATE('X_LES_SUBGRID_WThl',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'Thl'>
- CALL LES_ALLOCATE('X_LES_SUBGRID_WThv',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'Thv'>
- CALL LES_ALLOCATE('X_LES_SUBGRID_ThlThv',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <Thl'Thv'>
- CALL LES_ALLOCATE('X_LES_SUBGRID_W2Thl',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'2Thl>
- CALL LES_ALLOCATE('X_LES_SUBGRID_WThl2',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'Thl'2>
- CALL LES_ALLOCATE('X_LES_SUBGRID_DISS_Tke',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <epsilon>
- CALL LES_ALLOCATE('X_LES_SUBGRID_DISS_Thl2',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <epsilon_Thl2>
- CALL LES_ALLOCATE('X_LES_SUBGRID_WP',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'p'>
- CALL LES_ALLOCATE('X_LES_SUBGRID_PHI3',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! phi3
- CALL LES_ALLOCATE('X_LES_SUBGRID_LMix',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Lmix
- CALL LES_ALLOCATE('X_LES_SUBGRID_LDiss',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Ldiss
- CALL LES_ALLOCATE('X_LES_SUBGRID_Km',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Km
- CALL LES_ALLOCATE('X_LES_SUBGRID_Kh',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Kh
- CALL LES_ALLOCATE('X_LES_SUBGRID_ThlPz',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <Thl'dp'/dz>
- CALL LES_ALLOCATE('X_LES_SUBGRID_UTke',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <u'Tke>
- CALL LES_ALLOCATE('X_LES_SUBGRID_VTke',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <v'Tke>
- CALL LES_ALLOCATE('X_LES_SUBGRID_WTke',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'Tke>
- CALL LES_ALLOCATE('X_LES_SUBGRID_ddz_WTke',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <dw'Tke/dz>
-
- CALL LES_ALLOCATE('X_LES_SUBGRID_THLUP_MF',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Thl of the Updraft
- CALL LES_ALLOCATE('X_LES_SUBGRID_RTUP_MF',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Rt of the Updraft
- CALL LES_ALLOCATE('X_LES_SUBGRID_RVUP_MF',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Rv of the Updraft
- CALL LES_ALLOCATE('X_LES_SUBGRID_RCUP_MF',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Rc of the Updraft
- CALL LES_ALLOCATE('X_LES_SUBGRID_RIUP_MF',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Ri of the Updraft
- CALL LES_ALLOCATE('X_LES_SUBGRID_WUP_MF',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Thl of the Updraft
- CALL LES_ALLOCATE('X_LES_SUBGRID_MASSFLUX',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Mass Flux
- CALL LES_ALLOCATE('X_LES_SUBGRID_DETR',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Detrainment
- CALL LES_ALLOCATE('X_LES_SUBGRID_ENTR',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Entrainment
- CALL LES_ALLOCATE('X_LES_SUBGRID_FRACUP',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Updraft Fraction
- CALL LES_ALLOCATE('X_LES_SUBGRID_THVUP_MF',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Thv of the Updraft
- CALL LES_ALLOCATE('X_LES_SUBGRID_WTHLMF',(/NLES_K,NLES_TIMES,NLES_MASKS/))! Flux of thl
- CALL LES_ALLOCATE('X_LES_SUBGRID_WRTMF',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Flux of rt
- CALL LES_ALLOCATE('X_LES_SUBGRID_WTHVMF',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! Flux of thv
- CALL LES_ALLOCATE('X_LES_SUBGRID_WUMF',(/NLES_K,NLES_TIMES,NLES_MASKS/))! Flux of u
- CALL LES_ALLOCATE('X_LES_SUBGRID_WVMF',(/NLES_K,NLES_TIMES,NLES_MASKS/))! Flux of v
-
- IF (LUSERV ) THEN
- CALL LES_ALLOCATE('X_LES_SUBGRID_Rt2',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <Rt'2>
- CALL LES_ALLOCATE('X_LES_SUBGRID_ThlRt',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <Thl'Rt'>
- CALL LES_ALLOCATE('X_LES_SUBGRID_URt',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <u'Rt'>
- CALL LES_ALLOCATE('X_LES_SUBGRID_VRt',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <v'Rt'>
- CALL LES_ALLOCATE('X_LES_SUBGRID_WRt',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'Rt'>
- CALL LES_ALLOCATE('X_LES_SUBGRID_RtThv',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <Rt'Thv'>
- CALL LES_ALLOCATE('X_LES_SUBGRID_W2Rt',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'2Rt'>
- CALL LES_ALLOCATE('X_LES_SUBGRID_WThlRt',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'Thl'Rt'>
- CALL LES_ALLOCATE('X_LES_SUBGRID_WRt2',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'Rt'2>
- CALL LES_ALLOCATE('X_LES_SUBGRID_DISS_Rt2',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <epsilon_Rt2>
- CALL LES_ALLOCATE('X_LES_SUBGRID_DISS_ThlRt',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <epsilon_ThlRt>
- CALL LES_ALLOCATE('X_LES_SUBGRID_RtPz',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <Rt'dp'/dz>
- CALL LES_ALLOCATE('X_LES_SUBGRID_PSI3',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! psi3
- ELSE
- CALL LES_ALLOCATE('X_LES_SUBGRID_Rt2',(/0,0,0/))
- CALL LES_ALLOCATE('X_LES_SUBGRID_ThlRt',(/0,0,0/))
- CALL LES_ALLOCATE('X_LES_SUBGRID_URt',(/0,0,0/))
- CALL LES_ALLOCATE('X_LES_SUBGRID_VRt',(/0,0,0/))
- CALL LES_ALLOCATE('X_LES_SUBGRID_WRt',(/0,0,0/))
- CALL LES_ALLOCATE('X_LES_SUBGRID_RtThv',(/0,0,0/))
- CALL LES_ALLOCATE('X_LES_SUBGRID_W2Rt',(/0,0,0/))
- CALL LES_ALLOCATE('X_LES_SUBGRID_WThlRt',(/0,0,0/))
- CALL LES_ALLOCATE('X_LES_SUBGRID_WRt2',(/0,0,0/))
- CALL LES_ALLOCATE('X_LES_SUBGRID_DISS_Rt2',(/0,0,0/))
- CALL LES_ALLOCATE('X_LES_SUBGRID_DISS_ThlRt',(/0,0,0/))
- CALL LES_ALLOCATE('X_LES_SUBGRID_RtPz',(/0,0,0/))
- CALL LES_ALLOCATE('X_LES_SUBGRID_PSI3',(/0,0,0/))
- END IF
- IF (LUSERC ) THEN
- CALL LES_ALLOCATE('X_LES_SUBGRID_Rc2',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <Rc'2>
- CALL LES_ALLOCATE('X_LES_SUBGRID_URc',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <u'Rc'>
- CALL LES_ALLOCATE('X_LES_SUBGRID_VRc',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <v'Rc'>
- CALL LES_ALLOCATE('X_LES_SUBGRID_WRc',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <w'Rc'>
- ELSE
- CALL LES_ALLOCATE('X_LES_SUBGRID_Rc2',(/0,0,0/))
- CALL LES_ALLOCATE('X_LES_SUBGRID_URc',(/0,0,0/))
- CALL LES_ALLOCATE('X_LES_SUBGRID_VRc',(/0,0,0/))
- CALL LES_ALLOCATE('X_LES_SUBGRID_WRc',(/0,0,0/))
- END IF
- IF (LUSERI ) THEN
- CALL LES_ALLOCATE('X_LES_SUBGRID_Ri2',(/NLES_K,NLES_TIMES,NLES_MASKS/)) ! <Ri'2>
- ELSE
- CALL LES_ALLOCATE('X_LES_SUBGRID_Ri2',(/0,0,0/))
- END IF
- IF (NSV>0 ) THEN
- CALL LES_ALLOCATE('X_LES_SUBGRID_USv',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <u'Sv'>
- CALL LES_ALLOCATE('X_LES_SUBGRID_VSv',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <v'Sv'>
- CALL LES_ALLOCATE('X_LES_SUBGRID_WSv',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <w'Sv'>
- CALL LES_ALLOCATE('X_LES_SUBGRID_Sv2',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <Sv'2>
- CALL LES_ALLOCATE('X_LES_SUBGRID_SvThv',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <Sv'Thv'>
- CALL LES_ALLOCATE('X_LES_SUBGRID_W2Sv',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <w'2Sv'>
- CALL LES_ALLOCATE('X_LES_SUBGRID_WSv2',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <w'Sv'2>
- CALL LES_ALLOCATE('X_LES_SUBGRID_DISS_Sv2',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <epsilon_Sv2>
- CALL LES_ALLOCATE('X_LES_SUBGRID_SvPz',(/NLES_K,NLES_TIMES,NLES_MASKS,NSV/)) ! <Sv'dp'/dz>
- ELSE
- CALL LES_ALLOCATE('X_LES_SUBGRID_USv',(/0,0,0,0/))
- CALL LES_ALLOCATE('X_LES_SUBGRID_VSv',(/0,0,0,0/))
- CALL LES_ALLOCATE('X_LES_SUBGRID_WSv',(/0,0,0,0/))
- CALL LES_ALLOCATE('X_LES_SUBGRID_Sv2',(/0,0,0,0/))
- CALL LES_ALLOCATE('X_LES_SUBGRID_SvThv',(/0,0,0,0/))
- CALL LES_ALLOCATE('X_LES_SUBGRID_W2Sv',(/0,0,0,0/))
- CALL LES_ALLOCATE('X_LES_SUBGRID_WSv2',(/0,0,0,0/))
- CALL LES_ALLOCATE('X_LES_SUBGRID_DISS_Sv2',(/0,0,0,0/))
- CALL LES_ALLOCATE('X_LES_SUBGRID_SvPz',(/0,0,0,0/))
- END IF
-!
- X_LES_SUBGRID_U2 = XLES_SUBGRID_U2
- X_LES_SUBGRID_V2 = XLES_SUBGRID_V2
- X_LES_SUBGRID_W2 = XLES_SUBGRID_W2
- X_LES_SUBGRID_Thl2= XLES_SUBGRID_Thl2
- X_LES_SUBGRID_UV = XLES_SUBGRID_UV
- X_LES_SUBGRID_WU = XLES_SUBGRID_WU
- X_LES_SUBGRID_WV = XLES_SUBGRID_WV
- X_LES_SUBGRID_UThl= XLES_SUBGRID_UThl
- X_LES_SUBGRID_VThl= XLES_SUBGRID_VThl
- X_LES_SUBGRID_WThl= XLES_SUBGRID_WThl
- X_LES_SUBGRID_WThv = XLES_SUBGRID_WThv
- X_LES_SUBGRID_ThlThv = XLES_SUBGRID_ThlThv
- X_LES_SUBGRID_W2Thl = XLES_SUBGRID_W2Thl
- X_LES_SUBGRID_WThl2 = XLES_SUBGRID_WThl2
- X_LES_SUBGRID_DISS_Tke = XLES_SUBGRID_DISS_Tke
- X_LES_SUBGRID_DISS_Thl2= XLES_SUBGRID_DISS_Thl2
- X_LES_SUBGRID_WP = XLES_SUBGRID_WP
- X_LES_SUBGRID_PHI3 = XLES_SUBGRID_PHI3
- X_LES_SUBGRID_LMix = XLES_SUBGRID_LMix
- X_LES_SUBGRID_LDiss = XLES_SUBGRID_LDiss
- X_LES_SUBGRID_Km = XLES_SUBGRID_Km
- X_LES_SUBGRID_Kh = XLES_SUBGRID_Kh
- X_LES_SUBGRID_ThlPz = XLES_SUBGRID_ThlPz
- X_LES_SUBGRID_UTke= XLES_SUBGRID_UTke
- X_LES_SUBGRID_VTke= XLES_SUBGRID_VTke
- X_LES_SUBGRID_WTke= XLES_SUBGRID_WTke
- X_LES_SUBGRID_ddz_WTke =XLES_SUBGRID_ddz_WTke
-
- X_LES_SUBGRID_THLUP_MF = XLES_SUBGRID_THLUP_MF
- X_LES_SUBGRID_RTUP_MF = XLES_SUBGRID_RTUP_MF
- X_LES_SUBGRID_RVUP_MF = XLES_SUBGRID_RVUP_MF
- X_LES_SUBGRID_RCUP_MF = XLES_SUBGRID_RCUP_MF
- X_LES_SUBGRID_RIUP_MF = XLES_SUBGRID_RIUP_MF
- X_LES_SUBGRID_WUP_MF = XLES_SUBGRID_WUP_MF
- X_LES_SUBGRID_MASSFLUX = XLES_SUBGRID_MASSFLUX
- X_LES_SUBGRID_DETR = XLES_SUBGRID_DETR
- X_LES_SUBGRID_ENTR = XLES_SUBGRID_ENTR
- X_LES_SUBGRID_FRACUP = XLES_SUBGRID_FRACUP
- X_LES_SUBGRID_THVUP_MF = XLES_SUBGRID_THVUP_MF
- X_LES_SUBGRID_WTHLMF = XLES_SUBGRID_WTHLMF
- X_LES_SUBGRID_WRTMF = XLES_SUBGRID_WRTMF
- X_LES_SUBGRID_WTHVMF = XLES_SUBGRID_WTHVMF
- X_LES_SUBGRID_WUMF = XLES_SUBGRID_WUMF
- X_LES_SUBGRID_WVMF = XLES_SUBGRID_WVMF
-
- IF (LUSERV ) THEN
- X_LES_SUBGRID_Rt2 = XLES_SUBGRID_Rt2
- X_LES_SUBGRID_ThlRt= XLES_SUBGRID_ThlRt
- X_LES_SUBGRID_URt = XLES_SUBGRID_URt
- X_LES_SUBGRID_VRt = XLES_SUBGRID_VRt
- X_LES_SUBGRID_WRt = XLES_SUBGRID_WRt
- X_LES_SUBGRID_RtThv = XLES_SUBGRID_RtThv
- X_LES_SUBGRID_W2Rt = XLES_SUBGRID_W2Rt
- X_LES_SUBGRID_WThlRt = XLES_SUBGRID_WThlRt
- X_LES_SUBGRID_WRt2 = XLES_SUBGRID_WRt2
- X_LES_SUBGRID_DISS_Rt2= XLES_SUBGRID_DISS_Rt2
- X_LES_SUBGRID_DISS_ThlRt= XLES_SUBGRID_DISS_ThlRt
- X_LES_SUBGRID_RtPz = XLES_SUBGRID_RtPz
- X_LES_SUBGRID_PSI3 = XLES_SUBGRID_PSI3
- END IF
- IF (LUSERC ) THEN
- X_LES_SUBGRID_Rc2 = XLES_SUBGRID_Rc2
- X_LES_SUBGRID_URc = XLES_SUBGRID_URc
- X_LES_SUBGRID_VRc = XLES_SUBGRID_VRc
- X_LES_SUBGRID_WRc = XLES_SUBGRID_WRc
- END IF
- IF (LUSERI ) THEN
- X_LES_SUBGRID_Ri2 = XLES_SUBGRID_Ri2
- END IF
- IF (NSV>0 ) THEN
- X_LES_SUBGRID_USv = XLES_SUBGRID_USv
- X_LES_SUBGRID_VSv = XLES_SUBGRID_VSv
- X_LES_SUBGRID_WSv = XLES_SUBGRID_WSv
- X_LES_SUBGRID_Sv2 = XLES_SUBGRID_Sv2
- X_LES_SUBGRID_SvThv = XLES_SUBGRID_SvThv
- X_LES_SUBGRID_W2Sv = XLES_SUBGRID_W2Sv
- X_LES_SUBGRID_WSv2 = XLES_SUBGRID_WSv2
- X_LES_SUBGRID_DISS_Sv2 = XLES_SUBGRID_DISS_Sv2
- X_LES_SUBGRID_SvPz = XLES_SUBGRID_SvPz
- END IF
-!
-!
- CALL LES_ALLOCATE('X_LES_UW0',(/NLES_TIMES/))
- CALL LES_ALLOCATE('X_LES_VW0',(/NLES_TIMES/))
- CALL LES_ALLOCATE('X_LES_USTAR',(/NLES_TIMES/))
- CALL LES_ALLOCATE('X_LES_Q0',(/NLES_TIMES/))
- CALL LES_ALLOCATE('X_LES_E0',(/NLES_TIMES/))
- CALL LES_ALLOCATE('X_LES_SV0',(/NLES_TIMES,NSV/))
-!
- X_LES_UW0 = XLES_UW0
- X_LES_VW0 = XLES_VW0
- X_LES_USTAR = XLES_USTAR
- X_LES_Q0 = XLES_Q0
- X_LES_E0 = XLES_E0
- IF (NSV>0) X_LES_SV0 = XLES_SV0
-
-ELSE
-!
- XLES_RES_W_SBG_WThl = X_LES_RES_W_SBG_WThl
- XLES_RES_W_SBG_Thl2 = X_LES_RES_W_SBG_Thl2
- XLES_RES_ddxa_U_SBG_UaU = X_LES_RES_ddxa_U_SBG_UaU
- XLES_RES_ddxa_V_SBG_UaV = X_LES_RES_ddxa_V_SBG_UaV
- XLES_RES_ddxa_W_SBG_UaW = X_LES_RES_ddxa_W_SBG_UaW
- XLES_RES_ddxa_W_SBG_UaThl = X_LES_RES_ddxa_W_SBG_UaThl
- XLES_RES_ddxa_Thl_SBG_UaW = X_LES_RES_ddxa_Thl_SBG_UaW
- XLES_RES_ddz_Thl_SBG_W2 = X_LES_RES_ddz_Thl_SBG_W2
- XLES_RES_ddxa_Thl_SBG_UaThl = X_LES_RES_ddxa_Thl_SBG_UaThl
- IF (LUSERV) THEN
- XLES_RES_W_SBG_WRt = X_LES_RES_W_SBG_WRt
- XLES_RES_W_SBG_Rt2 = X_LES_RES_W_SBG_Rt2
- XLES_RES_W_SBG_ThlRt = X_LES_RES_W_SBG_ThlRt
- XLES_RES_ddxa_W_SBG_UaRt = X_LES_RES_ddxa_W_SBG_UaRt
- XLES_RES_ddxa_Rt_SBG_UaW = X_LES_RES_ddxa_Rt_SBG_UaW
- XLES_RES_ddz_Rt_SBG_W2 = X_LES_RES_ddz_Rt_SBG_W2
- XLES_RES_ddxa_Thl_SBG_UaRt= X_LES_RES_ddxa_Thl_SBG_UaRt
- XLES_RES_ddxa_Rt_SBG_UaThl= X_LES_RES_ddxa_Rt_SBG_UaThl
- XLES_RES_ddxa_Rt_SBG_UaRt = X_LES_RES_ddxa_Rt_SBG_UaRt
- END IF
- IF (NSV>0) THEN
- XLES_RES_ddxa_W_SBG_UaSv = X_LES_RES_ddxa_W_SBG_UaSv
- XLES_RES_ddxa_Sv_SBG_UaW = X_LES_RES_ddxa_Sv_SBG_UaW
- XLES_RES_ddz_Sv_SBG_W2 = X_LES_RES_ddz_Sv_SBG_W2
- XLES_RES_ddxa_Sv_SBG_UaSv = X_LES_RES_ddxa_Sv_SBG_UaSv
- XLES_RES_W_SBG_WSv = X_LES_RES_W_SBG_WSv
- XLES_RES_W_SBG_Sv2 = X_LES_RES_W_SBG_Sv2
- END IF
- XLES_SUBGRID_U2 = X_LES_SUBGRID_U2
- XLES_SUBGRID_V2 = X_LES_SUBGRID_V2
- XLES_SUBGRID_W2 = X_LES_SUBGRID_W2
- XLES_SUBGRID_Thl2= X_LES_SUBGRID_Thl2
- XLES_SUBGRID_UV = X_LES_SUBGRID_UV
- XLES_SUBGRID_WU = X_LES_SUBGRID_WU
- XLES_SUBGRID_WV = X_LES_SUBGRID_WV
- XLES_SUBGRID_UThl= X_LES_SUBGRID_UThl
- XLES_SUBGRID_VThl= X_LES_SUBGRID_VThl
- XLES_SUBGRID_WThl= X_LES_SUBGRID_WThl
- XLES_SUBGRID_WThv = X_LES_SUBGRID_WThv
- XLES_SUBGRID_ThlThv = X_LES_SUBGRID_ThlThv
- XLES_SUBGRID_W2Thl = X_LES_SUBGRID_W2Thl
- XLES_SUBGRID_WThl2 = X_LES_SUBGRID_WThl2
- XLES_SUBGRID_DISS_Tke = X_LES_SUBGRID_DISS_Tke
- XLES_SUBGRID_DISS_Thl2= X_LES_SUBGRID_DISS_Thl2
- XLES_SUBGRID_WP = X_LES_SUBGRID_WP
- XLES_SUBGRID_PHI3 = X_LES_SUBGRID_PHI3
- XLES_SUBGRID_LMix = X_LES_SUBGRID_LMix
- XLES_SUBGRID_LDiss = X_LES_SUBGRID_LDiss
- XLES_SUBGRID_Km = X_LES_SUBGRID_Km
- XLES_SUBGRID_Kh = X_LES_SUBGRID_Kh
- XLES_SUBGRID_ThlPz = X_LES_SUBGRID_ThlPz
- XLES_SUBGRID_UTke= X_LES_SUBGRID_UTke
- XLES_SUBGRID_VTke= X_LES_SUBGRID_VTke
- XLES_SUBGRID_WTke= X_LES_SUBGRID_WTke
- XLES_SUBGRID_ddz_WTke =X_LES_SUBGRID_ddz_WTke
-
- XLES_SUBGRID_THLUP_MF = X_LES_SUBGRID_THLUP_MF
- XLES_SUBGRID_RTUP_MF = X_LES_SUBGRID_RTUP_MF
- XLES_SUBGRID_RVUP_MF = X_LES_SUBGRID_RVUP_MF
- XLES_SUBGRID_RCUP_MF = X_LES_SUBGRID_RCUP_MF
- XLES_SUBGRID_RIUP_MF = X_LES_SUBGRID_RIUP_MF
- XLES_SUBGRID_WUP_MF = X_LES_SUBGRID_WUP_MF
- XLES_SUBGRID_MASSFLUX = X_LES_SUBGRID_MASSFLUX
- XLES_SUBGRID_DETR = X_LES_SUBGRID_DETR
- XLES_SUBGRID_ENTR = X_LES_SUBGRID_ENTR
- XLES_SUBGRID_FRACUP = X_LES_SUBGRID_FRACUP
- XLES_SUBGRID_THVUP_MF = X_LES_SUBGRID_THVUP_MF
- XLES_SUBGRID_WTHLMF = X_LES_SUBGRID_WTHLMF
- XLES_SUBGRID_WRTMF = X_LES_SUBGRID_WRTMF
- XLES_SUBGRID_WTHVMF = X_LES_SUBGRID_WTHVMF
- XLES_SUBGRID_WUMF = X_LES_SUBGRID_WUMF
- XLES_SUBGRID_WVMF = X_LES_SUBGRID_WVMF
-
- IF (LUSERV ) THEN
- XLES_SUBGRID_Rt2 = X_LES_SUBGRID_Rt2
- XLES_SUBGRID_ThlRt= X_LES_SUBGRID_ThlRt
- XLES_SUBGRID_URt = X_LES_SUBGRID_URt
- XLES_SUBGRID_VRt = X_LES_SUBGRID_VRt
- XLES_SUBGRID_WRt = X_LES_SUBGRID_WRt
- XLES_SUBGRID_RtThv = X_LES_SUBGRID_RtThv
- XLES_SUBGRID_W2Rt = X_LES_SUBGRID_W2Rt
- XLES_SUBGRID_WThlRt = X_LES_SUBGRID_WThlRt
- XLES_SUBGRID_WRt2 = X_LES_SUBGRID_WRt2
- XLES_SUBGRID_DISS_Rt2= X_LES_SUBGRID_DISS_Rt2
- XLES_SUBGRID_DISS_ThlRt= X_LES_SUBGRID_DISS_ThlRt
- XLES_SUBGRID_RtPz = X_LES_SUBGRID_RtPz
- XLES_SUBGRID_PSI3 = X_LES_SUBGRID_PSI3
- END IF
- IF (LUSERC ) THEN
- XLES_SUBGRID_Rc2 = X_LES_SUBGRID_Rc2
- XLES_SUBGRID_URc = X_LES_SUBGRID_URc
- XLES_SUBGRID_VRc = X_LES_SUBGRID_VRc
- XLES_SUBGRID_WRc = X_LES_SUBGRID_WRc
- END IF
- IF (LUSERI ) THEN
- XLES_SUBGRID_Ri2 = X_LES_SUBGRID_Ri2
- END IF
- IF (NSV>0 ) THEN
- XLES_SUBGRID_USv = X_LES_SUBGRID_USv
- XLES_SUBGRID_VSv = X_LES_SUBGRID_VSv
- XLES_SUBGRID_WSv = X_LES_SUBGRID_WSv
- XLES_SUBGRID_Sv2 = X_LES_SUBGRID_Sv2
- XLES_SUBGRID_SvThv = X_LES_SUBGRID_SvThv
- XLES_SUBGRID_W2Sv = X_LES_SUBGRID_W2Sv
- XLES_SUBGRID_WSv2 = X_LES_SUBGRID_WSv2
- XLES_SUBGRID_DISS_Sv2 = X_LES_SUBGRID_DISS_Sv2
- XLES_SUBGRID_SvPz = X_LES_SUBGRID_SvPz
- END IF
- XLES_UW0 = X_LES_UW0
- XLES_VW0 = X_LES_VW0
- XLES_USTAR = X_LES_USTAR
- XLES_Q0 = X_LES_Q0
- XLES_E0 = X_LES_E0
- IF (NSV>0) XLES_SV0 = X_LES_SV0
-!
- CALL LES_DEALLOCATE('X_LES_RES_W_SBG_WThl')
- CALL LES_DEALLOCATE('X_LES_RES_W_SBG_Thl2')
- CALL LES_DEALLOCATE('X_LES_RES_ddxa_U_SBG_UaU')
- CALL LES_DEALLOCATE('X_LES_RES_ddxa_V_SBG_UaV')
- CALL LES_DEALLOCATE('X_LES_RES_ddxa_W_SBG_UaW')
- CALL LES_DEALLOCATE('X_LES_RES_ddxa_W_SBG_UaThl')
- CALL LES_DEALLOCATE('X_LES_RES_ddxa_Thl_SBG_UaW')
- CALL LES_DEALLOCATE('X_LES_RES_ddz_Thl_SBG_W2')
- CALL LES_DEALLOCATE('X_LES_RES_ddxa_Thl_SBG_UaThl')
- CALL LES_DEALLOCATE('X_LES_RES_W_SBG_WRt')
- CALL LES_DEALLOCATE('X_LES_RES_W_SBG_Rt2')
- CALL LES_DEALLOCATE('X_LES_RES_W_SBG_ThlRt')
- CALL LES_DEALLOCATE('X_LES_RES_ddxa_W_SBG_UaRt')
- CALL LES_DEALLOCATE('X_LES_RES_ddxa_Rt_SBG_UaW')
- CALL LES_DEALLOCATE('X_LES_RES_ddz_Rt_SBG_W2')
- CALL LES_DEALLOCATE('X_LES_RES_ddxa_Thl_SBG_UaRt')
- CALL LES_DEALLOCATE('X_LES_RES_ddxa_Rt_SBG_UaThl')
- CALL LES_DEALLOCATE('X_LES_RES_ddxa_Rt_SBG_UaRt')
- CALL LES_DEALLOCATE('X_LES_RES_ddxa_W_SBG_UaSv')
- CALL LES_DEALLOCATE('X_LES_RES_ddxa_Sv_SBG_UaW')
- CALL LES_DEALLOCATE('X_LES_RES_ddz_Sv_SBG_W2')
- CALL LES_DEALLOCATE('X_LES_RES_ddxa_Sv_SBG_UaSv')
- CALL LES_DEALLOCATE('X_LES_RES_W_SBG_WSv')
- CALL LES_DEALLOCATE('X_LES_RES_W_SBG_Sv2')
-!
- CALL LES_DEALLOCATE('X_LES_SUBGRID_U2')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_V2')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_W2')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_Thl2')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_UV')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_WU')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_WV')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_UThl')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_VThl')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_WThl')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_WThv')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_ThlThv')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_W2Thl')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_WThl2')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_DISS_Tke')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_DISS_Thl2')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_WP')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_PHI3')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_LMix')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_LDiss')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_Km')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_Kh')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_ThlPz')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_UTke')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_VTke')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_WTke')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_ddz_WTke')
-
- CALL LES_DEALLOCATE('X_LES_SUBGRID_THLUP_MF')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_RTUP_MF')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_RVUP_MF')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_RCUP_MF')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_RIUP_MF')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_WUP_MF')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_MASSFLUX')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_DETR')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_ENTR')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_FRACUP')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_THVUP_MF')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_WTHLMF')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_WRTMF')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_WTHVMF')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_WUMF')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_WVMF')
-
- CALL LES_DEALLOCATE('X_LES_SUBGRID_Rt2')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_ThlRt')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_URt')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_VRt')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_WRt')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_RtThv')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_W2Rt')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_WThlRt')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_WRt2')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_DISS_Rt2')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_DISS_ThlRt')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_RtPz')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_PSI3')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_Rc2')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_URc')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_VRc')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_WRc')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_Ri2')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_USv')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_VSv')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_WSv')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_Sv2')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_SvThv')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_W2Sv')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_WSv2')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_DISS_Sv2')
- CALL LES_DEALLOCATE('X_LES_SUBGRID_SvPz')
- !
- CALL LES_DEALLOCATE('X_LES_UW0')
- CALL LES_DEALLOCATE('X_LES_VW0')
- CALL LES_DEALLOCATE('X_LES_USTAR')
- CALL LES_DEALLOCATE('X_LES_Q0')
- CALL LES_DEALLOCATE('X_LES_E0')
- CALL LES_DEALLOCATE('X_LES_SV0')
-!
-END IF
-!
-CALL SECOND_MNH(ZTIME2)
-!
-XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
-!
-END SUBROUTINE SWITCH_SBG_LES_n
diff --git a/src/mesonh/ext/to_elec_fieldn.f90 b/src/mesonh/ext/to_elec_fieldn.f90
deleted file mode 100644
index a6822298d897cb7c93e22205048645c57db9da56..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/to_elec_fieldn.f90
+++ /dev/null
@@ -1,184 +0,0 @@
-!MNH_LIC Copyright 2002-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ###########################
- MODULE MODI_TO_ELEC_FIELD_n
-! ###########################
-!
-INTERFACE
- SUBROUTINE TO_ELEC_FIELD_n(PRT, PSVT, PRHODJ, KTCOUNT, KRR, &
- PEFIELDU, PEFIELDV, PEFIELDW, PPHIT)
-!
-INTEGER, INTENT(IN) :: KTCOUNT ! counter value of the
- ! model temporal loop
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Jacobian
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Scalar variables with
- ! electric charge density
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDU ! 3 components
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDV ! of the
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDW ! electric field
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PPHIT ! Electrostatic potential
-
-END SUBROUTINE TO_ELEC_FIELD_n
-END INTERFACE
-END MODULE MODI_TO_ELEC_FIELD_n
-!
-! ###############################################################
- SUBROUTINE TO_ELEC_FIELD_n(PRT, PSVT, PRHODJ, KTCOUNT, KRR, &
- PEFIELDU, PEFIELDV, PEFIELDW, PPHIT)
-! ###############################################################
-!
-!
-!!**** * - compute the electric field
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute...
-!!
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!! None
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! C. Barthe, G. Molinie, J.-P. Pinty *Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 2002
-!! C. Barthe 06/11/09 update to version 4.8.1
-!! M. Chong 26/01/10 Add Small ions
-! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_REF_n, ONLY : XRHODREF
-USE MODD_PARAMETERS, ONLY : JPVEXT
-USE MODD_RAIN_ICE_DESCR_n, ONLY : XRTMIN
-USE MODD_ELEC_DESCR, ONLY : XRELAX_ELEC, XECHARGE
-USE MODD_ELEC_n, ONLY : XESOURCEFW
-!
-USE MODI_ELEC_FIELD_n
-!
-USE MODE_ll
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KTCOUNT ! counter value of the
- ! model temporal loop
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Jacobian
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Scalar variables with
- ! electric charge density
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDU ! 3 components
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDV ! of the
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEFIELDW ! electric field
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PPHIT ! Electrostatic potential
-!
-!
-!* 0.2 Declarations of local variables :
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZW ! work array
-!
-INTEGER :: IIB ! Define
-INTEGER :: IIE ! the
-INTEGER :: IJB ! physical
-INTEGER :: IJE ! domain
-INTEGER :: IKB !
-INTEGER :: IKE !
-INTEGER :: IIU, IJU, IKU
-INTEGER :: II
-INTEGER :: IINFO_ll
-!
-TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. COMPUTE THE LOOP BOUNDS
-! -----------------------
-!
-NULLIFY(TZFIELDS_ll)
-!
-! Compute loop bounds
-!
-CALL GET_PHYSICAL_ll(IIB,IJB,IIE,IJE)
-CALL GET_DIM_EXT_ll('B',IIU,IJU)
-!
-IKB = 1 + JPVEXT
-IKU = SIZE(XESOURCEFW,3)
-IKE = IKU - JPVEXT
-!
-! allocations
-!
-ALLOCATE(ZW(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)))
-ZW(:,:,:) = 0.
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. TRANSFORM PSVT from C/kg INTO C/m3 and SUM
-! ----------------------------------
-!
-DO II = 1, KRR+1
- ZW(:,:,:) = ZW(:,:,:) + PSVT(:,:,:,II) * XRHODREF(:,:,:)
-END DO
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. BOUNDARY CONDITIONS
-! -------------------
-!
-ZW(:,:,1:IKB-1) = 0.0 ! Setup to neutralize the computation on the
- ! first ligne of the tridiagonal system starting
- ! at IKB-1
-ZW(:,:,IKE:IKE+JPVEXT) = XESOURCEFW(:,:,IKE:IKE+JPVEXT)
-!
-CALL ADD3DFIELD_ll( TZFIELDS_ll, ZW, 'TO_ELEC_FIELD_n::ZW' )
-CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
-CALL CLEANLIST_ll(TZFIELDS_ll)
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. COMPUTE THE ELECTRIC FIELD
-! --------------------------
-!
-IF (PRESENT(PPHIT)) THEN
- CALL ELEC_FIELD_n (ZW, KTCOUNT, XRELAX_ELEC, PRHODJ, &
- PEFIELDU, PEFIELDV, PEFIELDW, PPHIT)
-ELSE
- CALL ELEC_FIELD_n (ZW, KTCOUNT, XRELAX_ELEC, PRHODJ, &
- PEFIELDU, PEFIELDV, PEFIELDW)
-ENDIF
-!
-DEALLOCATE(ZW)
-!
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE TO_ELEC_FIELD_n
-
diff --git a/src/mesonh/ext/two_wayn.f90 b/src/mesonh/ext/two_wayn.f90
deleted file mode 100644
index b2299ee4ac537dace171013da289b8b8f0fc0b5b..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/two_wayn.f90
+++ /dev/null
@@ -1,1309 +0,0 @@
-!MNH_LIC Copyright 1997-2020 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ###################
- MODULE MODI_TWO_WAY_n
-! ###################
-!
-INTERFACE
-!
- SUBROUTINE TWO_WAY_n (KRR,KSV,PRHODJ,KMI,PTSTEP, &
- PUM ,PVM, PWM, PTHM, PRM, PSVM, &
- PRUS,PRVS,PRWS,PRTHS,PRRS,PRSVS, &
- PINPRC,PINPRR,PINPRS,PINPRG,PINPRH,PPRCONV,PPRSCONV, &
- PDIRFLASWD,PSCAFLASWD,PDIRSRFSWD,OMASKkids )
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
-INTEGER, INTENT(IN) :: KMI ! Model index
-!
-REAL, INTENT(IN) :: PTSTEP ! Timestep duration
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (Rho) dry * Jacobian
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM, PVM, PWM ! Variables at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM, PSVM
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS ! Source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS, PRSVS ! terms
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC,PINPRR,PINPRS,PINPRG,PINPRH, &
- PPRCONV,PPRSCONV ! precipitating variables
-LOGICAL, DIMENSION(:,:), INTENT(INOUT) :: OMASKkids ! true where kids exist
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDIRFLASWD,PSCAFLASWD ! Long wave radiation
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDIRSRFSWD ! Long wave radiation
-!
-END SUBROUTINE TWO_WAY_n
-!
-END INTERFACE
-!
-END MODULE MODI_TWO_WAY_n
-! #######################################################################
- SUBROUTINE TWO_WAY_n (KRR,KSV,PRHODJ,KMI,PTSTEP, &
- PUM ,PVM, PWM, PTHM, PRM, PSVM, &
- PRUS,PRVS,PRWS,PRTHS,PRRS,PRSVS, &
- PINPRC,PINPRR,PINPRS,PINPRG,PINPRH,PPRCONV,PPRSCONV, &
- PDIRFLASWD,PSCAFLASWD,PDIRSRFSWD,OMASKkids )
-! #######################################################################
-!
-!!**** *TWO_WAY_n* - Relaxation of all fields toward the average value obtained
-!!**** by the nested model $n for TWO_WAY interactive gridnesting
-!!
-!! PURPOSE
-!! -------
-!! The purpose of TWO_WAY_n is:
-!! - first to average the fine scale fields of the inner model $n to
-!! the coarse mesh scale of the present outer model DAD($n).
-!! - second to apply the relaxation toward these average fields over the
-!! intersecting domain
-!
-!
-!!** METHOD
-!! ------
-!! Use a simple top hat horizontal average applied in the inner domain
-!! except in a halo inner band of IHALO width (default value 0).
-!! The relaxation equation writes:
-!! ___ t-1
-!! | \ rhodj * a |
-!! d (RHODJ * A) | t-1 /__ |
-!! -------------- = -K * RHODJ * |A - ----------------- |
-!! dt 2W | ___ |
-!! | \ rhodj |
-!! | /__ |
-!!
-!! In this routine $n denotes the nested model (with all variables X...,N...).
-!! KMI is the number of father model (all variables P..., K...)
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! MODULE MODD_CONF_n : all
-!!
-!! MODULE MODD_NESTING: NDT_2_WAY
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! J. P. Lafore *Meteo-France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 12/11/97
-!! 20/01/98 remove the TKE and EPS change
-!! P. Jabouille 03/04/00 parallelisation
-!! N. Asencio 18/07/05 Add the surface parameters : precipitating
-!! hydrometeors, the Short and Long Wave
-!! + MASKkids array
-!! 20/05/06 Remove EPS
-!! M. Leriche 16/07/10 Add ice phase chemical species
-!! V.Masson, C.Lac 08/10 Corrections in relaxation
-!! J. Escobar 27/06/2011 correction for gridnesting with different SHAPE
-!! Bosseur & Filippi 07/2013 Adds Forefire
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! Modification 01/2016 (JP Pinty) Add LIMA
-! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 29/03/2019: bugfix: use correct sizes for 3rd dimension in allocation and loops when CRAD/='NONE'
-!------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-USE MODE_ll
-USE MODE_MODELN_HANDLER
-!
-USE MODD_PARAMETERS ! Declarative modules
-USE MODD_NESTING
-USE MODD_CONF
-USE MODD_NSV
-USE MODD_PARAM_ICE_n, ONLY : LSEDIC
-USE MODD_PARAM_C2R2, ONLY : LSEDC
-USE MODD_PARAM_LIMA, ONLY : NSEDC => LSEDC
-!
-USE MODD_FIELD_n ! modules relative to the inner (fine scale) model $n
-USE MODD_PRECIP_n , ONLY : XINPRC,XINPRR,XINPRS,XINPRG,XINPRH
-USE MODD_RADIATIONS_n ,ONLY:XDIRFLASWD,XSCAFLASWD,XDIRSRFSWD
-USE MODD_DEEP_CONVECTION_n ,ONLY : XPRCONV,XPRSCONV
-USE MODD_REF_n
-USE MODD_CONF_n
-USE MODD_PARAM_n
-USE MODI_SHUMAN
-!
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-INTEGER, INTENT(IN) :: KSV ! Number of SV (father model)
-INTEGER, INTENT(IN) :: KMI ! Model index
-!
-REAL, INTENT(IN) :: PTSTEP ! Timestep duration
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (Rho) dry * Jacobian
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM, PVM, PWM ! Variables at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM, PSVM
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS ! Source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS, PRSVS ! terms
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC,PINPRR,PINPRS,PINPRG,PINPRH &
- ,PPRCONV,PPRSCONV ! precipitating variables
-LOGICAL, DIMENSION(:,:), INTENT(INOUT) :: OMASKkids ! true where kids exist
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDIRFLASWD,PSCAFLASWD ! Long wave radiation
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDIRSRFSWD ! Long wave radiation
-!
-!* 0.2 declarations of local variables
-!
-!
-INTEGER :: IIB,IJB,IIE,IJE
-INTEGER :: IKU,IKB
-INTEGER :: II1,II2,IJ1,IJ2,II1U,IJ1V,IWEST,ISOUTH,IDIST
-INTEGER :: IXOR,IXEND ! horizontal position (i,j) of the ORigin and END
-INTEGER :: IYOR,IYEND ! of the inner model $n domain, relative to outer model subdomain
-INTEGER :: IXORU,IYORV ! particular case dure to C grid
-INTEGER :: IDXRATIO,IDYRATIO ! x and y-direction resolution RATIO
-INTEGER :: IXOR_ll,IYOR_ll ! origin's coordinates of extended subdomain
-INTEGER :: IXDIM,IYDIM ! size of the extended dad subdomain
-!
-INTEGER :: JX,JY,JVAR ! loop index
-INTEGER :: IRR,ISV_USER ! number of moist and scalar var commun to both models
-!
-REAL :: ZK2W ! Relaxation value
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZAVE_RHODJ
-!
-! intermediate arrays for model communication
-REAL, DIMENSION(:, :, :), ALLOCATABLE :: ZTUM, ZTVM, ZTWM, ZTTHM
-REAL, DIMENSION(:, :, :, :), ALLOCATABLE :: ZTRM, ZTSVM
-REAL, DIMENSION(:, :, :), ALLOCATABLE :: ZUM, ZVM, ZWM, ZTHM
-REAL, DIMENSION(:, :, :, :), ALLOCATABLE :: ZRM, ZSVM
-REAL, DIMENSION(:, :, :), ALLOCATABLE :: ZTRHODJ, ZTRHODJU, ZTRHODJV
-REAL, DIMENSION(:, :, :), ALLOCATABLE :: ZRHODJ, ZRHODJU, ZRHODJV
-REAL, DIMENSION(:, :), ALLOCATABLE ::ZTINPRC,ZTINPRR,ZTINPRS,ZTINPRG,ZTINPRH,&
- ZTPRCONV,ZTPRSCONV
-REAL, DIMENSION(:, :,:), ALLOCATABLE :: ZTDIRFLASWD,ZTSCAFLASWD
-REAL, DIMENSION(:, :,:), ALLOCATABLE :: ZTDIRSRFSWD
-REAL, DIMENSION(:, :), ALLOCATABLE ::ZINPRC,ZINPRR,ZINPRS,ZINPRG,ZINPRH,&
- ZPRCONV,ZPRSCONV
-REAL, DIMENSION(:, :,:), ALLOCATABLE :: ZDIRFLASWD,ZSCAFLASWD
-REAL, DIMENSION(:, :,:), ALLOCATABLE :: ZDIRSRFSWD
-!
-INTEGER :: IINFO_ll, IDIMX, IDIMY ! size of intermediate arrays
-INTEGER :: IHALO ! band size where relaxation is not performed
-LOGICAL :: LINTER ! flag for intersection or not with the child domain
-INTEGER :: IMI ! Current model index KMI==NDAD(IMI)
-!
-INTEGER :: IIBC,IJBC,IIEC,IJEC
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. PROLOGUE:
-!
-IMI = GET_CURRENT_MODEL_INDEX()
-!
-CALL GO_TOMODEL_ll(IMI, IINFO_ll)
-CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
-!
-CALL GO_TOMODEL_ll(KMI, IINFO_ll)
-CALL GET_CHILD_DIM_ll(IMI, IDIMX, IDIMY, IINFO_ll)
-!
-! here we need to go back to SON domain for boundaries test
-CALL GO_TOMODEL_ll(IMI, IINFO_ll)
-!
-IKU = SIZE(PTHM,3)
-IKB = JPVEXT+1
-!
-IDXRATIO = NDXRATIO_ALL(IMI)
-IDYRATIO = NDYRATIO_ALL(IMI)
-!
-IRR = MIN(KRR,NRR)
-ISV_USER = MIN(NSV_USER_A(KMI),NSV_USER_A(IMI))
-!
-! 1.1 Allocate array of horizontal average fields
-!
-ALLOCATE(ZTUM(IDIMX, IDIMY, SIZE(PUM, 3)))
-ALLOCATE(ZTVM(IDIMX, IDIMY, SIZE(PUM, 3)))
-ALLOCATE(ZTWM(IDIMX, IDIMY, SIZE(PUM, 3)))
-ALLOCATE(ZTTHM(IDIMX, IDIMY, SIZE(PUM, 3)))
-IF (IRR /= 0) THEN
- ALLOCATE(ZTRM(IDIMX, IDIMY, SIZE(PUM, 3),IRR))
- ELSE
- ALLOCATE(ZTRM(0,0,0,0))
-ENDIF
-IF (KSV /= 0) THEN
- ALLOCATE(ZTSVM(IDIMX, IDIMY, SIZE(PUM, 3),KSV))
-ELSE
- ALLOCATE(ZTSVM(0,0,0,0))
-ENDIF
-!
-IF (LUSERC .AND. ( (LSEDIC .AND. CCLOUD(1:3) == 'ICE') .OR. &
- (LSEDC .AND. (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO')) .OR.&
- (NSEDC .AND. CCLOUD == 'LIMA') )) THEN
- ALLOCATE(ZTINPRC(IDIMX, IDIMY))
-ELSE
- ALLOCATE(ZTINPRC(0,0))
-ENDIF
-IF (LUSERR) THEN
- ALLOCATE(ZTINPRR(IDIMX, IDIMY))
-ELSE
- ALLOCATE(ZTINPRR(0,0))
-ENDIF
-IF (LUSERS) THEN
- ALLOCATE(ZTINPRS(IDIMX, IDIMY))
-ELSE
- ALLOCATE(ZTINPRS(0,0))
-ENDIF
-IF (LUSERG) THEN
- ALLOCATE(ZTINPRG(IDIMX, IDIMY))
-ELSE
- ALLOCATE(ZTINPRG(0,0))
-ENDIF
-IF (LUSERH) THEN
- ALLOCATE(ZTINPRH(IDIMX, IDIMY))
-ELSE
- ALLOCATE(ZTINPRH(0,0))
-ENDIF
-IF (CDCONV /= 'NONE') THEN
- ALLOCATE(ZTPRCONV (IDIMX, IDIMY))
- ALLOCATE(ZTPRSCONV(IDIMX, IDIMY))
- ELSE
- ALLOCATE(ZTPRCONV (0,0))
- ALLOCATE(ZTPRSCONV(0,0))
-END IF
-IF (CRAD /= 'NONE') THEN
- ALLOCATE(ZTDIRFLASWD(IDIMX, IDIMY, SIZE(PDIRFLASWD,3)))
- ALLOCATE(ZTSCAFLASWD(IDIMX, IDIMY, SIZE(PSCAFLASWD,3)))
- ALLOCATE(ZTDIRSRFSWD(IDIMX, IDIMY, SIZE(PDIRSRFSWD,3)))
-ELSE
- ALLOCATE(ZTDIRFLASWD(0,0,0))
- ALLOCATE(ZTSCAFLASWD(0,0,0))
- ALLOCATE(ZTDIRSRFSWD(0,0,0))
-ENDIF
-!
-ALLOCATE(ZTRHODJ (IDIMX, IDIMY, SIZE(PUM, 3)))
-ALLOCATE(ZTRHODJU(IDIMX, IDIMY, SIZE(PUM, 3)))
-ALLOCATE(ZTRHODJV(IDIMX, IDIMY, SIZE(PUM, 3)))
-!
-!
-ZK2W = 1. / (PTSTEP * NDT_2_WAY(NDAD(IMI)))
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. AVERAGE OF SCALAR VARIABLES
-! ---------------------------
-!
-IIBC=JPHEXT+2
-IIEC=IDIMX-JPHEXT-1
-IJBC=JPHEXT+2
-IJEC=IDIMY-JPHEXT-1
-!
-!* 2.1 summation of rhodj
-!
-ZTRHODJ(:,:,:) = 0.
-DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTRHODJ(IIBC:IIEC,IJBC:IJEC,:) = ZTRHODJ(IIBC:IIEC,IJBC:IJEC,:) &
- +XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)
- END DO
-END DO
-!
-!* 2.2 temperature
-!
-ZTTHM(:,:,:) = 0.
-DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTTHM(IIBC:IIEC,IJBC:IJEC,:) = ZTTHM(IIBC:IIEC,IJBC:IJEC,:) &
- +XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:) &
- *XTHT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)
-!
- END DO
-END DO
-!
-!
-!* 2.5 moist variables
-!
-DO JVAR=1,IRR
- ZTRM(:,:,:,JVAR) = 0.
- DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTRM(IIBC:IIEC,IJBC:IJEC,:,JVAR) = ZTRM(IIBC:IIEC,IJBC:IJEC,:,JVAR) &
- +XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:) &
- *XRT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR)
- END DO
- END DO
-END DO
-!
-!* 2.6 scalar variables SV
-!
-! User scalar variables
-IF (KSV /= 0) THEN
- DO JVAR=1,ISV_USER
- ZTSVM(:,:,:,JVAR) = 0.
- DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR) = ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR) &
- +XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:) &
- *XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR)
- END DO
- END DO
- END DO
-! C2R2 scalar variables
-IF (NSV_C2R2_A(IMI) > 0) THEN
- ! nested model uses C2R2 microphysical scheme
- DO JVAR=1,NSV_C2R2_A(KMI)
- ZTSVM(:,:,:,JVAR-1+NSV_C2R2BEG_A(KMI)) = 0.
- DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_C2R2BEG_A(KMI)) = &
- &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_C2R2BEG_A(KMI))+&
- &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_C2R2BEG_A(IMI))
- END DO
- END DO
- END DO
-END IF
-! C1R3 scalar variables
-IF (NSV_C1R3_A(IMI) > 0) THEN
- ! nested model uses C1R3 microphysical scheme
- DO JVAR=1,NSV_C1R3_A(KMI)
- ZTSVM(:,:,:,JVAR-1+NSV_C1R3BEG_A(KMI)) = 0.
- DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_C1R3BEG_A(KMI)) = &
- &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_C1R3BEG_A(KMI))+&
- &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_C1R3BEG_A(IMI))
- END DO
- END DO
- END DO
-END IF
-! LIMA scalar variables
-IF (NSV_LIMA_A(IMI) > 0) THEN
- ! nested model uses LIMA microphysical scheme
- DO JVAR=1,NSV_LIMA_A(KMI)
- ZTSVM(:,:,:,JVAR-1+NSV_LIMA_BEG_A(KMI)) = 0.
- DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_LIMA_BEG_A(KMI)) = &
- &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_LIMA_BEG_A(KMI))+&
- &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_LIMA_BEG_A(IMI))
- END DO
- END DO
- END DO
-END IF
-! Electrical scalar variables
-IF (NSV_ELEC_A(IMI) > 0) THEN
- ! nested model uses electrical scheme
- DO JVAR=1,NSV_ELEC_A(KMI)
- ZTSVM(:,:,:,JVAR-1+NSV_ELECBEG_A(KMI)) = 0.
- DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_ELECBEG_A(KMI)) = &
- &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_ELECBEG_A(KMI))+&
- &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_ELECBEG_A(IMI))
- END DO
- END DO
- END DO
-END IF
-! Chemical scalar variables
-DO JVAR=1,NSV_CHEM_A(KMI)
- ZTSVM(:,:,:,JVAR-1+NSV_CHEMBEG_A(KMI)) = 0.
- DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_CHEMBEG_A(KMI)) = &
- &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_CHEMBEG_A(KMI))+&
- &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_CHEMBEG_A(IMI))
- END DO
- END DO
-END DO
-! Ice phase chemical scalar variables
-IF (NSV_CHIC_A(IMI) > 0) THEN
- ! nested model uses aqueous chemistry and ice3/4 scheme
- DO JVAR=1,NSV_CHIC_A(KMI)
- ZTSVM(:,:,:,JVAR-1+NSV_CHICBEG_A(KMI)) = 0.
- DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_CHICBEG_A(KMI)) = &
- &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_CHICBEG_A(KMI))+&
- &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_CHICBEG_A(IMI))
- END DO
- END DO
- END DO
-END IF
-! NOX variables
-DO JVAR=1,NSV_LNOX_A(KMI)
- ZTSVM(:,:,:,JVAR-1+NSV_LNOXBEG_A(KMI)) = 0.
- DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_LNOXBEG_A(KMI)) = &
- &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_LNOXBEG_A(KMI))+&
- &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_LNOXBEG_A(IMI))
- END DO
- END DO
-END DO
-! Orilam scalar variables
-DO JVAR=1,NSV_AER_A(KMI)
- ZTSVM(:,:,:,JVAR-1+NSV_AERBEG_A(KMI)) = 0.
- DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_AERBEG_A(KMI)) = &
- &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_AERBEG_A(KMI))+&
- &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_AERBEG_A(IMI))
- END DO
- END DO
-END DO
-DO JVAR=1,NSV_AERDEP_A(KMI)
- ZTSVM(:,:,:,JVAR-1+NSV_AERDEPBEG_A(KMI)) = 0.
- DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_AERDEPBEG_A(KMI)) = &
- &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_AERDEPBEG_A(KMI))+&
- &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_AERDEPBEG_A(IMI))
- END DO
- END DO
-END DO
-! Dust scalar variables
-DO JVAR=1,NSV_DST_A(KMI)
- ZTSVM(:,:,:,JVAR-1+NSV_DSTBEG_A(KMI)) = 0.
- DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_DSTBEG_A(KMI)) = &
- &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_DSTBEG_A(KMI))+&
- &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_DSTBEG_A(IMI))
- END DO
- END DO
-END DO
-DO JVAR=1,NSV_DSTDEP_A(KMI)
- ZTSVM(:,:,:,JVAR-1+NSV_DSTDEPBEG_A(KMI)) = 0.
- DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_DSTDEPBEG_A(KMI)) = &
- &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_DSTDEPBEG_A(KMI))+&
- &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_DSTDEPBEG_A(IMI))
- END DO
- END DO
-END DO
-! Salt scalar variables
-DO JVAR=1,NSV_SLT_A(KMI)
- ZTSVM(:,:,:,JVAR-1+NSV_SLTBEG_A(KMI)) = 0.
- DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_SLTBEG_A(KMI)) = &
- &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_SLTBEG_A(KMI))+&
- &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_SLTBEG_A(IMI))
- END DO
- END DO
-END DO
-DO JVAR=1,NSV_SLTDEP_A(KMI)
- ZTSVM(:,:,:,JVAR-1+NSV_SLTDEPBEG_A(KMI)) = 0.
- DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_SLTDEPBEG_A(KMI)) = &
- &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_SLTDEPBEG_A(KMI))+&
- &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_SLTDEPBEG_A(IMI))
- END DO
- END DO
-END DO
-! lagrangian variables
-DO JVAR=1,NSV_LG_A(KMI)
- ZTSVM(:,:,:,JVAR-1+NSV_LGBEG_A(KMI)) = 0.
- DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_LGBEG_A(KMI)) = &
- &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_LGBEG_A(KMI))+&
- &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_LGBEG_A(IMI))
- END DO
- END DO
-END DO
-END IF
-! Passive scalar variables
-IF (NSV_PP_A(IMI) > 0) THEN
-DO JVAR=1,NSV_PP_A(KMI)
- ZTSVM(:,:,:,JVAR-1+NSV_PPBEG_A(KMI)) = 0.
- DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_PPBEG_A(KMI)) = &
- &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_PPBEG_A(KMI))+&
- &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_PPBEG_A(IMI))
- END DO
- END DO
-END DO
-END IF
-#ifdef MNH_FOREFIRE
-! ForeFire variables
-IF (NSV_FF_A(IMI) > 0) THEN
-DO JVAR=1,NSV_FF_A(KMI)
- ZTSVM(:,:,:,JVAR-1+NSV_FFBEG_A(KMI)) = 0.
- DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_FFBEG_A(KMI)) = &
- &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_FFBEG_A(KMI))+&
- &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_FFBEG_A(IMI))
- END DO
- END DO
-END DO
-END IF
-#endif
-! Conditional sampling variables
-IF (NSV_CS_A(IMI) > 0) THEN
-DO JVAR=1,NSV_CS_A(KMI)
- ZTSVM(:,:,:,JVAR-1+NSV_CSBEG_A(KMI)) = 0.
- DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_CSBEG_A(KMI)) = &
- &ZTSVM(IIBC:IIEC,IJBC:IJEC,:,JVAR-1+NSV_CSBEG_A(KMI))+&
- &XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)*&
- &XSVT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:,JVAR-1+NSV_CSBEG_A(IMI))
- END DO
- END DO
-END DO
-END IF
-! Precipitating variables
- IF (LUSERR) THEN
- ZTINPRR(:,:) = 0.
- DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTINPRR(IIBC:IIEC,IJBC:IJEC) = ZTINPRR(IIBC:IIEC,IJBC:IJEC) &
- +XINPRR(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO)
- END DO
- END DO
- ZTINPRR(IIBC:IIEC,IJBC:IJEC)=ZTINPRR(IIBC:IIEC,IJBC:IJEC)/(IDXRATIO*IDYRATIO)
- END IF
-!
- IF (LUSERC .AND. ((LSEDIC .AND. CCLOUD(1:3) == 'ICE') .OR. &
- (LSEDC .AND. (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO')) .OR.&
- (NSEDC .AND. CCLOUD == 'LIMA') )) THEN
- ZTINPRC(:,:) = 0.
- DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTINPRC(IIBC:IIEC,IJBC:IJEC) = ZTINPRC(IIBC:IIEC,IJBC:IJEC) &
- +XINPRC(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO)
- END DO
- END DO
- ZTINPRC(IIBC:IIEC,IJBC:IJEC)=ZTINPRC(IIBC:IIEC,IJBC:IJEC)/(IDXRATIO*IDYRATIO)
- END IF
-!
- IF (LUSERS) THEN
- ZTINPRS(:,:) = 0.
- DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTINPRS(IIBC:IIEC,IJBC:IJEC) = ZTINPRS(IIBC:IIEC,IJBC:IJEC) &
- +XINPRS(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO)
- END DO
- END DO
- ZTINPRS(IIBC:IIEC,IJBC:IJEC) = ZTINPRS(IIBC:IIEC,IJBC:IJEC)/(IDXRATIO*IDYRATIO)
- END IF
-!
- IF (LUSERG) THEN
- ZTINPRG(:,:) = 0.
- DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTINPRG(IIBC:IIEC,IJBC:IJEC) = ZTINPRG(IIBC:IIEC,IJBC:IJEC) &
- +XINPRG(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO)
- END DO
- END DO
- ZTINPRG(IIBC:IIEC,IJBC:IJEC) =ZTINPRG(IIBC:IIEC,IJBC:IJEC)/(IDXRATIO*IDYRATIO)
- END IF
-!
- IF (LUSERH) THEN
- ZTINPRH(:,:) = 0.
- DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTINPRH(IIBC:IIEC,IJBC:IJEC) = ZTINPRH(IIBC:IIEC,IJBC:IJEC) &
- +XINPRH(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO)
- END DO
- END DO
- ZTINPRH(IIBC:IIEC,IJBC:IJEC) =ZTINPRH(IIBC:IIEC,IJBC:IJEC)/(IDXRATIO*IDYRATIO)
- END IF
-!
- IF (CDCONV /= 'NONE') THEN
- ZTPRCONV(:,:) = 0.
- ZTPRSCONV(:,:) = 0.
- DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTPRCONV(IIBC:IIEC,IJBC:IJEC) = ZTPRCONV(IIBC:IIEC,IJBC:IJEC) &
- +XPRCONV(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO)
- ZTPRSCONV(IIBC:IIEC,IJBC:IJEC) = ZTPRSCONV(IIBC:IIEC,IJBC:IJEC) &
- +XPRSCONV(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO)
- END DO
- END DO
- ZTPRCONV(IIBC:IIEC,IJBC:IJEC) = ZTPRCONV(IIBC:IIEC,IJBC:IJEC)/(IDXRATIO*IDYRATIO)
- ZTPRSCONV(IIBC:IIEC,IJBC:IJEC) = ZTPRSCONV(IIBC:IIEC,IJBC:IJEC)/(IDXRATIO*IDYRATIO)
- END IF
-! Short Wave and Long Wave variables
- IF (CRAD /= 'NONE') THEN
- ZTDIRFLASWD(:,:,:) = 0.
- ZTSCAFLASWD(:,:,:) = 0.
- ZTDIRSRFSWD(:,:,:) = 0.
- DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTDIRFLASWD(IIBC:IIEC,IJBC:IJEC,:) = ZTDIRFLASWD(IIBC:IIEC,IJBC:IJEC,:)&
- +XDIRFLASWD(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)
- ZTSCAFLASWD(IIBC:IIEC,IJBC:IJEC,:) = ZTSCAFLASWD(IIBC:IIEC,IJBC:IJEC,:)&
- +XSCAFLASWD(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)
- ZTDIRSRFSWD(IIBC:IIEC,IJBC:IJEC,:) = ZTDIRSRFSWD(IIBC:IIEC,IJBC:IJEC,:)&
- +XDIRSRFSWD(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,:)
- END DO
- END DO
- ZTDIRFLASWD(IIBC:IIEC,IJBC:IJEC,:) = ZTDIRFLASWD(IIBC:IIEC,IJBC:IJEC,:)/(IDXRATIO*IDYRATIO)
- ZTSCAFLASWD(IIBC:IIEC,IJBC:IJEC,:) = ZTSCAFLASWD(IIBC:IIEC,IJBC:IJEC,:)/(IDXRATIO*IDYRATIO)
- ZTDIRSRFSWD(IIBC:IIEC,IJBC:IJEC,:) = ZTDIRSRFSWD(IIBC:IIEC,IJBC:IJEC,:)/(IDXRATIO*IDYRATIO)
- END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. AVERAGE OF WIND VARIABLES
-! -------------------------
-!
-!* 3.1 vertical wind W
-!
-ZTWM(:,:,:) = 0.
-DO JX=1,IDXRATIO
- DO JY=1,IDYRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTWM(IIBC:IIEC,IJBC:IJEC,IKB) = ZTWM(IIBC:IIEC,IJBC:IJEC,IKB) &
- +2.*XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,IKB) &
- *XWT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,IKB)
-!
- ZTWM(IIBC:IIEC,IJBC:IJEC,IKB+1:IKU) = ZTWM(IIBC:IIEC,IJBC:IJEC,IKB+1:IKU) &
- +(XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,IKB+1:IKU ) &
- + XRHODJ(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,IKB :IKU-1))&
- *XWT(II1:II2:IDXRATIO,IJ1:IJ2:IDYRATIO,IKB+1:IKU)
- END DO
-END DO
-!
-!* 3.2 horizontal wind U
-!
-ZTRHODJU(:,:,:) = 0.
-!
-IF(LWEST_ll()) THEN
- II1U = IIB+IDXRATIO !C grid
- IWEST=JPHEXT+3
-ELSE
- II1U = IIB
- IWEST=JPHEXT+2
-ENDIF
-!
-II2 = IIE+1-IDXRATIO
-!
-DO JY=1,IDYRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTRHODJU(IWEST:IIEC,IJBC:IJEC,:) = ZTRHODJU(IWEST:IIEC,IJBC:IJEC,:) &
- +XRHODJ(II1U :II2 :IDXRATIO,IJ1:IJ2:IDYRATIO,:) &
- +XRHODJ(II1U-1:II2-1:IDXRATIO,IJ1:IJ2:IDYRATIO,:)
-END DO
-!
-!
-ZTUM(:,:,:) = 0.
-DO JY=1,IDYRATIO
- IJ1 = IJB+JY-1
- IJ2 = IJE+JY-IDYRATIO
- ZTUM(IWEST:IIEC,IJBC:IJEC,:) = ZTUM(IWEST:IIEC,IJBC:IJEC,:) &
- +(XRHODJ(II1U :II2 :IDXRATIO,IJ1:IJ2:IDYRATIO,:) &
- +XRHODJ(II1U-1:II2-1:IDXRATIO,IJ1:IJ2:IDYRATIO,:)) &
- *XUT(II1U :II2 :IDXRATIO,IJ1:IJ2:IDYRATIO,:)
-END DO
-!
-!
-!* 3.3 horizontal wind V
-!
-ZTRHODJV(:,:,:) = 0.
-!
-IF(LSOUTH_ll() .AND. .NOT. L2D) THEN
- IJ1V = IJB+IDYRATIO !C grid
- ISOUTH=JPHEXT+3
-ELSE
- IJ1V = IJB
- ISOUTH=JPHEXT+2
-ENDIF
-!
-IJ2 = IJE+1-IDYRATIO
-!
-DO JX=1,IDXRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- ZTRHODJV(IIBC:IIEC,ISOUTH:IJEC,:) = ZTRHODJV(IIBC:IIEC,ISOUTH:IJEC,:) &
- +XRHODJ(II1:II2:IDXRATIO,IJ1V :IJ2 :IDYRATIO,:) &
- +XRHODJ(II1:II2:IDXRATIO,IJ1V-1:IJ2-1:IDYRATIO,:)
-END DO
-!
-!
-ZTVM(:,:,:) = 0.
-DO JX=1,IDXRATIO
- II1 = IIB+JX-1
- II2 = IIE+JX-IDXRATIO
- ZTVM(IIBC:IIEC,ISOUTH:IJEC,:) = ZTVM(IIBC:IIEC,ISOUTH:IJEC,:) &
- +(XRHODJ(II1:II2:IDXRATIO,IJ1V :IJ2 :IDYRATIO,:) &
- + XRHODJ(II1:II2:IDXRATIO,IJ1V-1:IJ2-1:IDYRATIO,:)) &
- *XVT(II1:II2:IDXRATIO,IJ1V :IJ2 :IDYRATIO,:)
-END DO
-!
-!
-!* 4. EXCHANGE OF DATA
-! ----------------
-!
-!
-CALL GO_TOMODEL_ll(IMI, IINFO_ll)
-CALL GET_FEEDBACK_COORD_ll(IXOR,IYOR,IXEND,IYEND,IINFO_ll) ! physical domain's origine
-!
-!
-IF (IINFO_ll == 0) THEN
- LINTER=.TRUE.
-ELSE
- LINTER=.FALSE.
-ENDIF
-!
-! Allocate array which will receive average child fields
-!
-IF (LINTER) THEN
- ALLOCATE(ZUM(IXOR:IXEND,IYOR:IYEND, SIZE(PUM, 3)))
- ALLOCATE(ZVM(IXOR:IXEND,IYOR:IYEND, SIZE(PUM, 3)))
- ALLOCATE(ZWM(IXOR:IXEND,IYOR:IYEND, SIZE(PUM, 3)))
- ALLOCATE(ZTHM(IXOR:IXEND,IYOR:IYEND, SIZE(PUM, 3)))
- ALLOCATE(ZRHODJ (IXOR:IXEND,IYOR:IYEND, SIZE(PUM, 3)))
- ALLOCATE(ZRHODJU(IXOR:IXEND,IYOR:IYEND, SIZE(PUM, 3)))
- ALLOCATE(ZRHODJV(IXOR:IXEND,IYOR:IYEND, SIZE(PUM, 3)))
- IF (IRR /= 0) THEN
- ALLOCATE(ZRM(IXOR:IXEND,IYOR:IYEND, SIZE(PUM, 3),IRR))
- END IF
- IF (KSV /= 0) THEN
- ALLOCATE(ZSVM(IXOR:IXEND,IYOR:IYEND, SIZE(PUM, 3),KSV))
- ENDIF
- IF (LUSERR) THEN
- ALLOCATE(ZINPRR(IXOR:IXEND,IYOR:IYEND))
- ELSE
- ALLOCATE(ZINPRR(0,0))
- END IF
- IF (LUSERC .AND. ((LSEDIC .AND. CCLOUD(1:3) == 'ICE') .OR. &
- (LSEDC .AND. (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO')) .OR.&
- (NSEDC .AND. CCLOUD == 'LIMA') )) THEN
- ALLOCATE(ZINPRC(IXOR:IXEND,IYOR:IYEND))
- ELSE
- ALLOCATE(ZINPRC(0,0))
- END IF
- IF (LUSERS) THEN
- ALLOCATE(ZINPRS(IXOR:IXEND,IYOR:IYEND))
- ELSE
- ALLOCATE(ZINPRS(0,0))
- END IF
- IF (LUSERG) THEN
- ALLOCATE(ZINPRG(IXOR:IXEND,IYOR:IYEND))
- ELSE
- ALLOCATE(ZINPRG(0,0))
- END IF
- IF (LUSERH) THEN
- ALLOCATE(ZINPRH(IXOR:IXEND,IYOR:IYEND))
- ELSE
- ALLOCATE(ZINPRH(0,0))
- END IF
- IF (CDCONV /= 'NONE') THEN
- ALLOCATE(ZPRCONV(IXOR:IXEND,IYOR:IYEND))
- ALLOCATE(ZPRSCONV(IXOR:IXEND,IYOR:IYEND))
- ELSE
- ALLOCATE(ZPRCONV(0,0))
- ALLOCATE(ZPRSCONV(0,0))
- END IF
- IF (CRAD /= 'NONE') THEN
- ALLOCATE(ZDIRFLASWD(IXOR:IXEND,IYOR:IYEND, SIZE(PDIRFLASWD, 3)))
- ALLOCATE(ZSCAFLASWD(IXOR:IXEND,IYOR:IYEND, SIZE(PSCAFLASWD, 3)))
- ALLOCATE(ZDIRSRFSWD(IXOR:IXEND,IYOR:IYEND, SIZE(PDIRSRFSWD, 3)))
- ELSE
- !3rd dimension size can also be allocated with a zero size
- ALLOCATE( ZDIRFLASWD(0, 0, SIZE( PDIRFLASWD, 3 )) )
- ALLOCATE( ZSCAFLASWD(0, 0, SIZE( PSCAFLASWD, 3 )) )
- ALLOCATE( ZDIRSRFSWD(0, 0, SIZE( PDIRSRFSWD, 3 )) )
- ENDIF
-ELSE
- ALLOCATE(ZUM(0,0,0))
- ALLOCATE(ZVM(0,0,0))
- ALLOCATE(ZWM(0,0,0))
- ALLOCATE(ZTHM(0,0,0))
- IF (IRR /= 0) ALLOCATE(ZRM(0,0,0,IRR))
- IF (KSV /= 0) ALLOCATE(ZSVM(0,0,0,KSV))
- ALLOCATE(ZRHODJ (0,0,0))
- ALLOCATE(ZRHODJU(0,0,0))
- ALLOCATE(ZRHODJV(0,0,0))
- ALLOCATE(ZINPRC(0,0))
- ALLOCATE(ZINPRR(0,0))
- ALLOCATE(ZINPRS(0,0))
- ALLOCATE(ZINPRG(0,0))
- ALLOCATE(ZINPRH(0,0))
- ALLOCATE(ZPRCONV(0,0))
- ALLOCATE(ZPRSCONV(0,0))
- !3rd dimension of ZDIRFLASWD, ZSCAFLASWD and ZDIRSRFSWD is allocated with a not necessarily zero size
- !because it needs to be to this size for the SET_LSFIELD_2WAY_ll loops if CRAD/='NONE'
- ALLOCATE( ZDIRFLASWD(0, 0, SIZE( PDIRFLASWD, 3 )) )
- ALLOCATE( ZSCAFLASWD(0, 0, SIZE( PSCAFLASWD, 3 )) )
- ALLOCATE( ZDIRSRFSWD(0, 0, SIZE( PDIRSRFSWD, 3 )) )
-ENDIF
-!
-! Initialize the list for the forcing
-!
-CALL SET_LSFIELD_2WAY_ll(ZUM, ZTUM)
-CALL SET_LSFIELD_2WAY_ll(ZVM, ZTVM)
-CALL SET_LSFIELD_2WAY_ll(ZWM, ZTWM)
-CALL SET_LSFIELD_2WAY_ll(ZTHM, ZTTHM)
-DO JVAR=1,IRR
- CALL SET_LSFIELD_2WAY_ll(ZRM(:,:,:,JVAR), ZTRM(:,:,:,JVAR))
-ENDDO
-DO JVAR=1,KSV
- CALL SET_LSFIELD_2WAY_ll(ZSVM(:,:,:,JVAR), ZTSVM(:,:,:,JVAR))
-ENDDO
-IF (LUSERR) THEN
- CALL SET_LSFIELD_2WAY_ll(ZINPRR , ZTINPRR)
-END IF
-!
-IF (LUSERC .AND. ((LSEDIC .AND. CCLOUD(1:3) == 'ICE') .OR. &
- (LSEDC .AND. (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO')) .OR.&
- (NSEDC .AND. CCLOUD == 'LIMA') )) THEN
- CALL SET_LSFIELD_2WAY_ll(ZINPRC , ZTINPRC)
-END IF
-IF (LUSERS) THEN
- CALL SET_LSFIELD_2WAY_ll(ZINPRS , ZTINPRS)
-END IF
-IF (LUSERG) THEN
- CALL SET_LSFIELD_2WAY_ll(ZINPRG , ZTINPRG)
-END IF
-IF (LUSERH) THEN
- CALL SET_LSFIELD_2WAY_ll(ZINPRH , ZTINPRH)
-END IF
-IF (CDCONV /= 'NONE') THEN
- CALL SET_LSFIELD_2WAY_ll(ZPRCONV , ZTPRCONV)
- CALL SET_LSFIELD_2WAY_ll(ZPRSCONV , ZTPRSCONV)
-END IF
-IF (CRAD /= 'NONE') THEN
- DO JVAR = 1, SIZE( PDIRFLASWD, 3 )
- CALL SET_LSFIELD_2WAY_ll(ZDIRFLASWD(:,:,JVAR) , ZTDIRFLASWD(:,:,JVAR))
- END DO
- DO JVAR = 1, SIZE( PSCAFLASWD, 3 )
- CALL SET_LSFIELD_2WAY_ll(ZSCAFLASWD(:,:,JVAR) , ZTSCAFLASWD(:,:,JVAR))
- END DO
- DO JVAR = 1, SIZE( PDIRSRFSWD, 3 )
- CALL SET_LSFIELD_2WAY_ll(ZDIRSRFSWD(:,:,JVAR) , ZTDIRSRFSWD(:,:,JVAR))
- END DO
-END IF
-CALL SET_LSFIELD_2WAY_ll(ZRHODJ, ZTRHODJ)
-CALL SET_LSFIELD_2WAY_ll(ZRHODJU, ZTRHODJU)
-CALL SET_LSFIELD_2WAY_ll(ZRHODJV, ZTRHODJV)
-!
-CALL LS_FEEDBACK_ll(IINFO_ll)
-CALL GO_TOMODEL_ll(KMI, IINFO_ll)
-CALL UNSET_LSFIELD_2WAY_ll(IMI)
-!
-DEALLOCATE(ZTUM,ZTVM,ZTWM,ZTTHM,ZTRHODJ,ZTRHODJU,ZTRHODJV)
-DEALLOCATE(ZTRM,ZTSVM)
-DEALLOCATE(ZTINPRC,ZTINPRR,ZTINPRS,ZTINPRG,ZTINPRH,ZTPRCONV,ZTPRSCONV)
-DEALLOCATE(ZTDIRFLASWD,ZTSCAFLASWD,ZTDIRSRFSWD)
-!
-IF (.NOT. LINTER) THEN ! no computation for the dad subdomain
- DEALLOCATE(ZUM,ZVM,ZWM,ZTHM,ZRHODJ,ZRHODJU,ZRHODJV)
- IF (IRR /= 0) DEALLOCATE(ZRM)
- IF (KSV /= 0) DEALLOCATE(ZSVM)
- DEALLOCATE(ZINPRC,ZINPRR,ZINPRS,ZINPRG,ZINPRH,ZPRCONV,ZPRSCONV)
- DEALLOCATE(ZDIRFLASWD,ZSCAFLASWD,ZDIRSRFSWD)
-RETURN
-ENDIF
-!
-!
-! 5. RELAXATION
-! -----------
-! 5.1 Compute the bounds of relaxation area
-!
-IHALO=2
-!!$IF (JPHEXT/=1) STOP ! boundaries are hard coded supposing JPHEXT=1
-!
-CALL GET_OR_ll('B',IXOR_ll,IYOR_ll)
-CALL GET_DIM_EXT_ll('B',IXDIM,IYDIM)
-!
-IF(LWEST_ll()) THEN
- IDIST=IXOR_ll+1-(NXOR_ALL(IMI)+1) ! comparison of first physical
- ! points of subdomain and current processor
-ELSE
- IDIST=IXOR_ll+NHALO-(NXOR_ALL(IMI)+1)! comparison of first physical
- ! points of subdomain and current processor
-ENDIF
-!
-IF(IDIST<=0) THEN ! west side of the child domain
- IXOR=IXOR+IHALO
-ENDIF
-!
-IF(IDIST>=1 .AND. IDIST<=IHALO-1) THEN
- IXOR=IXOR+IHALO-IDIST
-ENDIF
-!
-! C grid for v component
-IF(IDIST >=IHALO+1) IXORU=IXOR ! interior child domain
-IF(IDIST>=1 .AND. IDIST<=IHALO) IXORU=IXOR+1 ! partial overlapping of the relaxation area
-IF(IDIST<=0) IXORU=IXOR+1
-!
-IF(LEAST_ll()) THEN
- IDIST=(NXEND_ALL(IMI)-1)-(IXOR_ll-1+IXDIM-1) ! comparison of last physical
- ! points of subdomain and current processor
-ELSE
- IDIST=(NXEND_ALL(IMI)-1)-(IXOR_ll-1+IXDIM-NHALO)! comparison of last physical
- ! points of subdomain and current processor
-ENDIF
-!
-IF(IDIST<=0) IXEND=IXEND-IHALO ! east side of the child domain
-IF(IDIST>=1 .AND. IDIST<=IHALO-1) IXEND=IXEND-IHALO+IDIST
-!
-!
-IF(.NOT.L2D) THEN
- IF(LSOUTH_ll()) THEN
- IDIST=IYOR_ll+1-(NYOR_ALL(IMI)+1)! comparison of first physical
- ! points of subdomain and current processor
- ELSE
- IDIST=IYOR_ll+NHALO-(NYOR_ALL(IMI)+1)! comparison of first physical
- ! points of subdomain and current processor
- ENDIF
-!
- IF(IDIST<=0) THEN ! south side of the child domain
- IYOR=IYOR+IHALO
- ENDIF
-!
- IF(IDIST>=1 .AND. IDIST<=IHALO-1) THEN
- IYOR=IYOR+IHALO-IDIST
- ENDIF
-!
-! C grid for v component
- IF(IDIST >=IHALO+1) IYORV=IYOR ! interior child domain
- IF(IDIST>=1 .AND. IDIST<=IHALO) IYORV=IYOR+1 ! partial overlapping of the relaxation area
- IF(IDIST<=0) IYORV=IYOR+1
-!
-!
-!
- IF(LNORTH_ll()) THEN
- IDIST=(NYEND_ALL(IMI)-1)-(IYOR_ll-1+IYDIM-1)! comparison of last physical
- ! points of subdomain and current processor
- ELSE
- IDIST=(NYEND_ALL(IMI)-1)-(IYOR_ll-1+IYDIM-NHALO)! comparison of last physical
- ! points of subdomain and current processor
- ENDIF
- IF(IDIST<=0) IYEND=IYEND-IHALO ! north side of the child domain
- IF(IDIST>=1 .AND. IDIST<=IHALO-1) IYEND=IYEND-IHALO+IDIST
-!
-ELSE
- IYORV=IYOR+1 ! no parallelized
-ENDIF
-
-! at this point, IXOR:IXEND,IYOR:IYEND define the 2way area outside
-! the relaxation area
- IF (LUSERR) THEN
- PINPRR(IXOR:IXEND,IYOR:IYEND)=ZINPRR(IXOR:IXEND,IYOR:IYEND)
- ENDIF
- IF (LUSERC .AND. ((LSEDIC .AND. CCLOUD(1:3) == 'ICE') .OR. &
- (LSEDC .AND. (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO')) .OR.&
- (NSEDC .AND. CCLOUD == 'LIMA') )) THEN
- PINPRC(IXOR:IXEND,IYOR:IYEND)=ZINPRC(IXOR:IXEND,IYOR:IYEND)
- ENDIF
- IF (LUSERS) THEN
- PINPRS(IXOR:IXEND,IYOR:IYEND)=ZINPRS(IXOR:IXEND,IYOR:IYEND)
- ENDIF
- IF (LUSERG) THEN
- PINPRG(IXOR:IXEND,IYOR:IYEND)=ZINPRG(IXOR:IXEND,IYOR:IYEND)
- ENDIF
- IF (LUSERH) THEN
- PINPRH(IXOR:IXEND,IYOR:IYEND)=ZINPRH(IXOR:IXEND,IYOR:IYEND)
- ENDIF
- IF (CDCONV /= 'NONE') THEN
- PPRCONV(IXOR:IXEND,IYOR:IYEND)=ZPRCONV(IXOR:IXEND,IYOR:IYEND)
- PPRSCONV(IXOR:IXEND,IYOR:IYEND)=ZPRSCONV(IXOR:IXEND,IYOR:IYEND)
- END IF
- IF (CRAD /= 'NONE') THEN
- PDIRFLASWD(IXOR:IXEND,IYOR:IYEND,:)=ZDIRFLASWD(IXOR:IXEND,IYOR:IYEND,:)
- PSCAFLASWD(IXOR:IXEND,IYOR:IYEND,:)=ZSCAFLASWD(IXOR:IXEND,IYOR:IYEND,:)
- PDIRSRFSWD(IXOR:IXEND,IYOR:IYEND,:)=ZDIRSRFSWD(IXOR:IXEND,IYOR:IYEND,:)
- ENDIF
- DEALLOCATE(ZINPRC,ZINPRR,ZINPRS,ZINPRG,ZINPRH,ZPRCONV,ZPRSCONV)
- DEALLOCATE(ZDIRFLASWD,ZSCAFLASWD,ZDIRSRFSWD)
-!
-!* initialize the OMASKkids array
-!
-OMASKkids(IXOR:IXEND,IYOR:IYEND)=.TRUE.
-!
-!
-! 5.2 relaxation computation
-!
-PRTHS(IXOR:IXEND,IYOR:IYEND,:) = PRTHS(IXOR:IXEND,IYOR:IYEND,:) &
- - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * ( PTHM(IXOR:IXEND,IYOR:IYEND,:) &
- -ZTHM(IXOR:IXEND,IYOR:IYEND,:)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
-!
-DO JVAR=1,IRR
- PRRS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRRS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PRM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- -ZRM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
-ENDDO
-!
-! User scalar variables
-DO JVAR=1,ISV_USER
- PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
-ENDDO
-! C2R2 scalar variables
-DO JVAR=NSV_C2R2BEG_A(KMI),NSV_C2R2END_A(KMI)
- PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
-ENDDO
-! C1R3 scalar variables
-DO JVAR=NSV_C1R3BEG_A(KMI),NSV_C1R3END_A(KMI)
- PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
-ENDDO
-! LIMA scalar variables
-DO JVAR=NSV_LIMA_BEG_A(KMI),NSV_LIMA_END_A(KMI)
- PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
-ENDDO
-! Electrical scalar variables
-DO JVAR=NSV_ELECBEG_A(KMI),NSV_ELECEND_A(KMI)
- PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
-ENDDO
-! Chemical scalar variables
-DO JVAR=NSV_CHEMBEG_A(KMI),NSV_CHEMEND_A(KMI)
- PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
-ENDDO
-! Ice phase chemical scalar variables
-DO JVAR=NSV_CHICBEG_A(KMI),NSV_CHICEND_A(KMI)
- PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
-ENDDO
-! NOX variables
-DO JVAR=NSV_LNOXBEG_A(KMI),NSV_LNOXEND_A(KMI)
- PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
-ENDDO
-! Orilam scalar variables
-DO JVAR=NSV_AERBEG_A(KMI),NSV_AEREND_A(KMI)
- PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
-ENDDO
-DO JVAR=NSV_AERDEPBEG_A(KMI),NSV_AERDEPEND_A(KMI)
- PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
-ENDDO
-! Dust scalar variables
-DO JVAR=NSV_DSTBEG_A(KMI),NSV_DSTEND_A(KMI)
- PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
-ENDDO
-DO JVAR=NSV_DSTDEPBEG_A(KMI),NSV_DSTDEPEND_A(KMI)
- PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
-ENDDO
-! Salt scalar variables
-DO JVAR=NSV_SLTBEG_A(KMI),NSV_SLTEND_A(KMI)
- PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
-ENDDO
-DO JVAR=NSV_SLTDEPBEG_A(KMI),NSV_SLTDEPEND_A(KMI)
- PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
-ENDDO
-! Lagrangian scalar variables
-DO JVAR=NSV_LGBEG_A(KMI),NSV_LGEND_A(KMI)
- PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
-ENDDO
-! Passive pollutant variables
-DO JVAR=NSV_PPBEG_A(KMI),NSV_PPEND_A(KMI)
- PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
-ENDDO
-#ifdef MNH_FOREFIRE
-
-! ForeFire variables
-DO JVAR=NSV_FFBEG_A(KMI),NSV_FFEND_A(KMI)
- PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
-ENDDO
-#endif
-! Conditional sampling variables
-DO JVAR=NSV_CSBEG_A(KMI),NSV_CSEND_A(KMI)
- PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) = PRSVS(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- - ZK2W * PRHODJ(IXOR:IXEND,IYOR:IYEND,:) * (PSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR) &
- -ZSVM(IXOR:IXEND,IYOR:IYEND,:,JVAR)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
-ENDDO
-!
-ZRHODJ(IXOR:IXEND,IYOR:IYEND,IKB) = 2.*ZRHODJ(IXOR:IXEND,IYOR:IYEND,IKB)
-ZRHODJ(IXOR:IXEND,IYOR:IYEND,IKB+1:IKU) = ZRHODJ(IXOR:IXEND,IYOR:IYEND,IKB+1:IKU) &
- +ZRHODJ(IXOR:IXEND,IYOR:IYEND,IKB:IKU-1)
-!
-ZAVE_RHODJ=MZM(PRHODJ)
-PRWS(IXOR:IXEND,IYOR:IYEND,:) = PRWS(IXOR:IXEND,IYOR:IYEND,:) &
- - ZK2W * ZAVE_RHODJ(IXOR:IXEND,IYOR:IYEND,:) * ( PWM(IXOR:IXEND,IYOR:IYEND,:) &
- -ZWM(IXOR:IXEND,IYOR:IYEND,:)/ZRHODJ(IXOR:IXEND,IYOR:IYEND,:) )
-!
-ZAVE_RHODJ=MXM(PRHODJ)
-PRUS(IXORU:IXEND,IYOR:IYEND,:) = PRUS(IXORU:IXEND,IYOR:IYEND,:) &
- - ZK2W * ZAVE_RHODJ(IXORU:IXEND,IYOR:IYEND,:) * ( PUM(IXORU:IXEND,IYOR:IYEND,:) &
- -ZUM(IXORU:IXEND,IYOR:IYEND,:)/ZRHODJU(IXORU:IXEND,IYOR:IYEND,:) )
-!
-ZAVE_RHODJ=MYM(PRHODJ)
-PRVS(IXOR:IXEND,IYORV:IYEND,:) = PRVS(IXOR:IXEND,IYORV:IYEND,:) &
- - ZK2W * ZAVE_RHODJ(IXOR:IXEND,IYORV:IYEND,:) * ( PVM(IXOR:IXEND,IYORV:IYEND,:) &
- -ZVM(IXOR:IXEND,IYORV:IYEND,:)/ZRHODJV(IXOR:IXEND,IYORV:IYEND,:) )
-!
-DEALLOCATE(ZUM,ZVM,ZWM,ZTHM,ZRHODJ,ZRHODJU,ZRHODJV)
-IF (IRR /= 0) DEALLOCATE(ZRM)
-IF (KSV /= 0) DEALLOCATE(ZSVM)
-!------------------------------------------------------------------------------
-!
-END SUBROUTINE TWO_WAY_n
diff --git a/src/mesonh/ext/update_nsv.f90 b/src/mesonh/ext/update_nsv.f90
deleted file mode 100644
index f54a72169a96b85ca43c4c958e61dbdedc514c3e..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/update_nsv.f90
+++ /dev/null
@@ -1,187 +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.
-!-----------------------------------------------------------------
-! ######spl
- MODULE MODI_UPDATE_NSV
-! ######################
-!
-INTERFACE
- SUBROUTINE UPDATE_NSV(KMI)
- INTEGER, INTENT(IN) :: KMI ! Model index
- END SUBROUTINE UPDATE_NSV
-!
-END INTERFACE
-END MODULE MODI_UPDATE_NSV
-! ######spl
- SUBROUTINE UPDATE_NSV(KMI)
-! ##########################
-
-!!**** *UPDATE_NSV* - routine that updates the NSV_* variables for the
-!! current model. It is intended to be called from
-!! any MesoNH routine WITH or WITHOUT $n before using
-!! the NSV_* variables.
-!! Modify (Escobar ) 2/2014 : add Forefire var
-!! Modify (Vie) 2016 : add LIMA
-!! V. Vionnet 7/2017 : add blowing snow var
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-! P. Wautelet 26/11/2021: add TSVLIST and TSVLIST_A to store the metadata of all the scalar variables
-! P. Wautelet 14/01/2022: add CSV_CHEM_LIST(_A) to store the list of all chemical variables
-! P. Wautelet 20/02/2023: manage CSV(_A) + bugfix: reallocate size was wrong in some scenarii
-!-------------------------------------------------------------------------------
-!
-USE MODD_CONF, ONLY: NVERB
-USE MODD_FIELD, ONLY: tfieldmetadata
-USE MODD_NSV
-USE MODD_PARAMETERS, ONLY: JPSVNAMELGTMAX, NMNHNAMELGTMAX
-
-USE MODE_LIMA_UPDATE_NSV, ONLY: LIMA_UPDATE_NSV
-use mode_msg
-
-IMPLICIT NONE
-
-INTEGER, INTENT(IN) :: KMI ! Model index
-
-CHARACTER(LEN=JPSVNAMELGTMAX), DIMENSION(:,:), ALLOCATABLE :: YSVNAMES_TMP
-CHARACTER(LEN=6), DIMENSION(:,:), ALLOCATABLE :: YSV_TMP
-CHARACTER(LEN=NMNHNAMELGTMAX), DIMENSION(:,:), ALLOCATABLE :: YSVCHEM_LIST_TMP
-INTEGER :: JI, JJ
-INTEGER :: ISV
-TYPE(tfieldmetadata), DIMENSION(:,:), ALLOCATABLE :: YSVLIST_TMP
-!
-! STOP if INI_NSV has not be called yet
-IF ( .NOT. LINI_NSV(KMI) ) THEN
- call Print_msg( NVERB_FATAL, 'GEN', 'UPDATE_NSV', 'can not continue because INI_NSV was not called' )
-END IF
-!
-! Update the NSV_* variables from original NSV_*_A arrays
-! that have been initialized in ini_nsv.f90 for model KMI
-!
-
-! Allocate/reallocate CSV_CHEM_LIST_A
-IF ( .NOT. ALLOCATED( TNSV%CSV_CHEM_LIST_A ) ) THEN
- ALLOCATE( TNSV%CSV_CHEM_LIST_A( NSV_CHEM_LIST_A(KMI), KMI) )
- CSV_CHEM_LIST_A => TNSV%CSV_CHEM_LIST_A
-ENDIF
-!If CSV_CHEM_LIST_A is too small, enlarge it and transfer data
-IF ( SIZE( CSV_CHEM_LIST_A, 1 ) < NSV_CHEM_LIST_A(KMI) .OR. SIZE( CSV_CHEM_LIST_A, 2 ) < KMI ) THEN
- ALLOCATE( YSVCHEM_LIST_TMP( MAX( SIZE(CSV_CHEM_LIST_A,1), NSV_CHEM_LIST_A(KMI) ), MAX( SIZE(CSV_CHEM_LIST_A,2), KMI ) ) )
- DO JJ = 1, SIZE( CSV_CHEM_LIST_A, 2 )
- DO JI = 1, SIZE( CSV_CHEM_LIST_A, 1 )
- YSVCHEM_LIST_TMP(JI, JJ) = CSV_CHEM_LIST_A(JI, JJ)
- END DO
- END DO
- CALL MOVE_ALLOC( FROM = YSVCHEM_LIST_TMP, TO = TNSV%CSV_CHEM_LIST_A )
- CSV_CHEM_LIST_A => TNSV%CSV_CHEM_LIST_A
-END IF
-
-CSV_CHEM_LIST => CSV_CHEM_LIST_A(:,KMI)
-
-! Allocate/reallocate CSV_A
-IF ( .NOT. ALLOCATED( TNSV%CSV_A ) ) THEN
- ALLOCATE( TNSV%CSV_A( NSV_A(KMI), KMI) )
- CSV_A => TNSV%CSV_A
-ENDIF
-!If CSV_A is too small, enlarge it and transfer data
-IF ( SIZE( CSV_A, 1 ) < NSV_A(KMI) .OR. SIZE( CSV_A, 2 ) < KMI ) THEN
- ALLOCATE( YSV_TMP( MAX( SIZE(CSV_A,1), NSV_A(KMI) ), MAX( SIZE(CSV_A,2), KMI ) ) )
- DO JJ = 1, SIZE( CSV_A, 2 )
- DO JI = 1, SIZE( CSV_A, 1 )
- YSV_TMP(JI, JJ) = CSV_A(JI, JJ)
- END DO
- END DO
- CALL MOVE_ALLOC( FROM = YSV_TMP, TO = TNSV%CSV_A )
- CSV_A => TNSV%CSV_A
-END IF
-
-CSV => CSV_A(:,KMI)
-
-! Allocate/reallocate TSVLIST_A
-IF ( .NOT. ALLOCATED( TNSV%TSVLIST_A ) ) THEN
- ALLOCATE( TNSV%TSVLIST_A( NSV_A(KMI), KMI) )
- TSVLIST_A => TNSV%TSVLIST_A
-ENDIF
-!If TSVLIST_A is too small, enlarge it and transfer data
-IF ( SIZE( TSVLIST_A, 1 ) < NSV_A(KMI) .OR. SIZE( TSVLIST_A, 2 ) < KMI ) THEN
- ALLOCATE( YSVLIST_TMP( MAX( SIZE(TSVLIST_A,1), NSV_A(KMI) ), MAX( SIZE(TSVLIST_A,2), KMI ) ) )
- DO JJ = 1, SIZE( TSVLIST_A, 2 )
- DO JI = 1, SIZE( TSVLIST_A, 1 )
- YSVLIST_TMP(JI, JJ) = TSVLIST_A(JI, JJ)
- END DO
- END DO
- CALL MOVE_ALLOC( FROM = YSVLIST_TMP, TO = TNSV%TSVLIST_A )
- TSVLIST_A => TNSV%TSVLIST_A
-END IF
-
-TSVLIST => TSVLIST_A(:,KMI)
-
-NSV = NSV_A(KMI)
-NSV_USER = NSV_USER_A(KMI)
-NSV_C2R2 = NSV_C2R2_A(KMI)
-NSV_C2R2BEG = NSV_C2R2BEG_A(KMI)
-NSV_C2R2END = NSV_C2R2END_A(KMI)
-NSV_C1R3 = NSV_C1R3_A(KMI)
-NSV_C1R3BEG = NSV_C1R3BEG_A(KMI)
-NSV_C1R3END = NSV_C1R3END_A(KMI)
-!
-ISV=-1
-CALL LIMA_UPDATE_NSV(LDINIT=.FALSE., KMI=KMI, KSV=ISV, CDCLOUD='LIMA', LDUPDATE=.TRUE.)
-!
-NSV_ELEC = NSV_ELEC_A(KMI)
-NSV_ELECBEG = NSV_ELECBEG_A(KMI)
-NSV_ELECEND = NSV_ELECEND_A(KMI)
-NSV_CHEM = NSV_CHEM_A(KMI)
-NSV_CHEMBEG = NSV_CHEMBEG_A(KMI)
-NSV_CHEMEND = NSV_CHEMEND_A(KMI)
-NSV_CHGS = NSV_CHGS_A(KMI)
-NSV_CHGSBEG = NSV_CHGSBEG_A(KMI)
-NSV_CHGSEND = NSV_CHGSEND_A(KMI)
-NSV_CHAC = NSV_CHAC_A(KMI)
-NSV_CHACBEG = NSV_CHACBEG_A(KMI)
-NSV_CHACEND = NSV_CHACEND_A(KMI)
-NSV_CHIC = NSV_CHIC_A(KMI)
-NSV_CHICBEG = NSV_CHICBEG_A(KMI)
-NSV_CHICEND = NSV_CHICEND_A(KMI)
-NSV_LNOX = NSV_LNOX_A(KMI)
-NSV_LNOXBEG = NSV_LNOXBEG_A(KMI)
-NSV_LNOXEND = NSV_LNOXEND_A(KMI)
-NSV_DST = NSV_DST_A(KMI)
-NSV_DSTBEG = NSV_DSTBEG_A(KMI)
-NSV_DSTEND = NSV_DSTEND_A(KMI)
-NSV_DSTDEP = NSV_DSTDEP_A(KMI)
-NSV_DSTDEPBEG = NSV_DSTDEPBEG_A(KMI)
-NSV_DSTDEPEND = NSV_DSTDEPEND_A(KMI)
-NSV_SLT = NSV_SLT_A(KMI)
-NSV_SLTBEG = NSV_SLTBEG_A(KMI)
-NSV_SLTEND = NSV_SLTEND_A(KMI)
-NSV_SLTDEPBEG = NSV_SLTDEPBEG_A(KMI)
-NSV_SLTDEPEND = NSV_SLTDEPEND_A(KMI)
-NSV_AER = NSV_AER_A(KMI)
-NSV_AERBEG = NSV_AERBEG_A(KMI)
-NSV_AEREND = NSV_AEREND_A(KMI)
-NSV_AERDEPBEG = NSV_AERDEPBEG_A(KMI)
-NSV_AERDEPEND = NSV_AERDEPEND_A(KMI)
-NSV_LG = NSV_LG_A(KMI)
-NSV_LGBEG = NSV_LGBEG_A(KMI)
-NSV_LGEND = NSV_LGEND_A(KMI)
-NSV_PP = NSV_PP_A(KMI)
-NSV_PPBEG = NSV_PPBEG_A(KMI)
-NSV_PPEND = NSV_PPEND_A(KMI)
-#ifdef MNH_FOREFIRE
-NSV_FF = NSV_FF_A(KMI)
-NSV_FFBEG = NSV_FFBEG_A(KMI)
-NSV_FFEND = NSV_FFEND_A(KMI)
-#endif
-NSV_FIRE = NSV_FIRE_A(KMI)
-NSV_FIREBEG = NSV_FIREBEG_A(KMI)
-NSV_FIREEND = NSV_FIREEND_A(KMI)
-NSV_CS = NSV_CS_A(KMI)
-NSV_CSBEG = NSV_CSBEG_A(KMI)
-NSV_CSEND = NSV_CSEND_A(KMI)
-NSV_SNW = NSV_SNW_A(KMI)
-NSV_SNWBEG = NSV_SNWBEG_A(KMI)
-NSV_SNWEND = NSV_SNWEND_A(KMI)
-!
-
-END SUBROUTINE UPDATE_NSV
diff --git a/src/mesonh/ext/ver_interp_field.f90 b/src/mesonh/ext/ver_interp_field.f90
deleted file mode 100644
index d0092e917c7f9f1ea3232c1eba012cccf5d80b71..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/ver_interp_field.f90
+++ /dev/null
@@ -1,327 +0,0 @@
-!MNH_LIC Copyright 1997-2020 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!#######################
-MODULE MODI_VER_INTERP_FIELD
-!#######################
-!
-INTERFACE
-!
- SUBROUTINE VER_INTERP_FIELD(HTURB,KRR,KSV,PZZ_LS,PZZ, &
- PUT,PVT,PWT,PTHVT,PRT,PHUT,PTKET,PSVT, &
- PSRCT,PSIGS, &
- PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM )
-!
-CHARACTER (LEN=4), INTENT(IN) :: HTURB ! Kind of turbulence parameterization
-INTEGER, INTENT(IN) :: KRR ! number of moist variables
-INTEGER, INTENT(IN) :: KSV ! number of scalar variables
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ_LS ! initial 3D grid
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! new 3D grid
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT ! model 2
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTKET ! variables
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT,PSVT ! at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHVT,PHUT !
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRCT,PSIGS ! secondary
- ! prognostic variables
- ! Larger Scale fields
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLSUM, PLSVM, PLSWM ! Wind
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLSTHM, PLSRVM ! Mass
-END SUBROUTINE VER_INTERP_FIELD
-!
-END INTERFACE
-!
-END MODULE MODI_VER_INTERP_FIELD
-!
-! ##########################################################################
- SUBROUTINE VER_INTERP_FIELD(HTURB,KRR,KSV,PZZ_LS,PZZ, &
- PUT,PVT,PWT,PTHVT,PRT,PHUT,PTKET,PSVT, &
- PSRCT,PSIGS, &
- PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM )
-! ##########################################################################
-!
-!!**** *VER_INTERP_FIELD * - interpolate the 3D and LS 2D fields from one
-!! vertical grid PZZ_LS to another PZZ
-!!
-!! PURPOSE
-!! -------
-!!
-!!
-!!** METHOD
-!! ------
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book1 of the documentation
-!! SUBROUTINE VER_INTERP_FIELD (Book2 of the documentation)
-!!
-!!
-!! AUTHOR
-!! ------
-!!
-!! V. Masson * METEO-FRANCE *
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-!! Original 17/07/97
-!! 14/09/97 (V. Masson) Interpolation of relative humidity
-!! 05/06 Remobe KEPS
-!! 2014 (M.Faivre)
-! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CONF_n, ONLY : CONF_MODEL
-USE MODD_TURB_n, ONLY: XTKEMIN
-USE MODD_PARAMETERS
-USE MODD_VER_INTERP_LIN
-!
-USE MODI_SHUMAN
-USE MODI_COEF_VER_INTERP_LIN
-USE MODI_VER_INTERP_LIN
-!$20140709
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-USE MODD_FIELD_n ! modules relative to the outer model $n
-USE MODD_LSFIELD_n
-USE MODE_MPPDB
-!$20140710
-USE MODE_ll
-USE MODD_LBC_n
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-!
-CHARACTER (LEN=4), INTENT(IN) :: HTURB ! Kind of turbulence parameterization
-INTEGER, INTENT(IN) :: KRR ! number of moist variables
-INTEGER, INTENT(IN) :: KSV ! number of scalar variables
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ_LS ! initial 3D grid
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! new 3D grid
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT ! model 2
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTKET ! variables
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT,PSVT ! at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHVT,PHUT !
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRCT,PSIGS ! secondary
- ! prognostic variables
- ! Larger Scale fields
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLSUM, PLSVM, PLSWM ! Wind
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLSTHM, PLSRVM ! Mass
-!* 0.2 Declarations of local variables
-!
-INTEGER :: JRR, JSV
-INTEGER :: IKU
-INTEGER :: IKB
-REAL, DIMENSION(SIZE(PZZ_LS,1),SIZE(PZZ_LS,2),SIZE(PZZ_LS,3)) :: ZGRID1, ZGRID2
-!$20140709
-TYPE(LIST_ll), POINTER :: TZLSFIELD_ll ! list of LS fields
-INTEGER :: IINFO_ll
-!$20140710
-INTEGER JI,JJ,IIB,IJB,IIE,IJE
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. Prologue
-! --------
-!
-IKU=SIZE(PZZ,3)
-!
-IKB=1+JPVEXT
-!$20140710
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. variables which always exist
-! ----------------------------
-!
-!* 2.1 U component
-! -----------
-!
-!* shift of grids to mass points
-ZGRID1(:,:,:)=MZF(PZZ_LS(:,:,:))
-ZGRID1(:,:,IKU)=2.*ZGRID1(:,:,IKU-1)-ZGRID1(:,:,IKU-2)
-ZGRID2(:,:,:)=MZF(PZZ(:,:,:))
-ZGRID2(:,:,IKU)=2.*ZGRID2(:,:,IKU-1)-ZGRID2(:,:,IKU-2)
-!* move the first physical level if above the target grid
-ZGRID1(:,:,1:IKB)=MIN(ZGRID1(:,:,1:IKB),ZGRID2(:,:,1:IKB))
-!$20140710
-CALL MPPDB_CHECK3D(ZGRID1,"VERINTERPFIELDbefMXM:ZGRID1",PRECISION)
-CALL MPPDB_CHECK3D(ZGRID2,"VERINTERPFIELDbefMXM:ZGRID2",PRECISION)
-!* shift to U points
-!$20140710pb with MXM,MYM: MPPDB pb
-!$if cancel MXM, MYM then PUM,PVM are ok
-ZGRID1(:,:,:)=MXM(ZGRID1(:,:,:))
-ZGRID2(:,:,:)=MXM(ZGRID2(:,:,:))
-DO JI=JPHEXT,1,-1
- ZGRID1(JI,:,:)=2.*ZGRID1(JI+1,:,:)-ZGRID1(JI+2,:,:)
- ZGRID2(JI,:,:)=2.*ZGRID2(JI+1,:,:)-ZGRID2(JI+2,:,:)
-ENDDO
-!$20140710 update_halo
-NULLIFY(TZLSFIELD_ll)
-CALL ADD3DFIELD_ll( TZLSFIELD_ll, ZGRID1, 'VER_INTERP_FIELD::ZGRID1' )
-CALL ADD3DFIELD_ll( TZLSFIELD_ll, ZGRID2, 'VER_INTERP_FIELD::ZGRID2' )
-CALL UPDATE_HALO_ll(TZLSFIELD_ll,IINFO_ll)
-CALL CLEANLIST_ll(TZLSFIELD_ll)
-!
-!$20140710
-CALL MPPDB_CHECK3D(ZGRID1,"VERINTERPFIELDaftMXM:ZGRID1",PRECISION)
-CALL MPPDB_CHECK3D(ZGRID2,"VERINTERPFIELDaftMXM:ZGRID2",PRECISION)
-!
-!$20140710 add NKLIN and XCOEFLIN in COEF_VER_INTERP
-CALL COEF_VER_INTERP_LIN(ZGRID1(:,:,:),ZGRID2(:,:,:))
-!
-PUT (:,:,:) = VER_INTERP_LIN(PUT (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
-PLSUM (:,:,:) = VER_INTERP_LIN(PLSUM (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
-!$20140709
-CALL MPPDB_CHECK3D(PUT,"VERINTERPFIELD:PUT",PRECISION)
-!$
-!
-!* 2.2 V component
-! -----------
-!
-!* shift of grids to mass points
-ZGRID1(:,:,:)=MZF(PZZ_LS(:,:,:))
-ZGRID1(:,:,IKU)=2.*ZGRID1(:,:,IKU-1)-ZGRID1(:,:,IKU-2)
-ZGRID2(:,:,:)=MZF(PZZ(:,:,:))
-ZGRID2(:,:,IKU)=2.*ZGRID2(:,:,IKU-1)-ZGRID2(:,:,IKU-2)
-!* move the first physical level if above the target grid
-ZGRID1(:,:,1:IKB)=MIN(ZGRID1(:,:,1:IKB),ZGRID2(:,:,1:IKB))
-!* shift to V points
-
-ZGRID1(:,:,:)=MYM(ZGRID1(:,:,:))
-ZGRID2(:,:,:)=MYM(ZGRID2(:,:,:))
-DO JJ=JPHEXT,1,-1
- ZGRID1(:,JJ,:)=2.*ZGRID1(:,JJ+1,:)-ZGRID1(:,JJ+2,:)
- ZGRID2(:,JJ,:)=2.*ZGRID2(:,JJ+1,:)-ZGRID2(:,JJ+2,:)
-ENDDO
-!$20140711 updatehalo(zg1,2) also here
-NULLIFY(TZLSFIELD_ll)
-CALL ADD3DFIELD_ll( TZLSFIELD_ll, ZGRID1, 'VER_INTERP_FIELD::ZGRID1' )
-CALL ADD3DFIELD_ll( TZLSFIELD_ll, ZGRID2, 'VER_INTERP_FIELD::ZGRID2' )
-CALL UPDATE_HALO_ll(TZLSFIELD_ll,IINFO_ll)
-CALL CLEANLIST_ll(TZLSFIELD_ll)
-!$
-CALL COEF_VER_INTERP_LIN(ZGRID1(:,:,:),ZGRID2(:,:,:))
-!
-!$20140710
-CALL MPPDB_CHECK3D(XCOEFLIN,"VERINTERPFIELDaftVerinterplin:XCOEFLIN",PRECISION)
-PVT (:,:,:) = VER_INTERP_LIN(PVT (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
-PLSVM (:,:,:) = VER_INTERP_LIN(PLSVM (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
-!$20140710
-CALL MPPDB_CHECK3D(PVT,"VERINTERPFIELDaftVerinterplin:PVT",PRECISION)
-!
-!* 2.3 W component
-! -----------
-!
-ZGRID1(:,:,:)=PZZ_LS(:,:,:)
-ZGRID2(:,:,:)=PZZ (:,:,:)
-!* move the first physical level if above the target grid
-ZGRID1(:,:,1:IKB)=MIN(ZGRID1(:,:,1:IKB),ZGRID2(:,:,1:IKB))
-!
-CALL COEF_VER_INTERP_LIN(ZGRID1(:,:,:),ZGRID2(:,:,:))
-!
-PWT (:,:,:) = VER_INTERP_LIN(PWT (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
-PLSWM (:,:,:) = VER_INTERP_LIN(PLSWM (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
-!
-!* 2.4 thermodynamical variables
-! -------------------------
-!
-!* shift of grids to mass points
-ZGRID1(:,:,:)=MZF(PZZ_LS(:,:,:))
-ZGRID1(:,:,IKU)=2.*ZGRID1(:,:,IKU-1)-ZGRID1(:,:,IKU-2)
-ZGRID2(:,:,:)=MZF(PZZ(:,:,:))
-ZGRID2(:,:,IKU)=2.*ZGRID2(:,:,IKU-1)-ZGRID2(:,:,IKU-2)
-!
-CALL COEF_VER_INTERP_LIN(ZGRID1(:,:,:),ZGRID2(:,:,:))
-!
-PTHVT (:,:,:) = VER_INTERP_LIN(PTHVT (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
-PLSTHM(:,:,:) = VER_INTERP_LIN(PLSTHM(:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
-!
-IF ( SIZE(PLSRVM,1) /= 0 ) THEN
- PLSRVM(:,:,:) = VER_INTERP_LIN(PLSRVM(:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
- PLSRVM=MAX(PLSRVM,0.)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. moist variables
-! ---------------
-!
-DO JRR=1,KRR
- PRT (:,:,:,JRR) = VER_INTERP_LIN(PRT (:,:,:,JRR),NKLIN(:,:,:),XCOEFLIN(:,:,:))
- PRT (:,:,:,JRR) = MAX(PRT(:,:,:,JRR),0.)
-END DO
-!
-IF (CONF_MODEL(1)%NRR>=1) THEN
- PHUT(:,:,:) = VER_INTERP_LIN(PHUT (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
- PHUT(:,:,:) = MIN(MAX(PHUT(:,:,:),0.),100.)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. scalar variables
-! ----------------
-!
-DO JSV=1,KSV
- PSVT (:,:,:,JSV) = VER_INTERP_LIN(PSVT (:,:,:,JSV),NKLIN(:,:,:),XCOEFLIN(:,:,:))
- PSVT (:,:,:,JSV) = MAX(PSVT(:,:,:,JSV),0.)
-END DO
-!
-!-------------------------------------------------------------------------------
-!
-!* 5. TKE variable
-! ------------
-!
-!* shift of grids to mass points
-ZGRID1(:,:,:)=MZF(PZZ_LS(:,:,:))
-ZGRID1(:,:,IKU)=2.*ZGRID1(:,:,IKU-1)-ZGRID1(:,:,IKU-2)
-ZGRID2(:,:,:)=MZF(PZZ(:,:,:))
-ZGRID2(:,:,IKU)=2.*ZGRID2(:,:,IKU-1)-ZGRID2(:,:,IKU-2)
-!* move the first physical level if above the target grid
-ZGRID1(:,:,1:IKB)=MIN(ZGRID1(:,:,1:IKB),ZGRID2(:,:,1:IKB))
-!
-CALL COEF_VER_INTERP_LIN(ZGRID1(:,:,:),ZGRID2(:,:,:))
-!
-IF (HTURB /= 'NONE') THEN
- PTKET(:,:,:) = VER_INTERP_LIN(PTKET (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
- PTKET=MAX(PTKET,XTKEMIN)
-ENDIF
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 6. secondary prognostic variables
-! ------------------------------
-!
-IF (KRR > 1 .AND. HTURB /= 'NONE') THEN
- PSRCT (:,:,:) = VER_INTERP_LIN(PSRCT (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
- PSIGS (:,:,:) = VER_INTERP_LIN(PSIGS (:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-DEALLOCATE(NKLIN)
-DEALLOCATE(XCOEFLIN)
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE VER_INTERP_FIELD
-!
diff --git a/src/mesonh/ext/write_desfmn.f90 b/src/mesonh/ext/write_desfmn.f90
deleted file mode 100644
index d5ee56097423c4e106b08d9387980c0b063c2f27..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/write_desfmn.f90
+++ /dev/null
@@ -1,730 +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_WRITE_DESFM_n
-! #########################
-!
-INTERFACE
-!
-SUBROUTINE WRITE_DESFM_n(KMI,TPDATAFILE)
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KMI ! Model index
-TYPE(TFILEDATA), INTENT(IN) :: TPDATAFILE ! Datafile
-!
-END SUBROUTINE WRITE_DESFM_n
-!
-END INTERFACE
-!
-END MODULE MODI_WRITE_DESFM_n
-!
-!
-! ###################################################
- SUBROUTINE WRITE_DESFM_n(KMI,TPDATAFILE)
-! ###################################################
-!
-!!**** *WRITE_DESFM_n * - routine to write a descriptor file ( DESFM )
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to write the descriptive part of a Mesonh
-! file (FM-file). The resulting file is called DESFM.
-!
-!!
-!!** METHOD
-!! ------
-!!
-!! This routine writes in the file HDESFM, previously opened, the group of
-!! all the namelists used to specify a Mesonh simulation.
-!! If verbose option is high enough : NVERB>=5, the variables in descriptor
-!! file are printed on the right output-listing corresponding tomodel _n.
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! Module MODN_LUNIT_n : contains declarations of namelist NAM_LUNITn
-!! and module MODD_LUNIT_n
-!!
-!!
-!! Module MODN_CONF_n : contains declaration of namelist NAM_CONFn and
-!! uses module MODD_CONF1 (configuration variables
-!! for model _n )
-!!
-!! Module MODN_DYN_n : contains declaration of namelist NAM_DYNn and
-!! uses module MODD_DYN_n (dynamic control variables
-!! for model _n )
-!!
-!! Module MODN_ADV_n : contains declaration of namelist NAM_ADVn and
-!! uses module MODD_ADV_n (control variables for the
-!! advection scheme for model _n )
-!!
-!! Module MODN_PARAM_n : contains declaration of namelist NAM_PARAMn and
-!! uses module MODD_PARAM_n (names of the physical
-!! parameterizations for model _n )
-!!
-!! Module MODN_PARAM_RAD_n : contains declaration of the control parameters
-!! for calling the radiation scheme
-!!
-!! Module MODN_PARAM_KAFR_n : contains declaration of control parameters
-!! for calling the deep convection scheme
-!!
-!! Module MODN_LBC_n : contains declaration of namelis NAM_LBCn and
-!! uses module MODD_LBC_n (lateral boundary conditions)
-!!
-!!
-!! Module MODN_TURB_n : contains declaration of turbulence scheme options
-!! present in the namelist
-!!
-!! Module MODN_CONF : contains declaration of namelist NAM_CONF and
-!! uses module MODD_CONF (configuration variables)
-!!
-!! Module MODN_DYN : contains the declaration of namelist NAM_DYN and
-!! uses module MODD_DYN (dynamic control variables)
-!!
-!! Module MODN_BUDGET : contains declaration of all the namelists
-!! related to the budget computations
-!!
-!! Module MODN_LES : contains declaration of the control parameters
-!! for Large Eddy Simulations' storages
-!! Module MODN_BLANK_n : contains declaration of MesoNH developper variables
-!! for test and debugging purposes.
-!!
-!!
-!! REFERENCE
-!! ---------
-!! None
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Ducrocq * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 07/06/94
-!! Updated V.Ducrocq 06/09/94
-!! Updated J.Stein 20/10/94 to include NAM_OUTn
-!! Updated J.Stein 24/10/94 change routine name
-!! Updated J.Stein 26/10/94 add the OWRIGET argument
-!! Updated J.Stein 06/12/94 add the LS fields
-!! Updated J.Stein 09/01/95 add the turbulence scheme
-!! Updated J.Stein 09/01/95 add the 1D switch
-!! Updated J.Stein 20/03/95 remove R from the historical var.
-!! Updated Ph.Hereil 20/06/95 add the budgets
-!! Updated J.-P. Pinty 15/09/95 add the radiations
-!! Updated J.Vila 06/02/96 implementation of scalar
-!! advection schemes
-!! Updated J.Stein 20/02/96 cleaning + add the LES namelist
-!! Modifications 25/04/96 (Suhre) add NAM_BLANK
-!! Modifications 25/04/96 (Suhre) add NAM_FRC
-!! Modifications 25/04/96 (Suhre) add NAM_CH_MNHCn and NAM_CH_SOLVER
-!! Modifications 11/04/96 (Pinty) add the ice concentration
-!! Modifications 11/01/97 (Pinty) add the deep convection
-!! Temporary Modification (Masson 06/09/96) manual write of the first and
-!! third namelists because of compiler version.
-!! Modifications J.-P. Lafore 22/07/96 gridnesting implementation
-!! Modifications J.-P. Lafore 29/07/96 add NAM_FMOUT (renamed in NAM_OUTPUT/NAM_BACKUP)
-!! Modifications V. Masson 10/07/97 add NAM_PARAM_GROUNDn
-!! Modifications V. Masson 28/07/97 supress LSTEADY_DMASS
-!! Modifications P. Jabouille 03/10/01 LHORELAX_ modifications
-!! Modifications P. Jabouille 12/03/02 conditional writing of namelists
-!! Modifications J.-P. Pinty 29/11/02 add C3R5, ICE2, ICE4, CELEC
-!! Modification V. Masson 01/2004 removes surface (externalization)
-!! Modification P. Tulet 01/2005 add dust, orilam
-!! Modification 05/2006 Remove EPS and OWRIGET
-!! Modification 01/2016 (JP Pinty) Add LIMA
-!! 02/2018 Q.Libois ECRAD
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! Modification V. Vionnet 07/2017 add blowing snow variables
-!! Modification F.Auguste 02/2021 add IBM
-!! E.Jezequel 02/2021 add stations read from CSV file
-! A. Costes 12/2021: add Blaze fire model
-! P. Wautelet 27/04/2022: add namelist for profilers
-! P. Wautelet 13/07/2022: add namelist for flyers and balloons
-! P. Wautelet 19/01/2023: bugfix for ForeFire
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-USE MODD_CONF
-USE MODD_DYN_n, ONLY: LHORELAX_SVLIMA, LHORELAX_SVFIRE
-#ifdef MNH_FOREFIRE
-USE MODD_FOREFIRE, ONLY: LFOREFIRE
-#endif
-USE MODD_IBM_LSF, ONLY: LIBM_LSF
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_PARAMETERS
-USE MODD_PROFILER_n, ONLY: LPROFILER
-USE MODD_STATION_n, ONLY: LSTATION
-!
-USE MODE_MSG
-!
-! USE MODN_AIRCRAFTS
-USE MODN_BACKUP
-! USE MODN_BALLOONS
-USE MODN_CONF
-USE MODN_DYN
-USE MODN_NESTING
-USE MODN_OUTPUT
-USE MODN_BUDGET
-USE MODN_LES
-USE MODN_DYN_n
-USE MODN_ADV_n
-USE MODN_PARAM_n
-USE MODN_PARAM_RAD_n
-USE MODN_PARAM_ECRAD_n
-USE MODN_PARAM_KAFR_n
-USE MODD_PARAM_MFSHALL_n, ONLY: PARAM_MFSHALLN_INIT
-USE MODD_PARAM_ICE_n, ONLY: PARAM_ICEN_INIT
-USE MODD_PARAM_LIMA, ONLY: PARAM_LIMA_INIT
-USE MODN_CONF_n
-USE MODN_LUNIT_n
-USE MODN_LBC_n
-USE MODN_NUDGING_n
-USE MODD_TURB_n, ONLY: TURBN_INIT
-USE MODD_NEB_n, ONLY: NEBN_INIT
-USE MODN_BLANK_n
-USE MODN_FRC
-USE MODN_CH_MNHC_n
-USE MODN_CH_SOLVER_n
-USE MODN_PARAM_C2R2
-USE MODN_PARAM_C1R3
-USE MODN_ELEC
-USE MODN_SERIES
-USE MODN_SERIES_n
-USE MODN_TURB_CLOUD
-USE MODN_CH_ORILAM
-USE MODN_DUST
-USE MODN_SALT
-USE MODN_PASPOL
-USE MODN_CONDSAMP
-USE MODN_2D_FRC
-USE MODN_LATZ_EDFLX
-#ifdef MNH_FOREFIRE
-USE MODN_FOREFIRE
-#endif
-USE MODN_BLOWSNOW_n
-USE MODN_BLOWSNOW
-USE MODN_IBM_PARAM_n
-USE MODN_RECYCL_PARAM_n
-USE MODN_PROFILER_n
-USE MODN_STATION_n
-USE MODN_FIRE_n
-USE MODN_FLYERS
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-INTEGER, INTENT(IN) :: KMI ! Model index
-TYPE(TFILEDATA), INTENT(IN) :: TPDATAFILE ! Datafile
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: ILUSEG ! logical unit number of EXSEG file
-INTEGER :: ILUOUT ! Logical unit number for output-listing TLUOUT file
-!
-LOGICAL :: GHORELAX_UVWTH, &
- GHORELAX_RV, GHORELAX_RC, GHORELAX_RR, &
- GHORELAX_RI, GHORELAX_RS, GHORELAX_RG, &
- GHORELAX_TKE, GHORELAX_SVC2R2, GHORELAX_SVPP, &
- GHORELAX_SVCS, GHORELAX_SVCHIC, GHORELAX_SVFIRE,&
-#ifdef MNH_FOREFIRE
- GHORELAX_SVFF, &
-#endif
- GHORELAX_SVCHEM, GHORELAX_SVC1R3, &
- GHORELAX_SVELEC, GHORELAX_SVLIMA,GHORELAX_SVSNW
-LOGICAL :: GHORELAX_SVDST, GHORELAX_SVSLT, GHORELAX_SVAER
-LOGICAL, DIMENSION(JPSVMAX) :: GHORELAX_SV
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. UPDATE DESFM FILE
-! -----------------
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','WRITE_DESFM_n','called for '//TRIM(TPDATAFILE%CNAME))
-!
-IF (.NOT.ASSOCIATED(TPDATAFILE%TDESFILE)) &
- CALL PRINT_MSG(NVERB_FATAL,'IO','WRITE_DESFM_n','TDESFILE not associated for '//TRIM(TPDATAFILE%CNAME))
-!
-ILUSEG = TPDATAFILE%TDESFILE%NLU
-!
-CALL INIT_NAM_LUNITn
-WRITE(UNIT=ILUSEG,NML=NAM_LUNITn)
-IF (CPROGRAM/='MESONH') THEN
- LUSECI=.FALSE.
- NSV_USER = 0
-ENDIF
-CALL INIT_NAM_CONFn
-WRITE(UNIT=ILUSEG,NML=NAM_CONFn)
-!
-!
-CALL INIT_NAM_DYNn
-IF (CPROGRAM/='MESONH') THEN ! impose default value for next simulation
- GHORELAX_UVWTH = LHORELAX_UVWTH
- GHORELAX_RV = LHORELAX_RV
- GHORELAX_RC = LHORELAX_RC
- GHORELAX_RR = LHORELAX_RR
- GHORELAX_RI = LHORELAX_RI
- GHORELAX_RS = LHORELAX_RS
- GHORELAX_RG = LHORELAX_RG
- GHORELAX_TKE = LHORELAX_TKE
- GHORELAX_SV(:) = LHORELAX_SV(:)
- GHORELAX_SVC2R2= LHORELAX_SVC2R2
- GHORELAX_SVC1R3= LHORELAX_SVC1R3
- GHORELAX_SVLIMA= LHORELAX_SVLIMA
- GHORELAX_SVELEC= LHORELAX_SVELEC
- GHORELAX_SVCHEM= LHORELAX_SVCHEM
- GHORELAX_SVCHIC= LHORELAX_SVCHIC
- GHORELAX_SVDST = LHORELAX_SVDST
- GHORELAX_SVSLT = LHORELAX_SVSLT
- GHORELAX_SVPP = LHORELAX_SVPP
- GHORELAX_SVFIRE = LHORELAX_SVFIRE
-#ifdef MNH_FOREFIRE
- GHORELAX_SVFF = LHORELAX_SVFF
-#endif
- GHORELAX_SVCS = LHORELAX_SVCS
- GHORELAX_SVAER = LHORELAX_SVAER
- GHORELAX_SVSNW = LHORELAX_SVSNW
-!
- LHORELAX_UVWTH = .FALSE.
- LHORELAX_RV = .FALSE.
- LHORELAX_RC = .FALSE.
- LHORELAX_RR = .FALSE.
- LHORELAX_RI = .FALSE.
- LHORELAX_RS = .FALSE.
- LHORELAX_RG = .FALSE.
- LHORELAX_TKE = .FALSE.
- LHORELAX_SV(:) = .FALSE.
- LHORELAX_SVC2R2= .FALSE.
- LHORELAX_SVC1R3= .FALSE.
- LHORELAX_SVLIMA= .FALSE.
- LHORELAX_SVELEC= .FALSE.
- LHORELAX_SVCHEM= .FALSE.
- LHORELAX_SVCHIC= .FALSE.
- LHORELAX_SVLG = .FALSE.
- LHORELAX_SVPP = .FALSE.
- LHORELAX_SVFIRE = .FALSE.
-#ifdef MNH_FOREFIRE
- LHORELAX_SVFF = .FALSE.
-#endif
- LHORELAX_SVCS = .FALSE.
- LHORELAX_SVDST= .FALSE.
- LHORELAX_SVSLT= .FALSE.
- LHORELAX_SVAER= .FALSE.
- LHORELAX_SVSNW= .FALSE.
-ELSE !return to namelist meaning of LHORELAX_SV
- GHORELAX_SV(:) = LHORELAX_SV(:)
- LHORELAX_SV(NSV_USER+1:)=.FALSE.
-END IF
-WRITE(UNIT=ILUSEG,NML=NAM_DYNn)
-!
-IF (LIBM_LSF) THEN
- !
- CALL INIT_NAM_IBM_PARAMn
- !
- WRITE(UNIT=ILUSEG,NML=NAM_IBM_PARAMn)
- !
- IF (CPROGRAM/='MESONH') THEN
- LIBM = .FALSE.
- LIBM_TROUBLE = .FALSE.
- CIBM_ADV = 'NOTHIN'
- END IF
- !
-END IF
-!
-CALL INIT_NAM_ADVn
-WRITE(UNIT=ILUSEG,NML=NAM_ADVn)
-IF (CPROGRAM/='MESONH') THEN
- CTURB = 'NONE'
- CRAD = 'NONE'
- CCLOUD = 'NONE'
- CDCONV = 'NONE'
- CSCONV = 'NONE'
- CELEC = 'NONE'
- CACTCCN = 'NONE'
-END IF
-CALL INIT_NAM_PARAMn
-WRITE(UNIT=ILUSEG,NML=NAM_PARAMn)
-!
-CALL INIT_NAM_PARAM_RADn
-IF(CRAD /= 'NONE') WRITE(UNIT=ILUSEG,NML=NAM_PARAM_RADn)
-#ifdef MNH_ECRAD
-CALL INIT_NAM_PARAM_ECRADn
-IF(CRAD /= 'NONE') WRITE(UNIT=ILUSEG,NML=NAM_PARAM_ECRADn)
-#endif
-!
-CALL INIT_NAM_PARAM_KAFRn
-IF(CDCONV /= 'NONE' .OR. CSCONV == 'KAFR') &
- WRITE(UNIT=ILUSEG,NML=NAM_PARAM_KAFRn)
-!
-IF (CSCONV == 'EDKF' ) CALL PARAM_MFSHALLN_INIT(CPROGRAM, 0, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
-!
-CALL INIT_NAM_LBCn
-WRITE(UNIT=ILUSEG,NML=NAM_LBCn)
-!
-CALL INIT_NAM_NUDGINGn
-WRITE(UNIT=ILUSEG,NML=NAM_NUDGINGn)
-!
-IF(CTURB /= 'NONE') CALL TURBN_INIT(CPROGRAM, 0, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
-!
-CALL NEBN_INIT(CPROGRAM, 0, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
-!
-CALL INIT_NAM_BLANKn
-WRITE(UNIT=ILUSEG,NML=NAM_BLANKn)
-!
-!IF (CPROGRAM/='MESONH') THEN
-! LUSECHEM = .FALSE.
-! LORILAM = .FALSE.
-! LDEPOS_AER = .FALSE.
-! LDUST = .FALSE.
-! LDEPOS_DST = .FALSE.
-! LSALT = .FALSE.
-! LDEPOS_SLT = .FALSE.
-! LPASPOL = .FALSE.
-! LCONDSAMP = .FALSE.
-!END IF
-CALL INIT_NAM_CH_MNHCn
-IF(LUSECHEM .OR. LCH_CONV_LINOX .OR. LCH_CONV_SCAV) &
- WRITE(UNIT=ILUSEG,NML=NAM_CH_MNHCn)
-!
-CALL INIT_NAM_CH_SOLVERn
-IF(LUSECHEM) WRITE(UNIT=ILUSEG,NML=NAM_CH_SOLVERn)
-!
-CALL INIT_NAM_BLOWSNOWn
-IF(LBLOWSNOW) WRITE(UNIT=ILUSEG,NML=NAM_BLOWSNOWn)
-IF(LBLOWSNOW) WRITE(UNIT=ILUSEG,NML=NAM_BLOWSNOW)
-!
-CALL INIT_NAM_PROFILERn
-IF(LPROFILER) WRITE(UNIT=ILUSEG,NML=NAM_PROFILERn)
-!
-CALL INIT_NAM_STATIONn
-IF(LSTATION) WRITE(UNIT=ILUSEG,NML=NAM_STATIONn)
-!
-IF(LDUST) WRITE(UNIT=ILUSEG,NML=NAM_DUST)
-IF(LSALT) WRITE(UNIT=ILUSEG,NML=NAM_SALT)
-IF(LPASPOL) WRITE(UNIT=ILUSEG,NML=NAM_PASPOL)
-#ifdef MNH_FOREFIRE
-IF(LFOREFIRE) WRITE(UNIT=ILUSEG,NML=NAM_FOREFIRE)
-#endif
-!
-CALL INIT_NAM_FIREn
-WRITE(UNIT=ILUSEG,NML=NAM_FIREn)
-!
-IF(LCONDSAMP) WRITE(UNIT=ILUSEG,NML=NAM_CONDSAMP)
-IF(LORILAM.AND.LUSECHEM) WRITE(UNIT=ILUSEG,NML=NAM_CH_ORILAM)
-!
-CALL INIT_NAM_SERIESn
-IF(LSERIES) WRITE(UNIT=ILUSEG,NML=NAM_SERIESn)
-IF(L2D_ADV_FRC .OR. L2D_REL_FRC) WRITE(UNIT=ILUSEG,NML=NAM_2D_FRC)
-!
-IF (LUV_FLX .OR. LTH_FLX) WRITE(UNIT=ILUSEG,NML=NAM_LATZ_EDFLX)
-!
-IF (CPROGRAM/='MESONH') THEN
- LLG = .FALSE.
-END IF
-WRITE(UNIT=ILUSEG,NML=NAM_CONF)
-WRITE(UNIT=ILUSEG,NML=NAM_DYN)
-WRITE(UNIT=ILUSEG,NML=NAM_NESTING)
-!WRITE(UNIT=ILUSEG,NML=NAM_BACKUP)
-!WRITE(UNIT=ILUSEG,NML=NAM_OUTPUT)
-IF(CBUTYPE /= 'NONE') THEN
- IF(CBUTYPE=='SKIP') CBUTYPE='CART'
- WRITE(UNIT=ILUSEG,NML=NAM_BUDGET)
-END IF
-IF(LBU_RU) WRITE(UNIT=ILUSEG,NML=NAM_BU_RU)
-IF(LBU_RV) WRITE(UNIT=ILUSEG,NML=NAM_BU_RV)
-IF(LBU_RW) WRITE(UNIT=ILUSEG,NML=NAM_BU_RW)
-IF(LBU_RTH) WRITE(UNIT=ILUSEG,NML=NAM_BU_RTH)
-IF(LBU_RTKE) WRITE(UNIT=ILUSEG,NML=NAM_BU_RTKE)
-IF(LBU_RRV) WRITE(UNIT=ILUSEG,NML=NAM_BU_RRV)
-IF(LBU_RRC) WRITE(UNIT=ILUSEG,NML=NAM_BU_RRC)
-IF(LBU_RRR) WRITE(UNIT=ILUSEG,NML=NAM_BU_RRR)
-IF(LBU_RRI) WRITE(UNIT=ILUSEG,NML=NAM_BU_RRI)
-IF(LBU_RRS) WRITE(UNIT=ILUSEG,NML=NAM_BU_RRS)
-IF(LBU_RRG) WRITE(UNIT=ILUSEG,NML=NAM_BU_RRG)
-IF(LBU_RRH) WRITE(UNIT=ILUSEG,NML=NAM_BU_RRH)
-IF(LBU_RSV) WRITE(UNIT=ILUSEG,NML=NAM_BU_RSV)
-IF(LLES_MEAN .OR. LLES_RESOLVED .OR. LLES_SUBGRID .OR. LLES_UPDRAFT &
-.OR. LLES_DOWNDRAFT .OR. LLES_SPECTRA) WRITE(UNIT=ILUSEG,NML=NAM_LES)
-IF(LFORCING .OR. LTRANS) WRITE(UNIT=ILUSEG,NML=NAM_FRC)
-IF(CCLOUD(1:3) == 'ICE') CALL PARAM_ICEN_INIT(CPROGRAM, 0, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
-IF(CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO') &
- WRITE(UNIT=ILUSEG,NML=NAM_PARAM_C2R2)
-IF(CCLOUD == 'C3R5' ) WRITE(UNIT=ILUSEG,NML=NAM_PARAM_C1R3)
-IF(CCLOUD == 'LIMA' ) CALL PARAM_LIMA_INIT(CPROGRAM, 0, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
-IF(CELEC /= 'NONE') WRITE(UNIT=ILUSEG,NML=NAM_ELEC)
-IF(LSERIES) WRITE(UNIT=ILUSEG,NML=NAM_SERIES)
-IF(CTURB /= 'NONE') CALL TURBN_INIT(CPROGRAM, 0, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
-CALL NEBN_INIT(CPROGRAM, 0, .FALSE., ILUSEG, .FALSE., .FALSE., .FALSE., 1)
-WRITE(UNIT=ILUSEG,NML=NAM_FLYERS)
-!Not possible (for the moment): arrays have been deallocated after ini_aircraft: WRITE(UNIT=ILUSEG,NML=NAM_AIRCRAFTS)
-!Not possible (for the moment): arrays have been deallocated after ini_balloon: WRITE(UNIT=ILUSEG,NML=NAM_BALLOONS)
-!
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. WRITE UPDATED DESFM ON OUTPUT LISTING
-! -------------------------------------
-!
-IF (NVERB >= 5) THEN
-!
- ILUOUT = TLUOUT%NLU
-!
- WRITE(UNIT=ILUOUT,FMT="(/,'DESCRIPTOR OF SEGMENT FOR MODEL ',I2)") KMI
- WRITE(UNIT=ILUOUT,FMT="( '------------------------------- ' )")
-!
- WRITE(UNIT=ILUOUT,FMT="('********** LOGICAL UNITSn **********')")
- WRITE(UNIT=ILUOUT,NML=NAM_LUNITn)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** CONFIGURATIONn **********')")
- WRITE(UNIT=ILUOUT,NML=NAM_CONFn)
-!
-!
- WRITE(UNIT=ILUOUT,FMT="('********** DYNAMICn ****************')")
- WRITE(UNIT=ILUOUT,NML=NAM_DYNn)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** ADVECTIONn **************')")
- WRITE(UNIT=ILUOUT,NML=NAM_ADVn)
- !
- IF (LIBM_LSF) THEN
- WRITE(UNIT=ILUOUT,FMT="('********** IBM_PARAMn **************')")
- WRITE(UNIT=ILUOUT,NML=NAM_IBM_PARAMn)
- ENDIF
- !
- IF (LRECYCL) THEN
- WRITE(UNIT=ILUOUT,FMT="('********** RECYCL_PARAMn **************')")
- WRITE(UNIT=ILUOUT,NML=NAM_RECYCL_PARAMn)
- ENDIF
- !
- WRITE(UNIT=ILUOUT,FMT="('********** PARAMETERIZATIONSn ******')")
- WRITE(UNIT=ILUOUT,NML=NAM_PARAMn)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** RADIATIONn **************')")
- WRITE(UNIT=ILUOUT,NML=NAM_PARAM_RADn)
-#ifdef MNH_ECRAD
- WRITE(UNIT=ILUOUT,FMT="('********** ECRADn **************')")
- WRITE(UNIT=ILUOUT,NML=NAM_PARAM_ECRADn)
-#endif
-!
- WRITE(UNIT=ILUOUT,FMT="('********** CONVECTIONn *************')")
- WRITE(UNIT=ILUOUT,NML=NAM_PARAM_KAFRn)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ PARAM_MFSHALLn *******')")
- CALL PARAM_MFSHALLN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** LBCn ********************')")
- WRITE(UNIT=ILUOUT,NML=NAM_LBCn)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** NUDGINGn*****************')")
- WRITE(UNIT=ILUOUT,NML=NAM_NUDGINGn)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** TURBn *******************')")
- CALL TURBN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** NEBn *******************')")
- CALL NEBN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** CHEMICAL MONITORn *******')")
- WRITE(UNIT=ILUOUT,NML=NAM_CH_MNHCn)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ CHEMICAL SOLVERn ******************')")
- WRITE(UNIT=ILUOUT,NML=NAM_CH_SOLVERn)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ TEMPORAL SERIESn ******************')")
- WRITE(UNIT=ILUOUT,NML=NAM_SERIESn)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** BLOWING SNOW SCHEME ****************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BLOWSNOWn)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** BLAZE *******************')")
- WRITE(UNIT=ILUOUT,NML=NAM_FIREn)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** BLANKn *****************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BLANKn)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ ICE SCHEME ***********************')")
- CALL PARAM_ICEN_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
-!
- IF (KMI==1) THEN
- WRITE(UNIT=ILUOUT,FMT="(/,'PART OF SEGMENT FILE COMMON TO ALL THE MODELS')")
- WRITE(UNIT=ILUOUT,FMT="( '---------------------------------------------')")
-!
- WRITE(UNIT=ILUOUT,FMT="('************ CONFIGURATION ********************')")
- WRITE(UNIT=ILUOUT,NML=NAM_CONF)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ DYNAMIC **************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_DYN)
-!
- WRITE(UNIT=ILUOUT,FMT="(/,'********** NESTING **************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_NESTING)
-!
-! WRITE(UNIT=ILUOUT,FMT="(/,'********** BACKUP ***************************')")
-! WRITE(UNIT=ILUOUT,NML=NAM_BACKUP)
-!
-! WRITE(UNIT=ILUOUT,FMT="(/,'********** OUTPUT ***************************')")
-! WRITE(UNIT=ILUOUT,NML=NAM_OUTPUT)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ BUDGET ***************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BUDGET)
-!
- IF ( .NOT. ALLOCATED( CBULIST_RU ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RU(0) )
- WRITE(UNIT=ILUOUT,FMT="('************ U BUDGET *************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BU_RU)
-!
- IF ( .NOT. ALLOCATED( CBULIST_RV ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RV(0) )
- WRITE(UNIT=ILUOUT,FMT="('************ V BUDGET *************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BU_RV)
-!
- IF ( .NOT. ALLOCATED( CBULIST_RW ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RW(0) )
- WRITE(UNIT=ILUOUT,FMT="('************ W BUDGET *************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BU_RW)
-!
- IF ( .NOT. ALLOCATED( CBULIST_RTH ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTH(0) )
- WRITE(UNIT=ILUOUT,FMT="('************ TH BUDGET ************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BU_RTH)
-!
- IF ( .NOT. ALLOCATED( CBULIST_RTKE ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTKE(0) )
- WRITE(UNIT=ILUOUT,FMT="('************ TKE BUDGET ***********************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BU_RTKE)
-!
- IF ( .NOT. ALLOCATED( CBULIST_RRV ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRV(0) )
- WRITE(UNIT=ILUOUT,FMT="('************ RV BUDGET ************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BU_RRV)
-!
- IF ( .NOT. ALLOCATED( CBULIST_RRC ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRC(0) )
- WRITE(UNIT=ILUOUT,FMT="('************ RC BUDGET ************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BU_RRC)
-!
- IF ( .NOT. ALLOCATED( CBULIST_RRR ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRR(0) )
- WRITE(UNIT=ILUOUT,FMT="('************ RR BUDGET ************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BU_RRR)
-!
- IF ( .NOT. ALLOCATED( CBULIST_RRI ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRI(0) )
- WRITE(UNIT=ILUOUT,FMT="('************ RI BUDGET ************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BU_RRI)
-!
- IF ( .NOT. ALLOCATED( CBULIST_RRS ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRS(0) )
- WRITE(UNIT=ILUOUT,FMT="('************ RS BUDGET ************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BU_RRS)
-!
- IF ( .NOT. ALLOCATED( CBULIST_RRG ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRG(0) )
- WRITE(UNIT=ILUOUT,FMT="('************ RG BUDGET ************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BU_RRG)
-!
- IF ( .NOT. ALLOCATED( CBULIST_RRH ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRH(0) )
- WRITE(UNIT=ILUOUT,FMT="('************ RH BUDGET ************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BU_RRH)
-!
- IF ( .NOT. ALLOCATED( CBULIST_RSV ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RSV(0) )
- WRITE(UNIT=ILUOUT,FMT="('************ SVx BUDGET ***********************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BU_RSV)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ LES ******************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_LES)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ FORCING **************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_FRC)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** DUST SCHEME ************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_DUST)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** PASPOL *****************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_PASPOL)
-!
-#ifdef MNH_FOREFIRE
- WRITE(UNIT=ILUOUT,FMT="('********** FOREFIRE *****************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_FOREFIRE)
-!
-#endif
-!
- WRITE(UNIT=ILUOUT,FMT="('********** CONDSAMP****************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_CONDSAMP)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** SALT SCHEME ************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_SALT)
-!
- WRITE(UNIT=ILUOUT,FMT="('********** BLOWING SNOW SCHEME ****************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BLOWSNOW)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ ORILAM SCHEME ********************')")
- WRITE(UNIT=ILUOUT,NML=NAM_CH_ORILAM)
-!
- IF( CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5') THEN
- WRITE(UNIT=ILUOUT,FMT="('*********** C2R2 SCHEME *********************')")
- WRITE(UNIT=ILUOUT,NML=NAM_PARAM_C2R2)
- IF( CCLOUD == 'C3R5' ) THEN
- WRITE(UNIT=ILUOUT,FMT="('*********** C1R3 SCHEME *********************')")
- WRITE(UNIT=ILUOUT,NML=NAM_PARAM_C1R3)
- END IF
- END IF
-!
- IF( CCLOUD == 'LIMA' ) THEN
- WRITE(UNIT=ILUOUT,FMT="('*********** LIMA SCHEME *********************')")
- CALL PARAM_LIMA_INIT(CPROGRAM, 0, .FALSE., ILUOUT, .FALSE., .FALSE., .FALSE., 2)
- END IF
-!
- IF( CCLOUD == 'KHKO' ) THEN
- WRITE(UNIT=ILUOUT,FMT="('*********** KHKO SCHEME *********************')")
- WRITE(UNIT=ILUOUT,NML=NAM_PARAM_C2R2)
- END IF
-!
- IF( CELEC /= 'NONE' ) THEN
- WRITE(UNIT=ILUOUT,FMT="('*********** ELEC SCHEME *********************')")
- WRITE(UNIT=ILUOUT,NML=NAM_ELEC)
- END IF
-!
- WRITE(UNIT=ILUOUT,FMT="('************ TEMPORAL SERIES ****************')")
- WRITE(UNIT=ILUOUT,NML=NAM_SERIES)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ MIXING LENGTH FOR CLOUD ***********')")
- WRITE(UNIT=ILUOUT,NML=NAM_TURB_CLOUD)
-!
- END IF
-!
-END IF
-!
-IF (CPROGRAM /='MESONH') THEN !return to previous LHORELAX_
- LHORELAX_UVWTH = GHORELAX_UVWTH
- LHORELAX_RV = GHORELAX_RV
- LHORELAX_RC = GHORELAX_RC
- LHORELAX_RR = GHORELAX_RR
- LHORELAX_RI = GHORELAX_RI
- LHORELAX_RS = GHORELAX_RS
- LHORELAX_RG = GHORELAX_RG
- LHORELAX_TKE = GHORELAX_TKE
- LHORELAX_SV(:) = GHORELAX_SV(:)
- LHORELAX_SVC2R2= GHORELAX_SVC2R2
- LHORELAX_SVC1R3= GHORELAX_SVC1R3
- LHORELAX_SVLIMA= GHORELAX_SVLIMA
- LHORELAX_SVELEC= GHORELAX_SVELEC
- LHORELAX_SVCHEM= GHORELAX_SVCHEM
- LHORELAX_SVCHIC= GHORELAX_SVCHIC
- LHORELAX_SVLG = .FALSE.
- LHORELAX_SVDST = GHORELAX_SVDST
- LHORELAX_SVSLT = GHORELAX_SVSLT
- LHORELAX_SVPP = GHORELAX_SVPP
- LHORELAX_SVFIRE = GHORELAX_SVFIRE
-#ifdef MNH_FOREFIRE
- LHORELAX_SVFF = GHORELAX_SVFF
-#endif
- LHORELAX_SVCS = GHORELAX_SVCS
- LHORELAX_SVAER = GHORELAX_SVAER
- LHORELAX_SVSNW = GHORELAX_SVSNW
-ELSE
- LHORELAX_SV(:) = GHORELAX_SV(:)
-ENDIF
-CALL UPDATE_NAM_DYNn
-!------------------------------------------------------------------------------
-!
-END SUBROUTINE WRITE_DESFM_n
diff --git a/src/mesonh/ext/write_lesn.f90 b/src/mesonh/ext/write_lesn.f90
deleted file mode 100644
index 44f915343d63daec3f7f285412ab3fdb75b6fd2d..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/write_lesn.f90
+++ /dev/null
@@ -1,1319 +0,0 @@
-!MNH_LIC Copyright 2000-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 mode_write_les_n
-!######################
-
-use modd_field, only: tfieldmetadata_base
-
-implicit none
-
-private
-
-public :: Write_les_n
-
-
-character(len=:), allocatable :: cgroup
-character(len=:), allocatable :: cgroupcomment
-
-logical :: ldoavg ! Compute and store time average
-logical :: ldonorm ! Compute and store normalized field
-
-type(tfieldmetadata_base) :: tfield
-type(tfieldmetadata_base) :: tfieldx
-type(tfieldmetadata_base) :: tfieldy
-
-interface Les_diachro_write
- module procedure Les_diachro_write_1D, Les_diachro_write_2D, Les_diachro_write_3D, Les_diachro_write_4D
-end interface
-
-contains
-
-!###################################
-subroutine Write_les_n( tpdiafile )
-!###################################
-!
-!
-!!**** *WRITE_LES_n* writes the LES final diagnostics for model _n
-!!
-!!
-!! PURPOSE
-!! -------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 07/02/00
-!! 01/02/01 (D. Gazen) add module MODD_NSV for NSV variable
-!! 06/11/02 (V. Masson) some minor bugs
-!! 01/04/03 (V. Masson) idem
-!! 10/10/09 (P. Aumond) Add user multimaskS
-!! 11/15 (C.Lac) Add production terms of TKE
-!! 10/2016 (C.Lac) Add droplet deposition
-! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
-! C. Lac 02/2019: add rain fraction as a LES diagnostic
-! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
-! P. Wautelet 12/10/2020: remove HLES_AVG dummy argument and group all 4 calls
-! P. Wautelet 13/10/2020: bugfix: correct some names for LES_DIACHRO_2PT diagnostics (Ri)
-! P. Wautelet 26/10/2020: bugfix: correct some comments and conditions + add missing RES_RTPZ
-! P. Wautelet 26/10/2020: restructure subroutines to use tfieldmetadata_base type
-! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-use modd_conf_n, only: luserv, luserc, luserr, luseri, lusers, luserg, luserh
-use modd_io, only: tfiledata
-use modd_field, only: NMNHDIM_BUDGET_LES_TIME, NMNHDIM_BUDGET_LES_LEVEL, NMNHDIM_BUDGET_LES_SV, NMNHDIM_BUDGET_LES_MASK, &
- NMNHDIM_BUDGET_LES_PDF, &
- NMNHDIM_SPECTRA_2PTS_NI, NMNHDIM_SPECTRA_2PTS_NJ, NMNHDIM_SPECTRA_LEVEL, NMNHDIM_UNUSED, &
- TYPEREAL
-use modd_grid_n, only: xdxhat, xdyhat
-use modd_nsv, only: nsv
-use modd_les
-use modd_les_n
-use modd_param_n, only: ccloud
-use modd_param_c2r2, only: ldepoc
-USE MODD_PARAM_ICE_n, only: ldeposc
-use modd_parameters, only: XUNDEF
-
-use mode_les_spec_n, only: Les_spec_n
-use mode_modeln_handler, only: Get_current_model_index
-use mode_write_les_budget_n, only: Write_les_budget_n
-use mode_write_les_rt_budget_n, only: Write_les_rt_budget_n
-use mode_write_les_sv_budget_n, only: Write_les_sv_budget_n
-
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE! file to write
-!
-!
-!* 0.2 declaration of local variables
-!
-INTEGER :: IMASK
-!
-INTEGER :: JSV ! scalar loop counter
-INTEGER :: JI ! loop counter
-!
-character(len=3) :: ynum
-CHARACTER(len=5) :: YGROUP
-character(len=7), dimension(nles_masks) :: ymasks
-!
-logical :: gdoavg ! Compute and store time average
-logical :: gdonorm ! Compute and store normalized field
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZAVG_PTS_ll
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZUND_PTS_ll
-REAL :: ZCART_PTS_ll
-INTEGER :: IMI ! Current model inde
-!
-!-------------------------------------------------------------------------------
-!
-IF (.NOT. LLES) RETURN
-!
-!
-!* 1. Initializations
-! ---------------
-!
-IMI = GET_CURRENT_MODEL_INDEX()
-!
-!
-!* 1.1 Normalization variables
-! -----------------------
-!
-IF (CLES_NORM_TYPE/='NONE' ) THEN
- CALL LES_ALLOCATE('XLES_NORM_M', (/NLES_TIMES/))
- CALL LES_ALLOCATE('XLES_NORM_S', (/NLES_TIMES/))
- CALL LES_ALLOCATE('XLES_NORM_K', (/NLES_TIMES/))
- CALL LES_ALLOCATE('XLES_NORM_RHO',(/NLES_TIMES/))
- CALL LES_ALLOCATE('XLES_NORM_RV', (/NLES_TIMES/))
- CALL LES_ALLOCATE('XLES_NORM_SV', (/NLES_TIMES,NSV/))
- CALL LES_ALLOCATE('XLES_NORM_P', (/NLES_TIMES/))
- !
- IF (CLES_NORM_TYPE=='CONV') THEN
- WHERE (XLES_WSTAR(:)>0.)
- XLES_NORM_M(:) = XLES_BL_HEIGHT(:)
- XLES_NORM_S(:) = XLES_NORM_M(:) / XLES_WSTAR(:)
- XLES_NORM_K(:) = XLES_Q0(:) / XLES_WSTAR(:)
- XLES_NORM_RHO(:) = XLES_MEAN_RHO(1,:,1)
- XLES_NORM_RV(:) = XLES_E0(:) / XLES_WSTAR(:)
- XLES_NORM_P(:) = XLES_MEAN_RHO(1,:,1) * XLES_WSTAR(:)**2
- ELSEWHERE
- XLES_NORM_M(:) = 0.
- XLES_NORM_S(:) = 0.
- XLES_NORM_K(:) = 0.
- XLES_NORM_RHO(:) = 0.
- XLES_NORM_RV(:) = 0.
- XLES_NORM_P(:) = 0.
- END WHERE
- DO JSV=1,NSV
- WHERE (XLES_WSTAR(:)>0.)
- XLES_NORM_SV(:,JSV)= XLES_SV0(:,JSV) / XLES_WSTAR(:)
- ELSEWHERE
- XLES_NORM_SV(:,JSV)= 0.
- END WHERE
- END DO
- ELSE IF (CLES_NORM_TYPE=='EKMA') THEN
- WHERE (XLES_USTAR(:)>0.)
- XLES_NORM_M(:) = XLES_BL_HEIGHT(:)
- XLES_NORM_S(:) = XLES_NORM_M(:) / XLES_USTAR(:)
- XLES_NORM_K(:) = XLES_Q0(:) / XLES_USTAR(:)
- XLES_NORM_RHO(:) = XLES_MEAN_RHO(1,:,1)
- XLES_NORM_RV(:) = XLES_E0(:) / XLES_USTAR(:)
- XLES_NORM_P(:) = XLES_MEAN_RHO(1,:,1) * XLES_USTAR(:)**2
- ELSEWHERE
- XLES_NORM_M(:) = 0.
- XLES_NORM_S(:) = 0.
- XLES_NORM_K(:) = 0.
- XLES_NORM_RHO(:) = 0.
- XLES_NORM_RV(:) = 0.
- XLES_NORM_P(:) = 0.
- END WHERE
- DO JSV=1,NSV
- WHERE (XLES_USTAR(:)>0.)
- XLES_NORM_SV(:,JSV)= XLES_SV0(:,JSV) / XLES_USTAR(:)
- ELSEWHERE
- XLES_NORM_SV(:,JSV)= 0.
- END WHERE
- END DO
- ELSE IF (CLES_NORM_TYPE=='MOBU') THEN
- XLES_NORM_M(:) = XLES_MO_LENGTH(:)
- WHERE (XLES_USTAR(:)>0.)
- XLES_NORM_S(:) = XLES_NORM_M(:) / XLES_USTAR(:)
- XLES_NORM_K(:) = XLES_Q0(:) / XLES_USTAR(:)
- XLES_NORM_RHO(:) = XLES_MEAN_RHO(1,:,1)
- XLES_NORM_RV(:) = XLES_E0(:) / XLES_USTAR(:)
- XLES_NORM_P(:) = XLES_MEAN_RHO(1,:,1) * XLES_USTAR(:)**2
- ELSEWHERE
- XLES_NORM_S(:) = 0.
- XLES_NORM_K(:) = 0.
- XLES_NORM_RHO(:) = 0.
- XLES_NORM_RV(:) = 0.
- XLES_NORM_P(:) = 0.
- END WHERE
- DO JSV=1,NSV
- WHERE (XLES_USTAR(:)>0.)
- XLES_NORM_SV(:,JSV)= XLES_SV0(:,JSV) / XLES_USTAR(:)
- ELSEWHERE
- XLES_NORM_SV(:,JSV)= 0.
- END WHERE
- END DO
- END IF
-END IF
-!
-!* 1.2 Initializations for WRITE_DIACHRO
-! ---------------------------------
-!
-NLES_CURRENT_TIMES=NLES_TIMES
-!
-CALL LES_ALLOCATE('XLES_CURRENT_Z',(/NLES_K/))
-
-XLES_CURRENT_Z(:) = XLES_Z(:)
-!
-XLES_CURRENT_ZS = XLES_ZS
-!
-NLES_CURRENT_IINF=NLESn_IINF(IMI)
-NLES_CURRENT_ISUP=NLESn_ISUP(IMI)
-NLES_CURRENT_JINF=NLESn_JINF(IMI)
-NLES_CURRENT_JSUP=NLESn_JSUP(IMI)
-!
-XLES_CURRENT_DOMEGAX=XDXHAT(1)
-XLES_CURRENT_DOMEGAY=XDYHAT(1)
-
-tfield%ngrid = 0 !Not on the Arakawa grid
-tfield%ntype = TYPEREAL
-!
-!* 2. (z,t) profiles (all masks)
-! --------------
-IMASK = 1
-ymasks(imask) = 'cart'
-IF (LLES_NEB_MASK) THEN
- IMASK=IMASK+1
- ymasks(imask) = 'neb'
- IMASK=IMASK+1
- ymasks(imask) = 'clear'
-END IF
-IF (LLES_CORE_MASK) THEN
- IMASK=IMASK+1
- ymasks(imask) = 'core'
- IMASK=IMASK+1
- ymasks(imask) = 'env'
-END IF
-IF (LLES_MY_MASK) THEN
- DO JI=1,NLES_MASKS_USER
- IMASK=IMASK+1
- Write( ynum, '( i3.3 )' ) ji
- ymasks(imask) = 'user' // ynum
- END DO
-END IF
-IF (LLES_CS_MASK) THEN
- IMASK=IMASK+1
- ymasks(imask) = 'cs1'
- IMASK=IMASK+1
- ymasks(imask) = 'cs2'
- IMASK=IMASK+1
- ymasks(imask) = 'cs3'
-END IF
-!
-!* 2.0 averaging diagnostics
-! ---------------------
-!
-ALLOCATE(ZAVG_PTS_ll (NLES_K,NLES_TIMES,NLES_MASKS))
-ALLOCATE(ZUND_PTS_ll (NLES_K,NLES_TIMES,NLES_MASKS))
-
-ZAVG_PTS_ll(:,:,:) = NLES_AVG_PTS_ll(:,:,:)
-ZUND_PTS_ll(:,:,:) = NLES_UND_PTS_ll(:,:,:)
-ZCART_PTS_ll = (NLESn_ISUP(IMI)-NLESn_IINF(IMI)+1) * (NLESn_JSUP(IMI)-NLESn_JINF(IMI)+1)
-
-tfield%ndims = 3
-tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
-tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
-tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
-tfield%ndimlist(4:) = NMNHDIM_UNUSED
-
-ldoavg = xles_temp_mean_start /= XUNDEF .and. xles_temp_mean_end /= XUNDEF
-ldonorm = .false.
-
-cgroup = 'Miscellaneous'
-cgroupcomment = 'Miscellaneous terms (geometry, various unclassified averaged terms...)'
-
-call Les_diachro_write( tpdiafile, zavg_pts_ll, 'AVG_PTS', 'number of points used for averaging', '1', ymasks )
-call Les_diachro_write( tpdiafile, zavg_pts_ll / zcart_pts_ll, 'AVG_PTSF', 'fraction of points used for averaging', '1', ymasks )
-call Les_diachro_write( tpdiafile, zund_pts_ll, 'UND_PTS', 'number of points below orography', '1', ymasks )
-call Les_diachro_write( tpdiafile, zund_pts_ll / zcart_pts_ll, 'UND_PTSF', 'fraction of points below orography', '1', ymasks )
-
-DEALLOCATE(ZAVG_PTS_ll)
-DEALLOCATE(ZUND_PTS_ll)
-!
-!* 2.1 mean quantities
-! ---------------
-!
-cgroup = 'Mean'
-cgroupcomment = 'Mean vertical profiles of the model variables'
-
-tfield%ndims = 3
-tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
-tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
-tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
-tfield%ndimlist(4:) = NMNHDIM_UNUSED
-
-ldoavg = xles_temp_mean_start /= XUNDEF .and. xles_temp_mean_end /= XUNDEF
-ldonorm = trim(cles_norm_type) /= 'NONE'
-
-call Les_diachro_write( tpdiafile, XLES_MEAN_U, 'MEAN_U', 'Mean U Profile', 'm s-1', ymasks )
-call Les_diachro_write( tpdiafile, XLES_MEAN_V, 'MEAN_V', 'Mean V Profile', 'm s-1', ymasks )
-call Les_diachro_write( tpdiafile, XLES_MEAN_W, 'MEAN_W', 'Mean W Profile', 'm s-1', ymasks )
-call Les_diachro_write( tpdiafile, XLES_MEAN_P, 'MEAN_PRE', 'Mean pressure Profile', 'Pa', ymasks )
-call Les_diachro_write( tpdiafile, XLES_MEAN_DP, 'MEAN_DP', 'Mean Dyn production TKE Profile', 'm2 s-3', ymasks )
-call Les_diachro_write( tpdiafile, XLES_MEAN_TP, 'MEAN_TP', 'Mean Thermal production TKE Profile', 'm2 s-3', ymasks )
-call Les_diachro_write( tpdiafile, XLES_MEAN_TR, 'MEAN_TR', 'Mean transport production TKE Profile', 'm2 s-3', ymasks )
-call Les_diachro_write( tpdiafile, XLES_MEAN_DISS, 'MEAN_DISS', 'Mean Dissipation TKE Profile', 'm2 s-3', ymasks )
-call Les_diachro_write( tpdiafile, XLES_MEAN_LM, 'MEAN_LM', 'Mean mixing length Profile', 'm', ymasks )
-call Les_diachro_write( tpdiafile, XLES_MEAN_RHO, 'MEAN_RHO', 'Mean density Profile', 'kg m-3', ymasks )
-call Les_diachro_write( tpdiafile, XLES_MEAN_Th, 'MEAN_TH', 'Mean potential temperature Profile', 'K', ymasks )
-call Les_diachro_write( tpdiafile, XLES_MEAN_Mf, 'MEAN_MF', 'Mass-flux Profile', 'm s-1', ymasks )
-if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_Thl, 'MEAN_THL', 'Mean liquid potential temperature Profile', 'K', ymasks )
-if ( luserv ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_Thv, 'MEAN_THV', 'Mean virtual potential temperature Profile', 'K', ymasks )
-if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_Rt, 'MEAN_RT', 'Mean Rt Profile', 'kg kg-1', ymasks )
-if ( luserv ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_Rv, 'MEAN_RV', 'Mean Rv Profile', 'kg kg-1', ymasks )
-if ( luserv ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_Rehu, 'MEAN_REHU', 'Mean Rh Profile', 'percent', ymasks )
-if ( luserv ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_Qs, 'MEAN_QS', 'Mean Qs Profile', 'kg kg-1', ymasks )
-if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_KHt, 'MEAN_KHT', 'Eddy-diffusivity (temperature) Profile', 'm2 s-1', ymasks )
-if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_KHr, 'MEAN_KHR', 'Eddy-diffusivity (vapor) Profile', 'm2 s-1', ymasks )
-if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_Rc, 'MEAN_RC', 'Mean Rc Profile', 'kg kg-1', ymasks )
-if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_Cf, 'MEAN_CF', 'Mean Cf Profile', '1', ymasks )
-if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_INDCf, 'MEAN_INDCF', 'Mean Cf>1-6 Profile (0 or 1)', '1', ymasks )
-if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_INDCf2, 'MEAN_INDCF2', 'Mean Cf>1-5 Profile (0 or 1)', '1', ymasks )
-if ( luserr ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_Rr, 'MEAN_RR', 'Mean Rr Profile', 'kg kg-1', ymasks )
-if ( luserr ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_RF, 'MEAN_RF', 'Mean RF Profile', '1', ymasks )
-if ( luseri ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_Ri, 'MEAN_RI', 'Mean Ri Profile', 'kg kg-1', ymasks )
-if ( luseri ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_If, 'MEAN_IF', 'Mean If Profile', '1', ymasks )
-if ( lusers ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_Rs, 'MEAN_RS', 'Mean Rs Profile', 'kg kg-1', ymasks )
-if ( luserg ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_Rg, 'MEAN_RG', 'Mean Rg Profile', 'kg kg-1', ymasks )
-if ( luserh ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_Rh, 'MEAN_RH', 'Mean Rh Profile', 'kg kg-1', ymasks )
-
-if ( nsv > 0 ) then
- tfield%ndims = 4
- tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
- tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
- tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
- tfield%ndimlist(4) = NMNHDIM_BUDGET_LES_SV
- tfield%ndimlist(5:) = NMNHDIM_UNUSED
-
- call Les_diachro_write( tpdiafile, XLES_MEAN_Sv, 'MEAN_SV', 'Mean Sv Profiles', 'kg kg-1', ymasks )
-
- tfield%ndims = 3
- !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
- !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
- !tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
- tfield%ndimlist(4) = NMNHDIM_UNUSED
- !tfield%ndimlist(5:) = NMNHDIM_UNUSED
-end if
-
-call Les_diachro_write( tpdiafile, XLES_MEAN_WIND, 'MEANWIND', 'Profile of Mean Modulus of Wind', 'm s-1', ymasks )
-call Les_diachro_write( tpdiafile, XLES_RESOLVED_MASSFX, 'MEANMSFX', 'Total updraft mass flux', 'kg m-2 s-1', ymasks )
-
-if ( lles_pdf ) then
- cgroup = 'PDF'
- cgroupcomment = ''
-
- tfield%ndims = 4
- !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
- !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
- !tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
- tfield%ndimlist(4) = NMNHDIM_BUDGET_LES_PDF
- tfield%ndimlist(5:) = NMNHDIM_UNUSED
-
- call Les_diachro_write( tpdiafile, XLES_PDF_TH, 'PDF_TH', 'Pdf potential temperature Profiles', '1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_PDF_W, 'PDF_W', 'Pdf vertical velocity Profiles', '1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_PDF_THV, 'PDF_THV', 'Pdf virtual pot. temp. Profiles', '1', ymasks )
- if ( luserv ) &
- call Les_diachro_write( tpdiafile, XLES_PDF_RV, 'PDF_RV', 'Pdf Rv Profiles', '1', ymasks )
- if ( luserc ) then
- call Les_diachro_write( tpdiafile, XLES_PDF_RC, 'PDF_RC', 'Pdf Rc Profiles', '1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_PDF_RT, 'PDF_RT', 'Pdf Rt Profiles', '1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_PDF_THL, 'PDF_THL', 'Pdf Thl Profiles', '1', ymasks )
- end if
- if ( luserr ) &
- call Les_diachro_write( tpdiafile, XLES_PDF_RR, 'PDF_RR', 'Pdf Rr Profiles', '1', ymasks )
- if ( luseri ) &
- call Les_diachro_write( tpdiafile, XLES_PDF_RI, 'PDF_RI', 'Pdf Ri Profiles', '1', ymasks )
- if ( lusers ) &
- call Les_diachro_write( tpdiafile, XLES_PDF_RS, 'PDF_RS', 'Pdf Rs Profiles', '1', ymasks )
- if ( luserg ) &
- call Les_diachro_write( tpdiafile, XLES_PDF_RG, 'PDF_RG', 'Pdf Rg Profiles', '1', ymasks )
-end if
-!
-!* 2.2 resolved quantities
-! -------------------
-!
-if ( lles_resolved ) then
- !Prepare metadata (used in Les_diachro_write calls)
- ldoavg = xles_temp_mean_start /= XUNDEF .and. xles_temp_mean_end /= XUNDEF
- ldonorm = trim(cles_norm_type) /= 'NONE'
-
- cgroup = 'Resolved'
- cgroupcomment = 'Mean vertical profiles of the resolved fluxes, variances and covariances'
-
- tfield%ndims = 3
- tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
- tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
- tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
- tfield%ndimlist(4:) = NMNHDIM_UNUSED
-
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_U2, 'RES_U2', 'Resolved <u2> variance', 'm2 s-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_V2, 'RES_V2', 'Resolved <v2> variance', 'm2 s-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2, 'RES_W2', 'Resolved <w2> variance', 'm2 s-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_UV, 'RES_UV', 'Resolved <uv> Flux', 'm2 s-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WU, 'RES_WU', 'Resolved <wu> Flux', 'm2 s-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WV, 'RES_WV', 'Resolved <wv> Flux', 'm2 s-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_Ke, 'RES_KE', 'Resolved TKE Profile', 'm2 s-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_P2, 'RES_P2', 'Resolved pressure variance', 'Pa2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_UP, 'RES_UPZ', 'Resolved <up> horizontal Flux', 'Pa s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_VP, 'RES_VPZ', 'Resolved <vp> horizontal Flux', 'Pa s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WP, 'RES_WPZ', 'Resolved <wp> vertical Flux', 'Pa s-1', ymasks )
-
- if ( luserv ) &
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThThv, 'RES_THTV', &
- 'Resolved potential temperature - virtual potential temperature covariance', 'K2', ymasks )
- if ( luserc ) &
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThlThv, 'RES_TLTV', &
- 'Resolved liquid potential temperature - virtual potential temperature covariance', 'K2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_Th2, 'RES_TH2', 'Resolved potential temperature variance', 'K2', ymasks )
- if ( luserc ) &
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_Thl2, 'RES_THL2', 'Resolved liquid potential temperature variance', 'K2',&
- ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_UTh, 'RES_UTH', 'Resolved <uth> horizontal Flux', 'm K s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_VTh, 'RES_VTH', 'Resolved <vth> horizontal Flux', 'm K s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WTh, 'RES_WTH', 'Resolved <wth> vertical Flux', 'm K s-1', ymasks )
-
- if ( luserc ) then
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_UThl, 'RES_UTHL', 'Resolved <uthl> horizontal Flux', 'm K s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_VThl, 'RES_VTHL', 'Resolved <vthl> horizontal Flux', 'm K s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThl, 'RES_WTHL', 'Resolved <wthl> vertical Flux', 'm K s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_Rt2, 'RES_RT2', 'Resolved total water variance', 'kg2 kg-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRt, 'RES_WRT', 'Resolved <wrt> vertical Flux', 'm kg kg-1 s-1', ymasks )
- end if
-
- if ( luserv ) then
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_UThv, 'RES_UTHV', 'Resolved <uthv> horizontal Flux', 'm K s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_VThv, 'RES_VTHV', 'Resolved <vthv> horizontal Flux', 'm K s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThv, 'RES_WTHV', 'Resolved <wthv> vertical Flux', 'm K s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_Rv2, 'RES_RV2', 'Resolved water vapor variance', 'kg2 kg-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThRv, 'RES_THRV', 'Resolved <thrv> covariance', 'K kg kg-1', ymasks )
- if ( luserc ) &
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThlRv, 'RES_TLRV', 'Resolved <thlrv> covariance', 'K kg kg-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThvRv, 'RES_TVRV', 'Resolved <thvrv> covariance', 'K kg kg-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_URv, 'RES_URV', 'Resolved <urv> horizontal flux', 'm kg kg-1 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_VRv, 'RES_VRV', 'Resolved <vrv> horizontal flux', 'm kg kg-1 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRv, 'RES_WRV', 'Resolved <wrv> vertical flux', 'm kg kg-1 s-1', ymasks )
- end if
-
- if ( luserc ) then
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_Rc2, 'RES_RC2', 'Resolved cloud water variance', 'kg2 kg-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThRc, 'RES_THRC', 'Resolved <thrc> covariance', 'K kg kg-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThlRc, 'RES_TLRC', 'Resolved <thlrc> covariance', 'K kg kg-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThvRc, 'RES_TVRC', 'Resolved <thvrc> covariance', 'K kg kg-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_URc, 'RES_URC', 'Resolved <urc> horizontal flux', 'm kg kg-1 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_VRc, 'RES_VRC', 'Resolved <vrc> horizontal flux', 'm kg kg-1 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRc, 'RES_WRC', 'Resolved <wrc> vertical flux', 'm kg kg-1 s-1', ymasks )
- end if
-
- if ( luseri ) then
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_Ri2, 'RES_RI2', 'Resolved cloud ice variance', 'kg2 kg-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThRi, 'RES_THRI', 'Resolved <thri> covariance', 'K kg kg-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThlRi, 'RES_TLRI', 'Resolved <thlri> covariance', 'K kg kg-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThvRi, 'RES_TVRI', 'Resolved <thvri> covariance', 'K kg kg-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_URi, 'RES_URI', 'Resolved <uri> horizontal flux', 'm kg kg-1 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_VRi, 'RES_VRI', 'Resolved <vri> horizontal flux', 'm kg kg-1 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRi, 'RES_WRI', 'Resolved <wri> vertical flux', 'm kg kg-1 s-1', ymasks )
- end if
-
- if ( luserr ) then
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRr, 'RES_WRR', 'Resolved <wrr> vertical flux', 'm kg kg-1 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_INPRR3D, 'INPRR3D', 'Precipitation flux', 'm s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_MAX_INPRR3D, 'MAXINPR3D', 'Max Precip flux', 'm s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_EVAP3D, 'EVAP3D', 'Evaporation profile', 'kg kg-1 s-1', ymasks )
- end if
-
- if ( nsv > 0 ) then
- tfield%ndims = 4
- tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
- tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
- tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
- tfield%ndimlist(4) = NMNHDIM_BUDGET_LES_SV
- tfield%ndimlist(5:) = NMNHDIM_UNUSED
-
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_Sv2, 'RES_SV2', 'Resolved scalar variables variances', 'kg2 kg-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThSv, 'RES_THSV', 'Resolved <ThSv> variance', 'K kg kg-1', ymasks )
- if ( luserc ) &
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThlSv, 'RES_TLSV', 'Resolved <ThlSv> variance', 'K kg kg-1', ymasks )
- if ( luserv ) &
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThvSv, 'RES_TVSV', 'Resolved <ThvSv> variance', 'K kg kg-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_USv, 'RES_USV', 'Resolved <uSv> horizontal flux', 'm kg kg-1 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_VSv, 'RES_VSV', 'Resolved <vSv> horizontal flux', 'm kg kg-1 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WSv, 'RES_WSV', 'Resolved <wSv> vertical flux', 'm kg kg-1 s-1', ymasks )
-
- tfield%ndims = 3
- !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
- !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
- !tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
- tfield%ndimlist(4) = NMNHDIM_UNUSED
- !tfield%ndimlist(5:) = NMNHDIM_UNUSED
- end if
-
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_U3, 'RES_U3', 'Resolved <u3>', 'm3 s-3', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_V3, 'RES_V3', 'Resolved <v3>', 'm3 s-3', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_W3, 'RES_W3', 'Resolved <w3>', 'm3 s-3', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_U4, 'RES_U4', 'Resolved <u4>', 'm4 s-4', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_V4, 'RES_V4', 'Resolved <v4>', 'm4 s-4', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_W4, 'RES_W4', 'Resolved <w4>', 'm4 s-4', ymasks )
-
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThl2, 'RES_WTL2', 'Resolved <wThl2>', 'm K2 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2Thl, 'RES_W2TL', 'Resolved <w2Thl>', 'm2 K s-2', ymasks )
-
- if ( luserv ) then
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRv2, 'RES_WRV2', 'Resolved <wRv2>', 'm kg2 kg-2 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2Rv, 'RES_W2RV', 'Resolved <w2Rv>', 'm2 kg kg-1 s-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRt2, 'RES_WRT2', 'Resolved <wRt2>', 'm kg2 kg-2 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2Rt, 'RES_W2RT', 'Resolved <w2Rt>', 'm2 kg kg-1 s-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThlRv, 'RE_WTLRV', 'Resolved <wThlRv>', 'm K kg kg-1 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThlRt, 'RE_WTLRT', 'Resolved <wThlRt>', 'm K kg kg-1 s-1', ymasks )
- end if
-
- if ( luserc ) then
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRc2, 'RES_WRC2', 'Resolved <wRc2>', 'm kg2 kg-2 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2Rc, 'RES_W2RC', 'Resolved <w2Rc>', 'm2 kg kg-1 s-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThlRc, 'RE_WTLRC', 'Resolved <wThlRc>', 'm K kg kg-1 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRvRc, 'RE_WRVRC', 'Resolved <wRvRc>', 'm kg2 kg-2 s-1', ymasks )
- end if
-
- if ( luseri ) then
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRi2, 'RES_WRI2', 'Resolved <wRi2>', 'm kg2 kg-2 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2Ri, 'RES_W2RI', 'Resolved <w2Ri>', 'm2 kg kg-1 s-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThlRi, 'RE_WTLRI', 'Resolved <wThlRi>', 'm K kg kg-1 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRvRi, 'RE_WRVRI', 'Resolved <wRvRi>', 'm kg2 kg-2 s-1', ymasks )
- end if
-
- if ( nsv > 0 ) then
- tfield%ndims = 4
- tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
- tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
- tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
- tfield%ndimlist(4) = NMNHDIM_BUDGET_LES_SV
- tfield%ndimlist(5:) = NMNHDIM_UNUSED
-
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WSv2, 'RES_WSV2', 'Resolved <wSv2>', 'm kg2 kg-2 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2Sv, 'RES_W2SV', 'Resolved <w2Sv>', 'm2 kg kg-1 s-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThlSv, 'RE_WTLSV', 'Resolved <wThlSv>', 'm K kg kg-1 s-1', ymasks )
- if ( luserv ) &
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRvSv, 'RE_WRVSV', 'Resolved <wRvSv>', 'm kg2 kg-2 s-1', ymasks )
-
- tfield%ndims = 3
- !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
- !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
- !tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
- tfield%ndimlist(4) = NMNHDIM_UNUSED
- !tfield%ndimlist(5:) = NMNHDIM_UNUSED
- end if
-
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThlPz, 'RES_TLPZ', 'Resolved <Thldp/dz>', 'K Pa m-1', ymasks )
- if ( luserc ) &
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_RtPz, 'RES_RTPZ', 'Resolved <Rtdp/dz>', 'kg2 kg-2 Pa m-1', ymasks )
- if ( luserv ) &
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_RvPz, 'RES_RVPZ', 'Resolved <Rvdp/dz>', 'kg2 kg-2 Pa m-1', ymasks )
- if ( luserc ) &
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_RcPz, 'RES_RCPZ', 'Resolved <Rcdp/dz>', 'kg2 kg-2 Pa m-1', ymasks )
- if ( luseri ) &
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_RiPz, 'RES_RIPZ', 'Resolved <Ridp/dz>', 'kg2 kg-2 Pa m-1', ymasks )
-
- if ( nsv > 0 ) then
- tfield%ndims = 4
- tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
- tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
- tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
- tfield%ndimlist(4) = NMNHDIM_BUDGET_LES_SV
- tfield%ndimlist(5:) = NMNHDIM_UNUSED
-
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_SvPz, 'RES_SVPZ', 'Resolved <Svdp/dz>', 'kg2 kg-2 Pa m-1', ymasks )
-
- tfield%ndims = 3
- !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
- !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
- !tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
- tfield%ndimlist(4) = NMNHDIM_UNUSED
- !tfield%ndimlist(5:) = NMNHDIM_UNUSED
- end if
-
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_UKe, 'RES_UKE', 'Resolved flux of resolved kinetic energy', 'm3 s-3', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_VKe, 'RES_VKE', 'Resolved flux of resolved kinetic energy', 'm3 s-3', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WKe, 'RES_WKE', 'Resolved flux of resolved kinetic energy', 'm3 s-3', ymasks )
-end if
-!
-!
-!* 2.3 subgrid quantities
-! ------------------
-!
-if ( lles_subgrid ) then
- !Prepare metadata (used in Les_diachro_write calls)
- ldoavg = xles_temp_mean_start /= XUNDEF .and. xles_temp_mean_end /= XUNDEF
- ldonorm = trim(cles_norm_type) /= 'NONE'
-
- cgroup = 'Subgrid'
- cgroupcomment = 'Mean vertical profiles of the subgrid fluxes, variances and covariances'
-
- tfield%ndims = 3
- tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
- tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
- tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
- tfield%ndimlist(4:) = NMNHDIM_UNUSED
-
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_Tke, 'SBG_TKE', 'Subgrid TKE', 'm2 s-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_U2, 'SBG_U2', 'Subgrid <u2> variance', 'm2 s-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_V2, 'SBG_V2', 'Subgrid <v2> variance', 'm2 s-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_W2, 'SBG_W2', 'Subgrid <w2> variance', 'm2 s-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_UV, 'SBG_UV', 'Subgrid <uv> flux', 'm2 s-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_WU, 'SBG_WU', 'Subgrid <wu> flux', 'm2 s-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_WV, 'SBG_WV', 'Subgrid <wv> flux', 'm2 s-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_Thl2, 'SBG_THL2', 'Subgrid liquid potential temperature variance', &
- 'K2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_UThl, 'SBG_UTHL', 'Subgrid horizontal flux of liquid potential temperature', &
- 'm K s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_VThl, 'SBG_VTHL', 'Subgrid horizontal flux of liquid potential temperature', &
- 'm K s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_WThl, 'SBG_WTHL', 'Subgrid vertical flux of liquid potential temperature', &
- 'm K s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_WP, 'SBG_WP', 'Subgrid <wp> vertical Flux', 'm Pa s-1', ymasks )
-
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_THLUP_MF, 'THLUP_MF', 'Subgrid <thl> of updraft', 'K', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_RTUP_MF, 'RTUP_MF', 'Subgrid <rt> of updraft', 'kg kg-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_RVUP_MF, 'RVUP_MF', 'Subgrid <rv> of updraft', 'kg kg-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_RCUP_MF, 'RCUP_MF', 'Subgrid <rc> of updraft', 'kg kg-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_RIUP_MF, 'RIUP_MF', 'Subgrid <ri> of updraft', 'kg kg-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_WUP_MF, 'WUP_MF', 'Subgrid <w> of updraft', 'm s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_MASSFLUX, 'MAFLX_MF', 'Subgrid <MF> of updraft', 'kg m-2 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_DETR, 'DETR_MF', 'Subgrid <detr> of updraft', 'kg m-3 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_ENTR, 'ENTR_MF', 'Subgrid <entr> of updraft', 'kg m-3 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_FRACUP, 'FRCUP_MF', 'Subgrid <FracUp> of updraft', '1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_THVUP_MF, 'THVUP_MF', 'Subgrid <thv> of updraft', 'K', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_WTHLMF, 'WTHL_MF', 'Subgrid <wthl> of mass flux convection scheme', &
- 'm K s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_WRTMF, 'WRT_MF', 'Subgrid <wrt> of mass flux convection scheme', &
- 'm kg kg-1 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_WTHVMF, 'WTHV_MF', 'Subgrid <wthv> of mass flux convection scheme', &
- 'm K s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_WUMF, 'WU_MF', 'Subgrid <wu> of mass flux convection scheme', &
- 'm2 s-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_WVMF, 'WV_MF', 'Subgrid <wv> of mass flux convection scheme', &
- 'm2 s-2', ymasks )
-
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_PHI3, 'SBG_PHI3', 'Subgrid Phi3 function', '1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_LMix, 'SBG_LMIX', 'Subgrid Mixing Length', '1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_LDiss, 'SBG_LDIS', 'Subgrid Dissipation Length', '1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_Km, 'SBG_KM', 'Eddy diffusivity for momentum', 'm2 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_Kh, 'SBG_KH', 'Eddy diffusivity for heat', 'm2 s-1', ymasks )
-
- if ( luserv ) then
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_WThv, 'SBG_WTHV', 'Subgrid vertical flux of liquid potential temperature', &
- 'm K s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_Rt2, 'SBG_RT2', 'Subgrid total water variance', 'kg2 kg-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_ThlRt, 'SBG_TLRT', 'Subgrid <thlrt> covariance', 'K kg kg-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_URt, 'SBG_URT', 'Subgrid total water horizontal flux', &
- 'm kg kg-1 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_VRt, 'SBG_VRT', 'Subgrid total water horizontal flux', &
- 'm kg kg-1 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_WRt, 'SBG_WRT', 'Subgrid total water vertical flux', &
- 'm kg kg-1 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_PSI3, 'SBG_PSI3', 'Subgrid Psi3 function', '1', ymasks )
- end if
-
- if ( luserc ) then
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_Rc2, 'SBG_RC2', 'Subgrid cloud water variance', 'kg2 kg-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_URc, 'SBG_URC', 'Subgrid cloud water horizontal flux', 'm kg kg-1 s-1', &
- ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_VRc, 'SBG_VRC', 'Subgrid cloud water horizontal flux', 'm kg kg-1 s-1', &
- ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_WRc, 'SBG_WRC', 'Subgrid cloud water vertical flux', 'm kg kg-1 s-1', &
- ymasks )
- end if
-
- if ( nsv > 0 ) then
- tfield%ndims = 4
- tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
- tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
- tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
- tfield%ndimlist(4) = NMNHDIM_BUDGET_LES_SV
- tfield%ndimlist(5:) = NMNHDIM_UNUSED
-
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_USv, 'SBG_USV', 'Subgrid <uSv> horizontal flux', 'm kg kg-1 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_VSv, 'SBG_VSV', 'Subgrid <vSv> horizontal flux', 'm kg kg-1 s-1', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_WSv, 'SBG_WSV', 'Subgrid <wSv> vertical flux', 'm kg kg-1 s-1', ymasks )
-
- tfield%ndims = 3
- !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
- !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
- !tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
- tfield%ndimlist(4) = NMNHDIM_UNUSED
- !tfield%ndimlist(5:) = NMNHDIM_UNUSED
-
-
- end if
-
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_UTke, 'SBG_UTKE', 'Subgrid flux of subgrid kinetic energy', 'm3 s-3', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_VTke, 'SBG_VTKE', 'Subgrid flux of subgrid kinetic energy', 'm3 s-3', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_WTke, 'SBG_WTKE', 'Subgrid flux of subgrid kinetic energy', 'm3 s-3', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_W2Thl, 'SBG_W2TL', 'Subgrid flux of subgrid kinetic energy', 'm2 K s-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_WThl2, 'SBG_WTL2', 'Subgrid flux of subgrid kinetic energy', 'm K2 s-1', ymasks )
-end if
-
-
-!Prepare metadata (used in Les_diachro_write calls)
-tfield%ndims = 2
-tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
-tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
-tfield%ndimlist(3:) = NMNHDIM_UNUSED
-
-ldoavg = xles_temp_mean_start /= XUNDEF .and. xles_temp_mean_end /= XUNDEF
-ldonorm = trim(cles_norm_type) /= 'NONE'
-!
-!* 2.4 Updraft quantities
-! ------------------
-!
-if ( lles_updraft ) then
- cgroup = 'Updraft'
- cgroupcomment = 'Updraft vertical profiles of some resolved and subgrid fluxes, variances and covariances'
-
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT, 'UP_FRAC', 'Updraft fraction', '1' )
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_W, 'UP_W', 'Updraft W mean value', 'm s-1' )
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Th, 'UP_TH', 'Updraft potential temperature mean value', 'K' )
- if ( luserc ) &
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Thl, 'UP_THL', 'Updraft liquid potential temperature mean value', 'K' )
- if ( luserv ) &
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Thv, 'UP_THV', 'Updraft virtual potential temperature mean value', 'K' )
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Ke, 'UP_KE', 'Updraft resolved TKE mean value', 'm2 s-2' )
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Tke, 'UP_TKE', 'Updraft subgrid TKE mean value', 'm2 s-2' )
- if ( luserv ) &
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Rv, 'UP_RV', 'Updraft water vapor mean value', 'kg kg-1' )
- if ( luserc ) &
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Rc, 'UP_RC', 'Updraft cloud water mean value', 'kg kg-1' )
- if ( luserr ) &
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Rr, 'UP_RR', 'Updraft rain mean value', 'kg kg-1' )
- if ( luseri ) &
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Ri, 'UP_RI', 'Updraft ice mean value', 'kg kg-1' )
- if ( lusers ) &
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Rs, 'UP_RS', 'Updraft snow mean value', 'kg kg-1' )
- if ( luserg ) &
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Rg, 'UP_RG', 'Updraft graupel mean value', 'kg kg-1' )
- if ( luserh ) &
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Rh, 'UP_RH', 'Updraft hail mean value', 'kg kg-1' )
-
- if ( nsv > 0 ) then
- tfield%ndims = 3
- tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
- tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
- tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_SV
- tfield%ndimlist(4:) = NMNHDIM_UNUSED
-
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Sv, 'UP_SV', 'Updraft scalar variables mean values', 'kg kg-1' )
-
- tfield%ndims = 2
- !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
- !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
- tfield%ndimlist(3) = NMNHDIM_UNUSED
- !tfield%ndimlist(4:) = NMNHDIM_UNUSED
- end if
-
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Th2, 'UP_TH2', 'Updraft resolved Theta variance', 'K2' )
- if ( luserc ) &
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Thl2, 'UP_THL2', 'Updraft resolved Theta_l variance', 'K2' )
- if ( luserv ) &
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThThv, 'UP_THTV', 'Updraft resolved Theta Theta_v covariance', 'K2' )
- if ( luserc ) &
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThlThv, 'UP_TLTV', 'Updraft resolved Theta_l Theta_v covariance', 'K2' )
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_WTh, 'UP_WTH', 'Updraft resolved WTh flux', 'm K s-1' )
- if ( luserc ) &
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_WThl, 'UP_WTHL', 'Updraft resolved WThl flux', 'm K s-1' )
- if ( luserv ) &
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_WThv, 'UP_WTHV', 'Updraft resolved WThv flux', 'm K s-1' )
-
- if ( luserv ) then
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Rv2, 'UP_RV2', 'Updraft resolved water vapor variance', 'kg2 kg-2' )
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThRv, 'UP_THRV', 'Updraft resolved <thrv> covariance', 'K kg kg-1' )
- if ( luserc ) &
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThlRv, 'UP_THLRV', 'Updraft resolved <thlrv> covariance', 'K kg kg-1' )
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThvRv, 'UP_THVRV', 'Updraft resolved <thvrv> covariance', 'K kg kg-1' )
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_WRv, 'UP_WRV', 'Updraft resolved <wrv> vertical flux', 'm kg kg-1 s-1' )
- end if
-
- if ( luserc ) then
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Rc2, 'UP_RC2', 'Updraft resolved cloud water variance', 'kg2 kg-2' )
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThRc, 'UP_THRC', 'Updraft resolved <thrc> covariance', 'K kg kg-1' )
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThlRc, 'UP_THLRC', 'Updraft resolved <thlrc> covariance', 'K kg kg-1' )
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThvRc, 'UP_THVRC', 'Updraft resolved <thvrc> covariance', 'K kg kg-1' )
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_WRc, 'UP_WRC', 'Updraft resolved <wrc> vertical flux', 'm kg kg-1 s-1' )
- end if
-
- if ( luseri ) then
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Ri2, 'UP_RI2', 'Updraft resolved cloud ice variance', 'kg2 kg-2' )
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThRi, 'UP_THRI', 'Updraft resolved <thri> covariance', 'K kg kg-1' )
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThlRi, 'UP_THLRI', 'Updraft resolved <thlri> covariance', 'K kg kg-1' )
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThvRi, 'UP_THVRI', 'Updraft resolved <thvri> covariance', 'K kg kg-1' )
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_WRi, 'UP_WRI', 'Updraft resolved <wri> vertical flux', 'm kg kg-1 s-1' )
- end if
-
-
- if ( nsv > 0 ) then
- tfield%ndims = 3
- tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
- tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
- tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_SV
- tfield%ndimlist(4:) = NMNHDIM_UNUSED
-
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Sv2, 'UP_SV2', 'Updraft resolved scalar variables variances', 'kg2 kg-2' )
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThSv, 'UP_THSV', 'Updraft resolved <ThSv> variance', 'K kg kg-1' )
- if ( luserc ) &
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThlSv, 'UP_THLSV', 'Updraft resolved <ThlSv> variance', 'K kg kg-1' )
- if ( luserv ) &
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThvSv, 'UP_THVSV', 'Updraft resolved <ThvSv> variance', 'K kg kg-1' )
- call Les_diachro_write( tpdiafile, XLES_UPDRAFT_WSv, 'UP_WSV', 'Updraft resolved <wSv> vertical flux', 'm kg kg-1 s-1' )
-
- tfield%ndims = 2
- !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
- !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
- tfield%ndimlist(3) = NMNHDIM_UNUSED
- !tfield%ndimlist(4:) = NMNHDIM_UNUSED
- end if
-end if
-!
-!
-!* 2.5 Downdraft quantities
-! --------------------
-!
-if ( lles_downdraft ) then
- cgroup = 'Downdraft'
- cgroupcomment = 'Downdraft vertical profiles of some resolved and subgrid fluxes, variances and covariances'
-
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT, 'DW_FRAC', 'Downdraft fraction', '1' )
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_W, 'DW_W', 'Downdraft W mean value', 'm s-1' )
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Th, 'DW_TH', 'Downdraft potential temperature mean value', 'K' )
- if ( luserc ) &
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Thl, 'DW_THL', 'Downdraft liquid potential temperature mean value', 'K' )
- if ( luserv ) &
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Thv, 'DW_THV', 'Downdraft virtual potential temperature mean value', 'K' )
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Ke, 'DW_KE', 'Downdraft resolved TKE mean value', 'm2 s-2' )
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Tke, 'DW_TKE', 'Downdraft subgrid TKE mean value', 'm2 s-2' )
- if ( luserv ) &
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Rv, 'DW_RV', 'Downdraft water vapor mean value', 'kg kg-1' )
- if ( luserc ) &
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Rc, 'DW_RC', 'Downdraft cloud water mean value', 'kg kg-1' )
- if ( luserr ) &
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Rr, 'DW_RR', 'Downdraft rain mean value', 'kg kg-1' )
- if ( luseri ) &
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Ri, 'DW_RI', 'Downdraft ice mean value', 'kg kg-1' )
- if ( lusers ) &
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Rs, 'DW_RS', 'Downdraft snow mean value', 'kg kg-1' )
- if ( luserg ) &
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Rg, 'DW_RG', 'Downdraft graupel mean value', 'kg kg-1' )
- if ( luserh ) &
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Rh, 'DW_RH', 'Downdraft hail mean value', 'kg kg-1' )
-
- if ( nsv > 0 ) then
- tfield%ndims = 3
- tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
- tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
- tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_SV
- tfield%ndimlist(4:) = NMNHDIM_UNUSED
-
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Sv, 'DW_SV', 'Downdraft scalar variables mean values', 'kg kg-1' )
-
- tfield%ndims = 2
- !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
- !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
- tfield%ndimlist(3) = NMNHDIM_UNUSED
- !tfield%ndimlist(4:) = NMNHDIM_UNUSED
- end if
-
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Th2, 'DW_TH2', 'Downdraft resolved Theta variance', 'K2' )
- if ( luserc ) &
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Thl2, 'DW_THL2', 'Downdraft resolved Theta_l variance', 'K2' )
- if ( luserv ) &
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThThv, 'DW_THTV', 'Downdraft resolved Theta Theta_v covariance', 'K2' )
- if ( luserc ) &
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThlThv, 'DW_TLTV', 'Downdraft resolved Theta_l Theta_v covariance', 'K2' )
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_WTh, 'DW_WTH', 'Downdraft resolved WTh flux', 'm K s-1' )
- if ( luserc ) &
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_WThl, 'DW_WTHL', 'Downdraft resolved WThl flux', 'm K s-1' )
- if ( luserv ) &
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_WThv, 'DW_WTHV', 'Downdraft resolved WThv flux', 'm K s-1' )
-
- if ( luserv ) then
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Rv2, 'DW_RV2', 'Downdraft resolved water vapor variance', 'kg2 kg-2' )
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThRv, 'DW_THRV', 'Downdraft resolved <thrv> covariance', 'K kg kg-1' )
- if ( luserc ) &
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThlRv, 'DW_THLRV', 'Downdraft resolved <thlrv> covariance', 'K kg kg-1' )
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThvRv, 'DW_THVRV', 'Downdraft resolved <thvrv> covariance', 'K kg kg-1' )
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_WRv, 'DW_WRV', 'Downdraft resolved <wrv> vertical flux', &
- 'm kg kg-1 s-1' )
- end if
-
- if ( luserc ) then
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Rc2, 'DW_RC2', 'Downdraft resolved cloud water variance', 'kg2 kg-2' )
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThRc, 'DW_THRC', 'Downdraft resolved <thrc> covariance', 'K kg kg-1' )
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThlRc, 'DW_THLRC', 'Downdraft resolved <thlrc> covariance', 'K kg kg-1' )
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThvRc, 'DW_THVRC', 'Downdraft resolved <thvrc> covariance', 'K kg kg-1' )
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_WRc, 'DW_WRC', 'Downdraft resolved <wrc> vertical flux', &
- 'm kg kg-1 s-1' )
- end if
-
- if ( luseri ) then
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Ri2, 'DW_RI2', 'Downdraft resolved cloud ice variance', 'kg2 kg-2' )
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThRi, 'DW_THRI', 'Downdraft resolved <thri> covariance', 'K kg kg-1' )
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThlRi, 'DW_THLRI', 'Downdraft resolved <thlri> covariance', 'K kg kg-1' )
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThvRi, 'DW_THVRI', 'Downdraft resolved <thvri> covariance', 'K kg kg-1' )
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_WRi, 'DW_WRI', 'Downdraft resolved <wri> vertical flux', &
- 'm kg kg-1 s-1' )
- end if
-
-
- if ( nsv > 0 ) then
- tfield%ndims = 3
- tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
- tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
- tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_SV
- tfield%ndimlist(4:) = NMNHDIM_UNUSED
-
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Sv2, 'DW_SV2', 'Downdraft resolved scalar variables variances', &
- 'kg2 kg-2' )
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThSv, 'DW_THSV', 'Downdraft resolved <ThSv> variance', &
- 'K kg kg-1' )
- if ( luserc ) &
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThlSv, 'DW_THLSV', 'Downdraft resolved <ThlSv> variance', &
- 'K kg kg-1' )
- if ( luserv ) &
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThvSv, 'DW_THVSV', 'Downdraft resolved <ThvSv> variance', &
- 'K kg kg-1' )
- call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_WSv, 'DW_WSV', 'Downdraft resolved <wSv> vertical flux', &
- 'm kg kg-1 s-1' )
-
- tfield%ndims = 2
- !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
- !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
- tfield%ndimlist(3) = NMNHDIM_UNUSED
- !tfield%ndimlist(4:) = NMNHDIM_UNUSED
- end if
-end if
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. surface normalization parameters
-! --------------------------------
-!
-cgroup = 'Radiation'
-cgroupcomment = 'Radiative terms'
-
-!Prepare metadata (used in Les_diachro_write calls)
-tfield%ndims = 2
-tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
-tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
-tfield%ndimlist(3:) = NMNHDIM_UNUSED
-
-ldoavg = xles_temp_mean_start /= XUNDEF .and. xles_temp_mean_end /= XUNDEF
-ldonorm = .false.
-
-call Les_diachro_write( tpdiafile, XLES_SWU, 'SWU', 'SW upward radiative flux', 'W m-2' )
-call Les_diachro_write( tpdiafile, XLES_SWD, 'SWD', 'SW downward radiative flux', 'W m-2' )
-call Les_diachro_write( tpdiafile, XLES_LWU, 'LWU', 'LW upward radiative flux', 'W m-2' )
-call Les_diachro_write( tpdiafile, XLES_LWD, 'LWD', 'LW downward radiative flux', 'W m-2' )
-call Les_diachro_write( tpdiafile, XLES_DTHRADSW, 'DTHRADSW', 'SW radiative temperature tendency', 'K s-1' )
-call Les_diachro_write( tpdiafile, XLES_DTHRADLW, 'DTHRADLW', 'LW radiative temperature tendency', 'K s-1' )
-!writes mean_effective radius at all levels
-call Les_diachro_write( tpdiafile, XLES_RADEFF, 'RADEFF', 'Mean effective radius', 'micron' )
-
-
-cgroup = 'Surface'
-cgroupcomment = 'Averaged surface fields'
-
-! !Prepare metadate (used in Les_diachro_write calls)
-tfield%ndims = 1
-tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_TIME
-tfield%ndimlist(2:) = NMNHDIM_UNUSED
-
-call Les_diachro_write( tpdiafile, XLES_Q0, 'Q0', 'Sensible heat flux at the surface', 'm K s-1' )
-if ( luserv ) &
-call Les_diachro_write( tpdiafile, XLES_E0, 'E0', 'Latent heat flux at the surface', 'kg kg-1 m s-1' )
-
-if ( nsv > 0 ) then
- tfield%ndims = 2
- tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_TIME
- tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_SV
- tfield%ndimlist(3:) = NMNHDIM_UNUSED
-
- call Les_diachro_write( tpdiafile, XLES_SV0, 'SV0', 'Scalar variable fluxes at the surface', 'kg kg-1 m s-1' )
-
- tfield%ndims = 1
- !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_TIME
- tfield%ndimlist(2) = NMNHDIM_UNUSED
- !tfield%ndimlist(3:) = NMNHDIM_UNUSED
-end if
-
-call Les_diachro_write( tpdiafile, XLES_USTAR, 'Ustar', 'Friction velocity', 'm s-1' )
-call Les_diachro_write( tpdiafile, XLES_WSTAR, 'Wstar', 'Convective velocity', 'm s-1' )
-call Les_diachro_write( tpdiafile, XLES_MO_LENGTH, 'L_MO', 'Monin-Obukhov length', 'm' )
-if ( luserr ) &
-call Les_diachro_write( tpdiafile, XLES_PRECFR, 'PREC_FRAC', 'Fraction of columns where rain at surface', '1' )
-if ( luserr ) &
-call Les_diachro_write( tpdiafile, XLES_INPRR, 'INST_PREC', 'Instantaneous precipitation rate', 'mm day-1' )
-if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_INPRC, 'INST_SEDIM', 'Instantaneous cloud precipitation rate', 'mm day-1' )
-if ( luserc .and. ( ldeposc .or. ldepoc ) ) &
-call Les_diachro_write( tpdiafile, XLES_INDEP, 'INST_DEPOS', 'Instantaneous cloud deposition rate', 'mm day-1' )
-if ( luserr ) &
-call Les_diachro_write( tpdiafile, XLES_RAIN_INPRR, 'RAIN_PREC', 'Instantaneous precipitation rate over rainy grid cells', &
- 'mm day-1' )
-if ( luserr ) &
-call Les_diachro_write( tpdiafile, XLES_ACPRR, 'ACCU_PREC', 'Accumulated precipitation rate', 'mm' )
-
-
-cgroup = 'Miscellaneous'
-cgroupcomment = 'Miscellaneous terms (geometry, various unclassified averaged terms...)'
-
-call Les_diachro_write( tpdiafile, XLES_BL_HEIGHT, 'BL_H', 'Boundary Layer Height', 'm' )
-call Les_diachro_write( tpdiafile, XLES_INT_TKE, 'INT_TKE', 'Vertical integrated TKE', 'm2 s-2' )
-if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_ZCB, 'ZCB', 'Cloud base Height', 'm' )
-if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_CFtot, 'ZCFTOT', 'Total cloud cover (rc>1e-6)', '1' )
-if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_CF2tot, 'ZCF2TOT', 'Total cloud cover (rc>1e-5)', '1' )
-if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_LWP, 'LWP', 'Liquid Water path', 'kg m-2' )
-if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_LWPVAR, 'LWPVAR', 'Liquid Water path variance', 'kg m-4' )
-if ( luserr ) &
-call Les_diachro_write( tpdiafile, XLES_RWP, 'RWP', 'Rain Water path', 'kg m-2' )
-if ( luseri ) &
-call Les_diachro_write( tpdiafile, XLES_IWP, 'IWP', 'Ice Water path', 'kg m-2' )
-if ( lusers ) &
-call Les_diachro_write( tpdiafile, XLES_SWP, 'SWP', 'Snow Water path', 'kg m-2' )
-if ( luserg ) &
-call Les_diachro_write( tpdiafile, XLES_GWP, 'GWP', 'Graupel Water path', 'kg m-2' )
-if ( luserh ) &
-call Les_diachro_write( tpdiafile, XLES_HWP, 'HWP', 'Hail Water path', 'kg m-2' )
-if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_ZMAXCF, 'ZMAXCF', 'Height of Cloud fraction maximum (rc>1e-6)', 'm' )
-if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_ZMAXCF2, 'ZMAXCF2', 'Height of Cloud fraction maximum (rc>1e-5)', 'm' )
-
-!-------------------------------------------------------------------------------
-!
-!* 4. LES budgets
-! -----------
-!
-call Write_les_budget_n( tpdiafile )
-
-if ( luserv ) call Write_les_rt_budget_n( tpdiafile )
-
-if ( nsv > 0 ) call Write_les_sv_budget_n( tpdiafile )
-!
-!-------------------------------------------------------------------------------
-!
-!* 5. (ni,z,t) and (nj,z,t) 2points correlations
-! ------------------------------------------
-!
-if ( nspectra_k > 0 ) then
- tfieldx%cstdname = ''
- tfieldx%ngrid = 0 !Not on the Arakawa grid
- tfieldx%ntype = TYPEREAL
- tfieldx%ndims = 3
- tfieldx%ndimlist(1) = NMNHDIM_SPECTRA_2PTS_NI
- tfieldx%ndimlist(2) = NMNHDIM_SPECTRA_LEVEL
- tfieldx%ndimlist(3) = NMNHDIM_BUDGET_LES_TIME
- tfieldx%ndimlist(4:) = NMNHDIM_UNUSED
-
- tfieldy%cstdname = ''
- tfieldy%ngrid = 0 !Not on the Arakawa grid
- tfieldy%ntype = TYPEREAL
- tfieldy%ndims = 3
- tfieldy%ndimlist(1) = NMNHDIM_SPECTRA_2PTS_NJ
- tfieldy%ndimlist(2) = NMNHDIM_SPECTRA_LEVEL
- tfieldy%ndimlist(3) = NMNHDIM_BUDGET_LES_TIME
- tfieldy%ndimlist(4:) = NMNHDIM_UNUSED
-
- call Les_diachro_2pt_write( tpdiafile, XCORRi_UU, XCORRj_UU, 'UU', 'U*U 2 points correlations', 'm2 s-2' )
- call Les_diachro_2pt_write( tpdiafile, XCORRi_VV, XCORRj_VV, 'VV', 'V*V 2 points correlations', 'm2 s-2' )
- call Les_diachro_2pt_write( tpdiafile, XCORRi_WW, XCORRj_WW, 'WW', 'W*W 2 points correlations', 'm2 s-2' )
- call Les_diachro_2pt_write( tpdiafile, XCORRi_UV, XCORRj_UV, 'UV', 'U*V 2 points correlations', 'm2 s-2' )
- call Les_diachro_2pt_write( tpdiafile, XCORRi_WU, XCORRj_WU, 'WU', 'W*U 2 points correlations', 'm2 s-2' )
- call Les_diachro_2pt_write( tpdiafile, XCORRi_WV, XCORRj_WV, 'WV', 'W*V 2 points correlations', 'm2 s-2' )
-
- call Les_diachro_2pt_write( tpdiafile, XCORRi_ThTh, XCORRj_ThTh, 'THTH', 'Th*Th 2 points correlations', 'K2' )
- if ( luserc ) &
- call Les_diachro_2pt_write( tpdiafile, XCORRi_ThlThl, XCORRj_ThlThl, 'TLTL', 'Thl*Thl 2 points correlations', 'K2' )
- call Les_diachro_2pt_write( tpdiafile, XCORRi_WTh, XCORRj_WTh, 'WTH', 'W*Th 2 points correlations', 'm K s-1' )
- if ( luserc ) &
- call Les_diachro_2pt_write( tpdiafile, XCORRi_WThl, XCORRj_WThl, 'WTHL', 'W*Thl 2 points correlations', 'm K s-1' )
-
- if ( luserv ) then
- call Les_diachro_2pt_write( tpdiafile, XCORRi_RvRv, XCORRj_RvRv, 'RVRV', 'rv*rv 2 points correlations', 'kg2 kg-2' )
- call Les_diachro_2pt_write( tpdiafile, XCORRi_ThRv, XCORRj_ThRv, 'THRV', 'TH*RV 2 points correlations', 'K kg kg-1' )
- if ( luserc ) &
- call Les_diachro_2pt_write( tpdiafile, XCORRi_ThlRv, XCORRj_ThlRv, 'TLRV', 'thl*rv 2 points correlations', 'K kg kg-1' )
- call Les_diachro_2pt_write( tpdiafile, XCORRi_WRv, XCORRj_WRv, 'WRV', 'W*rv 2 points correlations', 'm kg s-1 kg-1' )
- end if
-
- if ( luserc ) then
- call Les_diachro_2pt_write( tpdiafile, XCORRi_RcRc, XCORRj_RcRc, 'RCRC', 'rc*rc 2 points correlations', 'kg2 kg-2' )
- call Les_diachro_2pt_write( tpdiafile, XCORRi_ThRc, XCORRj_ThRc, 'THRC', 'th*rc 2 points correlations', 'K kg kg-1' )
- call Les_diachro_2pt_write( tpdiafile, XCORRi_ThlRc, XCORRj_ThlRc, 'TLRC', 'thl*rc 2 points correlations', 'K kg kg-1' )
- call Les_diachro_2pt_write( tpdiafile, XCORRi_WRc, XCORRj_WRc, 'WRC', 'W*rc 2 points correlations', 'm kg s-1 kg-1' )
- end if
-
- if ( luseri ) then
- call Les_diachro_2pt_write( tpdiafile, XCORRi_RiRi, XCORRj_RiRi, 'RIRI', 'ri*ri 2 points correlations', 'kg2 kg-2' )
- call Les_diachro_2pt_write( tpdiafile, XCORRi_ThRi, XCORRj_ThRi, 'THRI', 'th*ri 2 points correlations', 'K kg kg-1' )
- call Les_diachro_2pt_write( tpdiafile, XCORRi_ThlRi, XCORRj_ThlRi, 'TLRI', 'thl*ri 2 points correlations', 'K kg kg-1' )
- call Les_diachro_2pt_write( tpdiafile, XCORRi_WRi, XCORRj_WRi, 'WRI', 'W*ri 2 points correlations', 'm kg s-1 kg-1' )
- end if
-
-!PW: TODO: ameliorer le ygroup (tenir compte de ce qu'est la variable scalaire et pas juste son jsv!)
- do jsv = 1, nsv
- Write( ygroup, fmt = "( a2, i3.3 )" ) "SS", jsv
- call Les_diachro_2pt_write( tpdiafile, XCORRi_SvSv(:,:,:,JSV), XCORRj_SvSv(:,:,:,JSV), ygroup, &
- 'Sv*Sv 2 points correlations','kg2 kg-2' )
- end do
-
-!PW: TODO: ameliorer le ygroup (tenir compte de ce qu'est la variable scalaire et pas juste son jsv!)
- do jsv = 1, nsv
- Write( ygroup, fmt = "( a2, i3.3 )" ) "WS", jsv
- call Les_diachro_2pt_write( tpdiafile, XCORRi_WSv(:,:,:,JSV), XCORRj_WSv(:,:,:,JSV), ygroup, &
- 'W*Sv 2 points correlations','m kg s-1 kg-1' )
- end do
-end if
-!
-!-------------------------------------------------------------------------------
-!
-!* 6. spectra and time-averaged profiles (if first call to WRITE_LES_n)
-! ----------------------------------
-!
-call Les_spec_n( tpdiafile )
-!
-!-------------------------------------------------------------------------------
-!
-!* 7. deallocations
-! -------------
-!
-CALL LES_DEALLOCATE('XLES_CURRENT_Z')
-
-IF (CLES_NORM_TYPE/='NONE' ) THEN
- CALL LES_DEALLOCATE('XLES_NORM_M')
- CALL LES_DEALLOCATE('XLES_NORM_S')
- CALL LES_DEALLOCATE('XLES_NORM_K')
- CALL LES_DEALLOCATE('XLES_NORM_RHO')
- CALL LES_DEALLOCATE('XLES_NORM_RV')
- CALL LES_DEALLOCATE('XLES_NORM_SV')
- CALL LES_DEALLOCATE('XLES_NORM_P')
-END IF
-
-end subroutine Write_les_n
-
-!------------------------------------------------------------------------------
-
-subroutine Les_diachro_write_1D( tpdiafile, pdata, hmnhname, hcomment, hunits )
-
-use modd_io, only: tfiledata
-
-use mode_les_diachro, only: Les_diachro
-
-type(tfiledata), intent(in) :: tpdiafile ! file to write
-real, dimension(:), intent(in) :: pdata
-character(len=*), intent(in) :: hmnhname
-character(len=*), intent(in) :: hcomment
-character(len=*), intent(in) :: hunits
-
-tfield%cmnhname = hmnhname
-tfield%clongname = hmnhname
-tfield%ccomment = hcomment
-tfield%cunits = hunits
-
-call Les_diachro( tpdiafile, tfield, cgroup, cgroupcomment, ldoavg, ldonorm, pdata )
-
-end subroutine Les_diachro_write_1D
-
-!------------------------------------------------------------------------------
-
-subroutine Les_diachro_write_2D( tpdiafile, pdata, hmnhname, hcomment, hunits )
-
-use modd_io, only: tfiledata
-
-use mode_les_diachro, only: Les_diachro
-
-type(tfiledata), intent(in) :: tpdiafile ! file to write
-real, dimension(:,:), intent(in) :: pdata
-character(len=*), intent(in) :: hmnhname
-character(len=*), intent(in) :: hcomment
-character(len=*), intent(in) :: hunits
-
-tfield%cmnhname = hmnhname
-tfield%clongname = hmnhname
-tfield%ccomment = hcomment
-tfield%cunits = hunits
-
-call Les_diachro( tpdiafile, tfield, cgroup, cgroupcomment, ldoavg, ldonorm, pdata )
-
-end subroutine Les_diachro_write_2D
-
-!------------------------------------------------------------------------------
-
-subroutine Les_diachro_write_3D( tpdiafile, pdata, hmnhname, hcomment, hunits, hmasks )
-
-use modd_io, only: tfiledata
-
-use mode_les_diachro, only: Les_diachro
-
-type(tfiledata), intent(in) :: tpdiafile ! file to write
-real, dimension(:,:,:), intent(in) :: pdata
-character(len=*), intent(in) :: hmnhname
-character(len=*), intent(in) :: hcomment
-character(len=*), intent(in) :: hunits
-character(len=*), dimension(:), optional, intent(in) :: hmasks
-
-tfield%cmnhname = hmnhname
-tfield%clongname = hmnhname
-tfield%ccomment = hcomment
-tfield%cunits = hunits
-
-call Les_diachro( tpdiafile, tfield, cgroup, cgroupcomment, ldoavg, ldonorm, pdata, hmasks = hmasks )
-
-end subroutine Les_diachro_write_3D
-
-!------------------------------------------------------------------------------
-
-subroutine Les_diachro_write_4D( tpdiafile, pdata, hmnhname, hcomment, hunits, hmasks )
-
-use modd_io, only: tfiledata
-
-use mode_les_diachro, only: Les_diachro
-
-type(tfiledata), intent(in) :: tpdiafile ! file to write
-real, dimension(:,:,:,:), intent(in) :: pdata
-character(len=*), intent(in) :: hmnhname
-character(len=*), intent(in) :: hcomment
-character(len=*), intent(in) :: hunits
-character(len=*), dimension(:), optional, intent(in) :: hmasks
-
-tfield%cmnhname = hmnhname
-tfield%clongname = hmnhname
-tfield%ccomment = hcomment
-tfield%cunits = hunits
-
-call Les_diachro( tpdiafile, tfield, cgroup, cgroupcomment, ldoavg, ldonorm, pdata, hmasks = hmasks )
-
-end subroutine Les_diachro_write_4D
-
-!------------------------------------------------------------------------------
-
-subroutine Les_diachro_2pt_write( tpdiafile, zcorri, zcorrj, hmnhname, hcomment, hunits )
-
-use modd_io, only: tfiledata
-
-use mode_les_diachro, only: Les_diachro_2pt
-
-type(tfiledata), intent(in) :: tpdiafile ! file to write
-real, dimension(:,:,:), intent(in) :: zcorri ! 2 pts correlation data
-real, dimension(:,:,:), intent(in) :: zcorrj ! 2 pts correlation data
-character(len=*), intent(in) :: hmnhname
-character(len=*), intent(in) :: hcomment
-character(len=*), intent(in) :: hunits
-
-tfieldx%cmnhname = hmnhname
-tfieldx%clongname = hmnhname
-tfieldx%ccomment = hcomment
-tfieldx%cunits = hunits
-
-tfieldy%cmnhname = hmnhname
-tfieldy%clongname = hmnhname
-tfieldy%ccomment = hcomment
-tfieldy%cunits = hunits
-
-call Les_diachro_2pt( tpdiafile, tfieldx, tfieldy, zcorri, zcorrj )
-
-end subroutine Les_diachro_2pt_write
-
-!------------------------------------------------------------------------------
-
-end module mode_write_les_n
diff --git a/src/mesonh/ext/write_lfifm1_for_diag.f90 b/src/mesonh/ext/write_lfifm1_for_diag.f90
deleted file mode 100644
index a6099e6a0f4eb779347699adbcf1e6f85fc896ca..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/write_lfifm1_for_diag.f90
+++ /dev/null
@@ -1,4188 +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_WRITE_LFIFM1_FOR_DIAG
-!################################
-INTERFACE
- SUBROUTINE WRITE_LFIFM1_FOR_DIAG(TPFILE,HDADFILE)
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! outpput data file
-CHARACTER(LEN=28), INTENT(IN) :: HDADFILE ! corresponding FM-file name of
- ! its DAD model
-!
-END SUBROUTINE WRITE_LFIFM1_FOR_DIAG
-END INTERFACE
-END MODULE MODI_WRITE_LFIFM1_FOR_DIAG
-!
-! ##################################################
- SUBROUTINE WRITE_LFIFM1_FOR_DIAG(TPFILE,HDADFILE)
-! ##################################################
-!
-!!**** *WRITE_LFIFM1* - routine to write a LFIFM file for model 1
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to write an initial LFIFM File
-! of name YFMFILE2//'.lfi' with the FM routines.
-!
-!!** METHOD
-!! ------
-!! The data are written in the LFIFM file :
-!! - dimensions
-!! - grid variables
-!! - configuration variables
-!! - prognostic variables at time t and t-dt
-!! - 1D anelastic reference state
-!!
-!! The localization on the model grid is also indicated :
-!!
-!! IGRID = 1 for mass grid point
-!! IGRID = 2 for U grid point
-!! IGRID = 3 for V grid point
-!! IGRID = 4 for w grid point
-!! IGRID = 0 for meaningless case
-!!
-!!
-!! EXTERNAL
-!! --------
-!! FMWRIT : FM-routine to write a record
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_DIM1 : contains dimensions
-!! Module MODD_TIME1 : contains time variables and uses MODD_TIME
-!! Module MODD_GRID : contains spatial grid variables for all models
-!! Module MODD_GRID1 : contains spatial grid variables
-!! Module MODD_REF : contains reference state variables
-!! Module MODD_LUNIT1: contains logical unit variables.
-!! Module MODD_CONF : contains configuration variables for all models
-!! Module MODD_CONF1 : contains configuration variables
-!! Module MODD_FIELD1 : contains prognostic variables
-!! Module MODD_GR_FIELD1 : contains surface prognostic variables
-!! Module MODD_LSFIELD1 : contains Larger Scale variables
-!! Module MODD_PARAM1 : contains parameterization options
-!! Module MODD_TURB1 : contains turbulence options
-!! Module MODD_FRC : contains forcing variables
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Ducrocq *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 06/05/94
-!! V. Ducrocq 27/06/94
-!! J.Stein 20/10/94 (name of the FMFILE)
-!! J.Stein 06/12/94 add the LS fields
-!! J.P. Lafore 09/01/95 add the DRYMASST
-!! J.Stein 20/01/95 add TKE and change the ycomment for the water
-!! variables
-!! J.Stein 23/01/95 add a TKE switch and MODD_PARAM1
-!! J.Stein 16/03/95 remove R from the historical variables
-!! J.Stein 20/03/95 add the EPS var.
-!! J.Stein 30/06/95 add the variables related to the subgrid condens
-!! S. Belair 01/09/95 add surface variables and ground parameters
-!! J.-P. Pinty 15/09/95 add the radiation parameters
-!! J.Stein 23/01/96 add the TSZ0 option for the surface scheme
-!! M.Georgelin 13/12/95 add the forcing variables
-!! J.-P. Pinty 15/02/96 add external control for the forcing
-!! J.Stein P.Bougeault 15/03/96 add the cloud fraction and change the
-!! surface parameters for TSZ0 option
-!! J.Stein P.Jabouille 30/04/96 add the storage type
-!! J.Stein P.Jabouille 20/05/96 switch for XSIGS and XSRC
-!! J.Stein 10/10/96 change Xsrc into XSRCM and XRCT
-!! J.P. Lafore 30/07/96 add YFMFILE2 and HDADFILE writing
-!! corresponding to MY_NAME and DAD_NAME (for nesting)
-!! V.Masson 08/10/96 add LTHINSHELL
-!! J.-P. Pinty 15/12/96 add the microphysics (ice)
-!! J.-P. Pinty 11/01/97 add the deep convection
-!! J.-P. Pinty 27/01/97 split the recording of the SV array
-!! J.-P. Pinty 29/01/97 set recording of PRCONV and PACCONV in mm/h and
-!! mm respectively
-!! J. Viviand 04/02/97 convert precipitation rates in mm/h
-!! P. Hereil 04/12/97 add the calculation of cloud top and moist PV
-!! P.Hereil N Asencio 3/02/98 add the calculation of precipitation on large scale grid mesh
-!! N Asencio 2/10/98 suppress flux calculation if start file
-!! V Masson 25/11/98 places dummy arguments in module MODD_DIAG_FLAG
-!! V Masson 04/01/00 removes TSZ0 option
-!! J.-P. Pinty 29/11/02 add C3R5, ICE2, ICE4, CELEC
-!! V Masson 01/2004 removes surface (externalization)
-!! P. Tulet 01/2005 add dust, orilam
-!! M. Leriche 04/2007 add aqueous concentration in M
-!! O. Caumont 03/2008 add simulation of radar observations
-!! O. Caumont 14/09/2009 modifications to allow for polar outputs (radar diagnostics)
-!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
-!! change of YCOMMENT
-!! G. Tanguy 10/2009 add possibility to run radar after
-!! PREP_REAL_CASE with AROME
-!! O. Caumont 01/2011 [radar diagnostics] add control check for NMAX; revise comments
-!! O. Caumont 05/2011 [radar diagnostics] change output format
-!! G.Tanguy/ JP Pinty/ JP Chabureau 18/05/2011 : add lidar simulator
-!! S.Bielli 12/2012 : add latitude and longitude
-!! F. Duffourg 02/2013 : add new fields
-!! J.Escobar 21/03/2013: for HALOK get correctly local array dim/bound
-!! J. escobar 27/03/2014 : write LAT/LON only in not CARTESIAN case
-!! G.Delautier 2014 : remplace MODD_RAIN_C2R2_PARAM par MODD_RAIN_C2R2_KHKO_PARAM
-!! C. Augros 2014 : new radar simulator (T matrice)
-!! D.Ricard 2015 : add THETAES + POVOES (LMOIST_ES=T)
-!! Modification 01/2016 (JP Pinty) Add LIMA
-!! C.Lac 04/2016 : add visibility and droplet deposition
-!! 10/2017 (G.Delautier) New boundary layer height : replace LBLTOP by CBLTOP
-!! T.Dauhut 10/2017 : add parallel 3D clustering
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! D.Ricard and P.Marquet 2016-2017 : THETAL + THETAS1 POVOS1 or THETAS2 POVOS2
-!! if LMOIST_L LMOIST_S1 or LMOIST_S2
-! P. Wautelet 08/02/2019: minor bug: compute ZWORK36 only when needed
-! S Bielli 02/2019: sea salt: significant sea wave height influences salt emission; 5 salt modes
-! P. Wautelet 18/03/2020: remove ICE2 option
-! B. Vie 06/2020: Add prognostic supersaturation for LIMA
-! P. Wautelet 11/03/2021: bugfix: correct name for NSV_LIMA_IMM_NUCL
-! J.L Redelsperger 03/2021 Adding OCEAN LES Case and Autocoupled O-A LES
-! P. Wautelet 04/02/2022: use TSVLIST to manage metadata of scalar variables
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_BLOWSNOW, ONLY: LBLOWSNOW, NBLOWSNOW3D
-USE MODD_BLOWSNOW_n, ONLY: XSNWSUBL3D
-USE MODD_CH_AERO_n, ONLY: XN3D, XRG3D, XSIG3D
-USE MODD_CH_AEROSOL
-USE MODD_CH_M9_n, ONLY: NEQAQ
-USE MODD_CH_MNHC_n, ONLY: LCH_CONV_LINOX, LUSECHEM, XRTMIN_AQ
-USE MODD_CONDSAMP, ONLY: LCONDSAMP
-USE MODD_CONF, ONLY: CBIBUSER, CEQNSYS, CPROGRAM, L1D, L2D, LCARTESIAN, LFORCING, LPACK, LTHINSHELL, NBUGFIX, NMASDEV
-USE MODD_CONF_n, ONLY: IDX_RVT, IDX_RCT, IDX_RRT, IDX_RIT, IDX_RST, IDX_RGT, IDX_RHT, &
- LUSERV, LUSERC, LUSERR, LUSERI, LUSERS, LUSERG, LUSERH, &
- LUSECI, NRR, NRRI, NRRL
-USE MODD_CST, ONLY: XALPI, XAVOGADRO, XBETAI, XCI, XCL, XCPD, XCPV, XG, XGAMI, XLSTT, XLVTT, &
- XMD, XMV, XP00, XPI, XRADIUS, XRHOLW, XRD, XRV, XTT
-USE MODD_CSTS_DUST, ONLY: XDENSITY_DUST, XM3TOUM3, XMOLARWEIGHT_DUST
-USE MODD_CURVCOR_n, ONLY: XCORIOZ
-USE MODD_DEEP_CONVECTION_n, ONLY: XCG_RATE, XCG_TOTAL_NUMBER, XIC_RATE, XIC_TOTAL_NUMBER, XPACCONV, XPRCONV, XPRSCONV
-USE MODD_DIAG_FLAG
-USE MODD_DIM_n, ONLY: NIMAX_ll, NJMAX_ll, NKMAX
-USE MODD_DUST, ONLY: LDEPOS_DST, LDUST, NMODE_DST
-USE MODD_DYN_n, ONLY: LOCEAN
-use modd_field, only: tfieldmetadata, tfieldlist, TYPEINT, TYPEREAL
-USE MODD_FIELD_n, ONLY: XCIT, XCLDFR, XICEFR, XPABSM, XPABST, XRT, XSIGS, XSRCT, XSVT, XTHT, XTKET, XUT, XVT, XWT, XZWS
-USE MODD_FRC, ONLY: NFRC, XGXTHFRC, XGYTHFRC, XPGROUNDFRC, XRVFRC, XTENDRVFRC, XTENDTHFRC, XTHFRC, XUFRC, XVFRC, XWFRC
-USE MODD_GRID, ONLY: XBETA, XLAT0, XLATORI, XLON0, XLONORI, XRPK
-USE MODD_GRID_n, only: LSLEVE, NEXTE_XMIN, NEXTE_YMIN, XHATM_BOUND, &
- XLAT, XLEN1, XLEN2, XLON, XZS, XXHAT, XXHATM, XYHAT, XYHATM, XZHAT, XZSMT, XZTOP, XZZ
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LSFIELD_n, ONLY: XLSRVM, XLSTHM, XLSUM, XLSVM, XLSWM
-USE MODD_LUNIT, ONLY: TLUOUT0
-USE MODD_METRICS_n, ONLY: XDXX, XDYY, XDZX, XDZY, XDZZ
-USE MODD_MPIF
-USE MODD_NESTING, ONLY: NDXRATIO_ALL, NDYRATIO_ALL, NXOR_ALL, NYOR_ALL
-USE MODD_NSV
-USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT, XUNDEF
-USE MODD_PARAM_LIMA_COLD, ONLY: CLIMA_COLD_CONC
-USE MODD_PARAM_LIMA, ONLY: NMOD_CCN, NMOD_IFN, NMOD_IMM, NINDICE_CCN_IMM, &
- LSCAV, LLIMA_DIAG, NMOM_S, NMOM_G, NMOM_H
-USE MODD_PARAM_LIMA_WARM, ONLY: CLIMA_WARM_CONC, CAERO_MASS
-USE MODD_PARAM_n, ONLY: CCLOUD, CDCONV, CELEC, CSURF, CTURB
-USE MODD_PASPOL, ONLY: LPASPOL
-USE MODD_PRECIP_n, ONLY: XACDEP, XACPRC, XACPRG, XACPRH, XACPRR, XACPRS, XEVAP3D, &
- XINDEP, XINPRC, XINPRG, XINPRH, XINPRR, XINPRR3D, XINPRS
-use modd_precision, only: MNHREAL_MPI
-USE MODD_RADAR, ONLY: CNAME_RAD, LATT, LCART_RAD, LDNDZ, LREFR, LWBSCS, LWREFL, &
- NBAZIM, NBELEV, NBRAD, NBSTEPMAX, NCURV_INTERPOL, NDIFF, NMAX, NPTS_H, NPTS_V, &
- XALT_RAD, XDT_RAD, XELEV, XGRID, XLAM_RAD, XLAT_RAD, XLON_RAD, XSTEP_RAD
-USE MODD_REF, ONLY: LBOUSS, LCOUPLES, XEXNTOP, XEXNTOPO, XRHODREFZ, XRHODREFZO, XTHVREFZ, XTHVREFZO
-USE MODD_REF_n, ONLY: XEXNREF, XRHODREF, XTHVREF
-USE MODD_SALT, ONLY: LDEPOS_SLT, LSALT, NMODE_SLT
-USE MODD_TIME, ONLY: TDTEXP, TDTSEG
-USE MODD_TIME_n, ONLY: TDTCUR, TDTMOD
-USE MODD_TURB_n, only: CTOM, XBL_DEPTH
-USE MODD_VAR_ll, ONLY: NMNH_COMM_WORLD
-
-USE MODE_AERO_PSD, ONLY: PPP2AERO
-USE MODE_BLOWSNOW_PSD, ONLY: PPP2SNOW
-USE MODE_DUST_PSD, ONLY: PPP2DUST
-use mode_field, only: Find_field_id_from_mnhname
-USE MODE_GRIDPROJ, ONLY: SM_LATLON
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODE_IO_FILE, only: IO_File_close, IO_File_open
-USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
-USE MODE_MODELN_HANDLER, only: GET_CURRENT_MODEL_INDEX
-use mode_msg
-USE MODE_SALT_PSD, ONLY: PPP2SALT
-USE MODE_THERMO, ONLY: QSAT, SM_FOES
-USE MODE_TOOLS, ONLY: UPCASE
-USE MODE_TOOLS_ll, ONLY: GET_DIM_EXT_ll, GET_INDICE_ll
-
-USE MODI_CALCSOUND
-USE MODI_CLUSTERING
-USE MODI_COMPUTE_MEAN_PRECIP
-USE MODI_CONTRAV
-USE MODI_GPS_ZENITH
-USE MODI_GRADIENT_M
-USE MODI_GRADIENT_U
-USE MODI_GRADIENT_V
-USE MODI_GRADIENT_W
-USE MODI_INI_RADAR
-USE MODI_LIDAR
-USE MODI_RADAR_RAIN_ICE
-USE MODI_RADAR_SIMULATOR
-USE MODI_SHUMAN
-USE MODI_UV_TO_ZONAL_AND_MERID
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! outpput data file
-CHARACTER(LEN=28), INTENT(IN) :: HDADFILE ! corresponding FM-file name of
- ! its DAD model
-!
-!* 0.2 Declarations of local variables
-!
-INTEGER :: IRESP ! return-code for the file routines
-!
-CHARACTER(LEN=3) :: YFRC ! to mark the time of the forcing
-CHARACTER(LEN=31) :: YFGRI ! file name for GPS stations
-!
-INTEGER :: IIU,IJU,IKU,IIB,IJB,IKB,IIE,IJE,IKE ! Arrays bounds
-!
-INTEGER :: JLOOP,JI,JJ,JK,JSV,JT,JH,JV,JEL ! loop index
-INTEGER :: IMI ! Current model index
-!
-REAL :: ZRV_OV_RD ! XRV / XRD
-REAL :: ZGAMREF ! Standard atmosphere lapse rate (K/m)
-REAL :: ZX0D ! work real scalar
-REAL :: ZLATOR, ZLONOR ! geographical coordinates of 1st mass point
-!
-REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZPOVO
-REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZTEMP
-REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZVOX,ZVOY,ZVOZ
-REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZCORIOZ
-REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZWORK31,ZWORK32
-REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZWORK33,ZWORK34
-REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2)) :: ZWORK21,ZWORK22
-REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2)) :: ZWORK23,ZWORK24
-REAL,DIMENSION(:,:,:,:,:), ALLOCATABLE :: ZWORK42 ! reflectivity on a cartesian grid (PREFL_CART)
-REAL,DIMENSION(:,:,:,:,:), ALLOCATABLE :: ZWORK42_BIS
-REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZWORK43 ! latlon coordinates of cartesian grid points (PLATLON)
-REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZPHI,ZTHETAE,ZTHETAV
-REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZTHETAES,ZTHETAL,ZTHETAS1,ZTHETAS2
-REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZVISIKUN,ZVISIGUL,ZVISIZHA
-INTEGER, DIMENSION(:,:), ALLOCATABLE :: IWORK1
-integer :: ICURR,INBOUT,IERR
-!
-REAL,DIMENSION(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),NSP+NCARB+NSOA,JPMODE):: ZPTOTA
-REAL,DIMENSION(:,:,:,:), POINTER :: ZSDSTDEP
-REAL,DIMENSION(:,:,:,:), POINTER :: ZSSLTDEP
-REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZSIG_DST, ZRG_DST, ZN0_DST
-REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZSIG_SLT, ZRG_SLT, ZN0_SLT
-REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZBET_SNW, ZRG_SNW
-REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZMA_SNW
-REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZRHOT, ZTMP ! work array
-!
-! GBOTUP = True does clustering from bottom up to top, False top down to surface
-LOGICAL :: GBOTUP ! clustering propagation
-LOGICAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: GCLOUD ! mask
-INTEGER,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ICLUSTERID, ICLUSTERLV
-REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZCLDSIZE
-
-!ECRITURE DANS UN FICHIER ASCII DE RESULTATS
-!INITIALISATION DU NOM DE FICHIER CREE EN PARALLELE AVEC CELUI LFI
-TYPE(TFILEDATA),POINTER :: TZRSFILE
-INTEGER :: ILURS
-CHARACTER(LEN=32) :: YRS
-CHARACTER(LEN=3),DIMENSION(:),ALLOCATABLE :: YRAD
-CHARACTER(LEN=2*INT(NBSTEPMAX*XSTEP_RAD/XGRID)*2*9+1), DIMENSION(:), ALLOCATABLE :: CLATLON
-CHARACTER(LEN=2*9) :: CBUFFER
-CHARACTER(LEN=4) :: YELEV
-CHARACTER(LEN=3) :: YGRID_SIZE
-INTEGER :: IEL,IIELV
-CHARACTER(LEN=5) :: YVIEW ! Upward or Downward integration
-INTEGER :: IACCMODE
-!
-!-------------------------------------------------------------------------------
-INTEGER :: IAUX ! work variable
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZW1, ZW2, ZW3
-REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZWORK35,ZWORK36
-REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2)) :: ZWORK25,ZWORK26
-REAL :: ZEAU ! Mean precipitable water
-INTEGER, DIMENSION(SIZE(XZZ,1),SIZE(XZZ,2)) ::IKTOP ! level in which is the altitude 3000m
-REAL, DIMENSION(SIZE(XZZ,1),SIZE(XZZ,2),SIZE(XZZ,3)) :: ZDELTAZ ! interval (m) between two levels K
-INTEGER :: ILUOUT0 ! Logical unit number for output-listing
-!
-CHARACTER(LEN=2) :: INDICE
-CHARACTER(LEN=100) :: YMSG
-INTEGER :: IID
-TYPE(TFIELDMETADATA) :: TZFIELD, TZFIELD2D
-TYPE(TFIELDMETADATA), DIMENSION(2) :: TZFIELD2
-!
-! LIMA LIDAR
-REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZTMP1, ZTMP2, ZTMP3, ZTMP4
-!
-! hauteur couche limite
-REAL,DIMENSION(:,:,:),ALLOCATABLE :: ZZZ_GRID1
-REAL,DIMENSION(:,:),ALLOCATABLE :: ZTHVSOL,ZSHMIX
-REAL,DIMENSION(:,:,:),ALLOCATABLE :: ZZONWIND,ZMERWIND,ZFFWIND2,ZRIB
-!
-!-------------------------------------------------------------------------------
-!
-!* 0. ARRAYS BOUNDS INITIALIZATION
-!
-CALL GET_DIM_EXT_ll ('B',IIU,IJU)
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IKU=NKMAX+2*JPVEXT
-IKB=1+JPVEXT
-IKE=IKU-JPVEXT
-
-IMI = GET_CURRENT_MODEL_INDEX()
-ILUOUT0 = TLUOUT0%NLU
-TZRSFILE => NULL()
-!-------------------------------------------------------------------------------
-!
-!* 1. WRITES IN THE LFI FILE
-! ----------------------
-!
-!* 1.0 TPFILE%CNAME and HDADFILE :
-!
-CALL IO_Field_write(TPFILE,'MASDEV', NMASDEV)
-CALL IO_Field_write(TPFILE,'BUGFIX', NBUGFIX)
-CALL IO_Field_write(TPFILE,'BIBUSER', CBIBUSER)
-CALL IO_Field_write(TPFILE,'PROGRAM', CPROGRAM)
-!
-CALL IO_Field_write(TPFILE,'L1D', L1D)
-CALL IO_Field_write(TPFILE,'L2D', L2D)
-CALL IO_Field_write(TPFILE,'PACK', LPACK)
-!
-CALL IO_Field_write(TPFILE,'MY_NAME', TPFILE%CNAME)
-CALL IO_Field_write(TPFILE,'DAD_NAME', HDADFILE)
-!
-IF (LEN_TRIM(HDADFILE)>0) THEN
- CALL IO_Field_write(TPFILE,'DXRATIO',NDXRATIO_ALL(1))
- CALL IO_Field_write(TPFILE,'DYRATIO',NDYRATIO_ALL(1))
- CALL IO_Field_write(TPFILE,'XOR', NXOR_ALL(1))
- CALL IO_Field_write(TPFILE,'YOR', NYOR_ALL(1))
-END IF
-!
-CALL IO_Field_write(TPFILE,'SURF', CSURF)
-!
-!* 1.1 Type and Dimensions :
-!
-CALL IO_Field_write(TPFILE,'STORAGE_TYPE','DI')
-!
-CALL IO_Field_write(TPFILE,'IMAX',NIMAX_ll)
-CALL IO_Field_write(TPFILE,'JMAX',NJMAX_ll)
-CALL IO_Field_write(TPFILE,'KMAX',NKMAX)
-!
-CALL IO_Field_write(TPFILE,'JPHEXT',JPHEXT)
-!
-!* 1.2 Grid variables :
-!
-IF (.NOT.LCARTESIAN) THEN
- CALL IO_Field_write(TPFILE,'RPK', XRPK)
- CALL IO_Field_write(TPFILE,'LONORI',XLONORI)
- CALL IO_Field_write(TPFILE,'LATORI',XLATORI)
-!
-!* diagnostic of 1st mass point
-!
- CALL SM_LATLON( XLATORI, XLONORI, XHATM_BOUND(NEXTE_XMIN), XHATM_BOUND(NEXTE_YMIN), ZLATOR, ZLONOR )
-!
- CALL IO_Field_write(TPFILE,'LONOR',ZLONOR)
- CALL IO_Field_write(TPFILE,'LATOR',ZLATOR)
-!
-END IF
-!
-CALL IO_Field_write(TPFILE,'THINSHELL',LTHINSHELL)
-CALL IO_Field_write(TPFILE,'LAT0',XLAT0)
-CALL IO_Field_write(TPFILE,'LON0',XLON0)
-CALL IO_Field_write(TPFILE,'BETA',XBETA)
-!
-CALL IO_Field_write(TPFILE,'XHAT',XXHAT)
-CALL IO_Field_write(TPFILE,'YHAT',XYHAT)
-CALL IO_Field_write(TPFILE,'ZHAT',XZHAT)
-CALL IO_Field_write(TPFILE,'ZTOP',XZTOP)
-!
-CALL IO_Field_write(TPFILE,'ZS', XZS)
-CALL IO_Field_write(TPFILE,'ZWS', XZWS)
-CALL IO_Field_write(TPFILE,'ZSMT', XZSMT)
-CALL IO_Field_write(TPFILE,'SLEVE',LSLEVE)
-!
-IF (LSLEVE) THEN
- CALL IO_Field_write(TPFILE,'LEN1',XLEN1)
- CALL IO_Field_write(TPFILE,'LEN2',XLEN2)
-END IF
-!
-!
-CALL IO_Field_write(TPFILE,'DTMOD',TDTMOD)
-CALL IO_Field_write(TPFILE,'DTCUR',TDTCUR)
-CALL IO_Field_write(TPFILE,'DTEXP',TDTEXP)
-CALL IO_Field_write(TPFILE,'DTSEG',TDTSEG)
-!
-!* 1.3 Configuration variables :
-!
-CALL IO_Field_write(TPFILE,'CARTESIAN',LCARTESIAN)
-CALL IO_Field_write(TPFILE,'LBOUSS', LBOUSS)
-CALL IO_Field_write(TPFILE,'LOCEAN', LOCEAN)
-CALL IO_Field_write(TPFILE,'LCOUPLES', LCOUPLES)
-!
-IF (LCARTESIAN .AND. LWIND_ZM) THEN
- LWIND_ZM=.FALSE.
- PRINT*,'YOU ARE IN CARTESIAN GEOMETRY SO LWIND_ZM IS FORCED TO FALSE'
-END IF
-!* 1.4 Reference state variables :
-!
-IF (LCOUPLES.AND.LOCEAN) THEN
- CALL IO_Field_write(TPFILE,'RHOREFZ',XRHODREFZO)
- CALL IO_Field_write(TPFILE,'THVREFZ',XTHVREFZO)
- CALL IO_Field_write(TPFILE,'EXNTOP', XEXNTOPO)
-ELSE
- CALL IO_Field_write(TPFILE,'RHOREFZ',XRHODREFZ)
- CALL IO_Field_write(TPFILE,'THVREFZ',XTHVREFZ)
- CALL IO_Field_write(TPFILE,'EXNTOP', XEXNTOP)
-END IF
-!
-CALL IO_Field_write(TPFILE,'RHODREF',XRHODREF)
-CALL IO_Field_write(TPFILE,'THVREF', XTHVREF)
-!
-!
-!* 1.5 Variables necessary for plots
-!
-! PABST,THT,POVOM for cross sections at constant pressure
-! level or constant theta level or constant PV level
-!
-IF (INDEX(CISO,'PR') /= 0) THEN
- CALL IO_Field_write(TPFILE,'PABST',XPABST)
-END IF
-!
-IF (INDEX(CISO,'TK') /= 0) THEN
- CALL IO_Field_write(TPFILE,'THT',XTHT)
-END IF
-!
-ZCORIOZ(:,:,:)=SPREAD( XCORIOZ(:,:),DIM=3,NCOPIES=IKU )
-ZVOX(:,:,:)=GY_W_VW(XWT,XDYY,XDZZ,XDZY)-GZ_V_VW(XVT,XDZZ)
-ZVOX(:,:,2)=ZVOX(:,:,3)
-ZVOY(:,:,:)=GZ_U_UW(XUT,XDZZ)-GX_W_UW(XWT,XDXX,XDZZ,XDZX)
-ZVOY(:,:,2)=ZVOY(:,:,3)
-ZVOZ(:,:,:)=GX_V_UV(XVT,XDXX,XDZZ,XDZX)-GY_U_UV(XUT,XDYY,XDZZ,XDZY)
-ZVOZ(:,:,2)=ZVOZ(:,:,3)
-ZVOZ(:,:,1)=ZVOZ(:,:,3)
-ZWORK31(:,:,:)=GX_M_M(XTHT,XDXX,XDZZ,XDZX)
-ZWORK32(:,:,:)=GY_M_M(XTHT,XDYY,XDZZ,XDZY)
-ZWORK33(:,:,:)=GZ_M_M(XTHT,XDZZ)
-ZPOVO(:,:,:)= ZWORK31(:,:,:)*MZF(MYF(ZVOX(:,:,:))) &
- + ZWORK32(:,:,:)*MZF(MXF(ZVOY(:,:,:))) &
- + ZWORK33(:,:,:)*(MYF(MXF(ZVOZ(:,:,:))) + ZCORIOZ(:,:,:))
-ZPOVO(:,:,:)= ZPOVO(:,:,:)*1E6/XRHODREF(:,:,:)
-ZPOVO(:,:,1) =-1.E+11
-ZPOVO(:,:,IKU)=-1.E+11
-IF (INDEX(CISO,'EV') /= 0) THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'POVOT', &
- CSTDNAME = '', &
- CLONGNAME = 'POVOT', &
- CUNITS = 'PVU', & ! 1 PVU = 1e-6 m^2 s^-1 K kg^-1
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_POtential VOrticity', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZPOVO)
-END IF
-!
-!
-IF (LVAR_RS) THEN
- CALL IO_Field_write(TPFILE,'UT',XUT)
- CALL IO_Field_write(TPFILE,'VT',XVT)
- !
- IF (LWIND_ZM) THEN
- TZFIELD2(1) = TFIELDMETADATA( &
- CMNHNAME = 'UM_ZM', &
- CSTDNAME = '', &
- CLONGNAME = 'UM_ZM', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'Zonal component of horizontal wind', &
- NGRID = 2, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- !
- TZFIELD2(2) = TFIELDMETADATA( &
- CMNHNAME = 'VM_ZM', &
- CSTDNAME = '', &
- CLONGNAME = 'VM_ZM', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'Meridian component of horizontal wind', &
- NGRID = 3, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- !
- CALL UV_TO_ZONAL_AND_MERID(XUT,XVT,23,TPFILE=TPFILE,TZFIELDS=TZFIELD2)
- END IF
- !
- CALL IO_Field_write(TPFILE,'WT',XWT)
- !
- ! write mixing ratio for water vapor required to plot radio-soundings
- !
- IF (LUSERV) THEN
- CALL IO_Field_write(TPFILE,'RVT',XRT(:,:,:,IDX_RVT))
- END IF
-END IF
-!
-!* Latitude and Longitude arrays
-!
-IF (.NOT.LCARTESIAN) THEN
- CALL IO_Field_write(TPFILE,'LAT',XLAT)
- CALL IO_Field_write(TPFILE,'LON',XLON)
-END IF
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 1.6 Other pronostic variables
-!
-ZTEMP(:,:,:)=XTHT(:,:,:)*(XPABST(:,:,:)/ XP00) **(XRD/XCPD)
-!
-IF (LVAR_TURB) THEN
- IF (CTURB /= 'NONE') THEN
- CALL IO_Field_write(TPFILE,'TKET',XTKET)
- !
- IF( NRR > 1 ) THEN
- CALL IO_Field_write(TPFILE,'SRCT',XSRCT)
- CALL IO_Field_write(TPFILE,'SIGS',XSIGS)
- END IF
- !
- IF(CTOM=='TM06') THEN
- CALL IO_Field_write(TPFILE,'BL_DEPTH',XBL_DEPTH)
- END IF
- END IF
-END IF
-!
-!* Rains
-!
-IF (LVAR_PR .AND. LUSERR .AND. SIZE(XINPRR)>0 ) THEN
- !
- ! explicit species
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME('INPRR',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_Field_write(TPFILE,TZFIELD,XINPRR*3.6E6)
- !
- CALL IO_Field_write(TPFILE,'INPRR3D',XINPRR3D)
- CALL IO_Field_write(TPFILE,'EVAP3D', XEVAP3D)
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRR',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm'
- CALL IO_Field_write(TPFILE,TZFIELD,XACPRR*1.0E3)
- !
- IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR.&
- CCLOUD == 'KHKO' .OR. CCLOUD == 'LIMA') THEN
- IF (SIZE(XINPRC) /= 0 ) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('INPRC',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_Field_write(TPFILE,TZFIELD,XINPRC*3.6E6)
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRC',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm'
- CALL IO_Field_write(TPFILE,TZFIELD,XACPRC*1.0E3)
- END IF
- IF (SIZE(XINDEP) /= 0 ) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('INDEP',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_Field_write(TPFILE,TZFIELD,XINDEP*3.6E6)
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME('ACDEP',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm'
- CALL IO_Field_write(TPFILE,TZFIELD,XACDEP*1.0E3)
- END IF
- END IF
- IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'LIMA') THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('INPRS',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_Field_write(TPFILE,TZFIELD,XINPRS*3.6E6)
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRS',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm'
- CALL IO_Field_write(TPFILE,TZFIELD,XACPRS*1.0E3)
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME('INPRG',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_Field_write(TPFILE,TZFIELD,XINPRG*3.6E6)
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRG',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm'
- CALL IO_Field_write(TPFILE,TZFIELD,XACPRG*1.0E3)
- !
- IF (SIZE(XINPRH) /= 0 ) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('INPRH',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_Field_write(TPFILE,TZFIELD,XINPRH*3.6E6)
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRH',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm'
- CALL IO_Field_write(TPFILE,TZFIELD,XACPRH*1.0E3)
- ENDIF
- !
- ZWORK21(:,:) = XINPRR(:,:) + XINPRS(:,:) + XINPRG(:,:)
- IF (SIZE(XINPRC) /= 0 ) &
- ZWORK21(:,:) = ZWORK21(:,:) + XINPRC(:,:)
- IF (SIZE(XINPRH) /= 0 ) &
- ZWORK21(:,:) = ZWORK21(:,:) + XINPRH(:,:)
- CALL FIND_FIELD_ID_FROM_MNHNAME('INPRT',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21*3.6E6)
- !
- ZWORK21(:,:) = XACPRR(:,:) + XACPRS(:,:) + XACPRG(:,:)
- IF (SIZE(XINPRC) /= 0 ) &
- ZWORK21(:,:) = ZWORK21(:,:) + XACPRC(:,:)
- IF (SIZE(XINPRH) /= 0 ) &
- ZWORK21(:,:) = ZWORK21(:,:) + XACPRH(:,:)
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRT',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm'
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21*1.0E3)
- !
- END IF
- !
- !* Convective rain
- !
- IF (CDCONV /= 'NONE') THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('PRCONV',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_Field_write(TPFILE,TZFIELD,XPRCONV*3.6E6)
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME('PACCONV',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm'
- CALL IO_Field_write(TPFILE,TZFIELD,XPACCONV*1.0E3)
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME('PRSCONV',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'mm hour-1'
- CALL IO_Field_write(TPFILE,TZFIELD,XPRSCONV*3.6E6)
- END IF
-END IF
-IF (LVAR_PR ) THEN
- !Precipitable water in kg/m**2
- ZWORK21(:,:) = 0.
- ZWORK22(:,:) = 0.
- ZWORK23(:,:) = 0.
- ZWORK31(:,:,:) = DZF(XZZ(:,:,:))
- DO JK = IKB,IKE
- !* Calcul de qtot
- IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'LIMA') THEN
- ZWORK23(IIB:IIE,IJB:IJE) = XRT(IIB:IIE,IJB:IJE,JK,1) + &
- XRT(IIB:IIE,IJB:IJE,JK,2) + XRT(IIB:IIE,IJB:IJE,JK,3) + &
- XRT(IIB:IIE,IJB:IJE,JK,4) + XRT(IIB:IIE,IJB:IJE,JK,5) + &
- XRT(IIB:IIE,IJB:IJE,JK,6)
- ELSE
- ZWORK23(IIB:IIE,IJB:IJE) = XRT(IIB:IIE,IJB:IJE,JK,1)
- ENDIF
- !* Calcul de l'eau precipitable
- ZWORK21(IIB:IIE,IJB:IJE)=XRHODREF(IIB:IIE,IJB:IJE,JK)* &
- ZWORK23(IIB:IIE,IJB:IJE)* ZWORK31(IIB:IIE,IJB:IJE,JK)
- !* Sum
- ZWORK22(IIB:IIE,IJB:IJE) = ZWORK22(IIB:IIE,IJB:IJE)+ZWORK21(IIB:IIE,IJB:IJE)
- ZWORK21(:,:) = 0.
- ZWORK23(:,:) = 0.
- END DO
- !* Precipitable water in kg/m**2
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'PRECIP_WAT', &
- CSTDNAME = '', &
- CLONGNAME = 'PRECIP_WAT', &
- CUNITS = 'kg m-2', &
- CDIR = 'XY', &
- CCOMMENT = '', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22)
-ENDIF
-!
-!
-!* Flux d'humidite et d'hydrometeores
-IF (LHU_FLX) THEN
- ZWORK35(:,:,:) = XRHODREF(:,:,:) * XRT(:,:,:,1)
- ZWORK31(:,:,:) = MXM(ZWORK35(:,:,:)) * XUT(:,:,:)
- ZWORK32(:,:,:) = MYM(ZWORK35(:,:,:)) * XVT(:,:,:)
- ZWORK35(:,:,:) = GX_U_M(ZWORK31,XDXX,XDZZ,XDZX) + GY_V_M(ZWORK32,XDYY,XDZZ,XDZY)
- IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'LIMA') THEN
- ZWORK36(:,:,:) = ZWORK35(:,:,:) + XRHODREF(:,:,:) * (XRT(:,:,:,2) + &
- XRT(:,:,:,3) + XRT(:,:,:,4) + XRT(:,:,:,5) + XRT(:,:,:,6))
- ZWORK33(:,:,:) = MXM(ZWORK36(:,:,:)) * XUT(:,:,:)
- ZWORK34(:,:,:) = MYM(ZWORK36(:,:,:)) * XVT(:,:,:)
- ZWORK36(:,:,:) = GX_U_M(ZWORK33,XDXX,XDZZ,XDZX) + GY_V_M(ZWORK34,XDYY,XDZZ,XDZY)
- ENDIF
- !
- ! Integration sur 3000 m
- !
- IKTOP(:,:)=0
- DO JK=1,IKU-1
- WHERE (((XZZ(:,:,JK) -XZS(:,:))<= 3000.0) .AND. ((XZZ(:,:,JK+1) -XZS(:,:))> 3000.0))
- IKTOP(:,:)=JK
- END WHERE
- END DO
- ZDELTAZ(:,:,:)=DZF(XZZ)
- ZWORK21(:,:) = 0.
- ZWORK22(:,:) = 0.
- ZWORK25(:,:) = 0.
- DO JJ=1,IJU
- DO JI=1,IIU
- IAUX=IKTOP(JI,JJ)
- DO JK=IKB,IAUX-1
- ZWORK21(JI,JJ) = ZWORK21(JI,JJ) + ZWORK31(JI,JJ,JK) * ZDELTAZ(JI,JJ,JK)
- ZWORK22(JI,JJ) = ZWORK22(JI,JJ) + ZWORK32(JI,JJ,JK) * ZDELTAZ(JI,JJ,JK)
- ZWORK25(JI,JJ) = ZWORK25(JI,JJ) + ZWORK35(JI,JJ,JK) * ZDELTAZ(JI,JJ,JK)
- ENDDO
- IF (IAUX >= IKB) THEN
- ZDELTAZ(JI,JJ,IAUX)= 3000. - (XZZ(JI,JJ,IAUX) -XZS(JI,JJ))
- ZWORK21(JI,JJ) = ZWORK21(JI,JJ) + ZWORK31(JI,JJ,IAUX) * ZDELTAZ(JI,JJ,IAUX)
- ZWORK22(JI,JJ) = ZWORK22(JI,JJ) + ZWORK32(JI,JJ,IAUX) * ZDELTAZ(JI,JJ,IAUX)
- ZWORK25(JI,JJ) = ZWORK25(JI,JJ) + ZWORK35(JI,JJ,IAUX) * ZDELTAZ(JI,JJ,IAUX)
- ENDIF
- ENDDO
- ENDDO
- IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'LIMA') THEN
- ZWORK23(:,:) = 0.
- ZWORK24(:,:) = 0.
- ZWORK26(:,:) = 0.
- DO JJ=1,IJU
- DO JI=1,IIU
- IAUX=IKTOP(JI,JJ)
- DO JK=IKB,IAUX-1
- ZWORK23(JI,JJ) = ZWORK23(JI,JJ) + ZWORK33(JI,JJ,JK) * ZDELTAZ(JI,JJ,JK)
- ZWORK24(JI,JJ) = ZWORK24(JI,JJ) + ZWORK34(JI,JJ,JK) * ZDELTAZ(JI,JJ,JK)
- ZWORK26(JI,JJ) = ZWORK26(JI,JJ) + ZWORK36(JI,JJ,JK) * ZDELTAZ(JI,JJ,JK)
- ENDDO
- IF (IAUX >= IKB) THEN
- ZDELTAZ(JI,JJ,IAUX)= 3000. - (XZZ(JI,JJ,IAUX) -XZS(JI,JJ))
- ZWORK23(JI,JJ) = ZWORK23(JI,JJ) + ZWORK33(JI,JJ,IAUX) * ZDELTAZ(JI,JJ,IAUX)
- ZWORK24(JI,JJ) = ZWORK24(JI,JJ) + ZWORK34(JI,JJ,IAUX) * ZDELTAZ(JI,JJ,IAUX)
- ZWORK26(JI,JJ) = ZWORK26(JI,JJ) + ZWORK36(JI,JJ,IAUX) * ZDELTAZ(JI,JJ,IAUX)
- ENDIF
- ENDDO
- ENDDO
- ENDIF
- ! Ecriture
- ! composantes U et V du flux surfacique d'humidite
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'UM90', &
- CSTDNAME = '', &
- CLONGNAME = 'UM90', &
- CUNITS = 'kg s-1 m-2', &
- CDIR = 'XY', &
- CCOMMENT = '', &
- NGRID = 2, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'VM90', &
- CSTDNAME = '', &
- CLONGNAME = 'VM90', &
- CUNITS = 'kg s-1 m-2', &
- CDIR = 'XY', &
- CCOMMENT = '', &
- NGRID = 3, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32)
- ! composantes U et V du flux d'humidite integre sur 3000 metres
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'UM91', &
- CSTDNAME = '', &
- CLONGNAME = 'UM91', &
- CUNITS = 'kg s-1 m-1', &
- CDIR = 'XY', &
- CCOMMENT = '', &
- NGRID = 2, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'VM91', &
- CSTDNAME = '', &
- CLONGNAME = 'VM91', &
- CUNITS = 'kg s-1 m-1', &
- CDIR = 'XY', &
- CCOMMENT = '', &
- NGRID = 3, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22)
- !
- ! Convergence d'humidite
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'HMCONV', &
- CSTDNAME = '', &
- CLONGNAME = 'HMCONV', &
- CUNITS = 'kg s-1 m-3', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Horizontal CONVergence of moisture flux', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,-ZWORK35)
- !
- ! Convergence d'humidite integre sur 3000 metres
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'HMCONV3000', &
- CSTDNAME = '', &
- CLONGNAME = 'HMCONV3000', &
- CUNITS = 'kg s-1 m-3', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Horizontal CONVergence of moisture flux', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,-ZWORK25)
- !
- IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'LIMA') THEN
- ! composantes U et V du flux surfacique d'hydrometeores
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'UM92', &
- CSTDNAME = '', &
- CLONGNAME = 'UM92', &
- CUNITS = 'kg s-1 m-2', &
- CDIR = 'XY', &
- CCOMMENT = '', &
- NGRID = 2, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'VM92', &
- CSTDNAME = '', &
- CLONGNAME = 'VM92', &
- CUNITS = 'kg s-1 m-2', &
- CDIR = 'XY', &
- CCOMMENT = '', &
- NGRID = 3, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK34)
- ! composantes U et V du flux d'hydrometeores integre sur 3000 metres
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'UM93', &
- CSTDNAME = '', &
- CLONGNAME = 'UM93', &
- CUNITS = 'kg s-1 m-1', &
- CDIR = 'XY', &
- CCOMMENT = '', &
- NGRID = 2, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK23)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'VM93', &
- CSTDNAME = '', &
- CLONGNAME = 'VM93', &
- CUNITS = 'kg s-1 m-1', &
- CDIR = 'XY', &
- CCOMMENT = '', &
- NGRID = 3, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK24)
- ! Convergence d'hydrometeores
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'HMCONV_TT', &
- CSTDNAME = '', &
- CLONGNAME = 'HMCONV_TT', &
- CUNITS = 'kg s-1 m-3', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Horizontal CONVergence of hydrometeor flux', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,-ZWORK36)
- ! Convergence d'hydrometeores integre sur 3000 metres
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'HMCONV3000_TT', &
- CSTDNAME = '', &
- CLONGNAME = 'HMCONV3000_TT', &
- CUNITS = 'kg s-1 m-3', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Horizontal CONVergence of hydrometeor flux', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,-ZWORK26)
- ENDIF
-ENDIF
-!
-!* Moist variables
-!
-IF (LVAR_MRW .OR. LLIMA_DIAG) THEN
- IF (NRR >=1) THEN
- ! Moist variables are written individually in file
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'generic for moist variables', & !Temporary name to ease identification
- CSTDNAME = '', &
- CDIR = 'XY', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- IF (LUSERV) THEN
- TZFIELD%CMNHNAME = 'MRV'
- TZFIELD%CLONGNAME = 'MRV'
- TZFIELD%CUNITS = 'g kg-1'
- TZFIELD%CCOMMENT = 'X_Y_Z_MRV'
- CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RVT)*1.E3)
- END IF
- IF (LUSERC) THEN
- TZFIELD%CMNHNAME = 'MRC'
- TZFIELD%CLONGNAME = 'MRC'
- TZFIELD%CUNITS = 'g kg-1'
- TZFIELD%CCOMMENT = 'X_Y_Z_MRC'
- CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RCT)*1.E3)
-!
- TZFIELD%CMNHNAME = 'VRC'
- TZFIELD%CLONGNAME = 'VRC'
- TZFIELD%CUNITS = 'ppv' !vol/vol
- TZFIELD%CCOMMENT = 'X_Y_Z_VRC (vol/vol)'
- CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RCT)*XRHODREF(:,:,:)/1.E3)
- END IF
- IF (LUSERR) THEN
- TZFIELD%CMNHNAME = 'MRR'
- TZFIELD%CLONGNAME = 'MRR'
- TZFIELD%CUNITS = 'g kg-1'
- TZFIELD%CCOMMENT = 'X_Y_Z_MRR'
- CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RRT)*1.E3)
-!
- TZFIELD%CMNHNAME = 'VRR'
- TZFIELD%CLONGNAME = 'VRR'
- TZFIELD%CUNITS = 'ppv' !vol/vol
- TZFIELD%CCOMMENT = 'X_Y_Z_VRR (vol/vol)'
- CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RRT)*XRHODREF(:,:,:)/1.E3)
- END IF
- IF (LUSERI) THEN
- TZFIELD%CMNHNAME = 'MRI'
- TZFIELD%CLONGNAME = 'MRI'
- TZFIELD%CUNITS = 'g kg-1'
- TZFIELD%CCOMMENT = 'X_Y_Z_MRI'
- CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RIT)*1.E3)
-!
- IF (LUSECI) THEN
- CALL IO_Field_write(TPFILE,'CIT',XCIT(:,:,:))
- END IF
- END IF
- IF (LUSERS) THEN
- TZFIELD%CMNHNAME = 'MRS'
- TZFIELD%CLONGNAME = 'MRS'
- TZFIELD%CUNITS = 'g kg-1'
- TZFIELD%CCOMMENT = 'X_Y_Z_MRS'
- CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RST)*1.E3)
- END IF
- IF (LUSERG) THEN
- TZFIELD%CMNHNAME = 'MRG'
- TZFIELD%CLONGNAME = 'MRG'
- TZFIELD%CUNITS = 'g kg-1'
- TZFIELD%CCOMMENT = 'X_Y_Z_MRG'
- CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RGT)*1.E3)
- END IF
- IF (LUSERH) THEN
- TZFIELD%CMNHNAME = 'MRH'
- TZFIELD%CLONGNAME = 'MRH'
- TZFIELD%CUNITS = 'g kg-1'
- TZFIELD%CCOMMENT = 'X_Y_Z_MRH'
- CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RHT)*1.E3)
- END IF
- END IF
-END IF
-!
-!* Scalar Variables
-!
-! User scalar variables
-! individually in the file
-IF (LVAR_MRSV) THEN
- DO JSV = 1,NSV_USER
- TZFIELD = TSVLIST(JSV)
- WRITE( TZFIELD%CMNHNAME, '( A4, I3.3 )' ) 'MRSV', JSV
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'g kg-1'
- WRITE( TZFIELD%CCOMMENT, '( A, I3.3 )' ) 'Mixing Ratio for user Scalar Variable', JSV
- CALL IO_Field_write( TPFILE, TZFIELD, XSVT(:,:,:,JSV) * 1.E3 )
- END DO
-END IF
-! microphysical C2R2 scheme scalar variables
-IF(LVAR_MRW) THEN
- DO JSV = NSV_C2R2BEG,NSV_C2R2END
- TZFIELD = TSVLIST(JSV)
- IF (JSV < NSV_C2R2END) THEN
- TZFIELD%CUNITS = 'cm-3'
- ZWORK31(:,:,:)=XSVT(:,:,:,JSV)*1.E-6
- ELSE
- TZFIELD%CUNITS = 'l-1'
- ZWORK31(:,:,:)=XSVT(:,:,:,JSV)*1.E-3
- END IF
- WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','MRSV',JSV
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
- END DO
- ! microphysical C3R5 scheme additional scalar variables
- DO JSV = NSV_C1R3BEG,NSV_C1R3END
- TZFIELD = TSVLIST(JSV)
- TZFIELD%CUNITS = 'l-1'
- CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E-3)
- END DO
-END IF
-!
-! microphysical LIMA scheme scalar variables
-!
-IF (LLIMA_DIAG) THEN
- IF (NSV_LIMA_END>=NSV_LIMA_BEG) THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'generic LIMA diag', & !Temporary name to ease identification
- CDIR = 'XY', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- END IF
- !
- DO JSV = NSV_LIMA_BEG,NSV_LIMA_END
-!PW: bases sur CLIMA_*_CONC et pas CLIMA_*_NAMES !!!
- !
- TZFIELD%CUNITS = 'cm-3'
- WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- !
-! Nc
- IF (JSV .EQ. NSV_LIMA_NC) THEN
- TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_CONC(1))
- END IF
-! Nr
- IF (JSV .EQ. NSV_LIMA_NR) THEN
- TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_CONC(2))
- END IF
-! N CCN free
- IF (JSV .GE. NSV_LIMA_CCN_FREE .AND. JSV .LT. NSV_LIMA_CCN_ACTI) THEN
- WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_CCN_FREE + 1)
- TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_CONC(3))//INDICE
- END IF
-! N CCN acti
- IF (JSV .GE. NSV_LIMA_CCN_ACTI .AND. JSV .LT. NSV_LIMA_CCN_ACTI + NMOD_CCN) THEN
- WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_CCN_ACTI + 1)
- TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_CONC(4))//INDICE
- END IF
-! Scavenging
- IF (JSV .EQ. NSV_LIMA_SCAVMASS) THEN
- TZFIELD%CMNHNAME = TRIM(CAERO_MASS(1))
- TZFIELD%CUNITS = 'kg cm-3'
- END IF
-! Ni
- IF (JSV .EQ. NSV_LIMA_NI) THEN
- TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_CONC(1))
- END IF
-! Ns
- IF (JSV .EQ. NSV_LIMA_NS) THEN
- TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_CONC(2))
- END IF
-! Ng
- IF (JSV .EQ. NSV_LIMA_NG) THEN
- TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_CONC(3))
- END IF
-! Nh
- IF (JSV .EQ. NSV_LIMA_NH) THEN
- TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_CONC(4))
- END IF
-! N IFN free
- IF (JSV .GE. NSV_LIMA_IFN_FREE .AND. JSV .LT. NSV_LIMA_IFN_NUCL) THEN
- WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_IFN_FREE + 1)
- TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_CONC(5))//INDICE
- END IF
-! N IFN nucl
- IF (JSV .GE. NSV_LIMA_IFN_NUCL .AND. JSV .LT. NSV_LIMA_IFN_NUCL + NMOD_IFN) THEN
- WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_IFN_NUCL + 1)
- TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_CONC(6))//INDICE
- END IF
-! N IMM nucl
- IF (JSV .GE. NSV_LIMA_IMM_NUCL .AND. JSV .LT. NSV_LIMA_IMM_NUCL + NMOD_IMM) THEN
- WRITE(INDICE,'(I2.2)')(NINDICE_CCN_IMM(JSV - NSV_LIMA_IMM_NUCL + 1))
- TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_CONC(7))//INDICE
- END IF
-! Hom. freez. of CCN
- IF (JSV .EQ. NSV_LIMA_HOM_HAZE) THEN
- TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_CONC(8))
- END IF
- !
-! Supersaturation
- IF (JSV .EQ. NSV_LIMA_SPRO) THEN
- TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_CONC(5))
- END IF
- !
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- ZWORK31(:,:,:)=XSVT(:,:,:,JSV)*1.E-6*XRHODREF(:,:,:)
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
- END DO
-!
- IF (LUSERC) THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'LWC', &
- CSTDNAME = '', &
- CLONGNAME = 'LWC', &
- CUNITS = 'g m-3', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_LWC', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- ZWORK31(:,:,:)=XRT(:,:,:,2)*1.E3*XRHODREF(:,:,:)
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
- END IF
-!
- IF (LUSERI) THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'IWC', &
- CSTDNAME = '', &
- CLONGNAME = 'IWC', &
- CUNITS = 'g m-3', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_MRI', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- ZWORK31(:,:,:)=XRT(:,:,:,4)*1.E3*XRHODREF(:,:,:)
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
- END IF
-!
-END IF
-!PW: TODO: a documenter
-IF (LELECDIAG .AND. CELEC .NE. "NONE") THEN
- DO JSV = NSV_ELECBEG,NSV_ELECEND
- TZFIELD = TSVLIST(JSV)
- IF ( JSV > NSV_ELECBEG .AND. JSV < NSV_ELECEND ) THEN
- TZFIELD%CUNITS = 'C m-3'
- WRITE( TZFIELD%CCOMMENT, '( A6, A3, I3.3 )' ) 'X_Y_Z_', 'SVT', JSV
- ELSE
- TZFIELD%CUNITS = 'm-3'
- WRITE( TZFIELD%CCOMMENT, '( A6, A3, I3.3, A8 )' ) 'X_Y_Z_', 'SVT', JSV, ' (nb ions/m3)'
- END IF
- ZWORK31(:,:,:)=XSVT(:,:,:,JSV) * XRHODREF(:,:,:) ! C/kg --> C/m3
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
- END DO
-END IF
-!
-! Lagrangian variables
-IF (LTRAJ) THEN
- DO JSV = NSV_LGBEG, NSV_LGEND
- TZFIELD = TSVLIST(JSV)
- WRITE(TZFIELD%CCOMMENT,'(A6,A20,I3.3,A4)')'X_Y_Z_','Lagrangian variable ',JSV
- CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
- END DO
-
- ! X coordinate
- DO JK=1,IKU
- DO JJ=1,IJU
- ZWORK31(:,JJ,JK) = 1E-3*XXHATM(:)
- END DO
- END DO
-
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'X', &
- CSTDNAME = '', &
- CLONGNAME = 'X', &
- CUNITS = 'km', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_X coordinate', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
-
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
-
- ! Y coordinate
- DO JK=1,IKU
- DO JI=1,IIU
- ZWORK31(JI,:,JK) = 1E-3 * XYHATM(:)
- END DO
- END DO
-
- TZFIELD%CMNHNAME = 'Y'
- TZFIELD%CLONGNAME = 'Y'
- TZFIELD%CCOMMENT = 'X_Y_Z_Y coordinate'
-
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
-END IF
-!
-! Passive polluant scalar variables
-IF (LPASPOL) THEN
- ALLOCATE(ZRHOT( SIZE(XTHT,1), SIZE(XTHT,2),SIZE(XTHT,3)))
- ALLOCATE(ZTMP( SIZE(XTHT,1), SIZE(XTHT,2),SIZE(XTHT,3)))
-!
-!* Density
-!
- ZRHOT(:,:,:)=XPABST(:,:,:)/(XRD*XTHT(:,:,:)*((XPABST(:,:,:)/XP00)**(XRD/XCPD)))
-!
-!* Conversion g/m3.
-!
- ZRHOT(:,:,:)=ZRHOT(:,:,:)*1000.0
- !
- DO JSV = NSV_PPBEG, NSV_PPEND
- TZFIELD = TSVLIST(JSV)
- TZFIELD%CUNITS = 'g m-3'
-
- ZTMP(:,:,:)=ABS( XSVT(:,:,:,JSV)*ZRHOT(:,:,:) )
- CALL IO_Field_write(TPFILE,TZFIELD,ZTMP)
- END DO
-
- DEALLOCATE(ZTMP)
- DEALLOCATE(ZRHOT)
-END IF
-! Conditional sampling variables
-IF (LCONDSAMP) THEN
-!PW: TODO: a documenter!!!
- DO JSV = NSV_CSBEG, NSV_CSEND
- TZFIELD = TSVLIST(JSV)
- CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
- END DO
-END IF
-! chemical scalar variables in gas phase ppb
-IF (LCHEMDIAG) THEN
- DO JSV = NSV_CHGSBEG,NSV_CHGSEND
- TZFIELD = TSVLIST(JSV)
- TZFIELD%CUNITS = 'ppb'
- WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','CHIM',JSV
- CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9)
- END DO
-END IF
-IF (LCHAQDIAG) THEN !aqueous concentration in M
- ZWORK31(:,:,:)=0.
- DO JSV = NSV_CHACBEG, NSV_CHACBEG-1+NEQAQ/2 !cloud water
- TZFIELD = TSVLIST(JSV)
- TZFIELD%CUNITS = 'mol l-1' !Original value: 'M' (molar) but not known by udunits => replaced by equivalent mol l-1
- WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','CHAQ',JSV
- WHERE(((XRT(:,:,:,2)*XRHODREF(:,:,:))/1.e3) .GE. XRTMIN_AQ)
- ZWORK31(:,:,:)=(XSVT(:,:,:,JSV)*1000.)/(XMD*1.E+3*XRT(:,:,:,2))
- ENDWHERE
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
- END DO
- !
- ZWORK31(:,:,:)=0.
- DO JSV = NSV_CHACBEG+NEQAQ/2, NSV_CHACEND !rain water
- TZFIELD = TSVLIST(JSV)
- TZFIELD%CUNITS = 'mol l-1' !Original value: 'M' (molar) but not known by udunits => replaced by equivalent mol l-1
- WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','CHAQ',JSV
- WHERE(((XRT(:,:,:,3)*XRHODREF(:,:,:))/1.e3) .GE. XRTMIN_AQ)
- ZWORK31(:,:,:)=(XSVT(:,:,:,JSV)*1000.)/(XMD*1.E+3*XRT(:,:,:,3))
- ENDWHERE
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
- END DO
-
-
-
-!PW: TODO: LCHICDIAG n'existe pas => les variables correspondantes ne sont pas ecrites...
-
-! ZWORK31(:,:,:)=0.
-! DO JSV = NSV_CHICBEG,NSV_CHICEND ! ice phase
-! TZFIELD%CMNHNAME = TRIM(CICNAMES(JSV-NSV_CHICBEG+1))
-! TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
-! WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3,A4)')'X_Y_Z_','CHIC',JSV,' (M)'
-! WHERE(((XRT(:,:,:,3)*XRHODREF(:,:,:))/1.e3) .GE. XRTMIN_AQ)
-! ZWORK31(:,:,:)=(XSVT(:,:,:,JSV)*1000.)/(XMD*1.E+3*XRT(:,:,:,3))
-! ENDWHERE
-! CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
-! END DO
-END IF
-! Aerosol
-IF ((LCHEMDIAG).AND.(LORILAM).AND.(LUSECHEM)) THEN
- DO JSV = NSV_AERBEG, NSV_AEREND
- TZFIELD = TSVLIST(JSV)
- TZFIELD%CUNITS = 'ppb'
- WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','AERO',JSV
- CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9)
- END DO
- !
- IF (.NOT.(ASSOCIATED(XN3D))) &
- ALLOCATE(XN3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE))
- IF (.NOT.(ASSOCIATED(XRG3D))) &
- ALLOCATE(XRG3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE))
- IF (.NOT.(ASSOCIATED(XSIG3D))) &
- ALLOCATE(XSIG3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE))
- !
- CALL PPP2AERO(XSVT(:,:,:,NSV_AERBEG:NSV_AEREND), XRHODREF, &
- PSIG3D=XSIG3D, PRG3D=XRG3D, PN3D=XN3D, PCTOTA=ZPTOTA)
-
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'generic for aerosol modes', &
- CSTDNAME = '', &
- CDIR = 'XY', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
-
- DO JJ=1,JPMODE
- WRITE(TZFIELD%CMNHNAME,'(A3,I1)')'RGA',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'um'
- WRITE(TZFIELD%CCOMMENT,'(A21,I1)')'RG (nb) AEROSOL MODE ',JJ
- CALL IO_Field_write(TPFILE,TZFIELD,XRG3D(:,:,:,JJ))
- !
- WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'RGAM',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'um'
- WRITE(TZFIELD%CCOMMENT,'(A20,I1)')'RG (m) AEROSOL MODE ',JJ
- ZWORK31(:,:,:)=XRG3D(:,:,:,JJ) / (EXP(-3.*(LOG(XSIG3D(:,:,:,JJ)))**2))
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
- !
- WRITE(TZFIELD%CMNHNAME,'(A3,I1)')'N0A',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'cm-3'
- WRITE(TZFIELD%CCOMMENT,'(A16,I1)')'N0 AEROSOL MODE ',JJ
- CALL IO_Field_write(TPFILE,TZFIELD,XN3D(:,:,:,JJ)*1.E-6)
- !
- WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'SIGA',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = '1'
- WRITE(TZFIELD%CCOMMENT,'(A19,I1)')'SIGMA AEROSOL MODE ',JJ
- CALL IO_Field_write(TPFILE,TZFIELD,XSIG3D(:,:,:,JJ))
- !
- WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'MSO4',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'ug m-3'
- WRITE(TZFIELD%CCOMMENT,'(A22,I1)')'MASS SO4 AEROSOL MODE ',JJ
- CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SO4,JJ))
- !
- WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'MNO3',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'ug m-3'
- WRITE(TZFIELD%CCOMMENT,'(A22,I1)')'MASS NO3 AEROSOL MODE ',JJ
- CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_NO3,JJ))
- !
- WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'MNH3',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'ug m-3'
- WRITE(TZFIELD%CCOMMENT,'(A22,I1)')'MASS NH3 AEROSOL MODE ',JJ
- CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_NH3,JJ))
- !
- WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'MH2O',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'ug m-3'
- WRITE(TZFIELD%CCOMMENT,'(A22,I1)')'MASS H2O AEROSOL MODE ',JJ
- CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_H2O,JJ))
- !
- IF (NSOA .EQ. 10) THEN
- WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA1',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'ug m-3'
- WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA1 AEROSOL MODE ',JJ
- CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA1,JJ))
- !
- WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA2',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'ug m-3'
- WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA2 AEROSOL MODE ',JJ
- CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA2,JJ))
- !
- WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA3',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'ug m-3'
- WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA3 AEROSOL MODE ',JJ
- CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA3,JJ))
- !
- WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA4',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'ug m-3'
- WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA4 AEROSOL MODE ',JJ
- CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA4,JJ))
- !
- WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA5',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'ug m-3'
- WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA5 AEROSOL MODE ',JJ
- CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA5,JJ))
- !
- WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA6',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'ug m-3'
- WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA6 AEROSOL MODE ',JJ
- CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA6,JJ))
- !
- WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA7',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'ug m-3'
- WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA7 AEROSOL MODE ',JJ
- CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA7,JJ))
- !
- WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA8',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'ug m-3'
- WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA8 AEROSOL MODE ',JJ
- CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA8,JJ))
- !
- WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA9',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'ug m-3'
- WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA9 AEROSOL MODE ',JJ
- CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA9,JJ))
- !
- WRITE(TZFIELD%CMNHNAME,'(A6,I1)')'MSOA10',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'ug m-3'
- WRITE(TZFIELD%CCOMMENT,'(A24,I1)')'MASS SOA10 AEROSOL MODE ',JJ
- CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA10,JJ))
- END IF
- !
- WRITE(TZFIELD%CMNHNAME,'(A3,I1)')'MOC',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'ug m-3'
- WRITE(TZFIELD%CCOMMENT,'(A21,I1)')'MASS OC AEROSOL MODE ',JJ
- CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_OC,JJ))
- !
- WRITE(TZFIELD%CMNHNAME,'(A3,I1)')'MBC',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'ug m-3'
- WRITE(TZFIELD%CCOMMENT,'(A21,I1)')'MASS BC AEROSOL MODE ',JJ
- CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_BC,JJ))
- ENDDO
-END IF
-! Dust variables
-IF (LDUST) THEN
- IF(.NOT.ALLOCATED(ZSIG_DST)) &
- ALLOCATE(ZSIG_DST(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), NMODE_DST))
- IF(.NOT.ALLOCATED(ZRG_DST)) &
- ALLOCATE(ZRG_DST(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), NMODE_DST))
- IF(.NOT.ALLOCATED(ZN0_DST)) &
- ALLOCATE(ZN0_DST(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), NMODE_DST))
- !
- DO JSV = NSV_DSTBEG, NSV_DSTEND
- TZFIELD = TSVLIST(JSV)
- TZFIELD%CUNITS = 'ppb'
- WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','DUST',JSV
- CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9)
- END DO
- !
- CALL PPP2DUST(XSVT(:,:,:,NSV_DSTBEG:NSV_DSTEND),XRHODREF,&
- PSIG3D=ZSIG_DST, PRG3D=ZRG_DST, PN3D=ZN0_DST)
-
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'generic for dust modes', &
- CSTDNAME = '', &
- CDIR = 'XY', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
-
- TZFIELD2D = TFIELDMETADATA( &
- CMNHNAME = 'generic for dust modes', &
- CSTDNAME = '', &
- CDIR = 'XY', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
-
- DO JJ=1,NMODE_DST
- WRITE(TZFIELD%CMNHNAME,'(A6,I1)')'DSTRGA',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'um'
- WRITE(TZFIELD%CCOMMENT,'(A18,I1)')'RG (nb) DUST MODE ',JJ
- CALL IO_Field_write(TPFILE,TZFIELD,ZRG_DST(:,:,:,JJ))
- !
- WRITE(TZFIELD%CMNHNAME,'(A7,I1)')'DSTRGAM',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'um'
- WRITE(TZFIELD%CCOMMENT,'(A17,I1)')'RG (m) DUST MODE ',JJ
- ZWORK31(:,:,:)=ZRG_DST(:,:,:,JJ) / (EXP(-3.*(LOG(ZSIG_DST(:,:,:,JJ)))**2))
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
- !
- WRITE(TZFIELD%CMNHNAME,'(A6,I1)')'DSTN0A',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'm-3'
- WRITE(TZFIELD%CCOMMENT,'(A13,I1)')'N0 DUST MODE ',JJ
- CALL IO_Field_write(TPFILE,TZFIELD,ZN0_DST(:,:,:,JJ))
- !
- WRITE(TZFIELD%CMNHNAME,'(A7,I1)')'DSTSIGA',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = '1'
- WRITE(TZFIELD%CCOMMENT,'(A16,I1)')'SIGMA DUST MODE ',JJ
- CALL IO_Field_write(TPFILE,TZFIELD,ZSIG_DST(:,:,:,JJ))
- !DUST MASS CONCENTRATION
- WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'DSTMSS',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'ug m-3'
- WRITE(TZFIELD%CCOMMENT,'(A14,I1)')'MASSCONC MODE ',JJ
- ZWORK31(:,:,:)= ZN0_DST(:,:,:,JJ)*4./3.*3.14*2500.*1e9 & !kg-->ug
- * (ZRG_DST(:,:,:,JJ)**3)*1.d-18 & !um-->m
- * exp(4.5*log(ZSIG_DST(:,:,:,JJ))*log(ZSIG_DST(:,:,:,JJ)))
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
- !DUST BURDEN (g/m2)
- ZWORK21(:,:)=0.0
- DO JK=IKB,IKE
- ZWORK31(:,:,JK) = ZWORK31(:,:,JK) *(XZZ(:,:,JK+1)-XZZ(:,:,JK)) &
- *1.d-6 ! Convert to ug/m2-->g/m2 in each layer
- END DO
- !
- DO JK=IKB,IKE
- DO JT=IJB,IJE
- DO JI=IIB,IIE
- ZWORK21(JI,JT)=ZWORK21(JI,JT)+ZWORK31(JI,JT,JK)
- ENDDO
- ENDDO
- ENDDO
- WRITE(TZFIELD2D%CMNHNAME,'(A7,I1)')'DSTBRDN',JJ
- TZFIELD2D%CLONGNAME = TRIM(TZFIELD2D%CMNHNAME)
- TZFIELD2D%CUNITS = 'g m-2'
- WRITE(TZFIELD2D%CCOMMENT,'(A6,I1)')'BURDEN',JJ
- CALL IO_Field_write(TPFILE,TZFIELD2D,ZWORK21)
- ENDDO
-END IF
-IF (LDUST.AND.LDEPOS_DST(IMI)) THEN
- DO JSV = NSV_DSTBEG, NSV_DSTEND
- TZFIELD = TSVLIST(JSV)
- TZFIELD%CUNITS = 'ppb'
- WRITE(TZFIELD%CCOMMENT,'(A,I3.3)') 'X_Y_Z_DUSTDEP', JSV
- CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9)
- END DO
- !
- ZSDSTDEP => XSVT(:,:,:,NSV_DSTDEPBEG:NSV_DSTDEPEND)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'generic for dustdep modes', &
- CSTDNAME = '', &
- CDIR = 'XY', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- !
- DO JJ=1,NMODE_DST
- ! FOR CLOUDS
- WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'DSTDEPN0A',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- WRITE(TZFIELD%CCOMMENT,'(A16,I1)')'N0 DUSTDEP MODE ',JJ
- TZFIELD%CUNITS = 'm-3'
- ! CLOUD: CALCULATE MOMENT 3 FROM TOTAL AEROSOL MASS
- ZWORK31(:,:,:) = ZSDSTDEP(:,:,:,JJ) &!==>molec_{aer}/molec_{air}
- *(XMOLARWEIGHT_DUST/XMD) &!==>kg_{aer}/kg_{air}
- *XRHODREF(:,:,:) &!==>kg_{aer}/m3_{air}
- /XDENSITY_DUST &!==>m3_{aer}/m3_{air}
- *XM3TOUM3 &!==>um3_{aer}/m3_{air}
- /(XPI*4./3.) !==>um3_{aer}/m3_{air}
- !==>volume 3rd moment
- !CLOUD: CALCULATE MOMENT 0 FROM DISPERSION AND MEAN RADIUS
- ZWORK31(:,:,:)= ZWORK31(:,:,:)/ &
- ((ZRG_DST(:,:,:,JJ)**3)* &
- EXP(4.5 * LOG(ZSIG_DST(:,:,:,JJ))**2))
- !CLOUD: RETURN TO CONCENTRATION #/m3
- ZWORK31(:,:,:)= ZWORK31(:,:,:) * XMD/ &
- (XAVOGADRO*XRHODREF(:,:,:))
- !CLOUD: Get number concentration (#/molec_{air}==>#/m3)
- ZWORK31(:,:,:)= &
- ZWORK31(:,:,:) & !#/molec_{air}
- * XAVOGADRO & !==>#/mole
- / XMD & !==>#/kg_{air}
- * XRHODREF(:,:,:) !==>#/m3
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
- ! CLOUD: DUST MASS CONCENTRATION
- WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'DSTDEPMSS',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- WRITE(TZFIELD%CCOMMENT,'(A17,I1)')'DEPMASSCONC MODE ',JJ
- TZFIELD%CUNITS = 'ug m-3'
- ZWORK31(:,:,:)= ZWORK31(:,:,:)*4./3.*3.14*2500.*1e9 & !kg-->ug
- * (ZRG_DST(:,:,:,JJ)**3)*1.d-18 & !um-->m
- * exp(4.5*log(ZSIG_DST(:,:,:,JJ))*log(ZSIG_DST(:,:,:,JJ)))
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
- ! FOR RAIN DROPS
- WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'DSTDEPN0A',JJ+NMODE_DST
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- WRITE(TZFIELD%CCOMMENT,'(A16,I1)')'N0 DUSTDEP MODE ',JJ+NMODE_DST
- TZFIELD%CUNITS = 'm-3'
- ! RAIN: CALCULATE MOMENT 3 FROM TOTAL AEROSOL MASS
- ZWORK31(:,:,:)=ZSDSTDEP(:,:,:,JJ+NMODE_DST) &!==>molec_{aer}/molec_{air}
- *(XMOLARWEIGHT_DUST/XMD) &!==>kg_{aer}/kg_{air}
- *XRHODREF(:,:,:) &!==>kg_{aer}/m3_{air}
- *(1.d0/XDENSITY_DUST) &!==>m3_{aer}/m3_{air}
- *XM3TOUM3 &!==>um3_{aer}/m3_{air}
- /(XPI*4./3.) !==>um3_{aer}/m3_{air}
- !==>volume 3rd moment
- !RAIN: CALCULATE MOMENT 0 FROM DISPERSION AND MEAN RADIUS
- ZWORK31(:,:,:)= ZWORK31(:,:,:)/ &
- ((ZRG_DST(:,:,:,JJ)**3)* &
- EXP(4.5 * LOG(ZSIG_DST(:,:,:,JJ))**2))
- !RAIN: RETURN TO CONCENTRATION #/m3
- ZWORK31(:,:,:)= ZWORK31(:,:,:) * XMD/ &
- (XAVOGADRO*XRHODREF(:,:,:))
- !RAIN: Get number concentration (#/molec_{air}==>#/m3)
- ZWORK31(:,:,:)= &
- ZWORK31(:,:,:) & !#/molec_{air}
- * XAVOGADRO & !==>#/mole
- / XMD & !==>#/kg_{air}
- * XRHODREF(:,:,:) !==>#/m3
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
- ! RAIN: DUST MASS CONCENTRATION
- WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'DSTDEPMSS',JJ+NMODE_DST
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- WRITE(TZFIELD%CCOMMENT,'(A17,I1)')'DEPMASSCONC MODE ',JJ+NMODE_DST
- TZFIELD%CUNITS = 'ug m-3'
- ZWORK31(:,:,:)= ZWORK31(:,:,:)*4./3.*3.14*2500.*1e9 & !kg-->ug
- * (ZRG_DST(:,:,:,JJ)**3)*1.d-18 & !um-->m
- * exp(4.5*log(ZSIG_DST(:,:,:,JJ))*log(ZSIG_DST(:,:,:,JJ)))
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
- END DO
-
- ZSDSTDEP => NULL()
-!
-END IF
-! Sea Salt variables
-IF (LSALT) THEN
- IF(.NOT.ALLOCATED(ZSIG_SLT)) &
- ALLOCATE(ZSIG_SLT(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), NMODE_SLT))
- IF(.NOT.ALLOCATED(ZRG_SLT)) &
- ALLOCATE(ZRG_SLT(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), NMODE_SLT))
- IF(.NOT.ALLOCATED(ZN0_SLT)) &
- ALLOCATE(ZN0_SLT(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), NMODE_SLT))
- !
- DO JSV = NSV_SLTBEG, NSV_SLTEND
- TZFIELD = TSVLIST(JSV)
- TZFIELD%CUNITS = 'ppb'
- WRITE(TZFIELD%CCOMMENT,'(A,I3.3)') 'X_Y_Z_SALT', JSV
- CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9)
- END DO
- !
- CALL PPP2SALT(XSVT(:,:,:,NSV_SLTBEG:NSV_SLTEND),XRHODREF,&
- PSIG3D=ZSIG_SLT, PRG3D=ZRG_SLT, PN3D=ZN0_SLT)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'generic for salt modes', &
- CSTDNAME = '', &
- CDIR = 'XY', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- !
- TZFIELD2D = TFIELDMETADATA( &
- CMNHNAME = 'generic for salt modes', &
- CSTDNAME = '', &
- CDIR = 'XY', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- !
- DO JJ=1,NMODE_SLT
- WRITE(TZFIELD%CMNHNAME,'(A6,I1)')'SLTRGA',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'um'
- WRITE(TZFIELD%CCOMMENT,'(A18,I1)')'RG (nb) SALT MODE ',JJ
- CALL IO_Field_write(TPFILE,TZFIELD,ZRG_SLT(:,:,:,JJ))
- !
- WRITE(TZFIELD%CMNHNAME,'(A7,I1)')'SLTRGAM',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'um'
- WRITE(TZFIELD%CCOMMENT,'(A17,I1)')'RG (m) SALT MODE ',JJ
- ZWORK31(:,:,:)=ZRG_SLT(:,:,:,JJ) / (EXP(-3.*(LOG(ZSIG_SLT(:,:,:,JJ)))**2))
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
- !
- WRITE(TZFIELD%CMNHNAME,'(A6,I1)')'SLTN0A',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'm-3'
- WRITE(TZFIELD%CCOMMENT,'(A13,I1)')'N0 SALT MODE ',JJ
- CALL IO_Field_write(TPFILE,TZFIELD,ZN0_SLT(:,:,:,JJ))
- !
- WRITE(TZFIELD%CMNHNAME,'(A7,I1)')'SLTSIGA',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = '1'
- WRITE(TZFIELD%CCOMMENT,'(A16,I1)')'SIGMA SALT MODE ',JJ
- CALL IO_Field_write(TPFILE,TZFIELD,ZSIG_SLT(:,:,:,JJ))
- !SALT MASS CONCENTRATION
- WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'SLTMSS',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'ug m-3'
- WRITE(TZFIELD%CCOMMENT,'(A14,I1)')'MASSCONC MODE ',JJ
- ZWORK31(:,:,:)= ZN0_SLT(:,:,:,JJ)*4./3.*3.14*2500.*1e9 & !kg-->ug
- * (ZRG_SLT(:,:,:,JJ)**3)*1.d-18 & !um-->m
- * exp(4.5*log(ZSIG_SLT(:,:,:,JJ))*log(ZSIG_SLT(:,:,:,JJ)))
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
- !SALT BURDEN (g/m2)
- ZWORK21(:,:)=0.0
- DO JK=IKB,IKE
- ZWORK31(:,:,JK) = ZWORK31(:,:,JK) *(XZZ(:,:,JK+1)-XZZ(:,:,JK)) &
- *1.d-6 ! Convert to ug/m2-->g/m2 in each layer
- END DO
- !
- DO JK=IKB,IKE
- DO JT=IJB,IJE
- DO JI=IIB,IIE
- ZWORK21(JI,JT)=ZWORK21(JI,JT)+ZWORK31(JI,JT,JK)
- ENDDO
- ENDDO
- ENDDO
- WRITE(TZFIELD2D%CMNHNAME,'(A7,I1)')'SLTBRDN',JJ
- TZFIELD2D%CLONGNAME = TRIM(TZFIELD2D%CMNHNAME)
- TZFIELD2D%CUNITS = 'g m-2'
- WRITE(TZFIELD2D%CCOMMENT,'(A6,I1)')'BURDEN',JJ
- CALL IO_Field_write(TPFILE,TZFIELD2D,ZWORK21)
- ENDDO
-END IF
-IF (LSALT.AND.LDEPOS_SLT(IMI)) THEN
- !
- DO JSV = NSV_SLTDEPBEG, NSV_SLTDEPEND
- TZFIELD = TSVLIST(JSV)
- TZFIELD%CUNITS = 'ppb'
- WRITE(TZFIELD%CCOMMENT,'(A,I3.3)') 'X_Y_Z_SALTDEP', JSV
- CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9)
- END DO
- !
- ZSSLTDEP => XSVT(:,:,:,NSV_SLTDEPBEG:NSV_SLTDEPEND)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'generic for saltdep modes', &
- CSTDNAME = '', &
- CDIR = 'XY', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- !
- DO JJ=1,NMODE_SLT
- ! FOR CLOUDS
- WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'SLTDEPN0A',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- WRITE(TZFIELD%CCOMMENT,'(A16,I1)')'N0 DUSTDEP MODE ',JJ
- TZFIELD%CUNITS = 'm-3'
- ! CLOUD: CALCULATE MOMENT 3 FROM TOTAL AEROSOL MASS
- ZWORK31(:,:,:) = ZSSLTDEP(:,:,:,JJ) &!==>molec_{aer}/molec_{air}
- *(XMOLARWEIGHT_DUST/XMD) &!==>kg_{aer}/kg_{air}
- *XRHODREF(:,:,:) &!==>kg_{aer}/m3_{air}
- /XDENSITY_DUST &!==>m3_{aer}/m3_{air}
- *XM3TOUM3 &!==>um3_{aer}/m3_{air}
- /(XPI*4./3.) !==>um3_{aer}/m3_{air}
- !==>volume 3rd moment
- !CLOUD: CALCULATE MOMENT 0 FROM DISPERSION AND MEAN RADIUS
- ZWORK31(:,:,:) = ZWORK31(:,:,:)/ &
- ((ZRG_SLT(:,:,:,JJ)**3)* &
- EXP(4.5 * LOG(ZSIG_SLT(:,:,:,JJ))**2))
- !CLOUD: RETURN TO CONCENTRATION #/m3
- ZWORK31(:,:,:)= ZWORK31(:,:,:) * XMD/ &
- (XAVOGADRO*XRHODREF(:,:,:))
- !CLOUD: Get number concentration (#/molec_{air}==>#/m3)
- ZWORK31(:,:,:)= &
- ZWORK31(:,:,:) & !#/molec_{air}
- * XAVOGADRO & !==>#/mole
- / XMD & !==>#/kg_{air}
- * XRHODREF(:,:,:) !==>#/m3
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
- ! CLOUD: DUST MASS CONCENTRATION
- WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'SLTDEPMSS',JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- WRITE(TZFIELD%CCOMMENT,'(A17,I1)')'DEPMASSCONC MODE ',JJ
- TZFIELD%CUNITS = 'ug m-3'
- ZWORK31(:,:,:)= ZWORK31(:,:,:)*4./3.*3.14*2500.*1e9 & !kg-->ug
- * (ZRG_SLT(:,:,:,JJ)**3)*1.d-18 & !um-->m
- * exp(4.5*log(ZSIG_SLT(:,:,:,JJ))*log(ZSIG_SLT(:,:,:,JJ)))
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
- ! FOR RAIN DROPS
- WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'SLTDEPN0A',JJ+NMODE_SLT
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- WRITE(TZFIELD%CCOMMENT,'(A16,I1)')'N0 DUSTDEP MODE ',JJ+NMODE_SLT
- TZFIELD%CUNITS = 'm-3'
- ! RAIN: CALCULATE MOMENT 3 FROM TOTAL AEROSOL MASS
- ZWORK31(:,:,:) = ZSSLTDEP(:,:,:,JJ+NMODE_SLT) &!==>molec_{aer}/molec_{air}
- *(XMOLARWEIGHT_DUST/XMD) &!==>kg_{aer}/kg_{air}
- *XRHODREF(:,:,:) &!==>kg_{aer}/m3_{air}
- /XDENSITY_DUST &!==>m3_{aer}/m3_{air}
- *XM3TOUM3 &!==>um3_{aer}/m3_{air}
- /(XPI*4./3.) !==>um3_{aer}/m3_{air}
- !==>volume 3rd moment
- !RAIN: CALCULATE MOMENT 0 FROM DISPERSION AND MEAN RADIUS
- ZWORK31(:,:,:)= ZWORK31(:,:,:)/ &
- ((ZRG_SLT(:,:,:,JJ)**3)* &
- EXP(4.5 * LOG(ZSIG_SLT(:,:,:,JJ))**2))
- !RAIN: RETURN TO CONCENTRATION #/m3
- ZWORK31(:,:,:)= ZWORK31(:,:,:) * XMD/ &
- (XAVOGADRO*XRHODREF(:,:,:))
- !RAIN: Get number concentration (#/molec_{air}==>#/m3)
- ZWORK31(:,:,:)= &
- ZWORK31(:,:,:) & !#/molec_{air}
- * XAVOGADRO & !==>#/mole
- / XMD & !==>#/kg_{air}
- * XRHODREF(:,:,:) !==>#/m3
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
- ! RAIN: DUST MASS CONCENTRATION
- WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'SLTDEPMSS',JJ+NMODE_SLT
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- WRITE(TZFIELD%CCOMMENT,'(A17,I1)')'DEPMASSCONC MODE ',JJ+NMODE_SLT
- TZFIELD%CUNITS = 'ug m-3'
- ZWORK31(:,:,:)= ZWORK31(:,:,:)*4./3.*3.14*2500.*1e9 & !kg-->ug
- * (ZRG_SLT(:,:,:,JJ)**3)*1.d-18 & !um-->m
- * exp(4.5*log(ZSIG_SLT(:,:,:,JJ))*log(ZSIG_SLT(:,:,:,JJ)))
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
- END DO
-
- ZSSLTDEP => NULL()
-!
-END IF
-!
-! Blowing snow variables
-!
-IF(LBLOWSNOW) THEN
-!PW:TODO?:variables scalaires XSVT pas ecrites ici. Voulu?
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'SNWSUBL3D', &
- CSTDNAME = '', &
- CLONGNAME = 'SNWSUBL3D', &
- CUNITS = 'kg m-3 s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_INstantaneous 3D Drifting snow sublimation flux', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,XSNWSUBL3D(:,:,:))
- !
- ZWORK21(:,:) = 0.
- DO JK = IKB,IKE
- ZWORK21(:,:) = ZWORK21(:,:)+XSNWSUBL3D(:,:,JK) * &
- (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW*3600*24
- END DO
- ZWORK21(:,:) = ZWORK21(:,:)*1000. ! vapor water in mm unit
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'COL_SNWSUBL', &
- CSTDNAME = '', &
- CLONGNAME = 'COL_SNWSUBL', &
- CUNITS = 'mm day-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Column Sublimation Rate (mmSWE/day)', &
- NGRID = 4, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21(:,:))
- !
- IF(.NOT.ALLOCATED(ZBET_SNW)) &
- ALLOCATE(ZBET_SNW(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3)))
- IF(.NOT.ALLOCATED(ZRG_SNW)) &
- ALLOCATE(ZRG_SNW(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3)))
- IF(.NOT.ALLOCATED(ZMA_SNW)) &
- ALLOCATE(ZMA_SNW(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3),NBLOWSNOW3D))
- !
- CALL PPP2SNOW(XSVT(:,:,:,NSV_SNWBEG:NSV_SNWEND),XRHODREF,&
- PBET3D=ZBET_SNW, PRG3D=ZRG_SNW, PM3D=ZMA_SNW)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'SNWRGA', &
- CSTDNAME = '', &
- CLONGNAME = 'SNWRGA', &
- CUNITS = 'm', &
- CDIR = 'XY', &
- CCOMMENT = 'RG (mean) SNOW', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZRG_SNW(:,:,:))
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'SNWBETA', &
- CSTDNAME = '', &
- CLONGNAME = 'SNWBETA', &
- CUNITS = 'm', &
- CDIR = 'XY', &
- CCOMMENT = 'BETA SNOW', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZBET_SNW(:,:,:))
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'SNWNOA', &
- CSTDNAME = '', &
- CLONGNAME = 'SNWNOA', &
- CUNITS = 'm-3', &
- CDIR = 'XY', &
- CCOMMENT = 'NUM CONC SNOW (#/m3)', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZMA_SNW(:,:,:,1))
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'SNWMASS', &
- CSTDNAME = '', &
- CLONGNAME = 'SNWMASS', &
- CUNITS = 'kg m-3', &
- CDIR = 'XY', &
- CCOMMENT = 'MASS CONC SNOW', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZMA_SNW(:,:,:,2))
- !
- ZWORK21(:,:) = 0.
- DO JK = IKB,IKE
- ZWORK21(:,:) = ZWORK21(:,:)+ZMA_SNW(:,:,JK,2) * &
- (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW
- END DO
- ZWORK21(:,:) = ZWORK21(:,:)*1000. ! vapor water in mm unit
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'THDS', &
- CSTDNAME = '', &
- CLONGNAME = 'THDS', &
- CUNITS = 'mm', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_THickness of Drifting Snow (mm SWE)', &
- NGRID = 4, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21(:,:))
-END IF
-! linox scalar variables
-IF (.NOT.(LUSECHEM .OR. LCHEMDIAG) .AND. LCH_CONV_LINOX) THEN
- DO JSV = NSV_LNOXBEG, NSV_LNOXEND
- TZFIELD = TSVLIST(JSV)
- TZFIELD%CUNITS = 'ppb'
- WRITE(TZFIELD%CCOMMENT,'(A,I3.3)') 'X_Y_Z_LNOX', JSV
- CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9)
- END DO
-END IF
-!
-!* Large Scale variables
-!
-IF (LVAR_LS) THEN
- CALL IO_Field_write(TPFILE,'LSUM', XLSUM)
- CALL IO_Field_write(TPFILE,'LSVM', XLSVM)
- !
- IF (LWIND_ZM) THEN
- TZFIELD2(1) = TFIELDMETADATA( &
- CMNHNAME = 'LSUM_ZM', &
- CSTDNAME = '', &
- CLONGNAME = 'LSUM_ZM', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'Large Scale Zonal component of horizontal wind', &
- NGRID = 2, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- !
- TZFIELD2(2) = TFIELDMETADATA( &
- CMNHNAME = 'LSVM_ZM', &
- CSTDNAME = '', &
- CLONGNAME = 'LSVM_ZM', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'Large Scale Meridian component of horizontal wind', &
- NGRID = 3, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- !
- CALL UV_TO_ZONAL_AND_MERID(XLSUM,XLSVM,23,TPFILE=TPFILE,TZFIELDS=TZFIELD2)
- ENDIF
- !
- CALL IO_Field_write(TPFILE,'LSWM', XLSWM)
- CALL IO_Field_write(TPFILE,'LSTHM',XLSTHM)
-!
- IF (LUSERV) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('LSRVM',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CUNITS = 'g kg-1'
- CALL IO_Field_write(TPFILE,TZFIELD,XLSRVM(:,:,:)*1.E3)
- END IF
-END IF
-!
-!* Forcing variables
-!
-IF (LVAR_FRC .AND. LFORCING) THEN
-!
- DO JT=1,NFRC
- WRITE (YFRC,'(I3.3)') JT
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'UFRC'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'UFRC'//YFRC, &
- CUNITS = 'm s-1', &
- CDIR = '--', &
- CCOMMENT = 'Zonal component of horizontal forcing wind', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 1, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_write(TPFILE,TZFIELD,XUFRC(:,JT))
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'VFRC'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'VFRC'//YFRC, &
- CUNITS = 'm s-1', &
- CDIR = '--', &
- CCOMMENT = 'Meridian component of horizontal forcing wind', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 1, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_write(TPFILE,TZFIELD,XVFRC(:,JT))
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'WFRC'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'WFRC'//YFRC, &
- CUNITS = 'm s-1', &
- CDIR = '--', &
- CCOMMENT = 'Vertical forcing wind', &
- NGRID = 4, &
- NTYPE = TYPEREAL, &
- NDIMS = 1, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_write(TPFILE,TZFIELD,XWFRC(:,JT))
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'THFRC'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'THFRC'//YFRC, &
- CUNITS = 'K', &
- CDIR = '--', &
- CCOMMENT = 'Forcing potential temperature', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 1, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_write(TPFILE,TZFIELD,XTHFRC(:,JT))
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'RVFRC'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'RVFRC'//YFRC, &
- CUNITS = 'kg kg-1', &
- CDIR = '--', &
- CCOMMENT = 'Forcing vapor mixing ratio', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 1, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_write(TPFILE,TZFIELD,XRVFRC(:,JT))
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'TENDTHFRC'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'TENDTHFRC'//YFRC, &
- CUNITS = 'K s-1', &
- CDIR = '--', &
- CCOMMENT = 'Large-scale potential temperature tendency for forcing', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 1, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_write(TPFILE,TZFIELD,XTENDTHFRC(:,JT))
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'TENDRVFRC'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'TENDRVFRC'//YFRC, &
- CUNITS = 'kg kg-1 s-1', &
- CDIR = '--', &
- CCOMMENT = 'Large-scale vapor mixing ratio tendency for forcing', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 1, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_write(TPFILE,TZFIELD,XTENDRVFRC(:,JT))
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'GXTHFRC'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'GXTHFRC'//YFRC, &
- CUNITS = 'K m-1', &
- CDIR = '--', &
- CCOMMENT = 'Large-scale potential temperature gradient for forcing', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 1, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_write(TPFILE,TZFIELD,XGXTHFRC(:,JT))
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'GYTHFRC'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'GYTHFRC'//YFRC, &
- CUNITS = 'K m-1', &
- CDIR = '--', &
- CCOMMENT = 'Large-scale potential temperature gradient for forcing', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 1, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_write(TPFILE,TZFIELD,XGYTHFRC(:,JT))
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'PGROUNDFRC'//YFRC, &
- CSTDNAME = '', &
- CLONGNAME = 'PGROUNDFRC'//YFRC, &
- CUNITS = 'Pa', &
- CDIR = '--', &
- CCOMMENT = 'Forcing ground pressure', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 0, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_write(TPFILE,TZFIELD,XPGROUNDFRC(JT))
-!
- END DO
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 1.7 Some diagnostic variables
-!
-IF (LTPZH .OR. LCOREF) THEN
-!
-!* Temperature in celsius
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'TEMP', &
- CSTDNAME = 'air_temperature', &
- CLONGNAME = 'TEMP', &
- CUNITS = 'celsius', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_TEMPerature', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- ZWORK31(:,:,:)=ZTEMP(:,:,:) - XTT
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
-!
-!* Pressure in hPa
- CALL FIND_FIELD_ID_FROM_MNHNAME('PABST',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CMNHNAME = 'PRES'
- TZFIELD%CUNITS = 'hPa'
- CALL IO_Field_write(TPFILE,TZFIELD,XPABST(:,:,:)*1E-2)
-!
-!* Geopotential in meters
- CALL IO_Field_write(TPFILE,'ALT',XZZ)
-!
-!* Relative humidity in percent
- IF (LUSERV) THEN
- ZWORK31(:,:,:)=SM_FOES(ZTEMP(:,:,:))
- ZWORK33(:,:,:)=ZWORK31(:,:,:)
- ZWORK31(:,:,:)=(XMV/XMD)*ZWORK31(:,:,:)/(XPABST(:,:,:)-ZWORK31(:,:,:))
- ZWORK32(:,:,:)=100.*XRT(:,:,:,1)/ZWORK31(:,:,:)
- IF (CCLOUD(1:3) =='ICE' .OR. CCLOUD =='C3R5' .OR. CCLOUD == 'LIMA') THEN
- WHERE ( ZTEMP(:,:,:)< XTT)
- ZWORK31(:,:,:) = EXP( XALPI - XBETAI/ZTEMP(:,:,:) &
- - XGAMI*ALOG(ZTEMP(:,:,:)) ) !saturation over ice
- ZWORK33(:,:,:)=ZWORK31(:,:,:)
- ZWORK31(:,:,:)=(XMV/XMD)*ZWORK31(:,:,:)/(XPABST(:,:,:)-ZWORK31(:,:,:))
- ZWORK32(:,:,:)=100.*XRT(:,:,:,1)/ZWORK31(:,:,:)
- END WHERE
- END IF
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'REHU', &
- CSTDNAME = 'relative_humidity', &
- CLONGNAME = 'REHU', &
- CUNITS = 'percent', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_RElative HUmidity', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'VPRES', &
- CSTDNAME = 'water_vapor_partial_pressure_in_air', &
- CLONGNAME = 'VPRES', &
- CUNITS = 'hPa', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Vapor PRESsure', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- ZWORK33(:,:,:)=ZWORK33(:,:,:)*ZWORK32(:,:,:)*1E-4
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33)
- !
- IF (LCOREF) THEN
- ZWORK33(:,:,:)=(77.6*( XPABST(:,:,:)*1E-2 &
- +ZWORK33(:,:,:)*4810/ZTEMP(:,:,:)) &
- -6*ZWORK33(:,:,:) )/ZTEMP(:,:,:)
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'COREF', &
- CSTDNAME = '', &
- CLONGNAME = 'COREF', &
- CUNITS = '1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_REFraction COindex (N-units)', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33)
- !
- ZWORK33(:,:,:)=ZWORK33(:,:,:)+MZF(XZZ(:,:,:))*1E6/XRADIUS
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'MCOREF', &
- CSTDNAME = '', &
- CLONGNAME = 'MCOREF', &
- CUNITS = '1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Modified REFraction COindex (M-units)', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33)
- END IF
- ELSE
- PRINT*, 'NO WATER VAPOR IN ',TPFILE%CNAME,' RELATIVE HUMIDITY IS NOT COMPUTED'
- END IF
-!
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* Virtual potential temperature
-!
-IF ( LMOIST_V .OR. LMSLP .OR. CBLTOP/='NONE' ) THEN
- ALLOCATE(ZTHETAV(IIU,IJU,IKU))
-!
- IF(NRR > 0) THEN
-! compute the ratio : 1 + total water mass / dry air mass
- ZRV_OV_RD = XRV / XRD
- ZTHETAV(:,:,:) = 1. + XRT(:,:,:,1)
- DO JLOOP = 2,1+NRRL+NRRI
- ZTHETAV(:,:,:) = ZTHETAV(:,:,:) + XRT(:,:,:,JLOOP)
- END DO
-! compute the virtual potential temperature when water is present in any form
- ZTHETAV(:,:,:) = XTHT(:,:,:) * (1.+XRT(:,:,:,1)*ZRV_OV_RD) / ZTHETAV(:,:,:)
- ELSE
-! compute the virtual potential temperature when water is absent
- ZTHETAV(:,:,:) = XTHT(:,:,:)
- END IF
-!
- IF (LMOIST_V .AND. NRR > 0) THEN
-! Virtual potential temperature
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'THETAV', &
- CSTDNAME = '', &
- CLONGNAME = 'THETAV', &
- CUNITS = 'K', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Virtual potential temperature', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZTHETAV)
- END IF
-!
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* Fog Visibility
-!
-IF (LVISI) THEN
-!
- IF ((CCLOUD /= 'NONE') .AND. (CCLOUD /='REVE')) ALLOCATE(ZVISIKUN(IIU,IJU,IKU))
- IF ((CCLOUD == 'C2R2') .OR. (CCLOUD =='KHKO')) THEN
- ALLOCATE(ZVISIGUL(IIU,IJU,IKU))
- ALLOCATE(ZVISIZHA(IIU,IJU,IKU))
- END IF
-!
- IF ((CCLOUD /= 'NONE') .AND. (CCLOUD /='REVE')) THEN
- ZVISIKUN(:,:,:) = 10000.
- WHERE ( XRT(:,:,:,2) >= 1E-08 )
- ZVISIKUN(:,:,:) =0.027/(XRT(:,:,:,2)*XRHODREF(:,:,:))**0.88*1000.
- END WHERE
-! Visibity Kunkel
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'VISIKUN', &
- CSTDNAME = '', &
- CLONGNAME = 'VISIKUN', &
- CUNITS = 'm', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Visibility Kunkel', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZVISIKUN)
-!
- IF ((CCLOUD == 'C2R2') .OR. (CCLOUD =='KHKO')) THEN
- ZVISIGUL(:,:,:) = 10000.
- ZVISIZHA(:,:,:) = 10000.
- WHERE ( (XRT(:,:,:,2) >= 1E-08 ) .AND. (XSVT(:,:,:,NSV_C2R2BEG+1) >=0.001 ) )
- ZVISIGUL(:,:,:) =1.002/(XRT(:,:,:,2)*XRHODREF(:,:,:)*XSVT(:,:,:,NSV_C2R2BEG+1))**0.6473*1000.
- ZVISIZHA(:,:,:) =0.187/(XRT(:,:,:,2)*XRHODREF(:,:,:)*XSVT(:,:,:,NSV_C2R2BEG+1))**0.34*1000.
- END WHERE
-! Visibity Gultepe
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'VISIGUL', &
- CSTDNAME = '', &
- CLONGNAME = 'VISIGUL', &
- CUNITS = 'm', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Visibility Gultepe', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZVISIGUL)
-! Visibity Zhang
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'VISIZHA', &
- CSTDNAME = '', &
- CLONGNAME = 'VISIZHA', &
- CUNITS = 'm', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Visibility Zhang', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZVISIZHA)
-!
- DEALLOCATE(ZVISIGUL,ZVISIZHA)
- END IF
- DEALLOCATE(ZVISIKUN)
- END IF
-!
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* Thetae computation according eq.(21), (43) of Bolton 1980 (MWR108,p 1046-1053)
-!
-IF (( LMOIST_E .OR. LBV_FR ) .AND. (NRR>0)) THEN
- ALLOCATE(ZTHETAE(IIU,IJU,IKU))
- !
- ZWORK31(:,:,:) = MAX(XRT(:,:,:,1),1.E-10)
- ZTHETAE(:,:,:)= ( 2840./ &
- (3.5*ALOG(XTHT(:,:,:)*( XPABST(:,:,:)/XP00 )**(XRD/XCPD) ) &
- - ALOG( XPABST(:,:,:)*0.01*ZWORK31(:,:,:) / ( 0.622+ZWORK31(:,:,:) ) ) &
- -4.805 ) ) + 55.
- ZTHETAE(:,:,:)= XTHT(:,:,:) * EXP( (3376. / ZTHETAE(:,:,:) - 2.54) &
- *ZWORK31(:,:,:) *(1. +0.81 *ZWORK31(:,:,:)) )
-!
- IF (LMOIST_E) THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'THETAE', &
- CSTDNAME = '', &
- CLONGNAME = 'THETAE', &
- CUNITS = 'K', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Equivalent potential temperature', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZTHETAE)
- END IF
-END IF
-!-------------------------------------------------------------------------------
-!
-!* Thetaes computation
-!
-IF (LMOIST_ES .AND. (NRR>0)) THEN
- ALLOCATE(ZTHETAES(IIU,IJU,IKU))
- ZWORK31(:,:,:) = MAX(QSAT(ZTEMP(:,:,:),XPABST(:,:,:)),1.E-10)
- ZTHETAES(:,:,:)= ( 2840./ &
- (3.5*ALOG(XTHT(:,:,:)*( XPABST(:,:,:)/XP00 )**(XRD/XCPD) ) &
- - ALOG( XPABST(:,:,:)*0.01*ZWORK31(:,:,:) / ( 0.622+ZWORK31(:,:,:) ) ) &
- -4.805 ) ) + 55.
- ZTHETAES(:,:,:)= XTHT(:,:,:) * EXP( (3376. / ZTHETAE(:,:,:) - 2.54) &
- *ZWORK31(:,:,:) *(1. +0.81 *ZWORK31(:,:,:)) )
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'THETAES', &
- CSTDNAME = '', &
- CLONGNAME = 'THETAES', &
- CUNITS = 'K', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Equivalent Saturated potential temperature', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZTHETAES)
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!* The Liquid-Water potential temperature (Betts, 1973)
-! (also needed for THETAS1 or THETAS2)
-!
-IF ( LMOIST_L .OR. LMOIST_S1 .OR. LMOIST_S2 ) THEN
-!
- ALLOCATE(ZTHETAL(IIU,IJU,IKU))
-!
- IF(NRR > 1) THEN
-! The latent heat of Vaporization:
- ZWORK31(:,:,:) = XLVTT + (XCPV-XCL)*(ZTEMP(:,:,:)-XTT)
-! The latent heat of Sublimation:
- ZWORK32(:,:,:) = XLSTT + (XCPV-XCI)*(ZTEMP(:,:,:)-XTT)
-! The numerator in the exponential
-! and the total water mixing ratio:
- ZTHETAL(:,:,:) = 0.0
- ZWORK33(:,:,:) = XRT(:,:,:,1)
- DO JLOOP = 2,1+NRRL
- ZTHETAL(:,:,:) = ZTHETAL(:,:,:) + XRT(:,:,:,JLOOP)*ZWORK31(:,:,:)
- ZWORK33(:,:,:) = ZWORK33(:,:,:) + XRT(:,:,:,JLOOP)
- END DO
- DO JLOOP = 1+NRRL+1,1+NRRL+NRRI
- ZTHETAL(:,:,:) = ZTHETAL(:,:,:) + XRT(:,:,:,JLOOP)*ZWORK32(:,:,:)
- ZWORK33(:,:,:) = ZWORK33(:,:,:) + XRT(:,:,:,JLOOP)
- END DO
-! compute the liquid-water potential temperature
-! theta_l = theta * exp[ -(L_vap * ql + L_sub * qi) / (c_pd * T) ]
-! when water is present in any form:
- ZTHETAL(:,:,:) = XTHT(:,:,:) &
- * exp(-ZTHETAL(:,:,:)/(1.0+ZWORK33(:,:,:))/XCPD/ZTEMP(:,:,:))
- ELSE
-! compute the liquid-water potential temperature
-! when water is absent:
- ZTHETAL(:,:,:) = XTHT(:,:,:)
- END IF
-!
- IF (LMOIST_L .AND. NRR > 0) THEN
- ! Liquid-Water potential temperature
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'THETAL', &
- CSTDNAME = '', &
- CLONGNAME = 'THETAL', &
- CUNITS = 'K', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Liquid water potential temperature', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZTHETAL)
- END IF
-!
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* The Moist-air Entropy potential temperature (Marquet, QJ2011, HDR2016)
-!
-IF ( LMOIST_S1 .OR. LMOIST_S2 ) THEN
- IF (LMOIST_S1) THEN
- ALLOCATE(ZTHETAS1(IIU,IJU,IKU))
- END IF
- IF (LMOIST_S2) THEN
- ALLOCATE(ZTHETAS2(IIU,IJU,IKU))
- END IF
-!
-! The total water (ZWORK31) and condensed water (ZWORK32) mixing ratios:
- ZWORK32(:,:,:) = 0.0
- IF(NRR > 0) THEN
- DO JLOOP = 2,1+NRRL+NRRI
- ZWORK32(:,:,:) = ZWORK32(:,:,:) + XRT(:,:,:,JLOOP)
- END DO
- END IF
- ZWORK31(:,:,:) = ZWORK32(:,:,:) + XRT(:,:,:,1)
-!
- IF (LMOIST_S1) THEN
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-! thetas1 = thetal * exp[ 5.87 * qt ] ; with qt=rt/(1+rt)
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- ZTHETAS1(:,:,:) = ZTHETAL(:,:,:) * &
- exp( 5.87*ZWORK31(:,:,:)/(1.0+ZWORK31(:,:,:)) )
- END IF
- IF (LMOIST_S2) THEN
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-! thetas2 = thetal * exp[ (5.87-0.46*ln(rv/0.0124)-0.46*qc) * qt ]
-! where qt=rt/(1+rt) and qc=rc/(1+rt)
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- ZWORK33(:,:,:) = 5.87 - 0.46 * log(MAX(XRT(:,:,:,1),1.E-10)/0.0124)
- ZTHETAS2(:,:,:) = ZTHETAL(:,:,:) * &
- exp( ZWORK33(:,:,:)*ZWORK31(:,:,:)/(1.0+ZWORK31(:,:,:)) &
- - 0.46*ZWORK32(:,:,:)/(1.0+ZWORK31(:,:,:)) )
- END IF
- IF (LMOIST_S1) THEN
-! The Moist-air Entropy potential temperature (1st order)
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'THETAS1', &
- CSTDNAME = '', &
- CLONGNAME = 'THETAS1', &
- CUNITS = 'K', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Moist air Entropy (1st order) potential temperature', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZTHETAS1)
- END IF
- IF (LMOIST_S2) THEN
-! The Moist-air Entropy potential temperature (2nd order)
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'THETAS2', &
- CSTDNAME = '', &
- CLONGNAME = 'THETAS2', &
- CUNITS = 'K', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Moist air Entropy (2nd order) potential temperature', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZTHETAS2)
- END IF
-!
-END IF
-!
-!-------------------------------------------------------------------------------
-!!
-!
-!* Vorticity quantities
-!
-IF (LVORT) THEN
-! Vorticity x
- ZWORK31(:,:,:)=MYF(MZF(MXM(ZVOX(:,:,:))))
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'UM1', &
- CSTDNAME = '', &
- CLONGNAME = 'UM1', &
- CUNITS = 's-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_x component of vorticity', &
- NGRID = 2, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
-!
-! Vorticity y
- ZWORK32(:,:,:)=MZF(MXF(MYM(ZVOY(:,:,:))))
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'VM1', &
- CSTDNAME = '', &
- CLONGNAME = 'VM1', &
- CUNITS = 's-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_y component of vorticity', &
- NGRID = 3, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32)
- !
- IF (LWIND_ZM) THEN
- TZFIELD2(1) = TFIELDMETADATA( &
- CMNHNAME = 'UM1_ZM', &
- CSTDNAME = '', &
- CLONGNAME = 'UM1_ZM', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'Zonal component of horizontal vorticity', &
- NGRID = 2, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- !
- TZFIELD2(2) = TFIELDMETADATA( &
- CMNHNAME = 'VM1_ZM', &
- CSTDNAME = '', &
- CLONGNAME = 'VM1_ZM', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'Meridian component of horizontal vorticity', &
- NGRID = 3, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- !
- CALL UV_TO_ZONAL_AND_MERID(ZWORK31,ZWORK32,23,TPFILE=TPFILE,TZFIELDS=TZFIELD2)
- ENDIF
-!
-! Vorticity z
- ZWORK31(:,:,:)=MXF(MYF(MZM(ZVOZ(:,:,:))))
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'WM1', &
- CSTDNAME = '', &
- CLONGNAME = 'WM1', &
- CUNITS = 's-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_relative vorticity', &
- NGRID = 4, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
-!
-! Absolute Vorticity
- ZWORK31(:,:,:)=MYF(MXF(ZVOZ(:,:,:))) + ZCORIOZ(:,:,:)
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'ABVOR', &
- CSTDNAME = '', &
- CLONGNAME = 'ABVOR', &
- CUNITS = 's-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_z ABsolute VORticity', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
-!
-END IF
-!
-IF ( LMEAN_POVO ) THEN
- !
- ALLOCATE(IWORK1(SIZE(XTHT,1),SIZE(XTHT,2)))
- !
- IWORK1(:,:)=0
- ZWORK21(:,:)=0.
- IF (XMEAN_POVO(1)>XMEAN_POVO(2)) THEN
- !Invert values (smallest must be first)
- ZX0D = XMEAN_POVO(1)
- XMEAN_POVO(1) = XMEAN_POVO(2)
- XMEAN_POVO(2) = ZX0D
- END IF
- DO JK=IKB,IKE
- WHERE((XPABST(:,:,JK)>XMEAN_POVO(1)).AND.(XPABST(:,:,JK)<XMEAN_POVO(2)))
- ZWORK21(:,:)=ZWORK21(:,:)+ZPOVO(:,:,JK)
- IWORK1(:,:)=IWORK1(:,:)+1
- END WHERE
- END DO
- WHERE (IWORK1(:,:)>0) ZWORK21(:,:)=ZWORK21(:,:)/REAL( IWORK1(:,:) )
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'MEAN_POVO', &
- CSTDNAME = '', &
- CLONGNAME = 'MEAN_POVO', &
- CUNITS = 'PVU', & ! 1 PVU = 1e-6 m^2 s^-1 K kg^-1
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_MEAN of POtential VOrticity', &
- NGRID = 4, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
-END IF
-!
-! Virtual Potential Vorticity in PV units
-IF (LMOIST_V .AND. (NRR>0) ) THEN
- ZWORK31(:,:,:)=GX_M_M(ZTHETAV,XDXX,XDZZ,XDZX)
- ZWORK32(:,:,:)=GY_M_M(ZTHETAV,XDYY,XDZZ,XDZY)
- ZWORK33(:,:,:)=GZ_M_M(ZTHETAV,XDZZ)
- ZWORK34(:,:,:)= ZWORK31(:,:,:)*MZF(MYF(ZVOX(:,:,:))) &
- + ZWORK32(:,:,:)*MZF(MXF(ZVOY(:,:,:))) &
- + ZWORK33(:,:,:)*(MYF(MXF(ZVOZ(:,:,:))) + ZCORIOZ(:,:,:))
- ZWORK34(:,:,:)=ZWORK34(:,:,:)*1E6/XRHODREF(:,:,:)
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'POVOV', &
- CSTDNAME = '', &
- CLONGNAME = 'POVOV', &
- CUNITS = 'PVU', & ! 1 PVU = 1e-6 m^2 s^-1 K kg^-1
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Virtual POtential VOrticity', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK34)
-!
- IF (LMEAN_POVO) THEN
- IWORK1(:,:)=0
- ZWORK21(:,:)=0.
- DO JK=IKB,IKE
- WHERE((XPABST(:,:,JK)>XMEAN_POVO(1)).AND.(XPABST(:,:,JK)<XMEAN_POVO(2)))
- ZWORK21(:,:)=ZWORK21(:,:)+ZWORK34(:,:,JK)
- IWORK1(:,:)=IWORK1(:,:)+1
- END WHERE
- END DO
- WHERE(IWORK1(:,:)>0) ZWORK21(:,:)=ZWORK21(:,:)/REAL( IWORK1(:,:) )
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'MEAN_POVOV', &
- CSTDNAME = '', &
- CLONGNAME = 'MEAN_POVOV', &
- CUNITS = 'PVU', & ! 1 PVU = 1e-6 m^2 s^-1 K kg^-1
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_MEAN of Virtual POtential VOrticity', &
- NGRID = 4, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
- END IF
-END IF
-!
-! Equivalent Potential Vorticity in PV units
-IF (LMOIST_E .AND. (NRR>0) ) THEN
-!
- ZWORK31(:,:,:)=GX_M_M(ZTHETAE,XDXX,XDZZ,XDZX)
- ZWORK32(:,:,:)=GY_M_M(ZTHETAE,XDYY,XDZZ,XDZY)
- ZWORK33(:,:,:)=GZ_M_M(ZTHETAE,XDZZ)
- ZWORK34(:,:,:)= ZWORK31(:,:,:)*MZF(MYF(ZVOX(:,:,:))) &
- + ZWORK32(:,:,:)*MZF(MXF(ZVOY(:,:,:))) &
- + ZWORK33(:,:,:)*(MYF(MXF(ZVOZ(:,:,:))) + ZCORIOZ(:,:,:))
- ZWORK34(:,:,:)=ZWORK34(:,:,:)*1E6/XRHODREF(:,:,:)
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'POVOE', &
- CSTDNAME = '', &
- CLONGNAME = 'POVOE', &
- CUNITS = 'PVU', & ! 1 PVU = 1e-6 m^2 s^-1 K kg^-1
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Equivalent POtential VOrticity', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK34)
-!
- IF (LMEAN_POVO) THEN
- IWORK1(:,:)=0
- ZWORK21(:,:)=0.
- DO JK=IKB,IKE
- WHERE((XPABST(:,:,JK)>XMEAN_POVO(1)).AND.(XPABST(:,:,JK)<XMEAN_POVO(2)))
- ZWORK21(:,:)=ZWORK21(:,:)+ZWORK34(:,:,JK)
- IWORK1(:,:)=IWORK1(:,:)+1
- END WHERE
- END DO
- WHERE(IWORK1(:,:)>0) ZWORK21(:,:)=ZWORK21(:,:)/REAL( IWORK1(:,:) )
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'MEAN_POVOE', &
- CSTDNAME = '', &
- CLONGNAME = 'MEAN_POVOE', &
- CUNITS = 'PVU', & ! 1 PVU = 1e-6 m^2 s^-1 K kg^-1
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_MEAN of Equivalent POtential VOrticity', &
- NGRID = 4, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
- DEALLOCATE(IWORK1)
- END IF
- !
-END IF
-!
-! Equivalent Saturated Potential Vorticity in PV units
-IF (LMOIST_ES .AND. (NRR>0) ) THEN
- ZWORK31(:,:,:)=GX_M_M(ZTHETAES,XDXX,XDZZ,XDZX)
- ZWORK32(:,:,:)=GY_M_M(ZTHETAES,XDYY,XDZZ,XDZY)
- ZWORK33(:,:,:)=GZ_M_M(ZTHETAES,XDZZ)
- ZWORK34(:,:,:)= ZWORK31(:,:,:)*MZF(MYF(ZVOX(:,:,:))) &
- + ZWORK32(:,:,:)*MZF(MXF(ZVOY(:,:,:))) &
- + ZWORK33(:,:,:)*(MYF(MXF(ZVOZ(:,:,:))) + ZCORIOZ(:,:,:))
- ZWORK34(:,:,:)=ZWORK34(:,:,:)*1E6/XRHODREF(:,:,:)
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'POVOES', &
- CSTDNAME = '', &
- CLONGNAME = 'POVOES', &
- CUNITS = 'PVU', & ! 1 PVU = 1e-6 m^2 s^-1 K kg^-1
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Equivalent Saturated POtential VOrticity', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK34)
-ENDIF
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* Horizontal divergence
-!
-IF (LDIV) THEN
-!
- ZWORK31=GX_U_M(XUT,XDXX,XDZZ,XDZX) + GY_V_M(XVT,XDYY,XDZZ,XDZY)
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'HDIV', &
- CSTDNAME = '', &
- CLONGNAME = 'HDIV', &
- CUNITS = 's-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Horizontal DIVergence', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
-!
- IF (LUSERV) THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'HMDIV', &
- CSTDNAME = '', &
- CLONGNAME = 'HMDIV', &
- CUNITS = 'kg m-3 s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Horizontal Moisture DIVergence HMDIV', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- ZWORK31=MXM(XRHODREF*XRT(:,:,:,1))*XUT
- ZWORK32=MYM(XRHODREF*XRT(:,:,:,1))*XVT
- ZWORK33=GX_U_M(ZWORK31,XDXX,XDZZ,XDZX) + GY_V_M(ZWORK32,XDYY,XDZZ,XDZY)
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33)
- END IF
-!
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* Clustering
-!
-IF (LCLSTR) THEN
- GCLOUD(:,:,:)=.FALSE.
- GBOTUP=LBOTUP
- IF (CFIELD=='W') THEN
- WHERE(XWT(:,:,:).GT.XTHRES) GCLOUD(:,:,:)=.TRUE.
- END IF
- IF (CFIELD=='CLOUD') THEN
- WHERE((XRT(:,:,:,2)+XRT(:,:,:,4)+XRT(:,:,:,5)+XRT(:,:,:,6)).GT.XTHRES) GCLOUD(:,:,:)=.TRUE.
- END IF
- PRINT *,'CALL CLUSTERING COUNT(GCLOUD)=',COUNT(GCLOUD)
- CALL CLUSTERING(GBOTUP,GCLOUD,XWT,ICLUSTERID,ICLUSTERLV,ZCLDSIZE)
- PRINT *,'GOT OUT OF CLUSTERING'
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'CLUSTERID', &
- CSTDNAME = '', &
- CLONGNAME = 'CLUSTERID', &
- CUNITS = '', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_CLUSTER (ID NUMBER)', &
- NGRID = 1, &
- NTYPE = TYPEINT, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ICLUSTERID)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'CLUSTERLV', &
- CSTDNAME = '', &
- CLONGNAME = 'CLUSTERLV', &
- CUNITS = '', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_CLUSTER (BASE OR TOP LEVEL)', &
- NGRID = 1, &
- NTYPE = TYPEINT, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ICLUSTERLV)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'CLDSIZE', &
- CSTDNAME = '', &
- CLONGNAME = 'CLDSIZE', &
- CUNITS = '', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_CLDSIZE (HOR. SECTION)', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZCLDSIZE)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* Geostrophic and Ageostrophic wind (m/s)
-!
-IF (LGEO .OR. LAGEO) THEN
- ALLOCATE(ZPHI(IIU,IJU,IKU))
- IF(CEQNSYS=='MAE' .OR. CEQNSYS=='DUR') THEN
- ZPHI(:,:,:)=(XPABST(:,:,:)/XP00)**(XRD/XCPD)-XEXNREF(:,:,:)
- !
- ZPHI(1,1,:)=2*ZPHI(1,2,:)-ZPHI(1,3,:)
- ZPHI(1,IJU,:)=2*ZPHI(1,IJU-1,:)-ZPHI(1,IJU-2,:)
- ZPHI(IIU,1,:)=2*ZPHI(IIU,2,:)-ZPHI(IIU,3,:)
- ZPHI(IIU,IJU,:)=2*ZPHI(IIU,IJU-1,:)-ZPHI(IIU,IJU-2,:)
- ZWORK31(:,:,:)=-MXM(GY_M_M(ZPHI,XDYY,XDZZ,XDZY)*XCPD*XTHVREF/ZCORIOZ)
- !
- ZPHI(1,1,:)=2*ZPHI(2,1,:)-ZPHI(3,1,:)
- ZPHI(IIU,1,:)=2*ZPHI(IIU-1,1,:)-ZPHI(IIU-2,1,:)
- ZPHI(1,IJU,:)=2*ZPHI(2,IJU,:)-ZPHI(3,IJU,:)
- ZPHI(IIU,IJU,:)=2*ZPHI(IIU-1,IJU,:)-ZPHI(IIU-2,IJU,:)
- ZWORK32(:,:,:)=MYM(GX_M_M(ZPHI,XDXX,XDZZ,XDZX)*XCPD*XTHVREF/ZCORIOZ)
- !
- ELSE IF(CEQNSYS=='LHE') THEN
- ZPHI(:,:,:)= ((XPABST(:,:,:)/XP00)**(XRD/XCPD)-XEXNREF(:,:,:)) &
- * XCPD * XTHVREF(:,:,:)
- !
- ZPHI(1,1,:)=2*ZPHI(1,2,:)-ZPHI(1,3,:)
- ZPHI(1,IJU,:)=2*ZPHI(1,IJU-1,:)-ZPHI(1,IJU-2,:)
- ZPHI(IIU,1,:)=2*ZPHI(IIU,2,:)-ZPHI(IIU,3,:)
- ZPHI(IIU,IJU,:)=2*ZPHI(IIU,IJU-1,:)-ZPHI(IIU,IJU-2,:)
- ZWORK31(:,:,:)=-MXM(GY_M_M(ZPHI,XDYY,XDZZ,XDZY)/ZCORIOZ)
- !
- ZPHI(1,1,:)=2*ZPHI(2,1,:)-ZPHI(3,1,:)
- ZPHI(IIU,1,:)=2*ZPHI(IIU-1,1,:)-ZPHI(IIU-2,1,:)
- ZPHI(1,IJU,:)=2*ZPHI(2,IJU,:)-ZPHI(3,IJU,:)
- ZPHI(IIU,IJU,:)=2*ZPHI(IIU-1,IJU,:)-ZPHI(IIU-2,IJU,:)
- ZWORK32(:,:,:)=MYM(GX_M_M(ZPHI,XDXX,XDZZ,XDZX)/ZCORIOZ)
- END IF
- DEALLOCATE(ZPHI)
-!
- IF (LGEO) THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'UM88', &
- CSTDNAME = '', &
- CLONGNAME = 'UM88', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_U component of GEOstrophic wind', &
- NGRID = 2, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'VM88', &
- CSTDNAME = '', &
- CLONGNAME = 'VM88', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_V component of GEOstrophic wind', &
- NGRID = 3, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32)
- !
- IF (LWIND_ZM) THEN
- TZFIELD2(1) = TFIELDMETADATA( &
- CMNHNAME = 'UM88_ZM', &
- CSTDNAME = '', &
- CLONGNAME = 'UM88_ZM', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'Zonal component of GEOstrophic wind', &
- NGRID = 2, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- !
- TZFIELD2(2) = TFIELDMETADATA( &
- CMNHNAME = 'VM88_ZM', &
- CSTDNAME = '', &
- CLONGNAME = 'VM88_ZM', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'Meridian component of GEOstrophic wind', &
- NGRID = 3, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- !
- CALL UV_TO_ZONAL_AND_MERID(ZWORK31,ZWORK32,23,TPFILE=TPFILE,TZFIELDS=TZFIELD2)
- ENDIF
-!
-! wm necessary to plot vertical cross sections of wind vectors
- CALL FIND_FIELD_ID_FROM_MNHNAME('WT',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CMNHNAME = 'WM88'
- TZFIELD%CLONGNAME = 'WM88'
- CALL IO_Field_write(TPFILE,TZFIELD,XWT)
- END IF
-!
- IF (LAGEO) THEN
- ZWORK31(:,:,:)=XUT(:,:,:)-ZWORK31(:,:,:)
- ZWORK32(:,:,:)=XVT(:,:,:)-ZWORK32(:,:,:)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'UM89', &
- CSTDNAME = '', &
- CLONGNAME = 'UM89', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_U component of AGEOstrophic wind', &
- NGRID = 2, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'VM89', &
- CSTDNAME = '', &
- CLONGNAME = 'VM89', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_V component of AGEOstrophic wind', &
- NGRID = 3, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32)
- !
- IF (LWIND_ZM) THEN
- TZFIELD2(1) = TFIELDMETADATA( &
- CMNHNAME = 'UM89_ZM', &
- CSTDNAME = '', &
- CLONGNAME = 'UM89_ZM', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'Zonal component of AGEOstrophic wind', &
- NGRID = 2, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- !
- TZFIELD2(2) = TFIELDMETADATA( &
- CMNHNAME = 'VM89_ZM', &
- CSTDNAME = '', &
- CLONGNAME = 'VM89_ZM', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'Meridian component of AGEOstrophic wind', &
- NGRID = 3, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- !
- CALL UV_TO_ZONAL_AND_MERID(ZWORK31,ZWORK32,23,TPFILE=TPFILE,TZFIELDS=TZFIELD2)
- ENDIF
-!
-! wm necessary to plot vertical cross sections of wind vectors
- CALL FIND_FIELD_ID_FROM_MNHNAME('WT',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%CMNHNAME = 'WM89'
- TZFIELD%CLONGNAME = 'WM89'
- CALL IO_Field_write(TPFILE,TZFIELD,XWT)
- END IF
-!
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* Contravariant wind field
-!
-!
-IF(LWIND_CONTRAV) THEN!$
- CALL CONTRAV ((/"TEST","TEST"/),(/"TEST","TEST"/),XUT,XVT,XWT,XDXX,XDYY,XDZZ,XDZX,XDZY, &
- ZWORK31,ZWORK32,ZWORK33,2)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'WNORM', &
- CSTDNAME = '', &
- CLONGNAME = 'WNORM', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_W surface normal wind', &
- NGRID = 4, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33)
-END IF
-!-------------------------------------------------------------------------------
-!
-!* Mean Sea Level Pressure in hPa
-!
-IF (LMSLP) THEN
- ZGAMREF=-6.5E-3
-! Exner function at the first mass point
- ZWORK21(:,:) = (XPABST(:,:,IKB) /XP00)**(XRD/XCPD)
-! virtual temperature at the first mass point
- ZWORK21(:,:) = ZWORK21(:,:) * ZTHETAV(:,:,IKB)
-! virtual temperature at ground level
- ZWORK21(:,:) = ZWORK21(:,:) - ZGAMREF*((XZZ(:,:,IKB)+XZZ(:,:,IKB+1))/2.-XZS(:,:))
-! virtual temperature at sea level
- ZWORK22(:,:) = ZWORK21(:,:) - ZGAMREF*XZS(:,:)
-! average underground virtual temperature
- ZWORK22(:,:) = 0.5*(ZWORK21(:,:)+ZWORK22(:,:))
-! surface pressure
- ZWORK21(:,:) = ( XPABST(:,:,IKB) + XPABST(:,:,IKB-1) )*.5
-! sea level pressure (hPa)
- ZWORK22(:,:) = 1.E-2*ZWORK21(:,:)*EXP(XG*XZS(:,:)/(XRD*ZWORK22(:,:)))
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'MSLP', &
- CSTDNAME = 'air_pressure_at_sea_level', &
- CLONGNAME = 'MSLP', &
- CUNITS = 'hPa', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Mean Sea Level Pressure', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22)
-END IF
-!-------------------------------------------------------------------------------
-!
-!* Vapor, cloud water and ice thickness
-!
-IF (LTHW) THEN
-!
- ZWORK21(:,:) = 0.
- IF(SIZE(XRT,4)>=1)THEN
- DO JK = IKB,IKE
- ZWORK21(:,:) = ZWORK21(:,:)+XRHODREF(:,:,JK)*XRT(:,:,JK,1) * &
- (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW
- END DO
- ZWORK21(:,:) = ZWORK21(:,:)*1000. ! vapor water in mm unit
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'THVW', &
- CSTDNAME = '', &
- CLONGNAME = 'THVW', &
- CUNITS = 'mm', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_THickness of Vapor Water', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
- END IF
- !
- ZWORK21(:,:) = 0.
- IF(SIZE(XRT,4)>=2)THEN
- DO JK = IKB,IKE
- ZWORK21(:,:) = ZWORK21(:,:)+XRHODREF(:,:,JK)*XRT(:,:,JK,2) * &
- (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW
- END DO
- ZWORK21(:,:) = ZWORK21(:,:)*1000. ! cloud water in mm unit
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'THCW', &
- CSTDNAME = '', &
- CLONGNAME = 'THCW', &
- CUNITS = 'mm', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_THickness of Cloud Water', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
- END IF
- !
- ZWORK21(:,:) = 0.
- IF(SIZE(XRT,4)>=3)THEN
- DO JK = IKB,IKE
- ZWORK21(:,:) = ZWORK21(:,:)+XRHODREF(:,:,JK)*XRT(:,:,JK,3) * &
- (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW
- END DO
- ZWORK21(:,:) = ZWORK21(:,:)*1000. ! rain water in mm unit
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'THRW', &
- CSTDNAME = '', &
- CLONGNAME = 'THRW', &
- CUNITS = 'mm', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_THickness of Rain Water', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
- END IF
- !
- ZWORK21(:,:) = 0.
- IF(SIZE(XRT,4)>=4)THEN
- DO JK = IKB,IKE
- ZWORK21(:,:) = ZWORK21(:,:)+XRHODREF(:,:,JK)*XRT(:,:,JK,4) * &
- (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW
- END DO
- ZWORK21(:,:) = ZWORK21(:,:)*1000. ! ice thickness in mm unit
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'THIC', &
- CSTDNAME = '', &
- CLONGNAME = 'THIC', &
- CUNITS = 'mm', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_THickness of ICe', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
- END IF
- !
- ZWORK21(:,:) = 0.
- IF(SIZE(XRT,4)>=5)THEN
- DO JK = IKB,IKE
- ZWORK21(:,:) = ZWORK21(:,:)+XRHODREF(:,:,JK)*XRT(:,:,JK,5) * &
- (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW
- END DO
- ZWORK21(:,:) = ZWORK21(:,:)*1000. ! snow thickness in mm unit
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'THSN', &
- CSTDNAME = '', &
- CLONGNAME = 'THSN', &
- CUNITS = 'mm', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_THickness of SNow', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
- END IF
- !
- ZWORK21(:,:) = 0.
- IF(SIZE(XRT,4)>=6)THEN
- DO JK = IKB,IKE
- ZWORK21(:,:) = ZWORK21(:,:)+XRHODREF(:,:,JK)*XRT(:,:,JK,6) * &
- (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW
- END DO
- ZWORK21(:,:) = ZWORK21(:,:)*1000. ! graupel thickness in mm unit
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'THGR', &
- CSTDNAME = '', &
- CLONGNAME = 'THGR', &
- CUNITS = 'mm', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_THickness of GRaupel', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
- END IF
- !
- ZWORK21(:,:) = 0.
- IF(SIZE(XRT,4)>=7)THEN
- DO JK = IKB,IKE
- ZWORK21(:,:) = ZWORK21(:,:)+XRHODREF(:,:,JK)*XRT(:,:,JK,7) * &
- (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW
- END DO
- ZWORK21(:,:) = ZWORK21(:,:)*1000. ! hail thickness in mm unit
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'THHA', &
- CSTDNAME = '', &
- CLONGNAME = 'THHA', &
- CUNITS = 'mm', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_THickness of HAil', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
- END IF
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* Accumulated and instantaneous total precip rates in mm and mm/h
-!
-IF (LTOTAL_PR .AND. SIZE (XACPRR)>0 ) THEN
- ZWORK21(:,:) = 0.
- !
- IF (LUSERR) THEN
- ZWORK21(:,:) = XACPRR(:,:)*1E3
- END IF
- IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'LIMA') THEN
- ZWORK21(:,:) = ZWORK21(:,:) + (XACPRS(:,:) + XACPRG(:,:))*1E3
- IF (SIZE(XINPRC) /= 0 ) &
- ZWORK21(:,:) = ZWORK21(:,:) + XACPRC(:,:) *1E3
- IF (SIZE(XINPRH) /= 0 ) &
- ZWORK21(:,:) = ZWORK21(:,:) + XACPRH(:,:) *1E3
- END IF
- IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO' &
- .OR. CCLOUD == 'LIMA' ) THEN
- IF (SIZE(XINPRC) /= 0 ) &
- ZWORK21(:,:) = ZWORK21(:,:) + XACPRC(:,:) *1E3
- END IF
- IF (CDCONV /= 'NONE') THEN
- ZWORK21(:,:) = ZWORK21(:,:) + XPACCONV(:,:)*1E3
- END IF
- IF (LUSERR .OR. CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C3R5' .OR. &
- CCLOUD == 'LIMA' .OR. CDCONV /= 'NONE') THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'ACTOPR', &
- CSTDNAME = '', &
- CLONGNAME = 'ACTOPR', &
- CUNITS = 'mm', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_ACccumulated TOtal Precipitation Rate', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
- ELSE
- PRINT * ,'YOU WANT TO COMPUTE THE ACCUMULATED RAIN'
- PRINT * ,'BUT NO RAIN IS PRESENT IN THE MODEL'
- END IF
- !
- ! calculation of the mean accumulated precipitations in the mesh-grid of a
- !large-scale model
- IF (LMEAN_PR .AND. LUSERR) THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'generic LS_ACTOPR', & !Temporary name to ease identification
- CUNITS = 'mm', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Large Scale ACccumulated TOtal Precipitation Rate', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- !
- DO JK=1,SIZE(XMEAN_PR),2
- IF (XMEAN_PR(JK) .NE. XUNDEF .AND. XMEAN_PR(JK+1) .NE. XUNDEF) THEN
- PRINT * ,'MEAN accumulated RAIN: GRID ', XMEAN_PR(JK), XMEAN_PR(JK+1)
- CALL COMPUTE_MEAN_PRECIP(ZWORK21,XMEAN_PR(JK:JK+1),ZWORK22,TZFIELD%NGRID)
- !
- JI=INT(XMEAN_PR(JK))
- JJ=INT(XMEAN_PR(JK+1))
- WRITE(TZFIELD%CMNHNAME,'(A9,2I2.2)')'LS_ACTOPR',JI,JJ
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22)
- END IF
- END DO
- !
- END IF
- !
- !
- ZWORK21(:,:) = 0.
- !
- IF (LUSERR) THEN
- ZWORK21(:,:) = XINPRR(:,:)*3.6E6
- END IF
- IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'LIMA') THEN
- ZWORK21(:,:) = ZWORK21(:,:) + (XINPRS(:,:) + XINPRG(:,:))*3.6E6
- IF (SIZE(XINPRC) /= 0 ) &
- ZWORK21(:,:) = ZWORK21(:,:) + XINPRC(:,:) *3.6E6
- IF (SIZE(XINPRH) /= 0 ) &
- ZWORK21(:,:) = ZWORK21(:,:) + XINPRH(:,:) *3.6E6
- END IF
- IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO' &
- .OR. CCLOUD == 'LIMA' ) THEN
- IF (SIZE(XINPRC) /= 0 ) &
- ZWORK21(:,:) = ZWORK21(:,:) + XINPRC(:,:) *3.6E6
- END IF
- IF (CDCONV /= 'NONE') THEN
- ZWORK21(:,:) = ZWORK21(:,:) + XPRCONV(:,:)*3.6E6
- END IF
- IF (LUSERR .OR. CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C3R5' .OR. &
- CCLOUD == 'LIMA' .OR. CDCONV /= 'NONE') THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'INTOPR', &
- CSTDNAME = '', &
- CLONGNAME = 'INTOPR', &
- CUNITS = 'mm hour-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_INstantaneous TOtal Precipitation Rate', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
- ELSE
- PRINT * ,'YOU WANT TO COMPUTE THE RAIN RATE'
- PRINT * ,'BUT NO RAIN IS PRESENT IN THE MODEL'
- END IF
-!
- ! calculation of the mean instantaneous precipitations in the mesh-grid of a
- ! large-scale model
- IF (LMEAN_PR .AND. LUSERR) THEN
- CALL COMPUTE_MEAN_PRECIP(ZWORK21,XMEAN_PR,ZWORK22,TZFIELD%NGRID)
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'LS_INTOPR', &
- CSTDNAME = '', &
- CLONGNAME = 'LS_INTOPR', &
- CUNITS = 'mm hour-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Large Scale INstantaneous TOtal Precipitation Rate', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22)
- END IF
-!
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* CAPEMAX, CINMAX (corresponding to CAPEMAX), CAPE, CIN, DCAPE, VKE in J/kg
-!
-IF (NCAPE >=0 .AND. LUSERV) THEN
- ZWORK31(:,:,:) = XRT(:,:,:,1) * 1000. ! vapour mixing ratio in g/kg
- ZWORK32(:,:,:)=0.0
- ZWORK33(:,:,:)=0.0
- ZWORK34(:,:,:)=0.0
- CALL CALCSOUND( XPABST(:,:,IKB:IKE)* 0.01 ,ZTEMP(:,:,IKB:IKE)- XTT, &
- ZWORK31(:,:,IKB:IKE), &
- ZWORK32(:,:,IKB:IKE),ZWORK33(:,:,IKB:IKE), &
- ZWORK34(:,:,IKB:IKE),ZWORK21,ZWORK22 )
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'CAPEMAX', &
- CSTDNAME = '', &
- CLONGNAME = 'CAPEMAX', &
- CUNITS = 'J kg-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_MAX of Convective Available Potential Energy', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'CINMAX', &
- CSTDNAME = '', &
- CLONGNAME = 'CINMAX', &
- CUNITS = 'J kg-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_MAX of Convective INhibition energy', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22)
- !
- IF (NCAPE >=1) THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'CAPE3D', &
- CSTDNAME = 'atmosphere_convective_available_potential_energy', &
- CLONGNAME = 'CAPE3D', &
- CUNITS = 'J kg-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Convective Available Potential Energy', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'CIN3D', &
- CSTDNAME = 'atmosphere_convective_inhibition', &
- CLONGNAME = 'CIN3D', &
- CUNITS = 'J kg-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Convective INhibition energy', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'DCAPE3D', &
- CSTDNAME = '', &
- CLONGNAME = 'DCAPE3D', &
- CUNITS = 'J kg-1', &
- CDIR = 'XY', &
- CCOMMENT = '', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK34)
- END IF
- !
- IF (NCAPE >=2) THEN
- ZWORK31(:,:,1:IKU-1)= 0.5*(XWT(:,:,1:IKU-1)+XWT(:,:,2:IKU))
- ZWORK31(:,:,IKU) = 0.
- ZWORK31=0.5*ZWORK31**2
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'VKE', &
- CSTDNAME = '', &
- CLONGNAME = 'VKE', &
- CUNITS = 'J kg-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Vertical Kinetic Energy', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
- END IF
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* B-V frequency to assess thermal tropopause
-!
-IF (LBV_FR) THEN
- ZWORK32(:,:,:)=DZM(XTHT(:,:,:))/ MZM(XTHT(:,:,:))
- DO JK=1,IKU
- DO JJ=1,IJU
- DO JI=1,IIU
- IF(ZWORK32(JI,JJ,JK)<0.) THEN
- ZWORK31(JI,JJ,JK)= -1.*SQRT( ABS( XG*ZWORK32(JI,JJ,JK)/ XDZZ(JI,JJ,JK) ) )
- ELSE
- ZWORK31(JI,JJ,JK)= SQRT( ABS( XG*ZWORK32(JI,JJ,JK)/ XDZZ(JI,JJ,JK) ) )
- END IF
- ENDDO
- ENDDO
- ENDDO
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'BV', &
- CSTDNAME = '', &
- CLONGNAME = 'BV', &
- CUNITS = 's-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Brunt-Vaissala frequency', &
- NGRID = 4, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
-!
- IF (NRR > 0) THEN
- ZWORK32(:,:,:)=DZM(ZTHETAE(:,:,:))/ MZM(ZTHETAE(:,:,:))
- DO JK=1,IKU
- DO JJ=1,IJU
- DO JI=1,IIU
- IF (ZWORK32(JI,JJ,JK)<0.) THEN
- ZWORK31(JI,JJ,JK)= -1.*SQRT( ABS( XG*ZWORK32(JI,JJ,JK)/ XDZZ(JI,JJ,JK) ) )
- ELSE
- ZWORK31(JI,JJ,JK)= SQRT( ABS( XG*ZWORK32(JI,JJ,JK)/ XDZZ(JI,JJ,JK) ) )
- END IF
- ENDDO
- ENDDO
- ENDDO
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'BVE', &
- CSTDNAME = '', &
- CLONGNAME = 'BVE', &
- CUNITS = 's-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Equivalent Brunt-Vaissala frequency', &
- NGRID = 4, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
- END IF
-END IF
-!
-IF(ALLOCATED(ZTHETAE)) DEALLOCATE(ZTHETAE)
-IF(ALLOCATED(ZTHETAES)) DEALLOCATE(ZTHETAES)
-!-------------------------------------------------------------------------------
-!
-!* GPS synthetic ZTD, ZHD, ZWD
-!
-IF ( NGPS>=0 ) THEN
- ! surface temperature
- ZGAMREF=-6.5E-3
- ZWORK21(:,:) = ZTEMP(:,:,IKB) - ZGAMREF*((XZZ(:,:,IKB)+XZZ(:,:,IKB+1))/2.-XZS(:,:))
- !
- YFGRI=ADJUSTL(ADJUSTR(TPFILE%CNAME)//'GPS')
- CALL GPS_ZENITH (YFGRI,XRT(:,:,:,1),ZTEMP,XPABST,ZWORK21,ZWORK22,ZWORK23,ZWORK24)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'ZTD', &
- CSTDNAME = '', &
- CLONGNAME = 'ZTD', &
- CUNITS = 'm', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Zenithal Total Delay', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22)
- !
- IF (NGPS>=1) THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'ZHD', &
- CSTDNAME = '', &
- CLONGNAME = 'ZHD', &
- CUNITS = 'm', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Zenithal Hydrostatic Delay', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK23)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'ZWD', &
- CSTDNAME = '', &
- CLONGNAME = 'ZWD', &
- CUNITS = 'm', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Zenithal Wet Delay', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK24)
- !
- END IF
- !
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* Radar reflectivities
-!
-IF(LRADAR .AND. LUSERR) THEN
-! CASE PREP_REAL_CASE after arome
- IF (CCLOUD=='NONE' .OR. CCLOUD=='KESS') THEN
- DEALLOCATE(XCIT)
- ALLOCATE(XCIT(IIU,IJU,IKU))
- XCIT(:,:,:)=800.
- CALL INI_RADAR('PLAT')
- ELSE IF (CCLOUD=='LIMA') THEN
- DEALLOCATE(XCIT)
- ALLOCATE(XCIT(IIU,IJU,IKU))
- XCIT(:,:,:)=XSVT(:,:,:,NSV_LIMA_NI)
- CALL INI_RADAR('PLAT')
- END IF
-!
- IF (NVERSION_RAD == 1) THEN
-! original version of radar diagnostics
- WRITE(ILUOUT0,*) 'radar diagnostics from RADAR_RAIN_ICE routine'
- IF (CCLOUD=='LIMA') THEN
- ALLOCATE( ZW1(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3)) )
- ALLOCATE( ZW2(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3)) )
- ALLOCATE( ZW3(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3)) )
- IF ( NMOM_S >= 2 ) ZW1(:,:,:)=XSVT(:,:,:,NSV_LIMA_NS)
- IF ( NMOM_G >= 2 ) ZW2(:,:,:)=XSVT(:,:,:,NSV_LIMA_NG)
- IF ( NMOM_H >= 2 ) ZW3(:,:,:)=XSVT(:,:,:,NSV_LIMA_NH)
- CALL RADAR_RAIN_ICE( XRT, XCIT, XRHODREF, ZTEMP, ZWORK31, ZWORK32, &
- ZWORK33, ZWORK34,XSVT(:,:,:,NSV_LIMA_NR), &
- ZW1(:,:,:), ZW2(:,:,:), ZW3(:,:,:) )
- DEALLOCATE( ZW1, ZW2, ZW3 )
- ELSE
- CALL RADAR_RAIN_ICE (XRT, XCIT, XRHODREF, ZTEMP, ZWORK31, ZWORK32, &
- ZWORK33, ZWORK34 )
- ENDIF
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'RARE', &
- CSTDNAME = 'equivalent_reflectivity_factor', &
- CLONGNAME = 'RARE', &
- CUNITS = 'dBZ', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_RAdar REflectivity', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'VDOP', &
- CSTDNAME = '', &
- CLONGNAME = 'VDOP', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_radar DOPpler fall speed', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32)
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'ZDR', &
- CSTDNAME = '', &
- CLONGNAME = 'ZDR', &
- CUNITS = 'dBZ', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Differential polar Reflectivity', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33)
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'KDP', &
- CSTDNAME = '', &
- CLONGNAME = 'KDP', &
- CUNITS = 'degree km-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Differential Phase Reflectivity', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK34)
-!
- ELSE
- !
- WRITE(ILUOUT0,*) 'radar diagnostics from RADAR_SIMULATOR routine'
-
- NBRAD=COUNT(XLAT_RAD(:) /= XUNDEF)
- NMAX=INT(NBSTEPMAX*XSTEP_RAD/XGRID)
- IF(NBSTEPMAX*XSTEP_RAD/XGRID/=NMAX .AND. (LCART_RAD)) THEN
- CALL PRINT_MSG(NVERB_FATAL,'GEN','WRITE_LFIFM1_FOR_DIAG', &
- 'NBSTEPMAX*XSTEP_RAD/XGRID is not an integer; please choose another combination')
- ENDIF
- DO JI=1,NBRAD
- NBELEV(JI)=COUNT(XELEV(JI,:) /= XUNDEF)
- WRITE(ILUOUT0,*) 'Number of ELEVATIONS : ', NBELEV(JI), 'FOR RADAR:', JI
- END DO
- IIELV=MAXVAL(NBELEV(1:NBRAD))
- WRITE(ILUOUT0,*) 'Maximum number of ELEVATIONS',IIELV
- WRITE(ILUOUT0,*) 'YOU HAVE ASKED FOR ', NBRAD, 'RADARS'
- !
- IF (LCART_RAD) NBAZIM=8*NMAX ! number of azimuths
- WRITE(ILUOUT0,*) ' Number of AZIMUTHS : ', NBAZIM
- IF (LCART_RAD) THEN
- ALLOCATE(ZWORK43(NBRAD,4*NMAX,2*NMAX))
- ELSE
- ALLOCATE(ZWORK43(1,NBAZIM,1))
- END IF
-!! Some controls...
- IF(NBRAD/=COUNT(XLON_RAD(:) /= XUNDEF).OR.NBRAD/=COUNT(XALT_RAD(:) /= XUNDEF).OR. &
- NBRAD/=COUNT(XLAM_RAD(:) /= XUNDEF).OR.NBRAD/=COUNT(XDT_RAD(:) /= XUNDEF).OR. &
- NBRAD/=COUNT(CNAME_RAD(:) /= "UNDEF")) THEN
- CALL PRINT_MSG(NVERB_FATAL,'GEN','WRITE_LFIFM1_FOR_DIAG','inconsistency in DIAG1.nam')
- END IF
- IF(NCURV_INTERPOL==0.AND.(LREFR.OR.LDNDZ)) THEN
- LREFR=.FALSE.
- LDNDZ=.FALSE.
- WRITE(ILUOUT0,*) "Warning: cannot output refractivity nor its vertical gradient when NCURV_INTERPOL=0"
- END IF
- IF(MOD(NPTS_H,2)==0) THEN
- NPTS_H=NPTS_H+1
- WRITE(ILUOUT0,*) "Warning: NPTS_H has to be ODD. Setting it to ",NPTS_H
- END IF
- IF(MOD(NPTS_V,2)==0) THEN
- NPTS_V=NPTS_V+1
- WRITE(ILUOUT0,*) "Warning: NPTS_V has to be ODD. Setting it to ",NPTS_V
- END IF
- IF(LWBSCS.AND.LWREFL) THEN
- LWREFL=.FALSE.
- WRITE(ILUOUT0,*) "Warning: LWREFL cannot be set to .TRUE. if LWBSCS is also set to .TRUE.. Setting LWREFL to .FALSE.."
- END IF
- IF(CCLOUD=="LIMA" .AND. NDIFF/=7) THEN
- WRITE(YMSG,*) 'NDIFF=',NDIFF,' not available with CCLOUD=LIMA'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','WRITE_LFIFM1_FOR_DIAG',YMSG)
- END IF
- INBOUT=28 !28: Temperature + RHR, RHS, RHG, ZDA, ZDS, ZDG, KDR, KDS, KDG
- IF (CCLOUD=='LIMA') INBOUT=INBOUT+1 ! rain concentration CRT
- IF(LREFR) INBOUT=INBOUT+1 !+refractivity
- IF(LDNDZ) INBOUT=INBOUT+1 !+refractivity vertical gradient
- IF(LATT) INBOUT=INBOUT+12 !+AER-AEG AVR-AVG (vertical specific attenuation) and ATR-ATG
- IF ( CCLOUD=='ICE4' ) THEN
- INBOUT=INBOUT+5 ! HAIL ZEH RHH ZDH KDH M_H
- IF (LATT) THEN
- INBOUT=INBOUT+3 ! AEH AVH ATH
- ENDIF
- END IF
- WRITE(ILUOUT0,*) "Nombre de variables dans ZWORK42 en sortie de radar_simulator:",INBOUT
-
- IF (LCART_RAD) THEN
- ALLOCATE(ZWORK42(NBRAD,IIELV,2*NMAX,2*NMAX,INBOUT))
- ELSE
- ALLOCATE(ZWORK42(NBRAD,IIELV,NBAZIM,NBSTEPMAX+1,INBOUT))
- ALLOCATE(ZWORK42_BIS(NBRAD,IIELV,NBAZIM,NBSTEPMAX+1,INBOUT))
- END IF
- !
- IF (CCLOUD=='LIMA') THEN
- CALL RADAR_SIMULATOR(XUT,XVT,XWT,XRT,XSVT(:,:,:,NSV_LIMA_NI),XRHODREF,&
- ZTEMP,XPABST,ZWORK42,ZWORK43,XSVT(:,:,:,NSV_LIMA_NR))
- ELSE ! ICE3
- CALL RADAR_SIMULATOR(XUT,XVT,XWT,XRT,XCIT,XRHODREF,ZTEMP,XPABSM,ZWORK42,ZWORK43)
- ENDIF
- ALLOCATE(YRAD(INBOUT))
- YRAD(1:8)=(/"ZHH","ZDR","KDP","CSR","ZER","ZEI","ZES","ZEG"/)
- ICURR=9
- IF (CCLOUD=='ICE4') THEN
- YRAD(ICURR)="ZEH"
- ICURR=ICURR+1
- END IF
- YRAD(ICURR)="VRU"
- ICURR=ICURR+1
- IF(LATT) THEN
- IF (CCLOUD=='ICE4') THEN
- YRAD(ICURR:ICURR+14)=(/"AER","AEI","AES","AEG","AEH","AVR","AVI","AVS","AVG","AVH","ATR","ATI","ATS","ATG","ATH"/)
- ICURR=ICURR+15
- ELSE
- YRAD(ICURR:ICURR+11)=(/"AER","AEI","AES","AEG","AVR","AVI","AVS","AVG","ATR","ATI","ATS","ATG"/)
- ICURR=ICURR+12
- END IF
- END IF
- YRAD(ICURR:ICURR+2)=(/"RHV","PDP","DHV"/)
- ICURR=ICURR+3
- YRAD(ICURR:ICURR+2)=(/"RHR","RHS","RHG"/)
- ICURR=ICURR+3
- IF (CCLOUD=='ICE4') THEN
- YRAD(ICURR)="RHH"
- ICURR=ICURR+1
- END IF
- YRAD(ICURR:ICURR+2)=(/"ZDA","ZDS","ZDG"/)
- ICURR=ICURR+3
- IF (CCLOUD=='ICE4') THEN
- YRAD(ICURR)="ZDH"
- ICURR=ICURR+1
- END IF
- YRAD(ICURR:ICURR+2)=(/"KDR","KDS","KDG"/)
- ICURR=ICURR+3
- IF (CCLOUD=='ICE4') THEN
- YRAD(ICURR)="KDH"
- ICURR=ICURR+1
- END IF
- YRAD(ICURR:ICURR+4)=(/"HAS","M_R","M_I","M_S","M_G"/)
- ICURR=ICURR+5
- IF (CCLOUD=='ICE4') THEN
- YRAD(ICURR)="M_H"
- ICURR=ICURR+1
- END IF
- YRAD(ICURR:ICURR+1)=(/"CIT","TEM"/)
- ICURR=ICURR+2
- IF (CCLOUD=='LIMA') THEN
- YRAD(ICURR)="CRT"
- ICURR=ICURR+1
- ENDIF
- IF(LREFR) THEN
- YRAD(ICURR)="RFR"
- ICURR=ICURR+1
- END IF
- IF(LDNDZ) THEN
- YRAD(ICURR)="DNZ"
- ICURR=ICURR+1
- END IF
- IF (LCART_RAD) THEN
- DO JI=1,NBRAD
- IEL=NBELEV(JI)
- ! writing latlon in internal files
- ALLOCATE(CLATLON(2*NMAX))
- CLATLON=""
- DO JV=2*NMAX,1,-1
- DO JH=1,2*NMAX
- WRITE(CBUFFER,'(2(f8.3,1X))') ZWORK43(JI,2*JH-1,JV),ZWORK43(JI,2*JH,JV)
- CLATLON(JV)=TRIM(CLATLON(JV)) // " " // TRIM(CBUFFER)
- END DO
- CLATLON(JV)=TRIM(ADJUSTL(CLATLON(JV)))
- END DO
- DO JEL=1,IEL
- WRITE(YELEV,'(I2.2,A1,I1.1)') FLOOR(XELEV(JI,JEL)),'.',&
- INT(ANINT(10.*XELEV(JI,JEL))-10*INT(XELEV(JI,JEL)))
- WRITE(YGRID_SIZE,'(I3.3)') 2*NMAX
- DO JJ=1,SIZE(ZWORK42(:,:,:,:,:),5)
- YRS=YRAD(JJ)//CNAME_RAD(JI)(1:3)//YELEV//YGRID_SIZE//TRIM(TPFILE%CNAME)
- CALL IO_File_add2list(TZRSFILE,YRS,'TXT','WRITE',KRECL=8192)
- CALL IO_File_open(TZRSFILE,HSTATUS='NEW')
- ILURS = TZRSFILE%NLU
- WRITE(ILURS,'(A,4F12.6,2I5)') '**domaine LATLON ',ZWORK43(JI,1,1),ZWORK43(JI,4*NMAX-1,2*NMAX), &
- ZWORK43(JI,2,1),ZWORK43(JI,4*NMAX,2*NMAX),2*NMAX,2*NMAX !! HEADER
- DO JV=2*NMAX,1,-1
- DO JH=1,2*NMAX
- WRITE(ILURS,'(E11.5,1X)',ADVANCE='NO') ZWORK42(JI,JEL,JH,JV,JJ)
- END DO
- WRITE(ILURS,*) ''
- END DO
-
- DO JV=2*NMAX,1,-1
- WRITE(ILURS,*) CLATLON(JV)
- END DO
- CALL IO_File_close(TZRSFILE)
- TZRSFILE => NULL()
- END DO
- END DO
- DEALLOCATE(CLATLON)
- END DO
- ELSE ! polar output
- CALL MPI_ALLREDUCE(ZWORK42, ZWORK42_BIS, SIZE(ZWORK42), MNHREAL_MPI, MPI_MAX, NMNH_COMM_WORLD, IERR)
- DO JI=1,NBRAD
- IEL=NBELEV(JI)
- DO JEL=1,IEL
- WRITE(YELEV,'(I2.2,A1,I1.1)') FLOOR(XELEV(JI,JEL)),'.',&
- INT(ANINT(10.*XELEV(JI,JEL))-10*INT(XELEV(JI,JEL)))
- DO JJ=1,SIZE(ZWORK42(:,:,:,:,:),5)
- YRS="P"//YRAD(JJ)//CNAME_RAD(JI)(1:3)//YELEV//TRIM(TPFILE%CNAME)
- CALL IO_File_add2list(TZRSFILE,YRS,'TXT','WRITE')
- CALL IO_File_open(TZRSFILE)
- ILURS = TZRSFILE%NLU
- DO JH=1,NBAZIM
- DO JV=1,NBSTEPMAX+1
- WRITE(ILURS,"(F15.7)") ZWORK42_BIS(JI,JEL,JH,JV,JJ)
- END DO
- END DO
- CALL IO_File_close(TZRSFILE)
- TZRSFILE => NULL()
- END DO
- END DO
- END DO
- END IF !polar output
- DEALLOCATE(ZWORK42,ZWORK43)
- END IF
-END IF
-!
-IF (LLIDAR) THEN
- PRINT *,'CALL LIDAR/RADAR with TPFILE%CNAME =',TPFILE%CNAME
- YVIEW=' '
- YVIEW=TRIM(CVIEW_LIDAR)
- PRINT *,'CVIEW_LIDAR REQUESTED ',YVIEW
- IF (YVIEW/='NADIR'.AND.YVIEW/='ZENIT') YVIEW='NADIR'
- PRINT *,'CVIEW_LIDAR USED ',YVIEW
- PRINT *,'XALT_LIDAR REQUESTED (m) ',XALT_LIDAR
- PRINT *,'XWVL_LIDAR REQUESTED (m) ',XWVL_LIDAR
- IF (XWVL_LIDAR==XUNDEF) XWVL_LIDAR=0.532E-6
- IF (XWVL_LIDAR<1.E-7.OR.XWVL_LIDAR>2.E-6) THEN
- PRINT *,'CAUTION: THE XWVL_LIDAR REQUESTED IS OUTSIDE THE USUAL RANGE'
- XWVL_LIDAR=0.532E-6
- ENDIF
- PRINT *,'XWVL_LIDAR USED (m) ',XWVL_LIDAR
-!
- IF (LDUST) THEN
- IACCMODE=MIN(2,NMODE_DST)
- ALLOCATE(ZTMP1(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), 1))
- ALLOCATE(ZTMP2(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), 1))
- ALLOCATE(ZTMP3(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), 1))
- ZTMP1(:,:,:,1)=ZN0_DST(:,:,:,IACCMODE)
- ZTMP2(:,:,:,1)=ZRG_DST(:,:,:,IACCMODE)
- ZTMP3(:,:,:,1)=ZSIG_DST(:,:,:,IACCMODE)
- SELECT CASE ( CCLOUD )
- CASE('KESS''ICE3','ICE4')
- CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, ZTEMP, XCLDFR, &
- XRT, ZWORK31, ZWORK32, &
- PDSTC=ZTMP1, &
- PDSTD=ZTMP2, &
- PDSTS=ZTMP3)
- CASE('C2R2')
- CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, ZTEMP, XCLDFR, &
- XRT, ZWORK31, ZWORK32, &
- PCT=XSVT(:,:,:,NSV_C2R2BEG+1:NSV_C2R2END), &
- PDSTC=ZTMP1, &
- PDSTD=ZTMP2, &
- PDSTS=ZTMP3)
- CASE('C3R5')
- CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, ZTEMP, XCLDFR, &
- XRT, ZWORK31, ZWORK32, &
- PCT=XSVT(:,:,:,NSV_C2R2BEG+1:NSV_C1R3END-1), &
- PDSTC=ZTMP1, &
- PDSTD=ZTMP2, &
- PDSTS=ZTMP3)
- CASE('LIMA')
-! PCT(2) = droplets (3)=drops (4)=ice crystals
- ALLOCATE(ZTMP4(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), 4))
- ZTMP4(:,:,:,1)=0.
- ZTMP4(:,:,:,2)=XSVT(:,:,:,NSV_LIMA_NC)
- ZTMP4(:,:,:,3)=XSVT(:,:,:,NSV_LIMA_NR)
- ZTMP4(:,:,:,4)=XSVT(:,:,:,NSV_LIMA_NI)
-!
- CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, ZTEMP, MAX(XCLDFR,XICEFR),&
- XRT, ZWORK31, ZWORK32, &
- PCT=ZTMP4, &
- PDSTC=ZTMP1, &
- PDSTD=ZTMP2, &
- PDSTS=ZTMP3)
-!
- END SELECT
- ELSE
- SELECT CASE ( CCLOUD )
- CASE('KESS','ICE3','ICE4')
- CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, ZTEMP, XCLDFR, &
- XRT, ZWORK31, ZWORK32)
- CASE('C2R2')
- CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, ZTEMP, XCLDFR, &
- XRT, ZWORK31, ZWORK32, &
- PCT=XSVT(:,:,:,NSV_C2R2BEG+1:NSV_C2R2END))
- CASE('C3R5')
- CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, ZTEMP, XCLDFR, &
- XRT, ZWORK31, ZWORK32, &
- PCT=XSVT(:,:,:,NSV_C2R2BEG+1:NSV_C1R3END-1))
- CASE('LIMA')
-! PCT(2) = droplets (3)=drops (4)=ice crystals
- ALLOCATE(ZTMP4(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), 4))
- ZTMP4(:,:,:,1)=0.
- ZTMP4(:,:,:,2)=XSVT(:,:,:,NSV_LIMA_NC)
- ZTMP4(:,:,:,3)=XSVT(:,:,:,NSV_LIMA_NR)
- ZTMP4(:,:,:,4)=XSVT(:,:,:,NSV_LIMA_NI)
-!
- CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, ZTEMP, MAX(XCLDFR,XICEFR),&
- XRT, ZWORK31, ZWORK32, &
- PCT=ZTMP4)
- END SELECT
- ENDIF
-!
- IF( ALLOCATED(ZTMP1) ) DEALLOCATE(ZTMP1)
- IF( ALLOCATED(ZTMP2) ) DEALLOCATE(ZTMP2)
- IF( ALLOCATED(ZTMP3) ) DEALLOCATE(ZTMP3)
- IF( ALLOCATED(ZTMP4) ) DEALLOCATE(ZTMP4)
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'LIDAR', &
- CSTDNAME = '', &
- CLONGNAME = 'LIDAR', &
- CUNITS = 'm-1 sr-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Normalized_Lidar_Profile', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'LIPAR', &
- CSTDNAME = '', &
- CLONGNAME = 'LIPAR', &
- CUNITS = 'm-1 sr-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Particle_Lidar_Profile', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32)
-!
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* Height of boundary layer
-!
-IF (CBLTOP == 'THETA') THEN
- !
- ! methode de la parcelle
- !
- ALLOCATE(ZSHMIX(IIU,IJU))
-
- ZWORK31(:,:,1:IKU-1)=0.5*(XZZ(:,:,1:IKU-1)+XZZ(:,:,2:IKU))
- ZWORK31(:,:,IKU)=2.*ZWORK31(:,:,IKU-1)-ZWORK31(:,:,IKU-2)
- ZWORK21(:,:) = ZTHETAV(:,:,IKB)+0.5
- ZSHMIX(:,:) = 0.0
- DO JJ=1,IJU
- DO JI=1,IIU
- DO JK=IKB,IKE
- IF ( ZTHETAV(JI,JJ,JK).GT.ZWORK21(JI,JJ) ) THEN
- ZSHMIX(JI,JJ) = ZWORK31(JI,JJ,JK-1) &
- +( ZWORK31(JI,JJ,JK) - ZWORK31 (JI,JJ,JK-1) ) &
- /( ZTHETAV(JI,JJ,JK) - ZTHETAV(JI,JJ,JK-1) ) &
- *( ZWORK21(JI,JJ) - ZTHETAV(JI,JJ,JK-1) )
- EXIT
- END IF
- END DO
- END DO
- END DO
- ZSHMIX(:,:)=ZSHMIX(:,:)-XZS(:,:)
- ZSHMIX(:,:)=MAX(ZSHMIX(:,:),50.0)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'HBLTOP', &
- CSTDNAME = 'atmosphere_boundary_layer_thickness', &
- CLONGNAME = 'HBLTOP', &
- CUNITS = 'm', &
- CDIR = 'XY', &
- CCOMMENT = 'Height of Boundary Layer TOP', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZSHMIX)
- !
- DEALLOCATE(ZSHMIX)
-ELSEIF (CBLTOP == 'RICHA') THEN
- !
- ! methode du "bulk Richardson number"
- !
- ALLOCATE(ZRIB(IIU,IJU,IKU))
- ALLOCATE(ZSHMIX(IIU,IJU))
-
- ZWORK31(:,:,1:IKU-1)=0.5*(XZZ(:,:,1:IKU-1)+XZZ(:,:,2:IKU))
- ZWORK31(:,:,IKU)=2.*ZWORK31(:,:,IKU-1)-ZWORK31(:,:,IKU-2)
- ZWORK32=MXF(XUT)
- ZWORK33=MYF(XVT)
- ZWORK34=ZWORK32**2+ZWORK33**2
- DO JK=IKB,IKE
- ZRIB(:,:,JK)=XG*ZWORK31(:,:,JK)*(ZTHETAV(:,:,JK)-ZTHETAV(:,:,IKB))/(ZTHETAV(:,:,IKB)*ZWORK34(:,:,JK))
- ENDDO
- ZSHMIX=0.0
- DO JJ=1,IJU
- DO JI=1,IIU
- DO JK=IKB,IKE
- IF ( ZRIB(JI,JJ,JK).GT.0.25 ) THEN
- ZSHMIX(JI,JJ) = ZWORK31(JI,JJ,JK-1) &
- +( ZWORK31(JI,JJ,JK) - ZWORK31(JI,JJ,JK-1) ) &
- *( 0.25 - ZRIB(JI,JJ,JK-1) ) &
- /( ZRIB(JI,JJ,JK) - ZRIB(JI,JJ,JK-1) )
- EXIT
- END IF
- END DO
- END DO
- END DO
- ZSHMIX(:,:)=ZSHMIX(:,:)-XZS(:,:)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'HBLTOP', &
- CSTDNAME = 'atmosphere_boundary_layer_thickness', &
- CLONGNAME = 'HBLTOP', &
- CUNITS = 'm', &
- CDIR = 'XY', &
- CCOMMENT = 'Height of Boundary Layer TOP', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZSHMIX)
- !
- DEALLOCATE(ZRIB,ZSHMIX)
-ENDIF
-!
-IF (ALLOCATED(ZTHETAV)) DEALLOCATE(ZTHETAV)
-!
-!
-!* Ligthning
-!
-IF ( LCH_CONV_LINOX ) THEN
- CALL IO_Field_write(TPFILE,'IC_RATE', XIC_RATE)
- CALL IO_Field_write(TPFILE,'CG_RATE', XCG_RATE)
- CALL IO_Field_write(TPFILE,'IC_TOTAL_NB',XIC_TOTAL_NUMBER)
- CALL IO_Field_write(TPFILE,'CG_TOTAL_NB',XCG_TOTAL_NUMBER)
-END IF
-!-------------------------------------------------------------------------------
-!-------------------------------------------------------------------------------
-!
-!* 1.8 My own variables :
-!
-!-------------------------------------------------------------------------------
-!-------------------------------------------------------------------------------
-!
-!-------------------------------------------------------------------------------
-END SUBROUTINE WRITE_LFIFM1_FOR_DIAG
diff --git a/src/mesonh/ext/write_lfifm1_for_diag_supp.f90 b/src/mesonh/ext/write_lfifm1_for_diag_supp.f90
deleted file mode 100644
index bb8214c93eb61a4b10f68adc4f90d12f6d43773f..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/write_lfifm1_for_diag_supp.f90
+++ /dev/null
@@ -1,1557 +0,0 @@
-!MNH_LIC Copyright 2000-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_WRITE_LFIFM1_FOR_DIAG_SUPP
-! ######################################
-INTERFACE
-!
- SUBROUTINE WRITE_LFIFM1_FOR_DIAG_SUPP(TPFILE)
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-!* 0.1 Declarations of arguments
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-END SUBROUTINE WRITE_LFIFM1_FOR_DIAG_SUPP
-!
-END INTERFACE
-!
-END MODULE MODI_WRITE_LFIFM1_FOR_DIAG_SUPP
-!
-! ##############################################
- SUBROUTINE WRITE_LFIFM1_FOR_DIAG_SUPP(TPFILE)
-! ##############################################
-!
-!!**** *WRITE_LFIFM1_FOR_DIAG_SUPP* - write records in the diag file
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to write in the file
-! of name YFMFILE//'.lfi' with the FM routines.
-!
-!!** METHOD
-!! ------
-!! The data are written in the LFIFM file :
-!! - diagnostics from the convection
-!! - diagnostics from the radiatif transfer code
-!!
-!! The localization on the model grid is also indicated :
-!! IGRID = 1 for mass grid point
-!! IGRID = 2 for U grid point
-!! IGRID = 3 for V grid point
-!! IGRID = 4 for w grid point
-!! IGRID = 0 for meaningless case
-!!
-!! EXTERNAL
-!! --------
-!! FMWRIT : FM-routine to write a record
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! J. Stein *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 13/09/00
-!! N. Asencio 15/09/00 computation of temperature and height of clouds is moved
-!! here and deleted in WRITE_LFIFM1_FOR_DIAG routine
-!! I. Mallet 02/11/00 add the call to RADTR_SATEL
-!! J.-P. Chaboureau 11/12/03 add call the CALL_RTTOV (table NRTTOVINFO to
-!! choose the platform, the satellite, the sensor for all channels
-!! (see the table in rttov science and validation report) and the
-!! type of calculations in the namelist: 0 = tb, 1 = tb + jacobian,
-!! 2 = tb + adjoint, 3 = tb + jacobian + adjoint)
-!! V. Masson 01/2004 removes surface (externalization)
-!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
-!! change of YCOMMENT
-!! October 2011 (C.Lac) FF10MAX : interpolation of 10m wind
-!! between 2 Meso-NH levels if 10m is above the first atmospheric level
-!! 2015 : D.Ricard add UM10/VM10 for LCARTESIAN=T cases
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! P.Tulet : Diag for salt and orilam
-!! J.-P. Chaboureau 07/03/2016 fix the dimensions of local arrays
-!! P.Wautelet : 11/07/2016 : removed MNH_NCWRIT define
-!! J.-P. Chaboureau 31/10/2016 add the call to RTTOV11
-!! F. Brosse 10/2016 add chemical production destruction terms outputs
-!! M.Leriche 01/07/2017 Add DIAG chimical surface fluxes
-!! J.-P. Chaboureau 01/2018 add altitude interpolation
-!! J.-P. Chaboureau 01/2018 add coarse graining
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! J.-P. Chaboureau 07/2018 bug fix on XEMIS when calling CALL_RTTOVxx
-!! J.-P. Chaboureau 09/04/2021 add the call to RTTOV13
-! P. Wautelet 04/02/2022: use TSVLIST to manage metadata of scalar variables
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CH_AEROSOL, ONLY: LORILAM
-USE MODD_CH_BUDGET_n, ONLY: CNAMES_BUDGET, NEQ_BUDGET, XTCHEM
-USE MODD_CH_FLX_n, ONLY: XCHFLX
-USE MODD_CH_PRODLOSSTOT_n, ONLY: CNAMES_PRODLOSST, NEQ_PLT, XLOSS, XPROD
-USE MODD_CST, ONLY: XCPD, XP00, XRD, XTT
-USE MODD_CURVCOR_n, ONLY: XCORIOZ
-USE MODD_DIAG_IN_RUN, ONLY: XCURRENT_ZON10M, XCURRENT_MER10M, &
- XCURRENT_SFCO2, XCURRENT_SWD, XCURRENT_LWD, &
- XCURRENT_SWU, XCURRENT_LWU
-USE MODD_DUST, ONLY: LDUST
-use modd_field, only: NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED, NMNHDIM_UNUSED, &
- tfieldmetadata, tfieldlist, TYPEINT, TYPEREAL
-use modd_field
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_CONF, ONLY: LCARTESIAN
-USE MODD_CONF_n, ONLY: LUSERC, LUSERI, NRR
-USE MODD_DEEP_CONVECTION_n, ONLY: NCLBASCONV, NCLTOPCONV, XCAPE, XDMFCONV, XDRCCONV, XDRICONV, XDRVCONV, &
- XDTHCONV, XDSVCONV, XMFCONV, XPRLFLXCONV, XPRSFLXCONV, XUMFCONV
-USE MODD_DIAG_FLAG, ONLY: CRAD_SAT, LCHEMDIAG, LCLD_COV, LCOARSE, LISOAL, LISOPR, LISOTH, LRAD_SUBG_COND, &
- NCONV_KF, NDXCOARSE, NRAD_3D, NRTTOVINFO, XISOAL, XISOPR, XISOTH
-USE MODD_FIELD_n, ONLY: XCLDFR, XICEFR, XPABST, XSIGS, XTHT, XTKET, XRT, XUT, XVT, XWT
-USE MODD_GRID_n, ONLY: XZHAT, XZZ
-USE MODD_METRICS_n, ONLY: XDXX, XDYY, XDZX, XDZY, XDZZ
-USE MODD_NEB_n, ONLY: LSIGMAS, LSUBG_COND, VSIGQSAT
-USE MODD_NSV, ONLY: NSV, NSV_CHEMBEG, NSV_CHEMEND, TSVLIST
-USE MODD_PARAMETERS, ONLY: JPVEXT, NUNDEF, XUNDEF
-USE MODD_PARAM_KAFR_n, ONLY: LCHTRANS
-USE MODD_PARAM_n, ONLY: CRAD, CSURF
-USE MODD_PARAM_RAD_n, only: NRAD_COLNBR
-USE MODD_RADIATIONS_N, ONLY: NCLEARCOL_TM1, NDLON, NFLEV, NSTATM, &
- XAER, XAZIM, XCCO2, XDIR_ALB, XDIRFLASWD, XDIRSRFSWD, XDTHRAD, XEMIS, &
- XFLALWD, XSCA_ALB, XSCAFLASWD, XSTATM, XTSRAD, XZENITH
-USE MODD_RAD_TRANSF, ONLY: JPGEOST
-USE MODD_REF_n, ONLY: XRHODREF
-USE MODD_SALT, ONLY: LSALT
-USE MODD_TIME_n, ONLY: TDTCUR
-USE MODD_NEB_n, ONLY: LSIGMAS, LSUBG_COND, VSIGQSAT
-
-use mode_field, only: Find_field_id_from_mnhname
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODE_MSG
-USE MODE_NEIGHBORAVG, ONLY: BLOCKAVG, MOVINGAVG
-USE MODE_TOOLS_LL, ONLY: GET_INDICE_ll
-
-#ifdef MNH_RTTOV_8
-USE MODI_CALL_RTTOV8
-#endif
-#ifdef MNH_RTTOV_11
-USE MODI_CALL_RTTOV11
-#endif
-#ifdef MNH_RTTOV_13
-USE MODI_CALL_RTTOV13
-#endif
-USE MODI_GET_SURF_UNDEF
-USE MODI_GRADIENT_M
-USE MODI_GRADIENT_U
-USE MODI_GRADIENT_UV
-USE MODI_GRADIENT_V
-USE MODI_GRADIENT_W
-USE MODI_PINTER
-USE MODI_SHUMAN
-USE MODI_RADTR_SATEL
-USE MODI_UV_TO_ZONAL_AND_MERID
-USE MODI_ZINTER
-
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-!* 0.2 Declarations of local variables
-!
-INTEGER :: IIU,IJU,IKU,IIB,IJB,IKB,IIE,IJE,IKE ! Arrays bounds
-INTEGER :: IKRAD
-!
-INTEGER :: JI,JJ,JK,JSV ! loop index
-!
-! variables for Diagnostic variables related to deep convection
-REAL,DIMENSION(:,:), ALLOCATABLE :: ZWORK21,ZWORK22
-!
-! variables for computation of temperature and height of clouds
-REAL :: ZCLMR ! value of mixing ratio tendency for detection of cloud top
-LOGICAL, DIMENSION(:,:), ALLOCATABLE :: GMASK2
-INTEGER, DIMENSION(:,:), ALLOCATABLE :: IWORK1, IWORK2
-INTEGER, DIMENSION(:,:), ALLOCATABLE :: ICL_HE_ST
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK31,ZTEMP
-!
-! variables needed for the transfer radiatif diagnostic code
-INTEGER :: ITOTGEO
-INTEGER, DIMENSION (JPGEOST) :: INDGEO
-CHARACTER(LEN=8), DIMENSION (JPGEOST) :: YNAM_SAT
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZIRBT, ZWVBT
-REAL :: ZUNDEF ! undefined value in SURFEX
-!
-! variables needed for 10m wind
-INTEGER :: ILEVEL
-!
-INTEGER :: IPRES, ITH
-CHARACTER(LEN=4) :: YCAR4
-CHARACTER(LEN=4), DIMENSION(SIZE(XISOPR)) :: YPRES
-CHARACTER(LEN=4), DIMENSION(SIZE(XISOTH)) :: YTH
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK32,ZWORK33,ZWORK34,ZWRES,ZPRES,ZWTH
-REAL, DIMENSION(:), ALLOCATABLE :: ZTH
-REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZPOVO
-REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZVOX,ZVOY,ZVOZ
-REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZCORIOZ
-TYPE(TFIELDMETADATA) :: TZFIELD
-TYPE(TFIELDMETADATA), DIMENSION(2) :: TZFIELD2
-!
-! variables needed for altitude interpolation
-INTEGER :: IAL
-REAL :: ZFILLVAL
-REAL, DIMENSION(:), ALLOCATABLE :: ZAL
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWAL
-!
-! variables needed for coarse graining
-REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZUT_PRM,ZVT_PRM,ZWT_PRM
-REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZUU_AVG,ZVV_AVG,ZWW_AVG
-INTEGER :: IDX, IID, IRESP
-CHARACTER(LEN=3) :: YDX
-!-------------------------------------------------------------------------------
-!
-!* 0. ARRAYS BOUNDS INITIALIZATION
-!
-IIU=SIZE(XTHT,1)
-IJU=SIZE(XTHT,2)
-IKU=SIZE(XTHT,3)
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IKB=1+JPVEXT
-IKE=IKU-JPVEXT
-!
-ALLOCATE(ZWORK21(IIU,IJU))
-ALLOCATE(ZWORK31(IIU,IJU,IKU))
-ALLOCATE(ZTEMP(IIU,IJU,IKU))
-ZTEMP(:,:,:)=XTHT(:,:,:)*(XPABST(:,:,:)/ XP00) **(XRD/XCPD)
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. DIAGNOSTIC RELATED TO CONVECTION
-! --------------------------------
-!
-!* Diagnostic variables related to deep convection
-!
-IF (NCONV_KF >= 0) THEN
- CALL IO_Field_write(TPFILE,'CAPE',XCAPE)
-!
- ! top height (km) of convective clouds
- ZWORK21(:,:)= 0.
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IF (NCLTOPCONV(JI,JJ)/=0) ZWORK21(JI,JJ)= XZZ(JI,JJ,NCLTOPCONV(JI,JJ))/1.E3
- END DO
- END DO
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'CLTOPCONV', &
- CSTDNAME = 'convective_cloud_top_altitude', &
- CLONGNAME = 'CLTOPCONV', &
- CUNITS = 'km', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Top of Convective Cloud', &
- NGRID = 4, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
-!
- ! base height (km) of convective clouds
- ZWORK21(:,:)= 0.
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IF (NCLBASCONV(JI,JJ)/=0) ZWORK21(JI,JJ)= XZZ(JI,JJ,NCLBASCONV(JI,JJ))/1.E3
- END DO
- END DO
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'CLBASCONV', &
- CSTDNAME = 'convective_cloud_base_altitude', &
- CLONGNAME = 'CLBASCONV', &
- CUNITS = 'km', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Base of Convective Cloud', &
- NGRID = 4, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
-END IF
-
-IF (NCONV_KF >= 1) THEN
- CALL IO_Field_write(TPFILE,'DTHCONV',XDTHCONV)
- CALL IO_Field_write(TPFILE,'DRVCONV',XDRVCONV)
- CALL IO_Field_write(TPFILE,'DRCCONV',XDRCCONV)
- CALL IO_Field_write(TPFILE,'DRICONV',XDRICONV)
-!
- IF ( LCHTRANS .AND. NSV > 0 ) THEN
- ! scalar variables are recorded
- ! individually in the file
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'generic for DSVCONV', & !Temporary name to ease identification
- CUNITS = 's-1', &
- CDIR = 'XY', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
-
- DO JSV = 1, NSV
- TZFIELD%CMNHNAME = 'DSVCONV_' // TRIM( TSVLIST(JSV)%CMNHNAME )
- TZFIELD%CLONGNAME = 'DSVCONV_' // TRIM( TSVLIST(JSV)%CLONGNAME )
- TZFIELD%CCOMMENT = 'Convective tendency for ' // TRIM( TSVLIST(JSV)%CMNHNAME )
- CALL IO_Field_write( TPFILE, TZFIELD, XDSVCONV(:,:,:,JSV) )
- END DO
- END IF
-END IF
-
-IF (NCONV_KF >= 2) THEN
- CALL IO_Field_write(TPFILE,'PRLFLXCONV',XPRLFLXCONV)
- CALL IO_Field_write(TPFILE,'PRSFLXCONV',XPRSFLXCONV)
- CALL IO_Field_write(TPFILE,'UMFCONV', XUMFCONV)
- CALL IO_Field_write(TPFILE,'DMFCONV', XDMFCONV)
-END IF
-!-------------------------------------------------------------------------------
-!
-!* Height and temperature of clouds top
-!
-IF (LCLD_COV .AND. LUSERC) THEN
- ALLOCATE(IWORK1(IIU,IJU),IWORK2(IIU,IJU))
- ALLOCATE(ICL_HE_ST(IIU,IJU))
- ALLOCATE(GMASK2(IIU,IJU))
- ALLOCATE(ZWORK22(IIU,IJU))
-!
-! Explicit clouds
-!
- ICL_HE_ST(:,:)=IKB !initialization
- IWORK1(:,:)=IKB ! with the
- IWORK2(:,:)=IKB ! ground values
- ZCLMR=1.E-4 ! detection of clouds for cloud mixing ratio > .1g/kg
-!
- GMASK2(:,:)=.TRUE.
- ZWORK31(:,:,:)= MZM( XRT(:,:,:,2) ) ! cloud mixing ratio at zz levels
- DO JK=IKE,IKB,-1
- WHERE ( (GMASK2(:,:)).AND.(ZWORK31(:,:,JK)>ZCLMR) )
- GMASK2(:,:)=.FALSE.
- IWORK1(:,:)=JK
- END WHERE
- END DO
-!
- IF (LUSERI) THEN
- GMASK2(:,:)=.TRUE.
- ZWORK31(:,:,:)= MZM( XRT(:,:,:,4) ) ! cloud mixing ratio at zz levels
- DO JK=IKE,IKB,-1
- WHERE ( (GMASK2(:,:)).AND.(ZWORK31(:,:,JK)>ZCLMR) )
- GMASK2(:,:)=.FALSE.
- IWORK2(:,:)=JK
- END WHERE
- END DO
- END IF
-!
- ZWORK21(:,:)=0.
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- ICL_HE_ST(JI,JJ)=MAX(IWORK1(JI,JJ),IWORK2(JI,JJ) )
- ZWORK21(JI,JJ) =XZZ(JI,JJ,ICL_HE_ST(JI,JJ)) ! height (m) of explicit clouds
- END DO
- END DO
-!
- WHERE ( ZWORK21(:,:)==XZZ(:,:,IKB) ) ZWORK21=0. ! set the height to
- ! 0 if there is no cloud
- ZWORK21(:,:)=ZWORK21(:,:)/1.E3 ! height (km) of explicit clouds
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'HECL', &
- CSTDNAME = '', &
- CLONGNAME = 'HECL', &
- CUNITS = 'km', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Height of Explicit CLoud top', &
- NGRID = 4, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
-!
-! Higher top of the different species of clouds
-!
- IWORK1(:,:)=IKB ! initialization with the ground values
- ZWORK31(:,:,:)=MZM(ZTEMP(:,:,:)) ! temperature (K) at zz levels
- IF(CRAD/='NONE') ZWORK31(:,:,IKB)=XTSRAD(:,:)
- ZWORK21(:,:)=0.
- ZWORK22(:,:)=0.
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- IWORK1(JI,JJ)=ICL_HE_ST(JI,JJ)
- IF (NCONV_KF >=0) &
- IWORK1(JI,JJ)= MAX(ICL_HE_ST(JI,JJ),NCLTOPCONV(JI,JJ))
- ZWORK21(JI,JJ)= XZZ(JI,JJ,IWORK1(JI,JJ)) ! max. cloud height (m)
- ZWORK22(JI,JJ)= ZWORK31(JI,JJ,IWORK1(JI,JJ))-XTT ! cloud temperature (C)
- END DO
- END DO
-!
- IF (NCONV_KF <0) THEN
- PRINT*,'YOU DO NOT ASK FOR CONVECTIVE DIAGNOSTICS (NCONV_KF<0), SO'
- PRINT*,' HC not written in FM-file (equal to HEC)'
- ELSE
- WHERE ( ZWORK21(:,:)==XZZ(:,:,IKB) ) ZWORK21(:,:)=0. ! set the height to
- ! 0 if there is no cloud
- ZWORK21(:,:)=ZWORK21(:,:)/1.E3 ! max. cloud height (km)
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'HCL', &
- CSTDNAME = 'cloud_top_altitude', &
- CLONGNAME = 'HCL', &
- CUNITS = 'km', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Height of CLoud top', &
- NGRID = 4, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
- ENDIF
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'TCL', &
- CSTDNAME = 'air_temperature_at_cloud_top', &
- CLONGNAME = 'TCL', &
- CUNITS = 'celsius', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Height of CLoud top', &
- NGRID = 4, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22)
-!
- CALL IO_Field_write(TPFILE,'CLDFR',XCLDFR)
- CALL IO_Field_write(TPFILE,'ICEFR',XICEFR)
-!
-! Visibility
-!
- ZWORK31(:,:,:)= 1.E4 ! 10 km for clear sky
- WHERE (XRT(:,:,:,2) > 0.)
- ZWORK31(:,:,:)=3.9E3/(144.7*(XRHODREF(:,:,:)*1.E3*XRT(:,:,:,2)/(1.+XRT(:,:,:,2)))**0.88)
- END WHERE
-!
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'VISI_HOR', &
- CSTDNAME = 'visibility_in_air', &
- CLONGNAME = 'VISI_HOR', &
- CUNITS = 'm', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_VISI_HOR', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
-!
- DEALLOCATE(IWORK1,IWORK2,ICL_HE_ST,GMASK2,ZWORK22)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. DIAGNOSTIC RELATED TO RADIATIONS
-! --------------------------------
-!
-IF (NRAD_3D >= 0) THEN
- IF (CRAD /= 'NONE') THEN
- CALL IO_Field_write(TPFILE,'DTHRAD', XDTHRAD)
- CALL IO_Field_write(TPFILE,'FLALWD', XFLALWD)
- CALL IO_Field_write(TPFILE,'DIRFLASWD', XDIRFLASWD)
- CALL IO_Field_write(TPFILE,'SCAFLASWD', XSCAFLASWD)
- CALL IO_Field_write(TPFILE,'DIRSRFSWD', XDIRSRFSWD)
- CALL IO_Field_write(TPFILE,'CLEARCOL_TM1',NCLEARCOL_TM1)
- CALL IO_Field_write(TPFILE,'ZENITH', XZENITH)
- CALL IO_Field_write(TPFILE,'AZIM', XAZIM)
- CALL IO_Field_write(TPFILE,'DIR_ALB', XDIR_ALB)
- CALL IO_Field_write(TPFILE,'SCA_ALB', XSCA_ALB)
- !
- CALL PRINT_MSG(NVERB_INFO,'IO','WRITE_LFIFM1_FOR_DIAG_SUPP','EMIS: writing only first band')
- CALL FIND_FIELD_ID_FROM_MNHNAME('EMIS',IID,IRESP)
- TZFIELD = TFIELDMETADATA( TFIELDLIST(IID) )
- TZFIELD%NDIMS = 2
- TZFIELD%NDIMLIST(3) = TZFIELD%NDIMLIST(4)
- TZFIELD%NDIMLIST(4) = NMNHDIM_UNUSED
- CALL IO_Field_write(TPFILE,TZFIELD,XEMIS(:,:,1))
- !
- CALL IO_Field_write(TPFILE,'TSRAD', XTSRAD)
- ELSE
- PRINT*,'YOU WANT DIAGNOSTICS RELATED TO RADIATION'
- PRINT*,' BUT NO RADIATIVE SCHEME WAS ACTIVATED IN THE MODEL'
- END IF
-END IF
-IF (NRAD_3D >= 1) THEN
- IF (LDUST) THEN
-!Dust optical depth between two vertical levels
- ZWORK31(:,:,:)=0.
- DO JK=IKB,IKE
- IKRAD = JK - JPVEXT
- ZWORK31(:,:,JK)= XAER(:,:,IKRAD,3)
- END DO
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'DSTAOD3D', &
- CSTDNAME = '', &
- CLONGNAME = 'DSTAOD3D', &
- CUNITS = 'm', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_DuST Aerosol Optical Depth', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
-!Dust optical depth
- ZWORK21(:,:)=0.0
- DO JK=IKB,IKE
- IKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- ZWORK21(JI,JJ)=ZWORK21(JI,JJ)+XAER(JI,JJ,IKRAD,3)
- ENDDO
- ENDDO
- ENDDO
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'DSTAOD2D', &
- CSTDNAME = '', &
- CLONGNAME = 'DSTAOD2D', &
- CUNITS = 'm', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_DuST Aerosol Optical Depth', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
-!Dust extinction (optical depth per km)
- DO JK=IKB,IKE
- IKRAD = JK - JPVEXT
- ZWORK31(:,:,JK)= XAER(:,:,IKRAD,3)/(XZZ(:,:,JK+1)-XZZ(:,:,JK))*1.D3
- ENDDO
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'DSTEXT', &
- CSTDNAME = '', &
- CLONGNAME = 'DSTEXT', &
- CUNITS = 'km-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_DuST EXTinction', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
- END IF
- IF (LSALT) THEN
-!Salt optical depth between two vertical levels
- ZWORK31(:,:,:)=0.
- DO JK=IKB,IKE
- IKRAD = JK - JPVEXT
- ZWORK31(:,:,JK)= XAER(:,:,IKRAD,2)
- END DO
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'SLTAOD3D', &
- CSTDNAME = '', &
- CLONGNAME = 'SLTAOD3D', &
- CUNITS = 'm', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Salt Aerosol Optical Depth', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
-!Salt optical depth
- ZWORK21(:,:)=0.0
- DO JK=IKB,IKE
- IKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- ZWORK21(JI,JJ)=ZWORK21(JI,JJ)+XAER(JI,JJ,IKRAD,2)
- ENDDO
- ENDDO
- ENDDO
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'SLTAOD2D', &
- CSTDNAME = '', &
- CLONGNAME = 'SLTAOD2D', &
- CUNITS = 'm', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Salt Aerosol Optical Depth', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
-!Salt extinction (optical depth per km)
- DO JK=IKB,IKE
- IKRAD = JK - JPVEXT
- ZWORK31(:,:,JK)= XAER(:,:,IKRAD,2)/(XZZ(:,:,JK+1)-XZZ(:,:,JK))*1.D3
- ENDDO
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'SLTEXT', &
- CSTDNAME = '', &
- CLONGNAME = 'SLTEXT', &
- CUNITS = 'km-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Salt EXTinction', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
- END IF
- IF (LORILAM) THEN
-!Orilam anthropogenic optical depth between two vertical levels
- ZWORK31(:,:,:)=0.
- DO JK=IKB,IKE
- IKRAD = JK - JPVEXT
- ZWORK31(:,:,JK)= XAER(:,:,IKRAD,4)
- END DO
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'AERAOD3D', &
- CSTDNAME = '', &
- CLONGNAME = 'AERAOD3D', &
- CUNITS = 'm', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Anthropogenic Aerosol Optical Depth', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
-!Orilam anthropogenic optical depth
- ZWORK21(:,:)=0.0
- DO JK=IKB,IKE
- IKRAD = JK - JPVEXT
- DO JJ=IJB,IJE
- DO JI=IIB,IIE
- ZWORK21(JI,JJ)=ZWORK21(JI,JJ)+XAER(JI,JJ,IKRAD,4)
- ENDDO
- ENDDO
- ENDDO
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'AERAOD2D', &
- CSTDNAME = '', &
- CLONGNAME = 'AERAOD2D', &
- CUNITS = 'm', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Anthropogenic Aerosol Optical Depth', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
-!Orilam anthropogenic extinction (optical depth per km)
- DO JK=IKB,IKE
- IKRAD = JK - JPVEXT
- ZWORK31(:,:,JK)= XAER(:,:,IKRAD,4)/(XZZ(:,:,JK+1)-XZZ(:,:,JK))*1.D3
- ENDDO
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'AEREXT', &
- CSTDNAME = '', &
- CLONGNAME = 'AEREXT', &
- CUNITS = 'km-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Z_Anthropogenic EXTinction', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
- END IF
-END IF
-!
-!-------------------------------------------------------------------------------
-! Net surface gaseous fluxes
-IF (LCHEMDIAG) THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'generic for net chemical flux', & !Temporary name to ease identification
- CUNITS = 'ppb m s-1', &
- CDIR = 'XY', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- !
- DO JSV = NSV_CHEMBEG, NSV_CHEMEND
- TZFIELD%CMNHNAME = 'FLX_' // TRIM( TSVLIST(JSV)%CMNHNAME )
- TZFIELD%CLONGNAME = 'FLX_' // TRIM( TSVLIST(JSV)%CLONGNAME )
- WRITE(TZFIELD%CCOMMENT,'(A6,A,A)')'X_Y_Z_',TRIM( TSVLIST(JSV)%CMNHNAME ),' Net chemical flux'
- CALL IO_Field_write(TPFILE,TZFIELD,XCHFLX(:,:,JSV-NSV_CHEMBEG+1) * 1E9)
- END DO
-END IF
-!-------------------------------------------------------------------------------
-!
-!* Brightness temperatures from the radiatif transfer code (Morcrette, 1991)
-!
-IF (LEN_TRIM(CRAD_SAT) /= 0 .AND. NRR /=0) THEN
- ALLOCATE (ZIRBT(IIU,IJU),ZWVBT(IIU,IJU))
- ITOTGEO=0
- IF (INDEX(CRAD_SAT,'GOES-E') /= 0) THEN
- ITOTGEO= ITOTGEO+1
- INDGEO(ITOTGEO) = 1
- YNAM_SAT(ITOTGEO) = 'GOES-E'
- END IF
- IF (INDEX(CRAD_SAT,'GOES-W') /= 0) THEN
- ITOTGEO= ITOTGEO+1
- INDGEO(ITOTGEO) = 2
- YNAM_SAT(ITOTGEO) = 'GOES-W'
- END IF
- IF (INDEX(CRAD_SAT,'GMS') /= 0) THEN
- ITOTGEO= ITOTGEO+1
- INDGEO(ITOTGEO) = 3
- YNAM_SAT(ITOTGEO) = 'GMS'
- END IF
- IF (INDEX(CRAD_SAT,'INDSAT') /= 0) THEN
- ITOTGEO= ITOTGEO+1
- INDGEO(ITOTGEO) = 4
- YNAM_SAT(ITOTGEO) = 'INDSAT'
- END IF
- IF (INDEX(CRAD_SAT,'METEOSAT') /= 0) THEN
- ITOTGEO= ITOTGEO+1
- INDGEO(ITOTGEO) = 5
- YNAM_SAT(ITOTGEO) = 'METEOSAT'
- END IF
- PRINT*,'YOU ASK FOR BRIGHTNESS TEMPERATURES FOR ',ITOTGEO,' SATELLITE(S)'
- IF (NRR==1) THEN
- PRINT*,' THERE IS ONLY VAPOR WATER IN YOUR ATMOSPHERE'
- PRINT*,' IRBT WILL NOT TAKE INTO ACCOUNT CLOUDS.'
- END IF
- !
- DO JI=1,ITOTGEO
- ZIRBT(:,:) = XUNDEF
- ZWVBT(:,:) = XUNDEF
- CALL RADTR_SATEL( TDTCUR%nyear, TDTCUR%nmonth, TDTCUR%nday, TDTCUR%xtime, &
- NDLON, NFLEV, NSTATM, NRAD_COLNBR, XEMIS(:,:,1), &
- XCCO2, XTSRAD, XSTATM, XTHT, XRT, XPABST, XZZ, &
- XSIGS, XMFCONV, MAX(XCLDFR,XICEFR), LUSERI, LSIGMAS, &
- LSUBG_COND, LRAD_SUBG_COND, ZIRBT, ZWVBT, &
- INDGEO(JI), VSIGQSAT )
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM(YNAM_SAT(JI))//'_IRBT', &
- CSTDNAME = '', &
- CLONGNAME = TRIM(YNAM_SAT(JI))//'_IRBT', &
- CUNITS = 'K', &
- CDIR = 'XY', &
- CCOMMENT = TRIM(YNAM_SAT(JI))//' Infra-Red Brightness Temperature', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZIRBT)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = TRIM(YNAM_SAT(JI))//'_WVBT', &
- CSTDNAME = '', &
- CLONGNAME = TRIM(YNAM_SAT(JI))//'_WVBT', &
- CUNITS = 'K', &
- CDIR = 'XY', &
- CCOMMENT = TRIM(YNAM_SAT(JI))//' Water-Vapor Brightness Temperature', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWVBT)
- END DO
- DEALLOCATE(ZIRBT,ZWVBT)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* Brightness temperatures from the Radiatif Transfer for Tiros Operational
-! Vertical Sounder (RTTOV) code
-!
-IF (NRTTOVINFO(1,1) /= NUNDEF) THEN
-! PRINT*,'YOU ASK FOR BRIGHTNESS TEMPERATURE COMPUTED BY THE RTTOV CODE'
-#if defined(MNH_RTTOV_8)
- CALL CALL_RTTOV8(NDLON, NFLEV, NSTATM, XEMIS(:,:,1), XTSRAD, XSTATM, XTHT, XRT, &
- XPABST, XZZ, XMFCONV, MAX(XCLDFR,XICEFR), XUT(:,:,IKB), XVT(:,:,IKB), &
- LUSERI, NRTTOVINFO, TPFILE )
-#elif defined(MNH_RTTOV_11)
- CALL CALL_RTTOV11(NDLON, NFLEV, XEMIS(:,:,1), XTSRAD, XTHT, XRT, &
- XPABST, XZZ, XMFCONV, MAX(XCLDFR,XICEFR), XUT(:,:,IKB), XVT(:,:,IKB), &
- LUSERI, NRTTOVINFO, TPFILE )
-#elif defined(MNH_RTTOV_13)
- CALL CALL_RTTOV13(NDLON, NFLEV, XEMIS(:,:,1), XTSRAD, XTHT, XRT, &
- XPABST, XZZ, XMFCONV, MAX(XCLDFR,XICEFR), XUT(:,:,IKB), XVT(:,:,IKB), &
- LUSERI, NRTTOVINFO, TPFILE )
-#else
-PRINT *, "RTTOV LIBRARY NOT AVAILABLE = ###CALL_RTTOV####"
-#endif
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. DIAGNOSTIC RELATED TO SURFACE
-! -----------------------------
-!
-IF (CSURF=='EXTE') THEN
-!! Since SURFEX7 (masdev49) XCURRENT_ZON10M and XCURRENT_MER10M
-!! are equal to XUNDEF of SURFEX if the first atmospheric level
-!! is under 10m
- CALL GET_SURF_UNDEF(ZUNDEF)
-!
- ILEVEL=IKB
- !While there are XUNDEF values and we aren't at model's top
- DO WHILE(ANY(XCURRENT_ZON10M(IIB:IIE,IJB:IJE)==ZUNDEF) .AND. (ILEVEL/=IKE-1) )
-
- !Where interpolation is needed and possible
- !(10m is between ILEVEL and ILEVEL+1 or 10m is below the bottom level)
- WHERE(XCURRENT_ZON10M(IIB:IIE,IJB:IJE)==ZUNDEF .AND. &
- ( XZHAT(ILEVEL+1) + XZHAT(ILEVEL+2)) /2. >10.)
-
- !Interpolation between ILEVEL and ILEVEL+1
- XCURRENT_ZON10M(IIB:IIE,IJB:IJE)=XUT(IIB:IIE,IJB:IJE,ILEVEL) + &
- (XUT(IIB:IIE,IJB:IJE,ILEVEL+1)-XUT(IIB:IIE,IJB:IJE,ILEVEL)) * &
- ( 10.- (XZHAT(ILEVEL)+XZHAT(ILEVEL+1))/2. ) / &
- ( (XZHAT(ILEVEL+2)-XZHAT(ILEVEL)) /2.)
- XCURRENT_MER10M(IIB:IIE,IJB:IJE)=XVT(IIB:IIE,IJB:IJE,ILEVEL) + &
- (XVT(IIB:IIE,IJB:IJE,ILEVEL+1)-XVT(IIB:IIE,IJB:IJE,ILEVEL)) * &
- (10.- (XZHAT(ILEVEL)+XZHAT(ILEVEL+1))/2. ) / &
- ( (XZHAT(ILEVEL+2)-XZHAT(ILEVEL)) /2.)
- END WHERE
- ILEVEL=ILEVEL+1 !level just higher
- END DO
- !
- ! in this case (argument KGRID=0), input winds are ZONal and MERidian
- ! and, output ones are in MesoNH grid
- IF (.NOT. LCARTESIAN) THEN
- TZFIELD2(1) = TFIELDMETADATA( &
- CMNHNAME = 'UM10', &
- CSTDNAME = '', &
- CLONGNAME = 'UM10', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'Zonal wind at 10m', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- !
- TZFIELD2(2) = TFIELDMETADATA( &
- CMNHNAME = 'VM10', &
- CSTDNAME = '', &
- CLONGNAME = 'VM10', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'Meridian wind at 10m', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- !
- CALL UV_TO_ZONAL_AND_MERID(XCURRENT_ZON10M,XCURRENT_MER10M,KGRID=0,TPFILE=TPFILE,TZFIELDS=TZFIELD2)
- ELSE
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'UM10', &
- CSTDNAME = '', &
- CLONGNAME = 'UM10', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'Zonal wind at 10m', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,XCURRENT_ZON10M)
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'VM10', &
- CSTDNAME = '', &
- CLONGNAME = 'VM10', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'Meridian wind at 10m', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,XCURRENT_MER10M)
- ENDIF
- !
- IF (SIZE(XTKET)>0) THEN
- ZWORK21(:,:) = SQRT(XCURRENT_ZON10M(:,:)**2+XCURRENT_MER10M(:,:)**2)
- ZWORK21(:,:) = ZWORK21(:,:) + 4. * SQRT(XTKET(:,:,IKB))
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'FF10MAX', &
- CSTDNAME = '', &
- CLONGNAME = 'FF10MAX', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_FF10MAX', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21)
- END IF
- !
- IF(ANY(XCURRENT_SFCO2/=XUNDEF))THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'SFCO2', &
- CSTDNAME = '', &
- CLONGNAME = 'SFCO2', &
- CUNITS = 'mg m-2 s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'CO2 Surface flux', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,XCURRENT_SFCO2)
- END IF
- !
- IF(ANY(XCURRENT_SWD/=XUNDEF))THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'SWD', &
- CSTDNAME = '', &
- CLONGNAME = 'SWD', &
- CUNITS = 'W m-2', &
- CDIR = 'XY', &
- CCOMMENT = 'incoming ShortWave at the surface', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,XCURRENT_SWD)
- END IF
- !
- IF(ANY(XCURRENT_SWU/=XUNDEF))THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'SWU', &
- CSTDNAME = '', &
- CLONGNAME = 'SWU', &
- CUNITS = 'W m-2', &
- CDIR = 'XY', &
- CCOMMENT = 'outcoming ShortWave at the surface', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,XCURRENT_SWU)
- END IF
-!
- IF(ANY(XCURRENT_LWD/=XUNDEF))THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'LWD', &
- CSTDNAME = '', &
- CLONGNAME = 'LWD', &
- CUNITS = 'W m-2', &
- CDIR = 'XY', &
- CCOMMENT = 'incoming LongWave at the surface', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,XCURRENT_LWD)
- END IF
-!
- IF(ANY(XCURRENT_LWU/=XUNDEF))THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'LWU', &
- CSTDNAME = '', &
- CLONGNAME = 'LWU', &
- CUNITS = 'W m-2', &
- CDIR = 'XY', &
- CCOMMENT = 'outcoming LongWave at the surface', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,XCURRENT_LWU)
- END IF
-END IF
-
-! MODIF FP NOV 2012
-!-------------------------------------------------------------------------------
-!
-!* 4. DIAGNOSTIC ON PRESSURE LEVELS
-! -----------------------------
-!
-IF (LISOPR .AND. XISOPR(1)/=0.) THEN
-!
-!
-ALLOCATE(ZWORK32(IIU,IJU,IKU))
-ALLOCATE(ZWORK33(IIU,IJU,IKU))
-ALLOCATE(ZWORK34(IIU,IJU,IKU))
-!
-! *************************************************
-! Determine the pressure level where to interpolate
-! *************************************************
- IPRES=0
- DO JI=1,SIZE(XISOPR)
- IF (XISOPR(JI)<=10..OR.XISOPR(JI)>1000.) EXIT
- IPRES=IPRES+1
- WRITE(YCAR4,'(I4)') INT(XISOPR(JI))
- YPRES(IPRES)=ADJUSTL(YCAR4)
- END DO
-
- ALLOCATE(ZWRES(IIU,IJU,IPRES))
- ZWRES(:,:,:)=XUNDEF
- ALLOCATE(ZPRES(IIU,IJU,IPRES))
- IPRES=0
- DO JI=1,SIZE(XISOPR)
- IF (XISOPR(JI)<=10..OR.XISOPR(JI)>1000.) EXIT
- IPRES=IPRES+1
- ZPRES(:,:,IPRES)=XISOPR(JI)*100.
- END DO
- PRINT *,'PRESSURE LEVELS WHERE TO INTERPOLATE=',ZPRES(1,1,:)
- !
- TZFIELD = TFIELDMETADATA(&
- CMNHNAME = 'variables at pressure levels', & !Temporary name to ease identification
- CSTDNAME = '', &
- CDIR = 'XY', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- !
-!
-!* Standard Variables
-!
-! *********************
-! Potential Temperature
-! *********************
- CALL PINTER(XTHT, XPABST, XZZ, ZTEMP, ZWRES, ZPRES, &
- IIU, IJU, IKU, IKB, IPRES, 'LOG', 'RHU.')
- DO JK=1,IPRES
- TZFIELD%CMNHNAME = 'THT'//TRIM(YPRES(JK))//'HPA'
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'K'
- TZFIELD%CCOMMENT = 'X_Y_potential temperature '//TRIM(YPRES(JK))//' hPa'
- CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
- END DO
-! *********************
-! Wind
-! *********************
- ZWORK31(:,:,:) = MXF(XUT(:,:,:))
- CALL PINTER(ZWORK31, XPABST, XZZ, ZTEMP, ZWRES, ZPRES, &
- IIU, IJU, IKU, IKB, IPRES, 'LOG', 'RHU.')
- DO JK=1,IPRES
- TZFIELD%CMNHNAME = 'UT'//TRIM(YPRES(JK))//'HPA'
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'm s-1'
- TZFIELD%CCOMMENT = 'X_Y_U component of wind '//TRIM(YPRES(JK))//' hPa'
- CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
- END DO
- !
- ZWORK31(:,:,:) = MYF(XVT(:,:,:))
- CALL PINTER(ZWORK31, XPABST, XZZ, ZTEMP, ZWRES, ZPRES, &
- IIU, IJU, IKU, IKB, IPRES, 'LOG', 'RHU.')
- DO JK=1,IPRES
- TZFIELD%CMNHNAME = 'VT'//TRIM(YPRES(JK))//'HPA'
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'm s-1'
- TZFIELD%CCOMMENT = 'X_Y_V component of wind '//TRIM(YPRES(JK))//' hPa'
- CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
- END DO
-! *********************
-! Water Vapour Mixing Ratio
-! *********************
- CALL PINTER(XRT(:,:,:,1), XPABST, XZZ, ZTEMP, ZWRES, ZPRES, &
- IIU, IJU, IKU, IKB, IPRES, 'LOG', 'RHU.')
- DO JK=1,IPRES
- TZFIELD%CMNHNAME = 'MRV'//TRIM(YPRES(JK))//'HPA'
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'g kg-1'
- TZFIELD%CCOMMENT = 'X_Y_Vapor Mixing Ratio '//TRIM(YPRES(JK))//' hPa'
- CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK)*1.E3)
- END DO
-! *********************
-! Geopotential in meters
-! *********************
- ZWORK31(:,:,:) = MZF(XZZ(:,:,:))
- CALL PINTER(ZWORK31, XPABST, XZZ, ZTEMP, ZWRES, ZPRES, &
- IIU, IJU, IKU, IKB, IPRES, 'LOG', 'RHU.')
- DO JK=1,IPRES
- TZFIELD%CMNHNAME = 'ALT'//TRIM(YPRES(JK))//'HPA'
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'm'
- TZFIELD%CCOMMENT = 'X_Y_ALTitude '//TRIM(YPRES(JK))//' hPa'
- CALL IO_Field_write(TPFILE,TZFIELD,ZWRES(:,:,JK))
- END DO
-!
- DEALLOCATE(ZWRES,ZPRES,ZWORK32,ZWORK33,ZWORK34)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 5. DIAGNOSTIC ON POTENTIEL TEMPERATURE LEVELS
-! -----------------------------
-!
-IF (LISOTH .AND.XISOTH(1)/=0.) THEN
-!
-!
-ALLOCATE(ZWORK32(IIU,IJU,IKU))
-ALLOCATE(ZWORK33(IIU,IJU,IKU))
-ALLOCATE(ZWORK34(IIU,IJU,IKU))
-!
-! *************************************************
-! Determine the potentiel temperature level where to interpolate
-! *************************************************
- ITH=0
- DO JI=1,SIZE(XISOTH)
- IF (XISOTH(JI)<=100..OR.XISOTH(JI)>1000.) EXIT
- ITH=ITH+1
- WRITE(YCAR4,'(I4)') INT(XISOTH(JI))
- YTH(ITH)=ADJUSTL(YCAR4)
- END DO
-
- ALLOCATE(ZWTH(IIU,IJU,ITH))
- ZWTH(:,:,:)=XUNDEF
- ALLOCATE(ZTH(ITH))
- ZTH(:) = XISOTH(1:ITH)
-
- PRINT *,'POTENTIAL TEMPERATURE LEVELS WHERE TO INTERPOLATE=',ZTH(:)
- !
- TZFIELD = TFIELDMETADATA(&
- CMNHNAME = 'variables at pot. temp. levels', & !Temporary name to ease identification
- CSTDNAME = '', &
- CDIR = 'XY', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 2, &
- LTIMEDEP = .TRUE. )
- !
-!
-!* Standard Variables
-!
-! *********************
-! Pressure
-! *********************
- CALL ZINTER(XPABST, XTHT, ZWTH, ZTH, IIU, IJU, IKU, IKB, ITH, XUNDEF)
- DO JK=1,ITH
- TZFIELD%CMNHNAME = 'PABST'//TRIM(YTH(JK))//'K'
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'Pa'
- TZFIELD%CCOMMENT = 'X_Y_pressure '//TRIM(YTH(JK))//' K'
- CALL IO_Field_write(TPFILE,TZFIELD,ZWTH(:,:,JK))
- END DO
-! *********************
-! Potential Vorticity
-! *********************
- ZCORIOZ(:,:,:)=SPREAD( XCORIOZ(:,:),DIM=3,NCOPIES=IKU )
- ZVOX(:,:,:)=GY_W_VW(XWT,XDYY,XDZZ,XDZY)-GZ_V_VW(XVT,XDZZ)
- ZVOX(:,:,2)=ZVOX(:,:,3)
- ZVOY(:,:,:)=GZ_U_UW(XUT,XDZZ)-GX_W_UW(XWT,XDXX,XDZZ,XDZX)
- ZVOY(:,:,2)=ZVOY(:,:,3)
- ZVOZ(:,:,:)=GX_V_UV(XVT,XDXX,XDZZ,XDZX)-GY_U_UV(XUT,XDYY,XDZZ,XDZY)
- ZVOZ(:,:,2)=ZVOZ(:,:,3)
- ZVOZ(:,:,1)=ZVOZ(:,:,3)
- ZWORK31(:,:,:)=GX_M_M(XTHT,XDXX,XDZZ,XDZX)
- ZWORK32(:,:,:)=GY_M_M(XTHT,XDYY,XDZZ,XDZY)
- ZWORK33(:,:,:)=GZ_M_M(XTHT,XDZZ)
- ZPOVO(:,:,:)= ZWORK31(:,:,:)*MZF(MYF(ZVOX(:,:,:))) &
- + ZWORK32(:,:,:)*MZF(MXF(ZVOY(:,:,:))) &
- + ZWORK33(:,:,:)*(MYF(MXF(ZVOZ(:,:,:))) + ZCORIOZ(:,:,:))
- ZPOVO(:,:,:)= ZPOVO(:,:,:)*1E6/XRHODREF(:,:,:)
- ZPOVO(:,:,1) =-1.E+11
- ZPOVO(:,:,IKU)=-1.E+11
- CALL ZINTER(ZPOVO, XTHT, ZWTH, ZTH, IIU, IJU, IKU, IKB, ITH, XUNDEF)
- DO JK=1,ITH
- TZFIELD%CMNHNAME = 'POVOT'//TRIM(YTH(JK))//'K'
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'PVU'
- TZFIELD%CCOMMENT = 'X_Y_POtential VOrticity '//TRIM(YTH(JK))//' K'
- CALL IO_Field_write(TPFILE,TZFIELD,ZWTH(:,:,JK))
- END DO
-! *********************
-! Wind
-! *********************
- ZWORK31(:,:,:) = MXF(XUT(:,:,:))
- CALL ZINTER(ZWORK31, XTHT, ZWTH, ZTH, IIU, IJU, IKU, IKB, ITH, XUNDEF)
- DO JK=1,ITH
- TZFIELD%CMNHNAME = 'UT'//TRIM(YTH(JK))//'K'
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'm s-1'
- TZFIELD%CCOMMENT = 'X_Y_U component of wind '//TRIM(YTH(JK))//' K'
- CALL IO_Field_write(TPFILE,TZFIELD,ZWTH(:,:,JK))
- END DO
- !
- ZWORK31(:,:,:) = MYF(XVT(:,:,:))
- CALL ZINTER(ZWORK31, XTHT, ZWTH, ZTH, IIU, IJU, IKU, IKB, ITH, XUNDEF)
- DO JK=1,ITH
- TZFIELD%CMNHNAME = 'VT'//TRIM(YTH(JK))//'K'
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = 'm s-1'
- TZFIELD%CCOMMENT = 'X_Y_V component of wind '//TRIM(YTH(JK))//' K'
- CALL IO_Field_write(TPFILE,TZFIELD,ZWTH(:,:,JK))
- END DO
-!
- DEALLOCATE(ZWTH,ZTH,ZWORK32,ZWORK33,ZWORK34)
-END IF
-!-------------------------------------------------------------------------------
-!
-!* 6. DIAGNOSTIC ON ALTITUDE LEVELS
-! -----------------------------
-!
-IF (LISOAL .AND.XISOAL(1)/=0.) THEN
-!
-!
- ZFILLVAL = -99999.
- ALLOCATE(ZWORK32(IIU,IJU,IKU))
- ALLOCATE(ZWORK33(IIU,IJU,IKU))
-!
-! *************************************************
-! Determine the altitude level where to interpolate
-! *************************************************
- IAL=0
- DO JI=1,SIZE(XISOAL)
- IF (XISOAL(JI)<0.) EXIT
- IAL=IAL+1
- END DO
- ALLOCATE(ZWAL(IIU,IJU,IAL))
- ZWAL(:,:,:)=XUNDEF
- ALLOCATE(ZAL(IAL))
- ZAL(:) = XISOAL(1:IAL)
- PRINT *,'ALTITUDE LEVELS WHERE TO INTERPOLATE=',ZAL(:)
-! *********************
-! Altitude
-! *********************
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'ALT_ALT', &
- CSTDNAME = '', &
- CLONGNAME = 'ALT_ALT', &
- CUNITS = 'm', &
- CDIR = '--', &
- CCOMMENT = 'Z_alt ALT', &
- NGRID = 0, &
- NTYPE = TYPEREAL, &
- NDIMS = 1, &
- LTIMEDEP = .FALSE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZAL)
-!
-!* Standard Variables
-!
-! *********************
-! Cloud
-! *********************
- ZWORK31(:,:,:) = 0.
- IF (SIZE(XRT,4) >= 2) ZWORK31(:,:,:) = XRT(:,:,:,2) ! Rc
- IF (SIZE(XRT,4) >= 4) ZWORK31(:,:,:) = ZWORK31(:,:,:) + XRT(:,:,:,4) !Ri
- ZWORK31(:,:,:) = ZWORK31(:,:,:)*1.E3
- CALL ZINTER(ZWORK31, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
- WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'ALT_CLOUD', &
- CSTDNAME = '', &
- CLONGNAME = 'ALT_CLOUD', &
- CUNITS = 'g kg-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_cloud ALT', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
-! *********************
-! Precipitation
-! *********************
- ZWORK31(:,:,:) = 0.
- IF (SIZE(XRT,4) >= 3) ZWORK31(:,:,:) = XRT(:,:,:,3) ! Rr
- IF (SIZE(XRT,4) >= 5) ZWORK31(:,:,:) = ZWORK31(:,:,:) + XRT(:,:,:,5) !Rsnow
- IF (SIZE(XRT,4) >= 6) ZWORK31(:,:,:) = ZWORK31(:,:,:) + XRT(:,:,:,6) !Rgraupel
- IF (SIZE(XRT,4) >= 7) ZWORK31(:,:,:) = ZWORK31(:,:,:) + XRT(:,:,:,7) !Rhail
- ZWORK31(:,:,:) = ZWORK31(:,:,:)*1.E3
- CALL ZINTER(ZWORK31, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
- WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'ALT_PRECIP', &
- CSTDNAME = '', &
- CLONGNAME = 'ALT_PRECIP', &
- CUNITS = 'g kg-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_precipitation ALT', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
-! *********************
-! Potential temperature
-! *********************
- CALL ZINTER(XTHT, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
- WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'ALT_THETA', &
- CSTDNAME = '', &
- CLONGNAME = 'ALT_THETA', &
- CUNITS = 'K', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_potential temperature ALT', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
-! *********************
-! Pressure
-! *********************
- CALL ZINTER(XPABST, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
- WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'ALT_PRESSURE', &
- CSTDNAME = '', &
- CLONGNAME = 'ALT_PRESSURE', &
- CUNITS = 'Pa', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_pressure ALT', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
-! *********************
-! Potential Vorticity
-! *********************
- ZCORIOZ(:,:,:)=SPREAD( XCORIOZ(:,:),DIM=3,NCOPIES=IKU )
- ZVOX(:,:,:)=GY_W_VW(XWT,XDYY,XDZZ,XDZY)-GZ_V_VW(XVT,XDZZ)
- ZVOX(:,:,2)=ZVOX(:,:,3)
- ZVOY(:,:,:)=GZ_U_UW(XUT,XDZZ)-GX_W_UW(XWT,XDXX,XDZZ,XDZX)
- ZVOY(:,:,2)=ZVOY(:,:,3)
- ZVOZ(:,:,:)=GX_V_UV(XVT,XDXX,XDZZ,XDZX)-GY_U_UV(XUT,XDYY,XDZZ,XDZY)
- ZVOZ(:,:,2)=ZVOZ(:,:,3)
- ZVOZ(:,:,1)=ZVOZ(:,:,3)
- ZWORK31(:,:,:)=GX_M_M(XTHT,XDXX,XDZZ,XDZX)
- ZWORK32(:,:,:)=GY_M_M(XTHT,XDYY,XDZZ,XDZY)
- ZWORK33(:,:,:)=GZ_M_M(XTHT,XDZZ)
- ZPOVO(:,:,:)= ZWORK31(:,:,:)*MZF(MYF(ZVOX(:,:,:))) &
- + ZWORK32(:,:,:)*MZF(MXF(ZVOY(:,:,:))) &
- + ZWORK33(:,:,:)*(MYF(MXF(ZVOZ(:,:,:))) + ZCORIOZ(:,:,:))
- ZPOVO(:,:,:)= ZPOVO(:,:,:)*1E6/XRHODREF(:,:,:)
- ZPOVO(:,:,1) =-1.E+11
- ZPOVO(:,:,IKU)=-1.E+11
- CALL ZINTER(ZPOVO, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
- WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'ALT_PV', &
- CSTDNAME = '', &
- CLONGNAME = 'ALT_PV', &
- CUNITS = 'PVU', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_Potential Vorticity ALT', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
-! *********************
-! Wind
-! *********************
- ZWORK31(:,:,:) = MXF(XUT(:,:,:))
- CALL ZINTER(ZWORK31, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
- WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'ALT_U', &
- CSTDNAME = '', &
- CLONGNAME = 'ALT_U', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_U component of wind ALT', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
- !
- ZWORK31(:,:,:) = MYF(XVT(:,:,:))
- CALL ZINTER(ZWORK31, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
- WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'ALT_V', &
- CSTDNAME = '', &
- CLONGNAME = 'ALT_V', &
- CUNITS = 'm s-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_V component of wind ALT', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
-! *********************
-! Dust extinction (optical depth per km)
-! *********************
- IF (NRAD_3D >= 1.AND.LDUST) THEN
- DO JK=IKB,IKE
- IKRAD = JK - JPVEXT
- ZWORK31(:,:,JK)= XAER(:,:,IKRAD,3)/(XZZ(:,:,JK+1)-XZZ(:,:,JK))*1.D3
- ENDDO
- CALL ZINTER(ZWORK31, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
- WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'ALT_DSTEXT', &
- CSTDNAME = '', &
- CLONGNAME = 'ALT_DSTEXT', &
- CUNITS = 'km-1', &
- CDIR = 'XY', &
- CCOMMENT = 'X_Y_DuST EXTinction ALT', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- NDIMLIST = [ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NOTLISTED ], &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
- END IF
-!
-! *********************
- DEALLOCATE(ZWAL,ZAL,ZWORK32,ZWORK33)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 7. COARSE GRAINING DIAGNOSTIC
-! --------------------------
-!
-IF (LCOARSE) THEN
- IDX = NDXCOARSE
-!-------------------------------
-! AVERAGE OF TKE BY BLOCK OF IDX POINTS
- CALL BLOCKAVG(XUT,IDX,IDX,ZWORK31)
- ZUT_PRM=XUT-ZWORK31
- CALL BLOCKAVG(XVT,IDX,IDX,ZWORK31)
- ZVT_PRM=XVT-ZWORK31
- CALL BLOCKAVG(XWT,IDX,IDX,ZWORK31)
- ZWT_PRM=XWT-ZWORK31
-!
- ZWORK31=MXF(ZUT_PRM*ZUT_PRM)
- CALL BLOCKAVG(ZWORK31,IDX,IDX,ZUU_AVG)
- ZWORK31=MYF(ZVT_PRM*ZVT_PRM)
- CALL BLOCKAVG(ZWORK31,IDX,IDX,ZVV_AVG)
- ZWORK31=MZF(ZWT_PRM*ZWT_PRM)
- CALL BLOCKAVG(ZWORK31,IDX,IDX,ZWW_AVG)
- CALL BLOCKAVG(XTKET,IDX,IDX,ZWORK31)
- ZWORK31=0.5*( ZUU_AVG+ZVV_AVG+ZWW_AVG ) + ZWORK31
- WRITE (YDX,FMT='(I3.3)') IDX
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'TKEBAVG'//YDX, &
- CSTDNAME = '', &
- CLONGNAME = 'TKEBAVG'//YDX, &
- CUNITS = 'm2 s-2', &
- CDIR = 'XY', &
- CCOMMENT = 'TKE_BLOCKAVG'//YDX, &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
-!---------------------------------
-! MOVING AVERAGE OF TKE OVER IDX+1 POINTS
- IDX = IDX/2
- CALL MOVINGAVG(XUT,IDX,IDX,ZWORK31)
- ZUT_PRM=XUT-ZWORK31
- CALL MOVINGAVG(XVT,IDX,IDX,ZWORK31)
- ZVT_PRM=XVT-ZWORK31
- CALL MOVINGAVG(XWT,IDX,IDX,ZWORK31)
- ZWT_PRM=XWT-ZWORK31
-!
- ZWORK31=MXF(ZUT_PRM*ZUT_PRM)
- CALL MOVINGAVG(ZWORK31,IDX,IDX,ZUU_AVG)
- ZWORK31=MYF(ZVT_PRM*ZVT_PRM)
- CALL MOVINGAVG(ZWORK31,IDX,IDX,ZVV_AVG)
- ZWORK31=MZF(ZWT_PRM*ZWT_PRM)
- CALL MOVINGAVG(ZWORK31,IDX,IDX,ZWW_AVG)
- CALL MOVINGAVG(XTKET,IDX,IDX,ZWORK31)
- ZWORK31=0.5*( ZUU_AVG+ZVV_AVG+ZWW_AVG ) + ZWORK31
- WRITE (YDX,FMT='(I3.3)') 2*IDX+1
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'TKEMAVG'//YDX, &
- CSTDNAME = '', &
- CLONGNAME = 'TKEMAVG'//YDX, &
- CUNITS = 'm2 s-2', &
- CDIR = 'XY', &
- CCOMMENT = 'TKE_MOVINGAVG'//YDX, &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 8. DIAGNOSTIC RELATED TO CHEMISTRY
-! -------------------------------
-!
-IF (NEQ_BUDGET>0) THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'generic for CNAMES_BUDGET', & !Temporary name to ease identification
- CSTDNAME = '', &
- CUNITS = 'ppv s-1', &
- CDIR = 'XY', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 4, &
- LTIMEDEP = .TRUE. )
- !
- DO JSV = 1, NEQ_BUDGET
- TZFIELD%CMNHNAME = TRIM(CNAMES_BUDGET(JSV))//'_BUDGET'
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(CNAMES_BUDGET(JSV))//'_BUDGET'
- CALL IO_Field_write(TPFILE,TZFIELD,XTCHEM(JSV)%XB_REAC(:,:,:,:))
- END DO
- !
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'generic for reaction list', & !Temporary name to ease identification
- CSTDNAME = '', &
- CUNITS = '', &
- CDIR = 'XY', &
- NGRID = 1, &
- NTYPE = TYPEINT, &
- NDIMS = 1, &
- LTIMEDEP = .TRUE. )
- !
- DO JSV=1, NEQ_BUDGET
- TZFIELD%CMNHNAME = TRIM(CNAMES_BUDGET(JSV))//'_CHREACLIST'
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CCOMMENT = TRIM(CNAMES_BUDGET(JSV))//'_REACTION_LIST'
- CALL IO_Field_write(TPFILE,TZFIELD,XTCHEM(JSV)%NB_REAC(:))
- END DO
-END IF
-!
-!
-! chemical prod/loss terms
-IF (NEQ_PLT>0) THEN
- TZFIELD = TFIELDMETADATA( &
- CMNHNAME = 'generic for CNAMES_PRODLOSST', & !Temporary name to ease identification
- CSTDNAME = '', &
- CUNITS = 'ppv s-1', &
- CDIR = 'XY', &
- NGRID = 1, &
- NTYPE = TYPEREAL, &
- NDIMS = 3, &
- LTIMEDEP = .TRUE. )
- !
- DO JSV = 1, NEQ_PLT
- TZFIELD%CMNHNAME = TRIM(CNAMES_PRODLOSST(JSV))//'_PROD'
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(CNAMES_PRODLOSST(JSV))//'_PROD'
- CALL IO_Field_write(TPFILE,TZFIELD,XPROD(:,:,:,JSV))
- !
- TZFIELD%CMNHNAME = TRIM(CNAMES_PRODLOSST(JSV))//'_LOSS'
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(CNAMES_PRODLOSST(JSV))//'_LOSS'
- CALL IO_Field_write(TPFILE,TZFIELD,XLOSS(:,:,:,JSV))
- END DO
-END IF
-!
-!
-DEALLOCATE(ZWORK21,ZWORK31,ZTEMP)
-!
-END SUBROUTINE WRITE_LFIFM1_FOR_DIAG_SUPP
diff --git a/src/mesonh/ext/xy_to_latlon.f90 b/src/mesonh/ext/xy_to_latlon.f90
deleted file mode 100644
index 45a379940c45a11e46943cc0cd61895fb3ec97f6..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/xy_to_latlon.f90
+++ /dev/null
@@ -1,203 +0,0 @@
-!MNH_LIC Copyright 1996-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.
-!-----------------------------------------------------------------
-! ####################
- PROGRAM XY_TO_LATLON
-! ####################
-!
-!!**** *XY_TO_LATLON* program to compute latitude and longiude from x and y
-!! for a MESONH file
-!!
-!! PURPOSE
-!! -------
-!!
-!! METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! module MODE_GRIDPROJ : contains projection routines
-!! SM_LATLON and SM_XYHAT
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! module MODD_GRID : variables for projection:
-!! XLAT0,XLON0,XRPK,XBETA
-!!
-!! module MODD_PGDDIM : specify the dimentions of the data arrays:
-!! NPGDIMAX and NPGDJMAX
-!!
-!! module MODD_PGDGRID : grid variables:
-!! XPGDLONOR,XPGDLATOR: longitude and latitude of the
-!! origine point for the conformal projection.
-!! XPGDXHAT,XPGDYHAT: position x,y in the conformal plane
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! V. Masson Meteo-France
-!!
-!! MODIFICATION
-!! ------------
-!!
-!! Original 26/01/96
-!!
-!! no transfer of the file when closing Dec. 09, 1996 (V.Masson)
-!! + changes call to READ_HGRID
-! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
-! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-! P. Wautelet 14/04/2020: add missing initializations (XY_TO_LATLON was not working)
-!----------------------------------------------------------------------------
-!
-!* 0. DECLARATION
-! -----------
-!
-use MODD_CONF, only: CPROGRAM
-USE MODD_DIM_n
-USE MODD_GRID
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PGDDIM
-USE MODD_PGDGRID
-USE MODD_PARAMETERS
-USE MODD_LUNIT
-!
-USE MODE_FIELD, ONLY: INI_FIELD_LIST
-USE MODE_GRIDPROJ
-USE MODE_IO, only: IO_Config_set, IO_Init
-use MODE_IO_FIELD_READ, only: IO_Field_read
-USE MODE_IO_FILE, only: IO_File_close, IO_File_open
-USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
-USE MODE_MODELN_HANDLER, ONLY: GOTO_MODEL
-use MODE_SPLITTINGZ_ll
-!
-USE MODE_INI_CST, ONLY: INI_CST
-USE MODI_READ_HGRID
-!
-USE MODN_CONFIO, ONLY: NAM_CONFIO
-!
-IMPLICIT NONE
-!
-!* 0.2 Declaration of variables
-! ------------------------
-!
-CHARACTER(LEN=28) :: YINIFILE ! name of input FM file
-CHARACTER(LEN=28) :: YNAME ! true name of input FM file
-CHARACTER(LEN=28) :: YDAD ! name of dad of input FM file
-CHARACTER(LEN=2) :: YSTORAGE_TYPE
-INTEGER :: INAM ! Logical unit for namelist file
-INTEGER :: ILUOUT0 ! Logical unit for output file.
-INTEGER :: IRESP ! Return-code if problem eraised.
-REAL :: ZI,ZJ ! input positions of the point
-INTEGER :: II,IJ ! integer positions of the point
-REAL :: ZXHAT ! output conformal coodinate x
-REAL :: ZYHAT ! output conformal coodinate y
-REAL :: ZLAT ! output latitude
-REAL :: ZLON ! output longitude
-TYPE(TFILEDATA),POINTER :: TZINIFILE => NULL()
-TYPE(TFILEDATA),POINTER :: TZNMLFILE => NULL()
-!
-!* 0.3 Declaration of namelists
-! ------------------------
-!
-NAMELIST/NAM_INIFILE/ YINIFILE
-!----------------------------------------------------------------------------
-!
- WRITE(*,*) '+---------------------------------+'
- WRITE(*,*) '| program xy_to_latlon |'
- WRITE(*,*) '+---------------------------------+'
- WRITE(*,*) ''
- WRITE(*,*) 'Warning: I and J are integer for flux points'
-!
-!* 1. Initializations
-! ---------------
-!
-CALL GOTO_MODEL(1)
-!
-CALL VERSION()
-!
-CPROGRAM='LAT2XY'
-!
-CALL IO_Init()
-!
-CALL INI_CST()
-!
-CALL INI_FIELD_LIST()
-!
-!* 2. Reading of namelist file
-! ------------------------
-!
-CALL IO_File_add2list(TZNMLFILE,'XY2LATLON1.nam','NML','READ')
-CALL IO_File_open(TZNMLFILE)
-INAM=TZNMLFILE%NLU
-READ(INAM,NAM_INIFILE)
-!
-READ(INAM,NAM_CONFIO)
-CALL IO_Config_set()
-CALL IO_File_close(TZNMLFILE)
-!
-!* 1. Opening of MESONH file
-! ----------------------
-!
-CALL IO_File_add2list(TZINIFILE,TRIM(YINIFILE),'MNH','READ',KLFITYPE=2,KLFIVERB=2)
-CALL IO_File_open(TZINIFILE)
-!
-CALL IO_Field_read(TZINIFILE,'IMAX', NIMAX)
-CALL IO_Field_read(TZINIFILE,'JMAX', NJMAX)
-NKMAX = 1
-CALL IO_Field_read(TZINIFILE,'JPHEXT',JPHEXT)
-!
-CALL SET_JP_ll(1,JPHEXT,JPVEXT,JPHEXT)
-CALL SET_DIM_ll(NIMAX, NJMAX, NKMAX)
-CALL INI_PARAZ_ll(IRESP)
-!
-!* 2. Reading of MESONH file
-! ----------------------
-!
-CALL READ_HGRID(0,TZINIFILE,YNAME,YDAD,YSTORAGE_TYPE)
-!
-!* 3. Closing of MESONH file
-! ----------------------
-!
-CALL IO_File_close(TZINIFILE)
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. Reading of I and J
-! ------------------
-!
-DO
- WRITE(*,*) '-------------------------------------------------------------------'
- WRITE(*,*) 'please enter index I (real, quit or q to stop):'
- READ(*,*,ERR=1) ZI
- WRITE(*,*) 'please enter index J (real, quit or q to stop):'
- READ(*,*,ERR=1) ZJ
-!
- II=MAX(MIN(INT(ZI),NPGDIMAX+2*JPHEXT-1),1)
- IJ=MAX(MIN(INT(ZJ),NPGDJMAX+2*JPHEXT-1),1)
- ZXHAT=XPGDXHAT(II) + (ZI-REAL(II)) * ( XPGDXHAT(II+1) - XPGDXHAT(II) )
- ZYHAT=XPGDYHAT(IJ) + (ZJ-REAL(IJ)) * ( XPGDYHAT(IJ+1) - XPGDYHAT(IJ) )
-!
- WRITE(*,*) 'x=', ZXHAT
- WRITE(*,*) 'y=', ZYHAT
-!
- CALL SM_LATLON(XPGDLATOR,XPGDLONOR, &
- ZXHAT,ZYHAT,ZLAT,ZLON)
-!
- WRITE(*,*) 'lat=', ZLAT
- WRITE(*,*) 'lon=', ZLON
-END DO
-1 WRITE(*,*) 'good bye'
-!
-!-------------------------------------------------------------------------------
-!
-END PROGRAM XY_TO_LATLON
diff --git a/src/mesonh/ext/yomhook.f90 b/src/mesonh/ext/yomhook.f90
deleted file mode 100644
index a0b84f76453a48b91853e335a1d44433f981d457..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/yomhook.f90
+++ /dev/null
@@ -1,156 +0,0 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-MODULE YOMHOOK
-USE PARKIND1 ,ONLY : JPIM ,JPRB
-LOGICAL :: LHOOK=.FALSE.
-INTEGER, PARAMETER :: JPHOOK=JPRB
-INTERFACE DR_HOOK
-MODULE PROCEDURE &
- DR_HOOK_DEFAULT, &
- DR_HOOK_FILE, &
- DR_HOOK_SIZE, &
- DR_HOOK_FILE_SIZE, &
- DR_HOOK_MULTI_DEFAULT, &
- DR_HOOK_MULTI_FILE, &
- DR_HOOK_MULTI_SIZE, &
- DR_HOOK_MULTI_FILE_SIZE
-END INTERFACE
-
-CONTAINS
-
-SUBROUTINE DR_HOOK_DEFAULT(CDNAME,KSWITCH,PKEY)
-CHARACTER(LEN=*), INTENT(IN) :: CDNAME
-INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH
-REAL(KIND=JPRB), INTENT(INOUT) :: PKEY
-!CALL DR_HOOK_UTIL(CDNAME,KSWITCH,PKEY,'',0)
-END SUBROUTINE DR_HOOK_DEFAULT
-
-SUBROUTINE DR_HOOK_MULTI_DEFAULT(CDNAME,KSWITCH,PKEY)
-CHARACTER(LEN=*), INTENT(IN) :: CDNAME
-INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH
-REAL(KIND=JPRB), INTENT(INOUT) :: PKEY(:)
-!CALL DR_HOOK_UTIL_MULTI(CDNAME,KSWITCH,PKEY,SIZE(PKEY),'',0)
-END SUBROUTINE DR_HOOK_MULTI_DEFAULT
-
-
-
-SUBROUTINE DR_HOOK_FILE(CDNAME,KSWITCH,PKEY,CDFILE)
-CHARACTER(LEN=*), INTENT(IN) :: CDNAME,CDFILE
-INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH
-REAL(KIND=JPRB), INTENT(INOUT) :: PKEY
-!CALL DR_HOOK_UTIL(CDNAME,KSWITCH,PKEY,CDFILE,0)
-END SUBROUTINE DR_HOOK_FILE
-
-SUBROUTINE DR_HOOK_MULTI_FILE(CDNAME,KSWITCH,PKEY,CDFILE)
-CHARACTER(LEN=*), INTENT(IN) :: CDNAME,CDFILE
-INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH
-REAL(KIND=JPRB), INTENT(INOUT) :: PKEY(:)
-!CALL DR_HOOK_UTIL_MULTI(CDNAME,KSWITCH,PKEY,SIZE(PKEY),CDFILE,0)
-END SUBROUTINE DR_HOOK_MULTI_FILE
-
-
-
-SUBROUTINE DR_HOOK_SIZE(CDNAME,KSWITCH,PKEY,KSIZEINFO)
-CHARACTER(LEN=*), INTENT(IN) :: CDNAME
-INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH,KSIZEINFO
-REAL(KIND=JPRB), INTENT(INOUT) :: PKEY
-!CALL DR_HOOK_UTIL(CDNAME,KSWITCH,PKEY,'',KSIZEINFO)
-END SUBROUTINE DR_HOOK_SIZE
-
-SUBROUTINE DR_HOOK_MULTI_SIZE(CDNAME,KSWITCH,PKEY,KSIZEINFO)
-CHARACTER(LEN=*), INTENT(IN) :: CDNAME
-INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH,KSIZEINFO
-REAL(KIND=JPRB), INTENT(INOUT) :: PKEY(:)
-!CALL DR_HOOK_UTIL_MULTI(CDNAME,KSWITCH,PKEY,SIZE(PKEY),'',KSIZEINFO)
-END SUBROUTINE DR_HOOK_MULTI_SIZE
-
-
-
-SUBROUTINE DR_HOOK_FILE_SIZE(CDNAME,KSWITCH,PKEY,CDFILE,KSIZEINFO)
-CHARACTER(LEN=*), INTENT(IN) :: CDNAME,CDFILE
-INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH,KSIZEINFO
-REAL(KIND=JPRB), INTENT(INOUT) :: PKEY
-!CALL DR_HOOK_UTIL(CDNAME,KSWITCH,PKEY,CDFILE,KSIZEINFO)
-END SUBROUTINE DR_HOOK_FILE_SIZE
-
-SUBROUTINE DR_HOOK_MULTI_FILE_SIZE(CDNAME,KSWITCH,PKEY,CDFILE,KSIZEINFO)
-CHARACTER(LEN=*), INTENT(IN) :: CDNAME,CDFILE
-INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH,KSIZEINFO
-REAL(KIND=JPRB), INTENT(INOUT) :: PKEY(:)
-!CALL DR_HOOK_UTIL_MULTI(CDNAME,KSWITCH,PKEY,SIZE(PKEY),CDFILE,KSIZEINFO)
-END SUBROUTINE DR_HOOK_MULTI_FILE_SIZE
-
-END MODULE YOMHOOK
-!====================================================================
-SUBROUTINE DR_HOOK_DEFAULT(CDNAME,KSWITCH,PKEY)
-USE PARKIND1 ,ONLY : JPIM ,JPRB
-CHARACTER(LEN=*), INTENT(IN) :: CDNAME
-INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH
-REAL(KIND=JPRB), INTENT(INOUT) :: PKEY
-!CALL DR_HOOK_UTIL(CDNAME,KSWITCH,PKEY,'',0)
-END SUBROUTINE DR_HOOK_DEFAULT
-
-SUBROUTINE DR_HOOK_MULTI_DEFAULT(CDNAME,KSWITCH,PKEY)
-USE PARKIND1 ,ONLY : JPIM ,JPRB
-CHARACTER(LEN=*), INTENT(IN) :: CDNAME
-INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH
-REAL(KIND=JPRB), INTENT(INOUT) :: PKEY(:)
-!CALL DR_HOOK_UTIL_MULTI(CDNAME,KSWITCH,PKEY,SIZE(PKEY),'',0)
-END SUBROUTINE DR_HOOK_MULTI_DEFAULT
-
-
-
-SUBROUTINE DR_HOOK_FILE(CDNAME,KSWITCH,PKEY,CDFILE)
-USE PARKIND1 ,ONLY : JPIM ,JPRB
-CHARACTER(LEN=*), INTENT(IN) :: CDNAME,CDFILE
-INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH
-REAL(KIND=JPRB), INTENT(INOUT) :: PKEY
-!CALL DR_HOOK_UTIL(CDNAME,KSWITCH,PKEY,CDFILE,0)
-END SUBROUTINE DR_HOOK_FILE
-
-SUBROUTINE DR_HOOK_MULTI_FILE(CDNAME,KSWITCH,PKEY,CDFILE)
-USE PARKIND1 ,ONLY : JPIM ,JPRB
-CHARACTER(LEN=*), INTENT(IN) :: CDNAME,CDFILE
-INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH
-REAL(KIND=JPRB), INTENT(INOUT) :: PKEY(:)
-!CALL DR_HOOK_UTIL_MULTI(CDNAME,KSWITCH,PKEY,SIZE(PKEY),CDFILE,0)
-END SUBROUTINE DR_HOOK_MULTI_FILE
-
-
-
-SUBROUTINE DR_HOOK_SIZE(CDNAME,KSWITCH,PKEY,KSIZEINFO)
-USE PARKIND1 ,ONLY : JPIM ,JPRB
-CHARACTER(LEN=*), INTENT(IN) :: CDNAME
-INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH,KSIZEINFO
-REAL(KIND=JPRB), INTENT(INOUT) :: PKEY
-!CALL DR_HOOK_UTIL(CDNAME,KSWITCH,PKEY,'',KSIZEINFO)
-END SUBROUTINE DR_HOOK_SIZE
-
-SUBROUTINE DR_HOOK_MULTI_SIZE(CDNAME,KSWITCH,PKEY,KSIZEINFO)
-USE PARKIND1 ,ONLY : JPIM ,JPRB
-CHARACTER(LEN=*), INTENT(IN) :: CDNAME
-INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH,KSIZEINFO
-REAL(KIND=JPRB), INTENT(INOUT) :: PKEY(:)
-!CALL DR_HOOK_UTIL_MULTI(CDNAME,KSWITCH,PKEY,SIZE(PKEY),'',KSIZEINFO)
-END SUBROUTINE DR_HOOK_MULTI_SIZE
-
-
-
-SUBROUTINE DR_HOOK_FILE_SIZE(CDNAME,KSWITCH,PKEY,CDFILE,KSIZEINFO)
-USE PARKIND1 ,ONLY : JPIM ,JPRB
-CHARACTER(LEN=*), INTENT(IN) :: CDNAME,CDFILE
-INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH,KSIZEINFO
-REAL(KIND=JPRB), INTENT(INOUT) :: PKEY
-!CALL DR_HOOK_UTIL(CDNAME,KSWITCH,PKEY,CDFILE,KSIZEINFO)
-END SUBROUTINE DR_HOOK_FILE_SIZE
-
-SUBROUTINE DR_HOOK_MULTI_FILE_SIZE(CDNAME,KSWITCH,PKEY,CDFILE,KSIZEINFO)
-USE PARKIND1 ,ONLY : JPIM ,JPRB
-CHARACTER(LEN=*), INTENT(IN) :: CDNAME,CDFILE
-INTEGER(KIND=JPIM), INTENT(IN) :: KSWITCH,KSIZEINFO
-REAL(KIND=JPRB), INTENT(INOUT) :: PKEY(:)
-!CALL DR_HOOK_UTIL_MULTI(CDNAME,KSWITCH,PKEY,SIZE(PKEY),CDFILE,KSIZEINFO)
-END SUBROUTINE DR_HOOK_MULTI_FILE_SIZE
-
diff --git a/src/mesonh/ext/zoom_pgd.f90 b/src/mesonh/ext/zoom_pgd.f90
deleted file mode 100644
index 8caa8ccb640fc9c5bfff4ff7353b87586c9586e8..0000000000000000000000000000000000000000
--- a/src/mesonh/ext/zoom_pgd.f90
+++ /dev/null
@@ -1,272 +0,0 @@
-!MNH_LIC Copyright 2005-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.
-!-----------------------------------------------------------------
-! ################
- PROGRAM ZOOM_PGD
-! ################
-!!
-!! PURPOSE
-!! -------
-!! This program zooms the physiographic data fields.
-!!
-!! METHOD
-!! ------
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! V. Masson Meteo-France
-!!
-!! MODIFICATION
-!! ------------
-!!
-!! Original march 2005
-!! 10/10/2011 J.Escobar call INI_PARAZ_ll
-!! 30/03/2012 S.Bielli Add NAM_NCOUT
-!! 06/2016 (G.Delautier) phasage surfex 8
-!! 08/07/2016 P.Wautelet Removed MNH_NCWRIT define
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
-! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
-! P. Wautelet 06/07/2021: use FINALIZE_MNH
-!----------------------------------------------------------------------------
-!
-!* 0. DECLARATION
-! -----------
-!
-USE MODD_CONF, ONLY : CPROGRAM, L1D, L2D, LPACK
-USE MODD_IO, only: TFILE_OUTPUTLISTING, TFILEDATA
-USE MODD_LUNIT, ONLY : TLUOUT0, TOUTDATAFILE
-USE MODD_PARAMETERS, ONLY : XUNDEF, NUNDEF, JPVEXT, JPHEXT, JPMODELMAX
-USE MODD_PARAM_n, ONLY : CSURF
-USE MODD_DIM_n, ONLY : NIMAX, NJMAX
-USE MODD_CONF_n, ONLY : CSTORAGE_TYPE
-use modd_precision, only: LFIINT
-!
-USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
-USE MODE_POS
-USE MODE_IO, only: IO_Config_set, IO_Init
-USE MODE_IO_FIELD_READ, only: IO_Field_read
-USE MODE_IO_FIELD_WRITE, only: IO_Field_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
-USE MODE_MSG
-USE MODE_MODELN_HANDLER
-!
-USE MODI_READ_HGRID
-USE MODI_WRITE_HGRID
-USE MODI_SET_SUBDOMAIN
-!JUANZ
-USE MODE_SPLITTINGZ_ll
-!JUANZ
-!
-USE MODI_VERSION
-USE MODI_READ_ALL_NAMELISTS
-USE MODI_ZOOM_PGD_SURF_ATM
-USE MODI_WRITE_PGD_SURF_ATM_N
-USE MODD_MNH_SURFEX_n
-!
-USE MODN_CONFIO, ONLY : NAM_CONFIO
-USE MODE_INI_CST, ONLY: INI_CST
-!
-IMPLICIT NONE
-!
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-INTEGER :: IRESP ! return code for I/O
-INTEGER :: ILUOUT0
-INTEGER :: ILUNAM
-INTEGER :: IINFO_ll
-CHARACTER(LEN=28) :: CPGDFILE ! name of the PGD file
-CHARACTER(LEN=28) :: YZOOMFILE ! name of the output file
-CHARACTER(LEN=2) :: YZOOMNBR
-CHARACTER(LEN=28) :: YMY_NAME,YDAD_NAME
-CHARACTER(LEN=28) :: YPGDFILE
-CHARACTER(LEN=2) :: YSTORAGE_TYPE
-LOGICAL :: GFOUND
-INTEGER :: IXOR_DAD,IYOR_DAD ! compared to Dad file, if any
-INTEGER :: IXOR,IYOR ! given or computed
-INTEGER :: IDXRATIO,IDYRATIO
-TYPE(TFILEDATA),POINTER :: TZNMLFILE => NULL()
-TYPE(TFILEDATA),POINTER :: TZPGDFILE => NULL()
-TYPE(TFILEDATA),POINTER :: TZZOOMFILE => NULL()
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZZS1,ZZSMT1,ZZS2,ZZSMT2
-!
-NAMELIST/NAM_PGDFILE/CPGDFILE,YZOOMFILE,YZOOMNBR
-!------------------------------------------------------------------------------
-!
-CALL GOTO_MODEL(1)
-CALL VERSION
-CPROGRAM='ZOOMPG'
-CSTORAGE_TYPE = 'PG'
-!
-CALL INI_CST
-!
-!
-!* 1. Set default names and parallelized I/O
-! --------------------------------------
-!
-CALL IO_Init()
-!
-CALL IO_File_add2list(TLUOUT0,'OUTPUT_LISTING0','OUTPUTLISTING','WRITE')
-CALL IO_File_open(TLUOUT0)
-TFILE_OUTPUTLISTING => TLUOUT0
-ILUOUT0=TLUOUT0%NLU
-!
-CALL IO_File_add2list(TZNMLFILE,'PRE_ZOOM1.nam','NML','READ')
-CALL IO_File_open(TZNMLFILE)
-ILUNAM = TZNMLFILE%NLU
-!
-CPGDFILE = 'PGDFILE' ! name of the input file
-YZOOMFILE = ''
-YZOOMNBR = '00'
-CALL POSNAM(ILUNAM,'NAM_PGDFILE',GFOUND,ILUOUT0)
-IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_PGDFILE)
-CALL POSNAM(ILUNAM,'NAM_CONFIO',GFOUND,ILUOUT0)
-IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CONFIO)
-CALL IO_Config_set()
-!
-!------------------------------------------------------------------------------
-!
-!* 2. ZOOM OF PGD DOMAIN
-! ------------------
-!
-!* 2.1 Open PGD file
-! -------------
-!
-CALL IO_File_add2list(TZPGDFILE,TRIM(CPGDFILE),'PGD','READ',KLFINPRAR=INT(1,KIND=LFIINT),KLFITYPE=2,KLFIVERB=5)
-CALL IO_File_open(TZPGDFILE)
-!
-!* 2.2 Reading of initial grid
-! -----------------------
-!
-CALL READ_HGRID(1,TZPGDFILE,YMY_NAME,YDAD_NAME,YSTORAGE_TYPE)
-!
-! NIMAX, NJMAX: size of input domain
-ALLOCATE(ZZS1 (NIMAX+2*JPHEXT,NJMAX+2*JPHEXT))
-ALLOCATE(ZZSMT1(NIMAX+2*JPHEXT,NJMAX+2*JPHEXT))
-CALL IO_Field_read(TZPGDFILE,'ZS',ZZS1)
-CALL IO_Field_read(TZPGDFILE,'ZSMT',ZZSMT1)
-!
-!* 2.3 Define subdomain
-! ----------------
-!
-CALL SET_SUBDOMAIN(TZNMLFILE,TZPGDFILE,IXOR_DAD,IYOR_DAD,IXOR,IYOR,IDXRATIO,IDYRATIO)
-!
-CALL IO_File_close(TZNMLFILE)
-!
-! NIMAX, NJMAX: size of output domain
-!
-CALL SET_JP_ll(JPMODELMAX,JPHEXT,JPVEXT,JPHEXT)
-CALL SET_DAD0_ll()
-CALL SET_DIM_ll(NIMAX, NJMAX, 1)
-CALL SET_LBX_ll('OPEN',1)
-CALL SET_LBY_ll('OPEN', 1)
-CALL SET_XRATIO_ll(1, 1)
-CALL SET_YRATIO_ll(1, 1)
-CALL SET_XOR_ll(1, 1)
-CALL SET_XEND_ll(NIMAX+2*JPHEXT, 1)
-CALL SET_YOR_ll(1, 1)
-CALL SET_YEND_ll(NJMAX+2*JPHEXT, 1)
-CALL SET_DAD_ll(0, 1)
-!JUANZ CALL INI_PARA_ll(IINFO_ll)
-CALL INI_PARAZ_ll(IINFO_ll)
-!
-!
-!* 2.4 Writing of final grid
-! ---------------------
-!
-IF ( (LEN_TRIM(YZOOMFILE) == 0) .OR. (ADJUSTL(YZOOMFILE) == ADJUSTL(CPGDFILE)) ) THEN
- YZOOMFILE=ADJUSTL(ADJUSTR(CPGDFILE)//'.z'//ADJUSTL(YZOOMNBR))
-END IF
-!
-CALL IO_File_add2list(TZZOOMFILE,TRIM(YZOOMFILE),'PGD','WRITE',KLFINPRAR=INT(1,KIND=LFIINT),KLFITYPE=1,KLFIVERB=5)
-!PW: TODO: points to dad file (if existing) ! TZZOOMFILE%TDADFILE =>
-!
-CALL IO_File_open(TZZOOMFILE)
-CALL WRITE_HGRID(1,TZZOOMFILE)
-!
-!* 2.5 Preparation of surface physiographic fields
-! -------------------------------------------
-!
-CALL IO_Field_read(TZPGDFILE,'SURF',CSURF)
-!
-!
-IF (CSURF=='EXTE') THEN
- CALL SURFEX_ALLOC_LIST(1)
- YSURF_CUR => YSURF_LIST(1)
- CALL READ_ALL_NAMELISTS(YSURF_CUR,'MESONH','PRE',.FALSE.)
- YPGDFILE = CPGDFILE
- CPGDFILE = YZOOMFILE
- TOUTDATAFILE => TZZOOMFILE
- CALL GOTO_SURFEX(1)
- CALL ZOOM_PGD_SURF_ATM(YSURF_CUR,'MESONH',YPGDFILE,'MESONH',YZOOMFILE,'MESONH')
-!
-!* 2.6 Writes the physiographic fields
-! -------------------------------
-!
- CALL WRITE_PGD_SURF_ATM_n(YSURF_CUR,'MESONH')
-ELSE
- ALLOCATE(ZZS2(NIMAX+2*JPHEXT,NJMAX+2*JPHEXT))
- ZZS2(:,:)=ZZS1(IXOR:IXOR+NIMAX+2*JPHEXT-1,IYOR:IYOR+NJMAX+2*JPHEXT-1)
- CALL IO_Field_write(TZZOOMFILE,'ZS',ZZS2)
-END IF
-!
-ALLOCATE(ZZSMT2(NIMAX+2*JPHEXT,NJMAX+2*JPHEXT))
-ZZSMT2(:,:)=ZZSMT1(IXOR:IXOR+NIMAX+2*JPHEXT-1,IYOR:IYOR+NJMAX+2*JPHEXT-1)
-CALL IO_Field_write(TZZOOMFILE,'ZSMT',ZZSMT2)
-!
-!* 2.7 Write configuration variables in the output file
-! ------------------------------------------------
-!
-CALL IO_Header_write(TZZOOMFILE)
-CALL IO_Field_write(TZZOOMFILE,'DXRATIO',IDXRATIO)
-CALL IO_Field_write(TZZOOMFILE,'DYRATIO',IDYRATIO)
-CALL IO_Field_write(TZZOOMFILE,'XOR', IXOR_DAD)
-CALL IO_Field_write(TZZOOMFILE,'YOR', IYOR_DAD)
-CALL IO_Field_write(TZZOOMFILE,'L1D', L1D)
-CALL IO_Field_write(TZZOOMFILE,'L2D', L2D)
-CALL IO_Field_write(TZZOOMFILE,'PACK', LPACK)
-CALL IO_Field_write(TZZOOMFILE,'SURF', CSURF)
-CALL IO_File_close(TZZOOMFILE)
-!
-!* 2.8 Shift to new PGD file
-! ---------------------
-!
-CPGDFILE = YZOOMFILE
-!
-!------------------------------------------------------------------------------
-!
-!* 3. CLOSE PARALLELIZED I/O
-! ----------------------
-!
-CALL IO_File_close(TZPGDFILE)
-!
-WRITE(ILUOUT0,*)
-WRITE(ILUOUT0,*) '***************************'
-WRITE(ILUOUT0,*) '* ZOOM_PGD ends correctly *'
-WRITE(ILUOUT0,*) '***************************'
-!
-CALL FINALIZE_MNH()
-!
-!-------------------------------------------------------------------------------
-!
-END PROGRAM ZOOM_PGD
diff --git a/src/mesonh/filesToSuppress.txt b/src/mesonh/filesToSuppress.txt
index ca6910d2cf72296af8bd8b2a60e8ace4cf3ebe86..559ea345838ab41d288c985c1eaf9dce1f8e0396 100644
--- a/src/mesonh/filesToSuppress.txt
+++ b/src/mesonh/filesToSuppress.txt
@@ -1,6 +1,6 @@
#This file contains the source codes that must not be included
#for the model compilation. These codes already exist in the Meso-NH model
-#and are used outside of the physics
+#and are used outside of the physics, or are not useful for Meso-NH (i.e. for testsprogs only)
# must be written with lower case .f90 (because prep_code already transformed it)
aux/mode_msg.f90
diff --git a/src/mesonh/mesonh_version.json b/src/mesonh/mesonh_version.json
index 576824f90ed9a226d8ebe1b5ab1a6b653c30664b..28d0c78dc70d8dfcbf88203ffb8016ca3e986443 100644
--- a/src/mesonh/mesonh_version.json
+++ b/src/mesonh/mesonh_version.json
@@ -1,13 +1,13 @@
{
-"refversion":"MNH-V5-6-0-INITNAM",
+"refversion":"MNH-V5-6-2-pre57-58715e8",
"testing": {
- "007_16janvier/008_run2":"79fe47e",
- "007_16janvier/008_run2_turb3D":"79fe47e",
- "007_16janvier/008_run2_lredf":"79fe47e",
- "COLD_BUBBLE/002_mesonh":"71ab2d2",
- "ARMLES/RUN":"c79e004",
- "COLD_BUBBLE_3D/002_mesonh":"71ab2d2",
- "OCEAN_LES/004_run2":"79fe47e",
- "014_LIMA/002_mesonh":"79fe47e"
+ "007_16janvier/008_run2":"cd4ccdd8",
+ "007_16janvier/008_run2_turb3D":"cd4ccdd8",
+ "007_16janvier/008_run2_lredf":"cd4ccdd8",
+ "COLD_BUBBLE/002_mesonh":"cd4ccdd8",
+ "ARMLES/RUN":"cd4ccdd8",
+ "COLD_BUBBLE_3D/002_mesonh":"cd4ccdd8",
+ "OCEAN_LES/004_run2":"cd4ccdd8",
+ "014_LIMA/002_mesonh":"cd4ccdd8"
}
}
diff --git a/src/mesonh/micro/ini_param_elec.f90 b/src/mesonh/micro/ini_param_elec.f90
index 03bc5fc30c2dc413ea721f83cdda88a4c543ae0e..b144572c51801be9f045437ebf8323b2a33b8994 100644
--- a/src/mesonh/micro/ini_param_elec.f90
+++ b/src/mesonh/micro/ini_param_elec.f90
@@ -10,18 +10,18 @@
IMPLICIT NONE
INTERFACE
!
- SUBROUTINE INI_PARAM_ELEC (TPINIFILE, HGETSVM, PRHO00, &
- KRR, KND, PFDINFTY, IIU, IJU, IKU )
+ SUBROUTINE INI_PARAM_ELEC (TPINIFILE, HGETSVT, HCLOUD, HELEC, &
+ PRHO00, KRR, IIU, IJU, IKU )
!
USE MODD_IO, ONLY : TFILEDATA
IMPLICIT NONE
!
-TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
-CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVM
-INTEGER, INTENT(IN) :: KND ! Number of intervals to integrate kernels
+TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
+CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVT
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! microphysics scheme
+CHARACTER (LEN=4), INTENT(IN) :: HELEC ! electrical scheme
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
REAL, INTENT(IN) :: PRHO00 ! Pressure at ground level
-REAL, INTENT(IN) :: PFDINFTY ! Factor used to define the "infinite" diameter
INTEGER, INTENT(IN) :: IIU ! Upper dimension in x direction (local)
INTEGER, INTENT(IN) :: IJU ! Upper dimension in y direction (local)
INTEGER, INTENT(IN) :: IKU ! Upper dimension in z direction
@@ -30,10 +30,10 @@ END SUBROUTINE INI_PARAM_ELEC
END INTERFACE
END MODULE MODI_INI_PARAM_ELEC
!
-! ##############################################################
- SUBROUTINE INI_PARAM_ELEC (TPINIFILE, HGETSVM, PRHO00, &
- KRR, KND, PFDINFTY, IIU, IJU, IKU )
-! ##############################################################
+! ###############################################################
+ SUBROUTINE INI_PARAM_ELEC (TPINIFILE, HGETSVT, HCLOUD, HELEC, &
+ PRHO00, KRR, IIU, IJU, IKU)
+! ###############################################################
!
!!**** *INI_PARAM_ELEC* - initialize the constants necessary
!! for the electrical scheme.
@@ -88,6 +88,12 @@ END MODULE MODI_INI_PARAM_ELEC
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! J. Wurtz 03/2022: new snow characteristics
+!! C. Barthe 04/02/2022 Add XGAMINC_RIM3 (no more initialized in ini_rain_ice_elec)
+!! C. Barthe 07/06/2022 Add parameters for charge sedimentation in LIMA
+!! C. Barthe 30/11/2022 Remove the section about charge neutralization ;
+!! already done in ini_flash_geom_elec
+!! C. Barthe 28/03/2023 Add parameters for sedimentation of cloud droplets charge
+!! C. Barthe 13/07/2023 Modify parameters that contain C_x and x_x for Ns, Ng and Nh
!
!-------------------------------------------------------------------------------
!
@@ -102,12 +108,48 @@ USE MODD_IO, ONLY: TFILEDATA
USE MODD_NSV, ONLY: NSV_ELECEND
USE MODD_PARAMETERS
USE MODD_PARAM_ICE_n
-USE MODD_RAIN_ICE_DESCR_n
-USE MODD_RAIN_ICE_PARAM_n
+USE MODD_PARAM_LIMA, ONLY : XALPHAC_L=>XALPHAC, XNUC_L=>XNUC, XALPHAR_L=>XALPHAR, XNUR_L=>XNUR, &
+ XALPHAI_L=>XALPHAI, XNUI_L=>XNUI, XALPHAS_L=>XALPHAS, XNUS_L=>XNUS, &
+ XALPHAG_L=>XALPHAG, XNUG_L=>XNUG, &
+ XCEXVT_L=>XCEXVT
+USE MODD_PARAM_LIMA_COLD, ONLY : XAI_L=>XAI, XBI_L=>XBI, XC_I_L=>XC_I, XDI_L=>XDI, &
+ XAS_L=>XAS, XBS_L=>XBS, XCS_L=>XCS, XDS_L=>XDS, XCCS_L=>XCCS, XCXS_L=>XCXS
+USE MODD_PARAM_LIMA_MIXED,ONLY : XAG_L=>XAG, XBG_L=>XBG, XCG_L=>XCG, XDG_L=>XDG, XCCG_L=>XCCG, XCXG_L=>XCXG, &
+ XAH_L=>XAH, XBH_L=>XBH, XCH_L=>XCH, XDH_L=>XDH, XCCH_L=>XCCH, XCXH_L=>XCXH, &
+ XALPHAH_L=>XALPHAH, XNUH_L=>XNUH, &
+ XGAMINC_BOUND_MIN_L=>XGAMINC_BOUND_MIN, XGAMINC_BOUND_MAX_L=>XGAMINC_BOUND_MAX, &
+ NGAMINC_L=>NGAMINC, NACCLBDAR_L=>NACCLBDAR, NACCLBDAS_L=>NACCLBDAS, &
+ XACCLBDAR_MIN_L=>XACCLBDAR_MIN, XACCLBDAR_MAX_L=>XACCLBDAR_MAX, &
+ XACCLBDAS_MIN_L=>XACCLBDAS_MIN, XACCLBDAS_MAX_L=>XACCLBDAS_MAX, &
+ NDRYLBDAR_L=>NDRYLBDAR, NDRYLBDAS_L=>NDRYLBDAS, NDRYLBDAG_L=>NDRYLBDAG, &
+ XDRYLBDAR_MIN_L=>XDRYLBDAR_MIN, XDRYLBDAR_MAX_L=>XDRYLBDAR_MAX, &
+ XDRYLBDAS_MIN_L=>XDRYLBDAS_MIN, XDRYLBDAS_MAX_L=>XDRYLBDAS_MAX, &
+ XDRYLBDAG_MIN_L=>XDRYLBDAG_MIN, XDRYLBDAG_MAX_L=>XDRYLBDAG_MAX
+USE MODD_PARAM_LIMA_WARM, ONLY : XAR_L=>XAR, XBR_L=>XBR, XCR_L=>XCR, XDR_L=>XDR, &
+ XCC_L=>XCC, XDC_L=>XDC, XCCR_L=>XCCR
+USE MODD_RAIN_ICE_DESCR_n,ONLY : XALPHAC_I=>XALPHAC, XNUC_I=>XNUC, XALPHAR_I=>XALPHAR, XNUR_I=>XNUR, &
+ XALPHAI_I=>XALPHAI, XNUI_I=>XNUI, XALPHAS_I=>XALPHAS, XNUS_I=>XNUS, &
+ XALPHAG_I=>XALPHAG, XNUG_I=>XNUG, XALPHAH_I=>XALPHAH, XNUH_I=>XNUH, &
+ XCC_I=>XCC, XDC_I=>XDC, &
+ XAR_I=>XAR, XBR_I=>XBR, XCR_I=>XCR, XDR_I=>XDR, XCCR_I=>XCCR, &
+ XAI_I=>XAI, XBI_I=>XBI, XC_I_I=>XC_I, XDI_I=>XDI, &
+ XAS_I=>XAS, XBS_I=>XBS, XCS_I=>XCS, XDS_I=>XDS, XCCS_I=>XCCS, XCXS_I=>XCXS, &
+ XAG_I=>XAG, XBG_I=>XBG, XCG_I=>XCG, XDG_I=>XDG, XCCG_I=>XCCG, XCXG_I=>XCXG, &
+ XAH_I=>XAH, XBH_I=>XBH, XCH_I=>XCH, XDH_I=>XDH, XCCH_I=>XCCH, XCXH_I=>XCXH, &
+ XCEXVT_I=>XCEXVT
+USE MODD_RAIN_ICE_PARAM_n,ONLY : XGAMINC_BOUND_MIN_I=>XGAMINC_BOUND_MIN, XGAMINC_BOUND_MAX_I=>XGAMINC_BOUND_MAX, &
+ NGAMINC_I=>NGAMINC, NACCLBDAR_I=>NACCLBDAR, NACCLBDAS_I=>NACCLBDAS, &
+ XACCLBDAR_MIN_I=>XACCLBDAR_MIN, XACCLBDAR_MAX_I=>XACCLBDAR_MAX, &
+ XACCLBDAS_MIN_I=>XACCLBDAS_MIN, XACCLBDAS_MAX_I=>XACCLBDAS_MAX, &
+ NDRYLBDAR_I=>NDRYLBDAR, NDRYLBDAS_I=>NDRYLBDAS, NDRYLBDAG_I=>NDRYLBDAG, &
+ XDRYLBDAR_MIN_I=>XDRYLBDAR_MIN, XDRYLBDAR_MAX_I=>XDRYLBDAR_MAX, &
+ XDRYLBDAS_MIN_I=>XDRYLBDAS_MIN, XDRYLBDAS_MAX_I=>XDRYLBDAS_MAX, &
+ XDRYLBDAG_MIN_I=>XDRYLBDAG_MIN, XDRYLBDAG_MAX_I=>XDRYLBDAG_MAX
USE MODD_VAR_ll
!
USE MODE_IO_FIELD_READ, only: IO_Field_read
!
+USE MODI_GAMMA_INC
USE MODI_MOMG
USE MODE_RRCOLSS, ONLY: RRCOLSS
USE MODE_RSCOLRG, ONLY: RSCOLRG
@@ -118,37 +160,211 @@ IMPLICIT NONE
!
!* 0.1 Declaration of dummy arguments
!
-TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
-CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVM
-INTEGER, INTENT(IN) :: KND ! Number of intervals to integrate kernels
+TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
+CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVT
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! microphysics scheme
+CHARACTER (LEN=4), INTENT(IN) :: HELEC ! electrical scheme
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
REAL, INTENT(IN) :: PRHO00 ! Pressure at ground level
-REAL, INTENT(IN) :: PFDINFTY ! Factor used to define the "infinite" diameter
INTEGER, INTENT(IN) :: IIU ! Upper dimension in x direction (local)
INTEGER, INTENT(IN) :: IJU ! Upper dimension in y direction (local)
INTEGER, INTENT(IN) :: IKU ! Upper dimension in z direction
!
!* 0.2 Declaration of local variables
!
+INTEGER :: IND ! Number of intervals to integrate kernels
+INTEGER :: J1, JLWC, JTEMP
+INTEGER :: IGAMINC, IACCLBDAR, IACCLBDAS, IDRYLBDAR, IDRYLBDAS, IDRYLBDAG
+!
+REAL :: ZRATE ! Geometrical growth of Lbda in the tabulated
+ ! functions and kernels
+REAL :: ZBOUND ! XDCSLIM*Lbda_s: upper bound for the partial
+ ! integration of the riming rate of the aggregates
+!
REAL :: ZESR ! Mean efficiency of rain-aggregate collection
REAL :: ZEGS !
REAL :: ZEGR
+REAL :: ZFDINFTY ! Factor used to define the "infinite" diameter
+! variables used to cope with the module variables common to icex and lima
+REAL :: ZCEXVT, &
+ ZCC, ZDC, ZALPHAC, ZNUC, &
+ ZAR, ZBR, ZCR, ZDR, ZCCR, ZALPHAR, ZNUR, &
+ ZAI, ZBI, ZCI, ZDI, ZALPHAI, ZNUI, &
+ ZAS, ZBS, ZCS, ZDS, ZCCS, ZCXS, ZALPHAS, ZNUS, &
+ ZAG, ZBG, ZCG, ZDG, ZCCG, ZCXG, ZALPHAG, ZNUG, &
+ ZAH, ZBH, ZCH, ZDH, ZCCH, ZCXH, ZALPHAH, ZNUH, &
+ ZGAMINC_BOUND_MIN, ZGAMINC_BOUND_MAX, &
+ ZACCLBDAR_MIN, ZACCLBDAR_MAX, ZACCLBDAS_MIN, ZACCLBDAS_MAX, &
+ ZDRYLBDAR_MIN, ZDRYLBDAR_MAX, ZDRYLBDAS_MIN, ZDRYLBDAS_MAX, &
+ ZDRYLBDAG_MIN, ZDRYLBDAG_MAX
+!
REAL, DIMENSION(:,:), ALLOCATABLE :: ZMANSELL1, ZMANSELL2 ! Used to initialize
! XMANSELL array
!
-INTEGER :: JLWC, JTEMP
-REAL, DIMENSION(:), ALLOCATABLE :: ZT, ZLWCC, ZEW
+REAL, DIMENSION(:), ALLOCATABLE :: ZT, ZLWCC, ZEW
!
!-------------------------------------------------------------------------------
-! constants for electricity
+!
+!* 1. PRELIMINARIES
+! -------------
+!
+!* 1.1 Constants for electricity
!
XEPSILON = 8.85E-12 ! Dielectric permittivity of the air
XECHARGE = 1.6E-19 ! Elementary charge (C)
!
-!* 1. SHAPE PARAMETERS
+!
+!* 1.2 Address module variables common to ICEx and LIMA
+!
+IF (HCLOUD(1:3) == 'ICE') THEN
+ ZCEXVT = XCEXVT_I
+ !
+ ZCC = XCC_I
+ ZDC = XDC_I
+ ZALPHAC = XALPHAC_I
+ ZNUC = XNUC_I
+ !
+ ZAR = XAR_I
+ ZBR = XBR_I
+ ZCR = XCR_I
+ ZDR = XDR_I
+ ZCCR = XCCR_I
+ ZALPHAR = XALPHAR_I
+ ZNUR = XNUR_I
+ !
+ ZAI = XAI_I
+ ZBI = XBI_I
+ ZCI = XC_I_I
+ ZDI = XDI_I
+ ZALPHAI = XALPHAI_I
+ ZNUI = XNUI_I
+ !
+ ZAS = XAS_I
+ ZBS = XBS_I
+ ZCS = XCS_I
+ ZDS = XDS_I
+ ZCCS = XCCS_I
+ ZCXS = XCXS_I
+ ZALPHAS = XALPHAS_I
+ ZNUS = XNUS_I
+ !
+ ZAG = XAG_I
+ ZBG = XBG_I
+ ZCG = XCG_I
+ ZDG = XDG_I
+ ZCCG = XCCG_I
+ ZCXG = XCXG_I
+ ZALPHAG = XALPHAG_I
+ ZNUG = XNUG_I
+ !
+ ZAH = XAH_I
+ ZBH = XBH_I
+ ZCH = XCH_I
+ ZDH = XDH_I
+ ZCCH = XCCH_I
+ ZCXH = XCXH_I
+ ZALPHAH = XALPHAH_I
+ ZNUH = XNUH_I
+ !
+ IGAMINC = NGAMINC_I
+ ZGAMINC_BOUND_MIN = XGAMINC_BOUND_MIN_I
+ ZGAMINC_BOUND_MAX = XGAMINC_BOUND_MAX_I
+ !
+ IACCLBDAR = NACCLBDAR_I
+ IACCLBDAS = NACCLBDAS_I
+ ZACCLBDAR_MIN = XACCLBDAR_MIN_I
+ ZACCLBDAR_MAX = XACCLBDAR_MAX_I
+ ZACCLBDAS_MIN = XACCLBDAS_MIN_I
+ ZACCLBDAS_MAX = XACCLBDAS_MAX_I
+ !
+ IDRYLBDAR = NDRYLBDAR_I
+ IDRYLBDAS = NDRYLBDAS_I
+ IDRYLBDAG = NDRYLBDAG_I
+ ZDRYLBDAR_MIN = XDRYLBDAR_MIN_I
+ ZDRYLBDAR_MAX = XDRYLBDAR_MAX_I
+ ZDRYLBDAS_MIN = XDRYLBDAS_MIN_I
+ ZDRYLBDAS_MAX = XDRYLBDAS_MAX_I
+ ZDRYLBDAG_MIN = XDRYLBDAG_MIN_I
+ ZDRYLBDAG_MAX = XDRYLBDAG_MAX_I
+ !
+ELSE IF (HCLOUD == 'LIMA') THEN
+ ZCEXVT = XCEXVT_L
+ !
+ ZCC = XCC_L
+ ZDC = XDC_L
+ ZALPHAC = XALPHAC_L
+ ZNUC = XNUC_L
+ !
+ ZAR = XAR_L
+ ZBR = XBR_L
+ ZCR = XCR_L
+ ZDR = XDR_L
+ ZCCR = XCCR_L
+ ZALPHAR = XALPHAR_L
+ ZNUR = XNUR_L
+ !
+ ZAI = XAI_L
+ ZBI = XBI_L
+ ZCI = XC_I_L
+ ZDI = XDI_L
+ ZALPHAI = XALPHAI_L
+ ZNUI = XNUI_L
+ !
+ ZAS = XAS_L
+ ZBS = XBS_L
+ ZCS = XCS_L
+ ZDS = XDS_L
+ ZCCS = XCCS_L
+ ZCXS = XCXS_L
+ ZALPHAS = XALPHAS_L
+ ZNUS = XNUS_L
+ !
+ ZAG = XAG_L
+ ZBG = XBG_L
+ ZCG = XCG_L
+ ZDG = XDG_L
+ ZCCG = XCCG_L
+ ZCXG = XCXG_L
+ ZALPHAG = XALPHAG_L
+ ZNUG = XNUG_L
+ !
+ ZAH = XAH_L
+ ZBH = XBH_L
+ ZCH = XCH_L
+ ZDH = XDH_L
+ ZCCH = XCCH_L
+ ZCXH = XCXH_L
+ ZALPHAH = XALPHAH_L
+ ZNUH = XNUH_L
+ !
+ IGAMINC = NGAMINC_L
+ ZGAMINC_BOUND_MIN = XGAMINC_BOUND_MIN_L
+ ZGAMINC_BOUND_MAX = XGAMINC_BOUND_MAX_L
+ !
+ IACCLBDAR = NACCLBDAR_L
+ IACCLBDAS = NACCLBDAS_L
+ ZACCLBDAR_MIN = XACCLBDAR_MIN_L
+ ZACCLBDAR_MAX = XACCLBDAR_MAX_L
+ ZACCLBDAS_MIN = XACCLBDAS_MIN_L
+ ZACCLBDAS_MAX = XACCLBDAS_MAX_L
+ !
+ IDRYLBDAR = NDRYLBDAR_L
+ IDRYLBDAS = NDRYLBDAS_L
+ IDRYLBDAG = NDRYLBDAG_L
+ ZDRYLBDAR_MIN = XDRYLBDAR_MIN_L
+ ZDRYLBDAR_MAX = XDRYLBDAR_MAX_L
+ ZDRYLBDAS_MIN = XDRYLBDAS_MIN_L
+ ZDRYLBDAS_MAX = XDRYLBDAS_MAX_L
+ ZDRYLBDAG_MIN = XDRYLBDAG_MIN_L
+ ZDRYLBDAG_MAX = XDRYLBDAG_MAX_L
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. SHAPE PARAMETERS
! ----------------
!
-XCXR = -1.0 ! Raindrop characteristic : XCXR (not declared in ini_rain_ice.f90)
+XCXR = -1.0 ! Raindrop characteristic : XCXR (not initialized in ini_rain_ice.f90)
!
! Individual charge q(d) = e_x * d ** f_x with f_x = XFx
!
@@ -205,7 +421,7 @@ XJCURR_FW = -2.7E-12
!
!-------------------------------------------------------------------------------
!
-!* 2. COEFFICIENTS FOR CHARGE TRANSFERS
+!* 3. COEFFICIENTS FOR CHARGE TRANSFERS
! ---------------------------------
!
! proportionality coefficient between mass transfer and charge transfer rates
@@ -214,11 +430,11 @@ XJCURR_FW = -2.7E-12
!
XCOEF_RQ_V = 1
XCOEF_RQ_C = XFC / 3.0 ! XBC=3
-XCOEF_RQ_R = XFR / XBR
-XCOEF_RQ_I = XFI / XBI
-XCOEF_RQ_S = XFS / XBS
-XCOEF_RQ_G = XFG / XBG
-XCOEF_RQ_H = XFH / XBH
+XCOEF_RQ_R = XFR / ZBR
+XCOEF_RQ_I = XFI / ZBI
+XCOEF_RQ_S = XFS / ZBS
+XCOEF_RQ_G = XFG / ZBG
+XCOEF_RQ_H = XFH / ZBH
!
!
!-------------------------------------------------------------------------------
@@ -240,6 +456,7 @@ XQHON = XQHON / (XLBDACQ**XFC)
!
!* 4. SEDIMENTATION
! -------------
+!
IF (ALLOCATED(XQTMIN)) DEALLOCATE(XQTMIN)
IF (ALLOCATED(XRTMIN_ELEC)) DEALLOCATE(XRTMIN_ELEC)
!
@@ -272,46 +489,78 @@ XLBDAS_MAXE = 2.E3 ! Less than 10000 particles in cube meter of cloud.
XLBDAG_MAXE = 2.E3 !
XLBDAH_MAXE = 2.E3 !
!
-! Rain
-!
-XCEXVT = 0.4
-XEXQSEDR = (XCXR - XFR - XDR) / (XCXR - XBR)
-XFQSEDR = XCR * (XCCR**(1 - XEXQSEDR)) * MOMG(XALPHAR,XNUR,XDR+XFR) * &
- ((XAR * MOMG(XALPHAR,XNUR,XBR))**(-XEXQSEDR)) * (PRHO00)**XCEXVT
-!
-! Ice
-!
-XEXQSEDI = (XDI + XFI) / XBI
-XFQSEDI = XC_I * MOMG(XALPHAI,XNUI,XDI+XFI) * (PRHO00**XCEXVT) * &
- (XAI * MOMG(XALPHAI,XNUI,XBI))**(-XEXQSEDI)
-!
-! Snow
-!
-XEXQSEDS = (XCXS - XFS - XDS) / (XCXS - XBS)
-XFQSEDS = XCS * (XCCS**(1 - XEXQSEDS)) * MOMG(XALPHAS,XNUS,XDS+XFS) * &
- ((XAS * MOMG(XALPHAS,XNUS,XBS))**(-XEXQSEDS)) * (PRHO00)**XCEXVT
-!
-! Graupeln
-!
-XEXQSEDG = (XCXG - XFG - XDG) / (XCXG - XBG)
-XFQSEDG = XCG * (XCCG**(1 - XEXQSEDG)) * MOMG(XALPHAG,XNUG,XDG+XFG) * &
- ((XAG * MOMG(XALPHAG,XNUG,XBG))**(-XEXQSEDG)) * (PRHO00)**XCEXVT
-!
-! Hail
-!
-XEXQSEDH = (XCXH - XFH - XDH) / (XCXH - XBH)
-XFQSEDH = XCH * (XCCH**(1 - XEXQSEDH)) * MOMG(XALPHAH,XNUH,XDH+XFH) * &
- ((XAH * MOMG(XALPHAH,XNUH,XBH))**(-XEXQSEDH)) * (PRHO00)**XCEXVT
-!
+IF (HCLOUD(1:3) == 'ICE') THEN
+ !
+ ! Cloud droplets
+ !
+ ZCEXVT = 0.4
+ XEXQSEDC = XFC + ZDC
+ XFQSEDC = ZCC * MOMG(ZALPHAC,ZNUC,ZDC+XFC) * (PRHO00)**ZCEXVT
+ !
+ ! Rain
+ !
+ XEXQSEDR = (XCXR - XFR - ZDR) / (XCXR - ZBR)
+ XFQSEDR = ZCR * (ZCCR**(1 - XEXQSEDR)) * MOMG(ZALPHAR,ZNUR,ZDR+XFR) * &
+ ((ZAR * MOMG(ZALPHAR,ZNUR,ZBR))**(-XEXQSEDR)) * (PRHO00)**ZCEXVT
+ !
+ ! Ice
+!!++cb++ 23/02/23 pour la microphysique, calcul fait pour des colonnes
+! => on fait pareil ici pour garder la coherence
+!XEXQSEDI = (ZDI + XFI) / ZBI
+!XFQSEDI = ZCI * MOMG(ZALPHAI,ZNUI,ZDI+XFI) * (PRHO00**ZCEXVT) * &
+! (ZAI * MOMG(ZALPHAI,ZNUI,ZBI))**(-XEXQSEDI)
+ XEXQSEDI = (1.585 + XFI) / 1.7
+ XFQSEDI = 2.1E5 * MOMG(ZALPHAI,ZNUI,1.585+XFI) * (PRHO00**ZCEXVT) * &
+ (2.14E-3 * MOMG(ZALPHAI,ZNUI,1.7))**(-XEXQSEDI)
+!--cb--
+ XFCI = (4. * XPI * 900.)**(-1)
+ !
+ ! Snow
+ !
+ XEXQSEDS = (ZCXS - XFS - ZDS) / (ZCXS - ZBS)
+ XFQSEDS = ZCS * (ZCCS**(1 - XEXQSEDS)) * MOMG(ZALPHAS,ZNUS,ZDS+XFS) * &
+ ((ZAS * MOMG(ZALPHAS,ZNUS,ZBS))**(-XEXQSEDS)) * (PRHO00)**ZCEXVT
+ !
+ ! Graupeln
+ !
+ XEXQSEDG = (ZCXG - XFG - ZDG) / (ZCXG - ZBG)
+ XFQSEDG = ZCG * (ZCCG**(1 - XEXQSEDG)) * MOMG(ZALPHAG,ZNUG,ZDG+XFG) * &
+ ((ZAG * MOMG(ZALPHAG,ZNUG,ZBG))**(-XEXQSEDG)) * (PRHO00)**ZCEXVT
+ !
+ ! Hail
+ !
+ XEXQSEDH = (ZCXH - XFH - ZDH) / (ZCXH - ZBH)
+ XFQSEDH = ZCH * (ZCCH**(1 - XEXQSEDH)) * MOMG(ZALPHAH,ZNUH,ZDH+XFH) * &
+ ((ZAH * MOMG(ZALPHAH,ZNUH,ZBH))**(-XEXQSEDH)) * (PRHO00)**ZCEXVT
+!
+ELSE IF (HCLOUD == 'LIMA') THEN
+ ALLOCATE(XFQSED(KRR))
+ XFQSED(:) = 0.
+ XFQSED(2) = ZCC * MOMG(ZALPHAC,ZNUC,ZDC+XFC)
+ XFQSED(3) = ZCR * MOMG(ZALPHAR,ZNUR,ZDR+XFR)
+ XFQSED(4) = ZCI * MOMG(ZALPHAI,ZNUI,ZDI+XFI)
+ XFQSED(5) = ZCS * MOMG(ZALPHAS,ZNUS,ZDS+XFS)
+ XFQSED(6) = ZCG * MOMG(ZALPHAG,ZNUG,ZDG+XFG)
+ IF (KRR == 7) XFQSED(7) = ZCH * MOMG(ZALPHAH,ZNUH,ZDH+XFH)
+ !
+ ALLOCATE(XDQ(KRR))
+ XDQ(:) = 0.
+ XDQ(2) = ZDC + XFC
+ XDQ(3) = ZDR + XFR
+ XDQ(4) = ZDI + XFI
+ XDQ(5) = ZDS + XFS
+ XDQ(6) = ZDG + XFG
+ IF (KRR == 7) XDQ(7) = ZDH + XFH
+END IF
!
!-------------------------------------------------------------------------------
!
!* 5. EVAPORATION OF RAINDROPS
! ------------------------
!
-XQREVAV1 = (2. / XPI) * MOMG(XALPHAR,XNUR,XFR) / MOMG(XALPHAR,XNUR,2.)
-XQREVAV2 = (XPI / XAR) * (MOMG(XALPHAR,XNUR,2.) / MOMG(XALPHAR,XNUR,XBR)) * &
- (XCXR - 2.) / (XCXR - XBR)
+!XQREVAV1 = (2. / XPI) * MOMG(ZALPHAR,ZNUR,XFR) / MOMG(ZALPHAR,ZNUR,2.)
+!XQREVAV2 = (XPI / ZAR) * (MOMG(ZALPHAR,ZNUR,2.) / MOMG(ZALPHAR,ZNUR,ZBR)) * &
+! (XCXR - 2.) / (XCXR - ZBR)
!
!
!-------------------------------------------------------------------------------
@@ -319,11 +568,22 @@ XQREVAV2 = (XPI / XAR) * (MOMG(XALPHAR,XNUR,2.) / MOMG(XALPHAR,XNUR,XBR)) * &
!* 6. RIMING OF CLOUD DROPLETS ON SNOW
! --------------------------------
!
-XEXQSRIMCG = XCXS - XFS
-XQSRIMCG = XCCS * MOMG(XALPHAS,XNUS,XFS)
+IF (HELEC == 'ELE4') THEN
+ XEXQSRIMCG = -XFS
+ XQSRIMCG = MOMG(ZALPHAS,ZNUS,XFS)
+ELSE
+ XEXQSRIMCG = ZCXS - XFS
+ XQSRIMCG = ZCCS * MOMG(ZALPHAS,ZNUS,XFS)
+END IF
!
! The array containing the tabulated function M(fs,D_cs^lim)/M(fs)
-! is implemented in ini_rain_ice.f90
+! is no more implemented in ini_rain_ice.f90
+ZRATE = EXP(LOG(ZGAMINC_BOUND_MAX/ZGAMINC_BOUND_MIN)/REAL(IGAMINC-1))
+IF( .NOT.ALLOCATED(XGAMINC_RIM3) ) ALLOCATE( XGAMINC_RIM3(IGAMINC) )
+DO J1 = 1, IGAMINC
+ ZBOUND = ZGAMINC_BOUND_MIN * ZRATE**(J1-1)
+ XGAMINC_RIM3(J1) = GAMMA_INC(ZNUS+XFS/ZALPHAS,ZBOUND)
+END DO
!
!
!-------------------------------------------------------------------------------
@@ -331,9 +591,15 @@ XQSRIMCG = XCCS * MOMG(XALPHAS,XNUS,XFS)
!* 7. CONTACT FREEZING BETWEEN RAINDROPS AND PRISTINE ICE
! ---------------------------------------------------
!
-XEXQRCFRIG = XCXR - XDR - XFR - 2.0
-XQRCFRIG = (XPI / 4.0) * XCR * XCCR * MOMG(XALPHAR,XNUR,XDR+XFR+2.) * &
- PRHO00**XCEXVT
+IF (HELEC == 'ELE4') THEN
+ XEXQRCFRIG = - ZDR - XFR - 2.0
+ XQRCFRIG = (XPI / 4.0) * ZCR * MOMG(ZALPHAR,ZNUR,ZDR+XFR+2.) * &
+ PRHO00**ZCEXVT
+ELSE
+ XEXQRCFRIG = XCXR - ZDR - XFR - 2.0
+ XQRCFRIG = (XPI / 4.0) * ZCR * ZCCR * MOMG(ZALPHAR,ZNUR,ZDR+XFR+2.) * &
+ PRHO00**ZCEXVT
+END IF
!
!
!-------------------------------------------------------------------------------
@@ -350,7 +616,7 @@ ALLOCATE( XIND_RATE(IIU, IJU, IKU) )
ALLOCATE( XEW(IIU, IJU, IKU) )
XEW(:,:,:) = 0.
!
-SELECT CASE(HGETSVM(NSV_ELECEND))
+SELECT CASE(HGETSVT(NSV_ELECEND))
CASE ('READ')
CALL IO_Field_read(TPINIFILE,'NI_IAGGS',XNI_IAGGS)
CALL IO_Field_read(TPINIFILE,'NI_IDRYG',XNI_IDRYG)
@@ -399,39 +665,39 @@ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
XSKN = 24.
XSKN_TAK = 2.0 ! for Takahashi
!
- XFQIAGGSP = XIKP * XCS**(1. + XINP) * &
- MOMG(XALPHAS, XNUS, 2.+XDS*(1.+XINP)) * &
- MOMG(XALPHAI, XNUI, XIMP)
- XFQIAGGSN = XIKN * XCS**(1. + XINN) * &
- MOMG(XALPHAS, XNUS, 2.+XDS*(1.+XINN)) * &
- MOMG(XALPHAI, XNUI, XIMN)
+ XFQIAGGSP = XIKP * ZCS**(1. + XINP) * &
+ MOMG(ZALPHAS, ZNUS, 2.+ZDS*(1.+XINP)) * &
+ MOMG(ZALPHAI, ZNUI, XIMP)
+ XFQIAGGSN = XIKN * ZCS**(1. + XINN) * &
+ MOMG(ZALPHAS, ZNUS, 2.+ZDS*(1.+XINN)) * &
+ MOMG(ZALPHAI, ZNUI, XIMN)
!
- XFQIDRYGBSP = XIKP * XCG**(1. + XINP) * &
- MOMG(XALPHAG, XNUG, 2.+XDG*(1.+XINP)) * &
- MOMG(XALPHAI, XNUI, XIMP)
- XFQIDRYGBSN = XIKN * XCG**(1. + XINN) * &
- MOMG(XALPHAG, XNUG, 2.+XDG*(1.+XINN)) * &
- MOMG(XALPHAI, XNUI, XIMN)
+ XFQIDRYGBSP = XIKP * ZCG**(1. + XINP) * &
+ MOMG(ZALPHAG, ZNUG, 2.+ZDG*(1.+XINP)) * &
+ MOMG(ZALPHAI, ZNUI, XIMP)
+ XFQIDRYGBSN = XIKN * ZCG**(1. + XINN) * &
+ MOMG(ZALPHAG, ZNUG, 2.+ZDG*(1.+XINN)) * &
+ MOMG(ZALPHAI, ZNUI, XIMN)
!
XFQIAGGSP_TAK = XFQIAGGSP * XIKP_TAK / XIKP
XFQIAGGSN_TAK = XFQIAGGSN * XIKN_TAK / XIKN
XFQIDRYGBSP_TAK = XFQIDRYGBSP * XIKP_TAK / XIKP
XFQIDRYGBSN_TAK = XFQIDRYGBSN * XIKN_TAK / XIKN
!
- XAIGAMMABI = XAI * MOMG(XALPHAI, XNUI, XBI)
+ XAIGAMMABI = ZAI * MOMG(ZALPHAI, ZNUI, ZBI)
!
- XLBQSDRYGB1SP = MOMG(XALPHAG,XNUG,2.) * MOMG(XALPHAS, XNUS, XSMP)
- XLBQSDRYGB1SN = MOMG(XALPHAG,XNUG,2.) * MOMG(XALPHAS, XNUS, XSMN)
- XLBQSDRYGB2SP = 2. * MOMG(XALPHAG,XNUG,1.) * MOMG(XALPHAS, XNUS, 1.+XSMP)
- XLBQSDRYGB2SN = 2. * MOMG(XALPHAG,XNUG,1.) * MOMG(XALPHAS, XNUS, 1.+XSMN)
- XLBQSDRYGB3SP = MOMG(XALPHAS, XNUS, 2.+XSMP)
- XLBQSDRYGB3SN = MOMG(XALPHAS, XNUS, 2.+XSMN)
+ XLBQSDRYGB1SP = MOMG(ZALPHAG,ZNUG,2.) * MOMG(ZALPHAS, ZNUS, XSMP)
+ XLBQSDRYGB1SN = MOMG(ZALPHAG,ZNUG,2.) * MOMG(ZALPHAS, ZNUS, XSMN)
+ XLBQSDRYGB2SP = 2. * MOMG(ZALPHAG,ZNUG,1.) * MOMG(ZALPHAS, ZNUS, 1.+XSMP)
+ XLBQSDRYGB2SN = 2. * MOMG(ZALPHAG,ZNUG,1.) * MOMG(ZALPHAS, ZNUS, 1.+XSMN)
+ XLBQSDRYGB3SP = MOMG(ZALPHAS, ZNUS, 2.+XSMP)
+ XLBQSDRYGB3SN = MOMG(ZALPHAS, ZNUS, 2.+XSMN)
ENDIF
!
IF (CNI_CHARGING == 'SAP98' .OR. CNI_CHARGING == 'TERAR' .OR. &
CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2') THEN
- XVSCOEF = XCS * MOMG(XALPHAS, XNUS, XBS+XDS) / MOMG(XALPHAS, XNUS, XBS)
- XVGCOEF = XCG * MOMG(XALPHAG, XNUG, XBG+XDG) / MOMG(XALPHAG, XNUG, XBG)
+ XVSCOEF = ZCS * MOMG(ZALPHAS, ZNUS, ZBS+ZDS) / MOMG(ZALPHAS, ZNUS, ZBS)
+ XVGCOEF = ZCG * MOMG(ZALPHAG, ZNUG, ZBG+ZDG) / MOMG(ZALPHAG, ZNUG, ZBG)
END IF
!
!
@@ -568,7 +834,7 @@ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
ALLOCATE(ZT(NIND_TEMP+1)) ! Kelvin
ALLOCATE(ZLWCC(NIND_TEMP+1))
DO JTEMP = 1, NIND_TEMP+1
- ZT(JTEMP)=1.0-REAL(JTEMP)+XTT
+ ZT(JTEMP) = 1.0 - REAL(JTEMP) + XTT
END DO
ZLWCC(:) = MIN( MAX( -0.49 + 6.64E-2*(XTT-ZT(:)),0.22 ),1.1 ) ! (g m^-3)
ALLOCATE(ZEW(NIND_LWC+1))
@@ -578,13 +844,13 @@ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
! 0.10 to 0.90 every 0.10 (9 values)
! 1.00 to 10.0 every 1.00 (10 values)
DO JLWC = 1, 9
- ZEW(JLWC)=0.01*REAL(JLWC)
+ ZEW(JLWC) = 0.01 * REAL(JLWC)
END DO
DO JLWC = 10, 18
- ZEW(JLWC)=0.1 + 0.1*REAL(JLWC-10)
+ ZEW(JLWC) = 0.1 + 0.1 * REAL(JLWC-10)
END DO
DO JLWC = 19, NIND_LWC+1
- ZEW(JLWC)=1.0 + REAL(JLWC-19)
+ ZEW(JLWC) = 1.0 + REAL(JLWC-19)
END DO
!
!
@@ -806,24 +1072,38 @@ XFQIAGGSBH = 2.E-14 ! (C.) Constant for ice-snow charging process
!
!* 9.2 Gardiner et al. (1985) parameterization
!
-XFQIAGGSBG = (XPI / 4.0) * XCCS * XCS**4. * PRHO00**(4. * XCEXVT) * &
- MOMG(XALPHAS,XNUS,2.+4.*XDS) * 7.3 * &
- MOMG(XALPHAI,XNUI,4.)
+IF (HELEC == 'ELE4') THEN
+ XFQIAGGSBG = (XPI / 4.0) * ZCS**4. * PRHO00**(4. * ZCEXVT) * &
+ MOMG(ZALPHAS,ZNUS,2.+4.*ZDS) * 7.3 * &
+ MOMG(ZALPHAI,ZNUI,4.)
+ELSE
+ XFQIAGGSBG = (XPI / 4.0) * ZCCS * ZCS**4. * PRHO00**(4. * ZCEXVT) * &
+ MOMG(ZALPHAS,ZNUS,2.+4.*ZDS) * 7.3 * &
+ MOMG(ZALPHAI,ZNUI,4.)
+END IF
!
!
!* 9.3 Saunders et al.(1991) parameterization
!
-XFQIAGGSBS = (XPI / 4.0) * XCCS
+IF (HELEC == 'ELE4') THEN
+ XFQIAGGSBS = XPI / 4.0
+ELSE
+ XFQIAGGSBS = (XPI / 4.0) * ZCCS
+END IF
!
!
!* 9.4 Takahashi (1978) parameterization
!
IF (CNI_CHARGING == 'TAKAH') THEN
- XFQIAGGSBT1 = (XPI / 4.0) * XCCS * XCS
- XFQIAGGSBT2 = 10 * MOMG(XALPHAS,XNUS,2.+XDS)
- XFQIAGGSBT3 = 5. * XCS * MOMG(XALPHAI,XNUI,2.) * &
- MOMG(XALPHAS,XNUS,2.+2*XDS) / ((1.E-4)**2 * 8. * &
- (XAI * MOMG(XALPHAI,XNUI,XBI))**(2 / XBI))
+ IF (HELEC == 'ELE4') THEN
+ XFQIAGGSBT1 = (XPI / 4.0) * ZCS
+ ELSE
+ XFQIAGGSBT1 = (XPI / 4.0) * ZCCS * ZCS
+ END IF
+ XFQIAGGSBT2 = 10. * MOMG(ZALPHAS,ZNUS,2.+ZDS)
+ XFQIAGGSBT3 = 5. * ZCS * MOMG(ZALPHAI,ZNUI,2.) * &
+ MOMG(ZALPHAS,ZNUS,2.+2.*ZDS) / ((1.E-4)**2 * 8. * &
+ (ZAI * MOMG(ZALPHAI,ZNUI,ZBI))**(2. / ZBI))
END IF
!
!
@@ -832,36 +1112,43 @@ END IF
!* 10. ACCRETION OF RAINDROPS ON SNOW
! ------------------------------
!
-IF( .NOT.ALLOCATED(XKER_Q_RACCSS)) ALLOCATE( XKER_Q_RACCSS(NACCLBDAS,NACCLBDAR) )
-IF( .NOT.ALLOCATED(XKER_Q_RACCS)) ALLOCATE( XKER_Q_RACCS (NACCLBDAS,NACCLBDAR) )
-IF( .NOT.ALLOCATED(XKER_Q_SACCRG)) ALLOCATE( XKER_Q_SACCRG(NACCLBDAR,NACCLBDAS) )
+IF( .NOT.ALLOCATED(XKER_Q_RACCSS)) ALLOCATE( XKER_Q_RACCSS(IACCLBDAS,IACCLBDAR) )
+IF( .NOT.ALLOCATED(XKER_Q_RACCS)) ALLOCATE( XKER_Q_RACCS (IACCLBDAS,IACCLBDAR) )
+IF( .NOT.ALLOCATED(XKER_Q_SACCRG)) ALLOCATE( XKER_Q_SACCRG(IACCLBDAR,IACCLBDAS) )
!
-XFQRACCS = (XPI / 4.0) * XCCS * XCCR * (PRHO00**XCEXVT)
+IF (HELEC == 'ELE4') THEN
+ XFQRACCS = (XPI / 4.0) * PRHO00**ZCEXVT
+ELSE
+ XFQRACCS = (XPI / 4.0) * ZCCS * ZCCR * (PRHO00**ZCEXVT)
+END IF
!
-XLBQRACCS1 = MOMG(XALPHAR,XNUR,2.+XFR)
-XLBQRACCS2 = 2. * MOMG(XALPHAR,XNUR,1.+XFR) * MOMG(XALPHAS,XNUS,1.)
-XLBQRACCS3 = MOMG(XALPHAR,XNUR,XFR) * MOMG(XALPHAS,XNUS,2.)
+XLBQRACCS1 = MOMG(ZALPHAR,ZNUR,2.+XFR)
+XLBQRACCS2 = 2. * MOMG(ZALPHAR,ZNUR,1.+XFR) * MOMG(ZALPHAS,ZNUS,1.)
+XLBQRACCS3 = MOMG(ZALPHAR,ZNUR,XFR) * MOMG(ZALPHAS,ZNUS,2.)
!
-XLBQSACCRG1 = MOMG(XALPHAS,XNUS,2.+XFS)
-XLBQSACCRG2 = 2. * MOMG(XALPHAS,XNUS,1.+XFS) * MOMG(XALPHAR,XNUR,1.)
-XLBQSACCRG3 = MOMG(XALPHAS,XNUS,XFS) * MOMG(XALPHAR,XNUR,2.)
+XLBQSACCRG1 = MOMG(ZALPHAS,ZNUS,2.+XFS)
+XLBQSACCRG2 = 2. * MOMG(ZALPHAS,ZNUS,1.+XFS) * MOMG(ZALPHAR,ZNUR,1.)
+XLBQSACCRG3 = MOMG(ZALPHAS,ZNUS,XFS) * MOMG(ZALPHAR,ZNUR,2.)
!
-ZESR = 1.0
+! These values are pasted from ini_rain_ice (7.2.2)
+IND = 50 ! Interval number, collection efficiency and infinite diameter
+ZESR = 1.0 ! factor used to integrate the dimensional distributions when
+ZFDINFTY = 20.0 ! computing the kernels XKER_RACCSS, XKER_RACCS and XKER_SACCRG
!
-CALL RRCOLSS (KND, XALPHAS, XNUS, XALPHAR, XNUR, &
- ZESR, XFR, XCS, XDS, 0., XCR, XDR, &
- XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
- PFDINFTY, XKER_Q_RACCSS, XAG, XBS, XAS )
+CALL RRCOLSS (IND, ZALPHAS, ZNUS, ZALPHAR, ZNUR, &
+ ZESR, XFR, ZCS, ZDS, 0., ZCR, ZDR, &
+ ZACCLBDAS_MAX, ZACCLBDAR_MAX, ZACCLBDAS_MIN, ZACCLBDAR_MIN, &
+ ZFDINFTY, XKER_Q_RACCSS, ZAG, ZBS, ZAS )
!
-CALL RZCOLX (KND, XALPHAS, XNUS, XALPHAR, XNUR, &
- ZESR, XFR, XCS, XDS, 0., XCR, XDR, 0., &
- XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
- PFDINFTY, XKER_Q_RACCS )
+CALL RZCOLX (IND, ZALPHAS, ZNUS, ZALPHAR, ZNUR, &
+ ZESR, XFR, ZCS, ZDS, 0., ZCR, ZDR, 0., &
+ ZACCLBDAS_MAX, ZACCLBDAR_MAX, ZACCLBDAS_MIN, ZACCLBDAR_MIN, &
+ ZFDINFTY, XKER_Q_RACCS )
!
-CALL RSCOLRG (KND, XALPHAS, XNUS, XALPHAR, XNUR, &
- ZESR, XFS, XCS, XDS, 0., XCR, XDR, &
- XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
- PFDINFTY, XKER_Q_SACCRG, XAG, XBS, XAS )
+CALL RSCOLRG (IND, ZALPHAS, ZNUS, ZALPHAR, ZNUR, &
+ ZESR, XFS, ZCS, ZDS, 0., ZCR, ZDR, &
+ ZACCLBDAS_MAX, ZACCLBDAR_MAX, ZACCLBDAS_MIN, ZACCLBDAR_MIN, &
+ ZFDINFTY, XKER_Q_SACCRG, ZAG, ZBS, ZAS )
!
!-------------------------------------------------------------------------------
!
@@ -870,20 +1157,24 @@ CALL RSCOLRG (KND, XALPHAS, XNUS, XALPHAR, XNUR, &
!
!* 11.1 charge transfer associated to mass transfer
!
-IF( .NOT.ALLOCATED(XKER_Q_SDRYG)) ALLOCATE( XKER_Q_SDRYG(NDRYLBDAG,NDRYLBDAS) )
+IF( .NOT.ALLOCATED(XKER_Q_SDRYG)) ALLOCATE( XKER_Q_SDRYG(IDRYLBDAG,IDRYLBDAS) )
!
-XFQSDRYG = (XPI / 4.0) * XCCS * XCCG * (PRHO00**XCEXVT)
+IF (HELEC == 'ELE4') THEN
+ XFQSDRYG = (XPI / 4.0) * (PRHO00**ZCEXVT)
+ELSE
+ XFQSDRYG = (XPI / 4.0) * ZCCS * ZCCG * (PRHO00**ZCEXVT)
+END IF
!
-XLBQSDRYG1 = MOMG(XALPHAS,XNUS,2.+XFS)
-XLBQSDRYG2 = 2. * MOMG(XALPHAS,XNUS,1.+XFS) * MOMG(XALPHAG,XNUG,1.)
-XLBQSDRYG3 = MOMG(XALPHAS,XNUS,XFS) * MOMG(XALPHAG,XNUG,2.)
+XLBQSDRYG1 = MOMG(ZALPHAS,ZNUS,2.+XFS)
+XLBQSDRYG2 = 2. * MOMG(ZALPHAS,ZNUS,1.+XFS) * MOMG(ZALPHAG,ZNUG,1.)
+XLBQSDRYG3 = MOMG(ZALPHAS,ZNUS,XFS) * MOMG(ZALPHAG,ZNUG,2.)
!
ZEGS = 1. ! also initialized in ini_rain_ice_elec
!
-CALL RZCOLX (KND, XALPHAG, XNUG, XALPHAS, XNUS, &
- ZEGS, XFS, XCG, XDG, 0., XCS, XDS, 0., &
- XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
- PFDINFTY, XKER_Q_SDRYG )
+CALL RZCOLX (IND, ZALPHAG, ZNUG, ZALPHAS, ZNUS, &
+ ZEGS, XFS, ZCG, ZDG, 0., ZCS, ZDS, 0., &
+ ZDRYLBDAG_MAX, ZDRYLBDAS_MAX, ZDRYLBDAG_MIN, ZDRYLBDAS_MIN, &
+ ZFDINFTY, XKER_Q_SDRYG )
!
!
!* 11.2 NI process: Heldson et Farley (1987) parameterization
@@ -892,39 +1183,46 @@ IF (CNI_CHARGING == 'HELFA') THEN
XHIDRYG = 2.E-15 ! Charge exchanged per collision between ice and graupel
XHSDRYG = 2.E-14
!
- XFQSDRYGBH = (XPI / 4.0) * XCCG * XCCS * (PRHO00**(XCEXVT)) * XHSDRYG
+ IF (HELEC == 'ELE4') THEN
+ XFQSDRYGBH = (XPI / 4.0) * PRHO00**(ZCEXVT) * XHSDRYG
+ ELSE
+ XFQSDRYGBH = (XPI / 4.0) * ZCCG * ZCCS * (PRHO00**(ZCEXVT)) * XHSDRYG
+ END IF
!
- XLBQSDRYGB4H = MOMG(XALPHAS,XNUS,2.)
- XLBQSDRYGB5H = 2. * MOMG(XALPHAS,XNUS,1.) * MOMG(XALPHAG,XNUG,1.)
- XLBQSDRYGB6H = MOMG(XALPHAG,XNUG,2.)
-!
- IF( .NOT.ALLOCATED(XKER_Q_SDRYGB)) ALLOCATE( XKER_Q_SDRYGB(NDRYLBDAG,NDRYLBDAS) )
- CALL RZCOLX (KND, XALPHAG, XNUG, XALPHAS, XNUS, &
- ZEGS, 0., XCG, XDG, 0., XCS, XDS, 0., &
- XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
- PFDINFTY, XKER_Q_SDRYGB )
+ XLBQSDRYGB4H = MOMG(ZALPHAS,ZNUS,2.)
+ XLBQSDRYGB5H = 2. * MOMG(ZALPHAS,ZNUS,1.) * MOMG(ZALPHAG,ZNUG,1.)
+ XLBQSDRYGB6H = MOMG(ZALPHAG,ZNUG,2.)
+!
+ IF( .NOT.ALLOCATED(XKER_Q_SDRYGB)) ALLOCATE( XKER_Q_SDRYGB(IDRYLBDAG,IDRYLBDAS) )
+ CALL RZCOLX (IND, ZALPHAG, ZNUG, ZALPHAS, ZNUS, &
+ ZEGS, 0., ZCG, ZDG, 0., ZCS, ZDS, 0., &
+ ZDRYLBDAG_MAX, ZDRYLBDAS_MAX, ZDRYLBDAG_MIN, ZDRYLBDAS_MIN, &
+ ZFDINFTY, XKER_Q_SDRYGB )
! Delta vqb1_sg
ENDIF
!
!
!* 11.3 NI process: Gardiner et al. (1985) parameterization
!
-IF (CNI_CHARGING == 'GARDI') THEN
- XFQIDRYGBG = (XPI / 4.0) * XCCG * (PRHO00**(4. * XCEXVT)) * XCG**4. * &
- 7.3
- XLBQIDRYGBG = MOMG(XALPHAI,XNUI,4.) * MOMG(XALPHAG,XNUG,2.+4.*XDG)
-!
- XFQSDRYGBG = (XPI / 4.0) * XCCS * XCCG * (PRHO00**(4. * XCEXVT)) * &
- 7.3
- XLBQSDRYGB4G = MOMG(XALPHAS,XNUS,4.) * MOMG(XALPHAG,XNUG,2.)
- XLBQSDRYGB5G = 2. * MOMG(XALPHAS,XNUS,5.) * MOMG(XALPHAG,XNUG,1.)
- XLBQSDRYGB6G = MOMG(XALPHAS,XNUS,6.)
-!
- IF( .NOT.ALLOCATED(XKER_Q_SDRYGB)) ALLOCATE( XKER_Q_SDRYGB(NDRYLBDAG,NDRYLBDAS) )
- CALL VQZCOLX (KND, XALPHAG, XNUG, XALPHAS, XNUS, &
- ZEGS, 4., XCG, XDG, XCS, XDS, 4., &
- XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
- PFDINFTY, XKER_Q_SDRYGB )
+IF (CNI_CHARGING == 'GARDI') THEN
+ IF (HELEC == 'ELE4') THEN
+ XFQIDRYGBG = (XPI / 4.0) * PRHO00**(4.*ZCEXVT) * ZCG**4. * 7.3
+ XFQSDRYGBG = (XPI / 4.0) * PRHO00**(4.*ZCEXVT) * 7.3
+ ELSE
+ XFQIDRYGBG = (XPI / 4.0) * ZCCG * (PRHO00**(4.*ZCEXVT)) * ZCG**4. * 7.3
+ XFQSDRYGBG = (XPI / 4.0) * ZCCS * ZCCG * (PRHO00**(4.*ZCEXVT)) * 7.3
+ END IF
+ XLBQIDRYGBG = MOMG(ZALPHAI,ZNUI,4.) * MOMG(ZALPHAG,ZNUG,2.+4.*ZDG)
+!
+ XLBQSDRYGB4G = MOMG(ZALPHAS,ZNUS,4.) * MOMG(ZALPHAG,ZNUG,2.)
+ XLBQSDRYGB5G = 2. * MOMG(ZALPHAS,ZNUS,5.) * MOMG(ZALPHAG,ZNUG,1.)
+ XLBQSDRYGB6G = MOMG(ZALPHAS,ZNUS,6.)
+!
+ IF( .NOT.ALLOCATED(XKER_Q_SDRYGB)) ALLOCATE( XKER_Q_SDRYGB(IDRYLBDAG,IDRYLBDAS) )
+ CALL VQZCOLX (IND, ZALPHAG, ZNUG, ZALPHAS, ZNUS, &
+ ZEGS, 4., ZCG, ZDG, ZCS, ZDS, 4., &
+ ZDRYLBDAG_MAX, ZDRYLBDAS_MAX, ZDRYLBDAG_MIN, ZDRYLBDAS_MIN, &
+ ZFDINFTY, XKER_Q_SDRYGB )
END IF
!
!
@@ -935,25 +1233,30 @@ IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
CNI_CHARGING == 'SAP98' .OR. &
CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2' .OR. &
CNI_CHARGING == 'TEEWC' .OR. CNI_CHARGING == 'TERAR') THEN
- XFQIDRYGBS = (XPI / 4.0) * XCCG
- XFQSDRYGBS = (XPI / 4.0) * XCCS * XCCG
- XLBQSDRYGB1S = MOMG(XALPHAG,XNUG,2.)
- XLBQSDRYGB2S = 2. * MOMG(XALPHAG,XNUG,1.)
-!
- IF( .NOT.ALLOCATED(XKER_Q_SDRYGB1)) ALLOCATE( XKER_Q_SDRYGB1(NDRYLBDAG,NDRYLBDAS) )
- IF( .NOT.ALLOCATED(XKER_Q_SDRYGB2)) ALLOCATE( XKER_Q_SDRYGB2(NDRYLBDAG,NDRYLBDAS) )
+ IF (HELEC == 'ELE4') THEN
+ XFQIDRYGBS = XPI / 4.0
+ XFQSDRYGBS = XPI / 4.0
+ ELSE
+ XFQIDRYGBS = (XPI / 4.0) * ZCCG
+ XFQSDRYGBS = (XPI / 4.0) * ZCCS * ZCCG
+ END IF
+ XLBQSDRYGB1S = MOMG(ZALPHAG,ZNUG,2.)
+ XLBQSDRYGB2S = 2. * MOMG(ZALPHAG,ZNUG,1.)
+!
+ IF( .NOT.ALLOCATED(XKER_Q_SDRYGB1)) ALLOCATE( XKER_Q_SDRYGB1(IDRYLBDAG,IDRYLBDAS) )
+ IF( .NOT.ALLOCATED(XKER_Q_SDRYGB2)) ALLOCATE( XKER_Q_SDRYGB2(IDRYLBDAG,IDRYLBDAS) )
!
! Positive charging region
- CALL VQZCOLX (KND, XALPHAG, XNUG, XALPHAS, XNUS, &
- ZEGS, XSMP, XCG, XDG, XCS, XDS, (1.+XSNP), &
- XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
- PFDINFTY, XKER_Q_SDRYGB1 )
+ CALL VQZCOLX (IND, ZALPHAG, ZNUG, ZALPHAS, ZNUS, &
+ ZEGS, XSMP, ZCG, ZDG, ZCS, ZDS, (1.+XSNP), &
+ ZDRYLBDAG_MAX, ZDRYLBDAS_MAX, ZDRYLBDAG_MIN, ZDRYLBDAS_MIN, &
+ ZFDINFTY, XKER_Q_SDRYGB1 )
!
! Negative charging region
- CALL VQZCOLX (KND, XALPHAG, XNUG, XALPHAS, XNUS, &
- ZEGS, XSMN, XCG, XDG, XCS, XDS, (1.+XSNN), &
- XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
- PFDINFTY, XKER_Q_SDRYGB2 )
+ CALL VQZCOLX (IND, ZALPHAG, ZNUG, ZALPHAS, ZNUS, &
+ ZEGS, XSMN, ZCG, ZDG, ZCS, ZDS, (1.+XSNN), &
+ ZDRYLBDAG_MAX, ZDRYLBDAS_MAX, ZDRYLBDAG_MIN, ZDRYLBDAS_MIN, &
+ ZFDINFTY, XKER_Q_SDRYGB2 )
ENDIF
!
!
@@ -962,30 +1265,38 @@ ENDIF
IF (CNI_CHARGING == 'TAKAH') THEN
!
! IDRYG_boun
- XFQIDRYGBT1 = (XPI / 4.0) * XCCG * XCG
- XFQIDRYGBT2 = 10.0 * MOMG(XALPHAG,XNUG,2.+XDG)
- XFQIDRYGBT3 = 5.0 * XCG * MOMG(XALPHAI,XNUI,2.) * &
- MOMG(XALPHAG,XNUG,2.+2.*XDG) / ((2.E-4)**2 * 8. * &
- (XAI * MOMG(XALPHAI,XNUI,XBI))**(2 / XBI))
+ IF (HELEC == 'ELE4') THEN
+ XFQIDRYGBT1 = (XPI / 4.0) * ZCG
+ ELSE
+ XFQIDRYGBT1 = (XPI / 4.0) * ZCCG * ZCG
+ END IF
+ XFQIDRYGBT2 = 10.0 * MOMG(ZALPHAG,ZNUG,2.+ZDG)
+ XFQIDRYGBT3 = 5.0 * ZCG * MOMG(ZALPHAI,ZNUI,2.) * &
+ MOMG(ZALPHAG,ZNUG,2.+2.*ZDG) / ((2.E-4)**2 * 8. * &
+ (ZAI * MOMG(ZALPHAI,ZNUI,ZBI))**(2./ZBI))
!
! SDRYG_boun
- XFQSDRYGBT1 = (XPI / 4.0) * XCCG * XCCS
- XFQSDRYGBT2 = XCG * MOMG(XALPHAG,XNUG,XDG) * MOMG(XALPHAS,XNUS,2.)
- XFQSDRYGBT3 = XCS * MOMG(XALPHAS,XNUS,2.+XDS)
- XFQSDRYGBT4 = XCG * MOMG(XALPHAG,XNUG,2.+XDG)
- XFQSDRYGBT5 = XCS * MOMG(XALPHAG,XNUG,2.) * MOMG(XALPHAS,XNUS,XDS)
- XFQSDRYGBT6 = 2. * XCG * MOMG(XALPHAG,XNUG,1.+XDG) * MOMG(XALPHAS,XNUS,1.)
- XFQSDRYGBT7 = 2. * XCS * MOMG(XALPHAG,XNUG,1.) * MOMG(XALPHAS,XNUS,1.+XDS)
+ IF (HELEC == 'ELE4') THEN
+ XFQSDRYGBT1 = XPI / 4.0
+ ELSE
+ XFQSDRYGBT1 = (XPI / 4.0) * ZCCG * ZCCS
+ END IF
+ XFQSDRYGBT2 = ZCG * MOMG(ZALPHAG,ZNUG,ZDG) * MOMG(ZALPHAS,ZNUS,2.)
+ XFQSDRYGBT3 = ZCS * MOMG(ZALPHAS,ZNUS,2.+ZDS)
+ XFQSDRYGBT4 = ZCG * MOMG(ZALPHAG,ZNUG,2.+ZDG)
+ XFQSDRYGBT5 = ZCS * MOMG(ZALPHAG,ZNUG,2.) * MOMG(ZALPHAS,ZNUS,ZDS)
+ XFQSDRYGBT6 = 2. * ZCG * MOMG(ZALPHAG,ZNUG,1.+ZDG) * MOMG(ZALPHAS,ZNUS,1.)
+ XFQSDRYGBT7 = 2. * ZCS * MOMG(ZALPHAG,ZNUG,1.) * MOMG(ZALPHAS,ZNUS,1.+ZDS)
XFQSDRYGBT8 = 5. / ((1.E-4)**2 * 8.)
- XFQSDRYGBT9 = MOMG(XALPHAG,XNUG,2.) * MOMG(XALPHAS,XNUS,2.)
- XFQSDRYGBT10 = MOMG(XALPHAS,XNUS,4.)
- XFQSDRYGBT11 = 2. * MOMG(XALPHAG,XNUG,1.) * MOMG(XALPHAS,XNUS,3.)
-!
- IF( .NOT.ALLOCATED(XKER_Q_SDRYGB)) ALLOCATE( XKER_Q_SDRYGB(NDRYLBDAG,NDRYLBDAS) )
- CALL VQZCOLX (KND, XALPHAG, XNUG, XALPHAS, XNUS, &
- ZEGS, 2., XCG, XDG, XCS, XDS, 2., &
- XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
- PFDINFTY, XKER_Q_SDRYGB )
+ XFQSDRYGBT9 = MOMG(ZALPHAG,ZNUG,2.) * MOMG(ZALPHAS,ZNUS,2.)
+ XFQSDRYGBT10 = MOMG(ZALPHAS,ZNUS,4.)
+ XFQSDRYGBT11 = 2. * MOMG(ZALPHAG,ZNUG,1.) * MOMG(ZALPHAS,ZNUS,3.)
+!
+ IF( .NOT.ALLOCATED(XKER_Q_SDRYGB)) ALLOCATE( XKER_Q_SDRYGB(IDRYLBDAG,IDRYLBDAS) )
+ CALL VQZCOLX (IND, ZALPHAG, ZNUG, ZALPHAS, ZNUS, &
+ ZEGS, 2., ZCG, ZDG, ZCS, ZDS, 2., &
+ ZDRYLBDAG_MAX, ZDRYLBDAS_MAX, ZDRYLBDAG_MIN, ZDRYLBDAS_MIN, &
+ ZFDINFTY, XKER_Q_SDRYGB )
END IF
!
!
@@ -996,15 +1307,19 @@ IF (CNI_CHARGING == 'TAKAH' .OR. CNI_CHARGING == 'SAP98' .OR. &
CNI_CHARGING == 'GARDI' .OR. &
CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2' .OR. &
CNI_CHARGING == 'TEEWC' .OR. CNI_CHARGING == 'TERAR') THEN
- XAUX_LIM = (XPI / 4.0) * XCCG * XCCS
- XAUX_LIM1 = MOMG(XALPHAS,XNUS,2.)
- XAUX_LIM2 = 2. * MOMG(XALPHAS,XNUS,1.) * MOMG(XALPHAG,XNUG,1.)
- XAUX_LIM3 = MOMG(XALPHAG,XNUG,2.)
- IF( .NOT.ALLOCATED(XKER_Q_LIMSG)) ALLOCATE( XKER_Q_LIMSG(NDRYLBDAG,NDRYLBDAS) )
- CALL RZCOLX (KND, XALPHAG, XNUG, XALPHAS, XNUS, &
- ZEGS, 0., XCG, XDG, 0., XCS, XDS, 0., &
- XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
- PFDINFTY, XKER_Q_LIMSG)
+ IF (HELEC == 'ELE4') THEN
+ XAUX_LIM = XPI / 4.0
+ ELSE
+ XAUX_LIM = (XPI / 4.0) * ZCCG * ZCCS
+ END IF
+ XAUX_LIM1 = MOMG(ZALPHAS,ZNUS,2.)
+ XAUX_LIM2 = 2. * MOMG(ZALPHAS,ZNUS,1.) * MOMG(ZALPHAG,ZNUG,1.)
+ XAUX_LIM3 = MOMG(ZALPHAG,ZNUG,2.)
+ IF( .NOT.ALLOCATED(XKER_Q_LIMSG)) ALLOCATE( XKER_Q_LIMSG(IDRYLBDAG,IDRYLBDAS) )
+ CALL RZCOLX (IND, ZALPHAG, ZNUG, ZALPHAS, ZNUS, &
+ ZEGS, 0., ZCG, ZDG, 0., ZCS, ZDS, 0., &
+ ZDRYLBDAG_MAX, ZDRYLBDAS_MAX, ZDRYLBDAG_MIN, ZDRYLBDAS_MIN, &
+ ZFDINFTY, XKER_Q_LIMSG)
ENDIF
!
!
@@ -1013,20 +1328,24 @@ ENDIF
!* 12. DRY GROWTH OF GRAUPELN BY CAPTURE OF RAINDROP
! ---------------------------------------------
!
-IF( .NOT.ALLOCATED(XKER_Q_RDRYG)) ALLOCATE( XKER_Q_RDRYG(NDRYLBDAG,NDRYLBDAR) )
+IF( .NOT.ALLOCATED(XKER_Q_RDRYG)) ALLOCATE( XKER_Q_RDRYG(IDRYLBDAG,IDRYLBDAR) )
!
-XFQRDRYG = (XPI / 4.0) * XCCG * XCCR * (PRHO00**XCEXVT)
+IF (HELEC == 'ELE4') THEN
+ XFQRDRYG = (XPI / 4.0) * PRHO00**ZCEXVT
+ELSE
+ XFQRDRYG = (XPI / 4.0) * ZCCG * ZCCR * (PRHO00**ZCEXVT)
+END IF
!
-XLBQRDRYG1 = MOMG(XALPHAR,XNUR,2.+XFR)
-XLBQRDRYG2 = 2. * MOMG(XALPHAR,XNUR,1.+XFR) * MOMG(XALPHAG,XNUG,1.)
-XLBQRDRYG3 = MOMG(XALPHAR,XNUR,XFR) * MOMG(XALPHAG,XNUG,2.)
+XLBQRDRYG1 = MOMG(ZALPHAR,ZNUR,2.+XFR)
+XLBQRDRYG2 = 2. * MOMG(ZALPHAR,ZNUR,1.+XFR) * MOMG(ZALPHAG,ZNUG,1.)
+XLBQRDRYG3 = MOMG(ZALPHAR,ZNUR,XFR) * MOMG(ZALPHAG,ZNUG,2.)
!
ZEGR = 1.0
!
-CALL RZCOLX (KND, XALPHAG, XNUG, XALPHAR, XNUR, &
- ZEGR, XFR, XCG, XDG, 0., XCR, XDR, 0., &
- XDRYLBDAG_MAX, XDRYLBDAR_MAX, XDRYLBDAG_MIN, XDRYLBDAR_MIN, &
- PFDINFTY, XKER_Q_RDRYG )
+CALL RZCOLX (IND, ZALPHAG, ZNUG, ZALPHAR, ZNUR, &
+ ZEGR, XFR, ZCG, ZDG, 0., ZCR, ZDR, 0., &
+ ZDRYLBDAG_MAX, ZDRYLBDAR_MAX, ZDRYLBDAG_MIN, ZDRYLBDAR_MIN, &
+ ZFDINFTY, XKER_Q_RDRYG )
!
!
!-------------------------------------------------------------------------------
@@ -1034,15 +1353,17 @@ CALL RZCOLX (KND, XALPHAG, XNUG, XALPHAR, XNUR, &
!* 13. UPDATE THE Q=f(D) RELATION
! --------------------------
!
-XFQUPDC = 400.E6 * MOMG(XALPHACQ,XNUCQ,XFC) / XLBDACQ**XFC ! Nc~400E6 m-3 as
+IF (HCLOUD(1:3) == 'ICE') THEN
+ XFQUPDC = 400.E6 * MOMG(XALPHACQ,XNUCQ,XFC) / XLBDACQ**XFC ! Nc~400E6 m-3 as
! proposed for RCHONI
-!
-XFQUPDR = XCCR * MOMG(XALPHAR,XNUR,XFR)
-XEXFQUPDI = (XFI/XBI)
-XFQUPDI = MOMG(XALPHAI,XNUI,XFI) * (XAI*MOMG(XALPHAI,XNUI,XBI))**(-XEXFQUPDI)
-XFQUPDS = XCCS * MOMG(XALPHAS,XNUS,XFS)
-XFQUPDG = XCCG * MOMG(XALPHAG,XNUG,XFG)
-XFQUPDH = XCCH * MOMG(XALPHAH,XNUH,XFH)
+ !
+ XFQUPDR = ZCCR * MOMG(ZALPHAR,ZNUR,XFR)
+ XEXFQUPDI = XFI / ZBI
+ XFQUPDI = MOMG(ZALPHAI,ZNUI,XFI) * (ZAI * MOMG(ZALPHAI,ZNUI,ZBI))**(-XEXFQUPDI)
+END IF
+XFQUPDS = ZCCS * MOMG(ZALPHAS,ZNUS,XFS)
+XFQUPDG = ZCCG * MOMG(ZALPHAG,ZNUG,XFG)
+XFQUPDH = ZCCH * MOMG(ZALPHAH,ZNUH,XFH)
!
!
!------------------------------------------------------------------------------
@@ -1057,39 +1378,17 @@ XEBOUND = 0.1
XALPHA_IND = 0.07 ! moderate inductive charging
XCOS_THETA = 0.2
!
-XIND1 = (XPI**3 / 8.) * (15.E-6)**2 * &
- XCG * 400.E6 * XCCG * &
- XCOLCG_IND * XEBOUND * XALPHA_IND
-XIND2 = XPI * XEPSILON * XCOS_THETA * MOMG(XALPHAG,XNUG,2.+XDG)
-XIND3 = MOMG(XALPHAG,XNUG,XDG+XFG) / 3.
-!
-!-------------------------------------------------------------------------------
-!
-!* 15. LIGHTNING FLASHES
-! -----------------
-!
-XFQLIGHTC = 660. * MOMG(3.,3.,2.) / MOMG(3.,3.,3.) ! PI/A*lbda^(b-2) = 660.
-!
-XFQLIGHTR = XPI * XCCR * MOMG(XALPHAR,XNUR,2.)
-XEXQLIGHTR = XCXR - 2.
-!
-XEXQLIGHTI = 2. / XBI
-XFQLIGHTI = XPI / 4. * MOMG(XALPHAI,XNUI,2.) * &
- (XAI * MOMG(XALPHAI,XNUI,XBI))**(-XEXQLIGHTI)
-!
-XFQLIGHTS = XPI * XCCS * MOMG(XALPHAS,XNUS,2.)
-XEXQLIGHTS = XCXS - 2.
-!
-XFQLIGHTG = XPI * XCCG * MOMG(XALPHAG,XNUG,2.)
-XEXQLIGHTG = XCXG - 2.
-!
-XFQLIGHTH = XPI * XCCH * MOMG(XALPHAH,XNUH,2.)
-XEXQLIGHTH = XCXH - 2.
-!
-IF( .NOT.ALLOCATED(XNEUT_POS)) ALLOCATE( XNEUT_POS(NLGHTMAX) )
-IF( .NOT.ALLOCATED(XNEUT_NEG)) ALLOCATE( XNEUT_NEG(NLGHTMAX) )
-XNEUT_POS(:) = 0.
-XNEUT_NEG(:) = 0.
+IF (HELEC == 'ELE4') THEN
+ XIND1 = (XPI**3 / 8.) * (15.E-6)**2 * &
+ ZCG * 400.E6 * &
+ XCOLCG_IND * XEBOUND * XALPHA_IND
+ELSE
+ XIND1 = (XPI**3 / 8.) * (15.E-6)**2 * &
+ ZCG * 400.E6 * ZCCG * &
+ XCOLCG_IND * XEBOUND * XALPHA_IND
+END IF
+XIND2 = XPI * XEPSILON * XCOS_THETA * MOMG(ZALPHAG,ZNUG,2.+ZDG)
+XIND3 = MOMG(ZALPHAG,ZNUG,ZDG+XFG) / 3.
!
!-------------------------------------------------------------------------------
!
diff --git a/src/mesonh/micro/ini_rain_ice_elec.f90 b/src/mesonh/micro/ini_rain_ice_elec.f90
index 3a0279455f46639c20443f68f27caa1b166700f3..1a7fa798b429365740460f18850a2215c1a69bb3 100644
--- a/src/mesonh/micro/ini_rain_ice_elec.f90
+++ b/src/mesonh/micro/ini_rain_ice_elec.f90
@@ -208,12 +208,6 @@ IF (CSEDIM == 'SPLI') THEN
END DO SPLIT
END IF
!
-IF (HCLOUD == 'ICE4') THEN
- CALL RAIN_ICE_DESCR_ALLOCATE(7)
-ELSE IF (HCLOUD == 'ICE3') THEN
- CALL RAIN_ICE_DESCR_ALLOCATE(6)
-END IF
-!
XRTMIN(1) = 1.0E-20
XRTMIN(2) = 1.0E-20
XRTMIN(3) = 1.0E-20
diff --git a/src/mesonh/micro/lima_nucleation_procs.f90 b/src/mesonh/micro/lima_nucleation_procs.f90
deleted file mode 100644
index c239ca84cf69c23c4370c8488ee9cb6428669957..0000000000000000000000000000000000000000
--- a/src/mesonh/micro/lima_nucleation_procs.f90
+++ /dev/null
@@ -1,394 +0,0 @@
-!MNH_LIC Copyright 2018-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_LIMA_NUCLEATION_PROCS
-! ###############################
-!
-IMPLICIT NONE
-INTERFACE
- SUBROUTINE LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU,&
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, &
- PNFT, PNAT, PIFT, PINT, PNIT, PNHT, &
- PCLDFR, PICEFR, PPRCFR )
-!
-USE MODD_IO, ONLY: TFILEDATA
-IMPLICIT NONE
-!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water conc. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water conc. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Prinstine ice conc. at t
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! CCN C. available at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN C. activated at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIFT ! IFN C. available at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! IFN C. activated at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIT ! Coated IFN activated at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHT ! CCN hom freezing
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Ice fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Precipitation fraction
-!
-END SUBROUTINE LIMA_NUCLEATION_PROCS
-END INTERFACE
-END MODULE MODI_LIMA_NUCLEATION_PROCS
-! #############################################################################
-SUBROUTINE LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU,&
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, &
- PNFT, PNAT, PIFT, PINT, PNIT, PNHT, &
- PCLDFR, PICEFR, PPRCFR )
-! #############################################################################
-!
-!! PURPOSE
-!! -------
-!! Compute nucleation processes for the time-split version of LIMA
-!!
-!! AUTHOR
-!! ------
-!! B. Vié * CNRM *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 15/03/2018
-! M. Leriche 06/2019: missing update of PNFT after CCN hom. ncl.
-! P. Wautelet 27/02/2020: bugfix: PNFT was not updated after LIMA_CCN_HOM_FREEZING
-! P. Wautelet 27/02/2020: add Z_TH_HINC variable (for budgets)
-! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
-! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation
-! B. Vie 03/2022: Add option for 1-moment pristine ice
-!-------------------------------------------------------------------------------
-!
-use modd_budget, only: lbu_enable, lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, &
- lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
- NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
- tbudgets
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
-USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI, &
- NSV_LIMA_NI, NSV_LIMA_IFN_FREE, NSV_LIMA_IFN_NUCL, NSV_LIMA_IMM_NUCL, NSV_LIMA_HOM_HAZE
-USE MODD_PARAM_LIMA, ONLY : LCOLD, LNUCL, LMEYERS, LSNOW, LWARM, LACTI, LRAIN, LHHONI, &
- NMOD_CCN, NMOD_IFN, NMOD_IMM, XCTMIN, XRTMIN, LSPRO, NMOM_I, NMOM_C
-USE MODD_NEB_n, ONLY : LSUBG_COND
-
-use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
-
-USE MODI_LIMA_CCN_ACTIVATION
-USE MODI_LIMA_CCN_HOM_FREEZING
-USE MODI_LIMA_MEYERS_NUCLEATION
-USE MODI_LIMA_PHILLIPS_IFN_NUCLEATION
-USE MODE_RAIN_ICE_NUCLEATION
-!
-!-------------------------------------------------------------------------------
-!
-IMPLICIT NONE
-!
-!-------------------------------------------------------------------------------
-!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Rain water m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water conc. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water conc. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Prinstine ice conc. at t
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! CCN C. available at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN C. activated at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIFT ! IFN C. available at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! IFN C. activated at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIT ! Coated IFN activated at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHT ! CCN hom. freezing
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Ice fraction
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Precipitation fraction
-!
-!-------------------------------------------------------------------------------
-!
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, Z_TH_HINC, Z_RC_HINC, Z_CC_HINC
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZTHS, ZRIS, ZRVS, ZRHT, ZCIT, ZT
-!
-integer :: idx
-INTEGER :: JL
-!
-!-------------------------------------------------------------------------------
-!
-IF ( LWARM .AND. LACTI .AND. NMOD_CCN >=1 .AND. NMOM_C.GE.2) THEN
-
- IF (.NOT.LSUBG_COND .AND. .NOT.LSPRO) THEN
-
- if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', ptht(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HENU', prvt(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HENU', prct(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_sv ) then
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HENU', pcct(:, :, :) * prhodj(:, :, :) / ptstep )
- do jl = 1, nmod_ccn
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
- call Budget_store_init( tbudgets(idx), 'HENU', pnft(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
- call Budget_store_init( tbudgets(idx), 'HENU', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- end if
- end if
-
- CALL LIMA_CCN_ACTIVATION( TPFILE, &
- PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
- PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT, PCLDFR )
- if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', ptht(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvt(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HENU', prct(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_sv ) then
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HENU', pcct(:, :, :) * prhodj(:, :, :) / ptstep )
- do jl = 1, nmod_ccn
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
- call Budget_store_end( tbudgets(idx), 'HENU', pnft(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
- call Budget_store_end( tbudgets(idx), 'HENU', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- end if
- end if
-
- END IF
-
- WHERE(PCLDFR(:,:,:)<1.E-10 .AND. PRCT(:,:,:)>XRTMIN(2) .AND. PCCT(:,:,:)>XCTMIN(2)) PCLDFR(:,:,:)=1.
-
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-IF ( LCOLD .AND. LNUCL .AND. NMOM_I>=2 .AND. .NOT.LMEYERS .AND. NMOD_IFN >= 1 ) THEN
- if ( lbu_enable ) then
- if ( lbudget_sv ) then
- do jl = 1, nmod_ifn
- idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
- call Budget_store_init( tbudgets(idx), 'HIND', pift(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl - 1 + jl
- call Budget_store_init( tbudgets(idx), 'HIND', pint(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
-
- do jl = 1, nmod_ccn
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
- call Budget_store_init( tbudgets(idx), 'HINC', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- do jl = 1, nmod_imm
- idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
- call Budget_store_init( tbudgets(idx), 'HINC', pnit(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- end if
- end if
-
- CALL LIMA_PHILLIPS_IFN_NUCLEATION (PTSTEP, &
- PRHODREF, PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCIT, PNAT, PIFT, PINT, PNIT, &
- Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, &
- Z_TH_HINC, Z_RC_HINC, Z_CC_HINC, &
- PICEFR )
- WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
-!
- if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'HIND', -z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HIND', z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
- do jl = 1, nmod_ifn
- idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
- call Budget_store_end( tbudgets(idx), 'HIND', pift(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl - 1 + jl
- call Budget_store_end( tbudgets(idx), 'HIND', pint(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- end if
-
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HINC', z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_sv ) then
- if (nmom_c.ge.2) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- end if
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- do jl = 1, nmod_ccn
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
- call Budget_store_end( tbudgets(idx), 'HINC', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- do jl = 1, nmod_imm
- idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
- call Budget_store_end( tbudgets(idx), 'HINC', pnit(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- end if
- end if
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-IF (LCOLD .AND. LNUCL .AND. NMOM_I>=2 .AND. LMEYERS) THEN
- CALL LIMA_MEYERS_NUCLEATION (PTSTEP, &
- PRHODREF, PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCIT, PINT, &
- Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, &
- Z_TH_HINC, Z_RC_HINC, Z_CC_HINC, &
- PICEFR )
- WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
- !
- if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'HIND', -z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HIND', z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_sv ) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
- if (nmod_ifn > 0 ) &
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HIND', &
- z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
- end if
-
- if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HINC', z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_sv ) then
- if (nmom_c.ge.2) then
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- end if
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- if (nmod_ifn > 0 ) &
- call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HINC', &
- -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
- end if
- end if
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-IF (LCOLD .AND. LNUCL .AND. NMOM_I.EQ.1) THEN
- WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
- !
- ZTHS=PTHT/PTSTEP
- ZRVS=PRVT/PTSTEP
- ZRIS=PRIT/PTSTEP
- ZRHT=0.
- ZCIT=PCIT
- ZT=PT
- CALL RAIN_ICE_NUCLEATION(1+JPHEXT, SIZE(PT,1)-JPHEXT, 1+JPHEXT, SIZE(PT,2)-JPHEXT, 1+JPVEXT, SIZE(PT,3)-JPVEXT, 6, &
- PTSTEP, PTHT, PPABST, PRHODJ, PRHODREF, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- ZCIT, PEXNREF, ZTHS, ZRVS, ZRIS, ZT, ZRHT)
- !
-! Z_TH_HIND=ZTHS*PTSTEP-PTHT
-! Z_RI_HIND=ZRIS*PTSTEP-PRIT
-! Z_CI_HIND=ZCIT-PCIT
- PCIT=ZCIT
- PRIT=ZRIS*PTSTEP
- PTHT=ZTHS*PTSTEP
- PRVT=ZRVS*PTSTEP
-! Z_TH_HINC=0.
-! Z_RC_HINC=0.
-! Z_CC_HINC=0.
-! !
-! if ( lbu_enable ) then
-! if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
-! if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'HIND', -z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
-! if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HIND', z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
-! if ( lbudget_sv ) then
-! call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
-! if (nmod_ifn > 0 ) &
-! call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HIND', &
-! z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
-! end if
-!
-! if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
-! if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HINC', z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
-! if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
-! if ( lbudget_sv ) then
-! call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
-! call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
-! if (nmod_ifn > 0 ) &
-! call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HINC', &
-! -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
-! end if
-! end if
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-IF ( LCOLD .AND. LNUCL .AND. LHHONI .AND. NMOD_CCN >= 1 .AND. NMOM_I.GE.2) THEN
- if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HONH', PTHT(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HONH', PRVT(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HONH', PRIT(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_sv ) then
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HONH', PCIT(:, :, :) * prhodj(:, :, :) / ptstep )
- do jl = 1, nmod_ccn
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
- call Budget_store_init( tbudgets(idx), 'HONH', PNFT(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_hom_haze), 'HONH', PNHT(:, :, :) * prhodj(:, :, :) / ptstep )
- end if
- end if
-
- CALL LIMA_CCN_HOM_FREEZING (PRHODREF, PEXNREF, PPABST, PW_NU, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, PNFT, PNHT, &
- PICEFR )
- WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
-!
- if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HONH', PTHT(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HONH', PRVT(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HONH', PRIT(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_sv ) then
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HONH', PCIT(:, :, :) * prhodj(:, :, :) / ptstep )
- do jl = 1, nmod_ccn
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
- call Budget_store_end( tbudgets(idx), 'HONH', PNFT(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_hom_haze), 'HONH', PNHT(:, :, :) * prhodj(:, :, :) / ptstep )
- end if
- end if
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LIMA_NUCLEATION_PROCS
diff --git a/src/mesonh/ext/modd_lima_precip_scavengingn.F90 b/src/mesonh/micro/modd_lima_precip_scavengingn.F90
similarity index 100%
rename from src/mesonh/ext/modd_lima_precip_scavengingn.F90
rename to src/mesonh/micro/modd_lima_precip_scavengingn.F90
diff --git a/src/mesonh/micro/radar_rain_ice.f90 b/src/mesonh/micro/radar_rain_ice.f90
index 13cfa19bd0b4abc4d53a3b7552431aae46ec1aa3..ae504233f2bf27919460e236fe796abf2021b6de 100644
--- a/src/mesonh/micro/radar_rain_ice.f90
+++ b/src/mesonh/micro/radar_rain_ice.f90
@@ -129,7 +129,7 @@ USE MODD_PARAM_LIMA_MIXED, ONLY:XDG_L=>XDG,XLBEXG_L=>XLBEXG,XLBG_L=>XLBG,XCCG_L=
XCXH_L=>XCXH,XDH_L=>XDH,XCH_L=>XCH,XALPHAH_L=>XALPHAH,XNUH_L=>XNUH,XBH_L=>XBH
USE MODD_PARAM_LIMA, ONLY: XALPHAR_L=>XALPHAR,XNUR_L=>XNUR,XALPHAS_L=>XALPHAS,XNUS_L=>XNUS,&
- XALPHAG_L=>XALPHAG,XNUG_L=>XNUG, XALPHAI_L=>XALPHAI,XNUI_L=>XNUI,&
+ XALPHAG_L=>XALPHAG,XNUG_L=>XNUG, XALPHAI_L=>XALPHAI,XNUI_L=>XNUI, NMOM_C, NMOM_R, NMOM_I, &
XRTMIN_L=>XRTMIN,XALPHAC_L=>XALPHAC,XNUC_L=>XNUC,LSNOW_T_L=>LSNOW_T,NMOM_S,NMOM_G,NMOM_H
USE MODD_PARAMETERS
USE MODD_PARAM_n, ONLY : CCLOUD
@@ -254,8 +254,8 @@ IF (SIZE(PRT,4) >= 3) THEN
Z3=7.8
!
ZLBDA(:,:,:) = 0.0
- IF (CCLOUD == 'LIMA') THEN
- GRAIN(:,:,:) =( (PRT(:,:,:,3).GT.XRTMIN_L(3)).AND. PCRT(:,:,:).GT.0.0)
+ IF (CCLOUD == 'LIMA' .AND. NMOM_R.GE.2) THEN
+ GRAIN(:,:,:) =( PRT(:,:,:,3).GT.XRTMIN_L(3) .AND. PCRT(:,:,:).GT.0.0)
ZLBEX=1.0/(-XBR_L)
ZLB_L(:,:,:)=( XAR_L*PCRT(:,:,:)*PRHODREF(:,:,:)*MOMG(XALPHAR_L,XNUR_L,XBR_L) )**(-ZLBEX)
WHERE( GRAIN(:,:,:) )
diff --git a/src/mesonh/turb/modn_param_mfshalln.f90 b/src/mesonh/turb/modn_param_mfshalln.f90
deleted file mode 100644
index 8b137891791fe96927ad78e64b0aad7bded08bdc..0000000000000000000000000000000000000000
--- a/src/mesonh/turb/modn_param_mfshalln.f90
+++ /dev/null
@@ -1 +0,0 @@
-
diff --git a/src/testprogs/aux/modd_misc.F90 b/src/testprogs/aux/modd_misc.F90
index 2642e4f3976ccf45f9c03ee7df8f760a3f241009..bf3c2f272f2283e3a3de739989cc0a66171d3890 100644
--- a/src/testprogs/aux/modd_misc.F90
+++ b/src/testprogs/aux/modd_misc.F90
@@ -34,6 +34,9 @@ TYPE MISC_t
TYPE(TFILEDATA) :: ZTFILE
REAL :: PRSNOW
LOGICAL :: ODIAG_IN_RUN
- CHARACTER(LEN=4) :: CMICRO
+ CHARACTER(LEN=4) :: CMICRO
+ LOGICAL :: OELEC=.FALSE. !< Lightning prognostic scheme
+ CHARACTER(LEN=4) :: CELEC='NONE' !< Name of the electricity scheme
+ LOGICAL :: OSEDIM_BEARD=.FALSE. !< Switch for effect of electrical forces on sedim.
END TYPE MISC_t
END MODULE MODD_MISC
diff --git a/src/testprogs/ice_adjust/main_ice_adjust.F90 b/src/testprogs/ice_adjust/main_ice_adjust.F90
index dca1e7d7160f6565c648cf8d08bc51b8c71a3d49..728acef74c1e0bd043b4d57a24414a4ec6e056ee 100644
--- a/src/testprogs/ice_adjust/main_ice_adjust.F90
+++ b/src/testprogs/ice_adjust/main_ice_adjust.F90
@@ -5,6 +5,7 @@ USE GETDATA_ICE_ADJUST_MOD, ONLY: GETDATA_ICE_ADJUST
USE COMPUTE_DIFF, ONLY: DIFF
USE MODI_ICE_ADJUST
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PHYEX, ONLY: PHYEX_t
USE STACK_MOD
USE OMP_LIB
@@ -56,6 +57,7 @@ INTEGER :: IBL, JLON, JLEV
TYPE(DIMPHYEX_t) :: D, D0
TYPE(PHYEX_t) :: PHYEX
+TYPE(TFILEDATA) :: TPFILE
LOGICAL :: LLCHECK
LOGICAL :: LLCHECKDIFF
LOGICAL :: LLDIFF
@@ -314,9 +316,10 @@ CMICRO='ICE3'
CSCONV='NONE'
CTURB='TKEL'
PTSTEP = 50.000000000000000
+TPFILE%NLU=0
!Default values
-CALL INI_PHYEX(CPROGRAM, 0, .TRUE., IULOUT, 0, 1, &
+CALL INI_PHYEX(CPROGRAM, TPFILE, .TRUE., IULOUT, 0, 1, &
&PTSTEP, ZDZMIN, &
&CMICRO, CSCONV, CTURB, &
&LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0, LDINIT=.FALSE., &
@@ -361,7 +364,7 @@ PHYEX%NEBN%CFRAC_ICE_ADJUST='S' ! Ice/liquid partition rule to use in adjustment
PHYEX%NEBN%CFRAC_ICE_SHALLOW_MF='S' ! Ice/liquid partition rule to use in shallow_mf
!Param initialisation
-CALL INI_PHYEX(CPROGRAM, 0, .TRUE., IULOUT, 0, 1, &
+CALL INI_PHYEX(CPROGRAM, TPFILE, .TRUE., IULOUT, 0, 1, &
&PTSTEP, ZDZMIN, &
&CMICRO, CSCONV, CTURB, &
&LDDEFAULTVAL=.FALSE., LDREADNAM=.FALSE., LDCHECK=.TRUE., KPRINT=2, LDINIT=.TRUE., &
diff --git a/src/testprogs/rain_ice/main_rain_ice.F90 b/src/testprogs/rain_ice/main_rain_ice.F90
index 2dd27371f4979b6161503cf0b48cdb2ebbad37ef..1e381ade159f0174a97a9c60c88676240c49bb1c 100644
--- a/src/testprogs/rain_ice/main_rain_ice.F90
+++ b/src/testprogs/rain_ice/main_rain_ice.F90
@@ -5,6 +5,7 @@ USE GETDATA_RAIN_ICE_MOD, ONLY: GETDATA_RAIN_ICE
USE COMPUTE_DIFF, ONLY: DIFF
USE MODI_RAIN_ICE
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PHYEX, ONLY: PHYEX_t
USE STACK_MOD
USE OMP_LIB
@@ -49,6 +50,7 @@ INTEGER :: IBL, JLON, JLEV
TYPE(DIMPHYEX_t) :: D, D0
TYPE(PHYEX_t) :: PHYEX
+TYPE(TFILEDATA) :: TPFILE
LOGICAL :: LLCHECK
LOGICAL :: LLCHECKDIFF
LOGICAL :: LLDIFF
@@ -56,6 +58,7 @@ INTEGER :: IBLOCK1, IBLOCK2
INTEGER :: ISTSZ, JBLK1, JBLK2
INTEGER :: NTID, ITID
INTEGER :: JRR
+REAL :: ZTHVREFZIKB! for electricity use only
REAL, ALLOCATABLE :: PSTACK(:,:)
TYPE (STACK) :: YLSTACK
@@ -128,7 +131,6 @@ D0%NKB = KLEV
D0%NKE = 1
D0%NKTB = 1
D0%NKTE = KLEV
-
ISTSZ = NPROMA * 20 * KLEV
ALLOCATE (PSTACK (ISTSZ, NGPBLKS))
@@ -136,6 +138,11 @@ TS = OMP_GET_WTIME ()
ZTD = 0.
ZTC = 0.
+IF (PHYEX%MISC%CELEC /='NONE') THEN
+CALL ABORT ! The following value of ZTHVREFZIKB must be removed from the electricity scheme or computed correctly here
+ELSE
+ ZTHVREFZIKB = 0. ! for electricity use only
+END IF
IF (LHOOK) CALL DR_HOOK ('MAIN',0,ZHOOK_HANDLE)
@@ -197,10 +204,10 @@ JBLK2 = (NGPBLKS * (ITID+1)) / NTID
YLSTACK%L = 0
YLSTACK%U = 0
#endif
-
CALL RAIN_ICE (D, PHYEX%CST, PHYEX%PARAM_ICEN, PHYEX%RAIN_ICE_PARAMN, &
- & PHYEX%RAIN_ICE_DESCRN, PHYEX%MISC%TBUCONF, &
- & PTSTEP=PHYEX%MISC%PTSTEP, &
+ & PHYEX%RAIN_ICE_DESCRN, PHYEX%ELEC_PARAM, PHYEX%ELEC_DESCR, &
+ & PHYEX%MISC%TBUCONF, OELEC=PHYEX%MISC%OELEC, OSEDIM_BEARD=PHYEX%MISC%OSEDIM_BEARD, &
+ & PTHVREFZIKB=ZTHVREFZIKB, HCLOUD='ICE3 ', PTSTEP=PHYEX%MISC%PTSTEP, &
& KRR=PHYEX%MISC%KRR, PEXN=PEXNREF(:,:,IBL), &
& PDZZ=PDZZ(:,:,IBL), PRHODJ=PRHODJ(:,:,IBL), PRHODREF=PRHODREF(:,:,IBL),PEXNREF=PEXNREF2(:,:,IBL),&
& PPABST=PPABSM(:,:,IBL), PCIT=PCIT(:,:,IBL), PCLDFR=PCLDFR(:,:,IBL), &
@@ -316,9 +323,10 @@ CMICRO='ICE3'
CSCONV='NONE'
CTURB='TKEL'
PTSTEP = 25.0000000000000
+TPFILE%NLU=0
!Default values
-CALL INI_PHYEX(CPROGRAM, 0, .TRUE., IULOUT, 0, 1, &
+CALL INI_PHYEX(CPROGRAM, TPFILE, .TRUE., IULOUT, 0, 1, &
&PTSTEP, ZDZMIN, &
&CMICRO, CSCONV, CTURB, &
&LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0, LDINIT=.FALSE., &
@@ -356,7 +364,7 @@ PHYEX%PARAM_ICEN%CSUBG_RR_EVAP='NONE'
PHYEX%PARAM_ICEN%CSUBG_PR_PDF='SIGM'
!Param initialisation
-CALL INI_PHYEX(CPROGRAM, 0, .TRUE., IULOUT, 0, 1, &
+CALL INI_PHYEX(CPROGRAM, TPFILE, .TRUE., IULOUT, 0, 1, &
&PTSTEP, ZDZMIN, &
&CMICRO, CSCONV, CTURB, &
&LDDEFAULTVAL=.FALSE., LDREADNAM=.FALSE., LDCHECK=.TRUE., KPRINT=2, LDINIT=.TRUE., &
diff --git a/src/testprogs/rain_ice_old/main_rain_ice_old.F90 b/src/testprogs/rain_ice_old/main_rain_ice_old.F90
index af96129e22f3315d9414a1a877f52ac8c8418ade..c64f69c4b1eb1cecc85b6d93765f1b65c49b216a 100644
--- a/src/testprogs/rain_ice_old/main_rain_ice_old.F90
+++ b/src/testprogs/rain_ice_old/main_rain_ice_old.F90
@@ -5,6 +5,7 @@ USE GETDATA_RAIN_ICE_OLD_MOD, ONLY: GETDATA_RAIN_ICE_OLD
USE COMPUTE_DIFF, ONLY: DIFF
USE MODI_RAIN_ICE_OLD
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PHYEX, ONLY: PHYEX_t
USE STACK_MOD
USE OMP_LIB
@@ -56,6 +57,7 @@ INTEGER :: IBL, JLON, JLEV
TYPE(DIMPHYEX_t) :: D, D0
TYPE(PHYEX_t) :: PHYEX
+TYPE(TFILEDATA) :: TPFILE
LOGICAL :: LLCHECK
LOGICAL :: LLCHECKDIFF
LOGICAL :: LLDIFF
@@ -401,9 +403,10 @@ ZDZMIN=20.
CMICRO='ICE3'
CSCONV='NONE'
CTURB='TKEL'
+TPFILE%NLU=0
!Default values
-CALL INI_PHYEX(CPROGRAM, 0, .TRUE., IULOUT, 0, 1, &
+CALL INI_PHYEX(CPROGRAM, TPFILE, .TRUE., IULOUT, 0, 1, &
&PTSTEP, ZDZMIN, &
&CMICRO, CSCONV, CTURB, &
&LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0, LDINIT=.FALSE., &
@@ -442,7 +445,7 @@ PHYEX%PARAM_ICEN%LSEDIC=LDSEDIC
PHYEX%PARAM_ICEN%CSUBG_AUCV_RC=CSUBG_AUCV_RC
!Param initialisation
-CALL INI_PHYEX(CPROGRAM, 0, .TRUE., IULOUT, 0, 1, &
+CALL INI_PHYEX(CPROGRAM, TPFILE, .TRUE., IULOUT, 0, 1, &
&PTSTEP, ZDZMIN, &
&CMICRO, CSCONV, CTURB, &
&LDDEFAULTVAL=.FALSE., LDREADNAM=.FALSE., LDCHECK=.TRUE., KPRINT=2, LDINIT=.TRUE., &
@@ -522,4 +525,3 @@ SUBROUTINE INIT_GMICRO(D, KRR, NGPBLKS, ODMICRO, PRT, PSSIO, OCND2)
END SUBROUTINE INIT_GMICRO
END PROGRAM
-
diff --git a/src/testprogs/shallow/main_shallow.F90 b/src/testprogs/shallow/main_shallow.F90
index 05281a7a0f05828e6bd0494f753b2edb64d134da..6edca5acf6bffbe910324fd4e4589e501978c8f0 100644
--- a/src/testprogs/shallow/main_shallow.F90
+++ b/src/testprogs/shallow/main_shallow.F90
@@ -5,6 +5,7 @@ USE GETDATA_SHALLOW_MOD, ONLY: GETDATA_SHALLOW
USE COMPUTE_DIFF, ONLY: DIFF
USE MODI_SHALLOW_MF
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PHYEX, ONLY: PHYEX_t
USE STACK_MOD
USE OMP_LIB
@@ -102,6 +103,7 @@ INTEGER :: IBL, JLON, JLEV
TYPE(DIMPHYEX_t) :: D, D0
TYPE(PHYEX_t) :: PHYEX
+TYPE(TFILEDATA) :: TPFILE
LOGICAL :: LLCHECK
LOGICAL :: LLCHECKDIFF
LOGICAL :: LLDIFF
@@ -405,9 +407,10 @@ CMICRO='NONE'
CSCONV='EDKF'
CTURB='TKEL'
PTSTEP = 25.0000000000000
+TPFILE%NLU=0
!Default values
-CALL INI_PHYEX(CPROGRAM, 0, .TRUE., IULOUT, 0, 1, &
+CALL INI_PHYEX(CPROGRAM, TPFILE, .TRUE., IULOUT, 0, 1, &
&PTSTEP, ZDZMIN, &
&CMICRO, CSCONV, CTURB, &
&LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0, LDINIT=.FALSE., &
@@ -428,7 +431,7 @@ PHYEX%NEBN%LSUBG_COND=.TRUE.
PHYEX%NEBN%CFRAC_ICE_SHALLOW_MF='S'
!Param initialisation
-CALL INI_PHYEX(CPROGRAM, 0, .TRUE., IULOUT, 0, 1, &
+CALL INI_PHYEX(CPROGRAM, TPFILE, .TRUE., IULOUT, 0, 1, &
&PTSTEP, ZDZMIN, &
&CMICRO, CSCONV, CTURB, &
&LDDEFAULTVAL=.FALSE., LDREADNAM=.FALSE., LDCHECK=.TRUE., KPRINT=2, LDINIT=.TRUE., &
diff --git a/src/testprogs/turb_mnh/main_turb.F90 b/src/testprogs/turb_mnh/main_turb.F90
index 578d65520c061639dd03b4e951f3981525ad54c7..4111de05aa9e0e4a7249edbf75af943d324a974a 100644
--- a/src/testprogs/turb_mnh/main_turb.F90
+++ b/src/testprogs/turb_mnh/main_turb.F90
@@ -5,6 +5,7 @@ USE GETDATA_TURB_MOD, ONLY: GETDATA_TURB
USE COMPUTE_DIFF, ONLY: DIFF
USE MODI_TURB
USE MODD_DIMPHYEX, ONLY: DIMPHYEX_t
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PHYEX, ONLY: PHYEX_t
USE STACK_MOD
USE OMP_LIB
@@ -111,6 +112,7 @@ INTEGER :: NPROMA, NGPBLKS, NFLEVG
INTEGER :: IBL, JLON, JLEV
TYPE(DIMPHYEX_t) :: D, D0
+TYPE(TFILEDATA) :: TPFILE
TYPE(PHYEX_t) :: PHYEX
LOGICAL :: LLCHECK
LOGICAL :: LLCHECKDIFF
@@ -297,7 +299,7 @@ CALL TURB(PHYEX%CST, PHYEX%CSTURB, PHYEX%MISC%TBUCONF, PHYEX%TURBN, PHYEX%NEBN,
& PHYEX%MISC%O2D, PHYEX%MISC%ONOMIXLG, PHYEX%MISC%OFLAT, PHYEX%MISC%OCOUPLES, PHYEX%MISC%OBLOWSNOW,PHYEX%MISC%OIBM,&
& PHYEX%MISC%OFLYER, PHYEX%MISC%OCOMPUTE_SRC, PHYEX%MISC%PRSNOW, &
& PHYEX%MISC%OOCEAN, PHYEX%MISC%ODEEPOC, PHYEX%MISC%ODIAG_IN_RUN, &
- & PHYEX%TURBN%CTURBLEN_CLOUD,PHYEX%MISC%CMICRO, &
+ & PHYEX%TURBN%CTURBLEN_CLOUD,PHYEX%MISC%CMICRO, PHYEX%MISC%CELEC, &
& PHYEX%MISC%PTSTEP,PHYEX%MISC%ZTFILE, &
& ZDXX(:,:,IBL),ZDYY(:,:,IBL),ZDZZ(:,:,IBL),ZDZX(:,:,IBL),ZDZY(:,:,IBL),ZZZ(:,:,IBL), &
& ZDIRCOSXW,ZDIRCOSYW,ZDIRCOSZW,ZCOSSLOPE,ZSINSLOPE, &
@@ -423,9 +425,10 @@ CMICRO='ICE3'
CSCONV='NONE'
CTURB='TKEL'
PTSTEP = 25.0000000000000
+TPFILE%NLU=0
!Default values
-CALL INI_PHYEX(CPROGRAM, 0, .TRUE., IULOUT, 0, 1, &
+CALL INI_PHYEX(CPROGRAM, TPFILE, .TRUE., IULOUT, 0, 1, &
&PTSTEP, ZDZMIN, &
&CMICRO, CSCONV, CTURB, &
&LDDEFAULTVAL=.TRUE., LDREADNAM=.FALSE., LDCHECK=.FALSE., KPRINT=0, LDINIT=.FALSE., &
@@ -469,7 +472,7 @@ PHYEX%TURBN%XLINI=0.1 !This line should not exist to reproduce operational setup
!was done (erroneously) with XLINI=0.1
!Param initialisation
-CALL INI_PHYEX(CPROGRAM, 0, .TRUE., IULOUT, 0, 1, &
+CALL INI_PHYEX(CPROGRAM, TPFILE, .TRUE., IULOUT, 0, 1, &
&PTSTEP, ZDZMIN, &
&CMICRO, CSCONV, CTURB, &
&LDDEFAULTVAL=.FALSE., LDREADNAM=.FALSE., LDCHECK=.TRUE., KPRINT=2, LDINIT=.TRUE., &
diff --git a/tools/prep_code.sh b/tools/prep_code.sh
index 5165fffc4ebee0d3f18d5ec30baecd108ee93fb8..7e7bd8d6f850ad6d7c081cd8779ec5d7a92e59f2 100755
--- a/tools/prep_code.sh
+++ b/tools/prep_code.sh
@@ -255,28 +255,30 @@ if [ $ilooprm -eq 1 ]; then
cd $sub
files=$(\ls -A)
for file in $files; do
- if [[ "$file" != "gradient_m"* ]]; then
- # Protection only for one line in turb.f90/.F90
- if [[ "$file" == "turb"* ]]; then
- sed -i 's/PLM(IIJB:IIJE,IKTB:IKTE) = PZZ(IIJB:IIJE,IKTB+IKL:IKTE+IKL) - PZZ(IIJB:IIJE,IKTB:IKTE)/PLM(IIJB:IIJE,IKTB : IKTE) = PZZ(IIJB:IIJE,IKTB+IKL:IKTE+IKL) - PZZ(IIJB:IIJE,IKTB : IKTE)/g' $file
- fi
- # Protection
- sed -i 's/JK=IKTB:IKTE/transJKIKTB/g' $file
- sed -i 's/JK=1:IKT/transIKT/g' $file
- sed -i 's/JIJ=IIJB:IIJE/transJIJ/g' $file
- sed -i 's/IKTB+1:IKTE/IKTB1IKTE/g' $file
- # Apply transformation
- sed -i 's/1:IKT/:/g' $file
- sed -i 's/IKTB:IKTE/:/g' $file
- sed -i 's/IIJB:IIJE/:/g' $file
- # Supression protection
- sed -i 's/transJKIKTB/JK=IKTB:IKTE/g' $file
- sed -i 's/transIKT/JK=1:IKT/g' $file
- sed -i 's/transJIJ/JIJ=IIJB:IIJE/g' $file
- sed -i 's/IKTB1IKTE/IKTB+1:IKTE/g' $file
- if [[ "$file" == "turb"* ]]; then
- sed -i 's/IKTB : IKTE/IKTB:IKTE/g' $file
- fi
+ if [[ "$file" != "minpack" ]]; then
+ if [[ "$file" != "gradient_m"* ]]; then
+ # Protection only for one line in turb.f90/.F90
+ if [[ "$file" == "turb"* ]]; then
+ sed -i 's/PLM(IIJB:IIJE,IKTB:IKTE) = PZZ(IIJB:IIJE,IKTB+IKL:IKTE+IKL) - PZZ(IIJB:IIJE,IKTB:IKTE)/PLM(IIJB:IIJE,IKTB : IKTE) = PZZ(IIJB:IIJE,IKTB+IKL:IKTE+IKL) - PZZ(IIJB:IIJE,IKTB : IKTE)/g' $file
+ fi
+ # Protection
+ sed -i 's/JK=IKTB:IKTE/transJKIKTB/g' $file
+ sed -i 's/JK=1:IKT/transIKT/g' $file
+ sed -i 's/JIJ=IIJB:IIJE/transJIJ/g' $file
+ sed -i 's/IKTB+1:IKTE/IKTB1IKTE/g' $file
+ # Apply transformation
+ sed -i 's/1:IKT/:/g' $file
+ sed -i 's/IKTB:IKTE/:/g' $file
+ sed -i 's/IIJB:IIJE/:/g' $file
+ # Supression protection
+ sed -i 's/transJKIKTB/JK=IKTB:IKTE/g' $file
+ sed -i 's/transIKT/JK=1:IKT/g' $file
+ sed -i 's/transJIJ/JIJ=IIJB:IIJE/g' $file
+ sed -i 's/IKTB1IKTE/IKTB+1:IKTE/g' $file
+ if [[ "$file" == "turb"* ]]; then
+ sed -i 's/IKTB : IKTE/IKTB:IKTE/g' $file
+ fi
+ fi
fi
done
cd ..