diff --git a/docs/TODO b/docs/TODO
index 6146bf71d91118dfc05759a0b16550c7e21f79d3..1dd58b63451a32f1fd203bf31e7ff01462fa0dbc 100644
--- a/docs/TODO
+++ b/docs/TODO
@@ -1,6 +1,5 @@
-LOCEAN:
- La clé LOCEAN est dans un module spécifique à Méso-NH (MODD_DYNn).
- Une solution serait de créer un module propre à PHYEX qui contiendrait des clés de contrôle de haut niveau
+Module de clés namelists PHYEX
+Une solution serait de créer un module propre à PHYEX qui contiendrait des clés de contrôle de haut niveau
pour la physique (y en a-t-il d'autres?). Ce module serait initialisé dans Méso-NH à partir de la clé
actuelle qui est sans doute utilisée ailleurs dans le code de Méso-NH
@@ -10,10 +9,19 @@ Dependencies:
- liste dans document Interfaces
- pour AROME placés, en attendant, dans phyex/externals
-Clé de compilation REPRO48 ajoutée pour permettre de reproduire le cycle 48, elle:
-- contourne des corrections de bug
-- modifie l'organisation de calculs
-Cette clé devra être supprimée
+Clé de compilation REPRO48 + REPRO55 ajoutées pour permettre de reproduire le cycle 48 MNH-5.5.0, elles:
+- contournent des corrections de bug
+- modifient l'organisation de calculs
+Ces clés devront être supprimées
+
+Ecrire doc sur marche à suivre pour intégrer un nouveau développement:
+- dev dans MNH Ã faire en array-syntax
+- dev dans AROME Ã faire en boucles do
+- intégration dans PHYEX: en array-syntax avec directives mnh_expand
+- les 3 tests suivants doivent donner les mêmes résultats (au bit près) dans chacun des deux modèles:
+ - compilation directe sans activer mnh_expand
+ - compilation en activant mnh_expand
+ - exécution en changeant le nombre de processeurs
Merge pb:
- ice4_nucleation_wrapper:
@@ -22,11 +30,12 @@ Merge pb:
Ryad a fait des tests pour regarder impact des allocatable sur CPU => temps * 2
Code à nettoyer quelque soit l'option retenue
Dernier code de Ryad: /home/gmap/mrpm/khatib/public/modset/mods_ice4_nucleation_wrapper.tgz et/ou /home/gmap/mrpm/khatib/public/modset/ice4_nucleation_wrapper.f90
+
+- rain_ice_red: le cas test MesoNH n'est pas bit repro (diffs > 1% sur rapports de melange)
+ sur la modif src/mesonh/rain_ice_red au commit bdd10dd (First rain_ice new/red merge)
- shallow_mf (appels dans aro_shallow et arp_shallow):
Dans Méso-NH: shallow_mf doit être appelé avec PDX=XDXHAT(1) et PDY=XDYHAT(1)
Dans AROME/ARP: où trouver la taille de maille?
- Pour l'instant 2 versions à cause de l'interface à compute_uprfat_rhcj10
-- compute_updraft_rhcj10: en attente retour de Rachel et/ou Yves pour faire le merge
Etape 2: array syntax -> loop
- en profiter pour supprimer args PA/PB des routines appelées depuis ice4_tendencies, comme pour nucleation
@@ -39,17 +48,25 @@ Etape 2: array syntax -> loop
Pb identifiés à corriger plus tard:
- deposition devrait être déplacée dans ice4_tendencies
-- non reproduction en changeant le nombre de procs
- avec les optimisations de Ryad, les tableaux 3D de precip passés à ice4_tendencies
lorsque HSUBG_RC_RR_ACCR=='PRFR' ne sont pas utilisables puisque les K1, K2 et K3
sont relatifs à la boucle IMICRO et que les calculs faits en debut de routine ne
concernent qu'une partie des points
=> Ã corriger
-- seules les options oper ont été testées, il manque des test pour sedim_after, nmaxiter, xmrstep, xtstep, autoconv, rainfr
+- seules quelques options sont testées avec les cas test (par exemple, il faudrait tester RMC01 mais
+ l'option n'est pas remontée en namelist)
+- les options CMF_CLOUD='STAT' et LOSIGAMS=.FALSE. semblent cassées en 48 original
- arome/ini_cmfshall devrait s'appeler ini_param_mfshall
- th_r_from_thl_rt appelée partout, il faudrait limiter à OTEST
+- la recompilation complète d'AROME n'est pas testée
+- il faudrait inclure un cas test plus conséquent en taille au moins sur belenos
+- doute sur le codage de MODD_PRECISION
+- appel à abort à travers print_msg non testé
+- lignes vides ajoutées après les macros mnh_expand
+- indentation inorrecte dans les blocs mnh_expand
+- sedimentation momentum non branchée
-Répertoire arome/ext contient les codes non PHYEX qu'il faut modifier dans le pack pour qu'il puisse être compilé.
+Répertoire arome/ext et mesonh/ext contient les codes non PHYEX qu'il faut modifier dans le pack pour qu'il puisse être compilé.
Ce répertoire devra être vidé à la fin du phasage, les modifications nécessaires ayadevront avoir été fournies par ailleurs
Budgets/DDH
@@ -58,9 +75,19 @@ Budgets/DDH
- nettoyage necessaire des routines budgets:
- etape 1: adaptation GPU en passant la structure => permettra d'identifier avec certitude les variables utiles
- etape 2: suppr des codes qui ne sont pas appelés, ménage modd_budget, ini_budget... Je pense que seul aro_ini_budget est utile
+- Le module modd_dyn n'est utilisé que pour les budgets, voir s'il peut être supprimé
+- Le code des budgets devrait être revu: pas en phase avec celui de Méso-NH et phasage a priori
+ inutile car très peu de code semble réellement utile pour AROME
SPP
- modd_spp_type est pour l'instant dans mpa/micro/externals mais n'est pas de la microphysique
-Gradients/shuman:
-- essayer de mettre des abort dans les routines arome (shuman doit suffire)
+Nettoyage apl_arome non fait (pb a la compilation) ==> 4 arguments dans aro_turb_mnh supprimés (non utilisés)
+
+turb.F90 : il reste un CALL à SOURCES_NEG_CORRECT à ajouter. Besoin de récupérer CCLOUD dans apl_arome : comment ?
+
+Regarder s'il ne serait pas possible/souhaitable de supprimer modd_lunit de PHYEX. On pourrait se contenter de recevoir le numero d'unité logique
+
+Nettoyage des répertoires aux nécessaire
+
+Initialiser dans AROME la variable ldiag_in_run de MODD_DIAG_IN_RUN pour pouvoir phaser le modd
diff --git a/src/arome/aux/budget_DDH.F90 b/src/arome/aux/budget_DDH.F90
index f934798c0b769d8f9ea4845f8144d585700a8def..5e448dc8eab5cc7bd501f1b4905e85cf019e244f 100644
--- a/src/arome/aux/budget_DDH.F90
+++ b/src/arome/aux/budget_DDH.F90
@@ -105,8 +105,17 @@ IF (SIZE(PVARS,3)==NFLEVGDDH+2) THEN
ELSE
IOFF=0
ENDIF
-
-CLPROC=HBUVAR(1:MIN(4, LEN(HBUVAR)))//REPEAT('_', MAX(0, 4-LEN(HBUVAR))) !if length is less than 4, fill with '_'
+!if length is less than 4, fill with budget old names
+IF(LEN(HBUVAR)==1) THEN
+ CLPROC=HBUVAR(1:MIN(4, LEN(HBUVAR)))//'_BU'
+ELSE IF(LEN(HBUVAR)==2) THEN
+ CLPROC=HBUVAR(1:MIN(4, LEN(HBUVAR)))//'_B'
+ELSE IF(LEN(HBUVAR)==3) THEN
+ CLPROC=HBUVAR(1:MIN(4, LEN(HBUVAR)))//'_'
+ELSE
+ CLPROC=HBUVAR(1:MIN(4, LEN(HBUVAR)))
+END IF
+!
IF (YDLDDH%LDDH_OMP) THEN
CLDDH='T'//YDDDH%YVARMULT(KBUDN)%CNAME//CLPROC
ELSE
diff --git a/src/arome/aux/get_halo.F90 b/src/arome/aux/get_halo.F90
new file mode 100644
index 0000000000000000000000000000000000000000..443d33f13241e2a260c8c44e9368a58c57515ac9
--- /dev/null
+++ b/src/arome/aux/get_halo.F90
@@ -0,0 +1,33 @@
+!MNH_LIC Copyright 1994-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.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+!-----------------------------------------------------------------
+! ####################
+ MODULE MODI_GET_HALO
+! ####################
+!
+INTERFACE
+!
+SUBROUTINE GET_HALO(PSRC)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
+!
+END SUBROUTINE GET_HALO
+!
+END INTERFACE
+!
+END MODULE MODI_GET_HALO
+!
+!-------------------------------------------------------------------------------
+! #########################
+ SUBROUTINE GET_HALO(PSRC)
+! #########################
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
+!
+END SUBROUTINE GET_HALO
+!-----------------------------------------------------------------------
diff --git a/src/arome/aux/gradient_m.F90 b/src/arome/aux/gradient_m.F90
index f9427caa265cc37dae1bdb44642a546531c1d7e8..1bd9756426595532b522bad83ab2cf96f73fa4c1 100644
--- a/src/arome/aux/gradient_m.F90
+++ b/src/arome/aux/gradient_m.F90
@@ -70,8 +70,8 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
!
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_M_M ! result mass point
@@ -101,7 +101,7 @@ END IF
IF (LHOOK) CALL DR_HOOK('GX_M_M',1,ZHOOK_HANDLE)
END FUNCTION GX_M_M
! ######spl
- FUNCTION GX_M_U(PY,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_M_U)
+ FUNCTION GX_M_U(KKA, KKU, KL,PY,PDXX,PDZZ,PDZX) RESULT(PGX_M_U)
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ##################################################
@@ -329,8 +329,8 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
!
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_M_M ! result mass point
!
@@ -359,7 +359,7 @@ ENDIF
IF (LHOOK) CALL DR_HOOK('GY_M_M',1,ZHOOK_HANDLE)
END FUNCTION GY_M_M
! ######spl
- FUNCTION GY_M_V(PY,PDYY,PDZZ,PDZY, KKA, KKU, KL) RESULT(PGY_M_V)
+ FUNCTION GY_M_V(KKA,KKU,KL,PY,PDYY,PDZZ,PDZY) RESULT(PGY_M_V)
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ##################################################
@@ -551,8 +551,8 @@ IMPLICIT NONE
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
!
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_M_M ! result mass point
!
@@ -575,7 +575,7 @@ PGZ_M_M(:,:,:)= MZF(DZM(PA(:,:,:), KKA, KKU, KL)/PDZZ(:,:,:), KKA, KKU, KL)
IF (LHOOK) CALL DR_HOOK('GZ_M_M',1,ZHOOK_HANDLE)
END FUNCTION GZ_M_M
! ######spl
- FUNCTION GZ_M_W(PY,PDZZ, KKA, KKU, KL) RESULT(PGZ_M_W)
+ FUNCTION GZ_M_W(KKA, KKU, KL,PY,PDZZ) RESULT(PGZ_M_W)
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! #########################################
diff --git a/src/arome/aux/gradient_u.F90 b/src/arome/aux/gradient_u.F90
index 96c0af25be42efcb11f3efb8f6f76e57db7840b8..317019d2014db20ac8fc6f79609aaf7c1f058c4e 100644
--- a/src/arome/aux/gradient_u.F90
+++ b/src/arome/aux/gradient_u.F90
@@ -66,8 +66,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -168,8 +168,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -261,8 +261,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
diff --git a/src/arome/aux/gradient_v.F90 b/src/arome/aux/gradient_v.F90
index 3dd2f23776cf0b1c4904a2ab6a743aa516af4d19..53e81c083c4eab01f0fa7b816c3042ed1ee73f10 100644
--- a/src/arome/aux/gradient_v.F90
+++ b/src/arome/aux/gradient_v.F90
@@ -66,8 +66,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -165,8 +165,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -260,8 +260,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
diff --git a/src/arome/aux/gradient_w.F90 b/src/arome/aux/gradient_w.F90
index b17ca4bab07ca090d3b9610d453bc6f35b6a3fcc..66216739e6808d13c0b75b3ce38b496968f1fc5d 100644
--- a/src/arome/aux/gradient_w.F90
+++ b/src/arome/aux/gradient_w.F90
@@ -56,8 +56,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -147,8 +147,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -236,8 +236,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
diff --git a/src/arome/aux/ibm_mixinglength.f90 b/src/arome/aux/ibm_mixinglength.f90
new file mode 100644
index 0000000000000000000000000000000000000000..766627888e3d49a472bd2eaa7a0b49bb58667abe
--- /dev/null
+++ b/src/arome/aux/ibm_mixinglength.f90
@@ -0,0 +1,35 @@
+!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_MIXINGLENGTH
+ ! ############################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_MIXINGLENGTH(PLM,PLEPS,PMU,PHI,PTKE)
+ !
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLM
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMU
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PHI
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ !
+ END SUBROUTINE IBM_MIXINGLENGTH
+ !
+ END INTERFACE
+END MODULE MODI_IBM_MIXINGLENGTH
+ !
+ SUBROUTINE IBM_MIXINGLENGTH(PLM,PLEPS,PMU,PHI,PTKE)
+ !
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLM
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMU
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PHI
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ !
+ END SUBROUTINE IBM_MIXINGLENGTH
+ !
diff --git a/src/arome/aux/ini_budget.F90 b/src/arome/aux/ini_budget.F90
index 20100d5b4582a05468c3e4eb82c7cf63d7a83d3f..9506cd1df51623445d6551c72846420b4a972e83 100644
--- a/src/arome/aux/ini_budget.F90
+++ b/src/arome/aux/ini_budget.F90
@@ -83,8 +83,6 @@
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FM
-!
USE MODD_PARAMETERS
USE MODD_BUDGET
USE MODD_DYN
diff --git a/src/arome/aux/modd_argslist_ll.F90 b/src/arome/aux/modd_argslist_ll.F90
new file mode 100644
index 0000000000000000000000000000000000000000..03db23cd5a89650e7edb31d43c3f24d97a602bec
--- /dev/null
+++ b/src/arome/aux/modd_argslist_ll.F90
@@ -0,0 +1,6 @@
+MODULE MODD_ARGSLIST_ll
+IMPLICIT NONE
+TYPE LIST_ll
+END TYPE LIST_ll
+CONTAINS
+END MODULE MODD_ARGSLIST_ll
diff --git a/src/arome/micro/modd_dyn.F90 b/src/arome/aux/modd_dyn.F90
similarity index 100%
rename from src/arome/micro/modd_dyn.F90
rename to src/arome/aux/modd_dyn.F90
diff --git a/src/arome/aux/modd_field.F90 b/src/arome/aux/modd_field.F90
new file mode 100644
index 0000000000000000000000000000000000000000..be5755c73358e0bfa715f4e4f4120b1a53364927
--- /dev/null
+++ b/src/arome/aux/modd_field.F90
@@ -0,0 +1,29 @@
+MODULE MODD_FIELD
+ USE MODD_PARAMETERS, ONLY: NGRIDUNKNOWN, NMNHNAMELGTMAX, NSTDNAMELGTMAX
+ INTEGER, PARAMETER :: NMNHDIM_UNKNOWN = -2
+ INTEGER, PARAMETER :: NMNHMAXDIMS = 6 ! Cannot be less than 6
+ INTEGER,PARAMETER :: TYPEUNDEF = -1, TYPEINT = 1, TYPELOG = 2, TYPEREAL = 3, TYPECHAR = 4, TYPEDATE = 5
+!
+TYPE TFIELDDATA
+ CHARACTER(LEN=NMNHNAMELGTMAX) :: CMNHNAME = '' !Name of the field (for MesoNH, non CF convention)
+ CHARACTER(LEN=NSTDNAMELGTMAX) :: CSTDNAME = '' !Standard name (CF convention)
+ CHARACTER(LEN=32) :: CLONGNAME = '' !Long name (CF convention)
+ CHARACTER(LEN=40) :: CUNITS = '' !Canonical units (CF convention)
+ CHARACTER(LEN=100) :: CCOMMENT = '' !Comment (for MesoNH, non CF convention)
+ INTEGER :: NGRID = NGRIDUNKNOWN !Localization on the model grid
+ INTEGER :: NTYPE = TYPEUNDEF !Datatype
+ INTEGER :: NDIMS = 0 !Number of dimensions
+ INTEGER, DIMENSION(NMNHMAXDIMS) :: NDIMLIST = NMNHDIM_UNKNOWN ! List of dimensions of the data field
+ !
+ INTEGER :: NFILLVALUE = -2147483647 !Fill value for integer fields
+ REAL :: XFILLVALUE = 9.9692099683868690e+36 !Fill value for real fields
+ INTEGER :: NVALIDMIN = -2147483646 !Minimum valid value for integer fields
+ INTEGER :: NVALIDMAX = 2147483647 !Maximum valid value for integer fields
+ REAL :: XVALIDMIN = -1.E36 !Minimum valid value for real fields
+ REAL :: XVALIDMAX = 1.E36 !Maximum valid value for real fields
+ CHARACTER(LEN=2) :: CDIR = '' !Type of the data field (XX,XY,--...)
+ CHARACTER(LEN=4) :: CLBTYPE = 'NONE' !Type of the lateral boundary (LBX,LBY,LBXU,LBYV)
+ LOGICAL :: LTIMEDEP = .FALSE. !Is the field time-dependent?
+END TYPE TFIELDDATA
+!
+END MODULE MODD_FIELD
diff --git a/src/arome/aux/modd_frc.F90 b/src/arome/aux/modd_frc.F90
new file mode 100644
index 0000000000000000000000000000000000000000..e1d77673e8619106b68cb329fa2ed58c96844cf3
--- /dev/null
+++ b/src/arome/aux/modd_frc.F90
@@ -0,0 +1,112 @@
+!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.
+!-----------------------------------------------------------------
+! ###############
+ MODULE MODD_FRC
+! ###############
+!
+!!*** *MODD_FRC - Declarative module for the forcing fields
+!!
+!! PURPOSE
+!! -------
+! This module contains NFRC 1D-arrays used by FORCING (geostrophic wind
+! components, large scale vertical wind, theta and humidity profiles when
+! the relaxation option is used,large scale theta and humidity gradients
+! and the translation speed of the domain of simulation.
+! The following control parameters are used by FORCING:
+! - LGEOST_UV_FRC and LGEOST_TH_FRC
+! - LTEND_THRV_FRC and LTEND_UV_FRC
+! - LVERT_MOTION_FRC
+! - LRELAX_THRV_FRC, LRELAX_UV_FRC and LRELAX_UVMEAN_FRC using:
+! XRELAX_TIME_FRC, XRELAX_HEIGHT_FRC and CRELAX_HEIGHT_TYPE
+! - LTRANS
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (module MODD_FRC)
+!!
+!!
+!! AUTHOR
+!! ------
+!! Marc Georgelin Labo d'aerologie
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 29/07/96
+!! 29/07/96 (Pinty&Suhre) revised
+!! 18/11/96 J.-P. Pinty addition of the translation
+!! 27/01/98 P. Bechtold use tendency forcing
+!! add SST and surface pressure forcing
+!! 01/2004 V. Masson surface externalization: removes SST forcing
+!! 09/2017 Q.Rodier add LTEND_UV_FRC
+!! 03/2021 JL Redelsperger Parameters defining sfc forcing shape for idealized ocean case
+!! 06/2021 F. Couvreux add LRELAX_UVMEAN_FRC
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!USE MODD_TYPE_DATE
+!
+IMPLICIT NONE
+!
+!* fields for FORCING
+! ------------------
+!
+INTEGER, SAVE :: NFRC ! number of forcing profiles
+!TYPE (DATE_TIME), SAVE, DIMENSION(:), ALLOCATABLE :: TDTFRC ! date of
+ ! each forcing profile
+!
+REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XUFRC, &! geostrophic wind
+ XVFRC, &! components U and V
+ XWFRC ! large scale vertical wind
+REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XTHFRC, &! large scale TH profile
+ XRVFRC ! large scale RV profile
+REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XGXTHFRC,&! large scale TH gradient
+ XGYTHFRC ! along the X and Y axis
+REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XTENDTHFRC,&! large scale TH tendency
+ XTENDRVFRC ! large scale RV tendency
+REAL, SAVE :: XUTRANS, &! horizontal components of
+ XVTRANS ! a constant
+ ! Galilean TRANSlation
+REAL, SAVE, DIMENSION(:), ALLOCATABLE :: XPGROUNDFRC! surf. pressure
+REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XTENDUFRC ! large scale U tendency
+REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XTENDVFRC ! large scale V tendency
+!
+!* control parameters for FORCING
+! ------------------------------
+!
+LOGICAL, SAVE :: LGEOST_UV_FRC ! enables geostrophic wind term
+LOGICAL, SAVE :: LGEOST_TH_FRC ! enables thermal wind advection
+LOGICAL, SAVE :: LTEND_THRV_FRC ! enables tendency forcing
+LOGICAL, SAVE :: LTEND_UV_FRC ! enables tendency forcing of the wind
+LOGICAL, SAVE :: LVERT_MOTION_FRC ! enables prescribed a forced vertical
+ ! transport for all prognostic variables
+LOGICAL, SAVE :: LRELAX_THRV_FRC ! enables temp. and humidity relaxation
+LOGICAL, SAVE :: LRELAX_UV_FRC ! enables horizontal wind relaxation applied to the full wind field
+LOGICAL, SAVE :: LRELAX_UVMEAN_FRC ! enables horizontal wind relaxation applied to the horiz. avg. wind
+!
+REAL, SAVE :: XRELAX_TIME_FRC ! e-folding time for relaxation
+REAL, SAVE :: XRELAX_HEIGHT_FRC ! height below which relaxation
+ ! is never applied
+CHARACTER(len=4), SAVE :: CRELAX_HEIGHT_TYPE ! "THGR" relax. above maximal dTH/dz
+ ! (but always above XRELAX_HEIGHT_FRC)
+ ! "FIXE" relax. above XRELAX_HEIGHT_FRC
+!
+LOGICAL, SAVE :: LTRANS ! enables a Galilean translation of the
+ ! domain of simulation
+LOGICAL, SAVE :: LPGROUND_FRC ! enables surf. pressure forcing
+!
+LOGICAL, SAVE :: LDEEPOC ! activates sfc forcing for ideal ocean deep conv
+REAL, SAVE :: XCENTX_OC ! center of sfc forc for ideal ocean
+REAL, SAVE :: XRADX_OC ! radius of sfc forc for ideal ocean
+REAL, SAVE :: XCENTY_OC ! center of sfc forc for ideal ocean
+REAL, SAVE :: XRADY_OC ! radius of sfc forc for ideal ocean
+!
+END MODULE MODD_FRC
diff --git a/src/arome/aux/modd_ibm_paramn.f90 b/src/arome/aux/modd_ibm_paramn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..716a93e6d6da60bf1ca8f19e2ecdffa9faf2fc32
--- /dev/null
+++ b/src/arome/aux/modd_ibm_paramn.f90
@@ -0,0 +1,15 @@
+!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 MODD_IBM_PARAM_n
+ ! #######################
+ IMPLICIT NONE
+ LOGICAL :: LIBM,LIBM_TROUBLE
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_LS=>NULL() ! LSF for MNH
+ REAL, DIMENSION(:,:,:) , POINTER :: XIBM_XMUT=>NULL()
+END MODULE MODD_IBM_PARAM_n
+!
diff --git a/src/arome/micro/modd_lunit.F90 b/src/arome/aux/modd_lunit.F90
similarity index 100%
rename from src/arome/micro/modd_lunit.F90
rename to src/arome/aux/modd_lunit.F90
diff --git a/src/arome/aux/modd_oceanh.F90 b/src/arome/aux/modd_oceanh.F90
new file mode 100644
index 0000000000000000000000000000000000000000..6638752658492bb2a477b6781ca92fe885bfcf04
--- /dev/null
+++ b/src/arome/aux/modd_oceanh.F90
@@ -0,0 +1,47 @@
+!MNH_LIC Copyright 2021-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #################
+ MODULE MODD_OCEANH
+! #################
+!
+!!**** *MODD_OCEAN* - declaration of variables used in ocean version
+!!
+!! PURPOSE
+!! -------
+! Declarative module for the variables
+!! at interface for OCEAN LES MESONH version including auto-coupling O-A LES
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! AUTHOR
+!! ------
+!! JL Redelsperger LOPS
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 03/2021
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!USE MODD_TYPE_DATE
+!
+IMPLICIT NONE
+!
+!* fields for Sea Sfc FORCINGs
+! ------------------
+!
+INTEGER, SAVE :: NFRCLT ! number of sea surface forcings PLUS 1
+INTEGER, SAVE :: NINFRT ! Interval in second between forcings
+!TYPE (DATE_TIME), SAVE, DIMENSION(:), ALLOCATABLE :: TFRCLT ! date/time of sea surface forcings
+REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XSSUFL,XSSVFL,XSSTFL,XSSOLA ! Time evol Flux U V T Solar_Rad at sea surface
+REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XSSUFL_XY,XSSVFL_XY,XSSTFL_XY! XY flux shape
+REAL, SAVE, DIMENSION(:), ALLOCATABLE :: XSSUFL_T,XSSVFL_T,XSSTFL_T,XSSOLA_T ! given time forcing fluxes
+!
+END MODULE MODD_OCEANH
diff --git a/src/arome/micro/modd_parameters.F90 b/src/arome/aux/modd_parameters.F90
similarity index 55%
rename from src/arome/micro/modd_parameters.F90
rename to src/arome/aux/modd_parameters.F90
index 4a1ea98602b6c3ed50c1bb4db0c6c4a46c94d075..45a4d73ae4301935106388511142030005c191e4 100644
--- a/src/arome/micro/modd_parameters.F90
+++ b/src/arome/aux/modd_parameters.F90
@@ -1,4 +1,9 @@
-! ######spl
+!MNH_LIC Copyright 1994-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 MODD_PARAMETERS
! ######################
!
@@ -50,17 +55,37 @@ INTEGER, PARAMETER :: JPBUPROMAX = 60 ! Maximum of allowed processes for all
INTEGER, PARAMETER :: JPRIMMAX = 6 ! Maximum number of points for the
! horizontal relaxation for the outermost verticals
INTEGER, PARAMETER :: JPSVMAX = 200 ! Maximum number of scalar variables
+INTEGER, PARAMETER :: JPSVNAMELGTMAX = 10 ! Maximum length of a scalar variable name (do not set to less than 10)
!
!
REAL, PARAMETER :: XUNDEF = 1.E+20 ! default value for undefined or unused
-! ! field.
-INTEGER, PARAMETER :: NUNDEF = 1E+9 ! default value for undefined or unused
-! ! field.
+! ! field.
+REAL, PARAMETER :: XNEGUNDEF = -999. ! default value for undefined or unused
+! ! field (negative value guaranteed)
+INTEGER, PARAMETER :: NUNDEF = 1E+9 ! default value for undefined or unused
+! ! field.
+INTEGER, PARAMETER :: NNEGUNDEF = -999 ! default value for undefined or unused
+! ! field (negative value guaranteed)
INTEGER, PARAMETER :: JPDUMMY = 20 ! Size of dummy array
!
INTEGER, PARAMETER :: JPOUTMAX = 192 ! Maximum allowed number of OUTput files
+INTEGER, PARAMETER :: JPOUTVARMAX = 192 ! Maximum allowed number of variables in an output file
+!
+INTEGER, PARAMETER :: NBUNAMELGTMAX = 32 ! Maximum length of a budget name
+INTEGER, PARAMETER :: NCOMMENTLGTMAX = 100 ! Maximum length of a comment
+INTEGER, PARAMETER :: NMNHNAMELGTMAX = 32 ! Maximum length of a MNH variable name
+INTEGER, PARAMETER :: NSTDNAMELGTMAX = 64 ! Maximum length of the standard name of a variable (CF convention)
+!
+INTEGER, PARAMETER :: NDIRNAMELGTMAX = 512 ! Maximum length of a directory name
+INTEGER, PARAMETER :: NFILENAMELGTMAX = 32 ! Maximum length of a file name (must be at least NFILENAMELGTMAXLFI)
+INTEGER, PARAMETER :: NFILENAMELGTMAXLFI = 28 ! Maximum length of a file name in LFI file (this is necessary
+ ! to keep backward compatibility), MUST BE 28
+!
+INTEGER, PARAMETER :: NLFIMAXCOMMENTLENGTH = 100 ! Length of comments in LFI files
!
INTEGER, PARAMETER :: JPLIMACCNMAX = 10 ! Maximum allowed number of CCN modes in LIMA
INTEGER, PARAMETER :: JPLIMAIFNMAX = 10 ! Maximum allowed number of IFN modes in LIMA
!
+INTEGER, PARAMETER :: NGRIDUNKNOWN = -1 ! Unknown Arakawa grid number
+!
END MODULE MODD_PARAMETERS
diff --git a/src/arome/micro/modd_refaro.F90 b/src/arome/aux/modd_ref.F90
similarity index 94%
rename from src/arome/micro/modd_refaro.F90
rename to src/arome/aux/modd_ref.F90
index 5d04ef439413f81cd47282608b4d645c7bb96875..c616ef13dad178f46223127c4c1d187ebc5e9242 100644
--- a/src/arome/micro/modd_refaro.F90
+++ b/src/arome/aux/modd_ref.F90
@@ -38,5 +38,6 @@ IMPLICIT NONE
! set to constant value 300k for AROME
REAL,SAVE, DIMENSION(2) :: XTHVREFZ=300. ! Thetav(z) for reference
! state without orography
+LOGICAL, SAVE ::LCOUPLES ! AUTOCOUPLED ATMS-OCEAN LES VERSION
!
END MODULE MODD_REF
diff --git a/src/arome/aux/mode_argslist_ll.F90 b/src/arome/aux/mode_argslist_ll.F90
new file mode 100644
index 0000000000000000000000000000000000000000..f80bc15fb3ae6e2d9ebdb0c7d3c6796127648e05
--- /dev/null
+++ b/src/arome/aux/mode_argslist_ll.F90
@@ -0,0 +1,44 @@
+MODULE MODE_ARGSLIST_ll
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+CONTAINS
+
+!
+ SUBROUTINE CLEANLIST_ll(TPLIST)
+IMPLICIT NONE
+ TYPE(LIST_ll), POINTER :: TPLIST ! List of fields
+ CALL ABORT
+ END SUBROUTINE CLEANLIST_ll
+!
+ SUBROUTINE ADD2DFIELD_ll(TPLIST, PFIELD, HNAME)
+IMPLICIT NONE
+
+ TYPE(LIST_ll), POINTER :: TPLIST ! list of fields
+ REAL, DIMENSION(:,:), TARGET :: PFIELD ! field to be added to the list
+ ! of fields
+ character(len=*), intent(in) :: HNAME ! Name of the field to be added
+ !
+ CALL ABORT
+END SUBROUTINE ADD2DFIELD_ll
+!
+ SUBROUTINE ADD3DFIELD_ll(TPLIST, PFIELD, HNAME)
+IMPLICIT NONE
+
+ TYPE(LIST_ll), POINTER :: TPLIST ! list of fields
+ REAL, DIMENSION(:,:,:), TARGET :: PFIELD ! field to be added to the list
+ ! of fields
+ character(len=*), intent(in) :: HNAME ! Name of the field to be added
+ !
+ CALL ABORT
+END SUBROUTINE ADD3DFIELD_ll
+!
+ SUBROUTINE ADD4DFIELD_ll(TPLIST, PFIELD, HNAME)
+IMPLICIT NONE
+
+ TYPE(LIST_ll), POINTER :: TPLIST ! list of fields
+ REAL, DIMENSION(:,:,:,:), TARGET :: PFIELD ! field to be added to the list
+ ! of fields
+ character(len=*), intent(in) :: HNAME ! Name of the field to be added
+ !
+ CALL ABORT
+END SUBROUTINE ADD4DFIELD_ll
+END MODULE MODE_ARGSLIST_ll
diff --git a/src/arome/aux/mode_gather_ll.F90 b/src/arome/aux/mode_gather_ll.F90
new file mode 100644
index 0000000000000000000000000000000000000000..88c37bbd9acd428168479ea952092f5799ebbf36
--- /dev/null
+++ b/src/arome/aux/mode_gather_ll.F90
@@ -0,0 +1,28 @@
+MODULE MODE_GATHER_ll
+IMPLICIT NONE
+
+INTERFACE GATHERALL_FIELD_ll
+ MODULE PROCEDURE &
+ GATHERALL_X1, GATHERALL_X3
+END INTERFACE
+
+CONTAINS
+SUBROUTINE GATHERALL_X3(HDIR,PSEND,PRECV,KRESP)
+CHARACTER(LEN=*), INTENT(IN) :: HDIR
+REAL,DIMENSION(:,:,:), INTENT(IN) :: PSEND
+REAL,DIMENSION(:,:,:), INTENT(INOUT):: PRECV
+INTEGER, INTENT(INOUT):: KRESP
+
+CALL ABORT
+END SUBROUTINE GATHERALL_X3
+!
+SUBROUTINE GATHERALL_X1(HDIR,PSEND,PRECV,KRESP)
+CHARACTER(LEN=*), INTENT(IN) :: HDIR
+REAL,DIMENSION(:), INTENT(IN) :: PSEND
+REAL,DIMENSION(:), INTENT(INOUT):: PRECV
+INTEGER, INTENT(INOUT):: KRESP
+
+CALL ABORT
+END SUBROUTINE GATHERALL_X1
+!
+END MODULE MODE_GATHER_ll
diff --git a/src/arome/aux/mode_io_field_write.F90 b/src/arome/aux/mode_io_field_write.F90
new file mode 100644
index 0000000000000000000000000000000000000000..e1ea4aef4651b7a11ce0bd10319e08bfb59c1edb
--- /dev/null
+++ b/src/arome/aux/mode_io_field_write.F90
@@ -0,0 +1,16 @@
+MODULE MODE_IO_FIELD_WRITE
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_FIELD, ONLY: TFIELDDATA
+CONTAINS
+SUBROUTINE IO_FIELD_WRITE(TPFILE,TZFIELD,PFIELD)
+ !
+ !* 0.1 Declarations of arguments
+ !
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDDATA), INTENT(IN) :: TZFIELD
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELD ! array containing the data field
+ !
+ CALL ABORT
+END SUBROUTINE IO_FIELD_WRITE
+END MODULE MODE_IO_FIELD_WRITE
+
diff --git a/src/arome/aux/mode_ll.F90 b/src/arome/aux/mode_ll.F90
index 790a3acac9312351c098993143fe731baf8f60e7..27ab8176073f3333edc5ddc7967af45d6fc7f0f2 100644
--- a/src/arome/aux/mode_ll.F90
+++ b/src/arome/aux/mode_ll.F90
@@ -1,14 +1,44 @@
MODULE MODE_ll
+USE MODE_ARGSLIST_ll
+USE MODE_TOOLS
IMPLICIT NONE
CONTAINS
SUBROUTINE GET_INDICE_ll(KXOR, KYOR, KXEND, KYEND, KSIZE1, KSIZE2)
USE MODD_PARAMETERS, ONLY : JPHEXT
IMPLICIT NONE
- INTEGER, INTENT(IN) :: KSIZE1, KSIZE2
+ INTEGER, INTENT(IN),OPTIONAL :: KSIZE1, KSIZE2
INTEGER, INTENT(OUT) :: KXOR, KYOR, KXEND, KYEND
KXOR=1+JPHEXT
KYOR=1+JPHEXT
KXEND=KSIZE1-JPHEXT
KYEND=KSIZE2-JPHEXT
END SUBROUTINE GET_INDICE_ll
+
+ SUBROUTINE UPDATE_HALO_ll(TPLIST, KINFO)
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ TYPE(LIST_ll), POINTER :: TPLIST ! pointer to the list of fields to be updated
+ INTEGER :: KINFO ! return status
+ CALL ABORT
+ END SUBROUTINE UPDATE_HALO_ll
+
+ SUBROUTINE GET_DIM_EXT_ll(CBORD,IIU,IJU)
+ IMPLICIT NONE
+ CHARACTER(LEN=1), INTENT(IN) :: CBORD
+ INTEGER, INTENT(IN) :: IIU,IJU
+ END SUBROUTINE GET_DIM_EXT_ll
+LOGICAL FUNCTION LNORTH_ll()
+ LNORTH_ll=.FALSE.
+END FUNCTION LNORTH_ll
+!
+LOGICAL FUNCTION LEAST_ll()
+ LEAST_ll=.FALSE.
+END FUNCTION LEAST_ll
+!
+LOGICAL FUNCTION LWEST_ll()
+ LWEST_ll=.FALSE.
+END FUNCTION LWEST_ll
+!
+LOGICAL FUNCTION LSOUTH_ll()
+ LSOUTH_ll=.FALSE.
+END FUNCTION LSOUTH_ll
END MODULE MODE_ll
diff --git a/src/arome/aux/mode_mppdb.F90 b/src/arome/aux/mode_mppdb.F90
new file mode 100644
index 0000000000000000000000000000000000000000..982b25d5deed69b423aa5ff6dae001cfe68099af
--- /dev/null
+++ b/src/arome/aux/mode_mppdb.F90
@@ -0,0 +1,18 @@
+MODULE MODE_MPPDB
+IMPLICIT NONE
+REAL :: PRECISION = 1e-8 * 0.0
+CONTAINS
+SUBROUTINE MPPDB_CHECK3DM(MESSAGE,PRECISION &
+ ,PTAB1,PTAB2,PTAB3,PTAB4,PTAB5,PTAB6,PTAB7,PTAB8,PTAB9,PTAB10 &
+ ,PTAB11,PTAB12,PTAB13,PTAB14,PTAB15,PTAB16,PTAB17,PTAB18,PTAB19,PTAB20 &
+ )
+
+IMPLICIT NONE
+
+CHARACTER(lEN=*) :: MESSAGE
+REAL :: PRECISION
+REAL, DIMENSION(:,:,:), OPTIONAL :: PTAB1,PTAB2,PTAB3,PTAB4,PTAB5,PTAB6,PTAB7,PTAB8,PTAB9,PTAB10
+REAL, DIMENSION(:,:,:), OPTIONAL :: PTAB11,PTAB12,PTAB13,PTAB14,PTAB15,PTAB16,PTAB17,PTAB18,PTAB19,PTAB20
+! DO NOTHING IN AROME
+END SUBROUTINE MPPDB_CHECK3DM
+END MODULE MODE_MPPDB
diff --git a/src/arome/aux/mode_sources_neg_correct.F90 b/src/arome/aux/mode_sources_neg_correct.F90
new file mode 100644
index 0000000000000000000000000000000000000000..1b49a6e2b22a64880bea7e75e5c32001a106ecda
--- /dev/null
+++ b/src/arome/aux/mode_sources_neg_correct.F90
@@ -0,0 +1,19 @@
+MODULE MODE_SOURCES_NEG_CORRECT
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE SOURCES_NEG_CORRECT(HCLOUD, HBUDNAME, KRR, PTSTEP, PPABST, &
+ &PTHT, PRT, PRTHS, PRRS, PRSVS, PRHODJ)
+IMPLICIT NONE
+CHARACTER(LEN=*), INTENT(IN) :: HCLOUD ! Kind of cloud parameterization
+CHARACTER(LEN=*), INTENT(IN) :: HBUDNAME ! Budget name
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+REAL, INTENT(IN) :: PTSTEP ! Timestep
+REAL, DIMENSION(:, :, :), INTENT(IN) :: PPABST ! Absolute pressure at time t
+REAL, DIMENSION(:, :, :), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:, :, :, :), INTENT(IN) :: PRT ! Moist variables at time t
+REAL, DIMENSION(:, :, :), INTENT(INOUT) :: PRTHS ! Source terms
+REAL, DIMENSION(:, :, :, :), INTENT(INOUT) :: PRRS ! Source terms
+REAL, DIMENSION(:, :, :, :), INTENT(INOUT) :: PRSVS ! Source terms
+REAL, DIMENSION(:, :, :), INTENT(IN), OPTIONAL :: PRHODJ ! Dry density * jacobian
+END SUBROUTINE SOURCES_NEG_CORRECT
+END MODULE MODE_SOURCES_NEG_CORRECT
diff --git a/src/arome/turb/mode_thermo_mono.F90 b/src/arome/aux/mode_thermo.F90
similarity index 98%
rename from src/arome/turb/mode_thermo_mono.F90
rename to src/arome/aux/mode_thermo.F90
index 5b68fba7e694270b66663ce33dca2485997a13c6..86165d23b4df39acacf7c268d926aec1d7add298 100644
--- a/src/arome/turb/mode_thermo_mono.F90
+++ b/src/arome/aux/mode_thermo.F90
@@ -1,7 +1,10 @@
+!MNH_LIC Copyright 1994-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 MODE_THERMO
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! #######################
!
!!**** *MODE_THERMO_MONO* - module for routines SM_FOES,SM_PMR_HU
@@ -29,13 +32,23 @@
!! MODIFICATIONS
!! -------------
!! Original 28/08/94
+!! J.Escobar : 5/10/2018 : add FLUSH , for better logging in case of PB
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
!--------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
!-------------------------------------------------------------------------------
-!
+USE MODE_MSG
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+IMPLICIT NONE
+
+PRIVATE
+
+PUBLIC :: DQSAT, DQSATI, QSAT, QSATI, SM_FOES, SM_PMR_HU
+
INTERFACE SM_FOES
MODULE PROCEDURE SM_FOES_0D
MODULE PROCEDURE SM_FOES_1D
@@ -288,6 +301,8 @@ END FUNCTION SM_FOES_1D
!! Modification 16/03/95 remove the EPSILON function
!! Modification 15/09/97 (V. Masson) add solid and liquid water phases
!! in thetav computation
+!! Modification 22/01/2019 (P. Wautelet) use standard FLUSH statement
+!! instead of non standard intrinsics!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -295,8 +310,6 @@ END FUNCTION SM_FOES_1D
!
USE MODD_CST
!
-USE MODE_FM
-!
IMPLICIT NONE
!
!* 0.1 Declarations of arguments and results
@@ -349,7 +362,7 @@ IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_PMR_HU_3D',0,ZHOOK_HANDLE)
ITERMAX = 10
IF (PRESENT(KITERMAX)) ITERMAX=KITERMAX
ZRDSRV = XRD /XRV
-ZEPS = 1.E-5
+ZEPS = XEPS_DT
!
ZRSLW(:,:,:)=0.
DO JRR=2,SIZE(PR,4)
@@ -381,8 +394,8 @@ IF ( ANY(ZDT > ZEPS) ) THEN
WRITE(ILUOUT,*) 'MR AT THIS MAXIMUM : ', PMR(IMAXLOC(1),IMAXLOC(2),IMAXLOC(3))
WRITE(ILUOUT,*) 'T AT THIS MAXIMUM : ', ZT(IMAXLOC(1),IMAXLOC(2),IMAXLOC(3))
WRITE(ILUOUT,*) 'JOB ABORTED '
- CALL ABORT
- STOP
+ FLUSH(unit=ILUOUT)
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'SM_PMR_HU_3D', 'failed to converge' )
END IF
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_PMR_HU_3D',1,ZHOOK_HANDLE)
@@ -444,8 +457,6 @@ END FUNCTION SM_PMR_HU_3D
!
USE MODD_CST
!
-USE MODE_FM
-!
IMPLICIT NONE
!
!* 0.1 Declarations of arguments and results
@@ -526,8 +537,7 @@ IF (ANY(ZDT>ZEPS)) THEN
WRITE(ILUOUT,*) 'MR AT THIS MAXIMUM : ', PMR(IMAXLOC)
WRITE(ILUOUT,*) 'T AT THIS MAXIMUM : ', ZT(IMAXLOC)
WRITE(ILUOUT,*) 'JOB ABORTED '
- CALL ABORT
- STOP
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'SM_PMR_HU_1D', 'failed to converge' )
END IF
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_PMR_HU_1D',1,ZHOOK_HANDLE)
diff --git a/src/arome/aux/modi_gradient_m.F90 b/src/arome/aux/modi_gradient_m.F90
index 82f5e3c895cedbe9b433086eb3e0a4c370888ec1..ed35df93ab224912e60c3afd8ec7797b009ebc99 100644
--- a/src/arome/aux/modi_gradient_m.F90
+++ b/src/arome/aux/modi_gradient_m.F90
@@ -6,8 +6,8 @@ INTERFACE
!
!
FUNCTION GX_M_M(PA,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_M_M)
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -19,8 +19,8 @@ END FUNCTION GX_M_M
!
!
FUNCTION GY_M_M(PA,PDYY,PDZZ,PDZY, KKA, KKU, KL) RESULT(PGY_M_M)
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -33,8 +33,8 @@ END FUNCTION GY_M_M
!
FUNCTION GZ_M_M(PA,PDZZ, KKA, KKU, KL) RESULT(PGZ_M_M)
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
@@ -42,7 +42,7 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_M_M ! result mass point
!
END FUNCTION GZ_M_M
!
- FUNCTION GX_M_U(PY,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_M_U)
+ FUNCTION GX_M_U(KKA, KKU, KL,PY,PDXX,PDZZ,PDZX) RESULT(PGX_M_U)
!
IMPLICIT NONE
!
@@ -59,7 +59,7 @@ REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2),SIZE(PY,3)) :: PGX_M_U ! result at flux
END FUNCTION GX_M_U
!
!
- FUNCTION GY_M_V(PY,PDYY,PDZZ,PDZY, KKA, KKU, KL) RESULT(PGY_M_V)
+ FUNCTION GY_M_V(KKA, KKU, KL,PY,PDYY,PDZZ,PDZY) RESULT(PGY_M_V)
!
IMPLICIT NONE
!
@@ -75,7 +75,7 @@ REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2),SIZE(PY,3)) :: PGY_M_V ! result at flux
! side
END FUNCTION GY_M_V
!
- FUNCTION GZ_M_W(PY,PDZZ, KKA, KKU, KL) RESULT(PGZ_M_W)
+ FUNCTION GZ_M_W(KKA, KKU, KL,PY,PDZZ) RESULT(PGZ_M_W)
!
IMPLICIT NONE
!
diff --git a/src/arome/aux/modi_gradient_u.F90 b/src/arome/aux/modi_gradient_u.F90
index 634310304ac65a470e562864b3d89c3c713edeae..519e5cc8138a439f0c7be20a45bae5fc1b89201b 100644
--- a/src/arome/aux/modi_gradient_u.F90
+++ b/src/arome/aux/modi_gradient_u.F90
@@ -6,8 +6,8 @@ INTERFACE
!
!
FUNCTION GX_U_M(PA,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_U_M)
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -20,8 +20,8 @@ END FUNCTION GX_U_M
!
FUNCTION GY_U_UV(PA,PDYY,PDZZ,PDZY, KKA, KKU, KL) RESULT(PGY_U_UV)
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -34,8 +34,8 @@ END FUNCTION GY_U_UV
!
FUNCTION GZ_U_UW(PA,PDZZ, KKA, KKU, KL) RESULT(PGZ_U_UW)
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
diff --git a/src/arome/aux/modi_gradient_v.F90 b/src/arome/aux/modi_gradient_v.F90
index eec4d2fe9a2b2aec96f84be5e17e842ec718dc93..d1ff4a08da2f36ef0eb877d26c167bbbcfdd93a1 100644
--- a/src/arome/aux/modi_gradient_v.F90
+++ b/src/arome/aux/modi_gradient_v.F90
@@ -7,8 +7,8 @@ INTERFACE
!
FUNCTION GY_V_M(PA,PDYY,PDZZ,PDZY, KKA, KKU, KL) RESULT(PGY_V_M)
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -20,8 +20,8 @@ END FUNCTION GY_V_M
!
FUNCTION GX_V_UV(PA,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_V_UV)
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -34,8 +34,8 @@ END FUNCTION GX_V_UV
!
FUNCTION GZ_V_VW(PA,PDZZ, KKA, KKU, KL) RESULT(PGZ_V_VW)
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
diff --git a/src/arome/aux/modi_gradient_w.F90 b/src/arome/aux/modi_gradient_w.F90
index 759319e3d8287c03b5f97936f34ddeca4f2f3348..48d924d53850049ebfcf080437dc0371f3cc1c76 100644
--- a/src/arome/aux/modi_gradient_w.F90
+++ b/src/arome/aux/modi_gradient_w.F90
@@ -7,8 +7,8 @@ INTERFACE
!
FUNCTION GZ_W_M(PA,PDZZ, KKA, KKU, KL) RESULT(PGZ_W_M)
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
!
@@ -18,8 +18,8 @@ END FUNCTION GZ_W_M
!
FUNCTION GX_W_UW(PA,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_W_UW)
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
@@ -32,8 +32,8 @@ END FUNCTION GX_W_UW
!
FUNCTION GY_W_VW(PA,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGY_W_VW)
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
diff --git a/src/arome/aux/modi_second_mnh.F90 b/src/arome/aux/modi_second_mnh.F90
new file mode 100644
index 0000000000000000000000000000000000000000..aaa03bd45a5d4b51d58c4824b59e51184b62984c
--- /dev/null
+++ b/src/arome/aux/modi_second_mnh.F90
@@ -0,0 +1,7 @@
+MODULE MODI_SECOND_MNH
+INTERFACE
+SUBROUTINE SECOND_MNH(XT)
+REAL :: XT
+END SUBROUTINE SECOND_MNH
+END INTERFACE
+END MODULE MODI_SECOND_MNH
diff --git a/src/arome/aux/modi_shuman.F90 b/src/arome/aux/modi_shuman.F90
index 8bc69a410cc83ea136f24c444eb8abf328091418..d8ffd80a10bbe333b86fc74b43637d0024139fd7 100644
--- a/src/arome/aux/modi_shuman.F90
+++ b/src/arome/aux/modi_shuman.F90
@@ -35,16 +35,16 @@ END FUNCTION DYM
FUNCTION DZF(PA,KKA,KKU,KL) RESULT(PDZF)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
! side
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDZF ! result at mass localization
END FUNCTION DZF
!
FUNCTION DZM(PA,KKA,KKU,KL) RESULT(PDZM)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass
! localization
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDZM ! result at flux side
END FUNCTION DZM
!
@@ -74,16 +74,16 @@ END FUNCTION MYM
!
FUNCTION MZF(PA,KKA,KKU,KL) RESULT(PMZF)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux side
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMZF ! result at mass
! localization
END FUNCTION MZF
!
FUNCTION MZM(PA,KKA,KKU,KL) RESULT(PMZM)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMZM ! result at flux localization
END FUNCTION MZM
!
diff --git a/src/arome/aux/modi_tridiag_w.F90 b/src/arome/aux/modi_tridiag_w.F90
new file mode 100644
index 0000000000000000000000000000000000000000..f7926ae5d02134ced88fc284ac4149555ce874c4
--- /dev/null
+++ b/src/arome/aux/modi_tridiag_w.F90
@@ -0,0 +1,3 @@
+MODULE MODI_TRIDIAG_W
+! Empty module for PHYEX, used in TURB 3D
+END MODULE MODI_TRIDIAG_W
diff --git a/src/arome/aux/shuman.F90 b/src/arome/aux/shuman.F90
index 47109f11e7a325caf881364330a5289757ce29c5..f8949e00d8e7966ffc2122154fc29121ec8f9a0e 100644
--- a/src/arome/aux/shuman.F90
+++ b/src/arome/aux/shuman.F90
@@ -275,7 +275,6 @@ PMYF=PA
! PMYF(:,JJ,:) = 0.5*( PA(:,JJ,:)+PA(:,JJ+1,:) )
!END DO
!
-!PMYF(:,IJU,:) = PMYF(:,2*JPHEXT,:)
!
!-------------------------------------------------------------------------------
!
@@ -429,8 +428,8 @@ IMPLICIT NONE
! ------------------------------------
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux side
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMZF ! result at mass
! localization
!
@@ -513,8 +512,8 @@ IMPLICIT NONE
! ------------------------------------
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMZM ! result at flux localization
!
!* 0.2 Declarations of local variables
@@ -713,6 +712,7 @@ END DO
!
PDXM(1,:,:) = PDXM(IIU-2*JPHEXT+1,:,:)
!
+CALL ABORT ! AROME SHOULD NOT CALLED HORIZONTAL FINITE DIFFERENCE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('DXM',1,ZHOOK_HANDLE)
@@ -803,6 +803,8 @@ END DO
!
!PDYF(:,IJU,:) = PDYF(:,2*JPHEXT,:)
!
+CALL ABORT ! AROME SHOULD NOT CALLED HORIZONTAL FINITE DIFFERENCE
+
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('DYF',1,ZHOOK_HANDLE)
@@ -892,6 +894,7 @@ DO JJ=2,IJU
END DO
!
PDYM(:,1,:) = PDYM(:,IJU-2*JPHEXT+1,:)
+CALL ABORT ! AROME SHOULD NOT CALLED HORIZONTAL FINITE DIFFERENCE
!
!-------------------------------------------------------------------------------
!
@@ -952,8 +955,8 @@ IMPLICIT NONE
! ------------------------------------
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux side
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDZF ! result at mass
! localization
!
@@ -1036,8 +1039,8 @@ IMPLICIT NONE
! ------------------------------------
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDZM ! result at flux
! side
!
diff --git a/src/arome/chem/module/modd_aunifacparam.mod b/src/arome/chem/module/modd_aunifacparam.mod
deleted file mode 100644
index 91bcad93f116f7c72f3176c9fab70a92ac2cf64a..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_aunifacparam.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_binsolu.mod b/src/arome/chem/module/modd_binsolu.mod
deleted file mode 100644
index cf7e6d5ec4f9dbdaf450c64242385d5d158d3522..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_binsolu.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_bunifacparam.mod b/src/arome/chem/module/modd_bunifacparam.mod
deleted file mode 100644
index 5dc14f24e3cf4c94fc5ed24755911c05be73bd10..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_bunifacparam.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_ch_aero_n.mod b/src/arome/chem/module/modd_ch_aero_n.mod
deleted file mode 100644
index 0813d91e137dae6c70c176b52aed976d45062c08..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_ch_aero_n.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_ch_aerosol.mod b/src/arome/chem/module/modd_ch_aerosol.mod
deleted file mode 100644
index 0a5f2c72614e68928e38d0e950a74456ebfead27..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_ch_aerosol.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_ch_aerosol0d.mod b/src/arome/chem/module/modd_ch_aerosol0d.mod
deleted file mode 100644
index 6819f122293aa5e748ffe54f80edf052f7df1a27..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_ch_aerosol0d.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_ch_const.mod b/src/arome/chem/module/modd_ch_const.mod
deleted file mode 100644
index 996e9fce64a37793ff29a936320d8e4ecff9e7ad..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_ch_const.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_ch_dep_n.mod b/src/arome/chem/module/modd_ch_dep_n.mod
deleted file mode 100644
index 800bd7ac4f8cf8e77b9702ea7aaf580f84385f77..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_ch_dep_n.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_ch_init_jvalues.mod b/src/arome/chem/module/modd_ch_init_jvalues.mod
deleted file mode 100644
index ac08d73b31794782780d0e8d8a77cbd9b6c59b05..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_ch_init_jvalues.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_ch_jvalues_n.mod b/src/arome/chem/module/modd_ch_jvalues_n.mod
deleted file mode 100644
index fe1e7e4e80906c646745c8a65fc18515c07663ae..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_ch_jvalues_n.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_ch_m9.mod b/src/arome/chem/module/modd_ch_m9.mod
deleted file mode 100644
index 6beb1980e96a2c90812a1b4e807c6909d8077da8..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_ch_m9.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_ch_m9_scheme.mod b/src/arome/chem/module/modd_ch_m9_scheme.mod
deleted file mode 100644
index d86d6d56bf6055bf9a07795ac36fd887dc449b0b..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_ch_m9_scheme.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_ch_meteo.mod b/src/arome/chem/module/modd_ch_meteo.mod
deleted file mode 100644
index f391f1a26fc0023ef26fffac6847fe2dcbe50616..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_ch_meteo.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_ch_mnhc_n.mod b/src/arome/chem/module/modd_ch_mnhc_n.mod
deleted file mode 100644
index 79f37d408ace81078fe75db7316c80ef81112eec..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_ch_mnhc_n.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_ch_model0d.mod b/src/arome/chem/module/modd_ch_model0d.mod
deleted file mode 100644
index 2e0ab963078698286e20ec714547f0eee2e7d6dd..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_ch_model0d.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_ch_solver_n.mod b/src/arome/chem/module/modd_ch_solver_n.mod
deleted file mode 100644
index 39473590903381317f1c2c9412e3322444c9e7b1..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_ch_solver_n.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_csts_dust.mod b/src/arome/chem/module/modd_csts_dust.mod
deleted file mode 100644
index 291816dd2967784448803091674dc91c73446846..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_csts_dust.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_csts_salt.mod b/src/arome/chem/module/modd_csts_salt.mod
deleted file mode 100644
index 4970439510922d5568e23727c37511a255ce8489..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_csts_salt.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_dust.mod b/src/arome/chem/module/modd_dust.mod
deleted file mode 100644
index 15da824a3952e1cbe50ca5ec3c2440687e9a5fb8..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_dust.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_dust_opt_lkt.mod b/src/arome/chem/module/modd_dust_opt_lkt.mod
deleted file mode 100644
index fe09dc6407fe9d00546999aad9371c0e947fa6d3..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_dust_opt_lkt.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_glo.mod b/src/arome/chem/module/modd_glo.mod
deleted file mode 100644
index ff3649c8c85a46a45cbc231a50d675c1e413cc65..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_glo.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_indref_aer.mod b/src/arome/chem/module/modd_indref_aer.mod
deleted file mode 100644
index 53e4bbe87942389d089b0bd02cd8c63fc0011aae..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_indref_aer.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_parameters_dep.mod b/src/arome/chem/module/modd_parameters_dep.mod
deleted file mode 100644
index c203a8024ecc0d7a422376c6f1cde7ac5936229a..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_parameters_dep.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_salt.mod b/src/arome/chem/module/modd_salt.mod
deleted file mode 100644
index e135212ab7b61121f52f2fa333028c5dfebf4747..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_salt.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_sub_ch_field_value_n.mod b/src/arome/chem/module/modd_sub_ch_field_value_n.mod
deleted file mode 100644
index 9e5911147c386512e3962fecebd4644e876bad7c..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_sub_ch_field_value_n.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_sub_ch_monitor_n.mod b/src/arome/chem/module/modd_sub_ch_monitor_n.mod
deleted file mode 100644
index 3b67ab4cd3557d1746d749ad9131a25ca0b09882..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_sub_ch_monitor_n.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_unifacparam.mod b/src/arome/chem/module/modd_unifacparam.mod
deleted file mode 100644
index 37636401e0a6d1d16a67f5cb0ba9727d5ae54b52..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_unifacparam.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_wet_dep_descr.mod b/src/arome/chem/module/modd_wet_dep_descr.mod
deleted file mode 100644
index 9bc5d995b774bbd24bae2af612873861bf949a81..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_wet_dep_descr.mod and /dev/null differ
diff --git a/src/arome/chem/module/modd_wet_dep_param.mod b/src/arome/chem/module/modd_wet_dep_param.mod
deleted file mode 100644
index 3171763c87b386adb4fd76f26fe6a48090a76c62..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modd_wet_dep_param.mod and /dev/null differ
diff --git a/src/arome/chem/module/mode_aero_psd.mod b/src/arome/chem/module/mode_aero_psd.mod
deleted file mode 100644
index 6c8106f380af935645bcd3eebfe98ead3ac5d146..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/mode_aero_psd.mod and /dev/null differ
diff --git a/src/arome/chem/module/mode_amain.mod b/src/arome/chem/module/mode_amain.mod
deleted file mode 100644
index 1ace17cccbeab5c23d9f2fb1f7cab6882580368c..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/mode_amain.mod and /dev/null differ
diff --git a/src/arome/chem/module/mode_bmain.mod b/src/arome/chem/module/mode_bmain.mod
deleted file mode 100644
index 5a235fa6bb20a7ab76806fd82b7e5ee6d37b28c9..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/mode_bmain.mod and /dev/null differ
diff --git a/src/arome/chem/module/mode_dust_psd.mod b/src/arome/chem/module/mode_dust_psd.mod
deleted file mode 100644
index 826323fc409381a08c60da7249077bd806365d42..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/mode_dust_psd.mod and /dev/null differ
diff --git a/src/arome/chem/module/mode_dustopt.mod b/src/arome/chem/module/mode_dustopt.mod
deleted file mode 100644
index e9f16d7d4db9b7cd7a7927ef2473d18a8e8fb27b..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/mode_dustopt.mod and /dev/null differ
diff --git a/src/arome/chem/module/mode_firstguess.mod b/src/arome/chem/module/mode_firstguess.mod
deleted file mode 100644
index 5ad3ee332dfb119fe4bc802f3874198d3758c3d7..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/mode_firstguess.mod and /dev/null differ
diff --git a/src/arome/chem/module/mode_modeln_handler.mod b/src/arome/chem/module/mode_modeln_handler.mod
deleted file mode 100644
index 50307289393c97ea286dbe74b245f9b667861551..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/mode_modeln_handler.mod and /dev/null differ
diff --git a/src/arome/chem/module/mode_oamain.mod b/src/arome/chem/module/mode_oamain.mod
deleted file mode 100644
index a45f7339c96d486dbb6b8bd7d5dd54b12c3b4544..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/mode_oamain.mod and /dev/null differ
diff --git a/src/arome/chem/module/mode_salt_psd.mod b/src/arome/chem/module/mode_salt_psd.mod
deleted file mode 100644
index 3e980bfb6b7b0d90ede8df147d65913c691bb645..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/mode_salt_psd.mod and /dev/null differ
diff --git a/src/arome/chem/module/mode_soaeql.mod b/src/arome/chem/module/mode_soaeql.mod
deleted file mode 100644
index f6bd5948e399074086e2af812d296a68b5915153..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/mode_soaeql.mod and /dev/null differ
diff --git a/src/arome/chem/module/mode_soaeqlutl.mod b/src/arome/chem/module/mode_soaeqlutl.mod
deleted file mode 100644
index 623551d81cb33fe0a62b29d3e729c3738a8e952d..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/mode_soaeqlutl.mod and /dev/null differ
diff --git a/src/arome/chem/module/mode_soatinit.mod b/src/arome/chem/module/mode_soatinit.mod
deleted file mode 100644
index 505cc8222c7169c9d4926b2ff0a9b33d439dd233..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/mode_soatinit.mod and /dev/null differ
diff --git a/src/arome/chem/module/mode_typea.mod b/src/arome/chem/module/mode_typea.mod
deleted file mode 100644
index 32308a2552723c5cb65e9c27897ada9bad91b96d..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/mode_typea.mod and /dev/null differ
diff --git a/src/arome/chem/module/mode_typeb.mod b/src/arome/chem/module/mode_typeb.mod
deleted file mode 100644
index e9b19ebf24885ca23ffd8762e669119155c38bb2..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/mode_typeb.mod and /dev/null differ
diff --git a/src/arome/chem/module/mode_unifac.mod b/src/arome/chem/module/mode_unifac.mod
deleted file mode 100644
index 44a02182c438cdb32d1d7776656779c8dbb094c2..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/mode_unifac.mod and /dev/null differ
diff --git a/src/arome/chem/module/mode_zsrpun.mod b/src/arome/chem/module/mode_zsrpun.mod
deleted file mode 100644
index 29f61e633787fcbb39f2e5c9f7d1f0705ec2c1ae..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/mode_zsrpun.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_aer_effic.mod b/src/arome/chem/module/modi_aer_effic.mod
deleted file mode 100644
index d3f0017fe290932ae8dad22a2bdd3e32b48c3844..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_aer_effic.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_aer_effic_dep.mod b/src/arome/chem/module/modi_aer_effic_dep.mod
deleted file mode 100644
index e89e59a68a6ad9a9cabf29d1ee17cbf0eef90ad6..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_aer_effic_dep.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_aer_velgrav.mod b/src/arome/chem/module/modi_aer_velgrav.mod
deleted file mode 100644
index fe656a00fcb06f605889c6966e9fc8cefc28d749..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_aer_velgrav.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_aer_wet_dep.mod b/src/arome/chem/module/modi_aer_wet_dep.mod
deleted file mode 100644
index 4586c848026ec93d702803caf7cd788e484bec78..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_aer_wet_dep.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_aer_wet_dep_kmt_warm.mod b/src/arome/chem/module/modi_aer_wet_dep_kmt_warm.mod
deleted file mode 100644
index 2b91bfb67fcf8e64d8156fa659b92afb4a500356..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_aer_wet_dep_kmt_warm.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_aer_coag.mod b/src/arome/chem/module/modi_ch_aer_coag.mod
deleted file mode 100644
index ea62bd33d3daa631031c7f97e6abc8a7bfe60b98..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_aer_coag.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_aer_driver.mod b/src/arome/chem/module/modi_ch_aer_driver.mod
deleted file mode 100644
index 05e8b036bf71d8f43536e74d5b87b6c781fed080..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_aer_driver.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_aer_eqm_cormass.mod b/src/arome/chem/module/modi_ch_aer_eqm_cormass.mod
deleted file mode 100644
index 9fdff192aa7545fb058b771a674fb29c9cb68b72..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_aer_eqm_cormass.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_aer_eqm_init0d.mod b/src/arome/chem/module/modi_ch_aer_eqm_init0d.mod
deleted file mode 100644
index 0283abd11af281d8ee2e44a3cd5ce083e89b826d..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_aer_eqm_init0d.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_aer_eqm_init_n.mod b/src/arome/chem/module/modi_ch_aer_eqm_init_n.mod
deleted file mode 100644
index 69bcd73109385e9cdbb49b75df5ed1d3070e35e8..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_aer_eqm_init_n.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_aer_eqsam.mod b/src/arome/chem/module/modi_ch_aer_eqsam.mod
deleted file mode 100644
index bc95d986a0545d9d9477f927030f610e504d313b..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_aer_eqsam.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_aer_growth.mod b/src/arome/chem/module/modi_ch_aer_growth.mod
deleted file mode 100644
index bf894def4039a921e0dd9ae8b4709c72aab655a8..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_aer_growth.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_aer_init.mod b/src/arome/chem/module/modi_ch_aer_init.mod
deleted file mode 100644
index ed2b0ddbe12a8ad0a656367ed77550c998bc4fbc..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_aer_init.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_aer_init_soa.mod b/src/arome/chem/module/modi_ch_aer_init_soa.mod
deleted file mode 100644
index 5eee0233bdd4df963a41c3c6f4b5767c172da64d..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_aer_init_soa.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_aer_intermin.mod b/src/arome/chem/module/modi_ch_aer_intermin.mod
deleted file mode 100644
index 51f25ea7aadaf1d0084dbddd99cca9e79260def8..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_aer_intermin.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_aer_mineral.mod b/src/arome/chem/module/modi_ch_aer_mineral.mod
deleted file mode 100644
index 4c5208ba7f7a6e6bc6be36fd5a200ec9cc6f3c66..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_aer_mineral.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_aer_mod_init.mod b/src/arome/chem/module/modi_ch_aer_mod_init.mod
deleted file mode 100644
index 7d99a34633e1559dfd3359c10d816a4e1ffb87d0..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_aer_mod_init.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_aer_mpmpo.mod b/src/arome/chem/module/modi_ch_aer_mpmpo.mod
deleted file mode 100644
index 4d0a0c5ce8ac4b4cc7769d30acca9ef72d880da1..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_aer_mpmpo.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_aer_nucl.mod b/src/arome/chem/module/modi_ch_aer_nucl.mod
deleted file mode 100644
index 2cdef9236cfa56c309f83dfd9d40f825b5d8cba9..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_aer_nucl.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_aer_organic.mod b/src/arome/chem/module/modi_ch_aer_organic.mod
deleted file mode 100644
index 93913aa512d3ac6871648f091b23abb280425fd8..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_aer_organic.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_aer_pun.mod b/src/arome/chem/module/modi_ch_aer_pun.mod
deleted file mode 100644
index e497ad07abb1e1f7e814849f8f91763ffdc45bbf..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_aer_pun.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_aer_reallfi_n.mod b/src/arome/chem/module/modi_ch_aer_reallfi_n.mod
deleted file mode 100644
index 5d647c7f0bd271c10f7dcfb124b577ac3652f061..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_aer_reallfi_n.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_aer_sedim_n.mod b/src/arome/chem/module/modi_ch_aer_sedim_n.mod
deleted file mode 100644
index b322e955353c5fbbb579666375612a556d3d74bd..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_aer_sedim_n.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_aer_solv.mod b/src/arome/chem/module/modi_ch_aer_solv.mod
deleted file mode 100644
index 739056625de509880f44c782712bbf4ec7ba1f2e..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_aer_solv.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_aer_surf.mod b/src/arome/chem/module/modi_ch_aer_surf.mod
deleted file mode 100644
index 2d8a91d1ed53537ebba477d16741e76c67fb4145..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_aer_surf.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_aer_thermo.mod b/src/arome/chem/module/modi_ch_aer_thermo.mod
deleted file mode 100644
index e7af9e7dd4c227828a5d2cd09ba36723a0c9fd65..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_aer_thermo.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_aer_trans.mod b/src/arome/chem/module/modi_ch_aer_trans.mod
deleted file mode 100644
index be3dad19e48d55a3a602ba43845bb2c8a55c7eff..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_aer_trans.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_aer_velgrav_n.mod b/src/arome/chem/module/modi_ch_aer_velgrav_n.mod
deleted file mode 100644
index 38f33f3fe0eb3cce7a93b78334e85a658dfc2942..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_aer_velgrav_n.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_allocate_taccs.mod b/src/arome/chem/module/modi_ch_allocate_taccs.mod
deleted file mode 100644
index 7ddd9dbfeaedb645b049bd6e879b31d736af7a58..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_allocate_taccs.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_aqua.mod b/src/arome/chem/module/modi_ch_aqua.mod
deleted file mode 100644
index 94da6bd5c580cc0aa06287521e60bfa0ebbad57d..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_aqua.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_ares.mod b/src/arome/chem/module/modi_ch_ares.mod
deleted file mode 100644
index 4c3a6d5843d1dfdc32f50c3900840d7d5c45397e..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_ares.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_boundaries.mod b/src/arome/chem/module/modi_ch_boundaries.mod
deleted file mode 100644
index 12f4bc83e66d49f0df13561af12cd4a934ac1b6a..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_boundaries.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_convect_linox.mod b/src/arome/chem/module/modi_ch_convect_linox.mod
deleted file mode 100644
index 4444edc73b747edc3d11e6ba5f429fcf5b205e1f..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_convect_linox.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_cranck.mod b/src/arome/chem/module/modi_ch_cranck.mod
deleted file mode 100644
index 5533c10da36a24c2bbbe81814c02a80dc93fedf2..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_cranck.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_deallocate_taccs.mod b/src/arome/chem/module/modi_ch_deallocate_taccs.mod
deleted file mode 100644
index bd0e88397300f24a76a0e7f082b9b292d82efe68..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_deallocate_taccs.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_diagnostics.mod b/src/arome/chem/module/modi_ch_diagnostics.mod
deleted file mode 100644
index 7da13a5c7eed2ff9f134292bc857312b342607a0..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_diagnostics.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_emission_flux0d.mod b/src/arome/chem/module/modi_ch_emission_flux0d.mod
deleted file mode 100644
index 7fcad6a90dd10b120780d8f27c8e9b845d21fc42..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_emission_flux0d.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_exqssa.mod b/src/arome/chem/module/modi_ch_exqssa.mod
deleted file mode 100644
index c18f771e6de0992bdd39fd1ef0231364ba85c81e..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_exqssa.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_fcn.mod b/src/arome/chem/module/modi_ch_fcn.mod
deleted file mode 100644
index 71fc1a791fbc88ba747511c24350ae62582b1730..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_fcn.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_field_value_n.mod b/src/arome/chem/module/modi_ch_field_value_n.mod
deleted file mode 100644
index 4418ba844a3cbbbd285efb81c565c99c875cb578..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_field_value_n.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_gauss.mod b/src/arome/chem/module/modi_ch_gauss.mod
deleted file mode 100644
index ce113c0b5f261fa338226223f6fd91222db85954..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_gauss.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_get_cnames.mod b/src/arome/chem/module/modi_ch_get_cnames.mod
deleted file mode 100644
index 75192f28c2b5f3de554b1244b22ee9101526513c..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_get_cnames.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_get_rates.mod b/src/arome/chem/module/modi_ch_get_rates.mod
deleted file mode 100644
index 77cf308dea90d32e9e22e9246734b22a9ae1497b..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_get_rates.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_ini_orilam.mod b/src/arome/chem/module/modi_ch_ini_orilam.mod
deleted file mode 100644
index 2e93f1f007c75ddf9b4b481f0ec6b22e0231f14b..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_ini_orilam.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_init_ccs.mod b/src/arome/chem/module/modi_ch_init_ccs.mod
deleted file mode 100644
index eee7db5ac9e4eb9cea7863b62fcac00d2d7c57cc..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_init_ccs.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_init_const_n.mod b/src/arome/chem/module/modi_ch_init_const_n.mod
deleted file mode 100644
index 63aeedbe9b0b60556b6f19b72e8465de450b6e4e..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_init_const_n.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_init_jvalues.mod b/src/arome/chem/module/modi_ch_init_jvalues.mod
deleted file mode 100644
index 69d9cc01876e5eb4a11348fd6adab4086ec8a6be..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_init_jvalues.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_init_meteo.mod b/src/arome/chem/module/modi_ch_init_meteo.mod
deleted file mode 100644
index a556290d3f58e41050817386b0b9b5a4bd677e7a..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_init_meteo.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_init_model0d.mod b/src/arome/chem/module/modi_ch_init_model0d.mod
deleted file mode 100644
index 0f81fcd449ba704532bc6824837cece36a5107d2..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_init_model0d.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_init_output.mod b/src/arome/chem/module/modi_ch_init_output.mod
deleted file mode 100644
index 553aca39fb45e03e746bf0be287b692715a1dea0..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_init_output.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_init_scheme.mod b/src/arome/chem/module/modi_ch_init_scheme.mod
deleted file mode 100644
index 339dbcfc7e191d7c0a563ac67b5cbe2ac1450b91..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_init_scheme.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_interp_jvalues.mod b/src/arome/chem/module/modi_ch_interp_jvalues.mod
deleted file mode 100644
index bb6318e864a135cb0c789311456b9a6596e23768..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_interp_jvalues.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_interp_jvalues_n.mod b/src/arome/chem/module/modi_ch_interp_jvalues_n.mod
deleted file mode 100644
index 1cd44c64b1acc204876be182af8ecec80271714c..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_interp_jvalues_n.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_isoropia.mod b/src/arome/chem/module/modi_ch_isoropia.mod
deleted file mode 100644
index 1ace36110db0b6a803167db58733b13af5688706..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_isoropia.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_jac.mod b/src/arome/chem/module/modi_ch_jac.mod
deleted file mode 100644
index 6db0180bf568e37b5eee34b44df04f305c9e86cc..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_jac.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_jvalues_clouds.mod b/src/arome/chem/module/modi_ch_jvalues_clouds.mod
deleted file mode 100644
index be9b9ab7a27789971bad14e57174c72e2f153c40..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_jvalues_clouds.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_jvalues_clouds_n.mod b/src/arome/chem/module/modi_ch_jvalues_clouds_n.mod
deleted file mode 100644
index 7ea0c37a7783779e60ea6603197b436d55bc86cf..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_jvalues_clouds_n.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_jvalues_n.mod b/src/arome/chem/module/modi_ch_jvalues_n.mod
deleted file mode 100644
index 579acc1a4443d945754fd0eea1f9c5a0403ca53c..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_jvalues_n.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_linssa.mod b/src/arome/chem/module/modi_ch_linssa.mod
deleted file mode 100644
index 701c4473c84fb9059930a101e44455499ec7d376..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_linssa.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_meteo_trans.mod b/src/arome/chem/module/modi_ch_meteo_trans.mod
deleted file mode 100644
index 2c18d3797868d4647fe83a10e245cfa3e817755c..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_meteo_trans.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_monitor_n.mod b/src/arome/chem/module/modi_ch_monitor_n.mod
deleted file mode 100644
index b0e62a9a8cad0b21da3673188e85348399d15fe7..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_monitor_n.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_nnares.mod b/src/arome/chem/module/modi_ch_nnares.mod
deleted file mode 100644
index c0534a9a2520278b8e0cadb850dac72fb079a563..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_nnares.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_nonzeroterms.mod b/src/arome/chem/module/modi_ch_nonzeroterms.mod
deleted file mode 100644
index 0ee3b366f14c90bf533a2789b25c41d4ed044d2c..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_nonzeroterms.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_open_input.mod b/src/arome/chem/module/modi_ch_open_input.mod
deleted file mode 100644
index b7a8881f092a49a9aa54b1f89418a888be95de3b..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_open_input.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_orilam.mod b/src/arome/chem/module/modi_ch_orilam.mod
deleted file mode 100644
index c9ff79c4a9e343bfc686288e2372ce5439e82f74..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_orilam.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_output.mod b/src/arome/chem/module/modi_ch_output.mod
deleted file mode 100644
index ae1a294a0fe5442f523148995a5b954f4268ffac..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_output.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_prodloss.mod b/src/arome/chem/module/modi_ch_prodloss.mod
deleted file mode 100644
index 70a8c95fdd69f7d18352644dc7a53f4912ccc11d..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_prodloss.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_qssa.mod b/src/arome/chem/module/modi_ch_qssa.mod
deleted file mode 100644
index aa23a99fe73724eba33f5e50bb1a7aa0c930077e..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_qssa.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_read_chem.mod b/src/arome/chem/module/modi_ch_read_chem.mod
deleted file mode 100644
index e7b426c0d21d719b3d997fd15f00995d0eb1830b..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_read_chem.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_read_meteo.mod b/src/arome/chem/module/modi_ch_read_meteo.mod
deleted file mode 100644
index f78e7a3ae8cc0485f6a9cf79b7ee6837d5decfaf..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_read_meteo.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_read_vector.mod b/src/arome/chem/module/modi_ch_read_vector.mod
deleted file mode 100644
index d9c5684913dd14e33644b5871cfa24d97820117f..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_read_vector.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_set_photo_rates.mod b/src/arome/chem/module/modi_ch_set_photo_rates.mod
deleted file mode 100644
index ec66dbc2c56c1dfb4cc351d11cb2735ff3dab05b..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_set_photo_rates.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_set_rates.mod b/src/arome/chem/module/modi_ch_set_rates.mod
deleted file mode 100644
index dc051de4c6ddf4bbd6cf38563dc00d70e8fde6b9..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_set_rates.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_show_chem.mod b/src/arome/chem/module/modi_ch_show_chem.mod
deleted file mode 100644
index 0c58d9a91ccd4452a4ab7b5e6a556e19a050ac9c..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_show_chem.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_sis.mod b/src/arome/chem/module/modi_ch_sis.mod
deleted file mode 100644
index f27b9e1e484a922729ff5d1d26247f81ca6c245c..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_sis.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_solver_n.mod b/src/arome/chem/module/modi_ch_solver_n.mod
deleted file mode 100644
index bb34dc16778085e44327f142186cd621f3fa0e5e..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_solver_n.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_sparse.mod b/src/arome/chem/module/modi_ch_sparse.mod
deleted file mode 100644
index cb4d78cf8348da6eb4d1e768e7fc28c054b08491..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_sparse.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_svode.mod b/src/arome/chem/module/modi_ch_svode.mod
deleted file mode 100644
index 3c340b1ae0c567897a5f9d8ee48a7d7cd6463d08..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_svode.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_terms.mod b/src/arome/chem/module/modi_ch_terms.mod
deleted file mode 100644
index cdc96655b1253e871a66582698641c4a28452287..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_terms.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_update_jvalues.mod b/src/arome/chem/module/modi_ch_update_jvalues.mod
deleted file mode 100644
index cf5feae2c642f26ce9659fe4508e7c2530ddbb02..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_update_jvalues.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_update_jvalues_n.mod b/src/arome/chem/module/modi_ch_update_jvalues_n.mod
deleted file mode 100644
index f5c482f0e55174963ae332aaec45f1ee6028b1b5..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_update_jvalues_n.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_update_meteo.mod b/src/arome/chem/module/modi_ch_update_meteo.mod
deleted file mode 100644
index 6a8d0c4c70dba53cfe140c7d7cb5ab94456f3c5b..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_update_meteo.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ch_write_chem.mod b/src/arome/chem/module/modi_ch_write_chem.mod
deleted file mode 100644
index 4a1295f2db17b651c48d7c0d351a5782c615500a..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ch_write_chem.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_dust_filter.mod b/src/arome/chem/module/modi_dust_filter.mod
deleted file mode 100644
index 1f7a571a822bb3a0952fdf0812a1da61620f98bf..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_dust_filter.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_dust_velgrav.mod b/src/arome/chem/module/modi_dust_velgrav.mod
deleted file mode 100644
index 10103a562077c3967ffff166a94be7c2c7759250..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_dust_velgrav.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_dustlfi_n.mod b/src/arome/chem/module/modi_dustlfi_n.mod
deleted file mode 100644
index 3ba552e731a87022bfef0acdf8fca2f203ab883b..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_dustlfi_n.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_eqsam_v03d_sub.mod b/src/arome/chem/module/modi_eqsam_v03d_sub.mod
deleted file mode 100644
index fa8110881602c82bac0c97770931a894ade424ad..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_eqsam_v03d_sub.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_ini_wet_dep.mod b/src/arome/chem/module/modi_ini_wet_dep.mod
deleted file mode 100644
index 64a1e96a283c4bdbc55b67df916b5c1498ee31d3..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_ini_wet_dep.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_init_dust.mod b/src/arome/chem/module/modi_init_dust.mod
deleted file mode 100644
index 957b57c0953f870e992632a0fd3822d2b1b14eae..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_init_dust.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_inv_levels.mod b/src/arome/chem/module/modi_inv_levels.mod
deleted file mode 100644
index cc0132bfa3481e70aa21a0c8c9df455c158e203c..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_inv_levels.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_mpdata_scalar.mod b/src/arome/chem/module/modi_mpdata_scalar.mod
deleted file mode 100644
index 202e390974ae8f067a2f7dfb655d416a949daf37..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_mpdata_scalar.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_salt_filter.mod b/src/arome/chem/module/modi_salt_filter.mod
deleted file mode 100644
index 66d09aba4b4b43750b87b6d5b347f2a23e9ddf2f..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_salt_filter.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_salt_velgrav.mod b/src/arome/chem/module/modi_salt_velgrav.mod
deleted file mode 100644
index 5e5dd06a7f6b2fea3b07bad12a2bb9708f6ae69c..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_salt_velgrav.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_saltlfi_n.mod b/src/arome/chem/module/modi_saltlfi_n.mod
deleted file mode 100644
index f2389bd9adb2a2baed4769fde4e13f675aa1088d..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_saltlfi_n.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_sedim_dust.mod b/src/arome/chem/module/modi_sedim_dust.mod
deleted file mode 100644
index 09a6bc907dbb860b11b2c8b2114915dd6de0856e..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_sedim_dust.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_sedim_salt.mod b/src/arome/chem/module/modi_sedim_salt.mod
deleted file mode 100644
index 12f36f5d32556f49c551dd272290b2c26f4b1dca..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_sedim_salt.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_troe.mod b/src/arome/chem/module/modi_troe.mod
deleted file mode 100644
index c4b9e6f8237fcdba57a2259464d50dde1de80a19..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_troe.mod and /dev/null differ
diff --git a/src/arome/chem/module/modi_troe_equil.mod b/src/arome/chem/module/modi_troe_equil.mod
deleted file mode 100644
index 0d27ba0def4af36d285941f7b9926c427c381eef..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modi_troe_equil.mod and /dev/null differ
diff --git a/src/arome/chem/module/modn_ch_orilam.mod b/src/arome/chem/module/modn_ch_orilam.mod
deleted file mode 100644
index 6c88f81ebb75ab511aff17e925c487ed4ecf3988..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modn_ch_orilam.mod and /dev/null differ
diff --git a/src/arome/chem/module/modn_dust.mod b/src/arome/chem/module/modn_dust.mod
deleted file mode 100644
index f2178cb6b2bd56dad047c1140cf7d41e1845cb28..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modn_dust.mod and /dev/null differ
diff --git a/src/arome/chem/module/modn_salt.mod b/src/arome/chem/module/modn_salt.mod
deleted file mode 100644
index 601380330471149755338757d1a95088ebee5414..0000000000000000000000000000000000000000
Binary files a/src/arome/chem/module/modn_salt.mod and /dev/null differ
diff --git a/src/arome/turb/modd_dynn.F90 b/src/arome/dead_code/modd_dynn.F90
similarity index 100%
rename from src/arome/turb/modd_dynn.F90
rename to src/arome/dead_code/modd_dynn.F90
diff --git a/src/arome/micro/mode_fmbidon.F90 b/src/arome/dead_code/mode_fmbidon.F90
similarity index 100%
rename from src/arome/micro/mode_fmbidon.F90
rename to src/arome/dead_code/mode_fmbidon.F90
diff --git a/src/arome/micro/mode_fmwritbidon.F90 b/src/arome/dead_code/mode_fmwritbidon.F90
similarity index 100%
rename from src/arome/micro/mode_fmwritbidon.F90
rename to src/arome/dead_code/mode_fmwritbidon.F90
diff --git a/src/arome/turb/modn_turb.F90 b/src/arome/dead_code/modn_turb.F90
similarity index 100%
rename from src/arome/turb/modn_turb.F90
rename to src/arome/dead_code/modn_turb.F90
diff --git a/src/arome/ext/aro_turb_mnh.F90 b/src/arome/ext/aro_turb_mnh.F90
index caee9cfa67fc6e614a16aedfdc3e32158d782230..73772849b9066a6a3f5b1289ed8fcffc9d6c0646 100644
--- a/src/arome/ext/aro_turb_mnh.F90
+++ b/src/arome/ext/aro_turb_mnh.F90
@@ -71,7 +71,8 @@
USE MODD_CONF
USE MODD_CST
USE MODD_PARAMETERS
-
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_BUDGET, ONLY: NBUDGET_RI, TBUDGETDATA
!
USE MODI_TURB
!
@@ -100,6 +101,7 @@ INTEGER, INTENT(IN) :: KGRADIENTS ! Number of stored horizon
LOGICAL, INTENT(IN) :: LDHARATU ! HARATU scheme active
CHARACTER (LEN=4), INTENT(IN) :: HMF_UPDRAFT ! Type of mass flux scheme
+CHARACTER (LEN=4) :: HCLOUD ! Type of microphysical scheme
REAL, INTENT(IN) :: PTSTEP ! Time step
!
!
@@ -170,11 +172,13 @@ LOGICAL , INTENT(IN) :: OSUBG_COND ! switch
REAL, DIMENSION(KLON,1,KLEV+2), INTENT(OUT) :: PDP, PTP, PTPMF, PTDIFF, PTDISS
! !for TKE DDH budgets
!
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
+TYPE(TYP_DDH), INTENT(INOUT), TARGET :: YDDDH
+TYPE(TLDDH), INTENT(IN), TARGET :: YDLDDH
+TYPE(TMDDH), INTENT(IN), TARGET :: YDMDDH
!
!
+TYPE(TBUDGETDATA), DIMENSION(NBUDGET_RI) :: YLBUDGET !NBUDGET_RI is the one with the highest number needed for turb
+TYPE(TFILEDATA) :: ZTFILE !I/O for MesoNH
!* 0.2 Declarations of local variables :
!
INTEGER :: JRR,JSV ! Loop index for the moist and scalar variables
@@ -198,24 +202,18 @@ CHARACTER(LEN=4),DIMENSION(2) :: HLBCX, HLBCY ! X- and Y-direc LBC
INTEGER :: ISPLIT ! number of time-splitting
-LOGICAL :: OCLOSE_OUT ! Conditional closure of
- ! the OUTPUT FM-file
LOGICAL :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
LOGICAL :: OTURB_DIAG ! switch to write some
! diagnostic fields in the syncronous FM-file
LOGICAL :: ORMC01 ! switch for RMC01 lengths in SBL
+LOGICAL :: OOCEAN ! switch for OCEAN version of turbulence scheme
CHARACTER(LEN=4) :: HTURBDIM ! dimensionality of the
! turbulence scheme
CHARACTER(LEN=4) :: HTURBLEN ! kind of mixing length
REAL :: ZIMPL ! degree of implicitness
-
-CHARACTER(LEN=4) :: HFMFILE ! Name of the output
- ! FM-file
-CHARACTER(LEN=4) :: HLUOUT ! Output-listing name for
- ! model n
!
REAL, DIMENSION(KLON,1,KLEV+2) :: ZDXX,ZDYY,ZDZZ,ZDZX,ZDZY
! metric coefficients
@@ -264,6 +262,9 @@ IKE=KKU-JPVEXT_TURB*KKL
! Numero du modele si grid nestind, toujours egal a 1
IMI=1
+! Fichier I/O pour MesoNH (non-utilise dans AROME)
+ZTFILE%LOPENED=.FALSE.
+
! Type de condition � la limite. En 1D, sans importance. A etudier en 3D.
HLBCX(:)='CYCL'
HLBCY(:)='CYCL'
@@ -272,9 +273,6 @@ HLBCY(:)='CYCL'
ISPLIT=1
! pour ecriture et diagnostic dans mesoNH, � priori les switches toujours � .F.
-OCLOSE_OUT=.FALSE.
-HFMFILE=' '
-HLUOUT= ' '
OTURB_FLX=.FALSE.
OTURB_DIAG=.FALSE.
@@ -283,9 +281,11 @@ ORMC01=.FALSE.
HTURBDIM='1DIM'
HTURBLEN='BL89'
-
+HCLOUD='ICE3'
ZIMPL=1.
+!Version Ocean du schema de turbulence
+OOCEAN=.FALSE.
! tableau a recalculer a chaque pas de temps
! attention, ZDZZ est l'altitude entre deux niveaux (et pas l'�paisseur de la couche)
@@ -412,27 +412,33 @@ ZCEI_MIN=0.0
ZCEI=0.0
ZCOEF_AMPL_SAT=0.0
-CL=HINST_SFU
+DO JRR=1, NBUDGET_RI
+ YLBUDGET(JRR)%NBUDGET=JRR
+ YLBUDGET(JRR)%YDDDH=>YDDDH
+ YLBUDGET(JRR)%YDLDDH=>YDLDDH
+ YLBUDGET(JRR)%YDMDDH=>YDMDDH
+ENDDO
+
CALL TURB (KLEV+2,1,KKL,IMI, KRR, KRRL, KRRI, HLBCX, HLBCY, ISPLIT,IMI, &
- & OCLOSE_OUT,OTURB_FLX,OTURB_DIAG,OSUBG_COND,ORMC01, &
- & HTURBDIM,HTURBLEN,'NONE','NONE', CL, &
- & HMF_UPDRAFT,ZIMPL, &
- & 2*PTSTEP, 2*PTSTEP, 2*PTSTEP, &
- & HFMFILE,HLUOUT,ZDXX,ZDYY,ZDZZ,ZDZX,ZDZY,ZZZ, &
+ & OTURB_FLX,OTURB_DIAG,OSUBG_COND,ORMC01,OOCEAN, &
+ & HTURBDIM,HTURBLEN,'NONE','NONE',HCLOUD, &
+ & ZIMPL, &
+ & 2*PTSTEP,ZTFILE, &
+ & ZDXX,ZDYY,ZDZZ,ZDZX,ZDZY,ZZZ, &
& ZDIRCOSXW,ZDIRCOSYW,ZDIRCOSZW,ZCOSSLOPE,ZSINSLOPE, &
- & PRHODJ,PTHVREF,PRHODREF, &
+ & PRHODJ,PTHVREF, &
& PSFTH,PSFRV,PSFSV,PSFU,PSFV, &
& PPABSM,PUM,PVM,PWM,PTKEM,ZSVM,PSRCM, &
& PLENGTHM,PLENGTHH,MFMOIST, &
& ZBL_DEPTH,ZSBL_DEPTH, &
- & PUM,PVM,PWM,ZCEI,ZCEI_MIN,ZCEI_MAX,ZCOEF_AMPL_SAT, &
+ & ZCEI,ZCEI_MIN,ZCEI_MAX,ZCOEF_AMPL_SAT, &
& PTHM,ZRM, &
& PRUS,PRVS,PRWS,PRTHS,ZRRS,ZRSVS,PRTKES_OUT, &
- & ZHGRAD,PSIGS, &
- & PDRUS_TURB,PDRVS_TURB, &
- & PDRTHLS_TURB,PDRRTS_TURB,ZDRSVS_TURB, &
- & PFLXZTHVMF,ZWTH,ZWRC,ZWSV,PDP,PTP,PTPMF,PTDIFF, &
- & PTDISS,PEDR,YDDDH,YDLDDH,YDMDDH)
+ & PSIGS, &
+ & PFLXZTHVMF,ZWTH,ZWRC,ZWSV,PDP,PTP,PTDIFF,PTDISS,&
+ & YLBUDGET, KBUDGETS=SIZE(YLBUDGET),PEDR=PEDR,PTPMF=PTPMF,&
+ & PDRUS_TURB=PDRUS_TURB,PDRVS_TURB=PDRVS_TURB, &
+ & PDRTHLS_TURB=PDRTHLS_TURB,PDRRTS_TURB=PDRRTS_TURB,PDRSVS_TURB=ZDRSVS_TURB)
!
!
!------------------------------------------------------------------------------
diff --git a/src/arome/gmkpack_ignored_files b/src/arome/gmkpack_ignored_files
index f4443eaf9130797e1e582adcae398ecca54b5a0b..44cbe8f4057eaef9834c0d43c528aacc49a4eed3 100644
--- a/src/arome/gmkpack_ignored_files
+++ b/src/arome/gmkpack_ignored_files
@@ -129,3 +129,70 @@ phyex/turb/modi_compute_updraft_rhcj10.F90
phyex/turb/compute_updraft_rhcj10.F90
phyex/turb/modi_compute_updraft.F90
phyex/turb/compute_updraft.F90
+>>>>>>> 9df244f
+phyex/turb/tke_eps_sources.F90
+phyex/turb/turb_ver.F90
+phyex/turb/prandtl.F90
+phyex/turb/turb_ver_thermo_flux.F90
+phyex/turb/turb_ver_thermo_corr.F90
+phyex/turb/turb_ver_dyn_flux.F90
+phyex/turb/turb_ver_sv_flux.F90
+phyex/turb/turb_ver_sv_corr.F90
+phyex/turb/tm06.F90
+phyex/turb/tm06_h.F90
+phyex/turb/tridiag.F90
+phyex/turb/tridiag_wind.F90
+phyex/turb/tridiag_thermo.F90
+phyex/turb/tridiag_tke.F90
+phyex/turb/tridiag_massflux.F90
+phyex/turb/bl89.F90
+phyex/turb/etheta.F90
+phyex/turb/emoist.F90
+phyex/turb/rmc01.F90
+phyex/turb/sbl_depth.F90
+phyex/turb/th_r_from_thl_rt_1d.F90
+phyex/turb/th_r_from_thl_rt_2d.F90
+phyex/turb/th_r_from_thl_rt_3d.F90
+phyex/turb/thl_rt_from_th_r_mf.F90
+phyex/turb/bl_depth_diag_3d.F90
+phyex/turb/bl_depth_diag_1d.F90
+phyex/turb/modi_compute_function_thermo_mf.F90
+phyex/turb/compute_function_thermo_mf.F90
+phyex/micro/modd_cst.F90
+phyex/micro/modi_ini_cst.F90
+phyex/micro/ini_cst.F90
+phyex/turb/modd_cmfshall.F90
+phyex/turb/mf_turb_expl.F90
+phyex/turb/modi_mf_turb_expl.F90
+phyex/turb/mf_turb.F90
+phyex/turb/modi_mf_turb.F90
+phyex/turb/compute_mf_cloud.F90
+phyex/turb/compute_mf_cloud_bigaus.F90
+phyex/turb/compute_mf_cloud_direct.F90
+phyex/turb/compute_mf_cloud_stat.F90
+phyex/turb/modi_compute_mf_cloud.F90
+phyex/turb/modi_compute_mf_cloud_bigaus.F90
+phyex/turb/modi_compute_mf_cloud_direct.F90
+phyex/turb/modi_compute_mf_cloud_stat.F90
+phyex/turb/compute_bl89_ml.F90
+phyex/turb/modi_compute_bl89_ml.F90
+phyex/turb/compute_entr_detr.F90
+phyex/turb/modi_compute_entr_detr.F90
+phyex/turb/compute_updraft_raha.F90
+phyex/turb/modi_compute_updraft_raha.F90
+phyex/turb/modi_compute_updraft_rhcj10.F90
+phyex/turb/compute_updraft_rhcj10.F90
+phyex/turb/modi_compute_updraft.F90
+phyex/turb/compute_updraft.F90
+phyex/micro/modd_conf.F90
+phyex/micro/modd_dyn.F90
+phyex/micro/modd_les.F90
+phyex/micro/modd_lunit.F90
+phyex/micro/modd_parameters.F90
+phyex/micro/modd_nsv.F90
+phyex/micro/modd_refaro.F90
+phyex/micro/mode_fmbidon.F90
+phyex/micro/mode_fmwritbidon.F90
+phyex/turb/modd_dynn.F90
+phyex/turb/mode_thermo_mono.F90
+phyex/turb/modn_turb.F90
diff --git a/src/arome/micro/ini_lima_cold_mixed.F90 b/src/arome/micro/ini_lima_cold_mixed.F90
index 79d0d993b046665c30eac5c64644429fe2e6921c..2e2aae3d855df8726776a5a67f78e978b74b517d 100644
--- a/src/arome/micro/ini_lima_cold_mixed.F90
+++ b/src/arome/micro/ini_lima_cold_mixed.F90
@@ -40,7 +40,6 @@ END MODULE MODI_INI_LIMA_COLD_MIXED
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FM
USE MODD_CST
USE MODD_REF
USE MODD_PARAM_LIMA
diff --git a/src/arome/micro/ini_rain_ice.F90 b/src/arome/micro/ini_rain_ice.F90
index 021d23402c54e92b8476af3e345d799157945ec1..50d2db14c48bf5a24ae760d378396997d32a4158 100644
--- a/src/arome/micro/ini_rain_ice.F90
+++ b/src/arome/micro/ini_rain_ice.F90
@@ -1,7 +1,10 @@
+!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.
+!-----------------------------------------------------------------
! ######spl
SUBROUTINE INI_RAIN_ICE ( KLUOUT, PTSTEP, PDZMIN, KSPLITR, HCLOUD )
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ###########################################################
!
!!**** *INI_RAIN_ICE * - initialize the constants necessary for the warm and
@@ -24,7 +27,7 @@
!! sedimentation is fulfilled for a Raindrop maximal fall velocity equal
!! VTRMAX. The parameters defining the collection kernels are read and are
!! checked against the new ones. If any change occurs, these kernels are
-!! recomputed and their numerical values are written in the output listiing.
+!! recomputed and their numerical values are written in the output listing.
!!
!! EXTERNAL
!! --------
@@ -74,13 +77,14 @@
!! 24/03/01 Update XCRIAUTI for cirrus cases
!! J.-P. Pinty 24/11/01 Update ICE3/ICE4 options
!! S. Riette 2016-11: new ICE3/ICE4 options
-!!
+!! P. Wautelet 22/01/2019 bug correction: incorrect write
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FM
USE MODD_CST
USE MODD_LUNIT
USE MODD_PARAMETERS
@@ -101,6 +105,9 @@ USE MODE_READ_XKER_SWETH, ONLY: READ_XKER_SWETH
USE MODE_READ_XKER_GWETH, ONLY: READ_XKER_GWETH
USE MODE_READ_XKER_RWETH, ONLY: READ_XKER_RWETH
!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -169,6 +176,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('INI_RAIN_ICE',0,ZHOOK_HANDLE)
!
+IF (LHOOK) CALL DR_HOOK('INI_RAIN_ICE',0,ZHOOK_HANDLE)
!
!* 0. FUNCTION STATEMENTS
! -------------------
diff --git a/src/arome/micro/lima_adjust.F90 b/src/arome/micro/lima_adjust.F90
index 195cc8b1e7acb9caee488be28cfee2e8324cb70a..5a890472e708a910d6d0f2d8c8653b4ad4929cbc 100644
--- a/src/arome/micro/lima_adjust.F90
+++ b/src/arome/micro/lima_adjust.F90
@@ -160,8 +160,6 @@ USE YOMMDDH, ONLY : TMDDH
USE MODI_BUDGET_DDH
USE MODI_LIMA_FUNCTIONS
!
-USE MODE_FM
-USE MODE_FMWRIT
!
IMPLICIT NONE
!
diff --git a/src/arome/micro/lima_warm.F90 b/src/arome/micro/lima_warm.F90
index 1a74e7b2ef6d0b044332adc5c93d7e8ed447f440..7778d173fce30e3def032344b8a7099fa2b3886b 100644
--- a/src/arome/micro/lima_warm.F90
+++ b/src/arome/micro/lima_warm.F90
@@ -148,9 +148,6 @@ USE MODD_NSV
USE MODD_BUDGET
USE MODI_BUDGET_DDH
!
-USE MODE_FM
-USE MODE_FMWRIT
-!
USE MODI_LIMA_WARM_SEDIMENTATION
USE MODI_LIMA_WARM_NUCL
USE MODI_LIMA_WARM_COAL
diff --git a/src/arome/micro/modd_cst.F90 b/src/arome/micro/modd_cst.F90
new file mode 100644
index 0000000000000000000000000000000000000000..86361573695350b804440998b3b87df7b7b671bf
--- /dev/null
+++ b/src/arome/micro/modd_cst.F90
@@ -0,0 +1,101 @@
+! ######spl
+ MODULE MODD_CST
+! ###############
+!
+!!**** *MODD_CST* - declaration of Physic constants
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to declare the
+! Physics constants.
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (MODD_CST)
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 16/05/94
+!! J. Stein 02/01/95 add xrholw
+!! J.-P. Pinty 13/12/95 add XALPI,XBETAI,XGAMI
+!! J. Stein 25/07/97 add XTH00
+!! V. Masson 05/10/98 add XRHOLI
+!! C. Mari 31/10/00 add NDAYSEC
+!! V. Masson 01/03/03 add conductivity of ice
+!! R. El Khatib 04/08/14 add pre-computed quantities
+!! J.L. Redelsperger 03/2021 add constants for ocean penetrating solar
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+REAL,SAVE :: XPI ! Pi
+!
+REAL,SAVE :: XDAY,XSIYEA,XSIDAY ! day duration, sideral year duration,
+ ! sideral day duration
+!
+REAL,SAVE :: XKARMAN ! von karman constant
+REAL,SAVE :: XLIGHTSPEED ! light speed
+REAL,SAVE :: XPLANCK ! Planck constant
+REAL,SAVE :: XBOLTZ ! Boltzman constant
+REAL,SAVE :: XAVOGADRO ! Avogadro number
+!
+REAL,SAVE :: XRADIUS,XOMEGA ! Earth radius, earth rotation
+REAL,SAVE :: XG ! Gravity constant
+!
+REAL,SAVE :: XP00 ! Reference pressure
+REAL,SAVE :: XP00OCEAN ! Reference pressure for ocean model
+REAL,SAVE :: XRH00OCEAN ! Reference density for ocean model
+!
+REAL,SAVE :: XSTEFAN,XI0 ! Stefan-Boltzman constant, solar constant
+!
+REAL,SAVE :: XMD,XMV ! Molar mass of dry air and molar mass of vapor
+REAL,SAVE :: XRD,XRV ! Gaz constant for dry air, gaz constant for vapor
+REAL,SAVE :: XEPSILO ! XMV/XMD
+REAL,SAVE :: XCPD,XCPV ! Cpd (dry air), Cpv (vapor)
+REAL,SAVE :: XRHOLW ! Volumic mass of liquid water
+REAL,SAVE :: XCL,XCI ! Cl (liquid), Ci (ice)
+REAL,SAVE :: XTT ! Triple point temperature
+REAL,SAVE :: XLVTT ! Vaporization heat constant
+REAL,SAVE :: XLSTT ! Sublimation heat constant
+REAL,SAVE :: XLMTT ! Melting heat constant
+REAL,SAVE :: XESTT ! Saturation vapor pressure at triple point
+ ! temperature
+REAL,SAVE :: XALPW,XBETAW,XGAMW ! Constants for saturation vapor
+ ! pressure function
+REAL,SAVE :: XALPI,XBETAI,XGAMI ! Constants for saturation vapor
+ ! pressure function over solid ice
+REAL,SAVE :: XCONDI ! thermal conductivity of ice (W m-1 K-1)
+REAL,SAVE :: XALPHAOC ! thermal expansion coefficient for ocean (K-1)
+REAL,SAVE :: XBETAOC ! Haline contraction coeff for ocean (S-1)
+REAL,SAVE :: XTH00 ! reference value for the potential temperature
+REAL,SAVE :: XTH00OCEAN ! Ref value for pot temp in ocean model
+REAL,SAVE :: XSA00OCEAN ! Ref value for SAlinity in ocean model
+REAL,SAVE :: XROC=0.69! 3 coeffs for SW penetration in Ocean (Hoecker et al)
+REAL,SAVE :: XD1=1.1
+REAL,SAVE :: XD2=23.
+! Values used in SURFEX CMO
+!REAL,SAVE :: XROC=0.58
+!REAL,SAVE :: XD1=0.35
+!REAL,SAVE :: XD2=23.
+
+REAL,SAVE :: XRHOLI ! Volumic mass of liquid water
+!
+INTEGER, SAVE :: NDAYSEC ! Number of seconds in a day
+!
+REAL,SAVE :: RDSRV ! XRD/XRV
+REAL,SAVE :: RDSCPD ! XRD/XCPD
+REAL,SAVE :: RINVXP00 ! 1./XP00
+!
+REAL,SAVE :: XMNH_EPSILON ! minimum space with 1.0
+END MODULE MODD_CST
diff --git a/src/arome/dead_code/mode_qsatmx_tab.F90 b/src/arome/micro/mode_qsatmx_tab.F90
similarity index 100%
rename from src/arome/dead_code/mode_qsatmx_tab.F90
rename to src/arome/micro/mode_qsatmx_tab.F90
diff --git a/src/arome/turb/bl_depth_diag_1d.F90 b/src/arome/turb/bl_depth_diag_1d.F90
deleted file mode 100644
index c477ca8ef4893d2c19ab0f4d68b580b95de1a775..0000000000000000000000000000000000000000
--- a/src/arome/turb/bl_depth_diag_1d.F90
+++ /dev/null
@@ -1,38 +0,0 @@
-! ######spl
-FUNCTION BL_DEPTH_DIAG_1D(KKB,KKE,PSURF,PZS,PFLUX,PZZ,PFTOP_O_FSURF)
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-!
-USE MODI_BL_DEPTH_DIAG_3D
-IMPLICIT NONE
-!
-INTEGER, INTENT(IN) :: KKB ! bottom point
-INTEGER, INTENT(IN) :: KKE ! top point
-REAL, INTENT(IN) :: PSURF ! surface flux
-REAL, INTENT(IN) :: PZS ! orography
-REAL, DIMENSION(:), INTENT(IN) :: PFLUX ! flux
-REAL, DIMENSION(:), INTENT(IN) :: PZZ ! altitude of flux points
-REAL, INTENT(IN) :: PFTOP_O_FSURF! Flux at BL top / Surface flux
-REAL :: BL_DEPTH_DIAG_1D
-!
-REAL, DIMENSION(1,1) :: ZSURF
-REAL, DIMENSION(1,1) :: ZZS
-REAL, DIMENSION(1,1,SIZE(PFLUX)) :: ZFLUX
-REAL, DIMENSION(1,1,SIZE(PZZ)) :: ZZZ
-REAL, DIMENSION(1,1) :: ZBL_DEPTH_DIAG
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK('BL_DEPTH_DIAG_1D',0,ZHOOK_HANDLE)
-ZSURF = PSURF
-ZZS = PZS
-ZFLUX(1,1,:) = PFLUX(:)
-ZZZ (1,1,:) = PZZ (:)
-!
-ZBL_DEPTH_DIAG = BL_DEPTH_DIAG_3D(KKB,KKE,ZSURF,ZZS,ZFLUX,ZZZ,PFTOP_O_FSURF)
-!
-BL_DEPTH_DIAG_1D = ZBL_DEPTH_DIAG(1,1)
-!
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('BL_DEPTH_DIAG_1D',1,ZHOOK_HANDLE)
-END FUNCTION BL_DEPTH_DIAG_1D
diff --git a/src/arome/turb/ini_cturb.F90 b/src/arome/turb/ini_cturb.F90
index 06bbc545492660b517fea9f828a6abd13ee66937..1847d0fdaa16277c181230c08f4b43093856b0a7 100644
--- a/src/arome/turb/ini_cturb.F90
+++ b/src/arome/turb/ini_cturb.F90
@@ -1,7 +1,5 @@
! ######spl
SUBROUTINE INI_CTURB
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ####################
!
!!**** *INI_CTURB* - routine to initialize the turbulence scheme
@@ -40,6 +38,8 @@
!! P.Jabouille 20/10/99 XCET=0.4
!! V.Masson 13/11/02 XALPSBL and XASBL
!! 05/06 Remove KEPS
+!! Q.Rodier 01/19
+!! Remove XASBL (not used)
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -48,8 +48,15 @@
USE MODD_CST
USE MODD_CTURB
!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
IMPLICIT NONE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('INI_CTURB',0,ZHOOK_HANDLE)
+!
! ---------------------------------------------------------------------------
!
! 1. SETTING THE NUMERICAL VALUES
@@ -57,8 +64,6 @@ IMPLICIT NONE
!
! 1.1 Constant for dissipation of Tke
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK('INI_CTURB',0,ZHOOK_HANDLE)
!
LHARAT=.FALSE.
!
@@ -67,6 +72,7 @@ XCED = 0.85
! Redelsperger-Sommeria (1981) = 0.70
! Schmidt-Schumann (1989) = 0.845
! Cheng-Canuto-Howard (2002) = 0.845
+! Rodier, Masson, Couvreux, Paci (2017) = 0.34
!
!
! 1.2 Constant for wind pressure-correlations
@@ -191,14 +197,6 @@ XCPR3= XCPR2 ! used only for the Schmidt number for scalar variables
XCPR4= XCPR2
XCPR5= XCPR2
!
-! 2.4 Value related to the TKE universal function within SBL
-!
-!
-XASBL = 0.5*( XALPSBL**(3./2.)*XKARMAN*XCED + XKARMAN/SQRT(XALPSBL)/XCMFS )
-! Redelsperger et al 2001
-!
-!
-!
! 3. MINIMUM VALUES
! --------------
!
diff --git a/src/arome/turb/modd_diag_in_run.F90 b/src/arome/turb/modd_diag_in_run.F90
index 48aa658f406545abf0fc72758a235ba5db5f9f16..ca9ce53a698a3a458f5ac777353e5d23518faa78 100644
--- a/src/arome/turb/modd_diag_in_run.F90
+++ b/src/arome/turb/modd_diag_in_run.F90
@@ -1,20 +1,30 @@
-! ######spl
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
MODULE MODD_DIAG_IN_RUN
+! Modifications
+!! 02/2018 Q.Libois ECRAD
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
!
!* stores instantaneous diagnostic arrays for the current time-step
!
IMPLICIT NONE
-SAVE
-
LOGICAL :: LDIAG_IN_RUN=.FALSE. ! flag for diagnostics
!
REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_RN ! net radiation
REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_H ! sensible heat flux
-REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_LE ! latent heat flux
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_LE ! Total latent heat flux
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_LEI ! Solid latent heat flux
REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_GFLUX ! ground flux
-REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_LW ! incoming longwave at the surface
-REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_SW ! incoming Shortwave at the surface
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_LWD ! incoming longwave at the surface
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_LWU ! outcoming longwave at the surface
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_SWD ! incoming Shortwave at the surface
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_SWU ! outcoming Shortwave at the surface
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_SWDIR ! incoming Shortwave direct at the surface
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_SWDIFF! incoming Shortwave diffuse at the surface
REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_T2M ! temperature at 2m
REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_Q2M ! humidity at 2m
REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_HU2M ! relative humidity at 2m
@@ -23,4 +33,6 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_MER10M! meridian wind at 10m
REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_DSTAOD! dust aerosol optical depth
REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_SFCO2 ! CO2 Surface flux
REAL, DIMENSION(:,:,:), ALLOCATABLE :: XCURRENT_TKE_DISS ! Tke dissipation rate
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_SLTAOD ! Salt aerosol optical depth
+REAL, DIMENSION(:,:), ALLOCATABLE :: XCURRENT_ZWS ! Significant height of waves
END MODULE MODD_DIAG_IN_RUN
diff --git a/src/arome/turb/modd_turbn.F90 b/src/arome/turb/modd_turbn.F90
deleted file mode 100644
index 3d11a7b591941538033c61d4e9fa3e1f71b1d8d1..0000000000000000000000000000000000000000
--- a/src/arome/turb/modd_turbn.F90
+++ /dev/null
@@ -1,3 +0,0 @@
-MODULE MODD_TURB_n
- CHARACTER (LEN=4), SAVE :: CTURBLEN='BL89'
-ENDMODULE MODD_TURB_n
diff --git a/src/arome/turb/modi_bl89.F90 b/src/arome/turb/modi_bl89.F90
deleted file mode 100644
index e451772994675a8640f6cce983666f77da09a8aa..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_bl89.F90
+++ /dev/null
@@ -1,22 +0,0 @@
-! ######spl
- MODULE MODI_BL89
-! ################
-INTERFACE
- SUBROUTINE BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,PTHLM,KRR,PRM,PTKEM,PSHEAR,PLM)
-!
-INTEGER, INTENT(IN) :: KKA
-INTEGER, INTENT(IN) :: KKU
-INTEGER, INTENT(IN) :: KKL
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
-INTEGER, INTENT(IN) :: KRR
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSHEAR
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLM
-
-END SUBROUTINE BL89
-END INTERFACE
-END MODULE MODI_BL89
diff --git a/src/arome/turb/modi_bl_depth_diag.F90 b/src/arome/turb/modi_bl_depth_diag.F90
deleted file mode 100644
index 778761f9c327fd3efa4447d3c465558cabcf8436..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_bl_depth_diag.F90
+++ /dev/null
@@ -1,36 +0,0 @@
-! ######spl
- MODULE MODI_BL_DEPTH_DIAG
-! ################
-!
-INTERFACE BL_DEPTH_DIAG
-!
-!
- FUNCTION BL_DEPTH_DIAG_3D(KKB,KKE,PSURF,PZS,PFLUX,PZZ,PFTOP_O_FSURF)
-
-INTEGER, INTENT(IN) :: KKB ! bottom point
-INTEGER, INTENT(IN) :: KKE ! top point
-REAL, DIMENSION(:,:), INTENT(IN) :: PSURF ! surface flux
-REAL, DIMENSION(:,:), INTENT(IN) :: PZS ! orography
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLUX ! flux
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux points
-REAL, INTENT(IN) :: PFTOP_O_FSURF! Flux at BL top / Surface flux
-REAL, DIMENSION(SIZE(PSURF,1),SIZE(PSURF,2)) :: BL_DEPTH_DIAG_3D
-!
-END FUNCTION BL_DEPTH_DIAG_3D
-!
-!
- FUNCTION BL_DEPTH_DIAG_1D(KKB,KKE,PSURF,PZS,PFLUX,PZZ,PFTOP_O_FSURF)
-INTEGER, INTENT(IN) :: KKB ! bottom point
-INTEGER, INTENT(IN) :: KKE ! top point
-REAL, INTENT(IN) :: PSURF ! surface flux
-REAL, INTENT(IN) :: PZS ! orography
-REAL, DIMENSION(:), INTENT(IN) :: PFLUX ! flux
-REAL, DIMENSION(:), INTENT(IN) :: PZZ ! altitude of flux points
-REAL, INTENT(IN) :: PFTOP_O_FSURF! Flux at BL top / Surface flux
-REAL :: BL_DEPTH_DIAG_1D
-!
-END FUNCTION BL_DEPTH_DIAG_1D
-!
-END INTERFACE
-!
-END MODULE MODI_BL_DEPTH_DIAG
diff --git a/src/arome/turb/modi_bl_depth_diag_3d.F90 b/src/arome/turb/modi_bl_depth_diag_3d.F90
deleted file mode 100644
index d2ea0c80dc34a1a8386177160e2374a1f02670c9..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_bl_depth_diag_3d.F90
+++ /dev/null
@@ -1,24 +0,0 @@
-! ######spl
- MODULE MODI_BL_DEPTH_DIAG_3D
-! ################
-!
-!
-INTERFACE
-!
-!
- FUNCTION BL_DEPTH_DIAG_3D(KKB,KKE,PSURF,PZS,PFLUX,PZZ,PFTOP_O_FSURF)
-INTEGER, INTENT(IN) :: KKB ! bottom point
-INTEGER, INTENT(IN) :: KKE ! top point
-REAL, DIMENSION(:,:), INTENT(IN) :: PSURF ! surface flux
-REAL, DIMENSION(:,:), INTENT(IN) :: PZS ! orography
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLUX ! flux
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux points
-REAL, INTENT(IN) :: PFTOP_O_FSURF! Flux at BL top / Surface flux
-REAL, DIMENSION(SIZE(PSURF,1),SIZE(PSURF,2)) :: BL_DEPTH_DIAG_3D
-!
-END FUNCTION BL_DEPTH_DIAG_3D
-!
-!
-END INTERFACE
-!
-END MODULE MODI_BL_DEPTH_DIAG_3D
diff --git a/src/arome/turb/modi_compute_function_thermo_mf.F90 b/src/arome/turb/modi_compute_function_thermo_mf.F90
deleted file mode 100644
index 7f68ce56fce49953f795cb474da461a774978b96..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_compute_function_thermo_mf.F90
+++ /dev/null
@@ -1,33 +0,0 @@
-! ######spl
- MODULE MODI_COMPUTE_FUNCTION_THERMO_MF
-! ######################################
-!
-INTERFACE
-
-! #################################################################
- SUBROUTINE COMPUTE_FUNCTION_THERMO_MF( KRR,KRRL,KRRI, &
- PTH, PR, PEXN, PFRAC_ICE, PPABS, &
- PT, PAMOIST,PATHETA )
-! #################################################################
-
-!* 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.
-
-REAL, DIMENSION(:,:), INTENT(IN) :: PTH ! theta
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PR ! water species
-REAL, DIMENSION(:,:) , INTENT(IN) :: PPABS,PEXN ! pressure, Exner funct.
-REAL, DIMENSION(:,:) , INTENT(IN) :: PFRAC_ICE ! ice fraction
-
-REAL, DIMENSION(:,:), INTENT(OUT) :: PT ! temperature
-
-REAL, DIMENSION(:,:), INTENT(OUT) :: PAMOIST,PATHETA
-!
-END SUBROUTINE COMPUTE_FUNCTION_THERMO_MF
-
-END INTERFACE
-!
-END MODULE MODI_COMPUTE_FUNCTION_THERMO_MF
diff --git a/src/arome/turb/modi_emoist.F90 b/src/arome/turb/modi_emoist.F90
deleted file mode 100644
index 57e762b71b4672fa94ececaa77b7ee7e028333ed..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_emoist.F90
+++ /dev/null
@@ -1,26 +0,0 @@
-! ######spl
-MODULE MODI_EMOIST
-!#################
-!
-INTERFACE
-!
-FUNCTION EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM) RESULT(PEMOIST)
-!
-INTEGER :: KRR ! number of moist var.
-INTEGER :: KRRI ! number of ice var.
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM ! Conservative pot. temperature
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios, where
-! PRM(:,:,:,1) = conservative mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! Amoist
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! Normalized 2dn_order
- ! moment s'r'c/2Sigma_s2
-!
-REAL,DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)):: PEMOIST ! result
-!
-END FUNCTION EMOIST
-!
-END INTERFACE
-!
-END MODULE MODI_EMOIST
diff --git a/src/arome/turb/modi_etheta.F90 b/src/arome/turb/modi_etheta.F90
deleted file mode 100644
index bc08b8a8944008eb082617954334cd06d697c10e..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_etheta.F90
+++ /dev/null
@@ -1,28 +0,0 @@
-! ######spl
-MODULE MODI_ETHETA
-!#################
-!
-INTERFACE
-!
-FUNCTION ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM) RESULT(PETHETA)
-!
-INTEGER :: KRR ! number of moist var.
-INTEGER :: KRRI ! number of ice var.
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM ! Conservative pot. temperature
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios, where
-! PRM(:,:,:,1) = conservative mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! Atheta
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! Normalized 2dn_order
- ! moment s'r'c/2Sigma_s2
-!
-REAL,DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)):: PETHETA ! result
-!
-!
-END FUNCTION ETHETA
-!
-END INTERFACE
-!
-END MODULE MODI_ETHETA
diff --git a/src/arome/turb/modi_prandtl.F90 b/src/arome/turb/modi_prandtl.F90
deleted file mode 100644
index 74fb802bfb827554494503afc12486fc191ca5d3..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_prandtl.F90
+++ /dev/null
@@ -1,72 +0,0 @@
-! ######spl
- MODULE MODI_PRANDTL
-! ###################
-!
-INTERFACE
-!
- SUBROUTINE PRANDTL(KKA,KKU,KKL,KRR,KRRI,OCLOSE_OUT,OTURB_DIAG,&
- HTURBDIM, &
- HFMFILE,HLUOUT, &
- PDXX,PDYY,PDZZ,PDZX,PDZY, &
- PTHVREF,PLOCPEXNM,PATHETA,PAMOIST, &
- PLM,PLEPS,PTKEM,PTHLM,PRM,PSVM,PSRCM, &
- PREDTH1,PREDR1, &
- PRED2TH3, PRED2R3, PRED2THR3, &
- PREDS1,PRED2THS3, PRED2RS3, &
- PBLL_O_E, &
- PETHETA, PEMOIST )
-!
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-INTEGER, INTENT(IN) :: KRRI ! number of ice var.
-!
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
-LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
- ! diagnostic fields in the syncronous FM-file
-CHARACTER*4 , INTENT(IN) :: HTURBDIM ! Kind of turbulence param.
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output
- ! FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
- ! metric coefficients
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential Temp.
- ! of the reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turbulent Mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! Dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM,PTKEM! Conservative Potential
- ! Temperature and TKE at t-1
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios at t-1
- ! with PRM(:,:,:,1) = cons.
- ! mixing ratio
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Scalars at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM
- ! s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PREDTH1 ! Redelsperger number R_theta
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PREDR1 ! Redelsperger number R_q
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2TH3 ! Redelsperger number R*2_theta
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2R3 ! Redelsperger number R*2_q
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2THR3! Redelsperger number R*2_thq
-REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PREDS1 ! Redelsperger number R_sv
-REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PRED2THS3! Redelsperger number R*2_thsv
-REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PRED2RS3 ! Redelsperger number R*2_qsv
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBLL_O_E! beta*Lk*Leps/tke
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PETHETA ! coefficient E_theta
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEMOIST ! coefficient E_moist
-!
-END SUBROUTINE PRANDTL
-!
-END INTERFACE
-!
-END MODULE MODI_PRANDTL
diff --git a/src/arome/turb/modi_rmc01.F90 b/src/arome/turb/modi_rmc01.F90
deleted file mode 100644
index 1845c21be2008c32a085aee0d8d689a094163dd2..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_rmc01.F90
+++ /dev/null
@@ -1,24 +0,0 @@
-! ######spl
- MODULE MODI_RMC01
-! ################
-INTERFACE
- SUBROUTINE RMC01(HTURBLEN,KKA,KKU,KKL,PZZ,PDXX,PDYY,PDZZ,PDIRCOSZW, &
- PSBL_DEPTH, PLMO, PLK, PLEPS )
-!
-CHARACTER(LEN=4), INTENT(IN) :: HTURBLEN ! type of mixing length
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux points
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! width of grid mesh (X dir)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! width of grid mesh (Y dir)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! width of vert. layers
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus
-REAL, DIMENSION(:,:), INTENT(IN) :: PSBL_DEPTH! SBL depth
-REAL, DIMENSION(:,:), INTENT(IN) :: PLMO ! Monin Obuhkov length
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLK ! Mixing length
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLEPS ! Dissipative length
-
-END SUBROUTINE RMC01
-END INTERFACE
-END MODULE MODI_RMC01
diff --git a/src/arome/turb/modi_sbl_depth.F90 b/src/arome/turb/modi_sbl_depth.F90
deleted file mode 100644
index 1f9fb94399496182fc754321a72f27ad3c047820..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_sbl_depth.F90
+++ /dev/null
@@ -1,24 +0,0 @@
-! ######spl
- MODULE MODI_SBL_DEPTH
-! ################
-!
-INTERFACE
-!
- SUBROUTINE SBL_DEPTH(KKB,KKE,PZZ,PFLXU,PFLXV,PWTHV,PLMO,PSBL_DEPTH)
-!
-INTEGER, INTENT(IN) :: KKB ! first physical level
-INTEGER, INTENT(IN) :: KKE ! upper physical level
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux levels
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLXU ! u'w'
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLXV ! v'w'
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWTHV ! buoyancy flux
-REAL, DIMENSION(:,:), INTENT(IN) :: PLMO ! Monin-Obukhov length
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSBL_DEPTH! boundary layer height
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE SBL_DEPTH
-!
-END INTERFACE
-!
-END MODULE MODI_SBL_DEPTH
diff --git a/src/arome/turb/modi_th_r_from_thl_rt_1d.F90 b/src/arome/turb/modi_th_r_from_thl_rt_1d.F90
deleted file mode 100644
index 577edb249bc26074fe0e702f3b42755230e6f855..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_th_r_from_thl_rt_1d.F90
+++ /dev/null
@@ -1,24 +0,0 @@
-! ######spl
- MODULE MODI_TH_R_FROM_THL_RT_1D
-! ###############################
-!
- INTERFACE
- SUBROUTINE TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE,PP, &
- PTHL, PRT, PTH, PRV, PRL, PRI, &
- PRSATW, PRSATI, PRR, PRS, PRG, PRH )
-CHARACTER*1 , INTENT(IN) :: HFRAC_ICE
-REAL, DIMENSION(:), INTENT(INOUT) :: PFRAC_ICE
-REAL, DIMENSION(:), INTENT(IN) :: PP ! Pressure
-REAL, DIMENSION(:), INTENT(IN) :: PTHL ! Liquid pot. temp.
-REAL, DIMENSION(:), INTENT(IN) :: PRT ! Total mixing ratios
-REAL, DIMENSION(:),OPTIONAL,INTENT(IN) :: PRR, PRS, PRG, PRH
-REAL, DIMENSION(:), INTENT(OUT):: PTH ! Potential temp.
-REAL, DIMENSION(:), INTENT(OUT):: PRV ! vapor mixing ratio
-REAL, DIMENSION(:), INTENT(INOUT):: PRL ! cloud mixing ratio
-REAL, DIMENSION(:), INTENT(INOUT):: PRI ! ice mixing ratio
-REAL, DIMENSION(:), INTENT(OUT) :: PRSATW ! estimated mixing ration at saturation over water
-REAL, DIMENSION(:), INTENT(OUT) :: PRSATI ! estimated mixing ration at saturation over ice
-
- END SUBROUTINE TH_R_FROM_THL_RT_1D
- END INTERFACE
- END MODULE MODI_TH_R_FROM_THL_RT_1D
diff --git a/src/arome/turb/modi_th_r_from_thl_rt_2d.F90 b/src/arome/turb/modi_th_r_from_thl_rt_2d.F90
deleted file mode 100644
index a3af56f230d40c878f0107fccf848bf0e0767939..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_th_r_from_thl_rt_2d.F90
+++ /dev/null
@@ -1,24 +0,0 @@
-! ######spl
- MODULE MODI_TH_R_FROM_THL_RT_2D
- INTERFACE
- SUBROUTINE TH_R_FROM_THL_RT_2D(HFRAC_ICE,PFRAC_ICE,PP, &
- PTHL, PRT, PTH, PRV, PRL, PRI, &
- PRSATW, PRSATI, PRR, PRS, PRG, PRH )
-CHARACTER*1 , INTENT(IN) :: HFRAC_ICE
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PFRAC_ICE
-REAL, DIMENSION(:,:), INTENT(IN) :: PP ! Pressure
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHL ! thetal to transform into th
-REAL, DIMENSION(:,:),INTENT(IN) :: PRT ! Total mixing ratios to transform into rv,rc and ri
-REAL, DIMENSION(:),OPTIONAL,INTENT(IN) :: PRR, PRS, PRG, PRH
-REAL, DIMENSION(:,:), INTENT(OUT):: PTH ! th
-REAL, DIMENSION(:,:), INTENT(OUT):: PRV ! vapor mixing ratio
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRL ! vapor mixing ratio
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRI ! vapor mixing ratio
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRSATW ! estimated mixing ration at saturation over water
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRSATI ! estimated mixing ration at saturation over ice
-
- END SUBROUTINE TH_R_FROM_THL_RT_2D
-
- END INTERFACE
-
- END MODULE MODI_TH_R_FROM_THL_RT_2D
diff --git a/src/arome/turb/modi_th_r_from_thl_rt_3d.F90 b/src/arome/turb/modi_th_r_from_thl_rt_3d.F90
deleted file mode 100644
index 5b52a056f4b7b7b6889c6f0c893843bbb65cc2d7..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_th_r_from_thl_rt_3d.F90
+++ /dev/null
@@ -1,27 +0,0 @@
-! ######spl
- MODULE MODI_TH_R_FROM_THL_RT_3D
-! ###############################
-INTERFACE
-!
- SUBROUTINE TH_R_FROM_THL_RT_3D(HFRAC_ICE,PFRAC_ICE,PP, &
- PTHL, PRT, PTH, PRV, PRL, PRI, &
- PRSATW, PRSATI, PRR, PRS, PRG, PRH )
-
-CHARACTER*1 , INTENT(IN) :: HFRAC_ICE
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFRAC_ICE
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PP ! Pressure
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHL ! thetal to transform into th
-REAL, DIMENSION(:,:,:),INTENT(IN) :: PRT ! Total mixing ratios to transform into rv,rc and ri
-REAL, DIMENSION(:,:,:),OPTIONAL,INTENT(IN) :: PRR, PRS, PRG, PRH
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PTH ! th
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PRV ! vapor mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRL ! vapor mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRI ! vapor mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRSATW ! estimated mixing ration at saturation over water
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRSATI ! estimated mixing ration at saturation over ice
-!
-END SUBROUTINE TH_R_FROM_THL_RT_3D
-!
-END INTERFACE
-!
-END MODULE MODI_TH_R_FROM_THL_RT_3D
diff --git a/src/arome/turb/modi_thl_rt_from_th_r_mf.F90 b/src/arome/turb/modi_thl_rt_from_th_r_mf.F90
deleted file mode 100644
index ed1dd9c6bdde9ebd379a8dbac1f5ed49281a884e..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_thl_rt_from_th_r_mf.F90
+++ /dev/null
@@ -1,31 +0,0 @@
-! ######spl
- MODULE MODI_THL_RT_FROM_TH_R_MF
-! ###############################
-!
-INTERFACE
-! #################################################################
- SUBROUTINE THL_RT_FROM_TH_R_MF( KRR,KRRL,KRRI, &
- PTH, PR, PEXN, &
- PTHL, PRT )
-! #################################################################
-!
-!
-!* 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.
-
-REAL, DIMENSION(:,:), INTENT(IN) :: PTH ! theta
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PR ! water species
-REAL, DIMENSION(:,:), INTENT(IN) :: PEXN ! exner function
-
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL ! th_l
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRT ! total non precip. water
-!
-END SUBROUTINE THL_RT_FROM_TH_R_MF
-
-END INTERFACE
-!
-END MODULE MODI_THL_RT_FROM_TH_R_MF
diff --git a/src/arome/turb/modi_tke_eps_sources.F90 b/src/arome/turb/modi_tke_eps_sources.F90
deleted file mode 100644
index 6df0247c32c30a5916e5d60446bbf8fd2b8e4b76..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_tke_eps_sources.F90
+++ /dev/null
@@ -1,63 +0,0 @@
-! ######spl
- MODULE MODI_TKE_EPS_SOURCES
-! ###########################
-INTERFACE
-!
- SUBROUTINE TKE_EPS_SOURCES(KKA,KKU,KKL,KMI,PTKEM,PLM,PLEPS,PDP,PTRH, &
- & PRHODJ,PDZZ,PDXX,PDYY,PDZX,PDZY,PZZ, &
- & PTSTEP,PIMPL,PEXPL, &
- & HTURBLEN,HTURBDIM, &
- & HFMFILE,HLUOUT,OCLOSE_OUT,OTURB_DIAG, &
- & PTP,PRTKES,PRTHLS,PCOEF_DISS,PTDIFF, &
- & PTDISS,PEDR,YDDDH, YDLDDH, YDMDDH)
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-INTEGER :: KMI ! model index number
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at t-deltat
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
- ! metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! physical height w-pt
-REAL, INTENT(IN) :: PTSTEP ! Double Time step ( *.5 for
- ! the first time step )
-REAL, INTENT(IN) :: PEXPL, PIMPL ! Coef. temporal. disc.
-CHARACTER*4, INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-CHARACTER*4, INTENT(IN) :: HTURBLEN ! kind of mixing length
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output
- ! FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
-LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
- ! diagnostic fields in the syncronous FM-file
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PDP, PTRH ! Dyn. prod. of TKE
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PTP ! Ther. prod. of TKE
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRTKES ! RHOD * Jacobian *
- ! TKE at t+deltat
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRTHLS ! Source of Theta_l
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCOEF_DISS ! 1/(Cph*Exner)
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTDIFF ! Diffusion TKE term
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTDISS ! Dissipation TKE term
-
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEDR ! eddy dissipation rate
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-!
-!
-END SUBROUTINE TKE_EPS_SOURCES
-!
-END INTERFACE
-!
-END MODULE MODI_TKE_EPS_SOURCES
diff --git a/src/arome/turb/modi_tm06.F90 b/src/arome/turb/modi_tm06.F90
deleted file mode 100644
index 5914828c395aa3015357c77808cbda3fcdf54086..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_tm06.F90
+++ /dev/null
@@ -1,25 +0,0 @@
-! ######spl
- MODULE MODI_TM06
-! ################
-!
-INTERFACE
-!
- SUBROUTINE TM06(KKA,KKU,KKL,PTHVREF,PBL_DEPTH,PZZ,PSFTH,PMWTH,PMTH2)
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! reference potential temperature
-REAL, DIMENSION(:,:), INTENT(IN) :: PBL_DEPTH ! boundary layer height
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux levels
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTH ! surface heat flux
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PMWTH ! w'2th'
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PMTH2 ! w'th'2
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE TM06
-!
-END INTERFACE
-!
-END MODULE MODI_TM06
diff --git a/src/arome/turb/modi_tm06_h.F90 b/src/arome/turb/modi_tm06_h.F90
deleted file mode 100644
index c37f96f34073a05b18e3afe6f12245b9d6d4fd70..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_tm06_h.F90
+++ /dev/null
@@ -1,24 +0,0 @@
-! ######spl
- MODULE MODI_TM06_H
-! ################
-!
-INTERFACE
-!
- SUBROUTINE TM06_H(KKB,KKTB,KKTE,PTSTEP,PZZ,PFLXZ,PBL_DEPTH)
-!
-INTEGER, INTENT(IN) :: KKB ! index of 1st physical level
- ! close to ground
-INTEGER, INTENT(IN) :: KKTB ! first physical level in k
-INTEGER, INTENT(IN) :: KKTE ! last physical level in k
-REAL, INTENT(IN) :: PTSTEP ! Double time step
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux levels
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLXZ ! heat flux
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PBL_DEPTH ! boundary layer height
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE TM06_H
-!
-END INTERFACE
-!
-END MODULE MODI_TM06_H
diff --git a/src/arome/turb/modi_tridiag.F90 b/src/arome/turb/modi_tridiag.F90
deleted file mode 100644
index f04637f9f9dd2f8af39fe522c586a081addbc4ed..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_tridiag.F90
+++ /dev/null
@@ -1,25 +0,0 @@
-! ######spl
- MODULE MODI_TRIDIAG
-! ###################
-INTERFACE
-!
- SUBROUTINE TRIDIAG(KKA,KKU,KKL,PVARM,PA,PTSTEP,PEXPL,PIMPL, &
- PRHODJ,PSOURCE,PVARP )
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=AR
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARM ! variable at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! upper diag. elements
-REAL, INTENT(IN) :: PTSTEP ! Double time step
-REAL, INTENT(IN) :: PEXPL,PIMPL ! weights of the temporal scheme
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (dry rho)*J
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSOURCE ! source term of PVAR
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVARP ! variable at t+1
-!
-END SUBROUTINE TRIDIAG
-!
-END INTERFACE
-!
-END MODULE MODI_TRIDIAG
diff --git a/src/arome/turb/modi_tridiag_massflux.F90 b/src/arome/turb/modi_tridiag_massflux.F90
deleted file mode 100644
index 1e6a223e9419519a53a1c768b6825536ace5c4f0..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_tridiag_massflux.F90
+++ /dev/null
@@ -1,28 +0,0 @@
-! ######spl
- MODULE MODI_TRIDIAG_MASSFLUX
-! ###################
-INTERFACE
-!
- SUBROUTINE TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PVARM,PF,PDFDT,PTSTEP,PIMPL, &
- PDZZ,PRHODJ,PVARP )
-!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PVARM ! variable at t-1 at mass point
-REAL, DIMENSION(:,:), INTENT(IN) :: PF ! flux in dT/dt=-dF/dz at flux point
-REAL, DIMENSION(:,:), INTENT(IN) :: PDFDT ! dF/dT at flux point
-REAL, INTENT(IN) :: PTSTEP ! Double time step
-REAL, INTENT(IN) :: PIMPL ! implicit weight
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Dz at flux point
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! (dry rho)*J at mass point
-!
-REAL, DIMENSION(:,:), INTENT(OUT):: PVARP ! variable at t+1 at mass point
-!
-END SUBROUTINE TRIDIAG_MASSFLUX
-!
-END INTERFACE
-!
-END MODULE MODI_TRIDIAG_MASSFLUX
diff --git a/src/arome/turb/modi_tridiag_thermo.F90 b/src/arome/turb/modi_tridiag_thermo.F90
deleted file mode 100644
index e0b5240fb408773f0c03411f0c4ad72290354070..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_tridiag_thermo.F90
+++ /dev/null
@@ -1,26 +0,0 @@
-! ######spl
- MODULE MODI_TRIDIAG_THERMO
-! ###################
-INTERFACE
-!
- SUBROUTINE TRIDIAG_THERMO(KKA,KKU,KKL,PVARM,PF,PDFDDTDZ,PTSTEP,PIMPL, &
- PDZZ,PRHODJ,PVARP )
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=AR
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARM ! variable at t-1 at mass point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PF ! flux in dT/dt=-dF/dz at flux point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDFDDTDZ! dF/d(dT/dz) at flux point
-REAL, INTENT(IN) :: PTSTEP ! Double time step
-REAL, INTENT(IN) :: PIMPL ! implicit weight
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Dz at flux point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (dry rho)*J at mass point
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PVARP ! variable at t+1 at mass point
-!
-END SUBROUTINE TRIDIAG_THERMO
-!
-END INTERFACE
-!
-END MODULE MODI_TRIDIAG_THERMO
diff --git a/src/arome/turb/modi_tridiag_tke.F90 b/src/arome/turb/modi_tridiag_tke.F90
deleted file mode 100644
index 9398d9fb66015625cd42781b46a0ff95df26b0c0..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_tridiag_tke.F90
+++ /dev/null
@@ -1,27 +0,0 @@
-! ######spl
- MODULE MODI_TRIDIAG_TKE
-! ##########################
-INTERFACE
-!
- SUBROUTINE TRIDIAG_TKE(KKA,KKU,KKL,PVARM,PA,PTSTEP,PEXPL,PIMPL, &
- PRHODJ,PSOURCE,PDIAG,PVARP )
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARM ! variable at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! upper diag. elements
-REAL, INTENT(IN) :: PTSTEP ! Double time step
-REAL, INTENT(IN) :: PEXPL,PIMPL ! weights of the temporal scheme
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (dry rho)*J
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSOURCE ! source term of PVAR
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDIAG ! diagonal term linked to
- ! the implicit dissipation
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVARP ! variable at t+1
-!
-END SUBROUTINE TRIDIAG_TKE
-!
-END INTERFACE
-!
-END MODULE MODI_TRIDIAG_TKE
diff --git a/src/arome/turb/modi_tridiag_wind.F90 b/src/arome/turb/modi_tridiag_wind.F90
deleted file mode 100644
index 87fb9c3e874a0606ece3d4aa2f439c3560033afa..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_tridiag_wind.F90
+++ /dev/null
@@ -1,27 +0,0 @@
-! ######spl
- MODULE MODI_TRIDIAG_WIND
-! ########################
-INTERFACE
-!
- SUBROUTINE TRIDIAG_WIND(KKA,KKU,KKL,PVARM,PA,PCOEFS,PTSTEP,PEXPL,PIMPL, &
- PRHODJA,PSOURCE,PVARP )
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=AR
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARM ! variable at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! upper diag. elements
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOEFS ! implicit coeff for the
- ! surface flux
-REAL, INTENT(IN) :: PTSTEP ! Double time step
-REAL, INTENT(IN) :: PEXPL,PIMPL ! weights of the temporal scheme
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJA ! (dry rho)*J averaged
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSOURCE ! source term of PVAR
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVARP ! variable at t+1
-!
-END SUBROUTINE TRIDIAG_WIND
-!
-END INTERFACE
-!
-END MODULE MODI_TRIDIAG_WIND
diff --git a/src/arome/turb/modi_turb_ver.F90 b/src/arome/turb/modi_turb_ver.F90
deleted file mode 100644
index 56dbe815d09ec06450d646e51345a6c120c157e6..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_turb_ver.F90
+++ /dev/null
@@ -1,125 +0,0 @@
-! ######spl
- MODULE MODI_TURB_VER
-! ####################
-!
-INTERFACE
-!
- SUBROUTINE TURB_VER(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- OCLOSE_OUT,OTURB_FLX, &
- HTURBDIM,HTOM,PIMPL,PEXPL, &
- PTSTEP_UVW,PTSTEP_MET, PTSTEP_SV, &
- HFMFILE,HLUOUT, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
- PCOSSLOPE,PSINSLOPE, &
- PRHODJ,PTHVREF, &
- PSFTHM,PSFRM,PSFSVM,PSFTHP,PSFRP,PSFSVP, &
- PCDUEFF,PTAU11M,PTAU12M,PTAU33M, &
- PUM,PVM,PWM,PUSLOPEM,PVSLOPEM,PTHLM,PRM,PSVM, &
- PTKEM,PLM,PLENGTHM,PLENGTHH,PLEPS,MFMOIST, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
- PFWTH,PFWR,PFTH2,PFR2,PFTHR,PBL_DEPTH, &
- PSBL_DEPTH,PLMO, &
- PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS, &
- PDP,PTP,PSIGS,PWTH,PWRC,PWSV )
-
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-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.
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-CHARACTER*4, INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-CHARACTER*4, INTENT(IN) :: HTOM ! type of Third Order Moment
-REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
-REAL, INTENT(IN) :: PTSTEP_UVW ! Dynamical timestep
-REAL, INTENT(IN) :: PTSTEP_MET ! Timestep for meteorological variables
-REAL, INTENT(IN) :: PTSTEP_SV ! Timestep for tracer variables
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output
- ! FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
- ! normal to the ground surface
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitudes at flux points
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
- ! between i and the slope vector
-REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
- ! between i and the slope vector
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: MFMOIST ! moist mass flux dual scheme
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state Virtual
- ! Potential Temperature
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM ! surface fluxes at time
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! t - deltat
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHP,PSFRP ! surface fluxes at time
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVP ! t + deltat
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU11M ! <uu> in the axes linked
- ! to the maximum slope direction and the surface normal and the binormal
- ! at time t - dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU12M ! <uv> in the same axes
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHLM
- ! Wind and potential temperature at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios
- ! at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-Delta t
-REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
- ! maximum slope direction
-REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
- ! direction normal to the maximum slope one
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLENGTHM ! Turb. mixing length momentum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLENGTHH ! Turb. mixing length heat/moisture
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
- ! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFRAC_ICE ! ri fraction of rc+ri
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWTH ! d(w'2th' )/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWR ! d(w'2r' )/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTH2 ! d(w'th'2 )/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFR2 ! d(w'r'2 )/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTHR ! d(w'th'r')/dz
-REAL, DIMENSION(:,:), INTENT(INOUT):: PBL_DEPTH ! BL depth
-REAL, DIMENSION(:,:), INTENT(INOUT):: PSBL_DEPTH ! SBL depth
-REAL, DIMENSION(:,:), INTENT(IN) :: PLMO ! Monin-Obukhov length
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS, PRTHLS
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS,PRRS
- ! cumulated sources for the prognostic variables
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDP,PTP ! Dynamic and thermal
- ! TKE production terms
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS ! Vert. part of Sigma_s at t
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTH ! heat flux
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWRC ! cloud water flux
-REAL, DIMENSION(:,:,:,:),INTENT(OUT) :: PWSV ! scalar flux
-
-!
-!
-END SUBROUTINE TURB_VER
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_VER
diff --git a/src/arome/turb/modi_turb_ver_dyn_flux.F90 b/src/arome/turb/modi_turb_ver_dyn_flux.F90
deleted file mode 100644
index a58d4f8a34cbd0d308c9b370765f370458e33e1c..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_turb_ver_dyn_flux.F90
+++ /dev/null
@@ -1,86 +0,0 @@
-! ######spl
- MODULE MODI_TURB_VER_DYN_FLUX
-! ####################
-!
-INTERFACE
-!
- SUBROUTINE TURB_VER_DYN_FLUX(KKA,KKU,KKL, &
- OCLOSE_OUT,OTURB_FLX,KRR, &
- HTURBDIM,PIMPL,PEXPL, &
- PTSTEP, &
- HFMFILE,HLUOUT, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
- PCOSSLOPE,PSINSLOPE, &
- PRHODJ, &
- PCDUEFF,PTAU11M,PTAU12M,PTAU33M, &
- PTHLM,PRM,PSVM,PUM,PVM,PWM,PUSLOPEM,PVSLOPEM, &
- PTKEM,PLM,MFMOIST,PWU,PWV, &
- PRUS,PRVS,PRWS, &
- PDP,PTP )
-!
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=AR
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-CHARACTER*4, INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
-REAL, INTENT(IN) :: PTSTEP ! Double Time Step
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output
- ! FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux points
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
- ! normal to the ground surface
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
- ! between i and the slope vector
-REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
- ! between i and the slope vector
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: MFMOIST ! moist mass flux dual scheme
-
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU11M ! <uu> in the axes linked
- ! to the maximum slope direction and the surface normal and the binormal
- ! at time t - dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU12M ! <uv> in the same axes
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHLM
- ! Wind at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
-REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
- ! maximum slope direction
-REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
- ! direction normal to the maximum slope one
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWU ! momentum flux u'w'
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWV ! momentum flux v'w'
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS
- ! cumulated sources for the prognostic variables
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PDP,PTP ! Dynamic and thermal
- ! TKE production terms
-!
-!
-!
-END SUBROUTINE TURB_VER_DYN_FLUX
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_VER_DYN_FLUX
diff --git a/src/arome/turb/modi_turb_ver_sv_corr.F90 b/src/arome/turb/modi_turb_ver_sv_corr.F90
deleted file mode 100644
index 31a993729572ee1f9f42393947976daf65d5a093..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_turb_ver_sv_corr.F90
+++ /dev/null
@@ -1,44 +0,0 @@
-! ######spl
- MODULE MODI_TURB_VER_SV_CORR
-! ####################
-!
-INTERFACE
-!
- SUBROUTINE TURB_VER_SV_CORR(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- PDZZ, &
- PTHLM,PRM,PTHVREF, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PPHI3,PPSI3, &
- PWM,PSVM, &
- PTKEM,PLM,PLEPS,PPSI_SV )
-!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-INTEGER, INTENT(IN) :: KRRL ! number of liquid var.
-INTEGER, INTENT(IN) :: KRRI ! number of ice var.
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ
- ! Metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM ! potential temperature at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios at t-Delta t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! reference Thv
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
- ! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3 ! Inv.Turb.Sch.for temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3 ! Inv.Turb.Sch.for humidity
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM ! w at time t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-Delta t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PPSI_SV ! Inv.Turb.Sch.for scalars
- ! cumulated sources for the prognostic variables
-!
-!
-END SUBROUTINE TURB_VER_SV_CORR
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_VER_SV_CORR
diff --git a/src/arome/turb/modi_turb_ver_sv_flux.F90 b/src/arome/turb/modi_turb_ver_sv_flux.F90
deleted file mode 100644
index dd10b563a2ff8686a345e31a6c75f662a56a86b2..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_turb_ver_sv_flux.F90
+++ /dev/null
@@ -1,65 +0,0 @@
-! ######spl
- MODULE MODI_TURB_VER_SV_FLUX
-! ####################
-!
-INTERFACE
-!
- SUBROUTINE TURB_VER_SV_FLUX(KKA,KKU,KKL, &
- OCLOSE_OUT,OTURB_FLX,HTURBDIM, &
- PIMPL,PEXPL, &
- PTSTEP, &
- HFMFILE,HLUOUT, &
- PDZZ,PDIRCOSZW, &
- PRHODJ,PWM, &
- PSFSVM,PSFSVP, &
- PSVM, &
- PTKEM,PLM,MFMOIST,PPSI_SV, &
- PRSVS,PWSV )
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=AR
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-CHARACTER*4, INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
-REAL, INTENT(IN) :: PTSTEP ! Double Time Step
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output
- ! FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ
- ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
- ! normal to the ground surface
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: MFMOIST ! moist mass flux dual scheme
-
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! t - deltat
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVP ! t + deltat
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-Delta t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM ! vertical wind
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PPSI_SV ! Inv.Turb.Sch.for scalars
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
- ! cumulated sources for the prognostic variables
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PWSV ! scalar flux
-
-!
-!
-END SUBROUTINE TURB_VER_SV_FLUX
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_VER_SV_FLUX
diff --git a/src/arome/turb/modi_turb_ver_thermo_corr.F90 b/src/arome/turb/modi_turb_ver_thermo_corr.F90
deleted file mode 100644
index 43d35b7707fc90cc4dee3546333e1cbaff4ef77c..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_turb_ver_thermo_corr.F90
+++ /dev/null
@@ -1,107 +0,0 @@
-! ######spl
- MODULE MODI_TURB_VER_THERMO_CORR
-! ####################
-!
-INTERFACE
-!
- SUBROUTINE TURB_VER_THERMO_CORR(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- OCLOSE_OUT,OTURB_FLX,HTURBDIM,HTOM, &
- PIMPL,PEXPL, &
- HFMFILE,HLUOUT, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW, &
- PRHODJ,PTHVREF, &
- PSFTHM,PSFRM,PSFTHP,PSFRP, &
- PWM,PTHLM,PRM,PSVM, &
- PTKEM,PLM,PLEPS, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM, &
- PBETA, PSQRT_TKE, PDTH_DZ, PDR_DZ, PRED2TH3, &
- PRED2R3, PRED2THR3, PBLL_O_E, PETHETA, &
- PEMOIST, PREDTH1, PREDR1, PPHI3, PPSI3, PD, &
- PFWTH,PFWR,PFTH2,PFR2,PFTHR, &
- PTHLP,PRP,MFMOIST,PSIGS )
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=AR
-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.
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-CHARACTER*4, INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-CHARACTER*4, INTENT(IN) :: HTOM ! type of Third Order Moment
-REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output
- ! FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ, PDXX, PDYY, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
- ! normal to the ground surface
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: MFMOIST ! moist mass flux dual scheme
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state Virtual
- ! Potential Temperature
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM ! surface fluxes at time
-! ! t - deltat
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHP,PSFRP ! surface fluxes at time
-! ! t + deltat
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM
-! Vertical wind
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
-! potential temperature at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios
- ! at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Mixing ratios
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
- ! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PBETA ! buoyancy coefficient
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE ! sqrt(e)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTH_DZ ! d(th)/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDR_DZ ! d(rt)/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2TH3 ! 3D Redeslperger number R*2_th
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2R3 ! 3D Redeslperger number R*2_r
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2THR3 ! 3D Redeslperger number R*2_thr
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E ! beta * Lk * Leps / tke
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA ! Coefficient for theta in theta_v computation
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST ! Coefficient for r in theta_v computation
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1 ! 1D Redelsperger number for Th
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1 ! 1D Redelsperger number for r
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3 ! Prandtl number for temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3 ! Prandtl number for vapor
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PD ! Denominator in Prandtl numbers
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWTH ! d(w'2th' )/dz (at flux point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWR ! d(w'2r' )/dz (at flux point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTH2 ! d(w'th'2 )/dz (at mass point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFR2 ! d(w'r'2 )/dz (at mass point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTHR ! d(w'th'r')/dz (at mass point)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLP ! guess of thl at t+ deltat
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRP ! guess of r at t+ deltat
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS ! Vert. part of Sigma_s at t
-!
-!
-!
-END SUBROUTINE TURB_VER_THERMO_CORR
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_VER_THERMO_CORR
diff --git a/src/arome/turb/modi_turb_ver_thermo_flux.F90 b/src/arome/turb/modi_turb_ver_thermo_flux.F90
deleted file mode 100644
index 19a050e790bf82229cd2acd0a5b3a670045e83c5..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_turb_ver_thermo_flux.F90
+++ /dev/null
@@ -1,118 +0,0 @@
-! ######spl
- MODULE MODI_TURB_VER_THERMO_FLUX
-! ####################
-!
-INTERFACE
-!
- SUBROUTINE TURB_VER_THERMO_FLUX(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- OCLOSE_OUT,OTURB_FLX,HTURBDIM,HTOM, &
- PIMPL,PEXPL, &
- PTSTEP, &
- HFMFILE,HLUOUT, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
- PRHODJ,PTHVREF, &
- PSFTHM,PSFRM,PSFTHP,PSFRP, &
- PWM,PTHLM,PRM,PSVM, &
- PTKEM,PLM,PLEPS, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
- PBETA, PSQRT_TKE, PDTH_DZ, PDR_DZ, PRED2TH3, &
- PRED2R3, PRED2THR3, PBLL_O_E, PETHETA, &
- PEMOIST, PREDTH1, PREDR1, PPHI3, PPSI3, PD, &
- PFWTH,PFWR,PFTH2,PFR2,PFTHR,MFMOIST,PBL_DEPTH,&
- PWTHV,PRTHLS,PRRS,PTHLP,PRP,PTP,PWTH,PWRC )
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=AR O
-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.
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-CHARACTER*4, INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-CHARACTER*4, INTENT(IN) :: HTOM ! type of Third Order Moment
-REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
-REAL, INTENT(IN) :: PTSTEP ! Double Time Step
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output
- ! FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ, PDXX, PDYY, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
- ! normal to the ground surface
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitudes
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: MFMOIST ! moist mass flux dual scheme
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state Virtual
- ! Potential Temperature
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM ! surface fluxes at time
-! ! t - deltat
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHP,PSFRP ! surface fluxes at time
-! ! t + deltat
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM
-! Vertical wind
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
-! potential temperature at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios
- ! at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Mixing ratios
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
- ! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFRAC_ICE ! ri fraction of rc+ri
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PBETA ! buoyancy coefficient
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE ! sqrt(e)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTH_DZ ! d(th)/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDR_DZ ! d(rt)/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2TH3 ! 3D Redeslperger number R*2_th
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2R3 ! 3D Redeslperger number R*2_r
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2THR3 ! 3D Redeslperger number R*2_thr
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E ! beta * Lk * Leps / tke
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA ! Coefficient for theta in theta_v computation
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST ! Coefficient for r in theta_v computation
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1 ! 1D Redelsperger number for Th
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1 ! 1D Redelsperger number for r
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3 ! Prandtl number for temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3 ! Prandtl number for vapor
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PD ! Denominator in Prandtl numbers
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWTH ! d(w'2th' )/dz (at flux point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWR ! d(w'2r' )/dz (at flux point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTH2 ! d(w'th'2 )/dz (at mass point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFR2 ! d(w'r'2 )/dz (at mass point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTHR ! d(w'th'r')/dz (at mass point)
-REAL, DIMENSION(:,:), INTENT(INOUT):: PBL_DEPTH ! BL depth
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTHV ! buoyancy flux
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHLS ! cumulated source for theta
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS ! cumulated source for rt
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHLP ! guess of thl at t+ deltat
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRP ! guess of r at t+ deltat
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PTP ! Dynamic and thermal
- ! TKE production terms
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTH ! heat flux
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWRC ! cloud water flux
-!
-!
-END SUBROUTINE TURB_VER_THERMO_FLUX
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_VER_THERMO_FLUX
diff --git a/src/arome/turb/modi_update_lm.F90 b/src/arome/turb/modi_update_lm.F90
deleted file mode 100644
index d2a31786e9a15acb0f239ed06035cbba5a160ac8..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_update_lm.F90
+++ /dev/null
@@ -1,18 +0,0 @@
-! ######spl
- MODULE MODI_UPDATE_LM
-! ###################
-INTERFACE
-!
-SUBROUTINE UPDATE_LM(HLBCX,HLBCY,PLM,PLEPS)
-!
-CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X boundary type
-CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y boundary type
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLM ! mixing length
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLEPS ! dissipative length
-!
-END SUBROUTINE UPDATE_LM
-!
-END INTERFACE
-!
-END MODULE MODI_UPDATE_LM
diff --git a/src/arome/turb/modi_updraft_sope.F90 b/src/arome/turb/modi_updraft_sope.F90
deleted file mode 100644
index 5fb81013f97ace2f68f41079baaff78d25a04234..0000000000000000000000000000000000000000
--- a/src/arome/turb/modi_updraft_sope.F90
+++ /dev/null
@@ -1,54 +0,0 @@
-! ######spl
- MODULE MODI_UPDRAFT_SOPE
-! #################################
-!
-INTERFACE
-!
- SUBROUTINE UPDRAFT_SOPE(KRR,KRRL,KRRI,OMIXUV, &
- PZZ,PDZZ,PSFTH,PSFRV,PPABSM,PRHODREF, &
- PTKEM,PTHM,PRM,PTHLM,PRTM,PUM,PVM,PSVM, &
- PTHL_UP,PRT_UP,PRV_UP,PU_UP,PV_UP,PSV_UP, &
- PRC_UP,PRI_UP,PTHV_UP,PW_UP,PFRAC_UP,PEMF,&
- PDETR,PENTR,KKLCL,KKETL,KKCTL )
-!
-!
-!
-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.
-LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height at the flux point
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! depth between mass levels
-
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTH,PSFRV
- ! normal surface fluxes of theta,rv
-!
-! prognostic variables at t- deltat
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! dry density of the
- ! reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM ! momentum
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Scalar variables
-!
-! thermodynamical variables which are transformed in conservative var.
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! pot. temp. = PTHLM in turb.f90
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! water species
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM,PRTM !cons. var.
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRV_UP,PRC_UP,PRI_UP,&!Thl,Rt,Rv,Rc,Ri
- PW_UP,PFRAC_UP,PEMF, &!w,Updraft Fraction, Mass Flux
- PDETR,PENTR,PTHV_UP, &!entrainment, detrainment, ThV
- PU_UP, PV_UP !updraft wind component
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar variables
-INTEGER, DIMENSION(:,:), INTENT(OUT) :: KKLCL,KKETL,KKCTL !index for LCL,ETL,CTL
-!
-!
-END SUBROUTINE UPDRAFT_SOPE
-
-END INTERFACE
-!
-END MODULE MODI_UPDRAFT_SOPE
diff --git a/src/arome/turb/prandtl.F90 b/src/arome/turb/prandtl.F90
deleted file mode 100644
index 3afb18cc4446837c32394876d804095d204a07ea..0000000000000000000000000000000000000000
--- a/src/arome/turb/prandtl.F90
+++ /dev/null
@@ -1,501 +0,0 @@
-! ######spl
- SUBROUTINE PRANDTL(KKA,KKU,KKL,KRR,KRRI,OCLOSE_OUT,OTURB_DIAG, &
- HTURBDIM, &
- HFMFILE,HLUOUT, &
- PDXX,PDYY,PDZZ,PDZX,PDZY, &
- PTHVREF,PLOCPEXNM,PATHETA,PAMOIST, &
- PLM,PLEPS,PTKEM,PTHLM,PRM,PSVM,PSRCM, &
- PREDTH1,PREDR1, &
- PRED2TH3, PRED2R3, PRED2THR3, &
- PREDS1,PRED2THS3, PRED2RS3, &
- PBLL_O_E, &
- PETHETA, PEMOIST )
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
- USE MODD_CTURB, ONLY : LHARAT
-! ###########################################################
-!
-!
-!!**** *PRANDTL* - routine to compute the Prandtl turbulent numbers
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to compute the Redelsperger
-! numbers and then get the turbulent Prandtl and Schmidt numbers:
-! * for the heat fluxes - PHI3 = 1/ Prandtl
-! * for the moisture fluxes - PSI3 = 1/ Schmidt
-!
-!!** METHOD
-!! ------
-!! The following steps are performed:
-!!
-!! 1 - default values of 1 are taken for phi3 and psi3 and different masks
-!! are defined depending on the presence of turbulence, stratification and
-!! humidity. The 1D Redelsperger numbers are computed
-!! * ZREDTH1 : (g / THVREF ) (LT**2 / TKE ) ETHETA (D Theta / Dz)
-!! * ZREDR1 : (g / THVREF ) (LT**2 / TKE ) EMOIST (D TW / Dz)
-!! 2 - 3D Redelsperger numbers are computed only for turbulent
-!! grid points where ZREDTH1 or ZREDR1 are > 0.
-!! 3 - PHI3 is computed only for turbulent grid points where ZREDTH1 > 0
-!! (turbulent thermally stratified points)
-!! 4 - PSI3 is computed only for turbulent grid points where ZREDR1 > 0
-!! (turbulent moist points)
-!!
-!!
-!! EXTERNAL
-!! --------
-!! FUNCTIONs ETHETA and EMOIST :
-!! allows to compute the coefficients
-!! for the turbulent correlation between any variable
-!! and the virtual potential temperature, of its correlations
-!! with the conservative potential temperature and the humidity
-!! conservative variable:
-!! ------- ------- -------
-!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
-!!
-!! GX_M_M, GY_M_M, GZ_M_M : Cartesian gradient operators
-!! MZM : Shuman function (mean operator in the z direction)
-!! Module MODI_ETHETA : interface module for ETHETA
-!! Module MODI_EMOIST : interface module for EMOIST
-!! Module MODI_SHUMAN : interface module for Shuman operators
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CST : contains physical constants
-!! XG : gravity constant
-!!
-!! Module MODD_CTURB: contains the set of constants for
-!! the turbulence scheme
-!! XCTV,XCPR2 : constants for the turbulent prandtl numbers
-!! XTKEMIN : minimum value allowed for the TKE
-!!
-!! Module MODD_PARAMETERS
-!! JPVEXT_TURB : number of vertical marginal points
-!!
-!! REFERENCE
-!! ---------
-!! Book 2 of documentation (routine PRANDTL)
-!! Book 1 of documentation (Chapter: Turbulence)
-!!
-!! AUTHOR
-!! ------
-!! Joan Cuxart * INM and Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 18/10/94
-!! Modifications: Feb 14, 1995 (J.Cuxart and J.Stein)
-!! Doctorization and Optimization
-!! Modifications: March 21, 1995 (J.M. Carriere)
-!! Introduction of cloud water
-!! Modifications: March 21, 1995 (J. Cuxart and J.Stein)
-!! Phi3 and Psi3 at w point + cleaning
-!! Modifications: July 2, 1995 (J.Cuxart and Ph.Bougeault)
-!! change the value of Phi3 and Psi3 if negative
-!! Modifications: Sept 20, 1995 (J. Stein, J. Cuxart, J.L. Redelsperger)
-!! remove the Where + use REDTH1+REDR1 for the tests
-!! Modifications: October 10, 1995 (J. Cuxart and J.Stein)
-!! Psi3 for tPREDS1he scalar variables
-!! Modifications: February 27, 1996 (J.Stein) optimization
-!! Modifications: June 15, 1996 (P.Jabouille) return to the previous
-!! computation of Phi3 and Psi3
-!! Modifications: October 10, 1996 (J. Stein) change the temporal
-!! discretization
-!! Modifications: May 23, 1997 (J. Stein) bug in 3D Redels number at ground
-!! with orography
-!! Modifications: Feb 20, 1998 (J. Stein) bug in all the 3D cases due to
-!! the use of ZW1 instead of ZW2
-!! Feb 20, 2003 (JP Pinty) Add PFRAC_ICE
-!! July 2005 (Tomas, Masson) implicitation of PHI3 and PSI3
-!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
-!! change of YCOMMENT
-!! 2012-02 Y. Seity, add possibility to run with reversed
-!! vertical levels
-!! Modifications: July 2015 (Wim de Rooy) LHARAT (Racmo turbulence) switch
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-USE MODD_CONF
-USE MODD_CTURB
-USE MODD_PARAMETERS
-!
-USE MODI_GRADIENT_M
-USE MODI_EMOIST
-USE MODI_ETHETA
-USE MODI_SHUMAN, ONLY: MZM
-USE MODE_FMWRIT
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-INTEGER, INTENT(IN) :: KRRI ! number of ice var.
-!
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
-LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
- ! diagnostic fields in the syncronous FM-file
-CHARACTER*4 , INTENT(IN) :: HTURBDIM ! Kind of turbulence param.
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output
- ! FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
- ! metric coefficients
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential Temp.
- ! of the reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turbulent Mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! Dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM,PTKEM! Conservative Potential
- ! Temperature and TKE at t-1
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios at t-1
- ! with PRM(:,:,:,1) = cons.
- ! mixing ratio
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Scalars at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM
- ! s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PREDTH1 ! Redelsperger number R_theta
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PREDR1 ! Redelsperger number R_q
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2TH3 ! Redelsperger number R*2_theta
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2R3 ! Redelsperger number R*2_q
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2THR3! Redelsperger number R*2_thq
-REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PREDS1 ! Redelsperger number R_s
-REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PRED2THS3! Redelsperger number R*2_thsv
-REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PRED2RS3 ! Redelsperger number R*2_qsv
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBLL_O_E! beta*Lk*Leps/tke
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PETHETA ! coefficient E_theta
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEMOIST ! coefficient E_moist
-!
-!
-! 0.2 declaration of local variables
-!
-REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
- ZW1, ZW2, ZW3
-! working variables
-!
-INTEGER :: IKB ! vertical index value for the first inner mass point
-INTEGER :: IKE ! vertical index value for the last inner mass point
-INTEGER :: IRESP ! Return code of FM routines
-INTEGER :: ILENG ! Length of the data field in LFIFM file
-INTEGER :: IGRID ! C-grid indicator in LFIFM file
-INTEGER :: ILENCH ! Length of comment string in LFIFM file
-CHARACTER (LEN=100) :: YCOMMENT ! comment string in LFIFM file
-CHARACTER (LEN=16) :: YRECFM ! Name of the desired field in LFIFM file
-INTEGER:: ISV ! number of scalar variables
-INTEGER:: JSV ! loop index for the scalar variables
-
-INTEGER :: JLOOP
-REAL :: ZMINVAL
-! ---------------------------------------------------------------------------
-!
-!
-!* 1. DEFAULT VALUES, 1D REDELSPERGER NUMBERS
-! ----------------------------------------
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK('PRANDTL',0,ZHOOK_HANDLE)
-
-IF (LHARAT) THEN
-PREDTH1(:,:,:)=0.
-PREDR1(:,:,:)=0.
-PRED2TH3(:,:,:)=0.
-PRED2R3(:,:,:)=0.
-PRED2THR3(:,:,:)=0.
-PREDS1(:,:,:,:)=0.
-PRED2THS3(:,:,:,:)=0.
-PRED2RS3(:,:,:,:)=0.
-PBLL_O_E(:,:,:)=0.
-ENDIF
-!
-IKB = KKA+JPVEXT_TURB*KKL
-IKE = KKU-JPVEXT_TURB*KKL
-ILENG=SIZE(PTHLM,1)*SIZE(PTHLM,2)*SIZE(PTHLM,3)
-ISV =SIZE(PSVM,4)
-!
-PETHETA(:,:,:) = MZM(ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM), KKA, KKU, KKL)
-PEMOIST(:,:,:) = MZM(EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM), KKA, KKU, KKL)
-PETHETA(:,:,KKA) = 2.*PETHETA(:,:,IKB) - PETHETA(:,:,IKB+KKL)
-PEMOIST(:,:,KKA) = 2.*PEMOIST(:,:,IKB) - PEMOIST(:,:,IKB+KKL)
-!
-!---------------------------------------------------------------------------
-IF (.NOT. LHARAT) THEN
-!
-! 1.3 1D Redelsperger numbers
-!
-PBLL_O_E(:,:,:) = MZM(XG / PTHVREF(:,:,:) * PLM(:,:,:) * PLEPS(:,:,:) / PTKEM(:,:,:), KKA, KKU, KKL)
-IF (KRR /= 0) THEN ! moist case
- PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * PETHETA(:,:,:) * &
- & GZ_M_W(PTHLM,PDZZ, KKA, KKU, KKL)
- PREDR1(:,:,:) = XCTV*PBLL_O_E(:,:,:) * PEMOIST(:,:,:) * &
- & GZ_M_W(PRM(:,:,:,1),PDZZ, KKA, KKU, KKL)
-ELSE ! dry case
- PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * GZ_M_W(PTHLM,PDZZ, KKA, KKU, KKL)
- PREDR1(:,:,:) = 0.
-END IF
-!
-! 3. Limits on 1D Redelperger numbers
-! --------------------------------
-!
-ZMINVAL = (1.-1./XPHI_LIM)
-!
-ZW1 = 1.
-ZW2 = 1.
-!
-WHERE (PREDTH1+PREDR1<-ZMINVAL)
- ZW1 = (-ZMINVAL) / (PREDTH1+PREDR1)
-END WHERE
-!
-WHERE (PREDTH1<-ZMINVAL)
- ZW2 = (-ZMINVAL) / (PREDTH1)
-END WHERE
-ZW2 = MIN(ZW1,ZW2)
-!
-ZW1 = 1.
-WHERE (PREDR1<-ZMINVAL)
- ZW1 = (-ZMINVAL) / (PREDR1)
-END WHERE
-ZW1 = MIN(ZW2,ZW1)
-!
-!
-! 3. Modification of Mixing length and dissipative length
-! ----------------------------------------------------
-!
-PBLL_O_E(:,:,:) = PBLL_O_E(:,:,:) * ZW1(:,:,:)
-PREDTH1 (:,:,:) = PREDTH1 (:,:,:) * ZW1(:,:,:)
-PREDR1 (:,:,:) = PREDR1 (:,:,:) * ZW1(:,:,:)
-!
-! 4. Threshold for very small (in absolute value) Redelperger numbers
-! ----------------------------------------------------------------
-!
-ZW2=SIGN(1.,PREDTH1(:,:,:))
-PREDTH1(:,:,:)= ZW2(:,:,:) * MAX(1.E-30, ZW2(:,:,:)*PREDTH1(:,:,:))
-!
-IF (KRR /= 0) THEN ! dry case
- ZW2=SIGN(1.,PREDR1(:,:,:))
- PREDR1(:,:,:)= ZW2(:,:,:) * MAX(1.E-30, ZW2(:,:,:)*PREDR1(:,:,:))
-END IF
-!
-!
-!---------------------------------------------------------------------------
-!
-! For the scalar variables
-DO JSV=1,ISV
- PREDS1(:,:,:,JSV)=XCTV*PBLL_O_E(:,:,:)*GZ_M_W(PSVM(:,:,:,JSV),PDZZ, KKA, KKU, KKL)
-END DO
-!
-DO JSV=1,ISV
- ZW2=SIGN(1.,PREDS1(:,:,:,JSV))
- PREDS1(:,:,:,JSV)= ZW2(:,:,:) * MAX(1.E-30, ZW2(:,:,:)*PREDS1(:,:,:,JSV))
-END DO
-!
-!---------------------------------------------------------------------------
-!
-!* 2. 3D REDELSPERGER NUMBERS
-! ------------------------
-!
-IF(HTURBDIM=='1DIM') THEN ! 1D case
-!
-!
- PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2
-!
- PRED2R3(:,:,:) = PREDR1(:,:,:) **2
-!
- PRED2THR3(:,:,:) = PREDTH1(:,:,:) * PREDR1(:,:,:)
-!
-ELSE IF (L2D) THEN ! 3D case in a 2D model
-!
- IF (KRR /= 0) THEN ! moist 3D case
- PRED2TH3(:,:,:)= PREDTH1(:,:,:)**2+(XCTV*PBLL_O_E(:,:,:)*PETHETA(:,:,:) )**2 * &
- MZM(GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL)**2, KKA, KKU, KKL)
- PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
-!
- PRED2R3(:,:,:)= PREDR1(:,:,:)**2 + (XCTV*PBLL_O_E(:,:,:)*PEMOIST(:,:,:))**2 * &
- MZM(GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX, KKA, KKU, KKL)**2, KKA, KKU, KKL)
- PRED2R3(:,:,IKB)=PRED2R3(:,:,IKB+KKL)
-!
- PRED2THR3(:,:,:)= PREDR1(:,:,:) * PREDTH1(:,:,:) + XCTV**2*PBLL_O_E(:,:,:)**2 * &
- PEMOIST(:,:,:) * PETHETA(:,:,:) * &
- MZM(GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX, KKA, KKU, KKL)* &
- GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL), KKA, KKU, KKL)
- PRED2THR3(:,:,IKB)=PRED2THR3(:,:,IKB+KKL)
-!
- ELSE ! dry 3D case in a 2D model
- PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2 + XCTV**2*PBLL_O_E(:,:,:)**2 * &
- MZM(GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL)**2, KKA, KKU, KKL)
- PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
-!
- PRED2R3(:,:,:) = 0.
-!
- PRED2THR3(:,:,:) = 0.
-!
- END IF
-!
-ELSE ! 3D case in a 3D model
-!
- IF (KRR /= 0) THEN ! moist 3D case
- PRED2TH3(:,:,:)= PREDTH1(:,:,:)**2 + ( XCTV*PBLL_O_E(:,:,:)*PETHETA(:,:,:) )**2 * &
- MZM(GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL)**2 &
- + GY_M_M(PTHLM,PDYY,PDZZ,PDZY, KKA, KKU, KKL)**2, KKA, KKU, KKL)
- PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
-!
- PRED2R3(:,:,:)= PREDR1(:,:,:)**2 + (XCTV*PBLL_O_E(:,:,:)*PEMOIST(:,:,:))**2 * &
- MZM(GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX, KKA, KKU, KKL)**2 + &
- GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY, KKA, KKU, KKL)**2, KKA, KKU, KKL)
- PRED2R3(:,:,IKB)=PRED2R3(:,:,IKB+KKL)
-!
- PRED2THR3(:,:,:)= PREDR1(:,:,:) * PREDTH1(:,:,:) + XCTV**2*PBLL_O_E(:,:,:)**2 * &
- PEMOIST(:,:,:) * PETHETA(:,:,:) * &
- MZM(GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX, KKA, KKU, KKL)* &
- GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL)+ &
- GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY, KKA, KKU, KKL)* &
- GY_M_M(PTHLM,PDYY,PDZZ,PDZY, KKA, KKU, KKL), KKA, KKU, KKL)
- PRED2THR3(:,:,IKB)=PRED2THR3(:,:,IKB+KKL)
-!
- ELSE ! dry 3D case in a 3D model
- PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2 + XCTV**2*PBLL_O_E(:,:,:)**2 * &
- MZM(GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL)**2 &
- + GY_M_M(PTHLM,PDYY,PDZZ,PDZY, KKA, KKU, KKL)**2, KKA, KKU, KKL)
- PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
-!
- PRED2R3(:,:,:) = 0.
-!
- PRED2THR3(:,:,:) = 0.
-!
- END IF
-!
-END IF ! end of the if structure on the turbulence dimensionnality
-!
-!
-!---------------------------------------------------------------------------
-!
-! 5. Prandtl numbers for scalars
-! ---------------------------
-DO JSV=1,ISV
-!
- IF(HTURBDIM=='1DIM') THEN
-! 1D case
- PRED2THS3(:,:,:,JSV) = PREDS1(:,:,:,JSV) * PREDTH1(:,:,:)
- IF (KRR /= 0) THEN
- PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) *PREDS1(:,:,:,JSV)
- ELSE
- PRED2RS3(:,:,:,JSV) = 0.
- END IF
-!
- ELSE IF (L2D) THEN ! 3D case in a 2D model
-!
- IF (KRR /= 0) THEN
- ZW1 = MZM((XG / PTHVREF * PLM * PLEPS / PTKEM)**2, KKA, KKU, KKL) *PETHETA
- ELSE
- ZW1 = MZM((XG / PTHVREF * PLM * PLEPS / PTKEM)**2, KKA, KKU, KKL)
- END IF
- PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + &
- ZW1* &
- MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX, KKA, KKU, KKL)* &
- GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL), &
- KKA, KKU, KKL)
-!
- IF (KRR /= 0) THEN
- PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
- ZW1 * PEMOIST * &
- MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX, KKA, KKU, KKL)* &
- GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX, KKA, KKU, KKL), &
- KKA, KKU, KKL)
- ELSE
- PRED2RS3(:,:,:,JSV) = 0.
- END IF
-!
- ELSE ! 3D case in a 3D model
-!
- IF (KRR /= 0) THEN
- ZW1 = MZM((XG / PTHVREF * PLM * PLEPS / PTKEM)**2, KKA, KKU, KKL) *PETHETA
- ELSE
- ZW1 = MZM((XG / PTHVREF * PLM * PLEPS / PTKEM)**2, KKA, KKU, KKL)
- END IF
- PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + &
- ZW1* &
- MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX, KKA, KKU, KKL)* &
- GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL) &
- +GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY, KKA, KKU, KKL)* &
- GY_M_M(PTHLM,PDYY,PDZZ,PDZY, KKA, KKU, KKL), &
- KKA, KKU, KKL)
-!
- IF (KRR /= 0) THEN
- PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
- ZW1 * PEMOIST * &
- MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX, KKA, KKU, KKL)* &
- GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX, KKA, KKU, KKL) &
- +GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY, KKA, KKU, KKL)* &
- GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY, KKA, KKU, KKL), &
- KKA, KKU, KKL)
- ELSE
- PRED2RS3(:,:,:,JSV) = 0.
- END IF
-!
- END IF ! end of HTURBDIM if-block
-!
-END DO
-!
-!---------------------------------------------------------------------------
-!
-!* 6. SAVES THE REDELSPERGER NUMBERS
-! ------------------------------
-!
-IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
- !
- ! stores the RED_TH1
- YRECFM ='RED_TH1'
- YCOMMENT='X_Y_Z_RED_TH1 (0)'
- IGRID = 4
- ILENCH=LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',PREDTH1,IGRID,ILENCH,YCOMMENT,IRESP)
- !
- ! stores the RED_R1
- YRECFM ='RED_R1'
- YCOMMENT='X_Y_Z_RED_R1 (0)'
- IGRID = 4
- ILENCH=LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',PREDR1,IGRID,ILENCH,YCOMMENT,IRESP)
- !
- ! stores the RED2_TH3
- YRECFM ='RED2_TH3'
- YCOMMENT='X_Y_Z_RED2_TH3 (0)'
- IGRID = 4
- ILENCH=LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',PRED2TH3,IGRID,ILENCH,YCOMMENT,IRESP)
- !
- ! stores the RED2_R3
- YRECFM ='RED2_R3'
- YCOMMENT='X_Y_Z_RED2_R3 (0)'
- IGRID = 4
- ILENCH=LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',PRED2R3,IGRID,ILENCH,YCOMMENT,IRESP)
- !
- ! stores the RED2_THR3
- YRECFM ='RED2_THR3'
- YCOMMENT='X_Y_Z_RED2_THR3 (0)'
- IGRID = 4
- ILENCH=LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',PRED2THR3,IGRID,ILENCH,YCOMMENT,IRESP)
-END IF
-!
-!---------------------------------------------------------------------------
-ENDIF ! (Done only if LHARAT is FALSE)
-!
-IF (LHOOK) CALL DR_HOOK('PRANDTL',1,ZHOOK_HANDLE)
-END SUBROUTINE PRANDTL
diff --git a/src/arome/turb/tke_eps_sources.F90 b/src/arome/turb/tke_eps_sources.F90
deleted file mode 100644
index 672987f182e17653c639b6206b88e93acd184127..0000000000000000000000000000000000000000
--- a/src/arome/turb/tke_eps_sources.F90
+++ /dev/null
@@ -1,432 +0,0 @@
-! ######spl
- SUBROUTINE TKE_EPS_SOURCES(KKA,KKU,KKL,KMI,PTKEM,PLM,PLEPS,PDP, &
- & PTRH,PRHODJ,PDZZ,PDXX,PDYY,PDZX,PDZY,PZZ, &
- & PTSTEP,PIMPL,PEXPL, &
- & HTURBLEN,HTURBDIM, &
- & HFMFILE,HLUOUT,OCLOSE_OUT,OTURB_DIAG, &
- & PTP,PRTKES,PRTHLS,PCOEF_DISS,PTDIFF,PTDISS, &
- & PEDR,YDDDH, YDLDDH, YDMDDH)
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-! ##################################################################
-!
-!
-!!**** *TKE_EPS_SOURCES* - routine to compute the sources of the turbulent
-!! evolutive variables: TKE and its dissipation when it is taken into
-!! account. The contribution to the heating of tke dissipation is computed.
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to compute the sources necessary for
-! the evolution of the turbulent kinetic energy and its dissipation
-! if necessary.
-!
-!!** METHOD
-!! ------
-!! The vertical turbulent flux is computed in an off-centered
-!! implicit scheme (a Crank-Nicholson type with coefficients different
-!! than 0.5), which allows to vary the degree of implicitness of the
-!! formulation.
-!! In high resolution, the horizontal transport terms are also
-!! calculated, but explicitly.
-!! The evolution of the dissipation as a variable is made if
-!! the parameter HTURBLEN is set equal to KEPS. The same reasoning
-!! made for TKE applies.
-!!
-!! EXTERNAL
-!! --------
-!! GX_U_M,GY_V_M,GZ_W_M
-!! GX_M_U,GY_M_V : Cartesian vertical gradient operators
-!!
-!! MXF,MXM.MYF,MYM,MZF,MZM: Shuman functions (mean operators)
-!! DZF : Shuman functions (difference operators)
-!!
-!! SUBROUTINE TRIDIAG : to solve an implicit temporal scheme
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CST : contains physical constants
-!!
-!! XG : gravity constant
-!!
-!! Module MODD_CTURB: contains the set of constants for
-!! the turbulence scheme
-!!
-!! XCET,XCED : transport and dissipation cts. for the TKE
-!! XCDP,XCDD,XCDT: constants from the parameterization of
-!! the K-epsilon equation
-!! XTKEMIN,XEPSMIN : minimum values for the TKE and its
-!! dissipation
-!!
-!! Module MODD_PARAMETERS:
-!!
-!! JPVEXT_TURB
-!! Module MODD_BUDGET:
-!! NBUMOD : model in which budget is calculated
-!! CBUTYPE : type of desired budget
-!! 'CART' for cartesian box configuration
-!! 'MASK' for budget zone defined by a mask
-!! 'NONE' ' for no budget
-!! NBUPROCCTR : process counter used for each budget variable
-!! LBU_RTKE : logical for budget of RTKE (turbulent kinetic energy)
-!! .TRUE. = budget of RTKE
-!! .FALSE. = no budget of RTKE
-!!
-!!
-!! REFERENCE
-!! ---------
-!! Book 2 of documentation (routine TKE_EPS_SOURCES)
-!! Book 1 of documentation (Chapter: Turbulence)
-!!
-!! AUTHOR
-!! ------
-!! Joan Cuxart * INM and Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original August 23, 1994
-!! Modifications: Feb 14, 1995 (J.Cuxart and J.Stein)
-!! Doctorization and Optimization
-!! June 29, 1995 (J.Stein) TKE budget
-!! June 28, 1995 (J.Cuxart) Add LES tools
-!! Modifications: February 29, 1996 (J. Stein) optimization
-!! Modifications: May 6, 1996 (N. Wood) Extend some loops over
-!! the outer points
-!! Modifications: August 30, 1996 (P. Jabouille) calcul ZFLX at the
-!! IKU level
-!! October 10, 1996 (J.Stein) set Keff at t-deltat
-!! Oct 8, 1996 (Cuxart,Sanchez) Var.LES: XETR_TF,XDISS_TF
-!! December 20, 1996 (J.-P. Pinty) update the CALL BUDGET
-!! November 24, 1997 (V. Masson) bug in <v'e>
-!! removes the DO loops
-!! Augu. 9, 1999 (J.Stein) TKE budget correction
-!! Mar 07 2001 (V. Masson and J. Stein) remove the horizontal
-!! turbulent transports of Tke computation
-!! Nov 06, 2002 (V. Masson) LES budgets
-!! July 20, 2003 (J.-P. Pinty P Jabouille) add the dissipative heating
-!! May 2006 Remove KEPS
-!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
-!! change of YCOMMENT
-!! 2012-02 Y. Seity, add possibility to run with reversed
-!! vertical levels
-!! 2014-11 Y. Seity, add output terms for TKE DDHs budgets
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-USE MODD_CONF
-USE MODD_CTURB
-USE MODD_PARAMETERS
-USE MODD_BUDGET
-USE MODD_LES
-USE MODD_DIAG_IN_RUN, ONLY : LDIAG_IN_RUN, XCURRENT_TKE_DISS
-!
-USE MODI_GRADIENT_M
-USE MODI_GRADIENT_U
-USE MODI_GRADIENT_V
-USE MODI_GRADIENT_W
-USE MODI_SHUMAN , ONLY : DZM, DZF, MZM, MZF
-USE MODI_TRIDIAG
-USE MODI_TRIDIAG_TKE
-USE MODI_BUDGET_DDH
-USE MODE_FMWRIT
-USE MODI_LES_MEAN_SUBGRID
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-!!!!!AROME!!USE MODE_ll
-!!!!!AROME!!USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-
-INTEGER, INTENT(IN) :: KMI ! model index number
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at t-deltat
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
- ! metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! physical height w-pt
-REAL, INTENT(IN) :: PTSTEP ! Double Time step ( *.5 for
- ! the first time step )
-REAL, INTENT(IN) :: PEXPL, PIMPL ! Coef. temporal. disc.
-CHARACTER*4, INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-CHARACTER*4, INTENT(IN) :: HTURBLEN ! kind of mixing length
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output
- ! FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
-LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
- ! diagnostic fields in the syncronous FM-file
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PDP, PTRH ! Dyn. prod. of TKE
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PTP ! Ther. prod. of TKE
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRTKES ! RHOD * Jacobian *
- ! TKE at t+deltat
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRTHLS ! Source of Theta_l
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCOEF_DISS ! 1/(Cph*Exner)
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTDIFF ! Diffusion TKE term
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTDISS ! Dissipation TKE term
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEDR ! EDR
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-!
-!
-!* 0.2 declaration of local variables
-!
-REAL, DIMENSION(SIZE(PTKEM,1),SIZE(PTKEM,2),SIZE(PTKEM,3)):: &
- ZA, & ! under diagonal elements of the tri-diagonal matrix involved
- ! in the temporal implicit scheme
- ZRES, & ! treated variable at t+ deltat when the turbu-
- ! lence is the only source of evolution added to the ones
- ! considered in ZSOURCE. This variable is also used to
- ! temporarily store some diagnostics stored in FM file
- ZFLX, & ! horizontal or vertical flux of the treated variable
- ZSOURCE, & ! source of evolution for the treated variable
- ZTR, & ! turbulent transport of TKE
- ZKEFF ! effectif diffusion coeff = LT * SQRT( TKE )
-LOGICAL,DIMENSION(SIZE(PTKEM,1),SIZE(PTKEM,2),SIZE(PTKEM,3)) :: GTKENEG
- ! 3D mask .T. if TKE < XTKEMIN
-INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE
- ! Index values for the Beginning and End
- ! mass points of the domain
-INTEGER :: IIU,IJU,IKU ! array size in the 3 dimensions
-INTEGER :: IRESP ! Return code of FM routines
-INTEGER :: IGRID ! C-grid indicator in LFIFM file
-INTEGER :: ILENCH ! Length of comment string in LFIFM file
-CHARACTER (LEN=100) :: YCOMMENT ! comment string in LFIFM file
-CHARACTER (LEN=16) :: YRECFM ! Name of the desired field in LFIFM file
-!
-!!!!!AROME!!TYPE(LIST_ll), POINTER :: TZFIELDDISS_ll ! list of fields to exchange
-!!!!!AROME!!INTEGER :: IINFO_ll ! return code of parallel routine
-!
-
-!----------------------------------------------------------------------------
-!!!!!AROME!!NULLIFY(TZFIELDDISS_ll)
-!
-!* 1. PRELIMINARY COMPUTATIONS
-! ------------------------
-!
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK('TKE_EPS_SOURCES',0,ZHOOK_HANDLE)
-IIB=1+JPHEXT
-IIU=SIZE(PTKEM,1)
-IIE=IIU-JPHEXT
-IJB=1+JPHEXT
-IJU=SIZE(PTKEM,2)
-IJE=IJU-JPHEXT
-IKB=KKA+JPVEXT_TURB*KKL
-IKE=KKU-JPVEXT_TURB*KKL
-!
-! compute the effective diffusion coefficient at the mass point
-ZKEFF(:,:,:) = PLM(:,:,:) * SQRT(PTKEM(:,:,:))
-!
-!----------------------------------------------------------------------------
-!
-!* 2. TKE EQUATION
-! ------------
-!
-!* 2.1 Horizontal turbulent explicit transport
-!
-!
-! Complete the sources of TKE with the horizontal turbulent explicit transport
-!
-IF (HTURBDIM=='3DIM') THEN
- ZTR=PTRH
-ELSE
- ZTR=0.
-END IF
-!
-!
-!
-!* 2.2 Explicit TKE sources except horizontal turbulent transport
-!
-!
-! extrapolate the dynamic production with a 1/Z law from its value at the
-! W(IKB+1) value stored in PDP(IKB) to the mass localization tke(IKB)
-PDP(:,:,IKB) = PDP(:,:,IKB) * (1. + PDZZ(:,:,IKB+KKL)/PDZZ(:,:,IKB))
-!
-! Compute the source terms for TKE: ( ADVECtion + NUMerical DIFFusion + ..)
-! + (Dynamical Production) + (Thermal Production) - (dissipation)
-ZFLX(:,:,:) = XCED * SQRT(PTKEM(:,:,:)) / PLEPS(:,:,:)
-ZSOURCE(:,:,:) = PRTKES(:,:,:) / PRHODJ(:,:,:) - PTKEM(:,:,:) / PTSTEP &
- + PDP(:,:,:) + PTP(:,:,:) + ZTR(:,:,:) - PEXPL * ZFLX(:,:,:) * PTKEM(:,:,:)
-!
-!* 2.2 implicit vertical TKE transport
-!
-!
-! Compute the vector giving the elements just under the diagonal for the
-! matrix inverted in TRIDIAG
-!
-ZA(:,:,:) = - PTSTEP * XCET * &
- MZM(ZKEFF, KKA, KKU, KKL) * MZM(PRHODJ, KKA, KKU, KKL) / PDZZ**2
-!
-! Compute TKE at time t+deltat: ( stored in ZRES )
-!
-CALL TRIDIAG_TKE(KKA,KKU,KKL,PTKEM,ZA,PTSTEP,PEXPL,PIMPL,PRHODJ,&
- & ZSOURCE,PTSTEP*ZFLX,ZRES)
-!
-!* diagnose the dissipation
-!
-IF (LDIAG_IN_RUN) THEN
- XCURRENT_TKE_DISS = ZFLX(:,:,:) * PTKEM(:,:,:) &
- *(PEXPL*PTKEM(:,:,:) + PIMPL*ZRES(:,:,:))
-!!!!!AROME!! CALL ADD3DFIELD_ll(TZFIELDDISS_ll,XCURRENT_TKE_DISS)
-!!!!!AROME!! CALL UPDATE_HALO_ll(TZFIELDDISS_ll,IINFO_ll)
-!!!!!AROME!! CALL CLEANLIST_ll(TZFIELDDISS_ll)
-ENDIF
-!
-! TKE must be greater than its minimum value
-!
-GTKENEG = ZRES <= XTKEMIN
-WHERE ( GTKENEG )
- ZRES = XTKEMIN
-END WHERE
-
-PTDISS(:,:,:) = - ZFLX(:,:,:)*(PEXPL*PTKEM(:,:,:) + PIMPL*ZRES(:,:,:))
-!
-IF ( LLES_CALL .OR. &
- (OTURB_DIAG .AND. OCLOSE_OUT) ) THEN
-!
-! Compute the cartesian vertical flux of TKE in ZFLX
-!
-
- ZFLX(:,:,:) = - XCET * MZM(ZKEFF, KKA, KKU, KKL) * &
- DZM(PIMPL * ZRES + PEXPL * PTKEM, KKA, KKU, KKL) / PDZZ
-!
- ZFLX(:,:,IKB) = 0.
- ZFLX(:,:,KKA) = 0.
-!
-! Compute the whole turbulent TRansport of TKE:
-!
- ZTR(:,:,:)= ZTR - DZF(MZM(PRHODJ, KKA, KKU, KKL) * ZFLX / PDZZ, KKA, KKU, KKL) /PRHODJ
-!
-! Storage in the LES configuration
-!
- IF (LLES_CALL) THEN
- CALL LES_MEAN_SUBGRID(MZF(ZFLX, KKA, KKU, KKL), X_LES_SUBGRID_WTke )
- CALL LES_MEAN_SUBGRID(-ZTR, X_LES_SUBGRID_ddz_WTke )
- END IF
-!
-END IF
-!
-!* 2.4 stores the explicit sources for budget purposes
-!
-IF (LBUDGET_TKE) THEN
-!
-! add the dynamical production
-!
- PRTKES(:,:,:) = PRTKES(:,:,:) + PDP(:,:,:) * PRHODJ(:,:,:)
- CALL BUDGET_DDH (PRTKES(:,:,:),5,'DP_BU_RTKE',YDDDH, YDLDDH, YDMDDH)
-!
-! add the thermal production
-!
- PRTKES(:,:,:) = PRTKES(:,:,:) + PTP(:,:,:) * PRHODJ(:,:,:)
- CALL BUDGET_DDH (PRTKES(:,:,:),5,'TP_BU_RTKE',YDDDH, YDLDDH, YDMDDH)
-!
-! add the dissipation
-!
-PRTKES(:,:,:) = PRTKES(:,:,:) - XCED * SQRT(PTKEM(:,:,:)) / PLEPS(:,:,:) * &
- (PEXPL*PTKEM(:,:,:) + PIMPL*ZRES(:,:,:)) * PRHODJ(:,:,:)
-CALL BUDGET_DDH (PRTKES(:,:,:),5,'DISS_BU_RTKE',YDDDH, YDLDDH, YDMDDH)
-END IF
-!
-!* 2.5 computes the final RTKE and stores the whole turbulent transport
-!
-PTDIFF(:,:,:) = ZRES(:,:,:) / PTSTEP - PRTKES(:,:,:)/PRHODJ(:,:,:) &
- & - PDP(:,:,:)- PTP(:,:,:) - PTDISS(:,:,:)
-
-PRTKES(:,:,:) = ZRES(:,:,:) * PRHODJ(:,:,:) / PTSTEP
-
-!
-! stores the whole turbulent transport
-!
-IF (LBUDGET_TKE) CALL BUDGET_DDH (PRTKES(:,:,:),5,'TR_BU_RTKE',YDDDH, YDLDDH, YDMDDH)
-!
-!
-!----------------------------------------------------------------------------
-!
-!* 3. COMPUTE THE DISSIPATIVE HEATING
-! -------------------------------
-!
-PRTHLS(:,:,:) = PRTHLS(:,:,:) + XCED * SQRT(PTKEM(:,:,:)) / PLEPS(:,:,:) * &
- (PEXPL*PTKEM(:,:,:) + PIMPL*ZRES(:,:,:)) * PRHODJ(:,:,:) * PCOEF_DISS(:,:,:)
-!
-!----------------------------------------------------------------------------
-!
-!* 4. STORES SOME DIAGNOSTICS
-! -----------------------
-!
-PEDR(:,:,:)=XCED * (PTKEM(:,:,:)**1.5) / PLEPS(:,:,:)
-
-
-
-IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
-!
-! stores the dynamic production
-!
- YRECFM ='DP'
- YCOMMENT='X_Y_Z_DP (M**2/S**3)'
- IGRID = 1
- ILENCH=LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',PDP,IGRID,ILENCH,YCOMMENT,IRESP)
-!
-! stores the thermal production
-!
- YRECFM ='TP'
- YCOMMENT='X_Y_Z_TP (M**2/S**3)'
- IGRID = 1
- ILENCH=LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',PTP,IGRID,ILENCH,YCOMMENT,IRESP)
-!
-! stores the whole turbulent transport
-!
- YRECFM ='TR'
- YCOMMENT='X_Y_Z_TR (M**2/S**3)'
- IGRID = 1
- ILENCH=LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZTR,IGRID,ILENCH,YCOMMENT,IRESP)
-!
-! stores the dissipation of TKE
-!
- YRECFM ='DISS'
- YCOMMENT='X_Y_Z_DISS (M**2/S**3)'
- IGRID = 1
- ILENCH=LEN(YCOMMENT)
- ZFLX(:,:,:) =-XCED * (PTKEM(:,:,:)**1.5) / PLEPS(:,:,:)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZFLX,IGRID,ILENCH,YCOMMENT,IRESP)
-END IF
-!
-! Storage in the LES configuration of the Dynamic Production of TKE and
-! the dissipation of TKE
-!
-IF (LLES_CALL ) THEN
- ZFLX(:,:,:) =-XCED * (PTKEM(:,:,:)**1.5) / PLEPS(:,:,:)
- CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_DISS_Tke )
-END IF
-!
-!----------------------------------------------------------------------------
-!
-!
-!----------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('TKE_EPS_SOURCES',1,ZHOOK_HANDLE)
-END SUBROUTINE TKE_EPS_SOURCES
diff --git a/src/arome/turb/turb.F90 b/src/arome/turb/turb.F90
deleted file mode 100644
index 68fec59f897017987d8cc13e0546e88f392ca912..0000000000000000000000000000000000000000
--- a/src/arome/turb/turb.F90
+++ /dev/null
@@ -1,1579 +0,0 @@
-! ######spl
- SUBROUTINE TURB(KKA,KKU,KKL,KMI,KRR,KRRL,KRRI,HLBCX,HLBCY, &
- & KSPLIT,KMODEL_CL, &
- & OCLOSE_OUT,OTURB_FLX,OTURB_DIAG,OSUBG_COND,ORMC01, &
- & HTURBDIM,HTURBLEN,HTOM,HTURBLEN_CL,HINST_SFU, &
- & HMF_UPDRAFT,PIMPL,PTSTEP_UVW, PTSTEP_MET,PTSTEP_SV, &
- & HFMFILE,HLUOUT,PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
- & PDIRCOSXW,PDIRCOSYW,PDIRCOSZW,PCOSSLOPE,PSINSLOPE, &
- & PRHODJ,PTHVREF,PRHODREF, &
- & PSFTH,PSFRV,PSFSV,PSFU,PSFV, &
- & PPABSM,PUM,PVM,PWM,PTKEM,PSVM,PSRCM, &
- & PLENGTHM,PLENGTHH,MFMOIST, &
- & PBL_DEPTH,PSBL_DEPTH, &
- & PUT,PVT,PWT,PCEI,PCEI_MIN,PCEI_MAX,PCOEF_AMPL_SAT, &
- & PTHLM,PRM, &
- & PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS,PRTKES, &
- & PHGRAD, PSIGS, &
- & PDRUS_TURB,PDRVS_TURB, &
- & PDRTHLS_TURB,PDRRTS_TURB,PDRSVS_TURB, &
- & PFLXZTHVMF,PWTH,PWRC,PWSV,PDP,PTP,PTPMF,PTDIFF, &
- & PTDISS,PEDR,YDDDH,YDLDDH,YDMDDH)
-
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
- USE MODD_CTURB, ONLY : LHARAT
-! #################################################################
-!
-!
-!!**** *TURB* - computes the turbulent source terms for the prognostic
-!! variables.
-!!
-!! PURPOSE
-!! -------
-!!**** The purpose of this routine is to compute the source terms in
-!! the evolution equations due to the turbulent mixing.
-!! The source term is computed as the divergence of the turbulent fluxes.
-!! The cartesian fluxes are obtained by a one and a half order closure, based
-!! on a prognostic equation for the Turbulence Kinetic Energy( TKE ). The
-!! system is closed by prescribing a turbulent mixing length. Different
-!! choices are available for this length.
-!
-!!** METHOD
-!! ------
-!!
-!! The dimensionality of the turbulence parameterization can be chosen by
-!! means of the parameter HTURBDIM:
-!! * HTURBDIM='1DIM' the parameterization is 1D but can be used in
-!! 3D , 2D or 1D simulations. Only the sources associated to the vertical
-!! turbulent fluxes are taken into account.
-!! * HTURBDIM='3DIM' the parameterization is fully 2D or 3D depending
-!! on the model dimensionality. Of course, it does not make any sense to
-!! activate this option with a 1D model.
-!!
-!! The following steps are made:
-!! 1- Preliminary computations.
-!! 2- The metric coefficients are recovered from the grid knowledge.
-!! 3- The mixing length is computed according to its choice:
-!! * HTURBLEN='BL89' the Bougeault and Lacarrere algorithm is used.
-!! The mixing length is given by the vertical displacement from its
-!! original level of an air particule having an initial internal
-!! energy equal to its TKE and stopped by the buoyancy forces.
-!! The discrete formulation is second order accurate.
-!! * HTURBLEN='DELT' the mixing length is given by the mesh size
-!! depending on the model dimensionality, this length is limited
-!! with the ground distance.
-!! * HTURBLEN='DEAR' the mixing length is given by the mesh size
-!! depending on the model dimensionality, this length is limited
-!! with the ground distance and also by the Deardorff mixing length
-!! pertinent in the stable cases.
-!! * HTURBLEN='KEPS' the mixing length is deduced from the TKE
-!! dissipation, which becomes a prognostic variable of the model (
-!! Duynkerke formulation).
-!! 3'- The cloud mixing length is computed according to HTURBLEN_CLOUD
-!! and emphasized following the CEI index
-!! 4- The conservative variables are computed along with Lv/Cp.
-!! 5- The turbulent Prandtl numbers are computed from the resolved fields
-!! and TKE
-!! 6- The sources associated to the vertical turbulent fluxes are computed
-!! with a temporal scheme allowing a degree of implicitness given by
-!! PIMPL, varying from PIMPL=0. ( purely explicit scheme) to PIMPL=1.
-!! ( purely implicit scheme)
-!! The sources associated to the horizontal fluxes are computed with a
-!! purely explicit temporal scheme. These sources are only computed when
-!! the turbulence parameterization is 2D or 3D( HTURBDIM='3DIM' ).
-!! 7- The sources for TKE are computed, along with the dissipation of TKE
-!! if HTURBLEN='KEPS'.
-!! 8- Some turbulence-related quantities are stored in the synchronous
-!! FM-file.
-!! 9- The non-conservative variables are retrieved.
-!!
-!!
-!! The saving of the fields in the synchronous FM-file is controlled by:
-!! * OTURB_FLX => saves all the turbulent fluxes and correlations
-!! * OTURB_DIAG=> saves the turbulent Prandtl and Schmidt numbers, the
-!! source terms of TKE and dissipation of TKE
-!!
-!! EXTERNAL
-!! --------
-!! SUBROUTINE PRANDTL : computes the turbulent Prandtl number
-!! SUBROUTINE TURB_VER : computes the sources from the vertical fluxes
-!! SUBROUTINE TURB_HOR : computes the sources from the horizontal fluxes
-!! SUBROUTINE TKE_EPS_SOURCES : computes the sources for TKE and its
-!! dissipation
-!! SUBROUTINE BUDGET : computes and stores the budgets
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! MODD_PARAMETERS : JPVEXT_TURB number of marginal vertical points
-!!
-!! MODD_CONF : CCONF model configuration (start/restart)
-!! L1D switch for 1D model version
-!! L2D switch for 2D model version
-!!
-!! MODD_CST : contains physical constants
-!! XG gravity constant
-!! XRD Gas constant for dry air
-!! XRV Gas constant for vapor
-!!
-!! MODD_CTURB : contains turbulence scheme constants
-!! XCMFS,XCED to compute the dissipation mixing length
-!! XTKEMIN minimum values for the TKE
-!! XLINI,XLINF to compute Bougeault-Lacarrere mixing
-!! length
-!! Module MODD_BUDGET:
-!! NBUMOD
-!! CBUTYPE
-!! NBUPROCCTR
-!! LBU_RU
-!! LBU_RV
-!! LBU_RW
-!! LBU_RTH
-!! LBU_RSV1
-!! LBU_RRV
-!! LBU_RRC
-!! LBU_RRR
-!! LBU_RRI
-!! LBU_RRS
-!! LBU_RRG
-!! LBU_RRH
-!!
-!! REFERENCE
-!! ---------
-!! Book 2 of documentation (routine TURB)
-!! Book 1 of documentation (Chapter: Turbulence)
-!!
-!! AUTHOR
-!! ------
-!! Joan Cuxart * INM and Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 05/10/94
-!! Modifications: Feb 14, 1995 (J.Cuxart and J.Stein)
-!! Doctorization and Optimization
-!! Modifications: March 21, 1995 (J.M. Carriere)
-!! Introduction of cloud water
-!! Modifications: June 1, 1995 (J.Cuxart )
-!! take min(Kz,delta)
-!! Modifications: June 1, 1995 (J.Stein J.Cuxart)
-!! remove unnecessary arrays and change Prandtl
-!! and Schmidt numbers localizations
-!! Modifications: July 20, 1995 (J.Stein) remove MODI_ground_ocean +
-!! TZDTCUR + MODD_TIME because they are not used
-!! change RW in RNP for the outputs
-!! Modifications: August 21, 1995 (Ph. Bougeault)
-!! take min(K(z-zsol),delta)
-!! Modifications: Sept 14, 1995 (Ph Bougeault, J. Cuxart)
-!! second order BL89 mixing length computations + add Deardorff length
-!! in the Delta case for stable cases
-!! Modifications: Sept 19, 1995 (J. Stein, J. Cuxart)
-!! define a DEAR case for the mixing length, add MODI_BUDGET and change
-!! some BUDGET calls, add LES tools
-!! Modifications: Oct 16, 1995 (J. Stein) change the budget calls
-!! Modifications: Feb 28, 1996 (J. Stein) optimization +
-!! remove min(K(z-zsol),delta)+
-!! bug in the tangential fluxes
-!! Modifications: Oct 16, 1996 (J. Stein) change the subgrid condensation
-!! scheme + temporal discretization
-!! Modifications: Dec 19, 1996 (J.-P. Pinty) update the budget calls
-!! Jun 22, 1997 (J. Stein) use the absolute pressure and
-!! change the Deardorf length at the surface
-!! Modifications: Apr 27, 1997 (V. Masson) BL89 mix. length computed in
-!! a separate routine
-!! Oct 13, 1999 (J. Stein) switch for the tgt fluxes
-!! Jun 24, 1999 (P Jabouille) Add routine UPDATE_ROTATE_WIND
-!! Feb 15, 2001 (J. Stein) remove tgt fluxes
-!! Mar 8, 2001 (V. Masson) forces the same behaviour near the surface
-!! for all mixing lengths
-!! Nov 06, 2002 (V. Masson) LES budgets
-!! Nov, 2002 (V. Masson) implement modifications of
-!! mixing and dissipative lengths
-!! near the surface (according
-!! Redelsperger et al 2001)
-!! Apr, 2003 (V. Masson) bug in Blackadar length
-!! bug in LES in 1DIM case
-!! Feb 20, 2003 (J.-P. Pinty) Add reversible ice processes
-!! May,26 2004 (P Jabouille) coef for computing dissipative heating
-!! Sept 2004 (M.Tomasini) Cloud Mixing length modification
-!! following the instability
-!! criterium CEI calculated in modeln
-!! May 2006 Remove KEPS
-!! Sept.2006 (I.Sandu): Modification of the stability criterion for
-!! DEAR (theta_v -> theta_l)
-!! Oct 2007 (J.Pergaud) Add MF contribution for vert. turb. transport
-!! Oct.2009 (C.Lac) Introduction of different PTSTEP according to the
-!! advection schemes
-!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
-!! change of YCOMMENT
-!! 06/2011 (J.escobar ) Bypass Bug with ifort11/12 on HLBCX,HLBC
-!! 2012-02 Y. Seity, add possibility to run with reversed
-!! vertical levels
-!! 2014-11 Y. Seity, add output terms for TKE DDHs budgets
-!! July 2015 (Wim de Rooy) modifications to run with RACMO
-!! turbulence (LHARAT=TRUE)
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS
-USE MODD_CST
-USE MODD_CTURB
-USE MODD_CONF
-USE MODD_BUDGET
-USE MODD_LES
-USE MODD_NSV
-!
-USE MODI_BL89
-USE MODI_TURB_VER
-!!MODIF AROME
-!USE MODI_ROTATE_WIND
-!USE MODI_TURB_HOR_SPLT
-USE MODI_TKE_EPS_SOURCES
-USE MODI_SHUMAN, ONLY : MZF, MXF, MYF
-USE MODI_GRADIENT_M
-USE MODI_BUDGET_DDH
-USE MODI_LES_MEAN_SUBGRID
-USE MODI_RMC01
-USE MODI_GRADIENT_W
-USE MODI_TM06
-USE MODI_UPDATE_LM
-!
-USE MODE_SBL
-USE MODE_FMWRIT
-!
-USE MODI_EMOIST
-USE MODI_ETHETA
-!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-INTEGER, INTENT(IN) :: KMI ! model index number
-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.
-CHARACTER(LEN=*),DIMENSION(:),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-INTEGER, INTENT(IN) :: KSPLIT ! number of time-splitting
-INTEGER, INTENT(IN) :: KMODEL_CL ! model number for cloud mixing length
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
- ! diagnostic fields in the syncronous FM-file
-LOGICAL, INTENT(IN) :: OSUBG_COND ! switch for SUBGrid
- ! CONDensation
-LOGICAL, INTENT(IN) :: ORMC01 ! switch for RMC01 lengths in SBL
-CHARACTER(LEN=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-CHARACTER(LEN=4), INTENT(IN) :: HTURBLEN ! kind of mixing length
-CHARACTER(LEN=4), INTENT(IN) :: HTOM ! kind of Third Order Moment
-CHARACTER(LEN=4), INTENT(IN) :: HTURBLEN_CL ! kind of cloud mixing length
-CHARACTER(LEN=1), INTENT(IN) :: HINST_SFU ! temporal location of the
- ! surface friction flux
-REAL, INTENT(IN) :: PIMPL ! degree of implicitness
-REAL, INTENT(IN) :: PTSTEP_UVW ! Dynamical timestep
-REAL, INTENT(IN) :: PTSTEP_MET ! Timestep for meteorological variables
-REAL, INTENT(IN) :: PTSTEP_SV ! Timestep for tracer variables
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output
- ! FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-!
-CHARACTER(LEN=4), INTENT(IN) :: HMF_UPDRAFT ! Type of Mass Flux Scheme
-
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
- ! metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! physical distance
-! between 2 succesive grid points along the K direction
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW, PDIRCOSZW
-! Director Cosinus along x, y and z directions at surface w-point
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
- ! between i and the slope vector
-REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
- ! between i and the slope vector
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
-REAL, DIMENSION(:,:,:), INTENT(IN) :: MFMOIST ! moist mass flux dual scheme
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential
- ! Temperature of the reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! dry density of the
- ! reference state
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTH,PSFRV, &
-! normal surface fluxes of theta and Rv
- PSFU,PSFV
-! normal surface fluxes of (u,v) parallel to the orography
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSV
-! normal surface fluxes of Scalar var.
-!
-! prognostic variables at t- deltat
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM ! wind components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! passive scal. var.
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! Second-order flux
- ! s'rc'/2Sigma_s2 at time t-1 multiplied by Lambda_3
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PBL_DEPTH ! BL height for TOMS
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSBL_DEPTH ! SBL depth for RMC01
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT,PWT ! Wind at t
-! variables for cloud mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCEI ! Cloud Entrainment instability
- ! index to emphasize localy
- ! turbulent fluxes
-REAL, INTENT(IN) :: PCEI_MIN ! minimum threshold for the instability index CEI
-REAL, INTENT(IN) :: PCEI_MAX ! maximum threshold for the instability index CEI
-REAL, INTENT(IN) :: PCOEF_AMPL_SAT ! saturation of the amplification coefficient
-!
-! thermodynamical variables which are transformed in conservative var.
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHLM ! conservative pot. temp.
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRM ! water var. where
- ! PRM(:,:,:,1) is the conservative mixing ratio
-!
-! sources of momentum, conservative potential temperature, Turb. Kin. Energy,
-! TKE dissipation
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS,PRVS,PRWS,PRTHLS,PRTKES
-! Source terms for all water kinds, PRRS(:,:,:,1) is used for the conservative
-! mixing ratio
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
-! Source terms for all passive scalar variables
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
-! Sigma_s at time t+1 : square root of the variance of the deviation to the
-! saturation
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PHGRAD
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDRUS_TURB ! evolution of rhoJ*U by turbulence only
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDRVS_TURB ! evolution of rhoJ*V by turbulence only
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDRTHLS_TURB ! evolution of rhoJ*thl by turbulence only
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDRRTS_TURB ! evolution of rhoJ*rt by turbulence only
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PDRSVS_TURB ! evolution of rhoJ*Sv by turbulence only
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLXZTHVMF
-! MF contribution for vert. turb. transport
-! used in the buoy. prod. of TKE
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTH ! heat flux
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWRC ! cloud water flux
-REAL, DIMENSION(:,:,:,:),INTENT(OUT) :: PWSV ! scalar flux
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTP ! Thermal TKE production
- ! MassFlux + turb
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTPMF ! Thermal TKE production
- ! MassFlux Only
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDP ! Dynamic TKE production
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTDIFF ! Diffusion TKE term
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTDISS ! Dissipation TKE term
-
-
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEDR ! EDR
-
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-!
-! length scale from vdfexcu
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLENGTHM, PLENGTHH
-
-!
-!
-!-------------------------------------------------------------------------------
-!
-! 0.2 declaration of local variables
-!
-REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
- ZCP, & ! Cp at t-1
- ZEXN, & ! EXN at t-1
- ZT, & ! T at t-1
- ZLOCPEXNM, & ! Lv/Cp/EXNREF at t-1
- ZLM, & ! Turbulent mixing length
- ZLEPS, & ! Dissipative length
- ZTRH, & !
- ZATHETA,ZAMOIST, & ! coefficients for s = f (Thetal,Rnp)
- ZCOEF_DISS, & ! 1/(Cph*Exner) for dissipative heating
- ZFRAC_ICE, & ! ri fraction of rc+ri
- ZMWTH,ZMWR,ZMTH2,ZMR2,ZMTHR,& ! 3rd order moments
- ZFWTH,ZFWR,ZFTH2,ZFR2,ZFTHR,& ! opposite of verticale derivate of 3rd order moments
- ZTHLM ! initial potential temp.
-REAL, DIMENSION(SIZE(PRM,1),SIZE(PRM,2),SIZE(PRM,3),SIZE(PRM,4)) :: &
- ZRM ! initial mixing ratio
-REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2)) :: ZTAU11M,ZTAU12M, &
- ZTAU22M,ZTAU33M, &
- ! tangential surface fluxes in the axes following the orography
- ZUSLOPE,ZVSLOPE, &
- ! wind components at the first mass level parallel
- ! to the orography
- ZCDUEFF, &
- ! - Cd*||u|| where ||u|| is the module of the wind tangential to
- ! orography (ZUSLOPE,ZVSLOPE) at the surface.
- ZUSTAR, ZLMO, &
- ZRVM, ZSFRV
- ! friction velocity, Monin Obuhkov length, work arrays for vapor
-!
- ! Virtual Potential Temp. used
- ! in the Deardorff mixing length computation
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: &
- ZLVOCPEXNM,ZLSOCPEXNM, & ! Lv/Cp/EXNREF and Ls/Cp/EXNREF at t-1
- ZATHETA_ICE,ZAMOIST_ICE ! coefficients for s = f (Thetal,Rnp)
-!
-REAL :: ZEXPL ! 1-PIMPL deg of expl.
-REAL :: ZRVORD ! RV/RD
-!
-INTEGER :: IKB,IKE ! index value for the
-! Beginning and the End of the physical domain for the mass points
-INTEGER :: IKT ! array size in k direction
-INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
-INTEGER :: JRR,JK,JSV ! loop counters
-INTEGER :: JI,JJ ! loop counters
-INTEGER :: IRESP ! Return code of FM routines
-INTEGER :: IGRID ! C-grid indicator in LFIFM file
-INTEGER :: ILENCH ! Length of comment string in LFIFM file
-CHARACTER (LEN=100) :: YCOMMENT ! comment string in LFIFM file
-CHARACTER (LEN=16) :: YRECFM ! Name of the desired field in LFIFM file
-REAL :: ZL0 ! Max. Mixing Length in Blakadar formula
-REAL :: ZALPHA ! proportionnality constant between Dz/2 and
-! ! BL89 mixing length near the surface
-!
-REAL :: ZTIME1, ZTIME2
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)):: ZSHEAR, ZDUDZ, ZDVDZ
-!
-!* 1.PRELIMINARIES
-! -------------
-!
-!* 1.1 Set the internal domains, ZEXPL
-!
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK('TURB',0,ZHOOK_HANDLE)
-IF (LHARAT .AND. HTURBDIM /= '1DIM') THEN
- CALL ABOR1('LHARATU only implemented for option HTURBDIM=1DIM!')
-ENDIF
-IF (LHARAT .AND. LLES_CALL) THEN
- CALL ABOR1('LHARATU not implemented for option LLES_CALL')
-ENDIF
-
-
-IKT=SIZE(PTHLM,3)
-IKTB=1+JPVEXT_TURB
-IKTE=IKT-JPVEXT_TURB
-IKB=KKA+JPVEXT_TURB*KKL
-IKE=KKU-JPVEXT_TURB*KKL
-!
-ZEXPL = 1.- PIMPL
-ZRVORD= XRV / XRD
-!
-!
-ZTHLM(:,:,:) = PTHLM(:,:,:)
-ZRM(:,:,:,:) = PRM(:,:,:,:)
-!
-!
-!
-!----------------------------------------------------------------------------
-!
-!* 2. COMPUTE CONSERVATIVE VARIABLES AND RELATED QUANTITIES
-! -----------------------------------------------------
-!
-!* 2.1 Cph at t
-!
-ZCP=XCPD
-!
-IF (KRR > 0) ZCP(:,:,:) = ZCP(:,:,:) + XCPV * PRM(:,:,:,1)
-DO JRR = 2,1+KRRL ! loop on the liquid components
- ZCP(:,:,:) = ZCP(:,:,:) + XCL * PRM(:,:,:,JRR)
-END DO
-!
-DO JRR = 2+KRRL,1+KRRL+KRRI ! loop on the solid components
- ZCP(:,:,:) = ZCP(:,:,:) + XCI * PRM(:,:,:,JRR)
-END DO
-!
-!* 2.2 Exner function at t
-!
-ZEXN(:,:,:) = (PPABSM(:,:,:)/XP00) ** (XRD/XCPD)
-!
-!* 2.3 dissipative heating coeff a t
-!
-ZCOEF_DISS(:,:,:) = 1/(ZCP(:,:,:) * ZEXN(:,:,:))
-!
-!
-ZFRAC_ICE(:,:,:) = 0.0
-ZATHETA(:,:,:) = 0.0
-ZAMOIST(:,:,:) = 0.0
-!
-IF (KRRL >=1) THEN
-!
-!* 2.4 Temperature at t
-!
- ZT(:,:,:) = PTHLM(:,:,:) * ZEXN(:,:,:)
-!
-!* 2.5 Lv/Cph/Exn
-!
- IF ( KRRI >= 1 ) THEN
- ALLOCATE(ZLVOCPEXNM(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)))
- ALLOCATE(ZLSOCPEXNM(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)))
- ALLOCATE(ZAMOIST_ICE(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)))
- ALLOCATE(ZATHETA_ICE(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)))
-!
- CALL COMPUTE_FUNCTION_THERMO(XALPW,XBETAW,XGAMW,XLVTT,XCL,ZT,ZEXN,ZCP, &
- ZLVOCPEXNM,ZAMOIST,ZATHETA)
- CALL COMPUTE_FUNCTION_THERMO(XALPI,XBETAI,XGAMI,XLSTT,XCI,ZT,ZEXN,ZCP, &
- ZLSOCPEXNM,ZAMOIST_ICE,ZATHETA_ICE)
-!
- WHERE(PRM(:,:,:,2)+PRM(:,:,:,4)>0.0)
- ZFRAC_ICE(:,:,:) = PRM(:,:,:,4) / ( PRM(:,:,:,2)+PRM(:,:,:,4) )
- END WHERE
-!
- ZLOCPEXNM(:,:,:) = (1.0-ZFRAC_ICE(:,:,:))*ZLVOCPEXNM(:,:,:) &
- +ZFRAC_ICE(:,:,:) *ZLSOCPEXNM(:,:,:)
- ZAMOIST(:,:,:) = (1.0-ZFRAC_ICE(:,:,:))*ZAMOIST(:,:,:) &
- +ZFRAC_ICE(:,:,:) *ZAMOIST_ICE(:,:,:)
- ZATHETA(:,:,:) = (1.0-ZFRAC_ICE(:,:,:))*ZATHETA(:,:,:) &
- +ZFRAC_ICE(:,:,:) *ZATHETA_ICE(:,:,:)
-
- DEALLOCATE(ZAMOIST_ICE)
- DEALLOCATE(ZATHETA_ICE)
- ELSE
- CALL COMPUTE_FUNCTION_THERMO(XALPW,XBETAW,XGAMW,XLVTT,XCL,ZT,ZEXN,ZCP, &
- ZLOCPEXNM,ZAMOIST,ZATHETA)
- END IF
-!
-!
- IF (OCLOSE_OUT .AND. OTURB_DIAG) THEN
- YRECFM ='ATHETA'
- YCOMMENT='X_Y_Z_ATHETA (M)'
- IGRID = 1
- ILENCH=LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZATHETA,IGRID,ILENCH,YCOMMENT,IRESP)
-!
- YRECFM ='AMOIST'
- YCOMMENT='X_Y_Z_AMOIST (M)'
- IGRID = 1
- ILENCH=LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZAMOIST,IGRID,ILENCH,YCOMMENT,IRESP)
- END IF
-!
-ELSE
- ZLOCPEXNM=0.
-END IF ! loop end on KRRL >= 1
-!
-! computes conservative variables
-!
-IF ( KRRL >= 1 ) THEN
- IF ( KRRI >= 1 ) THEN
- ! Rnp at t-1
- PRM(:,:,:,1) = PRM(:,:,:,1) + PRM(:,:,:,2) + PRM(:,:,:,4)
- PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,2) + PRRS(:,:,:,4)
- ! Theta_l at t-1
- PTHLM(:,:,:) = PTHLM(:,:,:) - ZLVOCPEXNM(:,:,:) * PRM(:,:,:,2) &
- - ZLSOCPEXNM(:,:,:) * PRM(:,:,:,4)
- PRTHLS(:,:,:) = PRTHLS(:,:,:) - ZLVOCPEXNM(:,:,:) * PRRS(:,:,:,2) &
- - ZLSOCPEXNM(:,:,:) * PRRS(:,:,:,4)
- ELSE
- ! Rnp at t-1
- PRM(:,:,:,1) = PRM(:,:,:,1) + PRM(:,:,:,2)
- PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,2)
- ! Theta_l at t-1
- PTHLM(:,:,:) = PTHLM(:,:,:) - ZLOCPEXNM(:,:,:) * PRM(:,:,:,2)
- PRTHLS(:,:,:) = PRTHLS(:,:,:) - ZLOCPEXNM(:,:,:) * PRRS(:,:,:,2)
- END IF
-END IF
-!
-!* stores value of conservative variables & wind before turbulence tendency
-PDRUS_TURB = PRUS
-PDRVS_TURB = PRVS
-PDRTHLS_TURB = PRTHLS
-PDRRTS_TURB = PRRS(:,:,:,1)
-PDRSVS_TURB = PRSVS
-!----------------------------------------------------------------------------
-!
-!* 3. MIXING LENGTH : SELECTION AND COMPUTATION
-! -----------------------------------------
-!
-!
-IF (.NOT. LHARAT) THEN
-
-SELECT CASE (HTURBLEN)
-!
-!* 3.1 BL89 mixing length
-! ------------------
-
- CASE ('BL89')
- ZSHEAR=0.
- CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKEM,ZSHEAR,ZLM)
-!
-!* 3.2 Delta mixing length
-! -------------------
-!
- CASE ('DELT')
- CALL DELT(ZLM)
-!
-!* 3.3 Deardorff mixing length
-! -----------------------
-!
- CASE ('DEAR')
- CALL DEAR(ZLM)
-!
-!* 3.4 Blackadar mixing length
-! -----------------------
-!
- CASE ('BLKR')
- ZL0 = 100.
- ZLM(:,:,:) = ZL0
-
- ZALPHA=0.5**(-1.5)
- !
- DO JK=IKTB,IKTE
- ZLM(:,:,JK) = ( 0.5*(PZZ(:,:,JK)+PZZ(:,:,JK+KKL)) - &
- & PZZ(:,:,KKA+JPVEXT_TURB*KKL) ) * PDIRCOSZW(:,:)
- ZLM(:,:,JK) = ZALPHA * ZLM(:,:,JK) * ZL0 / ( ZL0 + ZALPHA*ZLM(:,:,JK) )
- END DO
-!
- ZLM(:,:,IKTB-1) = ZLM(:,:,IKTB)
- ZLM(:,:,IKTE+1) = ZLM(:,:,IKTE)
-!
-!
-!
-END SELECT
-!
-!* 3.5 Mixing length modification for cloud
-! -----------------------
-IF (KMODEL_CL==KMI .AND. HTURBLEN_CL/='NONE' ) CALL CLOUD_MODIF_LM
-ENDIF !
-
-!
-!
-
-!
-!* 3.6 Dissipative length
-! ------------------
-
-IF (LHARAT) THEN
-ZLEPS=PLENGTHM*(3.75**2.)
-ELSE
-ZLEPS=ZLM
-ENDIF
-!
-!* 3.7 Correction in the Surface Boundary Layer (Redelsperger 2001)
-! ----------------------------------------
-!
-ZLMO=XUNDEF
- IF (ORMC01) THEN
- ZUSTAR=(PSFU**2+PSFV**2)**(0.25)
- IF (KRR>0) THEN
- ZLMO=LMO(ZUSTAR,ZTHLM(:,:,IKB),ZRM(:,:,IKB,1),PSFTH,PSFRV)
- ELSE
- ZRVM=0.
- ZSFRV=0.
- ZLMO=LMO(ZUSTAR,ZTHLM(:,:,IKB),ZRVM,PSFTH,ZSFRV)
- END IF
- CALL RMC01(HTURBLEN,KKA,KKU,KKL,PZZ,PDXX,PDYY,PDZZ,PDIRCOSZW,PSBL_DEPTH,ZLMO,ZLM,ZLEPS)
- END IF
-!
-!* 3.8 Mixing length in external points (used if HTURBDIM="3DIM")
-! ----------------------------------------------------------
-!
-IF (HTURBDIM=="3DIM") THEN
-!****FOR AROME****
-! CALL UPDATE_LM(HLBCX,HLBCY,ZLM,ZLEPS)
-END IF
-!----------------------------------------------------------------------------
-!
-!* 4. GO INTO THE AXES FOLLOWING THE SURFACE
-! --------------------------------------
-!
-!
-!* 4.1 rotate the wind at time t
-!
-IF ( HINST_SFU == 'T' ) THEN
-!
-!
- IF (CPROGRAM=='AROME ') THEN
- ZUSLOPE=PUM(:,:,KKA)
- ZVSLOPE=PVM(:,:,KKA)
- ELSE
-! CALL ROTATE_WIND(PUT,PVT,PWT, &
-! PDIRCOSXW, PDIRCOSYW, PDIRCOSZW, &
-! PCOSSLOPE,PSINSLOPE, &
-! PDXX,PDYY,PDZZ, &
-! ZUSLOPE,ZVSLOPE )
-!
-! CALL UPDATE_ROTATE_WIND(ZUSLOPE,ZVSLOPE)
- END IF
-!
-!
-!* 4.2 compute the proportionality coefficient between wind and stress
-!
- ZCDUEFF(:,:) =-SQRT ( (PSFU(:,:)**2 + PSFV(:,:)**2) / &
- (1.E-60 + ZUSLOPE(:,:)**2 + ZVSLOPE(:,:)**2 ) &
- )
-!
-!* 4.3 rotate the wind at time t-delta t
-!
- IF (CPROGRAM/='AROME ') THEN
-! CALL ROTATE_WIND(PUM,PVM,PWM, &
-! PDIRCOSXW, PDIRCOSYW, PDIRCOSZW, &
-! PCOSSLOPE,PSINSLOPE, &
-! PDXX,PDYY,PDZZ, &
-! ZUSLOPE,ZVSLOPE )
-!
-! CALL UPDATE_ROTATE_WIND(ZUSLOPE,ZVSLOPE)
- END IF
-!
-ELSE
-!
-!* 4.4 rotate the wind at time t-delta t
-!
- IF (CPROGRAM=='AROME ') THEN
- ZUSLOPE=PUM(:,:,KKA)
- ZVSLOPE=PVM(:,:,KKA)
- ELSE
-!
-! CALL ROTATE_WIND(PUM,PVM,PWM, &
-! PDIRCOSXW, PDIRCOSYW, PDIRCOSZW, &
-! PCOSSLOPE,PSINSLOPE, &
-! PDXX,PDYY,PDZZ, &
-! ZUSLOPE,ZVSLOPE )
-!
-! CALL UPDATE_ROTATE_WIND(ZUSLOPE,ZVSLOPE)
- END IF
-!
-!* 4.5 compute the proportionality coefficient between wind and stress
-!
- ZCDUEFF(:,:) =-SQRT ( (PSFU(:,:)**2 + PSFV(:,:)**2) / &
- (1.E-60 + ZUSLOPE(:,:)**2 + ZVSLOPE(:,:)**2 ) &
- )
-END IF
-!
-!* 4.6 compute the surface tangential fluxes
-!
-ZTAU11M(:,:) =2./3.*( (1.+ (PZZ (:,:,IKB+KKL)-PZZ (:,:,IKB)) &
- /(PDZZ(:,:,IKB+KKL)+PDZZ(:,:,IKB)) &
- ) *PTKEM(:,:,IKB) &
- -0.5 *PTKEM(:,:,IKB+KKL) &
- )
-ZTAU12M(:,:) =0.0
-ZTAU22M(:,:) =ZTAU11M(:,:)
-ZTAU33M(:,:) =ZTAU11M(:,:)
-!
-!* 4.7 third order terms in temperature and water fluxes and correlations
-! ------------------------------------------------------------------
-!
-!
-ZMWTH = 0. ! w'2th'
-ZMWR = 0. ! w'2r'
-ZMTH2 = 0. ! w'th'2
-ZMR2 = 0. ! w'r'2
-ZMTHR = 0. ! w'th'r'
-
-IF (HTOM=='TM06') CALL TM06(KKA,KKU,KKL,PTHVREF,PBL_DEPTH,PZZ,PSFTH,ZMWTH,ZMTH2)
-!
-ZFWTH = -GZ_M_W(ZMWTH,PDZZ, KKA, KKU, KKL) ! -d(w'2th' )/dz
-ZFWR = -GZ_M_W(ZMWR, PDZZ, KKA, KKU, KKL) ! -d(w'2r' )/dz
-ZFTH2 = -GZ_W_M(ZMTH2,PDZZ, KKA, KKU, KKL) ! -d(w'th'2 )/dz
-ZFR2 = -GZ_W_M(ZMR2, PDZZ, KKA, KKU, KKL) ! -d(w'r'2 )/dz
-ZFTHR = -GZ_W_M(ZMTHR,PDZZ, KKA, KKU, KKL) ! -d(w'th'r')/dz
-!
-ZFWTH(:,:,IKTE:) = 0.
-ZFWTH(:,:,:IKTB) = 0.
-ZFWR (:,:,IKTE:) = 0.
-ZFWR (:,:,:IKTB) = 0.
-ZFTH2(:,:,IKTE:) = 0.
-ZFTH2(:,:,:IKTB) = 0.
-ZFR2 (:,:,IKTE:) = 0.
-ZFR2 (:,:,:IKTB) = 0.
-ZFTHR(:,:,IKTE:) = 0.
-ZFTHR(:,:,:IKTB) = 0.
-!
-!----------------------------------------------------------------------------
-!
-!* 5. TURBULENT SOURCES
-! -----------------
-!
-CALL TURB_VER(KKA,KKU,KKL,KRR, KRRL, KRRI, &
- OCLOSE_OUT,OTURB_FLX, &
- HTURBDIM,HTOM,PIMPL,ZEXPL, &
- PTSTEP_UVW, PTSTEP_MET, PTSTEP_SV, &
- HFMFILE,HLUOUT, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
- PCOSSLOPE,PSINSLOPE, &
- PRHODJ,PTHVREF, &
- PSFTH,PSFRV,PSFSV,PSFTH,PSFRV,PSFSV, &
- ZCDUEFF,ZTAU11M,ZTAU12M,ZTAU33M, &
- PUM,PVM,PWM,ZUSLOPE,ZVSLOPE,PTHLM,PRM,PSVM, &
- PTKEM,ZLM,PLENGTHM,PLENGTHH,ZLEPS,MFMOIST, &
- ZLOCPEXNM,ZATHETA,ZAMOIST,PSRCM,ZFRAC_ICE, &
- ZFWTH,ZFWR,ZFTH2,ZFR2,ZFTHR,PBL_DEPTH, &
- PSBL_DEPTH,ZLMO, &
- PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS, &
- PDP,PTP,PSIGS,PWTH,PWRC,PWSV )
-!
-
-IF (LBUDGET_U) CALL BUDGET_DDH (PRUS,1,'VTURB_BU_RU',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_V) CALL BUDGET_DDH (PRVS,2,'VTURB_BU_RV',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_W) CALL BUDGET_DDH (PRWS,3,'VTURB_BU_RW',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_TH) THEN
- IF ( KRRI >= 1 .AND. KRRL >= 1 ) THEN
- CALL BUDGET_DDH (PRTHLS+ ZLVOCPEXNM * PRRS(:,:,:,2) + ZLSOCPEXNM * PRRS(:,:,:,4),4,'VTURB_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- ELSE IF ( KRRL >= 1 ) THEN
- CALL BUDGET_DDH (PRTHLS+ ZLOCPEXNM * PRRS(:,:,:,2),4,'VTURB_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- ELSE
- CALL BUDGET_DDH (PRTHLS,4,'VTURB_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- END IF
-END IF
-IF (LBUDGET_SV) THEN
- DO JSV = 1,NSV
- CALL BUDGET_DDH (PRSVS(:,:,:,JSV),JSV+12,'VTURB_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END DO
-END IF
-IF (LBUDGET_RV) THEN
- IF ( KRRI >= 1 .AND. KRRL >= 1) THEN
- CALL BUDGET_DDH (PRRS(:,:,:,1)-PRRS(:,:,:,2)-PRRS(:,:,:,4),6,'VTURB_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- ELSE IF ( KRRL >= 1 ) THEN
- CALL BUDGET_DDH (PRRS(:,:,:,1)-PRRS(:,:,:,2),6,'VTURB_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- ELSE
- CALL BUDGET_DDH (PRRS(:,:,:,1),6,'VTURB_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- END IF
-END IF
-IF (LBUDGET_RC) CALL BUDGET_DDH (PRRS(:,:,:,2),7,'VTURB_BU_RRC',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_RI) CALL BUDGET_DDH (PRRS(:,:,:,4),9,'VTURB_BU_RRI',YDDDH, YDLDDH, YDMDDH)
-!
-!
-IF (HTURBDIM=='3DIM') THEN
-!!!!MODIF AROME
-! CALL TURB_HOR_SPLT(KSPLIT, KRR, KRRL, KRRI, PTSTEP_UVW, &
-! PTSTEP_MET, PTSTEP_SV, HLBCX,HLBCY, &
-! OCLOSE_OUT,OTURB_FLX,OSUBG_COND, &
-! HFMFILE,HLUOUT, &
-! PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
-! PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
-! PCOSSLOPE,PSINSLOPE, &
-! PRHODJ,PTHVREF, &
-! PSFTH,PSFRV,PSFSV, &
-! ZCDUEFF,ZTAU11M,ZTAU12M,ZTAU22M,ZTAU33M, &
-! PUM,PVM,PWM,ZUSLOPE,ZVSLOPE,PTHLM,PRM,PSVM, &
-! PTKEM,ZLM,ZLEPS, &
-! ZLOCPEXNM,ZATHETA,ZAMOIST,PSRCM,ZFRAC_ICE, &
-! ZDP,ZTP,PSIGS, &
-! PHGRAD, &
-! ZTRH, &
-! PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS )
-END IF
-!
-!
-IF (LBUDGET_U) CALL BUDGET_DDH (PRUS,1,'HTURB_BU_RU',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_V) CALL BUDGET_DDH (PRVS,2,'HTURB_BU_RV',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_W) CALL BUDGET_DDH (PRWS,3,'HTURB_BU_RW',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_TH) THEN
- IF ( KRRI >= 1 .AND. KRRL >= 1 ) THEN
- CALL BUDGET_DDH (PRTHLS+ ZLVOCPEXNM * PRRS(:,:,:,2) + ZLSOCPEXNM * PRRS(:,:,:,4),4,'HTURB_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- ELSE IF ( KRRL >= 1 ) THEN
- CALL BUDGET_DDH (PRTHLS+ ZLOCPEXNM * PRRS(:,:,:,2),4,'HTURB_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- ELSE
- CALL BUDGET_DDH (PRTHLS,4,'HTURB_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- END IF
-END IF
-IF (LBUDGET_SV) THEN
- DO JSV = 1,NSV
- CALL BUDGET_DDH (PRSVS(:,:,:,JSV),JSV+12,'HTURB_BU_RSV',YDDDH, YDLDDH, YDMDDH)
- END DO
-END IF
-IF (LBUDGET_RV) THEN
- IF ( KRRI >= 1 .AND. KRRL >= 1) THEN
- CALL BUDGET_DDH (PRRS(:,:,:,1)-PRRS(:,:,:,2)-PRRS(:,:,:,4),6,'HTURB_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- ELSE IF ( KRRL >= 1 ) THEN
- CALL BUDGET_DDH (PRRS(:,:,:,1)-PRRS(:,:,:,2),6,'HTURB_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- ELSE
- CALL BUDGET_DDH (PRRS(:,:,:,1),6,'HTURB_BU_RRV',YDDDH, YDLDDH, YDMDDH)
- END IF
-END IF
-IF (LBUDGET_RC) CALL BUDGET_DDH (PRRS(:,:,:,2),7,'HTURB_BU_RRC',YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_RI) CALL BUDGET_DDH (PRRS(:,:,:,4),9,'HTURB_BU_RRI',YDDDH, YDLDDH, YDMDDH)
-!
-!----------------------------------------------------------------------------
-!
-!* 6. EVOLUTION OF THE TKE AND ITS DISSIPATION
-! ----------------------------------------
-!
-! 6.1 Contribution of mass-flux in the TKE buoyancy production if
-! cloud computation is not statistical
-
- PTP = PTP + XG / PTHVREF * MZF(PFLXZTHVMF,KKA, KKU, KKL)
- PTPMF=XG / PTHVREF * MZF(PFLXZTHVMF, KKA, KKU, KKL)
-
-! 6.2 TKE evolution equation
-
-IF (.NOT. LHARAT) THEN
-
-
-CALL TKE_EPS_SOURCES(KKA,KKU,KKL,KMI,PTKEM,ZLM,ZLEPS,PDP,ZTRH, &
- & PRHODJ,PDZZ,PDXX,PDYY,PDZX,PDZY,PZZ, &
- & PTSTEP_MET,PIMPL,ZEXPL, &
- & HTURBLEN,HTURBDIM, &
- & HFMFILE,HLUOUT,OCLOSE_OUT,OTURB_DIAG, &
- & PTP,PRTKES,PRTHLS,ZCOEF_DISS,PTDIFF, &
- & PTDISS,PEDR,YDDDH, YDLDDH, YDMDDH)
-IF (LBUDGET_TH) THEN
- IF ( KRRI >= 1 .AND. KRRL >= 1 ) THEN
- CALL BUDGET_DDH (PRTHLS+ ZLVOCPEXNM * PRRS(:,:,:,2) + ZLSOCPEXNM * PRRS(:,:,:,4),4,'DISSH_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- ELSE IF ( KRRL >= 1 ) THEN
- CALL BUDGET_DDH (PRTHLS+ ZLOCPEXNM * PRRS(:,:,:,2),4,'DISSH_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- ELSE
- CALL BUDGET_DDH (PRTHLS,4,'DISSH_BU_RTH',YDDDH, YDLDDH, YDMDDH)
- END IF
-END IF
-
-ENDIF
-!
-!----------------------------------------------------------------------------
-!
-!* 7. STORES SOME INFORMATIONS RELATED TO THE TURBULENCE SCHEME
-! ---------------------------------------------------------
-!
-IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
- YCOMMENT=' '
-!
-! stores the mixing length
-!
- YRECFM ='LM'
- YCOMMENT='X_Y_Z_LM (M)'
- IGRID = 1
- ILENCH=LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZLM,IGRID,ILENCH,YCOMMENT,IRESP)
-!
- IF (KRR /= 0) THEN
-!
-! stores the conservative potential temperature
-!
- YRECFM ='THLM'
- YCOMMENT='X_Y_Z_THLM (KELVIN)'
- IGRID = 1
- ILENCH=LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',PTHLM,IGRID,ILENCH,YCOMMENT,IRESP)
-!
-! stores the conservative mixing ratio
-!
- YRECFM ='RNPM'
- YCOMMENT='X_Y_Z_RNPM (KG/KG)'
- IGRID = 1
- ILENCH=LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',PRM(:,:,:,1),IGRID,ILENCH, &
- YCOMMENT,IRESP)
- END IF
-END IF
-!
-!* stores value of conservative variables & wind before turbulence tendency
-PDRUS_TURB = PRUS - PDRUS_TURB
-PDRVS_TURB = PRVS - PDRVS_TURB
-PDRTHLS_TURB = PRTHLS - PDRTHLS_TURB
-PDRRTS_TURB = PRRS(:,:,:,1) - PDRRTS_TURB
-PDRSVS_TURB = PRSVS - PDRSVS_TURB
-!----------------------------------------------------------------------------
-!
-!* 8. RETRIEVE NON-CONSERVATIVE VARIABLES
-! -----------------------------------
-!
-IF ( KRRL >= 1 ) THEN
- IF ( KRRI >= 1 ) THEN
- PRM(:,:,:,1) = PRM(:,:,:,1) - PRM(:,:,:,2) - PRM(:,:,:,4)
- PRRS(:,:,:,1) = PRRS(:,:,:,1) - PRRS(:,:,:,2) - PRRS(:,:,:,4)
- PTHLM(:,:,:) = PTHLM(:,:,:) + ZLVOCPEXNM(:,:,:) * PRM(:,:,:,2) &
- + ZLSOCPEXNM(:,:,:) * PRM(:,:,:,4)
- PRTHLS(:,:,:) = PRTHLS(:,:,:) + ZLVOCPEXNM(:,:,:) * PRRS(:,:,:,2) &
- + ZLSOCPEXNM(:,:,:) * PRRS(:,:,:,4)
-!
- DEALLOCATE(ZLVOCPEXNM)
- DEALLOCATE(ZLSOCPEXNM)
- ELSE
- PRM(:,:,:,1) = PRM(:,:,:,1) - PRM(:,:,:,2)
- PRRS(:,:,:,1) = PRRS(:,:,:,1) - PRRS(:,:,:,2)
- PTHLM(:,:,:) = PTHLM(:,:,:) + ZLOCPEXNM(:,:,:) * PRM(:,:,:,2)
- PRTHLS(:,:,:) = PRTHLS(:,:,:) + ZLOCPEXNM(:,:,:) * PRRS(:,:,:,2)
- END IF
-END IF
-!
-!----------------------------------------------------------------------------
-!
-!* 9. LES averaged surface fluxes
-! ---------------------------
-!
-IF (LLES_CALL) THEN
- CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID(PSFTH,X_LES_Q0)
- CALL LES_MEAN_SUBGRID(PSFRV,X_LES_E0)
- DO JSV=1,NSV
- CALL LES_MEAN_SUBGRID(PSFSV(:,:,JSV),X_LES_SV0(:,JSV))
- END DO
- CALL LES_MEAN_SUBGRID(PSFU,X_LES_UW0)
- CALL LES_MEAN_SUBGRID(PSFV,X_LES_VW0)
- CALL LES_MEAN_SUBGRID((PSFU*PSFU+PSFV*PSFV)**0.25,X_LES_USTAR)
-!----------------------------------------------------------------------------
-!
-!* 10. LES for 3rd order moments
-! -------------------------
-!
- CALL LES_MEAN_SUBGRID(ZMWTH,X_LES_SUBGRID_W2Thl)
- CALL LES_MEAN_SUBGRID(ZMTH2,X_LES_SUBGRID_WThl2)
- IF (KRR>0) THEN
- CALL LES_MEAN_SUBGRID(ZMWR,X_LES_SUBGRID_W2Rt)
- CALL LES_MEAN_SUBGRID(ZMTHR,X_LES_SUBGRID_WThlRt)
- CALL LES_MEAN_SUBGRID(ZMR2,X_LES_SUBGRID_WRt2)
- END IF
-!
-!----------------------------------------------------------------------------
-!
-!* 11. LES quantities depending on <w'2> in "1DIM" mode
-! ------------------------------------------------
-!
- IF (HTURBDIM=="1DIM") THEN
- CALL LES_MEAN_SUBGRID(2./3.*PTKEM,X_LES_SUBGRID_U2)
- CALL LES_MEAN_SUBGRID(2./3.*PTKEM,X_LES_SUBGRID_V2)
- CALL LES_MEAN_SUBGRID(2./3.*PTKEM,X_LES_SUBGRID_W2)
- CALL LES_MEAN_SUBGRID(2./3.*PTKEM*MZF(GZ_M_W(PTHLM,PDZZ, KKA, KKU, KKL),&
- KKA, KKU, KKL),X_LES_RES_ddz_Thl_SBG_W2)
- IF (KRR>=1) &
- CALL LES_MEAN_SUBGRID(2./3.*PTKEM*MZF(GZ_M_W(PRM(:,:,:,1),PDZZ, KKA, KKU, KKL),&
- &KKA, KKU, KKL),X_LES_RES_ddz_Rt_SBG_W2)
- DO JSV=1,NSV
- CALL LES_MEAN_SUBGRID(2./3.*PTKEM*MZF(GZ_M_W(PSVM(:,:,:,JSV),PDZZ, KKA, KKU, KKL), &
- &KKA, KKU, KKL), X_LES_RES_ddz_Sv_SBG_W2(:,:,:,JSV))
- END DO
- END IF
-
-!----------------------------------------------------------------------------
-!
-!* 12. LES mixing end dissipative lengths, presso-correlations
-! -------------------------------------------------------
-!
- CALL LES_MEAN_SUBGRID(ZLM,X_LES_SUBGRID_LMix)
- CALL LES_MEAN_SUBGRID(ZLEPS,X_LES_SUBGRID_LDiss)
-!
-!* presso-correlations for subgrid Tke are equal to zero.
-!
- ZLM = 0.
- CALL LES_MEAN_SUBGRID(ZLM,X_LES_SUBGRID_WP)
-!
- CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
-END IF
-!
-!----------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('TURB',1,ZHOOK_HANDLE)
-CONTAINS
-!
-!
-! ##############################################
- SUBROUTINE UPDATE_ROTATE_WIND(PUSLOPE,PVSLOPE)
-! ##############################################
-!!
-!!**** *UPDATE_ROTATE_WIND* routine to set rotate wind values at the border
-!
-!! AUTHOR
-!! ------
-!!
-!! P Jabouille *CNRM METEO-FRANCE
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 24/06/99
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!USE MODE_ll
-!USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-USE MODD_CONF
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PUSLOPE,PVSLOPE
-! tangential surface fluxes in the axes following the orography
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: IIB,IIE,IJB,IJE ! index values for the physical subdomain
-!TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
-!INTEGER :: IINFO_ll ! return code of parallel routine
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK('TURB:UPDATE_ROTATE_WIND',0,ZHOOK_HANDLE)
-!
-!* 1 PROLOGUE
-!
-!NULLIFY(TZFIELDS_ll)
-!
-!CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-!
-! 2 Update halo if necessary
-!
-!IF (NHALO == 1) THEN
-! CALL ADD2DFIELD_ll(TZFIELDS_ll,PUSLOPE)
-! CALL ADD2DFIELD_ll(TZFIELDS_ll,PVSLOPE)
-! CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
-! CALL CLEANLIST_ll(TZFIELDS_ll)
-!ENDIF
-!
-! 3 Boundary conditions for non cyclic case
-!
-!IF ( HLBCX(1) /= "CYCL" .AND. LWEST_ll()) THEN
-! PUSLOPE(IIB-1,:)=PUSLOPE(IIB,:)
-! PVSLOPE(IIB-1,:)=PVSLOPE(IIB,:)
-!END IF
-!IF ( HLBCX(2) /= "CYCL" .AND. LEAST_ll()) THEN
-! PUSLOPE(IIE+1,:)=PUSLOPE(IIE,:)
-! PVSLOPE(IIE+1,:)=PVSLOPE(IIE,:)
-!END IF
-!IF ( HLBCY(1) /= "CYCL" .AND. LSOUTH_ll()) THEN
-! PUSLOPE(:,IJB-1)=PUSLOPE(:,IJB)
-! PVSLOPE(:,IJB-1)=PVSLOPE(:,IJB)
-!END IF
-!IF( HLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
-! PUSLOPE(:,IJE+1)=PUSLOPE(:,IJE)
-! PVSLOPE(:,IJE+1)=PVSLOPE(:,IJE)
-!END IF
-!
-IF (LHOOK) CALL DR_HOOK('TURB:UPDATE_ROTATE_WIND',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE UPDATE_ROTATE_WIND
-!
-! ########################################################################
- SUBROUTINE COMPUTE_FUNCTION_THERMO(PALP,PBETA,PGAM,PLTT,PC,PT,PEXN,PCP,&
- PLOCPEXN,PAMOIST,PATHETA )
-! ########################################################################
-!!
-!!**** *COMPUTE_FUNCTION_THERMO* routine to compute several thermo functions
-!
-!! AUTHOR
-!! ------
-!!
-!! JP Pinty *LA*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 24/02/03
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-USE MODD_CST
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments
-!
-REAL :: PALP,PBETA,PGAM,PLTT,PC
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PT,PEXN,PCP
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLOCPEXN
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PAMOIST,PATHETA
-!
-!* 0.2 Declarations of local variables
-!
-REAL :: ZEPS ! XMV / XMD
-REAL, DIMENSION(SIZE(PEXN,1),SIZE(PEXN,2),SIZE(PEXN,3)) :: ZRVSAT
-REAL, DIMENSION(SIZE(PEXN,1),SIZE(PEXN,2),SIZE(PEXN,3)) :: ZDRVSATDT
-!
-!-------------------------------------------------------------------------------
-!
- REAL(KIND=JPRB) :: ZHOOK_HANDLE
- IF (LHOOK) CALL DR_HOOK('TURB:COMPUTE_FUNCTION_THERMO',0,ZHOOK_HANDLE)
- ZEPS = XMV / XMD
-!
-!* 1.1 Lv/Cph at t
-!
- PLOCPEXN(:,:,:) = ( PLTT + (XCPV-PC) * (PT(:,:,:)-XTT) ) / PCP(:,:,:)
-!
-!* 1.2 Saturation vapor pressure at t
-!
- ZRVSAT(:,:,:) = EXP( PALP - PBETA/PT(:,:,:) - PGAM*ALOG( PT(:,:,:) ) )
-!
-!* 1.3 saturation mixing ratio at t
-!
- ZRVSAT(:,:,:) = ZRVSAT(:,:,:) * ZEPS / ( PPABSM(:,:,:) - ZRVSAT(:,:,:) )
-!
-!* 1.4 compute the saturation mixing ratio derivative (rvs')
-!
- ZDRVSATDT(:,:,:) = ( PBETA / PT(:,:,:) - PGAM ) / PT(:,:,:) &
- * ZRVSAT(:,:,:) * ( 1. + ZRVSAT(:,:,:) / ZEPS )
-!
-!* 1.5 compute Amoist
-!
- PAMOIST(:,:,:)= 0.5 / ( 1.0 + ZDRVSATDT(:,:,:) * PLOCPEXN(:,:,:) )
-!
-!* 1.6 compute Atheta
-!
- PATHETA(:,:,:)= PAMOIST(:,:,:) * PEXN(:,:,:) * &
- ( ( ZRVSAT(:,:,:) - PRM(:,:,:,1) ) * PLOCPEXN(:,:,:) / &
- ( 1. + ZDRVSATDT(:,:,:) * PLOCPEXN(:,:,:) ) * &
- ( &
- ZRVSAT(:,:,:) * (1. + ZRVSAT(:,:,:)/ZEPS) &
- * ( -2.*PBETA/PT(:,:,:) + PGAM ) / PT(:,:,:)**2 &
- +ZDRVSATDT(:,:,:) * (1. + 2. * ZRVSAT(:,:,:)/ZEPS) &
- * ( PBETA/PT(:,:,:) - PGAM ) / PT(:,:,:) &
- ) &
- - ZDRVSATDT(:,:,:) &
- )
-!
-!* 1.7 Lv/Cph/Exner at t-1
-!
- PLOCPEXN(:,:,:) = PLOCPEXN(:,:,:) / PEXN(:,:,:)
-!
-IF (LHOOK) CALL DR_HOOK('TURB:COMPUTE_FUNCTION_THERMO',1,ZHOOK_HANDLE)
-END SUBROUTINE COMPUTE_FUNCTION_THERMO
-!
-! ####################
- SUBROUTINE DELT(PLM)
-! ####################
-!!
-!!**** *DELT* routine to compute mixing length for DELT case
-!
-!! AUTHOR
-!! ------
-!!
-!! M Tomasini *Meteo-France
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/05
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!* 0.1 Declarations of dummy arguments
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLM
-!
-!* 0.2 Declarations of local variables
-!
-REAL :: ZD ! distance to the surface
-!
-!-------------------------------------------------------------------------------
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK('TURB:DELT',0,ZHOOK_HANDLE)
-DO JK = IKTB,IKTE ! 1D turbulence scheme
- PLM(:,:,JK) = PZZ(:,:,JK+KKL) - PZZ(:,:,JK)
-END DO
-PLM(:,:,KKU) = PLM(:,:,IKE)
-PLM(:,:,KKA) = PZZ(:,:,IKB) - PZZ(:,:,KKA)
-IF ( HTURBDIM /= '1DIM' ) THEN ! 3D turbulence scheme
- IF ( L2D) THEN
- PLM(:,:,:) = SQRT( PLM(:,:,:)*MXF(PDXX(:,:,:)) )
- ELSE
- PLM(:,:,:) = (PLM(:,:,:)*MXF(PDXX(:,:,:))*MYF(PDYY(:,:,:)) ) ** (1./3.)
- END IF
-END IF
-!
-! mixing length limited by the distance normal to the surface
-! (with the same factor as for BL89)
-!
-IF (.NOT. ORMC01) THEN
- ZALPHA=0.5**(-1.5)
- !
- DO JJ=1,SIZE(PUM,2)
- DO JI=1,SIZE(PUM,1)
- DO JK=IKTB,IKTE
- ZD=ZALPHA*(0.5*(PZZ(JI,JJ,JK)+PZZ(JI,JJ,JK+KKL))&
- -PZZ(JI,JJ,IKB)) *PDIRCOSZW(JI,JJ)
- IF ( PLM(JI,JJ,JK)>ZD) THEN
- PLM(JI,JJ,JK)=ZD
- ELSE
- EXIT
- ENDIF
- END DO
- END DO
- END DO
-END IF
-!
-PLM(:,:,KKA) = PLM(:,:,IKB )
-PLM(:,:,KKU ) = PLM(:,:,IKE)
-!
-IF (LHOOK) CALL DR_HOOK('TURB:DELT',1,ZHOOK_HANDLE)
-END SUBROUTINE DELT
-!
-! ####################
- SUBROUTINE DEAR(PLM)
-! ####################
-!!
-!!**** *DELT* routine to compute mixing length for DEARdorff case
-!
-!! AUTHOR
-!! ------
-!!
-!! M Tomasini *Meteo-France
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/05
-!! I.Sandu (Sept.2006) : Modification of the stability criterion
-!! (theta_v -> theta_l)
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!* 0.1 Declarations of dummy arguments
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLM
-!
-!* 0.2 Declarations of local variables
-!
-REAL :: ZD ! distance to the surface
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK2D
-!
-REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
- ZDTHLDZ,ZDRTDZ, &!dtheta_l/dz, drt_dz used for computing the stablity
-! ! criterion
- ZETHETA,ZEMOIST !coef ETHETA and EMOIST
-!----------------------------------------------------------------------------
-!
-!-------------------------------------------------------------------------------
-!
-! initialize the mixing length with the mesh grid
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK('TURB:DEAR',0,ZHOOK_HANDLE)
-DO JK = IKTB,IKTE ! 1D turbulence scheme
- PLM(:,:,JK) = PZZ(:,:,JK+KKL) - PZZ(:,:,JK)
-END DO
-PLM(:,:,KKU) = PLM(:,:,IKE)
-PLM(:,:,KKA) = PZZ(:,:,IKB) - PZZ(:,:,KKA)
-IF ( HTURBDIM /= '1DIM' ) THEN ! 3D turbulence scheme
- IF ( L2D) THEN
- PLM(:,:,:) = SQRT( PLM(:,:,:)*MXF(PDXX(:,:,:)) )
- ELSE
- PLM(:,:,:) = (PLM(:,:,:)*MXF(PDXX(:,:,:))*MYF(PDYY(:,:,:)) ) ** (1./3.)
- END IF
-END IF
-! compute a mixing length limited by the stability
-!
-ALLOCATE(ZWORK2D(SIZE(PUM,1),SIZE(PUM,2)))
-!
-ZETHETA(:,:,:) = ETHETA(KRR,KRRI,PTHLM,PRM,ZLOCPEXNM,ZATHETA,PSRCM)
-ZEMOIST(:,:,:) = EMOIST(KRR,KRRI,PTHLM,PRM,ZLOCPEXNM,ZAMOIST,PSRCM)
-!
-DO JK = IKTB+1,IKTE-1
- ZDTHLDZ(:,:,JK)= 0.5*((PTHLM(:,:,JK+KKL)-PTHLM(:,:,JK))/PDZZ(:,:,JK+KKL)+ &
- (PTHLM(:,:,JK)-PTHLM(:,:,JK-KKL))/PDZZ(:,:,JK))
- ZDRTDZ(:,:,JK)= 0.5*((PRM(:,:,JK+KKL,1)-PRM(:,:,JK,1))/PDZZ(:,:,JK+KKL)+ &
- (PRM(:,:,JK,1)-PRM(:,:,JK-KKL,1))/PDZZ(:,:,JK))
- ZWORK2D(:,:)=XG/PTHVREF(:,:,JK)* &
- (ZETHETA(:,:,JK)*ZDTHLDZ(:,:,JK)+ZEMOIST(:,:,JK)*ZDRTDZ(:,:,JK))
- !
- WHERE(ZWORK2D(:,:)>0.)
- PLM(:,:,JK)=MAX(1.E-10,MIN(PLM(:,:,JK), &
- 0.76* SQRT(PTKEM(:,:,JK)/ZWORK2D(:,:))))
- END WHERE
-END DO
-! special case near the surface
-ZDTHLDZ(:,:,IKB)=(PTHLM(:,:,IKB+KKL)-PTHLM(:,:,IKB))/PDZZ(:,:,IKB+KKL)
-ZDRTDZ(:,:,IKB)=(PRM(:,:,IKB+KKL,1)-PRM(:,:,IKB,1))/PDZZ(:,:,IKB+KKL)
-!
-ZWORK2D(:,:)=XG/PTHVREF(:,:,IKB)* &
- (ZETHETA(:,:,IKB)*ZDTHLDZ(:,:,IKB)+ZEMOIST(:,:,IKB)*ZDRTDZ(:,:,IKB))
-WHERE(ZWORK2D(:,:)>0.)
- PLM(:,:,IKB)=MAX(1.E-10,MIN( PLM(:,:,JK), &
- 0.76* SQRT(PTKEM(:,:,IKB)/ZWORK2D(:,:))))
-END WHERE
-!
-DEALLOCATE(ZWORK2D)
-!
-! mixing length limited by the distance normal to the surface (with the same factor as for BL89)
-!
-IF (.NOT. ORMC01) THEN
- ZALPHA=0.5**(-1.5)
- !
- DO JJ=1,SIZE(PUM,2)
- DO JI=1,SIZE(PUM,1)
- DO JK=IKTB,IKTE
- ZD=ZALPHA*(0.5*(PZZ(JI,JJ,JK)+PZZ(JI,JJ,JK+KKL))-PZZ(JI,JJ,IKB)) &
- *PDIRCOSZW(JI,JJ)
- IF ( PLM(JI,JJ,JK)>ZD) THEN
- PLM(JI,JJ,JK)=ZD
- ELSE
- EXIT
- ENDIF
- END DO
- END DO
- END DO
-END IF
-!
-PLM(:,:,KKA) = PLM(:,:,IKB )
-PLM(:,:,IKE ) = PLM(:,:,IKE-KKL)
-PLM(:,:,KKU ) = PLM(:,:,KKU-KKL)
-!
-IF (LHOOK) CALL DR_HOOK('TURB:DEAR',1,ZHOOK_HANDLE)
-END SUBROUTINE DEAR
-!
-! #########################
- SUBROUTINE CLOUD_MODIF_LM
-! #########################
-!!
-!!*****CLOUD_MODIF_LM routine to:
-!! 1/ change the mixing length in the clouds
-!! 2/ emphasize the mixing length in the cloud
-!! by the coefficient ZCOEF_AMPL calculated here
-!! when the CEI index is above ZCEI_MIN.
-!!
-!!
-!! ZCOEF_AMPL ^
-!! |
-!! |
-!! ZCOEF_AMPL_SAT - ---------- Saturation
-!! (XDUMMY1) | -
-!! | -
-!! | -
-!! | -
-!! | - Amplification
-!! | - straight
-!! | - line
-!! | -
-!! | -
-!! | -
-!! | -
-!! | -
-!! 1 ------------
-!! |
-!! |
-!! 0 -----------|------------|----------> PCEI
-!! 0 ZCEI_MIN ZCEI_MAX
-!! (XDUMMY2) (XDUMMY3)
-!!
-!!
-!!
-!! AUTHOR
-!! ------
-!! M. Tomasini *CNRM METEO-FRANCE
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 09/07/04
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-REAL :: ZPENTE ! Slope of the amplification straight line
-REAL :: ZCOEF_AMPL_CEI_NUL! Ordonnate at the origin of the
- ! amplification straight line
-REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),SIZE(PUM,3)) :: ZCOEF_AMPL
- ! Amplification coefficient of the mixing length
- ! when the instability criterium is verified
-REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),SIZE(PUM,3)) :: ZLM_CLOUD
- ! Turbulent mixing length in the clouds
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. INITIALISATION
-! --------------
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK('TURB:CLOUD_MODIF_LM',0,ZHOOK_HANDLE)
-ZPENTE = ( PCOEF_AMPL_SAT - 1. ) / ( PCEI_MAX - PCEI_MIN )
-ZCOEF_AMPL_CEI_NUL = 1. - ZPENTE * PCEI_MIN
-!
-ZCOEF_AMPL(:,:,:) = 1.
-!
-!* 2. CALCULATION OF THE AMPLIFICATION COEFFICIENT
-! --------------------------------------------
-!
-! Saturation
-!
-WHERE ( PCEI(:,:,:)>=PCEI_MAX ) ZCOEF_AMPL(:,:,:)=PCOEF_AMPL_SAT
-!
-! Between the min and max limits of CEI index, linear variation of the
-! amplification coefficient ZCOEF_AMPL as a function of CEI
-!
-WHERE ( PCEI(:,:,:) < PCEI_MAX .AND. &
- PCEI(:,:,:) > PCEI_MIN ) &
- ZCOEF_AMPL(:,:,:) = ZPENTE * PCEI(:,:,:) + ZCOEF_AMPL_CEI_NUL
-!
-!
-!* 3. CALCULATION OF THE MIXING LENGTH IN CLOUDS
-! ------------------------------------------
-!
-IF (HTURBLEN_CL == HTURBLEN) THEN
- ZLM_CLOUD(:,:,:) = ZLM(:,:,:)
-ELSE
- SELECT CASE (HTURBLEN_CL)
-!
-!* 3.1 BL89 mixing length
-! ------------------
- CASE ('BL89')
- ZSHEAR=0.
- CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKEM,ZSHEAR,ZLM_CLOUD)
-!
-!* 3.2 Delta mixing length
-! -------------------
- CASE ('DELT')
- CALL DELT(ZLM_CLOUD)
-!
-!* 3.3 Deardorff mixing length
-! -----------------------
- CASE ('DEAR')
- CALL DEAR(ZLM_CLOUD)
-!
- END SELECT
-ENDIF
-!
-!* 4. MODIFICATION OF THE MIXING LENGTH IN THE CLOUDS
-! -----------------------------------------------
-!
-! Impression before modification of the mixing length
-IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
- YRECFM ='LM_CLEAR_SKY'
- YCOMMENT='X_Y_Z_LM CLEAR SKY (M)'
- IGRID = 1
- ILENCH = LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZLM,IGRID,ILENCH,YCOMMENT,IRESP)
-ENDIF
-!
-! Amplification of the mixing length when the criteria are verified
-!
-WHERE (ZCOEF_AMPL(:,:,:) /= 1.) ZLM(:,:,:) = ZCOEF_AMPL(:,:,:)*ZLM_CLOUD(:,:,:)
-!
-! Cloud mixing length in the clouds at the points which do not verified the CEI
-!
-WHERE (PCEI(:,:,:) == -1.) ZLM(:,:,:) = ZLM_CLOUD(:,:,:)
-!
-!
-!* 5. IMPRESSION
-! ----------
-!
-IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
- YRECFM ='COEF_AMPL'
- YCOMMENT='X_Y_Z_COEF AMPL (-)'
- IGRID = 1
- ILENCH = LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZCOEF_AMPL,IGRID,ILENCH,YCOMMENT,IRESP)
- !
- YRECFM ='LM_CLOUD'
- YCOMMENT='X_Y_Z_LM CLOUD (M)'
- IGRID = 1
- ILENCH = LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZLM_CLOUD,IGRID,ILENCH,YCOMMENT,IRESP)
- !
-ENDIF
-!
-IF (LHOOK) CALL DR_HOOK('TURB:CLOUD_MODIF_LM',1,ZHOOK_HANDLE)
-END SUBROUTINE CLOUD_MODIF_LM
-!
-END SUBROUTINE TURB
diff --git a/src/arome/turb/turb_ver_dyn_flux.F90 b/src/arome/turb/turb_ver_dyn_flux.F90
deleted file mode 100644
index 6c3c5f5c7504fcf51cf7bb70a23eddc40539b42b..0000000000000000000000000000000000000000
--- a/src/arome/turb/turb_ver_dyn_flux.F90
+++ /dev/null
@@ -1,746 +0,0 @@
-! ######spl
- SUBROUTINE TURB_VER_DYN_FLUX(KKA,KKU,KKL, &
- OCLOSE_OUT,OTURB_FLX,KRR, &
- HTURBDIM,PIMPL,PEXPL, &
- PTSTEP, &
- HFMFILE,HLUOUT, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
- PCOSSLOPE,PSINSLOPE, &
- PRHODJ, &
- PCDUEFF,PTAU11M,PTAU12M,PTAU33M, &
- PTHLM,PRM,PSVM,PUM,PVM,PWM,PUSLOPEM,PVSLOPEM, &
- PTKEM,PLM,MFMOIST,PWU,PWV, &
- PRUS,PRVS,PRWS, &
- PDP,PTP )
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
- USE MODD_CTURB, ONLY : LHARAT
-
-! ###############################################################
-!
-!
-!!**** *TURB_VER_DYN_FLUX* -compute the source terms due to the vertical turbulent
-!! fluxes.
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to compute the vertical turbulent
-! fluxes of the evolutive variables and give back the source
-! terms to the main program. In the case of large horizontal meshes,
-! the divergence of these vertical turbulent fluxes represent the whole
-! effect of the turbulence but when the three-dimensionnal version of
-! the turbulence scheme is activated (CTURBDIM="3DIM"), these divergences
-! are completed in the next routine TURB_HOR.
-! An arbitrary degree of implicitness has been implemented for the
-! temporal treatment of these diffusion terms.
-! The vertical boundary conditions are as follows:
-! * at the bottom, the surface fluxes are prescribed at the same
-! as the other turbulent fluxes
-! * at the top, the turbulent fluxes are set to 0.
-! It should be noted that the condensation has been implicitely included
-! in this turbulence scheme by using conservative variables and computing
-! the subgrid variance of a statistical variable s indicating the presence
-! or not of condensation in a given mesh.
-!
-!!** METHOD
-!! ------
-!! 1D type calculations are made;
-!! The vertical turbulent fluxes are computed in an off-centered
-!! implicit scheme (a Crank-Nicholson type with coefficients different
-!! than 0.5), which allows to vary the degree of implicitness of the
-!! formulation.
-!! The different prognostic variables are treated one by one.
-!! The contributions of each turbulent fluxes are cumulated into the
-!! tendency PRvarS, and into the dynamic and thermal production of
-!! TKE if necessary.
-!!
-!! In section 2 and 3, the thermodynamical fields are considered.
-!! Only the turbulent fluxes of the conservative variables
-!! (Thetal and Rnp stored in PRx(:,:,:,1)) are computed.
-!! Note that the turbulent fluxes at the vertical
-!! boundaries are given either by the soil scheme for the surface one
-!! ( at the same instant as the others fluxes) and equal to 0 at the
-!! top of the model. The thermal production is computed by vertically
-!! averaging the turbulent flux and multiply this flux at the mass point by
-!! a function ETHETA or EMOIST, which preform the transformation from the
-!! conservative variables to the virtual potential temperature.
-!!
-!! In section 4, the variance of the statistical variable
-!! s indicating presence or not of condensation, is determined in function
-!! of the turbulent moments of the conservative variables and its
-!! squarred root is stored in PSIGS. This information will be completed in
-!! the horizontal turbulence if the turbulence dimensionality is not
-!! equal to "1DIM".
-!!
-!! In section 5, the x component of the stress tensor is computed.
-!! The surface flux <u'w'> is computed from the value of the surface
-!! fluxes computed in axes linked to the orography ( i", j" , k"):
-!! i" is parallel to the surface and in the direction of the maximum
-!! slope
-!! j" is also parallel to the surface and in the normal direction of
-!! the maximum slope
-!! k" is the normal to the surface
-!! In order to prevent numerical instability, the implicit scheme has
-!! been extended to the surface flux regarding to its dependence in
-!! function of U. The dependence in function of the other components
-!! introduced by the different rotations is only explicit.
-!! The turbulent fluxes are used to compute the dynamic production of
-!! TKE. For the last TKE level ( located at PDZZ(:,:,IKB)/2 from the
-!! ground), an harmonic extrapolation from the dynamic production at
-!! PDZZ(:,:,IKB) is used to avoid an evaluation of the gradient of U
-!! in the surface layer.
-!!
-!! In section 6, the same steps are repeated but for the y direction
-!! and in section 7, a diagnostic computation of the W variance is
-!! performed.
-!!
-!! In section 8, the turbulent fluxes for the scalar variables are
-!! computed by the same way as the conservative thermodynamical variables
-!!
-!!
-!! EXTERNAL
-!! --------
-!! GX_U_M, GY_V_M, GZ_W_M : cartesian gradient operators
-!! GX_U_UW,GY_V_VW (X,Y,Z) represent the direction of the gradient
-!! _(M,U,...)_ represent the localization of the
-!! field to be derivated
-!! _(M,UW,...) represent the localization of the
-!! field derivated
-!!
-!!
-!! MXM,MXF,MYM,MYF,MZM,MZF
-!! : Shuman functions (mean operators)
-!! DXF,DYF,DZF,DZM
-!! : Shuman functions (difference operators)
-!!
-!! SUBROUTINE TRIDIAG : to compute the splitted implicit evolution
-!! of a variable located at a mass point
-!!
-!! SUBROUTINE TRIDIAG_WIND: to compute the splitted implicit evolution
-!! of a variable located at a wind point
-!!
-!! FUNCTIONs ETHETA and EMOIST :
-!! allows to compute:
-!! - the coefficients for the turbulent correlation between
-!! any variable and the virtual potential temperature, of its
-!! correlations with the conservative potential temperature and
-!! the humidity conservative variable:
-!! ------- ------- -------
-!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CST : contains physical constants
-!!
-!! XG : gravity constant
-!!
-!! Module MODD_CTURB: contains the set of constants for
-!! the turbulence scheme
-!!
-!! XCMFS,XCMFB : cts for the momentum flux
-!! XCSHF : ct for the sensible heat flux
-!! XCHF : ct for the moisture flux
-!! XCTV,XCHV : cts for the T and moisture variances
-!!
-!! Module MODD_PARAMETERS
-!!
-!! JPVEXT_TURB : number of vertical external points
-!! JPHEXT : number of horizontal external points
-!!
-!!
-!! REFERENCE
-!! ---------
-!! Book 1 of documentation (Chapter: Turbulence)
-!!
-!! AUTHOR
-!! ------
-!! Joan Cuxart * INM and Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original August 19, 1994
-!! Modifications: February 14, 1995 (J.Cuxart and J.Stein)
-!! Doctorization and Optimization
-!! Modifications: March 21, 1995 (J.M. Carriere)
-!! Introduction of cloud water
-!! Modifications: June 14, 1995 (J.Cuxart and J. Stein)
-!! Phi3 and Psi3 at w-point + bug in the all
-!! or nothing condens.
-!! Modifications: Sept 15, 1995 (J.Cuxart and J. Stein)
-!! Change the DP computation at the ground
-!! Modifications: October 10, 1995 (J.Cuxart and J. Stein)
-!! Psi for scal var and LES tools
-!! Modifications: November 10, 1995 (J. Stein)
-!! change the surface relations
-!! Modifications: February 20, 1995 (J. Stein) optimization
-!! Modifications: May 21, 1996 (J. Stein)
-!! bug in the vertical flux of the V wind
-!! component for explicit computation
-!! Modifications: May 21, 1996 (N. wood)
-!! modify the computation of the vertical
-!! part or the surface tangential flux
-!! Modifications: May 21, 1996 (P. Jabouille)
-!! same modification in the Y direction
-!!
-!! Modifications: Sept 17, 1996 (J. Stein) change the moist case by using
-!! Pi instead of Piref + use Atheta and Amoist
-!!
-!! Modifications: Nov 24, 1997 (V. Masson) removes the DO loops
-!! Modifications: Mar 31, 1998 (V. Masson) splits the routine TURB_VER_DYN_FLUX
-!! Modifications: Oct 18, 2000 (J. Stein) Bug in some computations for IKB level
-!! Modifications: Oct 18, 2000 (V. Masson) LES computations + LFLAT switch
-!! Nov 06, 2002 (V. Masson) LES budgets
-!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
-!! change of YCOMMENT
-!! 2012-02 Y. Seity, add possibility to run with reversed vertical levels
-!! Modifications July 2015 (Wim de Rooy) LHARATU switch
-
-!!--------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CONF
-USE MODD_CST
-USE MODD_CTURB
-USE MODD_PARAMETERS
-USE MODD_LES
-USE MODD_NSV
-!
-!
-USE MODI_GRADIENT_U
-USE MODI_GRADIENT_V
-USE MODI_GRADIENT_W
-USE MODI_GRADIENT_M
-USE MODI_SHUMAN , ONLY: MZM, MZF, MXM, MXF, MYM, MYF,&
- & DZM, DXF, DXM, DYF, DYM
-USE MODI_TRIDIAG
-USE MODI_TRIDIAG_WIND
-USE MODE_FMWRIT
-USE MODI_LES_MEAN_SUBGRID
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-CHARACTER*4, INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
-REAL, INTENT(IN) :: PTSTEP ! Double Time Step
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output
- ! FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
- ! normal to the ground surface
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux points
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
- ! between i and the slope vector
-REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
- ! between i and the slope vector
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: MFMOIST ! moist mass flux dual scheme
-
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU11M ! <uu> in the axes linked
- ! to the maximum slope direction and the surface normal and the binormal
- ! at time t - dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU12M ! <uv> in the same axes
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM, PTHLM
- ! Wind at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
-REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
- ! maximum slope direction
-REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
- ! direction normal to the maximum slope one
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWU ! momentum flux u'w'
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWV ! momentum flux v'w'
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS
- ! cumulated sources for the prognostic variables
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PDP,PTP ! Dynamic and thermal
- ! TKE production terms
-!
-!
-!
-!
-!* 0.2 declaration of local variables
-!
-!
-REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2)) :: ZDIRSINZW ! sinus of the angle
- ! between the normal and the vertical at the surface
-REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),1):: ZCOEFS ! coeff. for the
- ! implicit scheme for the wind at the surface
-REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),SIZE(PUM,3)) :: &
- ZA, & ! under diagonal elements of the tri-diagonal matrix involved
- ! in the temporal implicit scheme (also used to store coefficient
- ! J in Section 5)
- ZRES, & ! guess of the treated variable at t+ deltat when the turbu-
- ! lence is the only source of evolution added to the ones
- ! considered in ZSOURCE
- ZFLXZ, & ! vertical flux of the treated variable
- ZSOURCE, & ! source of evolution for the treated variable
- ZKEFF ! effectif diffusion coeff = LT * SQRT( TKE )
-INTEGER :: IRESP ! Return code of FM routines
-INTEGER :: IGRID ! C-grid indicator in LFIFM file
-INTEGER :: ILENCH ! Length of comment string in LFIFM file
-INTEGER :: IIB,IIE, & ! I index values for the Beginning and End
- IJB,IJE, & ! mass points of the domain in the 3 direct.
- IKB,IKE !
-INTEGER :: IKT ! array size in k direction
-INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
-INTEGER :: JSV ! scalar loop counter
-CHARACTER (LEN=100) :: YCOMMENT ! comment string in LFIFM file
-CHARACTER (LEN=16) :: YRECFM ! Name of the desired field in LFIFM file
-REAL, DIMENSION(SIZE(PDZZ,1),SIZE(PDZZ,2),1) :: ZCOEFFLXU, &
- ZCOEFFLXV, ZUSLOPEM, ZVSLOPEM
- ! coefficients for the surface flux
- ! evaluation and copy of PUSLOPEM and
- ! PVSLOPEM in local 3D arrays
-INTEGER :: IIU,IJU ! size of array in x,y,z directions
-!
-REAL :: ZTIME1, ZTIME2, ZCMFS
-!----------------------------------------------------------------------------
-!
-!* 1. PRELIMINARIES
-! -------------
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK('TURB_VER_DYN_FLUX',0,ZHOOK_HANDLE)
-IIU=SIZE(PUM,1)
-IIE=IIU-JPHEXT
-IIB=1+JPHEXT
-IJU=SIZE(PUM,2)
-IJE=IJU-JPHEXT
-IJB=1+JPHEXT
-IKB=KKA+JPVEXT_TURB*KKL
-IKE=KKU-JPVEXT_TURB*KKL
-IKT=SIZE(PUM,3)
-IKTB=1+JPVEXT_TURB
-IKTE=IKT-JPVEXT_TURB
-
-
-!
-ZSOURCE = 0.
-ZFLXZ = 0.
-ZCMFS = XCMFS
-IF (LHARAT)THEN
- ZCMFS=1.
-ENDIF
-!
-ZDIRSINZW(:,:) = SQRT(1.-PDIRCOSZW(:,:)**2)
-! compute the coefficients for the uncentred gradient computation near the
-! ground
-!
-! With LHARATU length scale and TKE are at half levels so remove MZM
-!
-IF (LHARAT) THEN
-ZKEFF(:,:,:) = PLM(:,:,:) * SQRT(PTKEM(:,:,:)) + 50*MFMOIST(:,:,:)
-ELSE
-ZKEFF(:,:,:) = MZM(PLM(:,:,:) * SQRT(PTKEM(:,:,:)), KKA, KKU, KKL)
-ENDIF
-
-!
-ZUSLOPEM(:,:,1)=PUSLOPEM(:,:)
-ZVSLOPEM(:,:,1)=PVSLOPEM(:,:)
-!
-!----------------------------------------------------------------------------
-!
-!
-!* 5. SOURCES OF U,W WIND COMPONENTS AND PARTIAL DYNAMIC PRODUCTION
-! -------------------------------------------------------------
-!
-!* 5.1 Source of U wind component
-!
-! Preparation of the arguments for TRIDIAG_WIND
-!
-ZA(:,:,:) = -PTSTEP * ZCMFS * &
- MXM( ZKEFF ) * MXM(MZM(PRHODJ, KKA, KKU, KKL)) / &
- MXM( PDZZ )**2
-!
-IF (CPROGRAM/='AROME ') ZA(1,:,:)=ZA(IIE,:,:)
-!
-! Compute the source of U wind component
-!
-! compute the coefficient between the vertical flux and the 2 components of the
-! wind following the slope
-ZCOEFFLXU(:,:,1) = PCDUEFF(:,:) * (PDIRCOSZW(:,:)**2 - ZDIRSINZW(:,:)**2) &
- * PCOSSLOPE(:,:)
-ZCOEFFLXV(:,:,1) = PCDUEFF(:,:) * PDIRCOSZW(:,:) * PSINSLOPE(:,:)
-
-! prepare the implicit scheme coefficients for the surface flux
-ZCOEFS(:,:,1)= ZCOEFFLXU(:,:,1) * PCOSSLOPE(:,:) * PDIRCOSZW(:,:) &
- +ZCOEFFLXV(:,:,1) * PSINSLOPE(:,:)
-!
-! average this flux to be located at the U,W vorticity point
-ZCOEFS(:,:,1:1)=MXM(ZCOEFS(:,:,1:1) / PDZZ(:,:,IKB:IKB) )
-!
-! compute the explicit tangential flux at the W point
-ZSOURCE(:,:,IKB) = &
- PTAU11M(:,:) * PCOSSLOPE(:,:) * PDIRCOSZW(:,:) * ZDIRSINZW(:,:) &
- -PTAU12M(:,:) * PSINSLOPE(:,:) * ZDIRSINZW(:,:) &
- -PTAU33M(:,:) * PCOSSLOPE(:,:) * ZDIRSINZW(:,:) * PDIRCOSZW(:,:)
-!
-! add the vertical part or the surface flux at the U,W vorticity point
-
-ZSOURCE(:,:,IKB:IKB) = &
- ( MXM( ZSOURCE(:,:,IKB:IKB) / PDZZ(:,:,IKB:IKB) ) &
- + MXM( ZCOEFFLXU(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
- *ZUSLOPEM(:,:,1:1) &
- -ZCOEFFLXV(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
- *ZVSLOPEM(:,:,1:1) ) &
- - ZCOEFS(:,:,1:1) * PUM(:,:,IKB:IKB) * PIMPL &
- ) * 0.5 * ( 1. + MXM(PRHODJ(:,:,KKA:KKA)) / MXM(PRHODJ(:,:,IKB:IKB)) )
-!
-ZSOURCE(:,:,IKTB+1:IKTE-1) = 0.
-ZSOURCE(:,:,IKE) = 0.
-!
-! Obtention of the splitted U at t+ deltat
-!
-CALL TRIDIAG_WIND(KKA,KKU,KKL,PUM,ZA,ZCOEFS(:,:,1),PTSTEP,PEXPL,PIMPL, &
- MXM(PRHODJ),ZSOURCE,ZRES)
-!
-! Compute the equivalent tendency for the U wind component
-!
-PRUS(:,:,:)=PRUS(:,:,:)+MXM(PRHODJ(:,:,:))*(ZRES(:,:,:)-PUM(:,:,:))/PTSTEP
-!
-!
-!* 5.2 Partial Dynamic Production
-!
-! vertical flux of the U wind component
-!
-ZFLXZ(:,:,:) = -ZCMFS * MXM(ZKEFF) * &
- DZM(PIMPL*ZRES + PEXPL*PUM, KKA, KKU, KKL) / MXM(PDZZ)
-!
-! surface flux
-ZFLXZ(:,:,IKB:IKB) = MXM(PDZZ(:,:,IKB:IKB)) * &
- ( ZSOURCE(:,:,IKB:IKB) &
- +ZCOEFS(:,:,1:1) * ZRES(:,:,IKB:IKB) * PIMPL &
- ) / 0.5 / ( 1. + MXM(PRHODJ(:,:,KKA:KKA)) / MXM(PRHODJ(:,:,IKB:IKB)) )
-!
-ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
-
-!
-IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
- ! stores the U wind component vertical flux
- YRECFM ='UW_VFLX'
- YCOMMENT='X_Y_Z_UW_VFLX (M**2/S**2)'
- IGRID = 4
- ILENCH=LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZFLXZ,IGRID,ILENCH,YCOMMENT,IRESP)
-END IF
-!
-! first part of total momentum flux
-!
-PWU(:,:,:) = ZFLXZ(:,:,:)
-!
-! Contribution to the dynamic production of TKE
-! compute the dynamic production at the mass point
-!
-PDP(:,:,:) = - MZF(MXF(ZFLXZ * GZ_U_UW(PUM,PDZZ, KKA, KKU, KKL)), KKA, KKU, KKL)
-!
-! evaluate the dynamic production at w(IKB+KKL) in PDP(IKB)
-PDP(:,:,IKB:IKB) = - MXF ( &
- ZFLXZ(:,:,IKB+KKL:IKB+KKL) * (PUM(:,:,IKB+KKL:IKB+KKL)-PUM(:,:,IKB:IKB)) &
- / MXM(PDZZ(:,:,IKB+KKL:IKB+KKL)) &
- )
-!
-! Storage in the LES configuration
-!
-IF (LLES_CALL) THEN
- CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID(MZF(MXF(ZFLXZ), KKA, KKU, KKL), X_LES_SUBGRID_WU )
- CALL LES_MEAN_SUBGRID(MZF(MXF(GZ_U_UW(PUM,PDZZ, KKA, KKU, KKL) &
- & *ZFLXZ), KKA, KKU, KKL), X_LES_RES_ddxa_U_SBG_UaU )
- CALL LES_MEAN_SUBGRID( ZCMFS * ZKEFF, X_LES_SUBGRID_Km )
- CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
-END IF
-!
-!* 5.3 Source of W wind component
-!
-!
-IF(HTURBDIM=='3DIM') THEN
- ! Compute the source for the W wind component
- ZFLXZ(:,:,KKA) = 2 * ZFLXZ(:,:,IKB) - ZFLXZ(:,:,IKB+KKL) ! extrapolation
- ! used to compute the W source at the ground
- !
- IF (.NOT. LFLAT) THEN
- PRWS(:,:,:)= PRWS &
- -DXF( MZM(MXM(PRHODJ) /PDXX, KKA, KKU, KKL) * ZFLXZ ) &
- +DZM(PRHODJ / MZF(PDZZ, KKA, KKU, KKL) * &
- MXF(MZF(ZFLXZ*PDZX, KKA, KKU, KKL) / PDXX ), &
- KKA, KKU, KKL)
- ELSE
- PRWS(:,:,:)= PRWS -DXF(MZM(MXM(PRHODJ) /PDXX, KKA, KKU, KKL) * ZFLXZ )
- END IF
- !
- ! Complete the Dynamical production with the W wind component
- !
- ZA(:,:,:)=-MZF(MXF(ZFLXZ * GX_W_UW(PWM,PDXX,PDZZ,PDZX, KKA, KKU, KKL)), KKA, KKU, KKL)
- !
- !
- ! evaluate the dynamic production at w(IKB+KKL) in PDP(IKB)
- ZA(:,:,IKB:IKB) = - MXF ( &
- ZFLXZ(:,:,IKB+KKL:IKB+KKL) * &
- ( DXM( PWM(:,:,IKB+KKL:IKB+KKL) ) &
- -MXM( (PWM(:,:,IKB+2*KKL:IKB+2*KKL )-PWM(:,:,IKB+KKL:IKB+KKL)) &
- /(PDZZ(:,:,IKB+2*KKL:IKB+2*KKL)+PDZZ(:,:,IKB+KKL:IKB+KKL)) &
- +(PWM(:,:,IKB+KKL:IKB+KKL)-PWM(:,:,IKB:IKB )) &
- /(PDZZ(:,:,IKB+KKL:IKB+KKL)+PDZZ(:,:,IKB:IKB )) &
- ) &
- * PDZX(:,:,IKB+KKL:IKB+KKL) &
- ) / (0.5*(PDXX(:,:,IKB+KKL:IKB+KKL)+PDXX(:,:,IKB:IKB))) &
- )
- !
- PDP(:,:,:)=PDP(:,:,:)+ZA(:,:,:)
- !
- ! Storage in the LES configuration
- !
- IF (LLES_CALL) THEN
- CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID(MZF(MXF(GX_W_UW(PWM,PDXX,&
- PDZZ,PDZX, KKA, KKU, KKL)*ZFLXZ), KKA, KKU, KKL), X_LES_RES_ddxa_W_SBG_UaW )
- CALL LES_MEAN_SUBGRID(MXF(GX_M_U(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL)&
- * MZF(ZFLXZ, KKA, KKU, KKL)), X_LES_RES_ddxa_Thl_SBG_UaW )
- IF (KRR>=1) THEN
- CALL LES_MEAN_SUBGRID(MXF(GX_U_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX, KKA, KKU, KKL)&
- *MZF(ZFLXZ, KKA, KKU, KKL)),X_LES_RES_ddxa_Rt_SBG_UaW )
- END IF
- DO JSV=1,NSV
- CALL LES_MEAN_SUBGRID( MXF(GX_U_M(PSVM(:,:,:,JSV),PDXX,PDZZ,&
- PDZX, KKA, KKU, KKL)*MZF(ZFLXZ, KKA, KKU, KKL)),X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV) )
- END DO
- CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
- END IF
-END IF
-!
-!----------------------------------------------------------------------------
-!
-!
-!* 6. SOURCES OF V,W WIND COMPONENTS AND COMPLETE 1D DYNAMIC PRODUCTION
-! -----------------------------------------------------------------
-!
-!* 6.1 Source of V wind component
-!
-! Preparation of the arguments for TRIDIAG_WIND
-!!
-ZA(:,:,:) = - PTSTEP * ZCMFS * &
- MYM( ZKEFF ) * MYM(MZM(PRHODJ, KKA, KKU, KKL)) / &
- MYM( PDZZ )**2
-!
-!
-IF(CPROGRAM/='AROME ') ZA(:,1,:)=ZA(:,IJE,:)
-!
-! Compute the source of V wind component
-! compute the coefficient between the vertical flux and the 2 components of the
-! wind following the slope
-ZCOEFFLXU(:,:,1) = PCDUEFF(:,:) * (PDIRCOSZW(:,:)**2 - ZDIRSINZW(:,:)**2) &
- * PSINSLOPE(:,:)
-ZCOEFFLXV(:,:,1) = PCDUEFF(:,:) * PDIRCOSZW(:,:) * PCOSSLOPE(:,:)
-
-! prepare the implicit scheme coefficients for the surface flux
-ZCOEFS(:,:,1)= ZCOEFFLXU(:,:,1) * PSINSLOPE(:,:) * PDIRCOSZW(:,:) &
- +ZCOEFFLXV(:,:,1) * PCOSSLOPE(:,:)
-!
-! average this flux to be located at the V,W vorticity point
-ZCOEFS(:,:,1:1)=MYM(ZCOEFS(:,:,1:1) / PDZZ(:,:,IKB:IKB) )
-!
-! compute the explicit tangential flux at the W point
-ZSOURCE(:,:,IKB) = &
- PTAU11M(:,:) * PSINSLOPE(:,:) * PDIRCOSZW(:,:) * ZDIRSINZW(:,:) &
- +PTAU12M(:,:) * PCOSSLOPE(:,:) * ZDIRSINZW(:,:) &
- -PTAU33M(:,:) * PSINSLOPE(:,:) * ZDIRSINZW(:,:) * PDIRCOSZW(:,:)
-!
-! add the vertical part or the surface flux at the V,W vorticity point
-ZSOURCE(:,:,IKB:IKB) = &
- ( MYM( ZSOURCE(:,:,IKB:IKB) / PDZZ(:,:,IKB:IKB) ) &
- + MYM( ZCOEFFLXU(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
- *ZUSLOPEM(:,:,1:1) &
- +ZCOEFFLXV(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
- *ZVSLOPEM(:,:,1:1) ) &
- - ZCOEFS(:,:,1:1) * PVM(:,:,IKB:IKB) * PIMPL &
- ) * 0.5 * ( 1. + MYM(PRHODJ(:,:,KKA:KKA)) / MYM(PRHODJ(:,:,IKB:IKB)) )
-!
-ZSOURCE(:,:,IKTB+1:IKTE-1) = 0.
-ZSOURCE(:,:,IKE) = 0.
-!
-! Obtention of the splitted V at t+ deltat
-CALL TRIDIAG_WIND(KKA,KKU,KKL,PVM,ZA,ZCOEFS(:,:,1),PTSTEP,PEXPL,PIMPL, &
- MYM(PRHODJ),ZSOURCE,ZRES)
-!
-! Compute the equivalent tendency for the V wind component
-!
-PRVS(:,:,:)=PRVS(:,:,:)+MYM(PRHODJ(:,:,:))*(ZRES(:,:,:)-PVM(:,:,:))/PTSTEP
-!
-!
-!* 6.2 Complete 1D dynamic Production
-!
-! vertical flux of the V wind component
-!
-ZFLXZ(:,:,:) = -ZCMFS * MYM(ZKEFF) * &
- DZM(PIMPL*ZRES + PEXPL*PVM, KKA, KKU, KKL) / MYM(PDZZ)
-!
-ZFLXZ(:,:,IKB:IKB) = MYM(PDZZ(:,:,IKB:IKB)) * &
- ( ZSOURCE(:,:,IKB:IKB) &
- +ZCOEFS(:,:,1:1) * ZRES(:,:,IKB:IKB) * PIMPL &
- ) / 0.5 / ( 1. + MYM(PRHODJ(:,:,KKA:KKA)) / MYM(PRHODJ(:,:,IKB:IKB)) )
-!
-!
-ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
-!
-IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
- ! stores the V wind component vertical flux
- YRECFM ='VW_VFLX'
- YCOMMENT='X_Y_Z_VW_VFLX (M**2/S**2)'
- IGRID = 4
- ILENCH=LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZFLXZ,IGRID,ILENCH,YCOMMENT,IRESP)
-END IF
-!
-! second part of total momentum flux
-!
-PWV(:,:,:) = ZFLXZ(:,:,:)
-!
-! Contribution to the dynamic production of TKE
-! compute the dynamic production contribution at the mass point
-!
-ZA(:,:,:) = - MZF(MYF(ZFLXZ * GZ_V_VW(PVM,PDZZ, KKA, KKU, KKL)), KKA, KKU, KKL)
-!
-! evaluate the dynamic production at w(IKB+KKL) in PDP(IKB)
-ZA(:,:,IKB:IKB) = &
- - MYF ( &
-ZFLXZ(:,:,IKB+KKL:IKB+KKL) * (PVM(:,:,IKB+KKL:IKB+KKL)-PVM(:,:,IKB:IKB)) &
- / MYM(PDZZ(:,:,IKB+KKL:IKB+KKL)) &
- )
-!
-PDP(:,:,:)=PDP(:,:,:)+ZA(:,:,:)
-!
-! Storage in the LES configuration
-!
-IF (LLES_CALL) THEN
- CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID(MZF(MYF(ZFLXZ), KKA, KKU, KKL), X_LES_SUBGRID_WV )
- CALL LES_MEAN_SUBGRID(MZF(MYF(GZ_V_VW(PVM,PDZZ, KKA, KKU, KKL)*&
- & ZFLXZ), KKA, KKU, KKL), X_LES_RES_ddxa_V_SBG_UaV )
- CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
-END IF
-!
-!
-!* 6.3 Source of W wind component
-!
-IF(HTURBDIM=='3DIM') THEN
- ! Compute the source for the W wind component
- ZFLXZ(:,:,KKA) = 2 * ZFLXZ(:,:,IKB) - ZFLXZ(:,:,IKB+KKL) ! extrapolation
- !
- IF (.NOT. L2D) THEN
- IF (.NOT. LFLAT) THEN
- PRWS(:,:,:)= PRWS(:,:,:) &
- -DYF( MZM(MYM(PRHODJ) /PDYY, KKA, KKU, KKL) * ZFLXZ ) &
- +DZM(PRHODJ / MZF(PDZZ, KKA, KKU, KKL) * &
- MYF(MZF(ZFLXZ*PDZY, KKA, KKU, KKL) / PDYY ), &
- KKA, KKU, KKL)
- ELSE
- PRWS(:,:,:)= PRWS(:,:,:) -DYF(MZM(MYM(PRHODJ) /PDYY, KKA, KKU, KKL) * ZFLXZ )
- END IF
- END IF
- !
- ! Complete the Dynamical production with the W wind component
- IF (.NOT. L2D) THEN
- ZA(:,:,:) = - MZF(MYF(ZFLXZ * GY_W_VW(PWM,PDYY,PDZZ,PDZY, KKA, KKU, KKL)), KKA, KKU, KKL)
- !
- ! evaluate the dynamic production at w(IKB+KKL) in PDP(IKB)
- ZA(:,:,IKB:IKB) = - MYF ( &
- ZFLXZ(:,:,IKB+KKL:IKB+KKL) * &
- ( DYM( PWM(:,:,IKB+KKL:IKB+KKL) ) &
- -MYM( (PWM(:,:,IKB+2*KKL:IKB+2*KKL)-PWM(:,:,IKB+KKL:IKB+KKL)) &
- /(PDZZ(:,:,IKB+2*KKL:IKB+2*KKL)+PDZZ(:,:,IKB+KKL:IKB+KKL)) &
- +(PWM(:,:,IKB+KKL:IKB+KKL)-PWM(:,:,IKB:IKB )) &
- /(PDZZ(:,:,IKB+KKL:IKB+KKL)+PDZZ(:,:,IKB:IKB )) &
- ) &
- * PDZY(:,:,IKB+KKL:IKB+KKL) &
- ) / (0.5*(PDYY(:,:,IKB+KKL:IKB+KKL)+PDYY(:,:,IKB:IKB))) &
- )
- !
- PDP(:,:,:)=PDP(:,:,:)+ZA(:,:,:)
- !
- END IF
- !
- ! Storage in the LES configuration
- !
- IF (LLES_CALL) THEN
- CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID(MZF(MYF(GY_W_VW(PWM,PDYY,&
- &PDZZ,PDZY, KKA, KKU, KKL)*ZFLXZ), KKA, KKU, KKL), &
- &X_LES_RES_ddxa_W_SBG_UaW , .TRUE. )
- CALL LES_MEAN_SUBGRID(MYF(GY_M_V(PTHLM,PDYY,PDZZ,PDZY, KKA, KKU, KKL)*&
- &MZF(ZFLXZ, KKA, KKU, KKL)), &
- &X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE. )
- IF (KRR>=1) THEN
- CALL LES_MEAN_SUBGRID(MYF(GY_V_M(PRM(:,:,:,1),PDYY,PDZZ,&
- &PDZY, KKA, KKU, KKL)*MZF(ZFLXZ, KKA, KKU, KKL)),&
- &X_LES_RES_ddxa_Rt_SBG_UaW , .TRUE. )
- END IF
- CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
- END IF
- !
-END IF
-!
-! complete the dynamic production at the marginal points
-IF (CPROGRAM/='AROME ') THEN
- PDP(:,:,KKA)= -999.
- PDP(:,:,KKU)= -999.
- PDP(:,1,:)= PDP(:,IJE,:)
- PDP(:,IJE+1,:)= PDP(:,IJB,:)
- PDP(1,:,:)= PDP(IIE,:,:)
- PDP(IIE+1,:,:)= PDP(IIB,:,:)
-END IF
-!
-!----------------------------------------------------------------------------
-!
-!* 7. DIAGNOSTIC COMPUTATION OF THE 1D <W W> VARIANCE
-! -----------------------------------------------
-!
-IF ( OTURB_FLX .AND. OCLOSE_OUT .AND. HTURBDIM == '1DIM') THEN
- ZFLXZ(:,:,:)= (2./3.) * PTKEM(:,:,:) &
- -ZCMFS*PLM(:,:,:)*SQRT(PTKEM(:,:,:))*GZ_W_M(PWM,PDZZ, KKA, KKU, KKL)
- ! to be tested &
- ! +XCMFB*(4./3.)*PLM(:,:,:)/SQRT(PTKEM(:,:,:))*PTP(:,:,:)
- ! stores the W variance
- YRECFM ='W_VVAR'
- YCOMMENT='X_Y_Z_W_VVAR (M**2/S**2)'
- IGRID = 1
- ILENCH=LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZFLXZ,IGRID,ILENCH,YCOMMENT,IRESP)
-END IF
-!
-!----------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('TURB_VER_DYN_FLUX',1,ZHOOK_HANDLE)
-END SUBROUTINE TURB_VER_DYN_FLUX
diff --git a/src/arome/turb/turb_ver_thermo_flux.F90 b/src/arome/turb/turb_ver_thermo_flux.F90
deleted file mode 100644
index d377e2c9d3de1ec857dfe3167d1e89c218d3c6c6..0000000000000000000000000000000000000000
--- a/src/arome/turb/turb_ver_thermo_flux.F90
+++ /dev/null
@@ -1,788 +0,0 @@
-! ######spl
- SUBROUTINE TURB_VER_THERMO_FLUX(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- OCLOSE_OUT,OTURB_FLX,HTURBDIM,HTOM, &
- PIMPL,PEXPL, &
- PTSTEP, &
- HFMFILE,HLUOUT, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
- PRHODJ,PTHVREF, &
- PSFTHM,PSFRM,PSFTHP,PSFRP, &
- PWM,PTHLM,PRM,PSVM, &
- PTKEM,PLM,PLEPS, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
- PBETA, PSQRT_TKE, PDTH_DZ, PDR_DZ, PRED2TH3, &
- PRED2R3, PRED2THR3, PBLL_O_E, PETHETA, &
- PEMOIST, PREDTH1, PREDR1, PPHI3, PPSI3, PD, &
- PFWTH,PFWR,PFTH2,PFR2,PFTHR,MFMOIST,PBL_DEPTH,&
- PWTHV,PRTHLS,PRRS,PTHLP,PRP,PTP,PWTH,PWRC)
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
- USE MODD_CTURB, ONLY : LHARAT
-! ###############################################################
-!
-!
-!!**** *TURB_VER_THERMO_FLUX* -compute the source terms due to the vertical turbulent
-!! fluxes.
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to compute the vertical turbulent
-! fluxes of the evolutive variables and give back the source
-! terms to the main program. In the case of large horizontal meshes,
-! the divergence of these vertical turbulent fluxes represent the whole
-! effect of the turbulence but when the three-dimensionnal version of
-! the turbulence scheme is activated (CTURBDIM="3DIM"), these divergences
-! are completed in the next routine TURB_HOR.
-! An arbitrary degree of implicitness has been implemented for the
-! temporal treatment of these diffusion terms.
-! The vertical boundary conditions are as follows:
-! * at the bottom, the surface fluxes are prescribed at the same
-! as the other turbulent fluxes
-! * at the top, the turbulent fluxes are set to 0.
-! It should be noted that the condensation has been implicitely included
-! in this turbulence scheme by using conservative variables and computing
-! the subgrid variance of a statistical variable s indicating the presence
-! or not of condensation in a given mesh.
-!
-!!** METHOD
-!! ------
-!! 1D type calculations are made;
-!! The vertical turbulent fluxes are computed in an off-centered
-!! implicit scheme (a Crank-Nicholson type with coefficients different
-!! than 0.5), which allows to vary the degree of implicitness of the
-!! formulation.
-!! The different prognostic variables are treated one by one.
-!! The contributions of each turbulent fluxes are cumulated into the
-!! tendency PRvarS, and into the dynamic and thermal production of
-!! TKE if necessary.
-!!
-!! In section 2 and 3, the thermodynamical fields are considered.
-!! Only the turbulent fluxes of the conservative variables
-!! (Thetal and Rnp stored in PRx(:,:,:,1)) are computed.
-!! Note that the turbulent fluxes at the vertical
-!! boundaries are given either by the soil scheme for the surface one
-!! ( at the same instant as the others fluxes) and equal to 0 at the
-!! top of the model. The thermal production is computed by vertically
-!! averaging the turbulent flux and multiply this flux at the mass point by
-!! a function ETHETA or EMOIST, which preform the transformation from the
-!! conservative variables to the virtual potential temperature.
-!!
-!! In section 4, the variance of the statistical variable
-!! s indicating presence or not of condensation, is determined in function
-!! of the turbulent moments of the conservative variables and its
-!! squarred root is stored in PSIGS. This information will be completed in
-!! the horizontal turbulence if the turbulence dimensionality is not
-!! equal to "1DIM".
-!!
-!! In section 5, the x component of the stress tensor is computed.
-!! The surface flux <u'w'> is computed from the value of the surface
-!! fluxes computed in axes linked to the orography ( i", j" , k"):
-!! i" is parallel to the surface and in the direction of the maximum
-!! slope
-!! j" is also parallel to the surface and in the normal direction of
-!! the maximum slope
-!! k" is the normal to the surface
-!! In order to prevent numerical instability, the implicit scheme has
-!! been extended to the surface flux regarding to its dependence in
-!! function of U. The dependence in function of the other components
-!! introduced by the different rotations is only explicit.
-!! The turbulent fluxes are used to compute the dynamic production of
-!! TKE. For the last TKE level ( located at PDZZ(:,:,IKB)/2 from the
-!! ground), an harmonic extrapolation from the dynamic production at
-!! PDZZ(:,:,IKB) is used to avoid an evaluation of the gradient of U
-!! in the surface layer.
-!!
-!! In section 6, the same steps are repeated but for the y direction
-!! and in section 7, a diagnostic computation of the W variance is
-!! performed.
-!!
-!! In section 8, the turbulent fluxes for the scalar variables are
-!! computed by the same way as the conservative thermodynamical variables
-!!
-!!
-!! EXTERNAL
-!! --------
-!! GX_U_M, GY_V_M, GZ_W_M : cartesian gradient operators
-!! GX_U_UW,GY_V_VW (X,Y,Z) represent the direction of the gradient
-!! _(M,U,...)_ represent the localization of the
-!! field to be derivated
-!! _(M,UW,...) represent the localization of the
-!! field derivated
-!!
-!!
-!! MXM,MXF,MYM,MYF,MZM,MZF
-!! : Shuman functions (mean operators)
-!! DXF,DYF,DZF,DZM
-!! : Shuman functions (difference operators)
-!!
-!! SUBROUTINE TRIDIAG : to compute the splitted implicit evolution
-!! of a variable located at a mass point
-!!
-!! SUBROUTINE TRIDIAG_WIND: to compute the splitted implicit evolution
-!! of a variable located at a wind point
-!!
-!! FUNCTIONs ETHETA and EMOIST :
-!! allows to compute:
-!! - the coefficients for the turbulent correlation between
-!! any variable and the virtual potential temperature, of its
-!! correlations with the conservative potential temperature and
-!! the humidity conservative variable:
-!! ------- ------- -------
-!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CST : contains physical constants
-!!
-!! XG : gravity constant
-!!
-!! Module MODD_CTURB: contains the set of constants for
-!! the turbulence scheme
-!!
-!! XCMFS,XCMFB : cts for the momentum flux
-!! XCSHF : ct for the sensible heat flux
-!! XCHF : ct for the moisture flux
-!! XCTV,XCHV : cts for the T and moisture variances
-!!
-!! Module MODD_PARAMETERS
-!!
-!! JPVEXT_TURB : number of vertical external points
-!! JPHEXT : number of horizontal external points
-!!
-!!
-!! REFERENCE
-!! ---------
-!! Book 1 of documentation (Chapter: Turbulence)
-!!
-!! AUTHOR
-!! ------
-!! Joan Cuxart * INM and Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original August 19, 1994
-!! Modifications: February 14, 1995 (J.Cuxart and J.Stein)
-!! Doctorization and Optimization
-!! Modifications: March 21, 1995 (J.M. Carriere)
-!! Introduction of cloud water
-!! Modifications: June 14, 1995 (J.Cuxart and J. Stein)
-!! Phi3 and Psi3 at w-point + bug in the all
-!! or nothing condens.
-!! Modifications: Sept 15, 1995 (J.Cuxart and J. Stein)
-!! Change the DP computation at the ground
-!! Modifications: October 10, 1995 (J.Cuxart and J. Stein)
-!! Psi for scal var and LES tools
-!! Modifications: November 10, 1995 (J. Stein)
-!! change the surface relations
-!! Modifications: February 20, 1995 (J. Stein) optimization
-!! Modifications: May 21, 1996 (J. Stein)
-!! bug in the vertical flux of the V wind
-!! component for explicit computation
-!! Modifications: May 21, 1996 (N. wood)
-!! modify the computation of the vertical
-!! part or the surface tangential flux
-!! Modifications: May 21, 1996 (P. Jabouille)
-!! same modification in the Y direction
-!!
-!! Modifications: Sept 17, 1996 (J. Stein) change the moist case by using
-!! Pi instead of Piref + use Atheta and Amoist
-!!
-!! Modifications: Nov 24, 1997 (V. Masson) removes the DO loops
-!! Modifications: Mar 31, 1998 (V. Masson) splits the routine TURB_VER_THERMO_FLUX
-!! Modifications: Oct 18, 2000 (V. Masson) LES computations
-!! Modifications: Dec 01, 2000 (V. Masson) conservation of energy from
-!! surface flux in 1DIM case
-!! when slopes are present
-!! Nov 06, 2002 (V. Masson) LES budgets
-!! Feb 20, 2003 (JP Pinty) Add PFRAC_ICE
-!! May 20, 2003 (JP Pinty) Correction of ETHETA
-!! and EMOIST calls
-!! July 2005 (S. Tomas, V. Masson)
-!! Add 3rd order moments
-!! and implicitation of PHI3 and PSI3
-!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
-!! change of YCOMMENT
-!! 2012-02 (Y. Seity) add possibility to run with reversed
-!! vertical levels
-!! Modifications July 2015 (Wim de Rooy) LHARAT switch
-!!--------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-USE MODD_CTURB
-USE MODD_PARAMETERS
-USE MODD_CONF
-USE MODD_LES
-!
-USE MODI_GRADIENT_U
-USE MODI_GRADIENT_V
-USE MODI_GRADIENT_W
-USE MODI_GRADIENT_M
-USE MODI_SHUMAN , ONLY : DZF, DZM, MZF, MZM
-USE MODI_TRIDIAG
-USE MODE_FMWRIT
-USE MODI_LES_MEAN_SUBGRID
-USE MODI_PRANDTL
-USE MODI_TRIDIAG_THERMO
-USE MODI_TM06_H
-!
-USE MODE_PRANDTL
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-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.
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-CHARACTER*4, INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-CHARACTER*4, INTENT(IN) :: HTOM ! type of Third Order Moment
-REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
-REAL, INTENT(IN) :: PTSTEP ! Double Time Step
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output
- ! FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ, PDXX, PDYY, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
- ! normal to the ground surface
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitudes
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: MFMOIST ! moist mass flux dual scheme
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state Virtual
- ! Potential Temperature
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM ! surface fluxes at time
-! ! t - deltat
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHP,PSFRP ! surface fluxes at time
-! ! t + deltat
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM
-! Vertical wind
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
-! potential temperature at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios
- ! at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Mixing ratios
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-!
-! In case LHARAT=TRUE, PLM already includes all stability corrections
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
-! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFRAC_ICE ! ri fraction of rc+ri
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PBETA ! buoyancy coefficient
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE ! sqrt(e)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTH_DZ ! d(th)/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDR_DZ ! d(rt)/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2TH3 ! 3D Redeslperger number R*2_th
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2R3 ! 3D Redeslperger number R*2_r
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2THR3 ! 3D Redeslperger number R*2_thr
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E ! beta * Lk * Leps / tke
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA ! Coefficient for theta in theta_v computation
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST ! Coefficient for r in theta_v computation
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1 ! 1D Redelsperger number for Th
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1 ! 1D Redelsperger number for r
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3 ! Prandtl number for temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3 ! Prandtl number for vapor
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PD ! Denominator in Prandtl numbers
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWTH ! d(w'2th' )/dz (at flux point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWR ! d(w'2r' )/dz (at flux point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTH2 ! d(w'th'2 )/dz (at mass point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFR2 ! d(w'r'2 )/dz (at mass point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTHR ! d(w'th'r')/dz (at mass point)
-REAL, DIMENSION(:,:), INTENT(INOUT):: PBL_DEPTH ! BL depth
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTHV ! buoyancy flux
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHLS ! cumulated source for theta
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS ! cumulated source for rt
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHLP ! guess of thl at t+ deltat
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRP ! guess of r at t+ deltat
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PTP ! Dynamic and thermal
- ! TKE production terms
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTH ! heat flux
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWRC ! cloud water flux
-!
-!
-!* 0.2 declaration of local variables
-!
-!
-REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
- ZA, & ! work variable for wrc or LES computation
- ZFLXZ, & ! vertical flux of the treated variable
- ZSOURCE, & ! source of evolution for the treated variable
- ZKEFF, & ! effectif diffusion coeff = LT * SQRT( TKE )
- ZF, & ! Flux in dTh/dt =-dF/dz (evaluated at t-1)(or rt instead of Th)
- ZDFDDTDZ, & ! dF/d(dTh/dz)
- ZDFDDRDZ, & ! dF/d(dr/dz)
- Z3RDMOMENT ! 3 order term in flux or variance equation
-INTEGER :: IRESP ! Return code of FM routines
-INTEGER :: IGRID ! C-grid indicator in LFIFM file
-INTEGER :: ILENCH ! Length of comment string in LFIFM file
-INTEGER :: IKB,IKE ! I index values for the Beginning and End
- ! mass points of the domain in the 3 direct.
-INTEGER :: IKT ! array size in k direction
-INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
-CHARACTER (LEN=100) :: YCOMMENT ! comment string in LFIFM file
-CHARACTER (LEN=16) :: YRECFM ! Name of the desired field in LFIFM file
-!
-REAL :: ZTIME1, ZTIME2
-!
-INTEGER :: JK
-LOGICAL :: GUSERV ! flag to use water
-LOGICAL :: GFTH2 ! flag to use w'th'2
-LOGICAL :: GFWTH ! flag to use w'2th'
-LOGICAL :: GFR2 ! flag to use w'r'2
-LOGICAL :: GFWR ! flag to use w'2r'
-LOGICAL :: GFTHR ! flag to use w'th'r'
-!----------------------------------------------------------------------------
-!
-!* 1. PRELIMINARIES
-! -------------
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK('TURB_VER_THERMO_FLUX',0,ZHOOK_HANDLE)
-IKT =SIZE(PTHLM,3)
-IKTE =IKT-JPVEXT_TURB
-IKTB =1+JPVEXT_TURB
-IKB=KKA+JPVEXT_TURB*KKL
-IKE=KKU-JPVEXT_TURB*KKL
-!
-GUSERV = (KRR/=0)
-!
-! compute the coefficients for the uncentred gradient computation near the
-! ground
-!
-IF (LHARAT) THEN
-! LHARAT so TKE and length scales at half levels!
-ZKEFF(:,:,:) = PLM(:,:,:) * SQRT(PTKEM(:,:,:)) +50.*MFMOIST(:,:,:)
-ELSE
-ZKEFF(:,:,:) = MZM(PLM(:,:,:) * SQRT(PTKEM(:,:,:)), KKA, KKU, KKL)
-ENDIF
-!
-!
-! Flags for 3rd order quantities
-!
-GFTH2 = .FALSE.
-GFR2 = .FALSE.
-GFTHR = .FALSE.
-GFWTH = .FALSE.
-GFWR = .FALSE.
-!
-IF (HTOM/='NONE') THEN
- GFTH2 = ANY(PFTH2/=0.)
- GFR2 = ANY(PFR2 /=0.) .AND. GUSERV
- GFTHR = ANY(PFTHR/=0.) .AND. GUSERV
- GFWTH = ANY(PFWTH/=0.)
- GFWR = ANY(PFWR /=0.) .AND. GUSERV
-END IF
-!----------------------------------------------------------------------------
-!
-!* 2. SOURCES OF CONSERVATIVE POTENTIAL TEMPERATURE AND
-! PARTIAL THERMAL PRODUCTION
-! ---------------------------------------------------------------
-!
-!* 2.1 Splitted value for cons. potential temperature at t+deltat
-!
-! Compute the turbulent flux F and F' at time t-dt.
-!
-IF (LHARAT) THEN
-ZF (:,:,:) = -ZKEFF*DZM(PTHLM, KKA, KKU, KKL)/PDZZ
-ZDFDDTDZ(:,:,:) = -ZKEFF
-ELSE
-ZF (:,:,:) = -XCSHF*PPHI3*ZKEFF*DZM(PTHLM, KKA, KKU, KKL)/PDZZ
-ZDFDDTDZ(:,:,:) = -XCSHF*ZKEFF*D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,GUSERV)
-ENDIF
-!
-! Effect of 3rd order terms in temperature flux (at flux point)
-!
-! d(w'2th')/dz
-IF (GFWTH) THEN
- Z3RDMOMENT= M3_WTH_W2TH(KKA,KKU,KKL,PREDTH1,PREDR1,PD,ZKEFF,PTKEM)
-!
- ZF = ZF + Z3RDMOMENT * PFWTH
- ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
- & PD,PBLL_O_E,PETHETA,ZKEFF,PTKEM) * PFWTH
-END IF
-!
-! d(w'th'2)/dz
-IF (GFTH2) THEN
- Z3RDMOMENT= M3_WTH_WTH2(PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA)
-!
- ZF = ZF + Z3RDMOMENT * MZM(PFTH2, KKA, KKU, KKL)
- ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_WTH2_O_DDTDZ(Z3RDMOMENT,PREDTH1,PREDR1,&
- & PD,PBLL_O_E,PETHETA) * MZM(PFTH2, KKA, KKU, KKL)
-END IF
-!
-! d(w'2r')/dz
-IF (GFWR) THEN
- ZF = ZF + M3_WTH_W2R(KKA,KKU,KKL,PREDTH1,PREDR1,PD,ZKEFF,&
- & PTKEM,PBLL_O_E,PEMOIST,PDTH_DZ) * PFWR
- ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_W2R_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
- & PD,ZKEFF,PTKEM,PBLL_O_E,PEMOIST) * PFWR
-END IF
-!
-! d(w'r'2)/dz
-IF (GFR2) THEN
- ZF = ZF + M3_WTH_WR2(KKA,KKU,KKL,PREDTH1,PREDR1,PD,ZKEFF,PTKEM,&
- & PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTH_DZ) * MZM(PFR2, KKA, KKU, KKL)
- ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_WR2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,&
- & ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST) * MZM(PFR2, KKA, KKU, KKL)
-END IF
-!
-! d(w'th'r')/dz
-IF (GFTHR) THEN
- Z3RDMOMENT= M3_WTH_WTHR(KKA,KKU,KKL,PREDR1,PD,ZKEFF,PTKEM,PSQRT_TKE,PBETA,&
- & PLEPS,PEMOIST)
-!
- ZF = ZF + Z3RDMOMENT * MZM(PFTHR, KKA, KKU, KKL)
- ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_WTHR_O_DDTDZ(Z3RDMOMENT,PREDTH1,&
- & PREDR1,PD,PBLL_O_E,PETHETA) * MZM(PFTHR, KKA, KKU, KKL)
-END IF
-!
-!* in 3DIM case, a part of the flux goes vertically, and another goes horizontally
-! (in presence of slopes)
-!* in 1DIM case, the part of energy released in horizontal flux
-! is taken into account in the vertical part
-!
-IF (HTURBDIM=='3DIM') THEN
- ZF(:,:,IKB) = ( PIMPL*PSFTHP(:,:) + PEXPL*PSFTHM(:,:) ) &
- * PDIRCOSZW(:,:) &
- * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
-ELSE
- ZF(:,:,IKB) = ( PIMPL*PSFTHP(:,:) + PEXPL*PSFTHM(:,:) ) &
- / PDIRCOSZW(:,:) &
- * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
-END IF
-!
-! Compute the splitted conservative potential temperature at t+deltat
-CALL TRIDIAG_THERMO(KKA,KKU,KKL,PTHLM,ZF,ZDFDDTDZ,PTSTEP,PIMPL,PDZZ,&
- PRHODJ,PTHLP)
-!
-! Compute the equivalent tendency for the conservative potential temperature
-PRTHLS(:,:,:)= PRTHLS(:,:,:) + &
- PRHODJ(:,:,:)*(PTHLP(:,:,:)-PTHLM(:,:,:))/PTSTEP
-!
-!* 2.2 Partial Thermal Production
-!
-! Conservative potential temperature flux :
-!
-ZFLXZ(:,:,:) = ZF &
- + PIMPL * ZDFDDTDZ * DZM(PTHLP - PTHLM, KKA, KKU, KKL) / PDZZ
-!
-ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
-!
- DO JK=IKTB+1,IKTE-1
- PWTH(:,:,JK)=0.5*(ZFLXZ(:,:,JK)+ZFLXZ(:,:,JK+KKL))
- END DO
- PWTH(:,:,IKB)=0.5*(ZFLXZ(:,:,IKB)+ZFLXZ(:,:,IKB+KKL))
- PWTH(:,:,KKA)=0.5*(ZFLXZ(:,:,KKA)+ZFLXZ(:,:,KKA+KKL))
- PWTH(:,:,IKE)=PWTH(:,:,IKE-KKL)
-
-IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
- ! stores the conservative potential temperature vertical flux
- YRECFM ='THW_FLX'
- YCOMMENT='X_Y_Z_THW_FLX (K*M/S)'
- IGRID = 4
- ILENCH=LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZFLXZ,IGRID,ILENCH,YCOMMENT,IRESP)
-END IF
-!
-! Contribution of the conservative temperature flux to the buoyancy flux
-IF (KRR /= 0) THEN
- PTP(:,:,:) = PBETA * MZF(MZM(PETHETA, KKA, KKU, KKL) * ZFLXZ, KKA, KKU, KKL)
- PTP(:,:,IKB)= PBETA(:,:,IKB) * PETHETA(:,:,IKB) * &
- 0.5 * ( ZFLXZ (:,:,IKB) + ZFLXZ (:,:,IKB+KKL) )
-ELSE
- PTP(:,:,:)= PBETA * MZF(ZFLXZ, KKA, KKU, KKL)
-END IF
-!
-! Buoyancy flux at flux points
-!
-PWTHV = MZM(PETHETA, KKA, KKU, KKL) * ZFLXZ
-PWTHV(:,:,IKB) = PETHETA(:,:,IKB) * ZFLXZ(:,:,IKB)
-!
-!* 2.3 Partial vertical divergence of the < Rc w > flux
-! Correction for qc and qi negative in AROME
-!IF ( KRRL >= 1 ) THEN
-! IF ( KRRI >= 1 ) THEN
-! PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
-! DZF(MZM(PRHODJ*PATHETA*2.*PSRCM, KKA, KKU, KKL)*ZFLXZ/PDZZ, KKA, KKU, KKL) &
-! *(1.0-PFRAC_ICE(:,:,:))
-! PRRS(:,:,:,4) = PRRS(:,:,:,4) - &
-! DZF(MZM(PRHODJ*PATHETA*2.*PSRCM, KKA, KKU, KKL)*ZFLXZ/PDZZ, KKA, KKU, KKL) &
-! *PFRAC_ICE(:,:,:)
-! ELSE
-! PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
-! DZF(MZM(PRHODJ*PATHETA*2.*PSRCM, KKA, KKU, KKL)*ZFLXZ/PDZZ, KKA, KKU, KKL)
-! END IF
-!END IF
-!
-!* 2.4 Storage in LES configuration
-!
-IF (LLES_CALL) THEN
- CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID(MZF(ZFLXZ, KKA, KKU, KKL), X_LES_SUBGRID_WThl )
- CALL LES_MEAN_SUBGRID(MZF(PWM*ZFLXZ, KKA, KKU, KKL), X_LES_RES_W_SBG_WThl )
- CALL LES_MEAN_SUBGRID(GZ_W_M(PWM,PDZZ, KKA, KKU, KKL)*MZF(ZFLXZ, KKA, KKU, KKL),&
- & X_LES_RES_ddxa_W_SBG_UaThl )
- CALL LES_MEAN_SUBGRID(MZF(PDTH_DZ*ZFLXZ, KKA, KKU, KKL), X_LES_RES_ddxa_Thl_SBG_UaThl )
- CALL LES_MEAN_SUBGRID(-XCTP*PSQRT_TKE/PLM*MZF(ZFLXZ, KKA, KKU, KKL), X_LES_SUBGRID_ThlPz )
- CALL LES_MEAN_SUBGRID(MZF(MZM(PETHETA, KKA, KKU, KKL)*ZFLXZ, KKA, KKU, KKL), X_LES_SUBGRID_WThv )
- IF (KRR>=1) THEN
- CALL LES_MEAN_SUBGRID(MZF(PDR_DZ*ZFLXZ, KKA, KKU, KKL), X_LES_RES_ddxa_Rt_SBG_UaThl )
- END IF
- !* diagnostic of mixing coefficient for heat
- ZA = DZM(PTHLP, KKA, KKU, KKL)
- WHERE (ZA==0.) ZA=1.E-6
- ZA = - ZFLXZ / ZA * PDZZ
- ZA(:,:,IKB) = XCSHF*PPHI3(:,:,IKB)*ZKEFF(:,:,IKB)
- ZA = MZF(ZA, KKA, KKU, KKL)
- ZA = MIN(MAX(ZA,-1000.),1000.)
- CALL LES_MEAN_SUBGRID( ZA, X_LES_SUBGRID_Kh )
- !
- CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
-END IF
-!
-!* 2.5 New boundary layer depth for TOMs
-!
-IF (HTOM=='TM06') CALL TM06_H(IKB,IKTB,IKTE,PTSTEP,PZZ,ZFLXZ,PBL_DEPTH)
-!
-!----------------------------------------------------------------------------
-!
-!
-!* 3. SOURCES OF CONSERVATIVE AND CLOUD MIXING RATIO AND
-! COMPLETE THERMAL PRODUCTION
-! ------------------------------------------------------
-!
-!* 3.1 Splitted value for cons. mixing ratio at t+deltat
-!
-!
-IF (KRR /= 0) THEN
- ! Compute the turbulent flux F and F' at time t-dt.
- !
- IF (LHARAT) THEN
- ZF (:,:,:) = -ZKEFF*DZM(PRM(:,:,:,1), KKA, KKU, KKL)/PDZZ
- ZDFDDRDZ(:,:,:) = -ZKEFF
- ELSE
- ZF (:,:,:) = -XCSHF*PPSI3*ZKEFF*DZM(PRM(:,:,:,1), KKA, KKU, KKL)/PDZZ
- ZDFDDRDZ(:,:,:) = -XCSHF*ZKEFF*D_PSI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,GUSERV)
- ENDIF
- !
- ! Effect of 3rd order terms in temperature flux (at flux point)
- !
- ! d(w'2r')/dz
- IF (GFWR) THEN
- Z3RDMOMENT= M3_WR_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,ZKEFF,PTKEM)
- !
- ZF = ZF + Z3RDMOMENT * PFWR
- ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,&
- & PBLL_O_E,PEMOIST,ZKEFF,PTKEM) * PFWR
- END IF
- !
- ! d(w'r'2)/dz
- IF (GFR2) THEN
- Z3RDMOMENT= M3_WR_WR2(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
- !
- ZF = ZF + Z3RDMOMENT * MZM(PFR2, KKA, KKU, KKL)
- ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_WR2_O_DDRDZ(Z3RDMOMENT,PREDR1,&
- & PREDTH1,PD,PBLL_O_E,PEMOIST) * MZM(PFR2, KKA, KKU, KKL)
- END IF
- !
- ! d(w'2th')/dz
- IF (GFWTH) THEN
- ZF = ZF + M3_WR_W2TH(KKA,KKU,KKL,PREDR1,PREDTH1,PD,ZKEFF,&
- & PTKEM,PBLL_O_E,PETHETA,PDR_DZ) * PFWTH
- ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,&
- & PD,ZKEFF,PTKEM,PBLL_O_E,PETHETA) * PFWTH
- END IF
- !
- ! d(w'th'2)/dz
- IF (GFTH2) THEN
- ZF = ZF + M3_WR_WTH2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,ZKEFF,PTKEM,&
- & PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDR_DZ) * MZM(PFTH2, KKA, KKU, KKL)
- ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,&
- &ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA) * MZM(PFTH2, KKA, KKU, KKL)
- END IF
- !
- ! d(w'th'r')/dz
- IF (GFTHR) THEN
- Z3RDMOMENT= M3_WR_WTHR(KKA,KKU,KKL,PREDTH1,PD,ZKEFF,PTKEM,PSQRT_TKE,PBETA,&
- & PLEPS,PETHETA)
- !
- ZF = ZF + Z3RDMOMENT * MZM(PFTHR, KKA, KKU, KKL)
- ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_WTHR_O_DDRDZ(KKA,KKU,KKL,Z3RDMOMENT,PREDR1, &
- & PREDTH1,PD,PBLL_O_E,PEMOIST) * MZM(PFTHR, KKA, KKU, KKL)
- END IF
- !
- !* in 3DIM case, a part of the flux goes vertically, and another goes horizontally
- ! (in presence of slopes)
- !* in 1DIM case, the part of energy released in horizontal flux
- ! is taken into account in the vertical part
- !
- IF (HTURBDIM=='3DIM') THEN
- ZF(:,:,IKB) = ( PIMPL*PSFRP(:,:) + PEXPL*PSFRM(:,:) ) &
- * PDIRCOSZW(:,:) &
- * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
- ELSE
- ZF(:,:,IKB) = ( PIMPL*PSFRP(:,:) + PEXPL*PSFRM(:,:) ) &
- / PDIRCOSZW(:,:) &
- * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
- END IF
- !
- ! Compute the splitted conservative potential temperature at t+deltat
- CALL TRIDIAG_THERMO(KKA,KKU,KKL,PRM(:,:,:,1),ZF,ZDFDDRDZ,PTSTEP,PIMPL,&
- PDZZ,PRHODJ,PRP)
- !
- ! Compute the equivalent tendency for the conservative mixing ratio
- PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRHODJ(:,:,:) * &
- (PRP(:,:,:)-PRM(:,:,:,1))/PTSTEP
- !
- !* 3.2 Complete thermal production
- !
- ! cons. mixing ratio flux :
- !
- ZFLXZ(:,:,:) = ZF &
- + PIMPL * ZDFDDRDZ * DZM(PRP - PRM(:,:,:,1), KKA, KKU, KKL) / PDZZ
- !
- ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
- !
- DO JK=IKTB+1,IKTE-1
- PWRC(:,:,JK)=0.5*(ZFLXZ(:,:,JK)+ZFLXZ(:,:,JK+KKL))
- END DO
- PWRC(:,:,IKB)=0.5*(ZFLXZ(:,:,IKB)+ZFLXZ(:,:,IKB+KKL))
- PWRC(:,:,KKA)=0.5*(ZFLXZ(:,:,KKA)+ZFLXZ(:,:,KKA+KKL))
- PWRC(:,:,IKE)=PWRC(:,:,IKE-KKL)
- !
- !
- IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
- ! stores the conservative mixing ratio vertical flux
- YRECFM ='RCONSW_FLX'
- YCOMMENT='X_Y_Z_RCONSW_FLX (KG*M/S/KG)'
- IGRID = 4
- ILENCH=LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZFLXZ,IGRID,ILENCH,YCOMMENT,IRESP)
- END IF
- !
- ! Contribution of the conservative water flux to the Buoyancy flux
- ZA(:,:,:) = PBETA * MZF(MZM(PEMOIST, KKA, KKU, KKL) * ZFLXZ, KKA, KKU, KKL)
- ZA(:,:,IKB) = PBETA(:,:,IKB) * PEMOIST(:,:,IKB) * &
- 0.5 * ( ZFLXZ (:,:,IKB) + ZFLXZ (:,:,IKB+KKL) )
- PTP(:,:,:) = PTP(:,:,:) + ZA(:,:,:)
- !
- ! Buoyancy flux at flux points
- !
- PWTHV = PWTHV + MZM(PEMOIST, KKA, KKU, KKL) * ZFLXZ
- PWTHV(:,:,IKB) = PWTHV(:,:,IKB) + PEMOIST(:,:,IKB) * ZFLXZ(:,:,IKB)
-!
-!* 3.3 Complete vertical divergence of the < Rc w > flux
-! Correction of qc and qi negative for AROME
-! IF ( KRRL >= 1 ) THEN
-! IF ( KRRI >= 1 ) THEN
-! PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
-! DZF(MZM(PRHODJ*PAMOIST*2.*PSRCM, KKA, KKU, KKL)*ZFLXZ/PDZZ, KKA, KKU, KKL) &
-! *(1.0-PFRAC_ICE(:,:,:))
-! PRRS(:,:,:,4) = PRRS(:,:,:,4) - &
-! DZF(MZM(PRHODJ*PAMOIST*2.*PSRCM, KKA, KKU, KKL)*ZFLXZ/PDZZ, KKA, KKU, KKL) &
-! *PFRAC_ICE(:,:,:)
-! ELSE
-! PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
-! DZF(MZM(PRHODJ*PAMOIST*2.*PSRCM, KKA, KKU, KKL)*ZFLXZ/PDZZ, KKA, KKU, KKL)
-! END IF
-! END IF
-!
-!* 3.4 Storage in LES configuration
-!
- IF (LLES_CALL) THEN
- CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID(MZF(ZFLXZ, KKA, KKU, KKL), X_LES_SUBGRID_WRt )
- CALL LES_MEAN_SUBGRID(MZF(PWM*ZFLXZ, KKA, KKU, KKL), X_LES_RES_W_SBG_WRt )
- CALL LES_MEAN_SUBGRID(GZ_W_M(PWM,PDZZ, KKA, KKU, KKL)*MZF(ZFLXZ, KKA, KKU, KKL),&
- & X_LES_RES_ddxa_W_SBG_UaRt )
- CALL LES_MEAN_SUBGRID(MZF(PDTH_DZ*ZFLXZ, KKA, KKU, KKL), X_LES_RES_ddxa_Thl_SBG_UaRt )
- CALL LES_MEAN_SUBGRID(MZF(PDR_DZ*ZFLXZ, KKA, KKU, KKL), X_LES_RES_ddxa_Rt_SBG_UaRt )
- CALL LES_MEAN_SUBGRID(MZF(MZM(PEMOIST, KKA, KKU, KKL)*ZFLXZ, KKA, KKU, KKL), X_LES_SUBGRID_WThv , .TRUE. )
- CALL LES_MEAN_SUBGRID(-XCTP*PSQRT_TKE/PLM*MZF(ZFLXZ, KKA, KKU, KKL), X_LES_SUBGRID_RtPz )
- CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
- END IF
-!
-END IF
-!
-!----------------------------------------------------------------------------
-!
-!
-!* 4. TURBULENT CORRELATIONS : <w Rc>
-! -------------------------------
-!
-!
-!* 4.1 <w Rc>
-!
-IF ( ((OTURB_FLX .AND. OCLOSE_OUT) .OR. LLES_CALL) .AND. (KRRL > 0) ) THEN
-!
-! recover the Conservative potential temperature flux :
-! With LHARAT is true tke and length scales at half levels
-! yet modify to use length scale and tke at half levels from vdfexcuhl
- IF (LHARAT) THEN
- ZA(:,:,:) = DZM(PIMPL * PTHLP + PEXPL * PTHLM, KKA, KKU, KKL) / PDZZ * &
- (-PLM*PSQRT_TKE)
- ELSE
- ZA(:,:,:) = DZM(PIMPL * PTHLP + PEXPL * PTHLM, KKA, KKU, KKL) / PDZZ * &
- (-PPHI3*MZM(PLM*PSQRT_TKE, KKA, KKU, KKL)) * XCSHF
- ENDIF
- ZA(:,:,IKB) = ( PIMPL*PSFTHP(:,:) + PEXPL*PSFTHM(:,:) ) &
- * PDIRCOSZW(:,:)
- !
- ! compute <w Rc>
- ZFLXZ(:,:,:) = MZM(PAMOIST * 2.* PSRCM, KKA, KKU, KKL) * ZFLXZ(:,:,:) + &
- MZM(PATHETA * 2.* PSRCM, KKA, KKU, KKL) * ZA(:,:,:)
- ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
- !
- ! store the liquid water mixing ratio vertical flux
- IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
- YRECFM ='RCW_FLX'
- YCOMMENT='X_Y_Z_RCW_FLX (KG*M/S/KG)'
- IGRID = 4
- ILENCH=LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZFLXZ,IGRID,ILENCH,YCOMMENT,IRESP)
- END IF
- !
-! and we store in LES configuration this subgrid flux <w'rc'>
-!
- IF (LLES_CALL) THEN
- CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(ZFLXZ, KKA, KKU, KKL), X_LES_SUBGRID_WRc )
- CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
- END IF
-!
-END IF !end of <w Rc>
-!
-!----------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('TURB_VER_THERMO_FLUX',1,ZHOOK_HANDLE)
-END SUBROUTINE TURB_VER_THERMO_FLUX
diff --git a/src/common/aux/modd_blowsnow.F90 b/src/common/aux/modd_blowsnow.F90
new file mode 100644
index 0000000000000000000000000000000000000000..36180eadd60e261aa7b39b19e96edbda940c31f6
--- /dev/null
+++ b/src/common/aux/modd_blowsnow.F90
@@ -0,0 +1,80 @@
+!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_BLOWSNOW
+!! ######################
+!!
+!! PURPOSE
+!! -------
+!!
+!! Declaration of variables and types for the blowing snow scheme
+!!
+!! METHOD
+!! ------
+!!
+!!
+!! REFERENCE
+!! ---------
+!! Etudes du transport de la neige par le vent en conditions alpines :
+!! Observations et simulations à l'aide d'un modèle couplé atmosphère/
+!! manteau neigeux (Thèse, Uni. Paris Est, 2012)
+!!
+!!
+!! AUTHOR
+!! ------
+!! Vincent Vionnet (CNRM)
+!!
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!!--------------------------------------------------------------------
+!! DECLARATIONS
+!! ------------
+IMPLICIT NONE
+
+LOGICAL :: LBLOWSNOW = .FALSE. ! switch to active pronostic blowing snow
+!
+INTEGER :: NBLOWSNOW3D = 2 ! Number of blowing snow variables
+! as scalar in Meso-NH. The curent version of the model use two scalars:
+! - Number concentration (#/kg)
+! - Mass concentration (kg/kg)
+
+INTEGER :: NBLOWSNOW_2D = 3 ! Number of 2D blowing snow variables
+! adected in Meso-NH. The curent version of the model advectes three variables:
+! - total number concentration in Canopy
+! - total mass concentration in Canopy
+! - equivalent concentration in the saltation layer
+!
+REAL :: XALPHA_SNOW ! Gamma distribution shape factor
+!
+REAL :: XRSNOW ! Ratio between diffusion coefficient for scalar
+ ! variables and blowing snow variables
+ ! RSNOW = KSCA/KSNOW = 4. (if Redelsperger-Sommeria (1981) used in ini_cturb)
+ ! RSNOW = KSCA/KSNOW = 2.5 ( if Cheng-Canuto-Howard (2002) used in ini_cturb)
+ ! Cheng-Canuto-Howard (2002) is the default in MNH V5.3
+ ! See Vionnet (PhD, 2012, In French) and Vionnet et al (TC, 2014)
+ ! for a complete dicsussion
+CHARACTER(LEN=6),DIMENSION(:),ALLOCATABLE :: CSNOWNAMES
+
+CHARACTER(LEN=6),DIMENSION(2), PARAMETER :: YPSNOW_INI = &
+ (/'SNWM01','SNWM02'/)
+!
+CHARACTER(LEN=6),DIMENSION(3), PARAMETER :: YPBLOWSNOW_2D = &
+ (/'SNWCNU','SNWCMA','SNWCSA' /)
+
+CHARACTER(LEN=4) :: CSNOWSEDIM ! type of formulation for snow
+! sedimentation : MITC : Mitchell (1996)
+! CARR : Carrier's drag coefficient (cf PIEKTUK)
+! TABC : Tabulated values from Carrier's drag coefficient
+! NONE : no seidmentation
+!Minimal mean radius (um)
+REAL :: XINIRADIUS_SNW = 5.e-6
+!Minimum allowed number concentration (#/m3)
+REAL :: XN0MIN_SNW = 1
+!
+!
+END MODULE MODD_BLOWSNOW
diff --git a/src/arome/micro/modd_conf.F90 b/src/common/aux/modd_conf.F90
similarity index 84%
rename from src/arome/micro/modd_conf.F90
rename to src/common/aux/modd_conf.F90
index ec9f4bb1f1e49901d9f41ecb2fa2cd5ebeb891c4..ea493d3a32e075aa3e9c80506a89a1c5bc4d3b01 100644
--- a/src/arome/micro/modd_conf.F90
+++ b/src/common/aux/modd_conf.F90
@@ -1,4 +1,9 @@
-! ######spl
+!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_CONF
! #################
!
@@ -38,6 +43,10 @@
!! P. Jabouille 26/06/01 lagrangian variables
!! V. Masson 09/07/01 add LNEUTRAL switch
!! P. Jabouille 18/04/02 add NBUGFIX and CBIBUSER
+!! C. Lac 01/04/14 add LCHECK
+!! G. Tanguy 01/04/14 add LCOUPLING
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!!
!-------------------------------------------------------------------------------
!
@@ -59,7 +68,7 @@ LOGICAL,SAVE :: LTHINSHELL ! Logical for thinshell approximation
LOGICAL,SAVE :: LCARTESIAN ! Logical for cartesian geometry :
! .TRUE. = cartesian geometry
! .FALSE. = conformal projection
-LOGICAL,SAVE :: L2D ! Logical for 2D model version
+LOGICAL,SAVE :: L2D=.FALSE. ! Logical for 2D model version
! .TRUE. = 2D model version
! .FALSE. = 3D model version
LOGICAL,SAVE :: L1D ! Logical for 1D model version
@@ -91,13 +100,14 @@ CHARACTER (LEN=3),SAVE :: CEQNSYS! EQuatioN SYStem resolved by the MESONH model
LOGICAL,SAVE :: LPACK ! Logical to compress 1D or 2D FM files
!
!
+INTEGER,DIMENSION(3),SAVE :: NMNHVERSION ! Version of MesoNH
INTEGER,SAVE :: NMASDEV ! NMASDEV=XY corresponds to the masdevX_Y
INTEGER,SAVE :: NBUGFIX ! NBUGFIX=n corresponds to the BUGn of masdevX_Y
CHARACTER(LEN=10),SAVE :: CBIBUSER! CBIBUSER is the name of the user binary library
!
CHARACTER(LEN=6),SAVE :: CPROGRAM ! CPROGRAM is the program currently running:
! ! 'PGD ','ADVPGD','NESPGD','REAL ','IDEAL '
-! ! 'MESONH','SPAWN ','DIAG '
+! ! 'MESONH','SPAWN ','DIAG ','SPEC '
!
INTEGER,SAVE :: NHALO ! Size of the halo for parallel distribution
!
@@ -111,5 +121,9 @@ LOGICAL,SAVE :: LNOMIXLG ! to use turbulence for lagrangian variables
LOGICAL,SAVE :: LNEUTRAL ! True if ref. theta field is uniform
!
LOGICAL,SAVE :: LCPL_AROME ! true if coupling file are issued from AROME
+LOGICAL,SAVE :: LCOUPLING ! true if coupling file (and not intial file)
+ ! (with LCOUPLING=T in PREP_REAL_CASE)
+!
+LOGICAL,SAVE :: LCHECK ! To test reproducibility
!
END MODULE MODD_CONF
diff --git a/src/common/aux/modd_dimn.F90 b/src/common/aux/modd_dimn.F90
new file mode 100644
index 0000000000000000000000000000000000000000..622541f68f37ad130a45ecd4169932eae50f2967
--- /dev/null
+++ b/src/common/aux/modd_dimn.F90
@@ -0,0 +1,87 @@
+!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 modd 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+! ##################
+ MODULE MODD_DIM_n
+! ##################
+!
+!!**** *MODD_DIM$n* - declaration of dimensions
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to specify the dimensions
+! of the data arrays.
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (module MODD_DIMn)
+!! Technical Specifications Report of the Meso-NH (chapters 2 and 3)
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/05/94
+!! Modifications 13/08/98 (V. Ducrocq) // NIINF .. NJSUP are no more used in the init part
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
+IMPLICIT NONE
+
+TYPE DIM_t
+ INTEGER :: NIMAX,NJMAX,NKMAX ! Dimensions respectively in x ,
+ ! y , z directions of the physical sub-domain.
+ INTEGER :: NIMAX_ll,NJMAX_ll ! Dimensions respectively in x and y
+ ! directions of the physical domain
+ INTEGER :: NIINF, NISUP ! Lower bound and upper bound of the arrays
+ ! in x direction
+ INTEGER :: NJINF, NJSUP ! Lower bound and upper bound of the arrays
+ ! in y direction
+!
+END TYPE DIM_t
+
+TYPE(DIM_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: DIM_MODEL
+
+INTEGER, POINTER :: NIMAX=>NULL(),NJMAX=>NULL(),NKMAX=>NULL()
+INTEGER, POINTER :: NIMAX_ll=>NULL(),NJMAX_ll=>NULL()
+INTEGER, POINTER :: NIINF=>NULL(), NISUP=>NULL()
+INTEGER, POINTER :: NJINF=>NULL(), NJSUP=>NULL()
+
+CONTAINS
+
+SUBROUTINE DIM_GOTO_MODEL(KFROM, KTO)
+INTEGER, INTENT(IN) :: KFROM, KTO
+!
+! Save current state for allocated arrays
+!
+! Current model is set to model KTO
+NIMAX=>DIM_MODEL(KTO)%NIMAX
+NJMAX=>DIM_MODEL(KTO)%NJMAX
+NKMAX=>DIM_MODEL(KTO)%NKMAX
+NIMAX_ll=>DIM_MODEL(KTO)%NIMAX_ll
+NJMAX_ll=>DIM_MODEL(KTO)%NJMAX_ll
+NIINF=>DIM_MODEL(KTO)%NIINF
+NISUP=>DIM_MODEL(KTO)%NISUP
+NJINF=>DIM_MODEL(KTO)%NJINF
+NJSUP=>DIM_MODEL(KTO)%NJSUP
+
+END SUBROUTINE DIM_GOTO_MODEL
+
+END MODULE MODD_DIM_n
diff --git a/src/common/aux/modd_gridn.F90 b/src/common/aux/modd_gridn.F90
new file mode 100644
index 0000000000000000000000000000000000000000..055d3c88f76b4634b987607db83365a12e58710f
--- /dev/null
+++ b/src/common/aux/modd_gridn.F90
@@ -0,0 +1,67 @@
+!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_GRID_n
+! ##################
+!
+!!**** *MODD_GRID$n* - declaration of grid variables
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to declare the variables
+! describing the grid.
+!
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (module MODD_GRIDn)
+!! Technical Specifications Report of the Meso-NH (chapters 2 and 3)
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/05/94
+!! J. Stein 15/11/95 add the slope angle
+!! V. Ducrocq 13/08/98 // : add XLATOR_ll and XLONOR_ll
+!! V. Masson nov 2004 supress XLATOR,XLONOR,XLATOR_ll,XLONOR_ll
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
+IMPLICIT NONE
+
+REAL, DIMENSION(:,:), POINTER :: XLON=>NULL(),XLAT=>NULL() ! Longitude and latitude
+REAL, DIMENSION(:), POINTER :: XXHAT=>NULL() ! Position x in the conformal or cartesian plane
+REAL, DIMENSION(:), POINTER :: XYHAT=>NULL() ! Position y in the conformal or cartesian plane
+REAL, DIMENSION(:), POINTER :: XDXHAT=>NULL() ! horizontal stretching in x
+REAL, DIMENSION(:), POINTER :: XDYHAT=>NULL() ! horizontal stretching in y
+REAL, DIMENSION(:,:), POINTER :: XMAP=>NULL() ! Map factor
+REAL, DIMENSION(:,:), POINTER :: XZS=>NULL() ! orography
+REAL, DIMENSION(:,:,:),POINTER :: XZZ=>NULL() ! height z
+REAL, POINTER :: XZTOP=>NULL() ! model top (m)
+REAL, DIMENSION(:), POINTER :: XZHAT=>NULL() ! height level without orography
+REAL, DIMENSION(:,:), POINTER :: XDIRCOSXW=>NULL(),XDIRCOSYW=>NULL(),XDIRCOSZW=>NULL() ! director cosinus of the normal
+ ! to the ground surface
+REAL, DIMENSION(:,:), POINTER :: XCOSSLOPE=>NULL() ! cosinus of the angle between i and the slope vector
+REAL, DIMENSION(:,:), POINTER :: XSINSLOPE=>NULL() ! sinus of the angle between i and the slope vector
+! Quantities for SLEVE vertical coordinate
+LOGICAL, POINTER :: LSLEVE=>NULL() ! Logical for SLEVE coordinate
+REAL, POINTER :: XLEN1=>NULL() ! Decay scale for smooth topography
+REAL, POINTER :: XLEN2=>NULL() ! Decay scale for small-scale topography deviation
+REAL, DIMENSION(:,:), POINTER :: XZSMT=>NULL() ! smooth orography for SLEVE coordinate
+
+END MODULE MODD_GRID_n
diff --git a/src/common/aux/modd_io.F90 b/src/common/aux/modd_io.F90
index c111e469fb3d2014b7021eb698d564a94f0cf413..56ae6db2b0feebb2decd74b3d29fafaa44a9d1e0 100644
--- a/src/common/aux/modd_io.F90
+++ b/src/common/aux/modd_io.F90
@@ -1,6 +1,34 @@
MODULE MODD_IO
+USE MODD_PARAMETERS, ONLY: NFILENAMELGTMAX
+!
IMPLICIT NONE
-
+!
INTEGER, PARAMETER :: NVERB_NO=0, NVERB_FATAL=1, NVERB_ERROR=2, NVERB_WARNING=3, NVERB_INFO=4, NVERB_DEBUG=5
INTEGER, SAVE :: N_ABORT_LEVEL = NVERB_ERROR
+!
+!Structure describing the characteristics of a file
+TYPE TFILEDATA
+ CHARACTER(LEN=NFILENAMELGTMAX) :: CNAME = '' !Filename
+ CHARACTER(LEN=:),ALLOCATABLE :: CDIRNAME !Directory name
+ CHARACTER(LEN=13) :: CTYPE = "UNKNOWN" !Filetype (PGD, MNH, DES, NML...)
+ CHARACTER(LEN=7) :: CFORMAT = "UNKNOWN" !Fileformat (NETCDF4, LFI, LFICDF4...)
+ CHARACTER(LEN=7) :: CMODE = "UNKNOWN" !Opening mode (read, write...)
+ LOGICAL :: LOPENED = .FALSE. !Is the file opened
+ INTEGER :: NOPEN_CURRENT = 0 !Number of times the file is currently opened (several opens without close are allowed)
+ INTEGER :: NOPEN = 0 !Number of times the file has been opened (during the current execution)
+ INTEGER :: NCLOSE = 0 !Number of times the file has been closed (during the current execution)
+ !
+ INTEGER :: NMASTER_RANK = -1 !Rank of the master process (no meaning if LMULTIMASTERS=.T.)
+ INTEGER :: NMPICOMM = -1 !MPI communicator used for IO on this file
+ LOGICAL :: LMASTER = .FALSE. !True if process is master of the file (process that open/read/write/close)
+ LOGICAL :: LMULTIMASTERS = .FALSE. !True if several processes may access the file
+ INTEGER :: NSUBFILES_IOZ = 0 !Number of sub-files (Z-split files based on this file)
+ !For example if 2 sub-files and this file is abcd,
+ !the 2 sub-files are abcd.Z001 and abcd.Z002
+! TYPE(TFILE_ELT),DIMENSION(:),ALLOCATABLE :: TFILES_IOZ !Corresponding Z-split files
+ !
+ 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
+ !
+END TYPE TFILEDATA
ENDMODULE MODD_IO
diff --git a/src/arome/micro/modd_les.F90 b/src/common/aux/modd_les.F90
similarity index 95%
rename from src/arome/micro/modd_les.F90
rename to src/common/aux/modd_les.F90
index 9ebc913ed56d6bd264d38f01ac62d5cbddbb5999..389e2b1a35b949d75779e3bd8d384eeaf8967b63 100644
--- a/src/arome/micro/modd_les.F90
+++ b/src/common/aux/modd_les.F90
@@ -1,4 +1,9 @@
-! ######spl
+!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 MODD_LES
! ###############
!
@@ -34,7 +39,11 @@
!! V. Masson Nov. 6, 2002 LES budgets
!! F. Couvreux Oct 1, 2006 LES PDF
!! J.Pergaud Oct , 2007 MF LES
-!! P. Aumond Oct , 2009 User multimaskS + 4th order
+!! P. Aumond Oct ,2009 User multimaskS + 4th order
+!! C.Lac Oct ,2014 Correction on user masks
+! 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 30/03/2021: budgets: LES cartesian subdomain limits are defined in the physical domain
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -56,10 +65,10 @@ LOGICAL :: LLES_DOWNDRAFT ! flag to activate the computations in downdrafts
LOGICAL :: LLES_SPECTRA ! flag to activate the spectra computations
LOGICAL :: LLES_PDF ! flag to activate the pdf computations
!
-INTEGER, DIMENSION(200) :: NLES_LEVELS ! model levels for LES comp.
-REAL, DIMENSION(200) :: XLES_ALTITUDES ! alt. levels for LES comp.
-INTEGER, DIMENSION(200) :: NSPECTRA_LEVELS ! model levels for spectra comp.
-REAL, DIMENSION(200) :: XSPECTRA_ALTITUDES ! alt. levels for spectra comp.
+INTEGER, DIMENSION(900) :: NLES_LEVELS ! physical model levels for LES comp.
+REAL, DIMENSION(900) :: XLES_ALTITUDES ! alt. levels for LES comp.
+INTEGER, DIMENSION(900) :: NSPECTRA_LEVELS ! physical model levels for spectra comp.
+REAL, DIMENSION(900) :: XSPECTRA_ALTITUDES ! alt. levels for spectra comp.
!
INTEGER, DIMENSION( 10) :: NLES_TEMP_SERIE_I ! I, J and Z point
INTEGER, DIMENSION( 10) :: NLES_TEMP_SERIE_J ! localizations to
@@ -74,7 +83,7 @@ REAL :: XLES_TEMP_MEAN_END ! for start and end of the temporal averaged comp.
REAL :: XLES_TEMP_MEAN_STEP ! time step for each averaging
LOGICAL :: LLES_CART_MASK ! flag to use a cartesian mask
-INTEGER :: NLES_IINF ! definition of the cartesians mask
+INTEGER :: NLES_IINF ! definition of the cartesians mask in physical domain
INTEGER :: NLES_ISUP ! for NLES_CART_MODNBR model
INTEGER :: NLES_JINF ! "
INTEGER :: NLES_JSUP ! "
@@ -87,7 +96,7 @@ INTEGER :: NPDF ! number of pdf intervals
!
!-------------------------------------------------------------------------------
!
-INTEGER, DIMENSION(JPMODELMAX) :: NLESn_IINF ! definition of the cartesians mask
+INTEGER, DIMENSION(JPMODELMAX) :: NLESn_IINF ! definition of the cartesians mask in physical domain
INTEGER, DIMENSION(JPMODELMAX) :: NLESn_ISUP ! for all models
INTEGER, DIMENSION(JPMODELMAX) :: NLESn_JINF ! "
INTEGER, DIMENSION(JPMODELMAX) :: NLESn_JSUP ! "
@@ -115,7 +124,6 @@ LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: LLES_CURRENT_NEB_MASK
LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: LLES_CURRENT_CORE_MASK
! 2D surface precipitations mask of the current model
!
-LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: LLES_CURRENT_MY_MASK
! 2D owner mask of the current model
LOGICAL, DIMENSION(:,:,:,:), ALLOCATABLE :: LLES_CURRENT_MY_MASKS
!
@@ -130,11 +138,8 @@ INTEGER :: NLES_CURRENT_TCOUNT
INTEGER :: NLES_CURRENT_TIMES
! current model NLES_TIMES (number of LES samplings)
!
-REAL, DIMENSION(:,:), ALLOCATABLE :: XLES_CURRENT_TRAJT
-! trajt array for write_diachro routine
-!
INTEGER :: NLES_CURRENT_IINF, NLES_CURRENT_ISUP, NLES_CURRENT_JINF, NLES_CURRENT_JSUP
-! coordinates for write_diachro, set to NLESn_IINF(current model), etc...
+! coordinates (in physical domain) for write_diachro, set to NLESn_IINF(current model), etc...
!
REAL :: XLES_CURRENT_DOMEGAX, XLES_CURRENT_DOMEGAY
! minimum wavelength in spectra analysis
@@ -145,9 +150,6 @@ CHARACTER(LEN=4), DIMENSION(2) :: CLES_CURRENT_LBCX
CHARACTER(LEN=4), DIMENSION(2) :: CLES_CURRENT_LBCY
! current model Y boundary conditions for 2 points correlations computations
!
-REAL, DIMENSION(:,:), ALLOCATABLE :: XLES_CURRENT_DATIME
-! date array for diachro
-!
REAL, DIMENSION(:), ALLOCATABLE :: XLES_CURRENT_Z
! altitudes for diachro
!
@@ -166,9 +168,6 @@ INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: NKLIN_CURRENT_SPEC
REAL, DIMENSION(:,:,:), ALLOCATABLE :: XCOEFLIN_CURRENT_SPEC
! coefficients for vertical interpolation
!
-CHARACTER(LEN=28) :: CCURRENT_FMDIAC
-! current CFMDIAC file
-!
REAL,DIMENSION(2) :: XTIME_LES
! time spent in subgrid LES computations in this time-step in TURB
!
diff --git a/src/common/aux/modd_metricsn.F90 b/src/common/aux/modd_metricsn.F90
new file mode 100644
index 0000000000000000000000000000000000000000..33cec104e0fcc1f51650c617136afecbb7f8edd0
--- /dev/null
+++ b/src/common/aux/modd_metricsn.F90
@@ -0,0 +1,78 @@
+!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 modd 2006/06/27 14:20:29
+!-----------------------------------------------------------------
+! #####################
+ MODULE MODD_METRICS_n
+! #####################
+!
+!!**** *MODD_METRICS$n* - metric coefficients
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to declare the
+! metric coefficients.
+!
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! P. Jabouille *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/04/99
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
+IMPLICIT NONE
+
+TYPE METRICS_t
+ REAL, DIMENSION(:,:,:), POINTER :: XDXX=>NULL(),XDZX=>NULL(), &
+ XDYY=>NULL(),XDZY=>NULL(),XDZZ=>NULL()
+ !metric coefficients
+END TYPE METRICS_t
+
+TYPE(METRICS_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: METRICS_MODEL
+
+REAL, DIMENSION(:,:,:), POINTER :: XDXX=>NULL(),XDZX=>NULL(), &
+ XDYY=>NULL(),XDZY=>NULL(),XDZZ=>NULL()
+
+CONTAINS
+
+SUBROUTINE METRICS_GOTO_MODEL(KFROM, KTO)
+INTEGER, INTENT(IN) :: KFROM, KTO
+!
+! Save current state for allocated arrays
+METRICS_MODEL(KFROM)%XDXX=>XDXX
+METRICS_MODEL(KFROM)%XDZX=>XDZX
+METRICS_MODEL(KFROM)%XDYY=>XDYY
+METRICS_MODEL(KFROM)%XDZY=>XDZY
+METRICS_MODEL(KFROM)%XDZZ=>XDZZ
+!
+! Current model is set to model KTO
+XDXX=>METRICS_MODEL(KTO)%XDXX
+XDZX=>METRICS_MODEL(KTO)%XDZX
+XDYY=>METRICS_MODEL(KTO)%XDYY
+XDZY=>METRICS_MODEL(KTO)%XDZY
+XDZZ=>METRICS_MODEL(KTO)%XDZZ
+
+END SUBROUTINE METRICS_GOTO_MODEL
+
+END MODULE MODD_METRICS_n
diff --git a/src/arome/micro/modd_nsv.F90 b/src/common/aux/modd_nsv.F90
similarity index 82%
rename from src/arome/micro/modd_nsv.F90
rename to src/common/aux/modd_nsv.F90
index f15b1b1047504dc96e356a4a4e0d5b8b8d636a08..63cab9dbf6c9c41b3e6e3f781ea3a3e9f4b323fe 100644
--- a/src/arome/micro/modd_nsv.F90
+++ b/src/common/aux/modd_nsv.F90
@@ -1,4 +1,9 @@
-! ######spl
+!MNH_LIC Copyright 2001-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
+! ###############
MODULE MODD_NSV
! ###############
!
@@ -20,15 +25,21 @@
!! M. Leriche 12/04/07 add aqueous chemistry
!! M. Leriche 08/07/10 add ice phase chemistry
!! C.Lac 07/11 add conditional sampling
+!! Pialat/Tulet 15/02/12 add ForeFire
!! B.Vie /14 LIMA
-!!
+!! Modification 01/2016 (JP Pinty) Add LIMA
+!! V. Vionnet 07/17 add blowing snow
+! P. Wautelet 10/03/2021: add CSVNAMES and CSVNAMES_A to store the name of all the scalar variables
+! B. Vie 06/2021: add prognostic supersaturation for LIMA
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS, ONLY : JPMODELMAX,& ! Maximum allowed number of nested models
- JPSVMAX ! Maximum number of scalar variables
+USE MODD_PARAMETERS, ONLY : JPMODELMAX, & ! Maximum allowed number of nested models
+ JPSVMAX, & ! Maximum number of scalar variables
+ JPSVNAMELGTMAX ! Maximum length of a scalar variable name
!
IMPLICIT NONE
SAVE
@@ -37,6 +48,8 @@ REAL,DIMENSION(JPSVMAX) :: XSVMIN ! minimum value for SV variables
!
LOGICAL :: LINI_NSV = .FALSE. ! becomes True when routine INI_NSV is called
!
+CHARACTER(LEN=JPSVNAMELGTMAX), DIMENSION(:,:), ALLOCATABLE, TARGET :: CSVNAMES_A !Names of all the scalar variables
+
INTEGER,DIMENSION(JPMODELMAX)::NSV_A = 0 ! total number of scalar variables
! NSV_A = NSV_USER_A+NSV_C2R2_A+NSV_CHEM_A+..
INTEGER,DIMENSION(JPMODELMAX)::NSV_USER_A = 0 ! number of user scalar variables with
@@ -123,16 +136,25 @@ INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_IFN_FREE_A = 0 ! First Free IFN conc.
INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_IFN_NUCL_A = 0 ! First Nucl. IFN conc.
INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_IMM_NUCL_A = 0 ! First Nucl. IMM conc.
INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_HOM_HAZE_A = 0 ! Hom. freezing of CCN
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_SPRO_A = 0 ! Supersaturation
+!
+#ifdef MNH_FOREFIRE
+INTEGER,DIMENSION(JPMODELMAX)::NSV_FF_A = 0 ! number of ForeFire scalar variables
+INTEGER,DIMENSION(JPMODELMAX)::NSV_FFBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_FFEND_A = 0 ! NSV_FFBEG_A...NSV_FFEND_A
+#endif
!
-! Specific declaration for AROME / CO2 runs.....
-! to be keep, and next to be introduced in MesoNH
INTEGER,DIMENSION(JPMODELMAX)::NSV_CO2_A = 0 ! index for CO2
-
+!
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SNW_A = 0 ! number of blowing snow scalar
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SNWBEG_A = 0 ! with indices in the range :
+INTEGER,DIMENSION(JPMODELMAX)::NSV_SNWEND_A = 0 ! NSV_SNWBEG_A...NSV_SNWEND_A
!
!###############################################################################
!
! variables updated for the current model
!
+CHARACTER(LEN=JPSVNAMELGTMAX), DIMENSION(:), POINTER :: CSVNAMES !Names of all the scalar variables
CHARACTER(LEN=6), DIMENSION(:), ALLOCATABLE :: CSV ! name of the scalar variables
INTEGER :: NSV = 0 ! total number of user scalar variables
!
@@ -208,7 +230,7 @@ INTEGER :: NSV_CSEND = 0 ! NSV_CSBEG...NSV_CSEND
!
INTEGER :: NSV_LIMA ! number of scalar in LIMA
INTEGER :: NSV_LIMA_BEG ! with indices in the range :
-INTEGER :: NSV_LIMA_END ! NSV_LIMA_BEG...NSV_LIMA_END
+INTEGER :: NSV_LIMA_END ! NSV_LIMA_BEG_A...NSV_LIMA_END_A
INTEGER :: NSV_LIMA_NC !
INTEGER :: NSV_LIMA_NR !
INTEGER :: NSV_LIMA_CCN_FREE !
@@ -219,10 +241,18 @@ INTEGER :: NSV_LIMA_IFN_FREE !
INTEGER :: NSV_LIMA_IFN_NUCL !
INTEGER :: NSV_LIMA_IMM_NUCL !
INTEGER :: NSV_LIMA_HOM_HAZE !
-
-! Specific declaration for AROME / CO2 runs.....
-! to be keep, and next to be introduced in MesoNH
+INTEGER :: NSV_LIMA_SPRO !
+!
+#ifdef MNH_FOREFIRE
+INTEGER :: NSV_FF = 0 ! number of ForeFire scalar variables
+INTEGER :: NSV_FFBEG = 0 ! with indices in the range :
+INTEGER :: NSV_FFEND = 0 ! NSV_FFBEG...NSV_FFEND
+#endif
+!
INTEGER :: NSV_CO2 = 0 ! index for CO2
-
+!
+INTEGER :: NSV_SNW = 0 ! number of blowing snow scalar variables
+INTEGER :: NSV_SNWBEG = 0 ! with indices in the range :
+INTEGER :: NSV_SNWEND = 0 ! NSV_SNWBEG...NSV_SNWEND
END MODULE MODD_NSV
diff --git a/src/common/aux/modd_turbn.F90 b/src/common/aux/modd_turbn.F90
new file mode 100644
index 0000000000000000000000000000000000000000..03cb317eb33be9eab48ea00e6d47556336501b3b
--- /dev/null
+++ b/src/common/aux/modd_turbn.F90
@@ -0,0 +1,108 @@
+!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 MODD_TURB_n
+! ##################
+!
+!!**** *MODD_TURB$n* - declaration of turbulence scheme free parameters
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to declare the
+! variables that may be set by namelist for the turbulence scheme
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (module MODD_PARAMn)
+!!
+!! AUTHOR
+!! ------
+!! J. Cuxart and J. Stein * I.N.M. and Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original January 9, 1995
+!! J.Cuxart February 15, 1995 add the switches for diagnostic storages
+!! J.M. Carriere May 15, 1995 add the subgrid condensation
+!! M. Tomasini Jul 05, 2001 add the subgrid autoconversion
+!! P. Bechtold Feb 11, 2002 add switch for Sigma_s computation
+!! P. Jabouille Apr 4, 2002 add switch for Sigma_s convection
+!! V. Masson Nov 13 2002 add switch for SBL lengths
+!! May 2006 Remove KEPS
+!! C.Lac Nov 2014 add terms of TKE production for LES diag
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! D. Ricard May 2021 add the switches for Leonard terms
+!! JL Redelsperger 03/2021 Add O-A flux for auto-coupled LES case
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
+IMPLICIT NONE
+!
+!
+ REAL :: XIMPL ! implicitness degree for the vertical terms of
+ ! the turbulence scheme
+ REAL :: XKEMIN ! mimimum value for the TKE
+ REAL :: XCEDIS ! Constant for dissipation of Tke
+ REAL :: XCADAP ! Coefficient for ADAPtative mixing length
+ CHARACTER (LEN=4) :: CTURBLEN ! type of length used for the closure
+ ! 'BL89' Bougeault and Lacarrere scheme
+ ! 'DELT' length = ( volum) ** 1/3
+ CHARACTER (LEN=4) :: CTURBDIM ! dimensionality of the turbulence scheme
+ ! '1DIM' for purely vertical computations
+ ! '3DIM' for computations in the 3
+ ! directions
+ LOGICAL :: LTURB_FLX ! logical switch for the storage of all
+ ! the turbulent fluxes
+ LOGICAL :: LTURB_DIAG! logical switch for the storage of some
+ ! turbulence related diagnostics
+ LOGICAL :: LSUBG_COND! Switch for subgrid condensation
+ LOGICAL :: LSIGMAS ! Switch for using Sigma_s from turbulence scheme
+ LOGICAL :: LSIG_CONV ! Switch for computing Sigma_s due to convection
+!
+ LOGICAL :: LRMC01 ! Switch for computing separate mixing
+! ! and dissipative length in the SBL
+! ! according to Redelsperger, Mahe &
+! ! Carlotti 2001
+ CHARACTER(LEN=4) :: CTOM ! type of Third Order Moments
+ ! 'NONE' none
+ ! 'TM06' Tomas Masson 2006
+ CHARACTER(LEN=4) :: CSUBG_AUCV ! type of subgrid rc->rr autoconv. method
+ CHARACTER(LEN=80) :: CSUBG_AUCV_RI ! type of subgrid ri->rs autoconv. method
+ CHARACTER(LEN=80) :: CCONDENS ! subrgrid condensation PDF
+ CHARACTER(LEN=4) :: CLAMBDA3 ! lambda3 choice for subgrid cloud scheme
+ CHARACTER(LEN=80) :: CSUBG_MF_PDF ! PDF to use for MF cloud autoconversions
+
+! REAL, DIMENSION(:,:), POINTER :: XBL_DEPTH=>NULL() ! BL depth for TOMS computations
+! REAL, DIMENSION(:,:), POINTER :: XSBL_DEPTH=>NULL()! SurfaceBL depth for RMC01 computations
+! REAL, DIMENSION(:,:,:), POINTER :: XWTHVMF=>NULL()! Mass Flux vert. transport of buoyancy
+ REAL :: VSIGQSAT ! coeff applied to qsat variance contribution
+ REAL, DIMENSION(:,:,:), POINTER :: XDYP=>NULL() ! Dynamical production of Kinetic energy
+ REAL, DIMENSION(:,:,:), POINTER :: XTHP=>NULL() ! Thermal production of Kinetic energy
+ REAL, DIMENSION(:,:,:), POINTER :: XTR=>NULL() ! Transport production of Kinetic energy
+ REAL, DIMENSION(:,:,:), POINTER :: XDISS=>NULL() ! Dissipation of Kinetic energy
+ REAL, DIMENSION(:,:,:), POINTER :: XLEM=>NULL() ! Mixing length
+ REAL, DIMENSION(:,:,:), POINTER :: XSSUFL_C=>NULL() ! O-A interface flux for u
+ REAL, DIMENSION(:,:,:), POINTER :: XSSVFL_C=>NULL() ! O-A interface flux for v
+ REAL, DIMENSION(:,:,:), POINTER :: XSSTFL_C=>NULL() ! O-A interface flux for theta
+ REAL, DIMENSION(:,:,:), POINTER :: XSSRFL_C=>NULL() ! O-A interface flux for vapor
+ LOGICAL :: LHGRAD ! logical switch for the computation of the Leornard Terms
+ REAL :: XCOEFHGRADTHL ! coeff applied to thl contribution
+ REAL :: XCOEFHGRADRM ! coeff applied to mixing ratio contribution
+ REAL :: XALTHGRAD ! altitude from which to apply the Leonard terms
+ REAL :: XCLDTHOLD ! cloud threshold to apply the Leonard terms
+ ! negative value : applied everywhere
+ ! 0.000001 applied only inside the clouds ri+rc > 10**-6 kg/kg
+!
+END MODULE MODD_TURB_n
diff --git a/src/common/aux/tools.f90 b/src/common/aux/tools.F90
similarity index 100%
rename from src/common/aux/tools.f90
rename to src/common/aux/tools.F90
diff --git a/src/common/micro/condensation.F90 b/src/common/micro/condensation.F90
index e07e87f180092a51b6f615a8693292e33c9d961b..404642217470bae1e892ad809db7e38489adc03f 100644
--- a/src/common/micro/condensation.F90
+++ b/src/common/micro/condensation.F90
@@ -171,8 +171,7 @@ REAL :: ZDZ(D%NIB:D%NIE), &
ZARDUM(D%NIE-D%NIB+1), ZCLDUM(D%NIE-D%NIB+1)
! end OCND2
REAL(KIND=JPRB) :: ZHOOK_HANDLE
-INTEGER, DIMENSION(D%NIT) :: IERR
-!
+INTEGER, DIMENSION(D%NIB:D%NIE) :: IERR
!
!* 0.3 Definition of constants :
!
@@ -203,6 +202,12 @@ PCLDFR(:,:,:) = 0. ! Initialize values
PSIGRC(:,:,:) = 0. ! Initialize values
ZPRIFACT = 1. ! Initialize value
ZCLDUM=-1. ! Initialize value
+! Init of the HALO (should be on HALO points only)
+#ifdef REPRO55
+PRC_OUT = PRC_IN
+PRV_OUT = PRV_IN
+PRI_OUT = PRI_IN
+#endif
IF(OCND2)ZPRIFACT = 0.
!
!
@@ -329,7 +334,7 @@ DO JK=D%NKTB,D%NKTE
ZFRAC(JI) = PRI_IN(JI,JJ,JK) / (PRC_IN(JI,JJ,JK)+PRI_IN(JI,JJ,JK))
ENDIF
END DO
- CALL COMPUTE_FRAC_ICE(HFRAC_ICE, NEB, ZFRAC(:), PT(:,JJ,JK), IERR) !error code IERR cannot be checked here to not break vectorization
+ CALL COMPUTE_FRAC_ICE(HFRAC_ICE, NEB, ZFRAC(:), PT(D%NIB:D%NIE,JJ,JK), IERR) !error code IERR cannot be checked here to not break vectorization
ENDIF
DO JI=D%NIB,D%NIE
ZQSL(JI) = CST%XRD / CST%XRV * ZPV(JI) / ( PPABS(JI,JJ,JK) - ZPV(JI) )
diff --git a/src/common/micro/ice4_nucleation_elem.func.h b/src/common/micro/ice4_nucleation_elem.func.h
new file mode 100644
index 0000000000000000000000000000000000000000..f9ef73991cae536f9e15786a60d153b783da3c69
--- /dev/null
+++ b/src/common/micro/ice4_nucleation_elem.func.h
@@ -0,0 +1,110 @@
+!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.
+ELEMENTAL SUBROUTINE ICE4_NUCLEATION_ELEM(ODCOMPUTE, &
+ PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, &
+ PRVT, &
+ PCIT, PRVHENI_MR)
+! ******* TO BE INCLUDED IN THE *CONTAINS* OF A SUBROUTINE, IN ORDER TO EASE AUTOMATIC INLINING ******
+! => Don't use drHook !!!
+!
+
+!!
+!!** PURPOSE
+!! -------
+!! Computes the nucleation
+!!
+!! AUTHOR
+!! ------
+!! S. Riette from the splitting of rain_ice source code (nov. 2014)
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! R. El Khatib 24-Aug-2021 Optimizations
+!! S. Riette Feb 2022: as an include file
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY: XALPI, XALPW, XBETAI, XBETAW, XGAMI, XGAMW, XMD, XMV, XTT, XEPSILO
+USE MODD_PARAM_ICE, ONLY: LFEEDBACKT
+USE MODD_RAIN_ICE_PARAM, ONLY: XALPHA1, XALPHA2, XBETA1, XBETA2, XMNU0, XNU10, XNU20
+USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, INTENT(IN) :: ODCOMPUTE
+REAL, INTENT(IN) :: PTHT ! Theta at t
+REAL, INTENT(IN) :: PPABST ! absolute pressure at t
+REAL, INTENT(IN) :: PRHODREF! Reference density
+REAL, INTENT(IN) :: PEXN ! Exner function
+REAL, INTENT(IN) :: PLSFACT
+REAL, INTENT(IN) :: PT ! Temperature at time t
+REAL, INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, INTENT(OUT) :: PRVHENI_MR ! Mixing ratio change due to the heterogeneous nucleation
+!
+!* 0.2 declaration of local variables
+!
+REAL :: ZW ! work array
+LOGICAL :: GNEGT ! Test where to compute the HEN process
+REAL :: ZZW, & ! Work scalar
+ ZUSW, & ! Undersaturation over water
+ ZSSI ! Supersaturation over ice
+!-------------------------------------------------------------------------------
+!
+GNEGT=PT<XTT .AND. PRVT>XRTMIN(1) .AND. ODCOMPUTE
+
+PRVHENI_MR=0.
+IF(GNEGT) THEN
+ ZZW=ALOG(PT)
+ ZUSW=EXP(XALPW - XBETAW/PT - XGAMW*ZZW) ! es_w
+ ZZW=EXP(XALPI - XBETAI/PT - XGAMI*ZZW) ! es_i
+
+ ZZW=MIN(PPABST/2., ZZW) ! safety limitation
+ ZSSI=PRVT*(PPABST-ZZW) / (XEPSILO*ZZW) - 1.0 ! Supersaturation over ice
+ ZUSW=MIN(PPABST/2., ZUSW) ! safety limitation
+ ZUSW=(ZUSW/ZZW)*((PPABST-ZZW)/(PPABST-ZUSW)) - 1.0
+ ! Supersaturation of saturated water vapor over ice
+ !
+ !* 3.1 compute the heterogeneous nucleation source RVHENI
+ !
+ !* 3.1.1 compute the cloud ice concentration
+ !
+ ZSSI=MIN(ZSSI, ZUSW) ! limitation of SSi according to SSw=0
+
+ IF(PT<XTT-5. .AND. ZSSI>0.) THEN
+ ZZW=XNU20*EXP(XALPHA2*ZSSI-XBETA2)
+ ELSEIF(PT<=XTT-2. .AND. PT>=XTT-5. .AND. ZSSI>0.) THEN
+ ZZW=MAX(XNU20*EXP(-XBETA2 ), &
+ XNU10*EXP(-XBETA1*(PT-XTT))*(ZSSI/ZUSW)**XALPHA1)
+ ELSE
+ ZZW=0.
+ ENDIF
+
+ ZZW=ZZW-PCIT
+ ZZW=MIN(ZZW, 50.E3) ! limitation provisoire a 50 l^-1
+ !
+ !* 3.1.2 update the r_i and r_v mixing ratios
+ !
+ PRVHENI_MR=MAX(ZZW, 0.0)*XMNU0/PRHODREF
+ PRVHENI_MR=MIN(PRVT, PRVHENI_MR)
+ !
+ !Limitation due to 0 crossing of temperature
+ !
+ IF(LFEEDBACKT) THEN
+ ZW=MIN(PRVHENI_MR, MAX(0., (XTT/PEXN-PTHT)/PLSFACT)) / &
+ MAX(PRVHENI_MR, 1.E-20)
+ PRVHENI_MR=PRVHENI_MR*ZW
+ ZZW=ZZW*ZW
+ ENDIF
+ !
+ PCIT=MAX(ZZW+PCIT, PCIT)
+ENDIF
+!
+END SUBROUTINE ICE4_NUCLEATION_ELEM
diff --git a/src/common/micro/ice_adjust.F90 b/src/common/micro/ice_adjust.F90
index d2c9d943a6497358e48cde8cfd00ae94fcaf9cf3..122a140c5dbb73f0b61147fc47c2d6b4c59724f9 100644
--- a/src/common/micro/ice_adjust.F90
+++ b/src/common/micro/ice_adjust.F90
@@ -12,10 +12,9 @@
PPABST, PZZ, &
PEXN, PCF_MF, PRC_MF, PRI_MF, &
PRV, PRC, PRVS, PRCS, PTH, PTHS, PSRCS, PCLDFR, &
- PRR, PRI, PRIS, PRS, PRG, PRH, &
+ PRR, PRI, PRIS, PRS, PRG, TBUDGETS, KBUDGETS, PRH,&
POUT_RV, POUT_RC, POUT_RI, POUT_TH, &
PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
- TBUDGETS, KBUDGETS, &
PICE_CLD_WGT)
! #########################################################################
!
diff --git a/src/common/micro/mode_ice4_compute_pdf.F90 b/src/common/micro/mode_ice4_compute_pdf.F90
index 6fb091d6c2c54691f9cad6371574c0f6417049d3..942c65c25291d9ef50dd052af074aa58f90af95b 100644
--- a/src/common/micro/mode_ice4_compute_pdf.F90
+++ b/src/common/micro/mode_ice4_compute_pdf.F90
@@ -309,7 +309,11 @@ ELSE
CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'ICE4_COMPUTE_PDF', 'wrong HSUBG_AUCV_RI case' )
ENDIF
!
+#ifdef REPRO48
+PRF=PHLC_HCF
+#else
PRF=MAX(PHLC_HCF,PHLI_HCF)
+#endif
!
IF (LHOOK) CALL DR_HOOK('ICE4_COMPUTE_PDF', 1, ZHOOK_HANDLE)
END SUBROUTINE ICE4_COMPUTE_PDF
diff --git a/src/common/micro/mode_ice4_nucleation.F90 b/src/common/micro/mode_ice4_nucleation.F90
deleted file mode 100644
index 7d54233276052d05f4deec25e9ae7c072c6f4b7a..0000000000000000000000000000000000000000
--- a/src/common/micro/mode_ice4_nucleation.F90
+++ /dev/null
@@ -1,127 +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 MODE_ICE4_NUCLEATION
-IMPLICIT NONE
-CONTAINS
-SUBROUTINE ICE4_NUCLEATION(KSIZE, ODCOMPUTE, &
- PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, &
- PRVT, &
- PCIT, PRVHENI_MR)
-!!
-!!** PURPOSE
-!! -------
-!! Computes the nucleation
-!!
-!! AUTHOR
-!! ------
-!! S. Riette from the splitting of rain_ice source code (nov. 2014)
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-!! R. El Khatib 24-Aug-2021 Optimizations
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY: XALPI, XALPW, XBETAI, XBETAW, XGAMI, XGAMW, XMD, XMV, XTT, XEPSILO
-USE MODD_PARAM_ICE, ONLY: LFEEDBACKT
-USE MODD_RAIN_ICE_PARAM, ONLY: XALPHA1, XALPHA2, XBETA1, XBETA2, XMNU0, XNU10, XNU20
-USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, DIMENSION(KSIZE),INTENT(IN) :: ODCOMPUTE
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT ! Theta at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature at time t
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRVHENI_MR ! Mixing ratio change due to the heterogeneous nucleation
-!
-!* 0.2 declaration of local variables
-!
-REAL, DIMENSION(KSIZE) :: ZW ! work array
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-LOGICAL, DIMENSION(KSIZE) :: GNEGT ! Test where to compute the HEN process
-REAL, DIMENSION(KSIZE) :: ZZW, & ! Work array
- ZUSW, & ! Undersaturation over water
- ZSSI ! Supersaturation over ice
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('ICE4_NUCLEATION', 0, ZHOOK_HANDLE)!
-!
-GNEGT(:)=PT(:)<XTT .AND. PRVT(:)>XRTMIN(1) .AND. ODCOMPUTE(:)
-
-ZUSW(:)=0.
-ZZW(:)=0.
-WHERE(GNEGT(:))
- ZZW(:)=ALOG(PT(:))
- ZUSW(:)=EXP(XALPW - XBETAW/PT(:) - XGAMW*ZZW(:)) ! es_w
- ZZW(:)=EXP(XALPI - XBETAI/PT(:) - XGAMI*ZZW(:)) ! es_i
-END WHERE
-
-ZSSI(:)=0.
-WHERE(GNEGT(:))
- ZZW(:)=MIN(PPABST(:)/2., ZZW(:)) ! safety limitation
- ZSSI(:)=PRVT(:)*(PPABST(:)-ZZW(:)) / (XEPSILO*ZZW(:)) - 1.0
- ! Supersaturation over ice
- ZUSW(:)=MIN(PPABST(:)/2., ZUSW(:)) ! safety limitation
- ZUSW(:)=(ZUSW(:)/ZZW(:))*((PPABST(:)-ZZW(:))/(PPABST(:)-ZUSW(:))) - 1.0
- ! Supersaturation of saturated water vapor over ice
- !
- !* 3.1 compute the heterogeneous nucleation source RVHENI
- !
- !* 3.1.1 compute the cloud ice concentration
- !
- ZSSI(:)=MIN(ZSSI(:), ZUSW(:)) ! limitation of SSi according to SSw=0
-END WHERE
-
-ZZW(:)=0.
-WHERE(GNEGT(:) .AND. PT(:)<XTT-5.0 .AND. ZSSI(:)>0.0 )
- ZZW(:)=XNU20*EXP(XALPHA2*ZSSI(:)-XBETA2)
-ELSEWHERE(GNEGT(:) .AND. PT(:)<=XTT-2.0 .AND. PT(:)>=XTT-5.0 .AND. ZSSI(:)>0.0)
- ZZW(:)=MAX(XNU20*EXP(-XBETA2 ), &
- XNU10*EXP(-XBETA1*(PT(:)-XTT))*(ZSSI(:)/ZUSW(:))**XALPHA1)
-END WHERE
-WHERE(GNEGT(:))
- ZZW(:)=ZZW(:)-PCIT(:)
- ZZW(:)=MIN(ZZW(:), 50.E3) ! limitation provisoire a 50 l^-1
-END WHERE
-
-PRVHENI_MR(:)=0.
-WHERE(GNEGT(:))
- !
- !* 3.1.2 update the r_i and r_v mixing ratios
- !
- PRVHENI_MR(:)=MAX(ZZW(:), 0.0)*XMNU0/PRHODREF(:)
- PRVHENI_MR(:)=MIN(PRVT(:), PRVHENI_MR(:))
-END WHERE
-!Limitation due to 0 crossing of temperature
-IF(LFEEDBACKT) THEN
- ZW(:)=0.
- WHERE(GNEGT(:))
- ZW(:)=MIN(PRVHENI_MR(:), &
- MAX(0., (XTT/PEXN(:)-PTHT(:))/PLSFACT(:))) / &
- MAX(PRVHENI_MR(:), 1.E-20)
- END WHERE
- PRVHENI_MR(:)=PRVHENI_MR(:)*ZW(:)
- ZZW(:)=ZZW(:)*ZW(:)
-ENDIF
-PCIT(:)=MAX(ZZW(:)+PCIT(:), PCIT(:))
-!
-IF (LHOOK) CALL DR_HOOK('ICE4_NUCLEATION', 1, ZHOOK_HANDLE)
-END SUBROUTINE ICE4_NUCLEATION
-END MODULE MODE_ICE4_NUCLEATION
diff --git a/src/common/micro/mode_ice4_nucleation_wrapper.F90 b/src/common/micro/mode_ice4_nucleation_wrapper.F90
deleted file mode 100644
index f16f0225517060c7d5175a9e4f643174b653d7b4..0000000000000000000000000000000000000000
--- a/src/common/micro/mode_ice4_nucleation_wrapper.F90
+++ /dev/null
@@ -1,139 +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 MODE_ICE4_NUCLEATION_WRAPPER
-IMPLICIT NONE
-CONTAINS
-SUBROUTINE ICE4_NUCLEATION_WRAPPER(KIT, KJT, KKT, LDMASK, &
- PTHT, PPABST, PRHODREF, PEXN, PLSFACT, PT, &
- PRVT, &
- PCIT, PRVHENI_MR)
-!!
-!!** PURPOSE
-!! -------
-!! Computes the nucleation
-!!
-!! AUTHOR
-!! ------
-!! S. Riette from the splitting of rain_ice source code (nov. 2014)
-!!
-!! MODIFICATIONS
-!! -------------
-! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
-!! R. El Khatib 24-Aug-2021 Optimizations
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST, ONLY: XTT
-USE MODE_TOOLS, ONLY: COUNTJV
-USE MODE_ICE4_NUCLEATION, ONLY: ICE4_NUCLEATION
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KIT, KJT, KKT
-LOGICAL, DIMENSION(KIT,KJT,KKT),INTENT(IN) :: LDMASK
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PLSFACT
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PT ! Temperature at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRVHENI_MR ! Mixing ratio change due to the heterogeneous nucleation
-!
-!* 0.2 declaration of local variables
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-INTEGER :: JL
-INTEGER :: INEGT
-INTEGER, DIMENSION(COUNT(PT<XTT .AND. LDMASK)) :: I1,I2,I3
-LOGICAL, DIMENSION(COUNT(PT<XTT .AND. LDMASK)) :: GLDCOMPUTE ! computation criterium
-LOGICAL, DIMENSION(KIT, KJT, KKT) :: GNEGT ! Test where to compute the HEN process
-REAL, DIMENSION(COUNT(PT<XTT .AND. LDMASK)) :: ZZT, & ! Temperature
- ZPRES, & ! Pressure
- ZRVT, & ! Water vapor m.r. at t
- ZCIT, & ! Pristine ice conc. at t
- ZTHT, & ! Theta at t
- ZRHODREF, &
- ZEXN, &
- ZLSFACT, &
- ZRVHENI_MR
-!! MNH version INTEGER, DIMENSION(:), ALLOCATABLE :: I1,I2,I3
-!! MNH version LOGICAL, DIMENSION(:), ALLOCATABLE :: GLDCOMPUTE
-!! MNH version LOGICAL, DIMENSION(KIT,KJT,KKT) :: GNEGT ! Test where to compute the HEN process
-!! MNH version REAL, DIMENSION(:), ALLOCATABLE :: ZZT, & ! Temperature
-!! MNH version ZPRES, & ! Pressure
-!! MNH version ZRVT, & ! Water vapor m.r. at t
-!! MNH version ZCIT, & ! Pristine ice conc. at t
-!! MNH version ZTHT, & ! Theta at t
-!! MNH version ZRHODREF, &
-!! MNH version ZEXN, &
-!! MNH version ZLSFACT, &
-!! MNH version ZRVHENI_MR
-!
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('ICE4_NUCLEATION_WRAPPER', 0, ZHOOK_HANDLE)!
-!
-!
-! optimization by looking for locations where
-! the temperature is negative only !!!
-!
-GNEGT(:,:,:)=PT(:,:,:)<XTT .AND. LDMASK
-INEGT = COUNT(GNEGT(:,:,:))
-!
-!! MNH version ALLOCATE(GLDCOMPUTE(INEGT))
-!! MNH version ALLOCATE(I1(INEGT),I2(INEGT),I3(INEGT))
-!! MNH version ALLOCATE(ZZT(INEGT))
-!! MNH version ALLOCATE(ZPRES(INEGT))
-!! MNH version ALLOCATE(ZRVT(INEGT))
-!! MNH version ALLOCATE(ZCIT(INEGT))
-!! MNH version ALLOCATE(ZTHT(INEGT))
-!! MNH version ALLOCATE(ZRHODREF(INEGT))
-!! MNH version ALLOCATE(ZEXN(INEGT))
-!! MNH version ALLOCATE(ZLSFACT(INEGT))
-!! MNH version ALLOCATE(ZRVHENI_MR(INEGT))
-!
-IF(INEGT>0) INEGT=COUNTJV(GNEGT(:,:,:), I1(:), I2(:), I3(:))
-!
-PRVHENI_MR(:,:,:)=0.
-IF(INEGT>0) THEN
- DO JL=1, INEGT
- ZRVT(JL)=PRVT(I1(JL), I2(JL), I3(JL))
- ZCIT(JL)=PCIT(I1(JL), I2(JL), I3(JL))
- ZPRES(JL)=PPABST(I1(JL), I2(JL), I3(JL))
- ZTHT(JL)=PTHT(I1(JL), I2(JL), I3(JL))
- ZRHODREF(JL)=PRHODREF(I1(JL), I2(JL), I3(JL))
- ZEXN(JL)=PEXN(I1(JL), I2(JL), I3(JL))
- ZLSFACT(JL)=PLSFACT(I1(JL), I2(JL), I3(JL)) / ZEXN(JL)
- ZZT(JL)=PT(I1(JL), I2(JL), I3(JL))
- GLDCOMPUTE(JL)=ZZT(JL)<XTT
- ENDDO
- CALL ICE4_NUCLEATION(INEGT, GLDCOMPUTE, &
- ZTHT, ZPRES, ZRHODREF, ZEXN, ZLSFACT, ZZT, &
- ZRVT, &
- ZCIT, ZRVHENI_MR)
- DO JL=1, INEGT
- PRVHENI_MR(I1(JL), I2(JL), I3(JL)) = ZRVHENI_MR(JL)
- PCIT (I1(JL), I2(JL), I3(JL)) = ZCIT (JL)
- END DO
-END IF
-!
-!! MNH versionDEALLOCATE(GLDCOMPUTE)
-!! MNH versionDEALLOCATE(I1,I2,I3)
-!! MNH versionDEALLOCATE(ZZT,ZPRES,ZRVT,ZCIT,ZTHT,ZRHODREF,ZEXN,ZLSFACT,ZRVHENI_MR)
-!
-IF (LHOOK) CALL DR_HOOK('ICE4_NUCLEATION_WRAPPER', 1, ZHOOK_HANDLE)
-
-END SUBROUTINE ICE4_NUCLEATION_WRAPPER
-END MODULE MODE_ICE4_NUCLEATION_WRAPPER
diff --git a/src/common/micro/mode_ice4_sedimentation_stat.F90 b/src/common/micro/mode_ice4_sedimentation_stat.F90
index 22d76575dac5b87e81803f5ccd27b49c0e853c64..d682049ad4b79f51738e773b2328ee0d8133e16b 100644
--- a/src/common/micro/mode_ice4_sedimentation_stat.F90
+++ b/src/common/micro/mode_ice4_sedimentation_stat.F90
@@ -107,8 +107,8 @@ FWSED2(PWSEDW,PTSTEP1,PDZZ1,PWSEDWSUP)=MAX(0.,1.-PDZZ1/(PTSTEP1*PWSEDW))*PWSEDWS
IF (LHOOK) CALL DR_HOOK('ICE4_SEDIMENTATION_STAT',0,ZHOOK_HANDLE)
IF ( PRESENT( PFPR ) ) THEN
!Set to 0. to avoid undefined values (in files)
- PFPR(:, :, : KKTB - 1, :) = 0.
- PFPR(:, :, KKTE + 1 :, :) = 0.
+ PFPR(:, :, : KKTB, :) = 0.
+ PFPR(:, :, KKTE :, :) = 0.
END IF
!-------------------------------------------------------------------------------
diff --git a/src/common/micro/mode_ice4_tendencies.F90 b/src/common/micro/mode_ice4_tendencies.F90
index ea9e8f8ae1e4fc078eded42e9adfbda498ea8c8b..cc53a39aa675b8da205f9e6d69c0333133414068 100644
--- a/src/common/micro/mode_ice4_tendencies.F90
+++ b/src/common/micro/mode_ice4_tendencies.F90
@@ -64,7 +64,6 @@ USE MODD_FIELDS_ADDRESS, ONLY : & ! common fields adress
& IRG, & ! Graupel
& IRH ! Hail
!
-USE MODE_ICE4_NUCLEATION, ONLY: ICE4_NUCLEATION
USE MODE_ICE4_RRHONG, ONLY: ICE4_RRHONG
USE MODE_ICE4_RIMLTC, ONLY: ICE4_RIMLTC
USE MODE_ICE4_RSRIMCG_OLD, ONLY: ICE4_RSRIMCG_OLD
@@ -207,10 +206,13 @@ ELSE
!
!* 2. COMPUTES THE SLOW COLD PROCESS SOURCES
! --------------------------------------
- CALL ICE4_NUCLEATION(KSIZE, LLCOMPUTE, &
- ZVART(:,ITH), PPRES, PRHODREF, PEXN, PLSFACT, ZT, &
- ZVART(:,IRV), &
- PCIT, PRVHENI_MR)
+!DIR$ VECTOR ALWAYS
+ DO CONCURRENT (JL=1:KSIZE)
+ CALL ICE4_NUCLEATION_ELEM(LLCOMPUTE(JL), &
+ ZVART(JL,ITH), PPRES(JL), PRHODREF(JL), PEXN(JL), PLSFACT(JL), ZT(JL), &
+ ZVART(JL,IRV), &
+ PCIT(JL), PRVHENI_MR(JL))
+ ENDDO
DO JL=1, KSIZE
ZVART(JL,ITH)=ZVART(JL,ITH) + PRVHENI_MR(JL)*PLSFACT(JL)
ZT(JL) = ZVART(JL,ITH) * PEXN(JL)
@@ -304,15 +306,6 @@ CALL ICE4_COMPUTE_PDF(KSIZE, HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF,&
PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, ZRAINFR)
LLRFR=HSUBG_RC_RR_ACCR=='PRFR' .OR. HSUBG_RR_EVAP=='PRFR'
IF (LLRFR) THEN
- CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'MODE_ICE4_TENDENCIES', 'LLRFR case broken by optimisation, see comments in mode_ice4_tendencies to knwon why (and how to reapir)....')
- !Microphyscs was optimized by introducing chunks of KPROMA size
- !Thus, in ice4_tendencies, the 1D array represent only a fraction of the points where microphisical species are present
- !We cannot rebuild the entire 3D arrays here, so we cannot call ice4_rainfr_vert here
- !A solution would be to suppress optimisation in this case by setting KPROMA=KSIZE in rain_ice
- !Another solution would be to compute column by column?
- !Another one would be to cut tendencies in 3 parts: before rainfr_vert, rainfr_vert, after rainfr_vert
-
-
!Diagnostic of precipitation fraction
PRAINFR(:,:,:) = 0.
ZRRT3D (:,:,:) = 0.
@@ -322,8 +315,10 @@ IF (LLRFR) THEN
DO JL=1,KSIZE
PRAINFR(K1(JL), K2(JL), K3(JL)) = ZRAINFR(JL)
ZRRT3D (K1(JL), K2(JL), K3(JL)) = ZVART(JL,IRR)
+#ifndef REPRO48
ZRST3D (K1(JL), K2(JL), K3(JL)) = ZVART(JL,IRS)
ZRGT3D (K1(JL), K2(JL), K3(JL)) = ZVART(JL,IRG)
+#endif
END DO
IF (KRR==7) THEN
DO JL=1,KSIZE
@@ -497,5 +492,7 @@ CALL ICE4_FAST_RI(KSIZE, ODSOFT, PCOMPUTE, &
!
IF (LHOOK) CALL DR_HOOK('ICE4_TENDENCIES', 1, ZHOOK_HANDLE)
!
+CONTAINS
+INCLUDE "ice4_nucleation_elem.func.h"
END SUBROUTINE ICE4_TENDENCIES
END MODULE MODE_ICE4_TENDENCIES
diff --git a/src/common/micro/mode_icecloud.F90 b/src/common/micro/mode_icecloud.F90
index 43b394d211255e7ef887cecec79246067a4ac324..774dd688734a27d00b2fa1caaebe32d83ad07011 100644
--- a/src/common/micro/mode_icecloud.F90
+++ b/src/common/micro/mode_icecloud.F90
@@ -11,7 +11,8 @@ SUBROUTINE ICECLOUD &
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
USE MODD_CST,ONLY : XCPD,XCPV,XLVTT,XLSTT,XG,XRD,XEPSILO
USE MODE_TIWMX, ONLY: ESATW, ESATI
- USE MODI_TIWMX
+ USE MODE_QSATMX_TAB
+! USE MODI_TIWMX
IMPLICIT NONE
!-----------------------------------------------------------------------
!
@@ -77,7 +78,7 @@ REAL :: ZSIGMAX,ZSIGMAY,ZSIGMAZ,ZXDIST,ZYDIST,&
INTEGER :: JK
! External function
-REAL :: QSATMX_TAB
+!REAL :: QSATMX_TAB
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('ICECLOUD',0,ZHOOK_HANDLE)
diff --git a/src/common/micro/modi_ice_adjust.F90 b/src/common/micro/modi_ice_adjust.F90
index 9c962de2ca5877cab6692476b61fd92140be6d94..e40451afba187c09edc1af59b63a7c9d029f4ddf 100644
--- a/src/common/micro/modi_ice_adjust.F90
+++ b/src/common/micro/modi_ice_adjust.F90
@@ -12,10 +12,9 @@ INTERFACE
PPABST, PZZ, &
PEXN, PCF_MF, PRC_MF, PRI_MF, &
PRV, PRC, PRVS, PRCS, PTH, PTHS, PSRCS, PCLDFR, &
- PRR, PRI, PRIS, PRS, PRG, PRH, &
+ PRR, PRI, PRIS, PRS, PRG, TBUDGETS, KBUDGETS, PRH,&
POUT_RV, POUT_RC, POUT_RI, POUT_TH, &
PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
- TBUDGETS, KBUDGETS, &
PICE_CLD_WGT)
USE MODD_BUDGET, ONLY: TBUDGETDATA, TBUDGETCONF_t
USE MODD_CST, ONLY: CST_t
diff --git a/src/common/micro/rain_ice.F90 b/src/common/micro/rain_ice.F90
index 0fa4b7bd73f38bfa24aba24506b7dbdb5f14ec07..5da4fe37e8978772295b1dcae8f80afe255c519d 100644
--- a/src/common/micro/rain_ice.F90
+++ b/src/common/micro/rain_ice.F90
@@ -205,7 +205,6 @@ USE MODE_ICE4_RAINFR_VERT, ONLY: ICE4_RAINFR_VERT
USE MODE_ICE4_SEDIMENTATION_STAT, ONLY: ICE4_SEDIMENTATION_STAT
USE MODE_ICE4_SEDIMENTATION_SPLIT, ONLY: ICE4_SEDIMENTATION_SPLIT
USE MODE_ICE4_SEDIMENTATION_SPLIT_MOMENTUM, ONLY: ICE4_SEDIMENTATION_SPLIT_MOMENTUM
-USE MODE_ICE4_NUCLEATION_WRAPPER, ONLY: ICE4_NUCLEATION_WRAPPER
USE MODE_ICE4_TENDENCIES, ONLY: ICE4_TENDENCIES
!
IMPLICIT NONE
@@ -318,7 +317,7 @@ REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2)) :: ZINPRI ! Pristine ice instant prec
LOGICAL :: GEXT_TEND
LOGICAL :: LSOFT ! Must we really compute tendencies or only adjust them to new T variables
INTEGER :: INB_ITER_MAX ! Maximum number of iterations (with real tendencies computation)
-REAL :: ZW1D
+REAL :: ZW0D
REAL :: ZTSTEP ! length of sub-timestep in case of time splitting
REAL :: ZINV_TSTEP ! Inverse ov PTSTEP
REAL :: ZTIME_THRESHOLD ! Time to reach threshold
@@ -1111,10 +1110,21 @@ PCIT(:,:,:)=ZCITOUT(:,:,:)
!* 6. COMPUTES THE SLOW COLD PROCESS SOURCES OUTSIDE OF ODMICRO POINTS
! ----------------------------------------------------------------
!
-CALL ICE4_NUCLEATION_WRAPPER(KIT, KJT, KKT, .NOT. ODMICRO, &
- PTHT, PPABST, PRHODREF, PEXN, ZZ_LSFACT, ZT, &
- PRVT, &
- PCIT, ZZ_RVHENI_MR)
+DO JK=1, KKT
+ DO JJ=1, KJT
+!DIR$ VECTOR ALWAYS
+ DO CONCURRENT (JI=1:KIT)
+ IF (.NOT. ODMICRO(JI, JJ, JK)) THEN
+ ZW0D=ZZ_LSFACT(JI, JJ, JK)/PEXN(JI, JJ, JK)
+ ENDIF
+ CALL ICE4_NUCLEATION_ELEM(.NOT. ODMICRO(JI, JJ, JK), &
+ PTHT(JI, JJ, JK), PPABST(JI, JJ, JK), PRHODREF(JI, JJ, JK), &
+ PEXN(JI, JJ, JK), ZW0D, ZT(JI, JJ, JK), &
+ PRVT(JI, JJ, JK), &
+ PCIT(JI, JJ, JK), ZZ_RVHENI_MR(JI, JJ, JK))
+ ENDDO
+ ENDDO
+ENDDO
!
!-------------------------------------------------------------------------------
!
@@ -1766,6 +1776,7 @@ CONTAINS
IF (LHOOK) CALL DR_HOOK('RAIN_ICE:CORRECT_NEGATIVITIES', 1, ZHOOK_HANDLE)
!
END SUBROUTINE CORRECT_NEGATIVITIES
-
+!
+INCLUDE "ice4_nucleation_elem.func.h"
!
END SUBROUTINE RAIN_ICE
diff --git a/src/arome/turb/modd_cturb.F90 b/src/common/turb/modd_cturb.F90
similarity index 90%
rename from src/arome/turb/modd_cturb.F90
rename to src/common/turb/modd_cturb.F90
index 9b18f803fd4181c9136220c02db637666cc20d0a..a446914f779a1f5aa6d72c4c24b7b9a2960261e5 100644
--- a/src/arome/turb/modd_cturb.F90
+++ b/src/common/turb/modd_cturb.F90
@@ -1,4 +1,8 @@
-! ######spl
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+! #######################
MODULE MODD_CTURB
! #######################
!
@@ -28,6 +32,7 @@
!! Original 08/08/94
!! Nov 06, 2002 (V. Masson) add XALPSBL and XASBL
!! May 06 Remove EPS
+!! Jan 2019 (Q. Rodier) Remove XASBL
!----------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -64,7 +69,6 @@ REAL,SAVE :: XLINI ! initial value for BL mixing length
REAL,SAVE :: XLINF ! to prevent division by zero in the BL algorithm
!
REAL,SAVE :: XALPSBL ! constant linking TKE and friction velocity in the SBL
-REAL,SAVE :: XASBL ! constant used to define mixing length in the SBL
!
REAL,SAVE :: XCEP ! Constant for wind pressure-correlations
REAL,SAVE :: XA0 ! Constant a0 for wind pressure-correlations
@@ -77,6 +81,6 @@ REAL,SAVE :: XCTP ! Constant for temperature and vapor pressure-correlat
REAL,SAVE :: XPHI_LIM ! Threshold value for Phi3 and Psi3
REAL,SAVE :: XSBL_O_BL ! SBL height / BL height ratio
REAL,SAVE :: XFTOP_O_FSURF! Fraction of surface (heat or momentum) flux used to define top of BL
-!
LOGICAL,SAVE :: LHARAT ! SWITCH HARATU
+!
END MODULE MODD_CTURB
diff --git a/src/common/turb/bl89.F90 b/src/common/turb/mode_bl89.F90
similarity index 96%
rename from src/common/turb/bl89.F90
rename to src/common/turb/mode_bl89.F90
index 57056e4815f6fb65ae1ff202472d58ed1f7810c6..1a5506d6b4392d4f4d8e4b13fcb363f5b494379a 100644
--- a/src/common/turb/bl89.F90
+++ b/src/common/turb/mode_bl89.F90
@@ -1,5 +1,12 @@
+!MNH_LIC Copyright 1994-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 MODE_BL89
+IMPLICIT NONE
+CONTAINS
! ######spl
- SUBROUTINE BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,PTHLM,KRR,PRM,PTKEM,PSHEAR,PLM)
+ SUBROUTINE BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,PTHLM,KRR,PRM,PTKEM,PSHEAR,PLM,OOCEAN)
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! #########################################################
@@ -52,7 +59,6 @@
USE MODD_CONF, ONLY: CPROGRAM
USE MODD_CST
USE MODD_CTURB
-USE MODD_DYN_n, ONLY: LOCEAN
USE MODD_PARAMETERS
USE MODD_PRECISION, ONLY: MNHREAL
!
@@ -74,6 +80,7 @@ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! water var.
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSHEAR
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLM ! Mixing length
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
! thermodynamical variables PTHLM=Theta at the begining
!
!* 0.2 Declaration of local variables
@@ -153,7 +160,7 @@ ELSE
ZSHEAR (:,JK) = RESHAPE(PSHEAR (:,:,JK),(/ IIU*IJU /) )
ZTKEM (:,JK) = RESHAPE(PTKEM (:,:,JK),(/ IIU*IJU /) )
ZG_O_THVREF(:,JK) = RESHAPE(XG/PTHVREF(:,:,JK),(/ IIU*IJU /) )
- IF (LOCEAN) ZG_O_THVREF(:,JK) = XG * XALPHAOC
+ IF (OOCEAN) ZG_O_THVREF(:,JK) = XG * XALPHAOC
DO JRR=1,KRR
ZRM (:,JK,JRR) = RESHAPE(PRM (:,:,JK,JRR),(/ IIU*IJU /) )
END DO
@@ -348,3 +355,4 @@ END IF
!
IF (LHOOK) CALL DR_HOOK('BL89',1,ZHOOK_HANDLE)
END SUBROUTINE BL89
+END MODULE MODE_BL89
diff --git a/src/arome/turb/bl_depth_diag_3d.F90 b/src/common/turb/mode_bl_depth_diag.F90
similarity index 57%
rename from src/arome/turb/bl_depth_diag_3d.F90
rename to src/common/turb/mode_bl_depth_diag.F90
index 78ce7c72a1dcca18bab4db48b5a002c1b7103dfa..3cf56530a1969c0ebc35cf56bb74b7a1bc59eb1d 100644
--- a/src/arome/turb/bl_depth_diag_3d.F90
+++ b/src/common/turb/mode_bl_depth_diag.F90
@@ -1,4 +1,16 @@
-! ######spl
+!MNH_LIC Copyright 1994-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 MODE_BL_DEPTH_DIAG
+!
+INTERFACE BL_DEPTH_DIAG
+ MODULE PROCEDURE BL_DEPTH_DIAG_3D
+ MODULE PROCEDURE BL_DEPTH_DIAG_1D
+END INTERFACE
+!
+CONTAINS
+!
FUNCTION BL_DEPTH_DIAG_3D(KKB,KKE,PSURF,PZS,PFLUX,PZZ,PFTOP_O_FSURF)
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
@@ -91,3 +103,41 @@ BL_DEPTH_DIAG_3D(:,:) = BL_DEPTH_DIAG_3D(:,:) / (1. - PFTOP_O_FSURF)
!
IF (LHOOK) CALL DR_HOOK('BL_DEPTH_DIAG_3D',1,ZHOOK_HANDLE)
END FUNCTION BL_DEPTH_DIAG_3D
+!
+FUNCTION BL_DEPTH_DIAG_1D(KKB,KKE,PSURF,PZS,PFLUX,PZZ,PFTOP_O_FSURF)
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KKB ! bottom point
+INTEGER, INTENT(IN) :: KKE ! top point
+REAL, INTENT(IN) :: PSURF ! surface flux
+REAL, INTENT(IN) :: PZS ! orography
+REAL, DIMENSION(:), INTENT(IN) :: PFLUX ! flux
+REAL, DIMENSION(:), INTENT(IN) :: PZZ ! altitude of flux points
+REAL, INTENT(IN) :: PFTOP_O_FSURF! Flux at BL top / Surface flux
+REAL :: BL_DEPTH_DIAG_1D
+!
+REAL, DIMENSION(1,1) :: ZSURF
+REAL, DIMENSION(1,1) :: ZZS
+REAL, DIMENSION(1,1,SIZE(PFLUX)) :: ZFLUX
+REAL, DIMENSION(1,1,SIZE(PZZ)) :: ZZZ
+REAL, DIMENSION(1,1) :: ZBL_DEPTH_DIAG
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('BL_DEPTH_DIAG_1D',0,ZHOOK_HANDLE)
+ZSURF = PSURF
+ZZS = PZS
+ZFLUX(1,1,:) = PFLUX(:)
+ZZZ (1,1,:) = PZZ (:)
+!
+ZBL_DEPTH_DIAG = BL_DEPTH_DIAG_3D(KKB,KKE,ZSURF,ZZS,ZFLUX,ZZZ,PFTOP_O_FSURF)
+!
+BL_DEPTH_DIAG_1D = ZBL_DEPTH_DIAG(1,1)
+!
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('BL_DEPTH_DIAG_1D',1,ZHOOK_HANDLE)
+END FUNCTION BL_DEPTH_DIAG_1D
+END MODULE MODE_BL_DEPTH_DIAG
diff --git a/src/common/turb/mode_coefj.f90 b/src/common/turb/mode_coefj.f90
new file mode 100644
index 0000000000000000000000000000000000000000..239b3f63c3c5a3c774fd10014840d4e42bc9a17e
--- /dev/null
+++ b/src/common/turb/mode_coefj.f90
@@ -0,0 +1,135 @@
+!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 turb 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+!################
+MODULE MODE_COEFJ
+IMPLICIT NONE
+CONTAINS
+! #######################################################
+ FUNCTION COEFJ(PTHL,PEXNREF,PFRAC_ICE) RESULT(PCOEFJ)
+! #######################################################
+!
+! PURPOSE
+!! -------
+! COEFJ computes the coefficient J of the documentation.
+!
+!!** METHOD
+!! ------ rvs(Tl) Lv(Tl)
+!! The value of this coefficient is J = --------------, for rc only
+!! Rv Tl THETAl
+!!
+!! rvsw(Tl) Lv(Tl) rvsi(Tl) Ls(Tl)
+!! or --------------- (1-Pfrac_ri) + --------------- Pfrac_ri, for rc+ri.
+!! Rv Tl THETAl Rv Tl THETAl
+!!
+!! EXTERNAL
+!! --------
+!! None.
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : contains physical constants.
+!!
+!! REFERENCE
+!! ---------
+!! Book 1 of documentation of Meso-NH
+!! Book 2 of documentation of Meso-NH
+!!
+!!
+!! AUTHOR
+!! ------
+!! Jean-Marie Carriere * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 20/03/95
+!! J.-P. Pinty 20/02/03 add non-precipitating ice
+!!
+!! ----------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODD_CST
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments and result
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHL ! Temperature variable
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Exner function of the
+! reference state
+REAL, DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PFRAC_ICE
+ ! Fraction of ri in the
+ ! non-precipating
+ ! "rc+ri" condensate
+!
+REAL,DIMENSION(SIZE(PTHL,1),SIZE(PTHL,2),SIZE(PTHL,3)):: PCOEFJ ! result
+!
+!* 0.2 declarations of local variables
+!
+REAL,DIMENSION(SIZE(PTHL,1),SIZE(PTHL,2),SIZE(PTHL,3)) :: &
+ ZTL, ZL, ZES, ZRVS, ZP
+! ZTL = Tl, ZL = Lv(Tl) or Ls(Tl), ZES = esw(Tl) or esi(Tl)
+! ZRVS = rvsw(Tl) or rvsi(Tl), ZP = p
+!
+REAL :: ZEPS ! = Mv/Md
+!---------------------------------------------------------------------------
+!
+!* 1. COMPUTATION OF Tl
+! -----------------
+!
+ZTL(:,:,:) = PTHL(:,:,:) * PEXNREF(:,:,:)
+!
+!* 2. COMPUTATION OF Lv(Tl)
+! ---------------------
+!
+ZL(:,:,:) = XLVTT + ( XCPV - XCL ) * ( ZTL(:,:,:) -XTT )
+!
+!* 3. COMPUTATION OF rvs(Tl)
+! ----------------------
+!
+ZEPS = XMV/XMD
+ZP(:,:,:) = (PEXNREF(:,:,:)**(XCPD/XRD))*XP00
+ZES(:,:,:) = EXP( XALPW - XBETAW/ZTL(:,:,:) - XGAMW*ALOG(ZTL(:,:,:) ) )
+ZRVS(:,:,:) = ZES(:,:,:) * ZEPS / ( ZP(:,:,:) - ZES(:,:,:) )
+!
+! 4. RESULT FOR rc only
+! ------------------
+!
+PCOEFJ(:,:,:) = ZRVS(:,:,:)*ZL(:,:,:)/ &
+ ( XRV*ZTL(:,:,:)*PTHL(:,:,:) )
+!
+! Add case when rc+ri
+!
+IF(PRESENT(PFRAC_ICE)) THEN
+!
+!* 5. COMPUTATION OF Ls(Tl)
+! ---------------------
+!
+ ZL(:,:,:) = XLSTT + ( XCPV - XCI ) * ( ZTL(:,:,:) -XTT )
+!
+!* 6. COMPUTATION OF rvs(Tl)
+! ----------------------
+!
+ ZES(:,:,:) = EXP( XALPI - XBETAI/ZTL(:,:,:) - XGAMI*ALOG(ZTL(:,:,:) ) )
+ ZRVS(:,:,:) = ZES(:,:,:) * ZEPS / ( ZP(:,:,:) - ZES(:,:,:) )
+!
+! 7. RESULT FOR rc and ri
+! --------------------
+!
+ PCOEFJ(:,:,:) = (1.0 - PFRAC_ICE(:,:,:))*PCOEFJ(:,:,:) &
+ + PFRAC_ICE(:,:,:) *ZRVS(:,:,:)*ZL(:,:,:)/ &
+ ( XRV*ZTL(:,:,:)*PTHL(:,:,:) )
+END IF
+!
+!---------------------------------------------------------------------------
+!
+END FUNCTION COEFJ
+END MODULE MODE_COEFJ
diff --git a/src/common/turb/mode_compute_entr_detr.F90 b/src/common/turb/mode_compute_entr_detr.F90
index 0b4ba055584d29363adc3a12948d23e18d5428d4..7d8fae529856f3a50b886d7d64389b5b8f30f7e2 100644
--- a/src/common/turb/mode_compute_entr_detr.F90
+++ b/src/common/turb/mode_compute_entr_detr.F90
@@ -77,8 +77,8 @@ USE MODD_CST
!
USE MODD_PARAM_MFSHALL_n
!
-USE MODI_TH_R_FROM_THL_RT_1D
-
+USE MODE_TH_R_FROM_THL_RT_1D, ONLY: TH_R_FROM_THL_RT_1D
+!
USE MODE_THERMO
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
@@ -283,7 +283,7 @@ ENDDO
CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,ZFRAC_ICE,&
PPRE_PLUS_HALF,PTHL_UP,PRT_UP,&
ZTHMIX,ZRVMIX,ZRCMIX,ZRIMIX,&
- ZRSATW, ZRSATI)
+ ZRSATW, ZRSATI,OOCEAN=.FALSE.)
ZTHV_UP_F2(:) = ZTHMIX(:)*(1.+ZRVORD*ZRVMIX(:))/(1.+PRT_UP(:))
! Integral buoyancy for cloudy part
@@ -349,14 +349,18 @@ DO JLOOP=1,SIZE(OTEST)
(PRTM(JLOOP,KK)-ZDZ*(PRTM(JLOOP,KK)-PRTM(JLOOP,JI))/PDZZ(JLOOP,KK)) + &
(1. - ZKIC_INIT)*PRT_UP(JLOOP)
ELSE
+#ifdef REPRO55
+ ZMIXTHL(JLOOP) = 0.1
+#else
ZMIXTHL(JLOOP) = 300.
+#endif
ZMIXRT(JLOOP) = 0.1
ENDIF
ENDDO
CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,ZFRAC_ICE,&
ZPRE,ZMIXTHL,ZMIXRT,&
ZTHMIX,ZRVMIX,PRC_MIX,PRI_MIX,&
- ZRSATW, ZRSATI)
+ ZRSATW, ZRSATI,OOCEAN=.FALSE.)
ZTHVMIX(:) = ZTHMIX(:)*(1.+ZRVORD*ZRVMIX(:))/(1.+ZMIXRT(:))
! Compute cons then non cons. var. of mixture at the flux level KK+KKL with initial ZKIC
@@ -365,7 +369,7 @@ ENDDO
CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,ZFRAC_ICE,&
PPRE_PLUS_HALF,ZMIXTHL,ZMIXRT,&
ZTHMIX,ZRVMIX,PRC_MIX,PRI_MIX,&
- ZRSATW, ZRSATI)
+ ZRSATW, ZRSATI,OOCEAN=.FALSE.)
ZTHVMIX_F2(:) = ZTHMIX(:)*(1.+ZRVORD*ZRVMIX(:))/(1.+ZMIXRT(:))
!Computation of mean ZKIC over the cloudy part
diff --git a/src/common/turb/mode_compute_mf_cloud_direct.F90 b/src/common/turb/mode_compute_mf_cloud_direct.F90
index 090e49e487bce7f09e8258a00767572ed26150b2..8db27676d2e1d61c5d6dfd5b859699106e6756c2 100644
--- a/src/common/turb/mode_compute_mf_cloud_direct.F90
+++ b/src/common/turb/mode_compute_mf_cloud_direct.F90
@@ -90,10 +90,14 @@ PRI_MF(:,:)=0.
PCF_MF(:,:)=0.
DO JI=1,SIZE(PCF_MF,1)
+#ifdef REPRO48
JK0=KKLCL(JI)-KKL ! first mass level with cloud
JK0=MAX(JK0, MIN(KKB,KKE)) !protection if KKL=1
JK0=MIN(JK0, MAX(KKB,KKE)) !protection if KKL=-1
DO JK=JK0,KKE-KKL,KKL
+#else
+ DO JK=KKLCL(JI),KKE-KKL,KKL
+#endif
PCF_MF(JI,JK ) = MAX( 0., MIN(1.,XKCF_MF *0.5* ( &
& PFRAC_UP(JI,JK) + PFRAC_UP(JI,JK+KKL) ) ))
PRC_MF(JI,JK) = 0.5* XKCF_MF * ( PFRAC_UP(JI,JK)*PRC_UP(JI,JK) &
diff --git a/src/common/turb/mode_compute_updraft.F90 b/src/common/turb/mode_compute_updraft.F90
index b8c7f64c50fd4d550e0cf930402ae62bb37e5476..f3b480826cbba990948d580dd7f9d1ccbda64702 100644
--- a/src/common/turb/mode_compute_updraft.F90
+++ b/src/common/turb/mode_compute_updraft.F90
@@ -71,7 +71,7 @@ USE MODD_PARAM_MFSHALL_n, ONLY: LGZ, XALP_PERT, XCMF, XPRES_UV, XFRAC_UP_MAX, &
USE MODD_TURB_n, ONLY : CTURBLEN
USE MODE_COMPUTE_ENTR_DETR, ONLY: COMPUTE_ENTR_DETR
-USE MODI_TH_R_FROM_THL_RT_1D
+USE MODE_TH_R_FROM_THL_RT_1D, ONLY: TH_R_FROM_THL_RT_1D
USE MODI_SHUMAN_MF, ONLY: MZM_MF, MZF_MF, GZ_M_W_MF
USE MODE_COMPUTE_BL89_ML, ONLY: COMPUTE_BL89_ML
@@ -295,7 +295,7 @@ IF (OENTR_DETR) THEN
PRI_UP(:,KKB)=0.
CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,KKB),ZPRES_F(:,KKB), &
PTHL_UP(:,KKB),PRT_UP(:,KKB),ZTH_UP(:,KKB), &
- PRV_UP(:,KKB),PRC_UP(:,KKB),PRI_UP(:,KKB),ZRSATW(:),ZRSATI(:))
+ PRV_UP(:,KKB),PRC_UP(:,KKB),PRI_UP(:,KKB),ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.)
! compute updraft thevav and buoyancy term at KKB level
PTHV_UP(:,KKB) = ZTH_UP(:,KKB)*((1+ZRVORD*PRV_UP(:,KKB))/(1+PRT_UP(:,KKB)))
@@ -319,7 +319,11 @@ IF (OENTR_DETR) THEN
ZSHEAR = 0. !no shear in bl89 mixing length
END IF
!
+#ifdef REPRO48
CALL COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ,ZTKEM_F(:,KKB),ZG_O_THVREF(:,KKB),ZTHVM,KKB,GLMIX,.TRUE.,ZSHEAR,ZLUP)
+#else
+ CALL COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ,ZTKEM_F(:,KKB),ZG_O_THVREF(:,KKB),ZTHVM,KKB,GLMIX,.FALSE.,ZSHEAR,ZLUP)
+#endif
ZLUP(:)=MAX(ZLUP(:),1.E-10)
! Compute Buoyancy flux at the ground
@@ -425,11 +429,15 @@ DO JK=KKB,KKE-KKL,KKL
ZMIX2(JLOOP) = (PZZ(JLOOP,JK+KKL)-PZZ(JLOOP,JK))*PENTR(JLOOP,JK) !&
ZMIX3_CLD(JLOOP) = (PZZ(JLOOP,JK+KKL)-PZZ(JLOOP,JK))*(1.-ZPART_DRY(JLOOP))*ZDETR_CLD(JLOOP,JK) !&
ZMIX2_CLD(JLOOP) = (PZZ(JLOOP,JK+KKL)-PZZ(JLOOP,JK))*(1.-ZPART_DRY(JLOOP))*ZENTR_CLD(JLOOP,JK)
-
+#ifdef REPRO48
PTHL_UP(JLOOP,JK+KKL)=(PTHL_UP(JLOOP,JK)*(1.-0.5*ZMIX2(JLOOP)) + PTHLM(JLOOP,JK)*ZMIX2(JLOOP)) &
/(1.+0.5*ZMIX2(JLOOP))
PRT_UP(JLOOP,JK+KKL) =(PRT_UP (JLOOP,JK)*(1.-0.5*ZMIX2(JLOOP)) + PRTM(JLOOP,JK)*ZMIX2(JLOOP)) &
/(1.+0.5*ZMIX2(JLOOP))
+#else
+ PTHL_UP(JLOOP,JK+KKL)=PTHL_UP(JLOOP,JK)*EXP(-ZMIX2(JLOOP)) + PTHLM(JLOOP,JK)*(1-EXP(-ZMIX2(JLOOP)))
+ PRT_UP(JLOOP,JK+KKL) =PRT_UP (JLOOP,JK)*EXP(-ZMIX2(JLOOP)) + PRTM(JLOOP,JK)*(1-EXP(-ZMIX2(JLOOP)))
+#endif
ENDIF
ENDDO
@@ -477,7 +485,7 @@ DO JK=KKB,KKE-KKL,KKL
ZRI_UP(:)=PRI_UP(:,JK) ! guess = level just below
CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,JK+KKL),ZPRES_F(:,JK+KKL), &
PTHL_UP(:,JK+KKL),PRT_UP(:,JK+KKL),ZTH_UP(:,JK+KKL), &
- ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:))
+ ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:), OOCEAN=.FALSE.)
WHERE(GTEST)
PRC_UP(:,JK+KKL)=ZRC_UP(:)
PRV_UP(:,JK+KKL)=ZRV_UP(:)
diff --git a/src/common/turb/mode_compute_updraft_raha.F90 b/src/common/turb/mode_compute_updraft_raha.F90
index 4082137400341dae238ad5e23349e25eb1726700..41414ea157c7fd1d5772da28eca198bb52ce4991 100644
--- a/src/common/turb/mode_compute_updraft_raha.F90
+++ b/src/common/turb/mode_compute_updraft_raha.F90
@@ -62,7 +62,7 @@ CONTAINS
USE MODD_CST
USE MODD_PARAM_MFSHALL_n
-USE MODI_TH_R_FROM_THL_RT_1D
+USE MODE_TH_R_FROM_THL_RT_1D, ONLY: TH_R_FROM_THL_RT_1D
USE MODI_SHUMAN_MF, ONLY: MZM_MF
!
USE PARKIND1, ONLY : JPRB
@@ -303,7 +303,7 @@ PRI_UP(:,KKB)=0.
CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,KKB),ZPRES_F(:,KKB), &
PTHL_UP(:,KKB),PRT_UP(:,KKB),ZTH_UP(:,KKB), &
- PRV_UP(:,KKB),PRC_UP(:,KKB),PRI_UP(:,KKB),ZRSATW(:),ZRSATI(:))
+ PRV_UP(:,KKB),PRC_UP(:,KKB),PRI_UP(:,KKB),ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.)
! compute updraft thevav and buoyancy term at KKB level
PTHV_UP(:,KKB) = ZTH_UP(:,KKB)*((1+ZRVORD*PRV_UP(:,KKB))/(1+PRT_UP(:,KKB)))
@@ -482,7 +482,7 @@ DO JK=KKB,KKE-KKL,KKL
ZRV_UP(:)=PRV_UP(:,JK)
CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,JK+KKL),ZPRES_F(:,JK+KKL), &
PTHL_UP(:,JK+KKL),PRT_UP(:,JK+KKL),ZTH_UP(:,JK+KKL), &
- ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:))
+ ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.)
WHERE(GTEST)
ZT_UP(:) = ZTH_UP(:,JK+KKL)*PEXNM(:,JK+KKL)
ZCP(:) = XCPD + XCL * ZRC_UP(:)
diff --git a/src/arome/turb/mode_compute_updraft_rhcj10.F90 b/src/common/turb/mode_compute_updraft_rhcj10.F90
similarity index 88%
rename from src/arome/turb/mode_compute_updraft_rhcj10.F90
rename to src/common/turb/mode_compute_updraft_rhcj10.F90
index bac5e7f1392f91d9ecc949a76fcfbca35989f890..0392012db244776f3720593fba148057f7a72a29 100644
--- a/src/arome/turb/mode_compute_updraft_rhcj10.F90
+++ b/src/common/turb/mode_compute_updraft_rhcj10.F90
@@ -16,7 +16,7 @@ SUBROUTINE COMPUTE_UPDRAFT_RHCJ10(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, &
PZZ,PDZZ, &
PSFTH,PSFRV, &
PPABSM,PRHODREF,PUM,PVM, PTKEM, &
- PEXNM,PTHM,PRVM,PTHLM,PRTM, &
+ PTHM,PRVM,PTHLM,PRTM, &
PSVM,PTHL_UP,PRT_UP, &
PRV_UP,PRC_UP,PRI_UP,PTHV_UP, &
PW_UP,PU_UP, PV_UP, PSV_UP, &
@@ -63,7 +63,7 @@ SUBROUTINE COMPUTE_UPDRAFT_RHCJ10(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, &
USE MODD_CST
USE MODD_PARAM_MFSHALL_n
USE MODD_TURB_n, ONLY : CTURBLEN
-USE MODI_TH_R_FROM_THL_RT_1D
+USE MODE_TH_R_FROM_THL_RT_1D, ONLY: TH_R_FROM_THL_RT_1D
USE MODI_SHUMAN_MF, ONLY: MZF_MF, MZM_MF, GZ_M_W_MF
USE MODE_COMPUTE_BL89_ML, ONLY: COMPUTE_BL89_ML
@@ -100,7 +100,7 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind
REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind
REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt
!
-REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! Exner function at t-dt
+!REAL, DIMENSION(:,:), INTENT(IN) :: PEXNM ! Exner function at t-dt
REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! pot. temp. at t-dt
REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
@@ -139,11 +139,11 @@ REAL, DIMENSION(SIZE(PSVM,1),SIZE(PTHM,2),SIZE(PSVM,3)) :: ZSVM_F ! scalar varia
REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTH_UP ! updraft THETA
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZT_UP ! updraft T
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZLVOCPEXN ! updraft L
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZCP ! updraft cp
+!REAL, DIMENSION(SIZE(PTHM,1)) :: ZT_UP ! updraft T
+!REAL, DIMENSION(SIZE(PTHM,1)) :: ZLVOCPEXN ! updraft L
+!REAL, DIMENSION(SIZE(PTHM,1)) :: ZCP ! updraft cp
REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZBUO ! Buoyancy
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTHS_UP,ZTHSM
+!REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTHS_UP,ZTHSM
REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZCOEF ! diminution coefficient for too high clouds
@@ -178,7 +178,7 @@ REAL, DIMENSION(SIZE(PTHM,1)) :: ZCOE,ZWCOE,ZBUCOE
REAL, DIMENSION(SIZE(PTHM,1)) :: ZDETR_BUO, ZDETR_RT
REAL, DIMENSION(SIZE(PTHM,1)) :: ZW_MAX ! w**2 max of the updraft
REAL, DIMENSION(SIZE(PTHM,1)) :: ZZTOP ! Top of the updraft
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZQTM,ZQT_UP
+!REAL, DIMENSION(SIZE(PTHM,1)) :: ZQTM,ZQT_UP
REAL :: ZDEPTH_MAX1, ZDEPTH_MAX2 ! control auto-extinction process
@@ -254,7 +254,7 @@ ZTKEM_F(:,:) = MZM_MF(PTKEM(:,:), KKA, KKU, KKL)
! This updraft is not yet ready to use scalar variables
!DO JSV=1,ISV
! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
-! *** SR merge AROME/Méso-nh: following two lines come from the AROME version
+! *** SR merge AROME/Meso-nh: following two lines come from the AROME version
! ZSVM_F(:,KKB:IKU,JSV) = 0.5*(PSVM(:,KKB:IKU,JSV)+PSVM(:,1:IKU-1,JSV))
! ZSVM_F(:,1,JSV) = ZSVM_F(:,KKB,JSV)
! *** the following single line comes from the Meso-NH version
@@ -276,11 +276,12 @@ PSV_UP(:,:,:)=0.
! thetal_up,rt_up,thetaV_up, w,Buoyancy term and mass flux (PEMF)
DO JI=1,IIJU
- PTHL_UP(JI,KKB)= ZTHLM_F(JI,KKB)+MAX(0.,MIN(ZTMAX,(PSFTH(JI)/SQRT(ZTKEM_F(JI,KKB)))*XALP_PERT))
- PRT_UP(JI,KKB) = ZRTM_F(JI,KKB)+MAX(0.,MIN(ZRMAX,(PSFRV(JI)/SQRT(ZTKEM_F(JI,KKB)))*XALP_PERT))
-
- ZQT_UP(JI) = PRT_UP(JI,KKB)/(1.+PRT_UP(JI,KKB))
- ZTHS_UP(JI,KKB)=PTHL_UP(JI,KKB)*(1.+XLAMBDA_MF*ZQT_UP(JI))
+ !PTHL_UP(JI,KKB)= ZTHLM_F(JI,KKB)+MAX(0.,MIN(ZTMAX,(PSFTH(JI)/SQRT(ZTKEM_F(JI,KKB)))*XALP_PERT))
+ !PRT_UP(JI,KKB) = ZRTM_F(JI,KKB)+MAX(0.,MIN(ZRMAX,(PSFRV(JI)/SQRT(ZTKEM_F(JI,KKB)))*XALP_PERT))
+ PTHL_UP(JI,KKB)= ZTHLM_F(JI,KKB)
+ PRT_UP(JI,KKB) = ZRTM_F(JI,KKB)
+ !ZQT_UP(JI) = PRT_UP(JI,KKB)/(1.+PRT_UP(JI,KKB))
+ !ZTHS_UP(JI,KKB)=PTHL_UP(JI,KKB)*(1.+XLAMBDA_MF*ZQT_UP(JI))
ENDDO
ZTHM_F (:,:) = MZM_MF(PTHM (:,:), KKA, KKU, KKL)
@@ -299,7 +300,8 @@ PTHV_UP(:,:)= ZTHVM_F(:,:)
PRV_UP (:,:)= ZRVM_F (:,:)
ZW_UP2(:,:)=ZEPS
-ZW_UP2(:,KKB) = MAX(0.0001,(1./6.)*ZTKEM_F(:,KKB))
+!ZW_UP2(:,KKB) = MAX(0.0001,(3./6.)*ZTKEM_F(:,KKB))
+ZW_UP2(:,KKB) = MAX(0.0001,(2./3.)*ZTKEM_F(:,KKB))
! Computation of non conservative variable for the KKB level of the updraft
! (all or nothing ajustement)
@@ -308,7 +310,7 @@ PRC_UP(:,KKB)=0.
PRI_UP(:,KKB)=0.
CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,KKB),ZPRES_F(:,KKB), &
PTHL_UP(:,KKB),PRT_UP(:,KKB),ZTH_UP(:,KKB), &
- PRV_UP(:,KKB),PRC_UP(:,KKB),PRI_UP(:,KKB),ZRSATW(:),ZRSATI(:))
+ PRV_UP(:,KKB),PRC_UP(:,KKB),PRI_UP(:,KKB),ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.)
DO JI=1,IIJU
! compute updraft thevav and buoyancy term at KKB level
@@ -338,15 +340,12 @@ IF(CTURBLEN=='RM17') THEN
ZDUDZ = MZF_MF(GZ_M_W_MF(PUM,PDZZ, KKA, KKU, KKL), KKA, KKU, KKL)
ZDVDZ = MZF_MF(GZ_M_W_MF(PVM,PDZZ, KKA, KKU, KKL), KKA, KKU, KKL)
ZSHEAR = SQRT(ZDUDZ*ZDUDZ + ZDVDZ*ZDVDZ)
- PRINT*, 'phasage bete sans controle'
- CALL ABORT
- STOP
ELSE
ZSHEAR = 0. !no shear in bl89 mixing length
END IF
!
CALL COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ,ZTKEM_F(:,KKB),ZG_O_THVREF(:,KKB), &
- ZTHVM_F,KKB,GLMIX,.FALSE.,ZSHEAR,ZLUP)
+ ZTHVM_F,KKB,GLMIX,.TRUE.,ZSHEAR,ZLUP)
ZLUP(:)=MAX(ZLUP(:),1.E-10)
DO JI=1,IIJU
@@ -358,8 +357,8 @@ DO JI=1,IIJU
IF (ZWTHVSURF>0.010) THEN ! <== Not 0 Important to have stratocumulus !!!!!
PEMF(JI,KKB) = XCMF * ZRHO_F(JI,KKB) * ((ZG_O_THVREF(JI,KKB))*ZWTHVSURF*ZLUP(JI))**(1./3.)
PFRAC_UP(JI,KKB)=MIN(PEMF(JI,KKB)/(SQRT(ZW_UP2(JI,KKB))*ZRHO_F(JI,KKB)),XFRAC_UP_MAX)
- PEMF(JI,KKB) = ZRHO_F(JI,KKB)*PFRAC_UP(JI,KKB)*SQRT(ZW_UP2(JI,KKB))
- ! ZW_UP2(JI,KKB)=(PEMF(JI,KKB)/(PFRAC_UP(JI,KKB)*ZRHO_F(JI,KKB)))**2
+ !PEMF(JI,KKB) = ZRHO_F(JI,KKB)*PFRAC_UP(JI,KKB)*SQRT(ZW_UP2(JI,KKB))
+ ZW_UP2(JI,KKB)=(PEMF(JI,KKB)/(PFRAC_UP(JI,KKB)*ZRHO_F(JI,KKB)))**2
GTEST(JI)=.TRUE.
ELSE
PEMF(JI,KKB) =0.
@@ -417,7 +416,7 @@ DO JK=KKB,KKE-KKL,KKL
ZRV_UP(:) =PRV_UP(:,JK)
CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,JK),&
PPABSM(:,JK),PTHL_UP(:,JK),PRT_UP(:,JK),&
- ZTH_UP(:,JK),ZRV_UP,ZRC_UP,ZRI_UP,ZRSATW(:),ZRSATI(:))
+ ZTH_UP(:,JK),ZRV_UP,ZRC_UP,ZRI_UP,ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.)
DO JI=1,IIJU
IF (GTEST(JI)) THEN
@@ -439,7 +438,6 @@ DO JK=KKB,KKE-KKL,KKL
ZBUCOE(JI) = 2.*ZCOE(JI)/(1.+XB*ZCOE(JI))
! Second Rachel bug correction (XA1 has been forgotten)
-
ZW_UP2(JI,JK+KKL) = MAX(ZEPS,ZW_UP2(JI,JK)*ZWCOE(JI) + XA1*ZBUO(JI,JK)*ZBUCOE(JI) )
ZW_MAX(JI) = MAX(ZW_MAX(JI), SQRT(ZW_UP2(JI,JK+KKL)))
ZWUP_MEAN(JI) = MAX(ZEPS,0.5*(ZW_UP2(JI,JK+KKL)+ZW_UP2(JI,JK)))
@@ -455,16 +453,17 @@ DO JK=KKB,KKE-KKL,KKL
! If the updraft did not stop, compute cons updraft characteritics at jk+1
ZZTOP(JI) = MAX(ZZTOP(JI),PZZ(JI,JK+KKL))
ZMIX2(JI) = (PZZ(JI,JK+KKL)-PZZ(JI,JK))*PENTR(JI,JK) !&
-
- ! Utilisation de thetaS
- ZQTM(JI) = PRTM(JI,JK)/(1.+PRTM(JI,JK))
- ZTHSM(JI,JK) = PTHLM(JI,JK)*(1.+XLAMBDA_MF*ZQTM(JI))
- ZTHS_UP(JI,JK+KKL)=(ZTHS_UP(JI,JK)*(1.-0.5*ZMIX2(JI)) + ZTHSM(JI,JK)*ZMIX2(JI)) &
- /(1.+0.5*ZMIX2(JI))
+
+ !ZQTM(JI) = PRTM(JI,JK)/(1.+PRTM(JI,JK))
+ !ZTHSM(JI,JK) = PTHLM(JI,JK)*(1.+XLAMBDA_MF*ZQTM(JI))
+ !ZTHS_UP(JI,JK+KKL)=(ZTHS_UP(JI,JK)*(1.-0.5*ZMIX2(JI)) + ZTHSM(JI,JK)*ZMIX2(JI)) &
+ ! /(1.+0.5*ZMIX2(JI))
PRT_UP(JI,JK+KKL) =(PRT_UP (JI,JK)*(1.-0.5*ZMIX2(JI)) + PRTM(JI,JK)*ZMIX2(JI)) &
/(1.+0.5*ZMIX2(JI))
- ZQT_UP(JI) = PRT_UP(JI,JK+KKL)/(1.+PRT_UP(JI,JK+KKL))
- PTHL_UP(JI,JK+KKL)=ZTHS_UP(JI,JK+KKL)/(1.+XLAMBDA_MF*ZQT_UP(JI))
+ !ZQT_UP(JI) = PRT_UP(JI,JK+KKL)/(1.+PRT_UP(JI,JK+KKL))
+ !PTHL_UP(JI,JK+KKL)=ZTHS_UP(JI,JK+KKL)/(1.+XLAMBDA_MF*ZQT_UP(JI))
+ PTHL_UP(JI,JK+KKL)=(PTHL_UP(JI,JK)*(1.-0.5*ZMIX2(JI)) + PTHLM(JI,JK)*ZMIX2(JI)) &
+ /(1.+0.5*ZMIX2(JI))
ENDIF ! GTEST
ENDDO
@@ -517,24 +516,27 @@ DO JK=KKB,KKE-KKL,KKL
ZRV_UP(:)=PRV_UP(:,JK)
CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,JK+KKL),ZPRES_F(:,JK+KKL), &
PTHL_UP(:,JK+KKL),PRT_UP(:,JK+KKL),ZTH_UP(:,JK+KKL), &
- ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:))
+ ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:),OOCEAN=.FALSE.)
DO JI=1,IIJU
IF(GTEST(JI)) THEN
- ZT_UP(JI) = ZTH_UP(JI,JK+KKL)*PEXNM(JI,JK+KKL)
- ZCP(JI) = XCPD + XCL * ZRC_UP(JI)
- ZLVOCPEXN(JI)=(XLVTT + (XCPV-XCL) * (ZT_UP(JI)-XTT) ) / ZCP(JI) / PEXNM(JI,JK+KKL)
- PRC_UP(JI,JK+KKL)=MIN(0.5E-3,ZRC_UP(JI)) ! On ne peut depasser 0.5 g/kg (autoconversion donc elimination !)
- PTHL_UP(JI,JK+KKL) = PTHL_UP(JI,JK+KKL)+ZLVOCPEXN(JI)*(ZRC_UP(JI)-PRC_UP(JI,JK+KKL))
+ !ZT_UP(JI) = ZTH_UP(JI,JK+KKL)*PEXNM(JI,JK+KKL)
+ !ZCP(JI) = XCPD + XCL * ZRC_UP(JI)
+ !ZLVOCPEXN(JI)=(XLVTT + (XCPV-XCL) * (ZT_UP(JI)-XTT) ) / ZCP(JI) / PEXNM(JI,JK+KKL)
+ !PRC_UP(JI,JK+KKL)=MIN(0.5E-3,ZRC_UP(JI)) ! On ne peut depasser 0.5 g/kg (autoconversion donc elimination !)
+ !PTHL_UP(JI,JK+KKL) = PTHL_UP(JI,JK+KKL)+ZLVOCPEXN(JI)*(ZRC_UP(JI)-PRC_UP(JI,JK+KKL))
+ PRC_UP(JI,JK+KKL)=ZRC_UP(JI)
PRV_UP(JI,JK+KKL)=ZRV_UP(JI)
PRI_UP(JI,JK+KKL)=ZRI_UP(JI)
- PRT_UP(JI,JK+KKL) = PRC_UP(JI,JK+KKL) + PRV_UP(JI,JK+KKL)
+ !PRT_UP(JI,JK+KKL) = PRC_UP(JI,JK+KKL) + PRV_UP(JI,JK+KKL)
PRSAT_UP(JI,JK+KKL) = ZRSATW(JI)*(1-PFRAC_ICE_UP(JI,JK+KKL)) + ZRSATI(JI)*PFRAC_ICE_UP(JI,JK+KKL)
! Compute the updraft theta_v, buoyancy and w**2 for level JK+1
!PTHV_UP(:,JK+KKL) = PTH_UP(:,JK+KKL)*((1+ZRVORD*PRV_UP(:,JK+KKL))/(1+PRT_UP(:,JK+KKL)))
- PTHV_UP(JI,JK+KKL) = ZTH_UP(JI,JK+KKL)*(1.+0.608*PRV_UP(JI,JK+KKL) - PRC_UP(JI,JK+KKL))
- ! A corriger pour utiliser q et non r !!!!
+ !PTHV_UP(JI,JK+KKL) = ZTH_UP(JI,JK+KKL)*(1.+0.608*PRV_UP(JI,JK+KKL) - PRC_UP(JI,JK+KKL))
+ !! A corriger pour utiliser q et non r !!!!
+ !ZMIX1(JI)=ZZDZ(JI,JK)*(PENTR(JI,JK)-PDETR(JI,JK))
+ PTHV_UP(JI,JK+KKL) = ZTH_UP(JI,JK+KKL)*((1+ZRVORD*PRV_UP(JI,JK+KKL))/(1+PRT_UP(JI,JK+KKL)))
ZMIX1(JI)=ZZDZ(JI,JK)*(PENTR(JI,JK)-PDETR(JI,JK))
ENDIF
ENDDO
@@ -550,7 +552,7 @@ DO JK=KKB,KKE-KKL,KKL
! Updraft fraction must be smaller than XFRAC_UP_MAX
PFRAC_UP(JI,JK+KKL)=MIN(XFRAC_UP_MAX, &
&PEMF(JI,JK+KKL)/(SQRT(ZW_UP2(JI,JK+KKL))*ZRHO_F(JI,JK+KKL)))
- PEMF(JI,JK+KKL) = ZRHO_F(JI,JK+KKL)*PFRAC_UP(JI,JK+KKL)*SQRT(ZW_UP2(JI,JK+KKL))
+ !PEMF(JI,JK+KKL) = ZRHO_F(JI,JK+KKL)*PFRAC_UP(JI,JK+KKL)*SQRT(ZW_UP2(JI,JK+KKL))
ENDIF
ENDDO
diff --git a/src/common/turb/emoist.F90 b/src/common/turb/mode_emoist.F90
similarity index 95%
rename from src/common/turb/emoist.F90
rename to src/common/turb/mode_emoist.F90
index f17bc3168c165b43e3bac222dad961b974e4834f..42e978ae689948613cd12df7360ea1febc2928b9 100644
--- a/src/common/turb/emoist.F90
+++ b/src/common/turb/mode_emoist.F90
@@ -1,9 +1,11 @@
-!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
-! ######spl
-FUNCTION EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM) RESULT(PEMOIST)
+MODULE MODE_EMOIST
+IMPLICIT NONE
+CONTAINS
+FUNCTION EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM,OOCEAN) RESULT(PEMOIST)
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ############################################################################
@@ -56,7 +58,6 @@ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!* 0. DECLARATIONS
! ------------
USE MODD_CST
-USE MODD_DYN_n, ONLY : LOCEAN
!
IMPLICIT NONE
!
@@ -65,6 +66,7 @@ IMPLICIT NONE
!
INTEGER :: KRR ! number of moist var.
INTEGER :: KRRI ! number of ice var.
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM ! Conservative pot. temperature
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios, where
@@ -93,7 +95,7 @@ INTEGER :: JRR ! moist loop counter
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('EMOIST',0,ZHOOK_HANDLE)
!
-IF (LOCEAN) THEN
+IF (OOCEAN) THEN
IF ( KRR == 0 ) THEN ! Unsalted
PEMOIST(:,:,:) = 0.
ELSE
@@ -162,3 +164,4 @@ END IF
!
IF (LHOOK) CALL DR_HOOK('EMOIST',1,ZHOOK_HANDLE)
END FUNCTION EMOIST
+END MODULE MODE_EMOIST
diff --git a/src/common/turb/etheta.F90 b/src/common/turb/mode_etheta.F90
similarity index 95%
rename from src/common/turb/etheta.F90
rename to src/common/turb/mode_etheta.F90
index f0506bd89dc5fc455e55281835ba7c1ab6b2365c..536133615c743dc04bd48eefeca355fa87992d60 100644
--- a/src/common/turb/etheta.F90
+++ b/src/common/turb/mode_etheta.F90
@@ -2,8 +2,10 @@
!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
-FUNCTION ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM) RESULT(PETHETA)
+MODULE MODE_ETHETA
+IMPLICIT NONE
+CONTAINS
+FUNCTION ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM,OOCEAN) RESULT(PETHETA)
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ############################################################################
@@ -55,7 +57,6 @@ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!* 0. DECLARATIONS
! ------------
USE MODD_CST
-USE MODD_DYN_n, ONLY : LOCEAN
!
IMPLICIT NONE
!
@@ -64,6 +65,7 @@ IMPLICIT NONE
!
INTEGER :: KRR ! number of moist var.
INTEGER :: KRRI ! number of ice var.
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM ! Conservative pot. temperature
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios, where
@@ -95,7 +97,7 @@ INTEGER :: JRR ! moist loop counter
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('ETHETA',0,ZHOOK_HANDLE)
-IF (LOCEAN) THEN ! ocean case
+IF (OOCEAN) THEN ! ocean case
PETHETA(:,:,:) = 1.
ELSE
IF ( KRR == 0) THEN ! dry case
@@ -153,3 +155,4 @@ END IF
!
IF (LHOOK) CALL DR_HOOK('ETHETA',1,ZHOOK_HANDLE)
END FUNCTION ETHETA
+END MODULE MODE_ETHETA
diff --git a/src/common/turb/mode_mf_turb.F90 b/src/common/turb/mode_mf_turb.F90
index 86f1d2f311ec85ab6c0997c594572caf87a684b7..7f9e698ce2f108aa9b5fc33d8a6ccbfdaa2f0d40 100644
--- a/src/common/turb/mode_mf_turb.F90
+++ b/src/common/turb/mode_mf_turb.F90
@@ -63,7 +63,10 @@ CONTAINS
! ------------
!
USE MODI_SHUMAN_MF, ONLY: MZM_MF
-USE MODI_TRIDIAG_MASSFLUX
+USE MODE_TRIDIAG_MASSFLUX, ONLY: TRIDIAG_MASSFLUX
+!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
diff --git a/src/arome/turb/mode_prandtl.F90 b/src/common/turb/mode_prandtl.F90
similarity index 77%
rename from src/arome/turb/mode_prandtl.F90
rename to src/common/turb/mode_prandtl.F90
index d460f8e0bc4b5af58dc41c7adef903aa53ae1f67..ec71f8db23686f1b59281dd1ecb8ede1d799eaaa 100644
--- a/src/arome/turb/mode_prandtl.F90
+++ b/src/common/turb/mode_prandtl.F90
@@ -1,4 +1,9 @@
-! ######spl
+!MNH_LIC Copyright 1994-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 MODE_PRANDTL
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
@@ -6,6 +11,7 @@
!
!* modification 08/2010 V. Masson smoothing of the discontinuity in functions
! used for implicitation of exchange coefficients
+! 05/2020 V. Masson and C. Lac : bug in D_PHI3DTDZ2_O_DDTDZ
!
USE MODD_CTURB, ONLY : XCTV, XCSHF, XCTD, XPHI_LIM, XCPR3, XCPR4, XCPR5
USE MODD_PARAMETERS, ONLY : JPVEXT_TURB
@@ -15,6 +21,539 @@ IMPLICIT NONE
!----------------------------------------------------------------------------
CONTAINS
!----------------------------------------------------------------------------
+ SUBROUTINE PRANDTL(KKA,KKU,KKL,KRR,KRRI,OTURB_DIAG, &
+ HTURBDIM,OOCEAN, &
+ TPFILE, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PTHVREF,PLOCPEXNM,PATHETA,PAMOIST, &
+ PLM,PLEPS,PTKEM,PTHLM,PRM,PSVM,PSRCM, &
+ PREDTH1,PREDR1, &
+ PRED2TH3, PRED2R3, PRED2THR3, &
+ PREDS1,PRED2THS3, PRED2RS3, &
+ PBLL_O_E, &
+ PETHETA, PEMOIST )
+! ###########################################################
+!
+!
+!!**** *PRANDTL* - routine to compute the Prandtl turbulent numbers
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to compute the Redelsperger
+! numbers and then get the turbulent Prandtl and Schmidt numbers:
+! * for the heat fluxes - PHI3 = 1/ Prandtl
+! * for the moisture fluxes - PSI3 = 1/ Schmidt
+!
+!!** METHOD
+!! ------
+!! The following steps are performed:
+!!
+!! 1 - default values of 1 are taken for phi3 and psi3 and different masks
+!! are defined depending on the presence of turbulence, stratification and
+!! humidity. The 1D Redelsperger numbers are computed
+!! * ZREDTH1 : (g / THVREF ) (LT**2 / TKE ) ETHETA (D Theta / Dz)
+!! * ZREDR1 : (g / THVREF ) (LT**2 / TKE ) EMOIST (D TW / Dz)
+!! 2 - 3D Redelsperger numbers are computed only for turbulent
+!! grid points where ZREDTH1 or ZREDR1 are > 0.
+!! 3 - PHI3 is computed only for turbulent grid points where ZREDTH1 > 0
+!! (turbulent thermally stratified points)
+!! 4 - PSI3 is computed only for turbulent grid points where ZREDR1 > 0
+!! (turbulent moist points)
+!!
+!!
+!! EXTERNAL
+!! --------
+!! FUNCTIONs ETHETA and EMOIST :
+!! allows to compute the coefficients
+!! for the turbulent correlation between any variable
+!! and the virtual potential temperature, of its correlations
+!! with the conservative potential temperature and the humidity
+!! conservative variable:
+!! ------- ------- -------
+!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
+!!
+!! GX_M_M, GY_M_M, GZ_M_M : Cartesian gradient operators
+!! MZM : Shuman function (mean operator in the z direction)
+!! Module MODI_ETHETA : interface module for ETHETA
+!! Module MODI_EMOIST : interface module for EMOIST
+!! Module MODI_SHUMAN : interface module for Shuman operators
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : contains physical constants
+!! XG : gravity constant
+!!
+!! Module MODD_CTURB: contains the set of constants for
+!! the turbulence scheme
+!! XCTV,XCPR2 : constants for the turbulent prandtl numbers
+!! XTKEMIN : minimum value allowed for the TKE
+!!
+!! Module MODD_PARAMETERS
+!! JPVEXT_TURB : number of vertical marginal points
+!!
+!! REFERENCE
+!! ---------
+!! Book 2 of documentation (routine PRANDTL)
+!! Book 1 of documentation (Chapter: Turbulence)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart * INM and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 18/10/94
+!! Modifications: Feb 14, 1995 (J.Cuxart and J.Stein)
+!! Doctorization and Optimization
+!! Modifications: March 21, 1995 (J.M. Carriere)
+!! Introduction of cloud water
+!! Modifications: March 21, 1995 (J. Cuxart and J.Stein)
+!! Phi3 and Psi3 at w point + cleaning
+!! Modifications: July 2, 1995 (J.Cuxart and Ph.Bougeault)
+!! change the value of Phi3 and Psi3 if negative
+!! Modifications: Sept 20, 1995 (J. Stein, J. Cuxart, J.L. Redelsperger)
+!! remove the Where + use REDTH1+REDR1 for the tests
+!! Modifications: October 10, 1995 (J. Cuxart and J.Stein)
+!! Psi3 for tPREDS1he scalar variables
+!! Modifications: February 27, 1996 (J.Stein) optimization
+!! Modifications: June 15, 1996 (P.Jabouille) return to the previous
+!! computation of Phi3 and Psi3
+!! Modifications: October 10, 1996 (J. Stein) change the temporal
+!! discretization
+!! Modifications: May 23, 1997 (J. Stein) bug in 3D Redels number at ground
+!! with orography
+!! Modifications: Feb 20, 1998 (J. Stein) bug in all the 3D cases due to
+!! the use of ZW1 instead of ZW2
+!! Feb 20, 2003 (JP Pinty) Add PFRAC_ICE
+!! July 2005 (Tomas, Masson) implicitation of PHI3 and PSI3
+!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
+!! change of YCOMMENT
+!! 2012-02 Y. Seity, add possibility to run with reversed
+!! vertical levels
+!! Modifications: July 2015 (Wim de Rooy) LHARAT (Racmo turbulence) switch
+!! 2017-09 J.Escobar, use epsilon XMNH_TINY_12 for R*4
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! JL Redelsperger 03/2021 : adding Ocean case for temperature only
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
+USE MODD_CST
+USE MODD_CONF
+USE MODD_CTURB
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PARAMETERS
+!
+USE MODI_GRADIENT_M
+USE MODE_EMOIST, ONLY: EMOIST
+USE MODE_ETHETA, ONLY: ETHETA
+USE MODI_SHUMAN, ONLY: MZM
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice var.
+!
+LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
+ ! diagnostic fields in the syncronous FM-file
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
+CHARACTER(LEN=4), INTENT(IN) :: HTURBDIM ! Kind of turbulence param.
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
+ ! metric coefficients
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential Temp.
+ ! of the reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turbulent Mixing length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! Dissipative length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM,PTKEM! Conservative Potential
+ ! Temperature and TKE at t-1
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios at t-1
+ ! with PRM(:,:,:,1) = cons.
+ ! mixing ratio
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Scalars at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM
+ ! s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PREDTH1 ! Redelsperger number R_theta
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PREDR1 ! Redelsperger number R_q
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2TH3 ! Redelsperger number R*2_theta
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2R3 ! Redelsperger number R*2_q
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2THR3! Redelsperger number R*2_thq
+REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PREDS1 ! Redelsperger number R_s
+REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PRED2THS3! Redelsperger number R*2_thsv
+REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PRED2RS3 ! Redelsperger number R*2_qsv
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBLL_O_E! beta*Lk*Leps/tke
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PETHETA ! coefficient E_theta
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEMOIST ! coefficient E_moist
+!
+!
+! 0.2 declaration of local variables
+!
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
+ ZW1, ZW2, ZW3
+! working variables
+!
+INTEGER :: IKB ! vertical index value for the first inner mass point
+INTEGER :: IKE ! vertical index value for the last inner mass point
+INTEGER :: IRESP ! Return code of FM routines
+INTEGER :: ILENG ! Length of the data field in LFIFM file
+INTEGER :: IGRID ! C-grid indicator in LFIFM file
+INTEGER :: ILENCH ! Length of comment string in LFIFM file
+CHARACTER (LEN=100) :: YCOMMENT ! comment string in LFIFM file
+CHARACTER (LEN=16) :: YRECFM ! Name of the desired field in LFIFM file
+INTEGER:: ISV ! number of scalar variables
+INTEGER:: JSV ! loop index for the scalar variables
+
+INTEGER :: JLOOP
+REAL :: ZMINVAL
+TYPE(TFIELDDATA) :: TZFIELD
+! ---------------------------------------------------------------------------
+!
+!* 1. DEFAULT VALUES, 1D REDELSPERGER NUMBERS
+! ----------------------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('PRANDTL',0,ZHOOK_HANDLE)
+
+IF (LHARAT) THEN
+PREDTH1(:,:,:)=0.
+PREDR1(:,:,:)=0.
+PRED2TH3(:,:,:)=0.
+PRED2R3(:,:,:)=0.
+PRED2THR3(:,:,:)=0.
+PREDS1(:,:,:,:)=0.
+PRED2THS3(:,:,:,:)=0.
+PRED2RS3(:,:,:,:)=0.
+PBLL_O_E(:,:,:)=0.
+ENDIF
+!
+IKB = KKA+JPVEXT_TURB*KKL
+IKE = KKU-JPVEXT_TURB*KKL
+ILENG=SIZE(PTHLM,1)*SIZE(PTHLM,2)*SIZE(PTHLM,3)
+ISV =SIZE(PSVM,4)
+!
+PETHETA(:,:,:) = MZM(ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM,OOCEAN), KKA, KKU, KKL)
+PEMOIST(:,:,:) = MZM(EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM,OOCEAN), KKA, KKU, KKL)
+PETHETA(:,:,KKA) = 2.*PETHETA(:,:,IKB) - PETHETA(:,:,IKB+KKL)
+PEMOIST(:,:,KKA) = 2.*PEMOIST(:,:,IKB) - PEMOIST(:,:,IKB+KKL)
+!
+!---------------------------------------------------------------------------
+IF (.NOT. LHARAT) THEN
+!
+! 1.3 1D Redelsperger numbers
+!
+PBLL_O_E(:,:,:) = MZM(XG / PTHVREF(:,:,:) * PLM(:,:,:) * PLEPS(:,:,:) / PTKEM(:,:,:), KKA, KKU, KKL)
+IF (KRR /= 0) THEN ! moist case
+ PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * PETHETA(:,:,:) * &
+ & GZ_M_W(KKA, KKU, KKL,PTHLM,PDZZ)
+ PREDR1(:,:,:) = XCTV*PBLL_O_E(:,:,:) * PEMOIST(:,:,:) * &
+ & GZ_M_W(KKA, KKU, KKL,PRM(:,:,:,1),PDZZ)
+ELSE ! dry case
+ PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * GZ_M_W(KKA, KKU, KKL,PTHLM,PDZZ)
+ PREDR1(:,:,:) = 0.
+END IF
+!
+! 3. Limits on 1D Redelperger numbers
+! --------------------------------
+!
+ZMINVAL = (1.-1./XPHI_LIM)
+!
+ZW1 = 1.
+ZW2 = 1.
+!
+WHERE (PREDTH1+PREDR1<-ZMINVAL)
+ ZW1 = (-ZMINVAL) / (PREDTH1+PREDR1)
+END WHERE
+!
+WHERE (PREDTH1<-ZMINVAL)
+ ZW2 = (-ZMINVAL) / (PREDTH1)
+END WHERE
+ZW2 = MIN(ZW1,ZW2)
+!
+ZW1 = 1.
+WHERE (PREDR1<-ZMINVAL)
+ ZW1 = (-ZMINVAL) / (PREDR1)
+END WHERE
+ZW1 = MIN(ZW2,ZW1)
+!
+!
+! 3. Modification of Mixing length and dissipative length
+! ----------------------------------------------------
+!
+PBLL_O_E(:,:,:) = PBLL_O_E(:,:,:) * ZW1(:,:,:)
+PREDTH1 (:,:,:) = PREDTH1 (:,:,:) * ZW1(:,:,:)
+PREDR1 (:,:,:) = PREDR1 (:,:,:) * ZW1(:,:,:)
+!
+! 4. Threshold for very small (in absolute value) Redelperger numbers
+! ----------------------------------------------------------------
+!
+ZW2=SIGN(1.,PREDTH1(:,:,:))
+PREDTH1(:,:,:)= ZW2(:,:,:) * MAX(1.E-30, ZW2(:,:,:)*PREDTH1(:,:,:))
+!
+IF (KRR /= 0) THEN ! dry case
+ ZW2=SIGN(1.,PREDR1(:,:,:))
+ PREDR1(:,:,:)= ZW2(:,:,:) * MAX(1.E-30, ZW2(:,:,:)*PREDR1(:,:,:))
+END IF
+!
+!
+!---------------------------------------------------------------------------
+!
+! For the scalar variables
+DO JSV=1,ISV
+ PREDS1(:,:,:,JSV)=XCTV*PBLL_O_E(:,:,:)*GZ_M_W(KKA, KKU, KKL,PSVM(:,:,:,JSV),PDZZ)
+END DO
+!
+DO JSV=1,ISV
+ ZW2=SIGN(1.,PREDS1(:,:,:,JSV))
+ PREDS1(:,:,:,JSV)= ZW2(:,:,:) * MAX(1.E-30, ZW2(:,:,:)*PREDS1(:,:,:,JSV))
+END DO
+!
+!---------------------------------------------------------------------------
+!
+!* 2. 3D REDELSPERGER NUMBERS
+! ------------------------
+!
+IF(HTURBDIM=='1DIM') THEN ! 1D case
+!
+!
+ PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2
+!
+ PRED2R3(:,:,:) = PREDR1(:,:,:) **2
+!
+ PRED2THR3(:,:,:) = PREDTH1(:,:,:) * PREDR1(:,:,:)
+!
+ELSE IF (L2D) THEN ! 3D case in a 2D model
+!
+ IF (KRR /= 0) THEN ! moist 3D case
+ PRED2TH3(:,:,:)= PREDTH1(:,:,:)**2+(XCTV*PBLL_O_E(:,:,:)*PETHETA(:,:,:) )**2 * &
+ MZM(GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL)**2, KKA, KKU, KKL)
+ PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
+!
+ PRED2R3(:,:,:)= PREDR1(:,:,:)**2 + (XCTV*PBLL_O_E(:,:,:)*PEMOIST(:,:,:))**2 * &
+ MZM(GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX, KKA, KKU, KKL)**2, KKA, KKU, KKL)
+ PRED2R3(:,:,IKB)=PRED2R3(:,:,IKB+KKL)
+!
+ PRED2THR3(:,:,:)= PREDR1(:,:,:) * PREDTH1(:,:,:) + XCTV**2*PBLL_O_E(:,:,:)**2 * &
+ PEMOIST(:,:,:) * PETHETA(:,:,:) * &
+ MZM(GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX, KKA, KKU, KKL)* &
+ GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL), KKA, KKU, KKL)
+ PRED2THR3(:,:,IKB)=PRED2THR3(:,:,IKB+KKL)
+!
+ ELSE ! dry 3D case in a 2D model
+ PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2 + XCTV**2*PBLL_O_E(:,:,:)**2 * &
+ MZM(GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL)**2, KKA, KKU, KKL)
+ PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
+!
+ PRED2R3(:,:,:) = 0.
+!
+ PRED2THR3(:,:,:) = 0.
+!
+ END IF
+!
+ELSE ! 3D case in a 3D model
+!
+ IF (KRR /= 0) THEN ! moist 3D case
+ PRED2TH3(:,:,:)= PREDTH1(:,:,:)**2 + ( XCTV*PBLL_O_E(:,:,:)*PETHETA(:,:,:) )**2 * &
+ MZM(GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL)**2 &
+ + GY_M_M(PTHLM,PDYY,PDZZ,PDZY, KKA, KKU, KKL)**2, KKA, KKU, KKL)
+ PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
+!
+ PRED2R3(:,:,:)= PREDR1(:,:,:)**2 + (XCTV*PBLL_O_E(:,:,:)*PEMOIST(:,:,:))**2 * &
+ MZM(GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX, KKA, KKU, KKL)**2 + &
+ GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY, KKA, KKU, KKL)**2, KKA, KKU, KKL)
+ PRED2R3(:,:,IKB)=PRED2R3(:,:,IKB+KKL)
+!
+ PRED2THR3(:,:,:)= PREDR1(:,:,:) * PREDTH1(:,:,:) + XCTV**2*PBLL_O_E(:,:,:)**2 * &
+ PEMOIST(:,:,:) * PETHETA(:,:,:) * &
+ MZM(GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX, KKA, KKU, KKL)* &
+ GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL)+ &
+ GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY, KKA, KKU, KKL)* &
+ GY_M_M(PTHLM,PDYY,PDZZ,PDZY, KKA, KKU, KKL), KKA, KKU, KKL)
+ PRED2THR3(:,:,IKB)=PRED2THR3(:,:,IKB+KKL)
+!
+ ELSE ! dry 3D case in a 3D model
+ PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2 + XCTV**2*PBLL_O_E(:,:,:)**2 * &
+ MZM(GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL)**2 &
+ + GY_M_M(PTHLM,PDYY,PDZZ,PDZY, KKA, KKU, KKL)**2, KKA, KKU, KKL)
+ PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
+!
+ PRED2R3(:,:,:) = 0.
+!
+ PRED2THR3(:,:,:) = 0.
+!
+ END IF
+!
+END IF ! end of the if structure on the turbulence dimensionnality
+!
+!
+!---------------------------------------------------------------------------
+!
+! 5. Prandtl numbers for scalars
+! ---------------------------
+DO JSV=1,ISV
+!
+ IF(HTURBDIM=='1DIM') THEN
+! 1D case
+ PRED2THS3(:,:,:,JSV) = PREDS1(:,:,:,JSV) * PREDTH1(:,:,:)
+ IF (KRR /= 0) THEN
+ PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) *PREDS1(:,:,:,JSV)
+ ELSE
+ PRED2RS3(:,:,:,JSV) = 0.
+ END IF
+!
+ ELSE IF (L2D) THEN ! 3D case in a 2D model
+!
+ IF (KRR /= 0) THEN
+ ZW1 = MZM((XG / PTHVREF * PLM * PLEPS / PTKEM)**2, KKA, KKU, KKL) *PETHETA
+ ELSE
+ ZW1 = MZM((XG / PTHVREF * PLM * PLEPS / PTKEM)**2, KKA, KKU, KKL)
+ END IF
+ PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + &
+ ZW1* &
+ MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX, KKA, KKU, KKL)* &
+ GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL), &
+ KKA, KKU, KKL)
+!
+ IF (KRR /= 0) THEN
+ PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
+ ZW1 * PEMOIST * &
+ MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX, KKA, KKU, KKL)* &
+ GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX, KKA, KKU, KKL), &
+ KKA, KKU, KKL)
+ ELSE
+ PRED2RS3(:,:,:,JSV) = 0.
+ END IF
+!
+ ELSE ! 3D case in a 3D model
+!
+ IF (KRR /= 0) THEN
+ ZW1 = MZM((XG / PTHVREF * PLM * PLEPS / PTKEM)**2, KKA, KKU, KKL) *PETHETA
+ ELSE
+ ZW1 = MZM((XG / PTHVREF * PLM * PLEPS / PTKEM)**2, KKA, KKU, KKL)
+ END IF
+ PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + &
+ ZW1* &
+ MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX, KKA, KKU, KKL)* &
+ GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL) &
+ +GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY, KKA, KKU, KKL)* &
+ GY_M_M(PTHLM,PDYY,PDZZ,PDZY, KKA, KKU, KKL), &
+ KKA, KKU, KKL)
+!
+ IF (KRR /= 0) THEN
+ PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
+ ZW1 * PEMOIST * &
+ MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX, KKA, KKU, KKL)* &
+ GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX, KKA, KKU, KKL) &
+ +GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY, KKA, KKU, KKL)* &
+ GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY, KKA, KKU, KKL), &
+ KKA, KKU, KKL)
+ ELSE
+ PRED2RS3(:,:,:,JSV) = 0.
+ END IF
+!
+ END IF ! end of HTURBDIM if-block
+!
+END DO
+!
+!---------------------------------------------------------------------------
+!
+!* 6. SAVES THE REDELSPERGER NUMBERS
+! ------------------------------
+!
+IF ( OTURB_DIAG .AND. TPFILE%LOPENED ) THEN
+ !
+ ! stores the RED_TH1
+ TZFIELD%CMNHNAME = 'RED_TH1'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'RED_TH1'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_RED_TH1'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PREDTH1)
+ !
+ ! stores the RED_R1
+ TZFIELD%CMNHNAME = 'RED_R1'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'RED_R1'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_RED_R1'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PREDR1)
+ !
+ ! stores the RED2_TH3
+ TZFIELD%CMNHNAME = 'RED2_TH3'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'RED2_TH3'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_RED2_TH3'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PRED2TH3)
+ !
+ ! stores the RED2_R3
+ TZFIELD%CMNHNAME = 'RED2_R3'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'RED2_R3'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_RED2_R3'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PRED2R3)
+ !
+ ! stores the RED2_THR3
+ TZFIELD%CMNHNAME = 'RED2_THR3'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'RED2_THR3'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_RED2_THR3'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PRED2THR3)
+ !
+END IF
+!
+!---------------------------------------------------------------------------
+ENDIF ! (Done only if LHARAT is FALSE)
+!
+IF (LHOOK) CALL DR_HOOK('PRANDTL',1,ZHOOK_HANDLE)
+END SUBROUTINE PRANDTL
+!
SUBROUTINE SMOOTH_TURB_FUNCT(PPHI3,PF_LIM,PF)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3 ! Phi3
@@ -423,12 +962,10 @@ D_M3_WTH_W2TH_O_DDTDZ(:,:,IKE+1)=D_M3_WTH_W2TH_O_DDTDZ(:,:,IKE)
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_W2TH_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_WTH_W2TH_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WTH_W2R(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
+FUNCTION M3_WTH_W2R(KKA,KKU,KKL,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
@@ -479,12 +1016,10 @@ D_M3_WTH_W2R_O_DDTDZ(:,:,IKE+1)=D_M3_WTH_W2R_O_DDTDZ(:,:,IKE)
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_W2R_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_WTH_W2R_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WTH_WR2(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTDZ)
+FUNCTION M3_WTH_WR2(KKA,KKU,KKL,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTDZ)
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
@@ -1259,12 +1794,10 @@ D_M3_WR_W2R_O_DDRDZ = D_M3_WTH_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PBLL_O
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_W2R_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_WR_W2R_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WR_W2TH(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+FUNCTION M3_WR_W2TH(KKA,KKU,KKL,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ)
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
@@ -1275,7 +1808,7 @@ FUNCTION M3_WR_W2TH(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PD
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_W2TH',0,ZHOOK_HANDLE)
-M3_WR_W2TH = M3_WTH_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+M3_WR_W2TH = M3_WTH_W2R(KKA,KKU,KKL,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ)
!
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_W2TH',1,ZHOOK_HANDLE)
END FUNCTION M3_WR_W2TH
@@ -1300,12 +1833,10 @@ D_M3_WR_W2TH_O_DDRDZ = D_M3_WTH_W2R_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_W2TH_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_WR_W2TH_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WR_WTH2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ)
+FUNCTION M3_WR_WTH2(KKA,KKU,KKL,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ)
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
@@ -1319,7 +1850,7 @@ FUNCTION M3_WR_WTH2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_WTH2',0,ZHOOK_HANDLE)
-M3_WR_WTH2 = M3_WTH_WR2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ)
+M3_WR_WTH2 = M3_WTH_WR2(KKA,KKU,KKL,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ)
!
IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_WTH2',1,ZHOOK_HANDLE)
END FUNCTION M3_WR_WTH2
diff --git a/src/common/turb/rmc01.F90 b/src/common/turb/mode_rmc01.F90
similarity index 95%
rename from src/common/turb/rmc01.F90
rename to src/common/turb/mode_rmc01.F90
index 7488d6cbd8f5651433d9f34838940920a54ea5f4..628b4cad0dda1fcef65f2a70fd43b0ef5ec61e0f 100644
--- a/src/common/turb/rmc01.F90
+++ b/src/common/turb/mode_rmc01.F90
@@ -1,5 +1,11 @@
-! ######spl
- SUBROUTINE RMC01(HTURBLEN,KKA,KKU,KKL,PZZ,PDXX,PDYY, &
+!MNH_LIC Copyright 1994-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 MODE_RMC01
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE RMC01(HTURBLEN,KKA,KKU,KKL,PZZ,PDXX,PDYY, &
PDZZ,PDIRCOSZW,PSBL_DEPTH,PLMO,PLK,PLEPS)
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
@@ -233,3 +239,4 @@ PLEPS(:,:,KKU ) = PLEPS(:,:,IKE)
!
IF (LHOOK) CALL DR_HOOK('RMC01',1,ZHOOK_HANDLE)
END SUBROUTINE RMC01
+END MODULE MODE_RMC01
diff --git a/src/common/turb/mode_rotate_wind.F90 b/src/common/turb/mode_rotate_wind.F90
new file mode 100644
index 0000000000000000000000000000000000000000..e117b95f81770e26771aee5999a8ef9aedaef688
--- /dev/null
+++ b/src/common/turb/mode_rotate_wind.F90
@@ -0,0 +1,204 @@
+!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 MODE_ROTATE_WIND
+! #######################
+IMPLICIT NONE
+CONTAINS
+! ###########################################################
+ SUBROUTINE ROTATE_WIND(PU,PV,PW, &
+ PDIRCOSXW, PDIRCOSYW, PDIRCOSZW, &
+ PCOSSLOPE,PSINSLOPE, &
+ PDXX,PDYY,PDZZ, &
+ PUSLOPE,PVSLOPE )
+! ###########################################################
+!
+!
+!!**** *ROTATE_WIND* - computes the wind components along the maximum slope
+!! direction and its normal direction in the first mass level.
+!!
+!! PURPOSE
+!! -------
+!!****
+! The purpose of this routine is to compute the wind component parallel
+! to the orography at the first mass level. The exact location where these
+! components are computed is the point of intersection between the normal
+! to the orography and the first mass-level hyper-plane at PDZZ(:,:,IKB)/2
+!
+!!** METHOD
+!! ------
+!! The values of the 3 cartesian components of the wind are determined
+!! by a bilinear interpolation between the 4 nearest points in the first
+!! mass-level hyper-plane. These points are found according to the signs of
+!! the slopes' sinus and cosinus. For each direction of interpolation, the
+!! two different localizations (mass or flux grids) are used to avoid
+!! lateral boundary problems.
+!! Then, the rotation is performed for the wind components. The rotation
+!! angle is the angle between the x axe and the maximum slope direction
+!! defined by the slope vector (dZs/dx , dZs/dy).
+!! Finally, the horizontal components are set at the marginal points
+!! according to cyclic boundary conditions because this is the only case
+!! where these points can be considered.
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! MODD_CONF : L2D switch for 2D model version
+!!
+!!
+!! REFERENCE
+!! ---------
+!! Book 1 of documentation (Chapter: Turbulence)
+!!
+!! AUTHOR
+!! ------
+!! Joel Stein * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 14/11/95
+!! Modifications: 15/05/96, (N. wood)
+!! take into account no slip conditions
+!! at the surface
+!! 14/02/01 (V. Masson)
+!! Slip condition at the surface restored
+!!
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PU,PV,PW ! cartesian components
+ ! of the wind
+REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW, PDIRCOSZW
+! Director Cosinus along x, y and z directions at surface w-point
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
+ ! between i and the slope vector
+REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
+ ! between i and the slope vector
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ
+ ! Metric coefficients
+REAL, DIMENSION(:,:), INTENT(OUT) :: PUSLOPE ! wind component along
+ ! the maximum slope direction
+REAL, DIMENSION(:,:), INTENT(OUT) :: PVSLOPE ! wind component along
+ ! the direction normal to the maximum slope one
+!
+!-------------------------------------------------------------------------------
+!
+! 0.2 declaration of local variables
+!
+INTEGER, DIMENSION(SIZE(PDIRCOSXW,1),SIZE(PDIRCOSXW,2)) :: ILOC,JLOC
+ ! shift index to find the 4 nearest points in x and y directions
+REAL, DIMENSION(SIZE(PDIRCOSXW,1),SIZE(PDIRCOSXW,2)) :: ZCOEFF,ZCOEFM, &
+ ! interpolation weigths for flux and mass locations
+ ZUINT,ZVINT,ZWINT, &
+ ! intermediate values of the cartesian components after x interp.
+ ZUFIN,ZVFIN,ZWFIN, &
+ ! final values of the cartesian components after the 2 interp.
+ ZWGROUND
+ ! vertical velocity at the surface
+INTEGER :: IIB,IIE,IJB,IJE,IKB
+ ! index values for the Beginning or the End of the physical
+ ! domain in x,y and z directions
+INTEGER :: IIU,IJU
+ ! arrays' sizes for i and j indices
+INTEGER :: JI,JJ
+!
+!----------------------------------------------------------------------------
+!
+!* 1. PRELIMINARIES
+! -------------
+!
+PUSLOPE=0.
+PVSLOPE=0.
+!
+IIB = 2
+IJB = 2
+IIU = SIZE(PU,1)
+IJU = SIZE(PU,2)
+IIE = IIU - 1
+IJE = IJU - 1
+IKB = 1+JPVEXT
+!
+ZWGROUND(:,:) = PW(:,:,IKB)
+!
+!* 2. INTERPOLATE THE CARTESIAN COMPONENTS
+! ------------------------------------
+!
+ILOC(:,:)=NINT(SIGN(1.,-PCOSSLOPE(:,:)))
+JLOC(:,:)=NINT(SIGN(1.,-PSINSLOPE(:,:)))
+!
+! interpolation in x direction
+!
+DO JJ = 1,IJU
+ DO JI = IIB,IIE
+ ZCOEFF(JI,JJ) = &
+ (0.5*PDXX(JI,JJ,IKB) + 0.5*PDZZ(JI,JJ,IKB)*PDIRCOSXW(JI,JJ) ) &
+ * 2. / (PDXX(JI,JJ,IKB)+PDXX(JI+1,JJ,IKB))
+ ZUINT(JI,JJ) = ZCOEFF(JI,JJ) * PU(JI+1,JJ,IKB) + &
+ (1.-ZCOEFF(JI,JJ)) * PU(JI,JJ,IKB)
+ !
+ ZCOEFM(JI,JJ) = 1. - 0.5 * PDZZ(JI,JJ,IKB) * ABS(PDIRCOSXW(JI,JJ)) &
+ / PDXX(JI+(ILOC(JI,JJ)+1)/2,JJ,IKB)
+ ZVINT(JI,JJ) = ZCOEFM(JI,JJ) * PV(JI,JJ,IKB) + &
+ (1.-ZCOEFM(JI,JJ)) * PV(JI+ILOC(JI,JJ),JJ,IKB)
+ !
+ ZWINT(JI,JJ) = ZCOEFM(JI,JJ) * (PW(JI,JJ,IKB+1)+ZWGROUND(JI,JJ)) * 0.5 &
+ + (1.-ZCOEFM(JI,JJ)) &
+ *(PW(JI+ILOC(JI,JJ),JJ,IKB+1)+ZWGROUND(JI+ILOC(JI,JJ),JJ)) * 0.5
+ END DO
+END DO
+!
+! interpolation in y direction
+!
+DO JJ = IJB,IJE
+ DO JI = IIB,IIE
+ ZCOEFF(JI,JJ) = &
+ (0.5*PDYY(JI,JJ,IKB) + 0.5*PDZZ(JI,JJ,IKB)*PDIRCOSYW(JI,JJ) ) &
+ * 2. / (PDYY(JI,JJ,IKB)+PDYY(JI+1,JJ,IKB))
+ ZVFIN(JI,JJ) = ZCOEFF(JI,JJ) * ZVINT(JI,JJ+1) + &
+ (1.-ZCOEFF(JI,JJ)) * ZVINT(JI,JJ)
+ !
+ ZCOEFM(JI,JJ) = 1. - 0.5 * PDZZ(JI,JJ,IKB) * ABS(PDIRCOSYW(JI,JJ)) &
+ / PDYY(JI,JJ+(JLOC(JI,JJ)+1)/2,IKB)
+ ZUFIN(JI,JJ) = ZCOEFM(JI,JJ) * ZUINT(JI,JJ) + &
+ (1.-ZCOEFM(JI,JJ)) * ZUINT(JI,JJ+JLOC(JI,JJ))
+ ZWFIN(JI,JJ) = ZCOEFM(JI,JJ) * ZWINT(JI,JJ) + &
+ (1.-ZCOEFM(JI,JJ)) * ZWINT(JI,JJ+JLOC(JI,JJ))
+ END DO
+END DO
+!
+!* 3. ROTATE THE WIND
+! ---------------
+!
+!
+DO JJ = IJB,IJE
+ DO JI = IIB,IIE
+ PUSLOPE(JI,JJ) = PCOSSLOPE(JI,JJ) * PDIRCOSZW(JI,JJ) * ZUFIN(JI,JJ) + &
+ PSINSLOPE(JI,JJ) * PDIRCOSZW(JI,JJ) * ZVFIN(JI,JJ) + &
+ SQRT(1.-PDIRCOSZW(JI,JJ)**2) * ZWFIN(JI,JJ)
+ !
+ PVSLOPE(JI,JJ) =-PSINSLOPE(JI,JJ) * ZUFIN(JI,JJ) + &
+ PCOSSLOPE(JI,JJ) * ZVFIN(JI,JJ)
+ !
+ END DO
+END DO
+!
+!
+!
+!----------------------------------------------------------------------------
+!
+END SUBROUTINE ROTATE_WIND
+END MODULE MODE_ROTATE_WIND
diff --git a/src/arome/turb/mode_sbl.F90 b/src/common/turb/mode_sbl.F90
similarity index 90%
rename from src/arome/turb/mode_sbl.F90
rename to src/common/turb/mode_sbl.F90
index bb24bb31e9c8bf8989f81a43ec06a3ac81291604..ef8e3ac6681eebf28d3df0b0351a6bd473149893 100644
--- a/src/arome/turb/mode_sbl.F90
+++ b/src/common/turb/mode_sbl.F90
@@ -1,7 +1,10 @@
-! ######spl
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###############
MODULE MODE_SBL
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ###############
!
!!**** *MODE_SBL * - contains Surface Boundary Layer characteristics functions
@@ -36,6 +39,8 @@
!! V. Masson 06/11/02 optimization and add Businger fonction for TKE
!! V. Masson 01/01/03 use PAULSON_PSIM function
!-----------------------------------------------------------------------------
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
!* 0. DECLARATIONS
!
@@ -87,7 +92,7 @@ FUNCTION BUSINGER_PHIM_3D(PZ_O_LMO)
ELSEWHERE
BUSINGER_PHIM_3D(:,:,:) = 1. + 4.7 * PZ_O_LMO
END WHERE
-IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIM_3D',1,ZHOOK_HANDLE)
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIM_3D',1,ZHOOK_HANDLE)
END FUNCTION BUSINGER_PHIM_3D
!
!-------------------------------------------------------------------------------
@@ -103,7 +108,7 @@ FUNCTION BUSINGER_PHIM_2D(PZ_O_LMO)
ELSEWHERE
BUSINGER_PHIM_2D(:,:) = 1. + 4.7 * PZ_O_LMO
END WHERE
-IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIM_2D',1,ZHOOK_HANDLE)
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIM_2D',1,ZHOOK_HANDLE)
END FUNCTION BUSINGER_PHIM_2D
!
!-------------------------------------------------------------------------------
@@ -119,7 +124,7 @@ FUNCTION BUSINGER_PHIM_1D(PZ_O_LMO)
ELSEWHERE
BUSINGER_PHIM_1D(:) = 1. + 4.7 * PZ_O_LMO
END WHERE
-IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIM_1D',1,ZHOOK_HANDLE)
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIM_1D',1,ZHOOK_HANDLE)
END FUNCTION BUSINGER_PHIM_1D
!
!-------------------------------------------------------------------------------
@@ -135,7 +140,7 @@ FUNCTION BUSINGER_PHIM_0D(PZ_O_LMO)
ELSE
BUSINGER_PHIM_0D = 1. + 4.7 * PZ_O_LMO
END IF
-IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIM_0D',1,ZHOOK_HANDLE)
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIM_0D',1,ZHOOK_HANDLE)
END FUNCTION BUSINGER_PHIM_0D
!
!-------------------------------------------------------------------------------
@@ -153,7 +158,7 @@ FUNCTION BUSINGER_PHIH_3D(PZ_O_LMO)
ELSEWHERE
BUSINGER_PHIH_3D(:,:,:) = 0.74 + 4.7 * PZ_O_LMO
END WHERE
-IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIH_3D',1,ZHOOK_HANDLE)
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIH_3D',1,ZHOOK_HANDLE)
END FUNCTION BUSINGER_PHIH_3D
!
!-------------------------------------------------------------------------------
@@ -169,7 +174,7 @@ FUNCTION BUSINGER_PHIH_2D(PZ_O_LMO)
ELSEWHERE
BUSINGER_PHIH_2D(:,:) = 0.74 + 4.7 * PZ_O_LMO
END WHERE
-IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIH_2D',1,ZHOOK_HANDLE)
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIH_2D',1,ZHOOK_HANDLE)
END FUNCTION BUSINGER_PHIH_2D
!
!-------------------------------------------------------------------------------
@@ -185,7 +190,7 @@ FUNCTION BUSINGER_PHIH_1D(PZ_O_LMO)
ELSEWHERE
BUSINGER_PHIH_1D(:) = 0.74 + 4.7 * PZ_O_LMO
END WHERE
-IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIH_1D',1,ZHOOK_HANDLE)
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIH_1D',1,ZHOOK_HANDLE)
END FUNCTION BUSINGER_PHIH_1D
!
!-------------------------------------------------------------------------------
@@ -201,7 +206,7 @@ FUNCTION BUSINGER_PHIH_0D(PZ_O_LMO)
ELSE
BUSINGER_PHIH_0D = 0.74 + 4.7 * PZ_O_LMO
END IF
-IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIH_0D',1,ZHOOK_HANDLE)
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIH_0D',1,ZHOOK_HANDLE)
END FUNCTION BUSINGER_PHIH_0D
!
!-------------------------------------------------------------------------------
@@ -221,7 +226,7 @@ FUNCTION BUSINGER_PHIE_3D(PZ_O_LMO)
ELSEWHERE
BUSINGER_PHIE_3D(:,:,:) = 1./(1. + 4.7 * PZ_O_LMO)**2
END WHERE
-IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIE_3D',1,ZHOOK_HANDLE)
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:BUSINGER_PHIE_3D',1,ZHOOK_HANDLE)
END FUNCTION BUSINGER_PHIE_3D
!
!-------------------------------------------------------------------------------
@@ -243,7 +248,7 @@ FUNCTION PAULSON_PSIM_2D(PZ_O_LMO)
ELSEWHERE
PAULSON_PSIM_2D(:,:) = - 4.7 * PZ_O_LMO
END WHERE
-IF (LHOOK) CALL DR_HOOK('MODE_SBL:PAULSON_PSIM_2D',1,ZHOOK_HANDLE)
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:PAULSON_PSIM_2D',1,ZHOOK_HANDLE)
END FUNCTION PAULSON_PSIM_2D
!
!-------------------------------------------------------------------------------
@@ -264,7 +269,7 @@ FUNCTION PAULSON_PSIM_1D(PZ_O_LMO)
ELSEWHERE
PAULSON_PSIM_1D(:) = - 4.7 * PZ_O_LMO
END WHERE
-IF (LHOOK) CALL DR_HOOK('MODE_SBL:PAULSON_PSIM_1D',1,ZHOOK_HANDLE)
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:PAULSON_PSIM_1D',1,ZHOOK_HANDLE)
END FUNCTION PAULSON_PSIM_1D
!
!-------------------------------------------------------------------------------
@@ -285,7 +290,7 @@ FUNCTION PAULSON_PSIM_0D(PZ_O_LMO)
ELSE
PAULSON_PSIM_0D = - 4.7 * PZ_O_LMO
END IF
-IF (LHOOK) CALL DR_HOOK('MODE_SBL:PAULSON_PSIM_0D',1,ZHOOK_HANDLE)
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:PAULSON_PSIM_0D',1,ZHOOK_HANDLE)
END FUNCTION PAULSON_PSIM_0D
!
!-------------------------------------------------------------------------------
@@ -317,7 +322,7 @@ FUNCTION LMO_2D(PUSTAR,PTHETA,PRV,PSFTH,PSFRV)
LMO_2D(:,:) = - MAX(PUSTAR(:,:),1.E-6)**3 &
/ ( XKARMAN * XG / ZTHETAV(:,:) *ZQ0(:,:) )
-IF (LHOOK) CALL DR_HOOK('MODE_SBL:LMO_2D',1,ZHOOK_HANDLE)
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:LMO_2D',1,ZHOOK_HANDLE)
END FUNCTION LMO_2D
!
!-------------------------------------------------------------------------------
@@ -347,7 +352,7 @@ FUNCTION LMO_1D(PUSTAR,PTHETA,PRV,PSFTH,PSFRV)
LMO_1D(:) = - MAX(PUSTAR(:),1.E-6)**3 &
/ ( XKARMAN * ( XG / ZTHETAV(:) * PSFTH(:) &
+ XG * ZEPS * PSFRV(:) ) )
-IF (LHOOK) CALL DR_HOOK('MODE_SBL:LMO_1D',1,ZHOOK_HANDLE)
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:LMO_1D',1,ZHOOK_HANDLE)
END FUNCTION LMO_1D
!
!-------------------------------------------------------------------------------
@@ -378,7 +383,7 @@ FUNCTION LMO_0D(PUSTAR,PTHETA,PRV,PSFTH,PSFRV)
LMO_0D = - MAX(PUSTAR,1.E-6)**3 &
/ ( XKARMAN * ( XG / ZTHETAV * PSFTH &
+ XG * ZEPS * PSFRV ) )
-IF (LHOOK) CALL DR_HOOK('MODE_SBL:LMO_0D',1,ZHOOK_HANDLE)
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:LMO_0D',1,ZHOOK_HANDLE)
END FUNCTION LMO_0D
!
!-------------------------------------------------------------------------------
@@ -421,7 +426,7 @@ FUNCTION USTAR_2D(PU,PV,PZ,PZ0,PLMO)
* XKARMAN / LOG(PZ(:,:)/PZ0(:,:))
END WHERE
!
-IF (LHOOK) CALL DR_HOOK('MODE_SBL:USTAR_2D',1,ZHOOK_HANDLE)
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:USTAR_2D',1,ZHOOK_HANDLE)
END FUNCTION USTAR_2D
!
!-------------------------------------------------------------------------------
@@ -463,7 +468,7 @@ FUNCTION USTAR_1D(PU,PV,PZ,PZ0,PLMO)
* XKARMAN / LOG(PZ(:)/PZ0(:))
END WHERE
!
-IF (LHOOK) CALL DR_HOOK('MODE_SBL:USTAR_1D',1,ZHOOK_HANDLE)
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:USTAR_1D',1,ZHOOK_HANDLE)
END FUNCTION USTAR_1D
!
!-------------------------------------------------------------------------------
@@ -495,7 +500,7 @@ FUNCTION USTAR_0D(PU,PV,PZ,PZ0,PLMO)
USTAR_0D = SQRT( PU**2+PV**2 ) &
* XKARMAN / LOG(PZ/PZ0)
-IF (LHOOK) CALL DR_HOOK('MODE_SBL:USTAR_0D',1,ZHOOK_HANDLE)
+ IF (LHOOK) CALL DR_HOOK('MODE_SBL:USTAR_0D',1,ZHOOK_HANDLE)
END FUNCTION USTAR_0D
!
!-------------------------------------------------------------------------------
diff --git a/src/common/turb/sbl_depth.F90 b/src/common/turb/mode_sbl_depth.F90
similarity index 91%
rename from src/common/turb/sbl_depth.F90
rename to src/common/turb/mode_sbl_depth.F90
index 0c670f8db17dc556afeb5c44ab5df47793acf41d..e485940e06f075776b2f2ddd41aac71164aa331b 100644
--- a/src/common/turb/sbl_depth.F90
+++ b/src/common/turb/mode_sbl_depth.F90
@@ -1,3 +1,10 @@
+!MNH_LIC Copyright 1994-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 MODE_SBL_DEPTH
+IMPLICIT NONE
+CONTAINS
! ######spl
SUBROUTINE SBL_DEPTH(KKB,KKE,PZZ,PFLXU,PFLXV,PWTHV,PLMO,PSBL_DEPTH)
USE PARKIND1, ONLY : JPRB
@@ -41,7 +48,7 @@
USE MODD_PARAMETERS, ONLY : XUNDEF
USE MODD_CTURB, ONLY : XFTOP_O_FSURF, XSBL_O_BL
!
-USE MODI_BL_DEPTH_DIAG
+USE MODE_BL_DEPTH_DIAG
!
IMPLICIT NONE
!
@@ -119,3 +126,4 @@ WHERE (PLMO(:,:)==XUNDEF) PSBL_DEPTH = ZSBL_DYN
!----------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('SBL_DEPTH',1,ZHOOK_HANDLE)
END SUBROUTINE SBL_DEPTH
+END MODULE MODE_SBL_DEPTH
diff --git a/src/arome/turb/th_r_from_thl_rt_1d.F90 b/src/common/turb/mode_th_r_from_thl_rt_1d.F90
similarity index 90%
rename from src/arome/turb/th_r_from_thl_rt_1d.F90
rename to src/common/turb/mode_th_r_from_thl_rt_1d.F90
index 6b8f549df310712164170068d64ee52b767072c4..1aff6f5943ff5a99cf55a46a60c48fdb72ca3118 100644
--- a/src/arome/turb/th_r_from_thl_rt_1d.F90
+++ b/src/common/turb/mode_th_r_from_thl_rt_1d.F90
@@ -1,7 +1,13 @@
-! ######spl
+!MNH_LIC Copyright 2006-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 MODE_TH_R_FROM_THL_RT_1D
+IMPLICIT NONE
+CONTAINS
SUBROUTINE TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE,PP, &
PTHL, PRT, PTH, PRV, PRL, PRI, &
- PRSATW, PRSATI, PRR, PRS, PRG, PRH )
+ PRSATW, PRSATI, PRR, PRS, PRG, PRH,OOCEAN)
! #################################################################
!
!
@@ -35,6 +41,7 @@
!! S. Riette April 2011 : ice added, allow ZRLTEMP to be negative
!! we use dQsat/dT to help convergence
!! use of optional PRR, PRS, PRG, PRH
+!! S. Riette Nov 2016: support for HFRAC_ICE='S'
!!
!! --------------------------------------------------------------------------
!
@@ -43,7 +50,7 @@
!
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-USE MODD_CST!, ONLY: XP00, XRD, XCPD, XCPV, XCL, XCI, XLVTT, XTT, XLSTT
+USE MODD_CST !, ONLY: XP00, XRD, XCPD, XCPV, XCL, XCI, XLVTT, XTT, XLSTT
USE MODD_NEB, ONLY: NEB
USE MODE_THERMO
!
@@ -52,7 +59,8 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-CHARACTER*1 , INTENT(IN) :: HFRAC_ICE
+CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
REAL, DIMENSION(:), INTENT(INOUT) :: PFRAC_ICE
REAL, DIMENSION(:), INTENT(IN) :: PP ! Pressure
REAL, DIMENSION(:), INTENT(IN) :: PTHL ! thetal to transform into th
@@ -119,8 +127,11 @@ ENDDO
! ---------
DO II=1,JITER
- ZT(:)=PTH(:)*ZEXN(:)
-
+ IF (OOCEAN) THEN
+ ZT=PTH
+ ELSE
+ ZT(:)=PTH(:)*ZEXN(:)
+ END IF
!Computation of liquid/ice fractions
PFRAC_ICE(:) = 0.
DO J=1, SIZE(PFRAC_ICE, 1)
@@ -196,3 +207,4 @@ CONTAINS
INCLUDE "compute_frac_ice.func.h"
!
END SUBROUTINE TH_R_FROM_THL_RT_1D
+END MODULE MODE_TH_R_FROM_THL_RT_1D
diff --git a/src/arome/turb/th_r_from_thl_rt_2d.F90 b/src/common/turb/mode_th_r_from_thl_rt_2d.F90
similarity index 84%
rename from src/arome/turb/th_r_from_thl_rt_2d.F90
rename to src/common/turb/mode_th_r_from_thl_rt_2d.F90
index 5d1ff0e0802183504784a6b10abb3c76943c72df..2ac0c85284102e0ce45d4fa88a97f9fa474e708d 100644
--- a/src/arome/turb/th_r_from_thl_rt_2d.F90
+++ b/src/common/turb/mode_th_r_from_thl_rt_2d.F90
@@ -1,7 +1,13 @@
-! ######spl
+!MNH_LIC Copyright 2006-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 MODE_TH_R_FROM_THL_RT_2D
+IMPLICIT NONE
+CONTAINS
SUBROUTINE TH_R_FROM_THL_RT_2D(HFRAC_ICE,PFRAC_ICE,PP, &
PTHL, PRT, PTH, PRV, PRL, PRI, &
- PRSATW, PRSATI, PRR, PRS, PRG, PRH )
+ PRSATW, PRSATI, PRR, PRS, PRG, PRH,OOCEAN)
! #################################################################
!
!
@@ -40,7 +46,7 @@
! ------------
!
!
-USE MODI_TH_R_FROM_THL_RT_3D
+USE MODE_TH_R_FROM_THL_RT_3D, ONLY: TH_R_FROM_THL_RT_3D
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
@@ -49,7 +55,7 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-CHARACTER*1 , INTENT(IN) :: HFRAC_ICE
+CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE
REAL, DIMENSION(:,:), INTENT(INOUT) :: PFRAC_ICE
REAL, DIMENSION(:,:), INTENT(IN) :: PP ! Pressure
REAL, DIMENSION(:,:), INTENT(IN) :: PTHL ! Liquid pot. temp.
@@ -61,6 +67,7 @@ REAL, DIMENSION(:,:), INTENT(INOUT):: PRL ! cloud mixing ratio
REAL, DIMENSION(:,:), INTENT(INOUT):: PRI ! ice mixing ratio
REAL, DIMENSION(:,:), INTENT(OUT) :: PRSATW ! estimated mixing ration at saturation over water
REAL, DIMENSION(:,:), INTENT(OUT) :: PRSATI ! estimated mixing ration at saturation over ice
+LOGICAL, INTENT(IN) :: OOCEAN ! switch OCEAN version
!
!-------------------------------------------------------------------------------
@@ -95,9 +102,11 @@ DO JK=1, SIZE(PTHL,2)
PTHL(:,JK), PRT(:,JK), PTH(:,JK), &
PRV(:,JK), PRL(:,JK), PRI(:,JK), &
PRSATW(:,JK), PRSATI(:,JK), &
- ZRR(:,JK), ZRS(:,JK), ZRG(:,JK), ZRH(:,JK))
+ ZRR(:,JK), ZRS(:,JK), ZRG(:,JK), ZRH(:,JK),OOCEAN)
ENDDO
IF (LHOOK) CALL DR_HOOK('TH_R_FROM_THL_RT_2D',1,ZHOOK_HANDLE)
END SUBROUTINE TH_R_FROM_THL_RT_2D
+END MODULE MODE_TH_R_FROM_THL_RT_2D
+
diff --git a/src/arome/turb/th_r_from_thl_rt_3d.F90 b/src/common/turb/mode_th_r_from_thl_rt_3d.F90
similarity index 84%
rename from src/arome/turb/th_r_from_thl_rt_3d.F90
rename to src/common/turb/mode_th_r_from_thl_rt_3d.F90
index 473a9bcc278263fd8ea78fed112a4520567b0f21..1e179b139debd6d2c8e7c57146ba47244e7442ac 100644
--- a/src/arome/turb/th_r_from_thl_rt_3d.F90
+++ b/src/common/turb/mode_th_r_from_thl_rt_3d.F90
@@ -1,7 +1,13 @@
-! ######spl
+!MNH_LIC Copyright 2006-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 MODE_TH_R_FROM_THL_RT_3D
+IMPLICIT NONE
+CONTAINS
SUBROUTINE TH_R_FROM_THL_RT_3D(HFRAC_ICE,PFRAC_ICE,PP, &
PTHL, PRT, PTH, PRV, PRL, PRI, &
- PRSATW, PRSATI, PRR, PRS, PRG, PRH )
+ PRSATW, PRSATI, PRR, PRS, PRG, PRH,OOCEAN)
! #################################################################
!
!
@@ -39,7 +45,7 @@
!* 0. DECLARATIONS
! ------------
!
-USE MODI_TH_R_FROM_THL_RT_1D
+USE MODE_TH_R_FROM_THL_RT_1D, ONLY: TH_R_FROM_THL_RT_1D
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
@@ -48,7 +54,7 @@ IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
-CHARACTER*1 , INTENT(IN) :: HFRAC_ICE
+CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFRAC_ICE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PP ! Pressure
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHL ! thetal to transform into th
@@ -60,6 +66,7 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRL ! vapor mixing ratio
REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRI ! vapor mixing ratio
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRSATW ! estimated mixing ration at saturation over water
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRSATI ! estimated mixing ration at saturation over ice
+LOGICAL, INTENT(IN) :: OOCEAN ! switch OCEAN version
!
!-------------------------------------------------------------------------------
!
@@ -91,10 +98,11 @@ DO JK=1, SIZE(PTHL,3)
PTHL(:,JJ,JK), PRT(:,JJ,JK), PTH(:,JJ,JK), &
PRV(:,JJ,JK), PRL(:,JJ,JK), PRI(:,JJ,JK), &
PRSATW(:,JJ,JK), PRSATI(:,JJ,JK), &
- ZRR(:,JJ,JK), ZRS(:,JJ,JK), ZRG(:,JJ,JK), ZRH(:,JJ,JK))
+ ZRR(:,JJ,JK), ZRS(:,JJ,JK), ZRG(:,JJ,JK), ZRH(:,JJ,JK),OOCEAN)
ENDDO
ENDDO
IF (LHOOK) CALL DR_HOOK('TH_R_FROM_THL_RT_3D',1,ZHOOK_HANDLE)
END SUBROUTINE TH_R_FROM_THL_RT_3D
+END MODULE MODE_TH_R_FROM_THL_RT_3D
diff --git a/src/arome/turb/thl_rt_from_th_r_mf.F90 b/src/common/turb/mode_thl_rt_from_th_r_mf.F90
similarity index 90%
rename from src/arome/turb/thl_rt_from_th_r_mf.F90
rename to src/common/turb/mode_thl_rt_from_th_r_mf.F90
index c9488f86b61a8c1e520804f2a283ccd26e28a208..bf72ab9439b62e883471b54f7abb10ecce8c4031 100644
--- a/src/arome/turb/thl_rt_from_th_r_mf.F90
+++ b/src/common/turb/mode_thl_rt_from_th_r_mf.F90
@@ -1,4 +1,10 @@
-! ######spl
+!MNH_LIC Copyright 1994-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 MODE_THL_RT_FROM_TH_R_MF
+IMPLICIT NONE
+CONTAINS
SUBROUTINE THL_RT_FROM_TH_R_MF( KRR,KRRL,KRRI, &
PTH, PR, PEXN, &
PTHL, PRT )
@@ -114,3 +120,4 @@ ELSE
END IF
IF (LHOOK) CALL DR_HOOK('THL_RT_FRM_TH_R_MF',1,ZHOOK_HANDLE)
END SUBROUTINE THL_RT_FROM_TH_R_MF
+END MODULE MODE_THL_RT_FROM_TH_R_MF
diff --git a/src/mesonh/turb/tke_eps_sources.f90 b/src/common/turb/mode_tke_eps_sources.F90
similarity index 66%
rename from src/mesonh/turb/tke_eps_sources.f90
rename to src/common/turb/mode_tke_eps_sources.F90
index 4efe246beff2b829a835448166f9ad33bd6ea51f..cdfa0d2e45d8b701262f5b4c734a84d86c18dade 100644
--- a/src/mesonh/turb/tke_eps_sources.f90
+++ b/src/common/turb/mode_tke_eps_sources.F90
@@ -1,67 +1,18 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-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_TKE_EPS_SOURCES
-! ###########################
-INTERFACE
-!
- SUBROUTINE TKE_EPS_SOURCES(KKA,KKU,KKL,KMI,PTKEM,PLM,PLEPS,PDP,PTRH, &
- PRHODJ,PDZZ,PDXX,PDYY,PDZX,PDZY,PZZ, &
- PTSTEP,PIMPL,PEXPL, &
- HTURBLEN,HTURBDIM, &
- TPFILE,OTURB_DIAG, &
- PTP,PRTKES,PRTKESM, PRTHLS,PCOEF_DISS,PTR,PDISS )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-INTEGER, INTENT(IN) :: KMI ! model index number
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at t-deltat
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
- ! metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! physical height w-pt
-REAL, INTENT(IN) :: PTSTEP ! Time step
-REAL, INTENT(IN) :: PEXPL, PIMPL ! Coef. temporal. disc.
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-CHARACTER(len=4), INTENT(IN) :: HTURBLEN ! kind of mixing length
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
- ! diagnostic fields in the syncronous FM-file
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PDP ! Dyn. prod. of TKE
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTRH
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTP ! Ther. prod. of TKE
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRTKES ! RHOD * Jacobian *
- ! TKE at t+deltat
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTKESM ! Advection source
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRTHLS ! Source of Theta_l
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCOEF_DISS ! 1/(Cph*Exner)
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTR ! Transport prod. of TKE
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDISS ! Dissipati prod. of TKE
-!
-!
-!
-END SUBROUTINE TKE_EPS_SOURCES
-!
-END INTERFACE
-!
-END MODULE MODI_TKE_EPS_SOURCES
-!
-! ##################################################################
+MODULE MODE_TKE_EPS_SOURCES
+IMPLICIT NONE
+CONTAINS
SUBROUTINE TKE_EPS_SOURCES(KKA,KKU,KKL,KMI,PTKEM,PLM,PLEPS,PDP, &
- PTRH,PRHODJ,PDZZ,PDXX,PDYY,PDZX,PDZY,PZZ, &
- PTSTEP,PIMPL,PEXPL, &
- HTURBLEN,HTURBDIM, &
- TPFILE,OTURB_DIAG, &
- PTP,PRTKES,PRTKESM, PRTHLS,PCOEF_DISS,PTR,PDISS )
+ & PTRH,PRHODJ,PDZZ,PDXX,PDYY,PDZX,PDZY,PZZ, &
+ & PTSTEP,PIMPL,PEXPL, &
+ & HTURBLEN,HTURBDIM, &
+ & TPFILE,OTURB_DIAG, &
+ & PTP,PRTKES,PRTHLS,PCOEF_DISS,PTDIFF,PTDISS,PRTKEMS,&
+ & TBUDGETS, KBUDGETS, &
+ & PEDR, PTR,PDISS )
! ##################################################################
!
!
@@ -95,6 +46,8 @@ END MODULE MODI_TKE_EPS_SOURCES
!! MXF,MXM.MYF,MYM,MZF,MZM: Shuman functions (mean operators)
!! DZF : Shuman functions (difference operators)
!!
+!! SUBROUTINE TRIDIAG : to solve an implicit temporal scheme
+!!
!!
!! IMPLICIT ARGUMENTS
!! ------------------
@@ -113,7 +66,7 @@ END MODULE MODI_TKE_EPS_SOURCES
!!
!! Module MODD_PARAMETERS:
!!
-!! JPVEXT
+!! JPVEXT_TURB
!! Module MODD_BUDGET:
!! NBUMOD : model in which budget is calculated
!! CBUTYPE : type of desired budget
@@ -161,6 +114,8 @@ END MODULE MODI_TKE_EPS_SOURCES
!! change of YCOMMENT
!! 2012-02 Y. Seity, add possibility to run with reversed
!! vertical levels
+!! 2014-11 Y. Seity, add output terms for TKE DDHs budgets
+!! --------------------------------------------------------------------------
!! 2015-01 (J. Escobar) missing get_halo(ZRES) for JPHEXT<> 1
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
@@ -171,19 +126,22 @@ END MODULE MODI_TKE_EPS_SOURCES
!* 0. DECLARATIONS
! ------------
!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
USE MODD_ARGSLIST_ll, ONLY: LIST_ll
-use modd_budget, only: lbudget_tke, lbudget_th, NBUDGET_TKE, NBUDGET_TH, tbudgets
+USE MODD_BUDGET, ONLY: LBUDGET_TKE, LBUDGET_TH, NBUDGET_TKE, NBUDGET_TH, TBUDGETDATA
USE MODD_CONF
USE MODD_CST
USE MODD_CTURB
-USE MODD_DIAG_IN_RUN, ONLY: LDIAG_IN_RUN, XCURRENT_TKE_DISS
-use modd_field, only: tfielddata, TYPEREAL
-USE MODD_IO, ONLY: TFILEDATA
+USE MODD_DIAG_IN_RUN, ONLY : LDIAG_IN_RUN, XCURRENT_TKE_DISS
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
USE MODD_PARAMETERS
!
-use mode_budget, only: Budget_store_add, Budget_store_end, Budget_store_init
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_BUDGET, ONLY: BUDGET_STORE_ADD, BUDGET_STORE_END, BUDGET_STORE_INIT
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE
USE MODE_ll
!
USE MODI_GET_HALO
@@ -192,8 +150,9 @@ USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_LES_MEAN_SUBGRID
-USE MODI_SHUMAN
-USE MODI_TRIDIAG_TKE
+USE MODE_TRIDIAG_TKE, ONLY: TRIDIAG_TKE
+USE MODI_SHUMAN , ONLY : DZM, DZF, MZM, MZF
+!
!
IMPLICIT NONE
!
@@ -215,9 +174,9 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! physical height w-pt
REAL, INTENT(IN) :: PTSTEP ! Time step
REAL, INTENT(IN) :: PEXPL, PIMPL ! Coef. temporal. disc.
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
+CHARACTER(LEN=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
! turbulence scheme
-CHARACTER(len=4), INTENT(IN) :: HTURBLEN ! kind of mixing length
+CHARACTER(LEN=4), INTENT(IN) :: HTURBLEN ! kind of mixing length
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
! diagnostic fields in the syncronous FM-file
@@ -228,9 +187,14 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRTKES ! RHOD * Jacobian *
! TKE at t+deltat
REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRTHLS ! Source of Theta_l
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCOEF_DISS ! 1/(Cph*Exner)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTKESM ! Advection source
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTR ! Transport prod. of TKE
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDISS ! Dissipati prod. of TKE
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTDIFF ! Diffusion TKE term
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTDISS ! Dissipation TKE term
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTKEMS ! Advection source
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+REAL, DIMENSION(:,:,:), INTENT(OUT), OPTIONAL :: PTR ! Transport prod. of TKE
+REAL, DIMENSION(:,:,:), INTENT(OUT), OPTIONAL :: PDISS ! Dissipation of TKE
+REAL, DIMENSION(:,:,:), INTENT(OUT), OPTIONAL :: PEDR ! EDR
!
!
!
@@ -245,9 +209,10 @@ REAL, DIMENSION(SIZE(PTKEM,1),SIZE(PTKEM,2),SIZE(PTKEM,3)):: &
! temporarily store some diagnostics stored in FM file
ZFLX, & ! horizontal or vertical flux of the treated variable
ZSOURCE, & ! source of evolution for the treated variable
- ZKEFF ! effectif diffusion coeff = LT * SQRT( TKE )
-!LOGICAL,DIMENSION(SIZE(PTKEM,1),SIZE(PTKEM,2),SIZE(PTKEM,3)) :: GTKENEG
-! ! 3D mask .T. if TKE < XTKEMIN
+ ZKEFF, & ! effectif diffusion coeff = LT * SQRT( TKE )
+ ZTR ! Transport term
+LOGICAL,DIMENSION(SIZE(PTKEM,1),SIZE(PTKEM,2),SIZE(PTKEM,3)) :: GTKENEG
+ ! 3D mask .T. if TKE < XTKEMIN
INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE
! Index values for the Beginning and End
! mass points of the domain
@@ -256,6 +221,7 @@ INTEGER :: IIU,IJU,IKU ! array size in the 3 dimensions
TYPE(LIST_ll), POINTER :: TZFIELDDISS_ll ! list of fields to exchange
INTEGER :: IINFO_ll ! return code of parallel routine
TYPE(TFIELDDATA) :: TZFIELD
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!----------------------------------------------------------------------------
NULLIFY(TZFIELDDISS_ll)
@@ -263,17 +229,18 @@ NULLIFY(TZFIELDDISS_ll)
!* 1. PRELIMINARY COMPUTATIONS
! ------------------------
!
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+
+IF (LHOOK) CALL DR_HOOK('TKE_EPS_SOURCES',0,ZHOOK_HANDLE)
+!
IIU=SIZE(PTKEM,1)
IJU=SIZE(PTKEM,2)
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE,IIU,IJU)
IKB=KKA+JPVEXT_TURB*KKL
IKE=KKU-JPVEXT_TURB*KKL
!
! compute the effective diffusion coefficient at the mass point
ZKEFF(:,:,:) = PLM(:,:,:) * SQRT(PTKEM(:,:,:))
-
-if (lbudget_th) call Budget_store_init( tbudgets(NBUDGET_TH), 'DISSH', prthls(:, :, :) )
-
+!
!----------------------------------------------------------------------------
!
!* 2. TKE EQUATION
@@ -285,16 +252,15 @@ if (lbudget_th) call Budget_store_init( tbudgets(NBUDGET_TH), 'DISSH', prthls(
! Complete the sources of TKE with the horizontal turbulent explicit transport
!
IF (HTURBDIM=='3DIM') THEN
- PTR=PTRH
+ ZTR=PTRH
ELSE
- PTR=0.
+ ZTR=0.
END IF
!
!
!
!* 2.2 Explicit TKE sources except horizontal turbulent transport
!
-!
! extrapolate the dynamic production with a 1/Z law from its value at the
! W(IKB+1) value stored in PDP(IKB) to the mass localization tke(IKB)
PDP(:,:,IKB) = PDP(:,:,IKB) * (1. + PDZZ(:,:,IKB+KKL)/PDZZ(:,:,IKB))
@@ -302,9 +268,9 @@ PDP(:,:,IKB) = PDP(:,:,IKB) * (1. + PDZZ(:,:,IKB+KKL)/PDZZ(:,:,IKB))
! Compute the source terms for TKE: ( ADVECtion + NUMerical DIFFusion + ..)
! + (Dynamical Production) + (Thermal Production) - (dissipation)
ZFLX(:,:,:) = XCED * SQRT(PTKEM(:,:,:)) / PLEPS(:,:,:)
-ZSOURCE(:,:,:) = ( PRTKES(:,:,:) + PRTKESM(:,:,:) ) / PRHODJ(:,:,:) &
+ZSOURCE(:,:,:) = ( PRTKES(:,:,:) + PRTKEMS(:,:,:) ) / PRHODJ(:,:,:) &
- PTKEM(:,:,:) / PTSTEP &
- + PDP(:,:,:) + PTP(:,:,:) + PTR(:,:,:) - PEXPL * ZFLX(:,:,:) * PTKEM(:,:,:)
+ + PDP(:,:,:) + PTP(:,:,:) + ZTR(:,:,:) - PEXPL * ZFLX(:,:,:) * PTKEM(:,:,:)
!
!* 2.2 implicit vertical TKE transport
!
@@ -313,7 +279,7 @@ ZSOURCE(:,:,:) = ( PRTKES(:,:,:) + PRTKESM(:,:,:) ) / PRHODJ(:,:,:) &
! matrix inverted in TRIDIAG
!
ZA(:,:,:) = - PTSTEP * XCET * &
- MZM(ZKEFF) * MZM(PRHODJ) / PDZZ**2
+ MZM(ZKEFF, KKA, KKU, KKL) * MZM(PRHODJ, KKA, KKU, KKL) / PDZZ**2
!
! Compute TKE at time t+deltat: ( stored in ZRES )
!
@@ -332,67 +298,71 @@ IF (LDIAG_IN_RUN) THEN
ENDIF
!
! TKE must be greater than its minimum value
-!
-! CL : Now done at the end of the time step in ADVECTION_METSV
-!GTKENEG = ZRES <= XTKEMIN
-!WHERE ( GTKENEG )
-! ZRES = XTKEMIN
-!END WHERE
+! CL : Now done at the end of the time step in ADVECTION_METSV for MesoNH
+IF(CPROGRAM/='MESONH') THEN
+ GTKENEG = ZRES <= XTKEMIN
+ WHERE ( GTKENEG )
+ ZRES = XTKEMIN
+ END WHERE
+END IF
+PTDISS(:,:,:) = - ZFLX(:,:,:)*(PEXPL*PTKEM(:,:,:) + PIMPL*ZRES(:,:,:))
!
IF ( LLES_CALL .OR. &
- (OTURB_DIAG .AND. tpfile%lopened) ) THEN
+ (OTURB_DIAG .AND. TPFILE%LOPENED) ) THEN
!
! Compute the cartesian vertical flux of TKE in ZFLX
!
- ZFLX(:,:,:) = - XCET * MZM(ZKEFF) * &
- DZM(PIMPL * ZRES + PEXPL * PTKEM ) / PDZZ
+ ZFLX(:,:,:) = - XCET * MZM(ZKEFF, KKA, KKU, KKL) * &
+ DZM(PIMPL * ZRES + PEXPL * PTKEM, KKA, KKU, KKL) / PDZZ
!
ZFLX(:,:,IKB) = 0.
ZFLX(:,:,KKA) = 0.
!
! Compute the whole turbulent TRansport of TKE:
!
- PTR(:,:,:)= PTR - DZF( MZM(PRHODJ) * ZFLX / PDZZ ) /PRHODJ
+ ZTR(:,:,:)= ZTR - DZF(MZM(PRHODJ, KKA, KKU, KKL) * ZFLX / PDZZ, KKA, KKU, KKL) /PRHODJ
!
! Storage in the LES configuration
!
IF (LLES_CALL) THEN
- CALL LES_MEAN_SUBGRID( MZF(ZFLX), X_LES_SUBGRID_WTke )
- CALL LES_MEAN_SUBGRID( -PTR, X_LES_SUBGRID_ddz_WTke )
+ CALL LES_MEAN_SUBGRID(MZF(ZFLX, KKA, KKU, KKL), X_LES_SUBGRID_WTke )
+ CALL LES_MEAN_SUBGRID(-ZTR, X_LES_SUBGRID_ddz_WTke )
END IF
!
END IF
!
!* 2.4 stores the explicit sources for budget purposes
!
-if (lbudget_tke) then
+IF (LBUDGET_TKE) THEN
! Dynamical production
- call Budget_store_add( tbudgets(NBUDGET_TKE), 'DP', pdp(:, :, :) * prhodj(:, :, :) )
+ CALL BUDGET_STORE_ADD( TBUDGETS(NBUDGET_TKE), 'DP', PDP(:, :, :) * PRHODJ(:, :, :) )
! Thermal production
- call Budget_store_add( tbudgets(NBUDGET_TKE), 'TP', ptp(:, :, :) * prhodj(:, :, :) )
+ CALL BUDGET_STORE_ADD( TBUDGETS(NBUDGET_TKE), 'TP', PTP(:, :, :) * PRHODJ(:, :, :) )
! Dissipation
- call Budget_store_add( tbudgets(NBUDGET_TKE), 'DISS', -xced * sqrt( ptkem(:, :, :) ) / pleps(:, :, :) &
- * ( pexpl * ptkem(:, :, :) + pimpl * zres(:, :, :) ) * prhodj(:, :, :) )
-end if
+ CALL BUDGET_STORE_ADD( TBUDGETS(NBUDGET_TKE), 'DISS',- XCED * SQRT(PTKEM(:,:,:)) / PLEPS(:,:,:) * &
+ (PEXPL*PTKEM(:,:,:) + PIMPL*ZRES(:,:,:)) * PRHODJ(:,:,:))
+END IF
!
!* 2.5 computes the final RTKE and stores the whole turbulent transport
-! with the removal of the advection part
-
-if (lbudget_tke) then
- !Store the previous source terms in prtkes before initializing the next one
- PRTKES(:,:,:) = PRTKES(:,:,:) + PRHODJ(:,:,:) * &
- ( PDP(:,:,:) + PTP(:,:,:) &
- - XCED * SQRT(PTKEM(:,:,:)) / PLEPS(:,:,:) * ( PEXPL*PTKEM(:,:,:) + PIMPL*ZRES(:,:,:) ) )
+! with the removal of the advection part for MesoNH
- call Budget_store_init( tbudgets(NBUDGET_TKE), 'TR', prtkes(:, :, :) )
-end if
+!Store the previous source terms in prtkes before initializing the next one
+!Should be in IF LBUDGET_TKE only. Was removed out for a correct comput. of PTDIFF in case of LBUDGET_TKE=F in AROME
+PRTKES(:,:,:) = PRTKES(:,:,:) + PRHODJ(:,:,:) * &
+ ( PDP(:,:,:) + PTP(:,:,:) &
+ - XCED * SQRT(PTKEM(:,:,:)) / PLEPS(:,:,:) * ( PEXPL*PTKEM(:,:,:) + PIMPL*ZRES(:,:,:) ) )
+!
+PTDIFF(:,:,:) = ZRES(:,:,:) / PTSTEP - PRTKES(:,:,:)/PRHODJ(:,:,:) &
+ & - PDP(:,:,:)- PTP(:,:,:) - PTDISS(:,:,:)
-PRTKES(:,:,:) = ZRES(:,:,:) * PRHODJ(:,:,:) / PTSTEP - PRTKESM(:,:,:)
+IF (LBUDGET_TKE) CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_TKE), 'TR', PRTKES(:, :, :) )
+!
+PRTKES(:,:,:) = ZRES(:,:,:) * PRHODJ(:,:,:) / PTSTEP - PRTKEMS(:,:,:)
!
! stores the whole turbulent transport
!
-if (lbudget_tke) call Budget_store_end( tbudgets(NBUDGET_TKE), 'TR', prtkes(:, :, :) )
+IF (LBUDGET_TKE) CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_TKE), 'TR', PRTKES(:, :, :) )
!----------------------------------------------------------------------------
!
@@ -401,17 +371,16 @@ if (lbudget_tke) call Budget_store_end( tbudgets(NBUDGET_TKE), 'TR', prtkes(:, :
!
PRTHLS(:,:,:) = PRTHLS(:,:,:) + XCED * SQRT(PTKEM(:,:,:)) / PLEPS(:,:,:) * &
(PEXPL*PTKEM(:,:,:) + PIMPL*ZRES(:,:,:)) * PRHODJ(:,:,:) * PCOEF_DISS(:,:,:)
-
-if (lbudget_th) call Budget_store_end( tbudgets(NBUDGET_TH), 'DISSH', prthls(:, :, :) )
-
!----------------------------------------------------------------------------
!
!* 4. STORES SOME DIAGNOSTICS
! -----------------------
!
-PDISS(:,:,:) = -XCED * (PTKEM(:,:,:)**1.5) / PLEPS(:,:,:)
+IF(PRESENT(PDISS)) PDISS(:,:,:) = -XCED * (PTKEM(:,:,:)**1.5) / PLEPS(:,:,:)
+IF(PRESENT(PTR)) PTR=ZTR
+IF(PRESENT(PEDR)) PEDR = XCED * (PTKEM(:,:,:)**1.5) / PLEPS(:,:,:)
!
-IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
+IF ( OTURB_DIAG .AND. TPFILE%LOPENED ) THEN
!
! stores the dynamic production
!
@@ -425,7 +394,7 @@ IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PDP)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,PDP)
!
! stores the thermal production
!
@@ -439,7 +408,7 @@ IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PTP)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,PTP)
!
! stores the whole turbulent transport
!
@@ -453,7 +422,7 @@ IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PTR)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZTR)
!
! stores the dissipation of TKE
!
@@ -467,7 +436,7 @@ IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PDISS)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,PDISS)
END IF
!
! Storage in the LES configuration of the Dynamic Production of TKE and
@@ -482,4 +451,6 @@ END IF
!
!----------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('TKE_EPS_SOURCES',1,ZHOOK_HANDLE)
END SUBROUTINE TKE_EPS_SOURCES
+END MODULE MODE_TKE_EPS_SOURCES
diff --git a/src/common/turb/tm06.F90 b/src/common/turb/mode_tm06.F90
similarity index 96%
rename from src/common/turb/tm06.F90
rename to src/common/turb/mode_tm06.F90
index 22bf99d25a03c27acd88ce1a3d9d0d649b6bcac8..903ea792e01c5f456289a0c283f6e24c76400a41 100644
--- a/src/common/turb/tm06.F90
+++ b/src/common/turb/mode_tm06.F90
@@ -2,8 +2,10 @@
!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 TM06(KKA,KKU,KKL,PTHVREF,PBL_DEPTH,PZZ,PSFTH,PMWTH,PMTH2)
+MODULE MODE_TM06
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE TM06(KKA,KKU,KKL,PTHVREF,PBL_DEPTH,PZZ,PSFTH,PMWTH,PMTH2)
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! #################################################################
@@ -136,3 +138,4 @@ PMWTH(:,:,KKU) = PMWTH(:,:,KKU) * ZWSTAR(:,:)**2*ZTSTAR(:,:)
!----------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('TM06',1,ZHOOK_HANDLE)
END SUBROUTINE TM06
+END MODULE MODE_TM06
diff --git a/src/common/turb/tm06_h.F90 b/src/common/turb/mode_tm06_h.F90
similarity index 96%
rename from src/common/turb/tm06_h.F90
rename to src/common/turb/mode_tm06_h.F90
index 3162f5149e9d44cfe2d0e8868995881c044f1210..7d32fdd62d070d1f0d9cc796b315490f32c8d4cd 100644
--- a/src/common/turb/tm06_h.F90
+++ b/src/common/turb/mode_tm06_h.F90
@@ -2,8 +2,10 @@
!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 TM06_H(KKB,KKTB,KKTE,PTSTEP,PZZ,PFLXZ,PBL_DEPTH)
+MODULE MODE_TM06_H
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE TM06_H(KKB,KKTB,KKTE,PTSTEP,PZZ,PFLXZ,PBL_DEPTH)
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! #################################################################
@@ -96,3 +98,4 @@ WHERE(PBL_DEPTH(:,:)/=XUNDEF) PBL_DEPTH(:,:)=MIN(PBL_DEPTH(:,:),ZBL_DEPTH(:,:)+Z
!----------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('TM06_H',1,ZHOOK_HANDLE)
END SUBROUTINE TM06_H
+END MODULE MODE_TM06_H
diff --git a/src/common/turb/tridiag.F90 b/src/common/turb/mode_tridiag.F90
similarity index 98%
rename from src/common/turb/tridiag.F90
rename to src/common/turb/mode_tridiag.F90
index ee28bf7bb4be4dc87ca84be8d09bc696ca498496..82b2ec2b08172cb21bf53a27f11c9b12e1be6abe 100644
--- a/src/common/turb/tridiag.F90
+++ b/src/common/turb/mode_tridiag.F90
@@ -2,8 +2,10 @@
!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 TRIDIAG(KKA,KKU,KKL,PVARM,PA,PTSTEP,PEXPL,PIMPL, &
+MODULE MODE_TRIDIAG
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE TRIDIAG(KKA,KKU,KKL,PVARM,PA,PTSTEP,PEXPL,PIMPL, &
PRHODJ,PSOURCE,PVARP )
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
@@ -230,3 +232,4 @@ PVARP(:,:,KKU)=PVARP(:,:,IKE)
!
IF (LHOOK) CALL DR_HOOK('TRIDIAG',1,ZHOOK_HANDLE)
END SUBROUTINE TRIDIAG
+END MODULE MODE_TRIDIAG
diff --git a/src/common/turb/tridiag_massflux.F90 b/src/common/turb/mode_tridiag_massflux.F90
similarity index 98%
rename from src/common/turb/tridiag_massflux.F90
rename to src/common/turb/mode_tridiag_massflux.F90
index 401018cc0fed6cac3161e06224461d7c1ea8ea99..915d75b936fd4131452da4cf5c7e41a9922390f5 100644
--- a/src/common/turb/tridiag_massflux.F90
+++ b/src/common/turb/mode_tridiag_massflux.F90
@@ -2,8 +2,10 @@
!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 TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PVARM,PF,PDFDT,PTSTEP,PIMPL, &
+MODULE MODE_TRIDIAG_MASSFLUX
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PVARM,PF,PDFDT,PTSTEP,PIMPL, &
PDZZ,PRHODJ,PVARP )
USE PARKIND1, ONLY : JPRB
@@ -275,3 +277,4 @@ PVARP(:,KKU)=PVARP(:,KKE)
!
IF (LHOOK) CALL DR_HOOK('TRIDIAG_MASSFLUX',1,ZHOOK_HANDLE)
END SUBROUTINE TRIDIAG_MASSFLUX
+END MODULE MODE_TRIDIAG_MASSFLUX
diff --git a/src/common/turb/tridiag_thermo.F90 b/src/common/turb/mode_tridiag_thermo.F90
similarity index 98%
rename from src/common/turb/tridiag_thermo.F90
rename to src/common/turb/mode_tridiag_thermo.F90
index 7d20b2fa1e633d84dafcb24479c3c46a808d575a..5488c69f08941147fe0cafded7870f16aac0e796 100644
--- a/src/common/turb/tridiag_thermo.F90
+++ b/src/common/turb/mode_tridiag_thermo.F90
@@ -2,8 +2,10 @@
!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 TRIDIAG_THERMO(KKA,KKU,KKL,PVARM,PF,PDFDDTDZ,PTSTEP,PIMPL, &
+MODULE MODE_TRIDIAG_THERMO
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE TRIDIAG_THERMO(KKA,KKU,KKL,PVARM,PF,PDFDDTDZ,PTSTEP,PIMPL, &
PDZZ,PRHODJ,PVARP )
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
@@ -269,3 +271,4 @@ PVARP(:,:,KKU)=PVARP(:,:,IKE)
!
IF (LHOOK) CALL DR_HOOK('TRIDIAG_THERMO',1,ZHOOK_HANDLE)
END SUBROUTINE TRIDIAG_THERMO
+END MODULE MODE_TRIDIAG_THERMO
diff --git a/src/common/turb/tridiag_tke.F90 b/src/common/turb/mode_tridiag_tke.F90
similarity index 98%
rename from src/common/turb/tridiag_tke.F90
rename to src/common/turb/mode_tridiag_tke.F90
index aaba12157838120e2c95cc5fbb845e53f9185e55..52ec08bdfbcec157530255aa9593f16e2ee02383 100644
--- a/src/common/turb/tridiag_tke.F90
+++ b/src/common/turb/mode_tridiag_tke.F90
@@ -2,8 +2,10 @@
!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 TRIDIAG_TKE(KKA,KKU,KKL,PVARM,PA,PTSTEP,PEXPL,PIMPL, &
+MODULE MODE_TRIDIAG_TKE
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE TRIDIAG_TKE(KKA,KKU,KKL,PVARM,PA,PTSTEP,PEXPL,PIMPL, &
PRHODJ,PSOURCE,PDIAG,PVARP )
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
@@ -233,3 +235,4 @@ PVARP(:,:,KKU)=PVARP(:,:,IKE)
!
IF (LHOOK) CALL DR_HOOK('TRIDIAG_TKE',1,ZHOOK_HANDLE)
END SUBROUTINE TRIDIAG_TKE
+END MODULE MODE_TRIDIAG_TKE
diff --git a/src/common/turb/tridiag_wind.F90 b/src/common/turb/mode_tridiag_wind.F90
similarity index 98%
rename from src/common/turb/tridiag_wind.F90
rename to src/common/turb/mode_tridiag_wind.F90
index 1f074af2b701023336eadeec436711fecb45f791..65fd7256e14f7cf242917b450ff723d4d9e942d9 100644
--- a/src/common/turb/tridiag_wind.F90
+++ b/src/common/turb/mode_tridiag_wind.F90
@@ -2,8 +2,10 @@
!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 TRIDIAG_WIND(KKA,KKU,KKL,PVARM,PA,PCOEFS,PTSTEP,PEXPL,PIMPL, &
+MODULE MODE_TRIDIAG_WIND
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE TRIDIAG_WIND(KKA,KKU,KKL,PVARM,PA,PCOEFS,PTSTEP,PEXPL,PIMPL, &
PRHODJA,PSOURCE,PVARP )
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
@@ -234,3 +236,4 @@ PVARP(:,:,KKU)=PVARP(:,:,IKE)
!
IF (LHOOK) CALL DR_HOOK('TRIDIAG_WIND',1,ZHOOK_HANDLE)
END SUBROUTINE TRIDIAG_WIND
+END MODULE MODE_TRIDIAG_WIND
diff --git a/src/mesonh/turb/turb_hor.f90 b/src/common/turb/mode_turb_hor.F90
similarity index 72%
rename from src/mesonh/turb/turb_hor.f90
rename to src/common/turb/mode_turb_hor.F90
index 8c872dcee439fe7faea9f96ce4f171a76ea4ff8a..76973ab7a2621f81e5f8adaa901ebd3aa28deaf5 100644
--- a/src/mesonh/turb/turb_hor.f90
+++ b/src/common/turb/mode_turb_hor.F90
@@ -2,114 +2,11 @@
!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_TURB_HOR
-! ####################
-!
-INTERFACE
-!
- SUBROUTINE TURB_HOR(KSPLT, KRR, KRRL, KRRI, PTSTEP, &
- OTURB_FLX,OSUBG_COND, &
- TPFILE, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
- PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
- PCOSSLOPE,PSINSLOPE, &
- PINV_PDXX, PINV_PDYY, PINV_PDZZ, PMZM_PRHODJ, &
- PK, &
- PRHODJ,PTHVREF, &
- PSFTHM,PSFRM,PSFSVM, &
- PCDUEFF,PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
- PUM,PVM,PWM,PUSLOPEM,PVSLOPEM,PTHLM,PRM,PSVM, &
- PTKEM,PLM,PLEPS, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
- PDP,PTP,PSIGS, &
- PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS )
-
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KSPLT ! current split index
-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.
-REAL, INTENT(IN) :: PTSTEP !
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
-! condensation
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! vertical grid
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW, PDIRCOSZW
-! Director Cosinus along x, y and z directions at surface w-point
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
- ! between i and the slope vector
-REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
- ! between i and the slope vector
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state VPT
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! surface fluxes
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU11M ! <uu> in the axes linked
- ! to the maximum slope direction and the surface normal and the binormal
- ! at time t - dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU12M ! <uv> in the same axes
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU22M ! <vv> in the same axes
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
-!
-! Variables at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHLM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! mixing ratios at t-1,
- ! where PRM(:,:,:,1) = conservative mixing ratio
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-1
-REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
- ! maximum slope direction
-REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
- ! direction normal to the maximum slope one
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
- ! PK = PLM * SQRT(PTKEM)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t- dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM
- ! normalized 2nd-order flux
- ! s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFRAC_ICE ! ri fraction of rc+ri
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS, PRTHLS
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS,PRRS ! var. at t+1 -split-
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP,PTP ! TKE production terms
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
- ! IN: Vertical part of Sigma_s at t
- ! OUT: Total Sigma_s at t
-!
-!
-!
-END SUBROUTINE TURB_HOR
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_HOR
-! ################################################################
- SUBROUTINE TURB_HOR(KSPLT, KRR, KRRL, KRRI, PTSTEP, &
- OTURB_FLX,OSUBG_COND, &
+MODULE MODE_TURB_HOR
+IMPLICIT NONE
+CONTAINS
+ SUBROUTINE TURB_HOR(KSPLT, KRR, KRRL, KRRI, PTSTEP, &
+ OTURB_FLX,OSUBG_COND,OOCEAN, &
TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
@@ -245,14 +142,14 @@ USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_LES
!
-USE MODI_TURB_HOR_THERMO_FLUX
-USE MODI_TURB_HOR_THERMO_CORR
-USE MODI_TURB_HOR_DYN_CORR
-USE MODI_TURB_HOR_UV
-USE MODI_TURB_HOR_UW
-USE MODI_TURB_HOR_VW
-USE MODI_TURB_HOR_SV_FLUX
-USE MODI_TURB_HOR_SV_CORR
+USE MODE_TURB_HOR_THERMO_FLUX, ONLY: TURB_HOR_THERMO_FLUX
+USE MODE_TURB_HOR_THERMO_CORR, ONLY: TURB_HOR_THERMO_CORR
+USE MODE_TURB_HOR_DYN_CORR, ONLY: TURB_HOR_DYN_CORR
+USE MODE_TURB_HOR_UV, ONLY: TURB_HOR_UV
+USE MODE_TURB_HOR_UW, ONLY: TURB_HOR_UW
+USE MODE_TURB_HOR_VW, ONLY: TURB_HOR_VW
+USE MODE_TURB_HOR_SV_FLUX, ONLY: TURB_HOR_SV_FLUX
+USE MODE_TURB_HOR_SV_CORR, ONLY: TURB_HOR_SV_CORR
!
IMPLICIT NONE
!
@@ -269,6 +166,7 @@ LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
! condensation
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for ocean version
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
@@ -368,7 +266,7 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
!
IF (KSPLT==1) &
CALL TURB_HOR_THERMO_CORR(KRR, KRRL, KRRI, &
- OTURB_FLX,OSUBG_COND, &
+ OTURB_FLX,OSUBG_COND,OOCEAN, &
TPFILE, &
PINV_PDXX,PINV_PDYY, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
@@ -458,7 +356,7 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
PRSVS )
!
IF (KSPLT==1 .AND. LLES_CALL) &
- CALL TURB_HOR_SV_CORR(KRR,KRRL,KRRI, &
+ CALL TURB_HOR_SV_CORR(KRR,KRRL,KRRI,OOCEAN, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
PLM,PLEPS,PTKEM,PTHVREF, &
PTHLM,PRM, &
@@ -467,3 +365,4 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
!
!
END SUBROUTINE TURB_HOR
+END MODULE MODE_TURB_HOR
diff --git a/src/mesonh/turb/turb_hor_dyn_corr.f90 b/src/common/turb/mode_turb_hor_dyn_corr.F90
similarity index 83%
rename from src/mesonh/turb/turb_hor_dyn_corr.f90
rename to src/common/turb/mode_turb_hor_dyn_corr.F90
index 2a4a3e98d7fa391aa25e8b6c048680eca238bb63..f652951dceaa4210f222fa08c0c99b2e925c72d7 100644
--- a/src/mesonh/turb/turb_hor_dyn_corr.f90
+++ b/src/common/turb/mode_turb_hor_dyn_corr.F90
@@ -3,79 +3,9 @@
!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_TURB_HOR_DYN_CORR
-!
-INTERFACE
-!
- SUBROUTINE TURB_HOR_DYN_CORR(KSPLT, PTSTEP, &
- OTURB_FLX,KRR, &
- TPFILE, &
- PK,PINV_PDZZ, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
- PDIRCOSZW, &
- PCOSSLOPE,PSINSLOPE, &
- PRHODJ, &
- PCDUEFF,PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
- PUM,PVM,PWM,PUSLOPEM,PVSLOPEM, &
- PTHLM,PRM,PSVM, &
- PTKEM,PLM, &
- PDP,PTP, &
- PRUS,PRVS,PRWS )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KSPLT ! split process index
-REAL, INTENT(IN) :: PTSTEP ! timestep
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
- ! PK = PLM * SQRT(PTKEM)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! vertical grid
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW
-! Director Cosinus along z directions at surface w-point
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
- ! between i and the slope vector
-REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
- ! between i and the slope vector
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU11M ! <uu> in the axes linked
- ! to the maximum slope direction and the surface normal and the binormal
- ! at time t - dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU12M ! <uv> in the same axes
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU22M ! <vv> in the same axes
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
-!
-! Variables at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHLM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
-REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
- ! maximum slope direction
-REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
- ! direction normal to the maximum slope one
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t- dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP,PTP ! TKE production terms
-!
-!
-!
-END SUBROUTINE TURB_HOR_DYN_CORR
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_HOR_DYN_CORR
-! ################################################################
+MODULE MODE_TURB_HOR_DYN_CORR
+IMPLICIT NONE
+CONTAINS
SUBROUTINE TURB_HOR_DYN_CORR(KSPLT, PTSTEP, &
OTURB_FLX,KRR, &
TPFILE, &
@@ -144,21 +74,21 @@ USE MODD_ARGSLIST_ll, ONLY: LIST_ll
USE MODD_CST
USE MODD_CONF
USE MODD_CTURB
-use modd_field, only: tfielddata, TYPEREAL
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_LES
USE MODD_NSV
!
USE MODE_ll
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE
!
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_SHUMAN
-USE MODI_COEFJ
+USE MODE_COEFJ, ONLY: COEFJ
USE MODI_LES_MEAN_SUBGRID
USE MODI_TRIDIAG_W
!
@@ -369,7 +299,7 @@ ZFLX(:,:,IKB-1) = &
ZFLX(:,:,IKB-1) = 2. * ZFLX(:,:,IKB-1) - ZFLX(:,:,IKB)
!
CALL UPDATE_HALO_ll(TZFIELDS_ll, IINFO_ll)
-IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+IF ( TPFILE%LOPENED .AND. OTURB_FLX ) THEN
! stores <U U>
TZFIELD%CMNHNAME = 'U_VAR'
TZFIELD%CSTDNAME = ''
@@ -381,7 +311,7 @@ IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLX)
END IF
!
! Complete the U tendency
@@ -464,7 +394,7 @@ ZFLX(:,:,IKB-1) = 2. * ZFLX(:,:,IKB-1) - ZFLX(:,:,IKB)
!
CALL UPDATE_HALO_ll(TZFIELDS_ll, IINFO_ll)
!
-IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+IF ( TPFILE%LOPENED .AND. OTURB_FLX ) THEN
! stores <V V>
TZFIELD%CMNHNAME = 'V_VAR'
TZFIELD%CSTDNAME = ''
@@ -476,7 +406,7 @@ IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLX)
END IF
!
! Complete the V tendency
@@ -551,7 +481,7 @@ ZFLX(:,:,IKB-1) = &
!
ZFLX(:,:,IKB-1) = 2. * ZFLX(:,:,IKB-1) - ZFLX(:,:,IKB)
!
-IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+IF ( TPFILE%LOPENED .AND. OTURB_FLX ) THEN
! stores <W W>
TZFIELD%CMNHNAME = 'W_VAR'
TZFIELD%CSTDNAME = ''
@@ -563,7 +493,7 @@ IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLX)
END IF
!
! Complete the W tendency
@@ -623,3 +553,4 @@ CALL CLEANLIST_ll(TZFIELDS_ll)
!
!
END SUBROUTINE TURB_HOR_DYN_CORR
+END MODULE MODE_TURB_HOR_DYN_CORR
diff --git a/src/mesonh/turb/turb_hor_splt.f90 b/src/common/turb/mode_turb_hor_splt.F90
similarity index 78%
rename from src/mesonh/turb/turb_hor_splt.f90
rename to src/common/turb/mode_turb_hor_splt.F90
index 2de0ca9a8cdea58c8f98279e1ddcbc7d2038070a..ffdf167115a076217f87fa4455ee8f0cf45a4c30 100644
--- a/src/mesonh/turb/turb_hor_splt.f90
+++ b/src/common/turb/mode_turb_hor_splt.F90
@@ -2,109 +2,11 @@
!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_TURB_HOR_SPLT
-! #########################
-!
-INTERFACE
-!
- SUBROUTINE TURB_HOR_SPLT(KSPLIT, KRR, KRRL, KRRI, PTSTEP, &
- HLBCX,HLBCY,OTURB_FLX,OSUBG_COND, &
- TPFILE, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
- PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
- PCOSSLOPE,PSINSLOPE, &
- PRHODJ,PTHVREF, &
- PSFTHM,PSFRM,PSFSVM, &
- PCDUEFF,PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
- PUM,PVM,PWM,PUSLOPEM,PVSLOPEM,PTHLM,PRM,PSVM, &
- PTKEM,PLM,PLEPS, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
- PDP,PTP,PSIGS, &
- PTRH, &
- PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS )
-
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KSPLIT ! number of time splitting
-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.
-REAL, INTENT(IN) :: PTSTEP ! timestep
-CHARACTER (LEN=*), DIMENSION(:), INTENT(IN) :: HLBCX,HLBCY
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
-! condensation
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! vertical grid
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW, PDIRCOSZW
-! Director Cosinus along x, y and z directions at surface w-point
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
- ! between i and the slope vector
-REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
- ! between i and the slope vector
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state VPT
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! surface fluxes
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU11M ! <uu> in the axes linked
- ! to the maximum slope direction and the surface normal and the binormal
- ! at time t - dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU12M ! <uv> in the same axes
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU22M ! <vv> in the same axes
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
-!
-! Variables at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHLM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! mixing ratios at t-1,
- ! where PRM(:,:,:,1) = conservative mixing ratio
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-1
-REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
- ! maximum slope direction
-REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
- ! direction normal to the maximum slope one
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t- dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM
- ! normalized 2nd-order flux
- ! s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFRAC_ICE ! ri fraction of rc+ri
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS, PRTHLS
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS,PRRS ! var. at t+1 -split-
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP,PTP ! TKE production terms
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTRH
-
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
- ! IN: Vertical part of Sigma_s at t
- ! OUT: Total Sigma_s at t
-!
-!
-!
-END SUBROUTINE TURB_HOR_SPLT
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_HOR_SPLT
-! ################################################################
- SUBROUTINE TURB_HOR_SPLT(KSPLIT, KRR, KRRL, KRRI, PTSTEP, &
- HLBCX,HLBCY,OTURB_FLX,OSUBG_COND, &
+MODULE MODE_TURB_HOR_SPLT
+IMPLICIT NONE
+CONTAINS
+ SUBROUTINE TURB_HOR_SPLT(KSPLIT, KRR, KRRL, KRRI, PTSTEP, &
+ HLBCX,HLBCY,OTURB_FLX,OSUBG_COND,OOCEAN, &
TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
@@ -261,8 +163,8 @@ USE MODD_PARAMETERS
!
!
USE MODI_SHUMAN
-USE MODI_TURB_HOR
-USE MODI_TURB_HOR_TKE
+USE MODE_TURB_HOR
+USE MODE_TURB_HOR_TKE
!
USE MODE_ll
!
@@ -281,6 +183,7 @@ CHARACTER (LEN=*), DIMENSION(:), INTENT(IN) :: HLBCX,HLBCY
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
! condensation
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
@@ -454,7 +357,7 @@ IF (KSPLIT>1 .AND. CPROGRAM=='MESONH') THEN
!
! compute the turbulent tendencies for the small time step
CALL TURB_HOR(JSPLT, KRR, KRRL, KRRI, PTSTEP, &
- OTURB_FLX,OSUBG_COND, &
+ OTURB_FLX,OSUBG_COND,OOCEAN, &
TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
@@ -595,7 +498,7 @@ IF (KSPLIT>1 .AND. CPROGRAM=='MESONH') THEN
ELSE
!
CALL TURB_HOR(1, KRR, KRRL, KRRI, PTSTEP, &
- OTURB_FLX,OSUBG_COND, &
+ OTURB_FLX,OSUBG_COND,OOCEAN, &
TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
@@ -630,3 +533,4 @@ DEALLOCATE(ZINV_PDZZ)
DEALLOCATE(ZMZM_PRHODJ)
!
END SUBROUTINE TURB_HOR_SPLT
+END MODULE MODE_TURB_HOR_SPLT
diff --git a/src/mesonh/turb/turb_hor_sv_corr.f90 b/src/common/turb/mode_turb_hor_sv_corr.F90
similarity index 73%
rename from src/mesonh/turb/turb_hor_sv_corr.f90
rename to src/common/turb/mode_turb_hor_sv_corr.F90
index f9e2c7b5557ff6c0f31e75efcf9a3aa3347b3406..9f559aa8e3c5e4e6fe9b98db9a12c61a104c7def 100644
--- a/src/mesonh/turb/turb_hor_sv_corr.f90
+++ b/src/common/turb/mode_turb_hor_sv_corr.F90
@@ -2,47 +2,10 @@
!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_TURB_HOR_SV_CORR
-! ############################
-!
-INTERFACE
-!
- SUBROUTINE TURB_HOR_SV_CORR(KRR,KRRL,KRRI, &
- PDXX,PDYY,PDZZ,PDZX,PDZY, &
- PLM,PLEPS,PTKEM,PTHVREF, &
- PTHLM,PRM, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM, &
- PWM,PSVM )
-!
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-INTEGER, INTENT(IN) :: KRRL ! number of liquid var.
-INTEGER, INTENT(IN) :: KRRI ! number of ice var.
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! tke
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! reference Thv
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM ! potential temperature at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios at t-Delta t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
- ! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM ! w at t-1
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-1
-!
-!
-END SUBROUTINE TURB_HOR_SV_CORR
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_HOR_SV_CORR
-! ################################################################
- SUBROUTINE TURB_HOR_SV_CORR(KRR,KRRL,KRRI, &
+MODULE MODE_TURB_HOR_SV_CORR
+IMPLICIT NONE
+CONTAINS
+ SUBROUTINE TURB_HOR_SV_CORR(KRR,KRRL,KRRI,OOCEAN, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
PLM,PLEPS,PTKEM,PTHVREF, &
PTHLM,PRM, &
@@ -98,8 +61,8 @@ USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_SHUMAN
USE MODI_LES_MEAN_SUBGRID
-USE MODI_EMOIST
-USE MODI_ETHETA
+USE MODE_EMOIST, ONLY: EMOIST
+USE MODE_ETHETA, ONLY: ETHETA
!
USE MODI_SECOND_MNH
!
@@ -113,6 +76,7 @@ IMPLICIT NONE
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid var.
INTEGER, INTENT(IN) :: KRRI ! number of ice var.
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
! Metric coefficients
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! mixing length
@@ -137,6 +101,7 @@ REAL, DIMENSION(SIZE(PSVM,1),SIZE(PSVM,2),SIZE(PSVM,3)) &
:: ZFLX, ZA
!
INTEGER :: JSV ! loop counter
+INTEGER :: IKU
!
REAL :: ZTIME1, ZTIME2
!
@@ -147,6 +112,7 @@ REAL :: ZCQSVD = 2.4 ! constant for humidity - scalar covariance dissipation
REAL :: ZCSV !constant for the scalar flux
! ---------------------------------------------------------------------------
!
+IKU=SIZE(PTKEM,3)
CALL SECOND_MNH(ZTIME1)
!
IF(LBLOWSNOW) THEN
@@ -179,7 +145,7 @@ DO JSV=1,NSV
! covariance SvThv
!
IF (LLES_CALL) THEN
- ZA(:,:,:) = ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM)
+ ZA(:,:,:) = ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM,OOCEAN)
IF (.NOT. L2D) THEN
ZFLX(:,:,:)= PLM(:,:,:) * PLEPS(:,:,:) &
* ( GX_M_M(PTHLM,PDXX,PDZZ,PDZX) * GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX) &
@@ -194,7 +160,7 @@ DO JSV=1,NSV
CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLX, X_LES_SUBGRID_SvPz(:,:,:,JSV), .TRUE. )
!
IF (KRR>=1) THEN
- ZA(:,:,:) = EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM)
+ ZA(:,:,:) = EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM,OOCEAN)
IF (.NOT. L2D) THEN
ZFLX(:,:,:)= PLM(:,:,:) * PLEPS(:,:,:) &
* ( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) * GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX) &
@@ -216,3 +182,5 @@ CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
!
END SUBROUTINE TURB_HOR_SV_CORR
+END MODULE MODE_TURB_HOR_SV_CORR
+
diff --git a/src/mesonh/turb/turb_hor_sv_flux.f90 b/src/common/turb/mode_turb_hor_sv_flux.F90
similarity index 80%
rename from src/mesonh/turb/turb_hor_sv_flux.f90
rename to src/common/turb/mode_turb_hor_sv_flux.F90
index 163ee3d0203f1e9cad04a62d18573d07707c4c20..f61a531d910f2c0fb1f97b249a8665a53fa1ca08 100644
--- a/src/mesonh/turb/turb_hor_sv_flux.f90
+++ b/src/common/turb/mode_turb_hor_sv_flux.F90
@@ -3,59 +3,9 @@
!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_TURB_HOR_SV_FLUX
-! ############################
-!
-INTERFACE
-!
- SUBROUTINE TURB_HOR_SV_FLUX(KSPLT, &
- OTURB_FLX, &
- TPFILE, &
- PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
- PDXX,PDYY,PDZZ,PDZX,PDZY, &
- PDIRCOSXW,PDIRCOSYW, &
- PRHODJ,PWM, &
- PSFSVM, &
- PSVM, &
- PRSVS )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KSPLT ! split process index
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
- ! PK = PLM * SQRT(PTKEM)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW
-! Director Cosinus along x and y directions at surface w-point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM ! vertical wind
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! surface fluxes
-!
-!
-! Variables at t-1
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-1
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! var. at t+1 -split-
-!
-!
-!
-END SUBROUTINE TURB_HOR_SV_FLUX
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_HOR_SV_FLUX
-! ################################################################
+MODULE MODE_TURB_HOR_SV_FLUX
+IMPLICIT NONE
+CONTAINS
SUBROUTINE TURB_HOR_SV_FLUX(KSPLT, &
OTURB_FLX, &
TPFILE, &
@@ -113,21 +63,21 @@ END MODULE MODI_TURB_HOR_SV_FLUX
USE MODD_CST
USE MODD_CONF
USE MODD_CTURB
-use modd_field, only: tfielddata, TYPEREAL
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_NSV, ONLY: NSV_LGBEG, NSV_LGEND
USE MODD_LES
USE MODD_BLOWSNOW
!
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE
!
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_SHUMAN
-USE MODI_COEFJ
+USE MODE_COEFJ, ONLY: COEFJ
USE MODI_LES_MEAN_SUBGRID
!
USE MODI_SECOND_MNH
@@ -247,7 +197,7 @@ DO JSV=1,ISV
ZFLXX(:,:,IKB-1:IKB-1) = 2. * MXM( ZWORK2D(:,:,1:1) ) - ZFLXX(:,:,IKB:IKB)
!
! stores <U SVth>
- IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+ IF ( TPFILE%LOPENED .AND. OTURB_FLX ) THEN
WRITE(TZFIELD%CMNHNAME,'("USV_FLX_",I3.3)') JSV
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
@@ -258,7 +208,7 @@ DO JSV=1,ISV
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLXX)
END IF
!
IF (LLES_CALL .AND. KSPLT==1) THEN
@@ -298,7 +248,7 @@ DO JSV=1,ISV
ZFLXY(:,:,IKB-1:IKB-1) = 2. * MYM( ZWORK2D(:,:,1:1) ) - ZFLXY(:,:,IKB:IKB)
!
! stores <V SVth>
- IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+ IF ( TPFILE%LOPENED .AND. OTURB_FLX ) THEN
WRITE(TZFIELD%CMNHNAME,'("VSV_FLX_",I3.3)') JSV
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
@@ -309,7 +259,7 @@ DO JSV=1,ISV
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXY)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLXY)
END IF
!
ELSE
@@ -362,3 +312,4 @@ END DO ! end loop JSV
!
!
END SUBROUTINE TURB_HOR_SV_FLUX
+END MODULE MODE_TURB_HOR_SV_FLUX
diff --git a/src/mesonh/turb/turb_hor_thermo_corr.f90 b/src/common/turb/mode_turb_hor_thermo_corr.F90
similarity index 81%
rename from src/mesonh/turb/turb_hor_thermo_corr.f90
rename to src/common/turb/mode_turb_hor_thermo_corr.F90
index b619486765f9001c536c5b7860997c9c8894aaca..cd359059e6b87ecaf951a16f2ccc3888aac14db3 100644
--- a/src/mesonh/turb/turb_hor_thermo_corr.f90
+++ b/src/common/turb/mode_turb_hor_thermo_corr.F90
@@ -3,71 +3,11 @@
!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_TURB_HOR_THERMO_CORR
-! ################################
-!
-INTERFACE
-!
- SUBROUTINE TURB_HOR_THERMO_CORR(KRR, KRRL, KRRI, &
- OTURB_FLX,OSUBG_COND, &
- TPFILE, &
- PINV_PDXX,PINV_PDYY, &
- PDXX,PDYY,PDZZ,PDZX,PDZY, &
- PTHVREF, &
- PWM,PTHLM,PRM, &
- PTKEM,PLM,PLEPS, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM, &
- PSIGS )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-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.
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
-! condensation
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state Virtual
- ! Potential Temperature
-!
-! Variables at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! mixing ratios at t-1,
- ! where PRM(:,:,:,1) = conservative mixing ratio
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! Turb. Kin. Energy
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
- ! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
- ! IN: Vertical part of Sigma_s at t
- ! OUT: Total Sigma_s at t
-!
-!
-!
-END SUBROUTINE TURB_HOR_THERMO_CORR
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_HOR_THERMO_CORR
-! ################################################################
+MODULE MODE_TURB_HOR_THERMO_CORR
+IMPLICIT NONE
+CONTAINS
SUBROUTINE TURB_HOR_THERMO_CORR(KRR, KRRL, KRRI, &
- OTURB_FLX,OSUBG_COND, &
+ OTURB_FLX,OSUBG_COND,OOCEAN, &
TPFILE, &
PINV_PDXX,PINV_PDYY, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
@@ -121,12 +61,12 @@ END MODULE MODI_TURB_HOR_THERMO_CORR
USE MODD_CST
USE MODD_CONF
USE MODD_CTURB
-use modd_field, only: tfielddata, TYPEREAL
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_LES
!
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE
!
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
@@ -135,8 +75,8 @@ USE MODI_GRADIENT_W
USE MODI_SHUMAN
USE MODI_LES_MEAN_SUBGRID
!
-USE MODI_EMOIST
-USE MODI_ETHETA
+USE MODE_EMOIST, ONLY: EMOIST
+USE MODE_ETHETA, ONLY: ETHETA
!
USE MODI_SECOND_MNH
!
@@ -153,6 +93,7 @@ INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
! condensation
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
@@ -224,7 +165,7 @@ ZCOEFF(:,:,IKB)= - (PDZZ(:,:,IKB+2)+2.*PDZZ(:,:,IKB+1)) / &
!
!
!
-IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. tpfile%lopened ) &
+IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. TPFILE%LOPENED ) &
.OR. ( LLES_CALL ) ) THEN
!
!* 8.1 <THl THl>
@@ -265,7 +206,7 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. tpfile%lopened ) &
END IF
!
! stores <THl THl>
- IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+ IF ( OTURB_FLX .AND. TPFILE%LOPENED ) THEN
TZFIELD%CMNHNAME = 'THL_HVAR'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'THL_HVAR'
@@ -276,7 +217,7 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. tpfile%lopened ) &
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLX)
END IF
!
! Storage in the LES configuration (addition to TURB_VER computation)
@@ -286,7 +227,7 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. tpfile%lopened ) &
CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_Thl2, .TRUE. )
CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLX, X_LES_RES_W_SBG_Thl2, .TRUE. )
CALL LES_MEAN_SUBGRID( -2.*XCTD*SQRT(PTKEM)*ZFLX/PLEPS ,X_LES_SUBGRID_DISS_Thl2, .TRUE. )
- ZA(:,:,:) = ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM)
+ ZA(:,:,:) = ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM,OOCEAN)
CALL LES_MEAN_SUBGRID( ZA*ZFLX, X_LES_SUBGRID_ThlThv, .TRUE. )
CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLX, X_LES_SUBGRID_ThlPz, .TRUE. )
CALL SECOND_MNH(ZTIME2)
@@ -353,7 +294,7 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. tpfile%lopened ) &
END IF
!
! stores <THl Rnp>
- IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+ IF ( OTURB_FLX .AND. TPFILE%LOPENED ) THEN
TZFIELD%CMNHNAME = 'THLR_HCOR'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'THLR_HCOR'
@@ -364,7 +305,7 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. tpfile%lopened ) &
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLX)
END IF
!
! Storage in the LES configuration (addition to TURB_VER computation)
@@ -376,7 +317,7 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. tpfile%lopened ) &
CALL LES_MEAN_SUBGRID( -XCTD*SQRT(PTKEM)*ZFLX/PLEPS ,X_LES_SUBGRID_DISS_ThlRt, .TRUE. )
CALL LES_MEAN_SUBGRID( ZA*ZFLX, X_LES_SUBGRID_RtThv, .TRUE. )
CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLX, X_LES_SUBGRID_RtPz,.TRUE.)
- ZA(:,:,:) = EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM)
+ ZA(:,:,:) = EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM,OOCEAN)
CALL LES_MEAN_SUBGRID( ZA*ZFLX, X_LES_SUBGRID_ThlThv, .TRUE. )
CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLX, X_LES_SUBGRID_ThlPz,.TRUE.)
CALL SECOND_MNH(ZTIME2)
@@ -421,7 +362,7 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. tpfile%lopened ) &
END IF
!
! stores <Rnp Rnp>
- IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+ IF ( OTURB_FLX .AND. TPFILE%LOPENED ) THEN
TZFIELD%CMNHNAME = 'R_HVAR'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'R_HVAR'
@@ -432,7 +373,7 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. tpfile%lopened ) &
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLX)
END IF
!
! Storage in the LES configuration (addition to TURB_VER computation)
@@ -466,3 +407,4 @@ END IF
!
!
END SUBROUTINE TURB_HOR_THERMO_CORR
+END MODULE MODE_TURB_HOR_THERMO_CORR
diff --git a/src/mesonh/turb/turb_hor_thermo_flux.f90 b/src/common/turb/mode_turb_hor_thermo_flux.F90
similarity index 86%
rename from src/mesonh/turb/turb_hor_thermo_flux.f90
rename to src/common/turb/mode_turb_hor_thermo_flux.F90
index 90d189a2bf41c8261bc26bc692a95ec3fc2297a6..97a74596e8bd6ef4086862a7554d27c61c86acf7 100644
--- a/src/mesonh/turb/turb_hor_thermo_flux.f90
+++ b/src/common/turb/mode_turb_hor_thermo_flux.F90
@@ -3,74 +3,9 @@
!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_TURB_HOR_THERMO_FLUX
-! ################################
-!
-INTERFACE
-!
- SUBROUTINE TURB_HOR_THERMO_FLUX(KSPLT, KRR, KRRL, KRRI, &
- OTURB_FLX,OSUBG_COND, &
- TPFILE, &
- PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
- PDXX,PDYY,PDZZ,PDZX,PDZY, &
- PDIRCOSXW,PDIRCOSYW, &
- PRHODJ, &
- PSFTHM,PSFRM, &
- PWM,PTHLM,PRM, &
- PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
- PRTHLS,PRRS )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KSPLT ! split process index
-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.
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
-! condensation
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
- ! PK = PLM * SQRT(PTKEM)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW
-! Director Cosinus along x, y and z directions at surface w-point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM
-!
-! Variables at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! mixing ratios at t-1,
- ! where PRM(:,:,:,1) = conservative mixing ratio
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM
- ! normalized 2nd-order flux
- ! s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFRAC_ICE ! ri fraction of rc+ri
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHLS
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS ! var. at t+1 -split-
-!
-!
-END SUBROUTINE TURB_HOR_THERMO_FLUX
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_HOR_THERMO_FLUX
+MODULE MODE_TURB_HOR_THERMO_FLUX
+IMPLICIT NONE
+CONTAINS
! ################################################################
SUBROUTINE TURB_HOR_THERMO_FLUX(KSPLT, KRR, KRRL, KRRI, &
OTURB_FLX,OSUBG_COND, &
@@ -130,12 +65,12 @@ END MODULE MODI_TURB_HOR_THERMO_FLUX
USE MODD_CST
USE MODD_CONF
USE MODD_CTURB
-use modd_field, only: tfielddata, TYPEREAL
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_LES
!
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE
!
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
@@ -143,8 +78,8 @@ USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_SHUMAN
USE MODI_LES_MEAN_SUBGRID
-!!USE MODI_EMOIST
-!!USE MODI_ETHETA
+!!USE MODE_EMOIST, ONLY: EMOIST
+!!USE MODE_ETHETA, ONLY: ETHETA
!
USE MODI_SECOND_MNH
!
@@ -310,7 +245,7 @@ END IF
!!ZWORK(:,:,:) = ZFLX(:,:,:)
!
! stores the horizontal <U THl>
-IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+IF ( TPFILE%LOPENED .AND. OTURB_FLX ) THEN
TZFIELD%CMNHNAME = 'UTHL_FLX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'UTHL_FLX'
@@ -321,7 +256,7 @@ IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLX)
END IF
!
IF (KSPLT==1 .AND. LLES_CALL) THEN
@@ -413,7 +348,7 @@ IF (KRR/=0) THEN
END IF
!
! stores the horizontal <U Rnp>
- IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+ IF ( TPFILE%LOPENED .AND. OTURB_FLX ) THEN
TZFIELD%CMNHNAME = 'UR_FLX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'UR_FLX'
@@ -424,7 +359,7 @@ IF (KRR/=0) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLX)
END IF
!
IF (KSPLT==1 .AND. LLES_CALL) THEN
@@ -462,7 +397,7 @@ END IF
!! ZFLX(:,:,:)*MXM(EMOIST(KRR,KRRI,PTHLT,PEXNREF,PRT,PLOCPT,PSRCM))
!! !
!! ! stores the horizontal <U VPT>
-!! IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+!! IF ( TPFILE%LOPENED .AND. OTURB_FLX ) THEN
!! TZFIELD%CMNHNAME = 'UVPT_FLX'
!! TZFIELD%CSTDNAME = ''
!! TZFIELD%CLONGNAME = 'UVPT_FLX'
@@ -473,7 +408,7 @@ END IF
!! TZFIELD%NTYPE = TYPEREAL
!! TZFIELD%NDIMS = 3
!! TZFIELD%LTIMEDEP = .TRUE.
-!! CALL IO_Field_write(TPFILE,TZFIELD,ZVPTU)
+!! CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZVPTU)
!! END IF
!!!
!!ELSE
@@ -565,7 +500,7 @@ END IF
!!ZWORK(:,:,:) = ZFLX(:,:,:)
!
! stores the horizontal <V THl>
-IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+IF ( TPFILE%LOPENED .AND. OTURB_FLX ) THEN
TZFIELD%CMNHNAME = 'VTHL_FLX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'VTHL_FLX'
@@ -576,7 +511,7 @@ IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLX)
END IF
!
IF (KSPLT==1 .AND. LLES_CALL) THEN
@@ -677,7 +612,7 @@ IF (KRR/=0) THEN
END IF
!
! stores the horizontal <V Rnp>
- IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+ IF ( TPFILE%LOPENED .AND. OTURB_FLX ) THEN
TZFIELD%CMNHNAME = 'VR_FLX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'VR_FLX'
@@ -688,7 +623,7 @@ IF (KRR/=0) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLX)
END IF
!
IF (KSPLT==1 .AND. LLES_CALL) THEN
@@ -730,7 +665,7 @@ END IF
!! END IF
!! !
!! ! stores the horizontal <V VPT>
-!! IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+!! IF ( TPFILE%LOPENED .AND. OTURB_FLX ) THEN
!! TZFIELD%CMNHNAME = 'VVPT_FLX'
!! TZFIELD%CSTDNAME = ''
!! TZFIELD%CLONGNAME = 'VVPT_FLX'
@@ -741,7 +676,7 @@ END IF
!! TZFIELD%NTYPE = TYPEREAL
!! TZFIELD%NDIMS = 3
!! TZFIELD%LTIMEDEP = .TRUE.
-!! CALL IO_Field_write(TPFILE,TZFIELD,ZVPTV)
+!! CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZVPTV)
!! END IF
!!!
!!ELSE
@@ -750,3 +685,4 @@ END IF
!
!
END SUBROUTINE TURB_HOR_THERMO_FLUX
+END MODULE MODE_TURB_HOR_THERMO_FLUX
diff --git a/src/mesonh/turb/turb_hor_tke.f90 b/src/common/turb/mode_turb_hor_tke.F90
similarity index 82%
rename from src/mesonh/turb/turb_hor_tke.f90
rename to src/common/turb/mode_turb_hor_tke.F90
index ec8e9e2b63953f2eb38ebfad15f72c6837337fab..5ff7a0029077c979ca71d3ed008b7d165cc340f8 100644
--- a/src/mesonh/turb/turb_hor_tke.f90
+++ b/src/common/turb/mode_turb_hor_tke.F90
@@ -3,43 +3,9 @@
!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_TURB_HOR_TKE
-! ####################
-!
-INTERFACE
-!
- SUBROUTINE TURB_HOR_TKE(KSPLT, &
- PDXX,PDYY,PDZZ,PDZX,PDZY, &
- PINV_PDXX, PINV_PDYY, PINV_PDZZ, PMZM_PRHODJ, &
- PK, PRHODJ, PTKEM, &
- PTRH )
-
-!
-INTEGER, INTENT(IN) :: KSPLT ! current split index
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
- ! PK = PLM * SQRT(PTKEM)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t- dt
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTRH ! horizontal transport of Tke
-!
-!
-!
-END SUBROUTINE TURB_HOR_TKE
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_HOR_TKE
-! ################################################################
+MODULE MODE_TURB_HOR_TKE
+IMPLICIT NONE
+CONTAINS
SUBROUTINE TURB_HOR_TKE(KSPLT, &
PDXX, PDYY, PDZZ,PDZX,PDZY, &
PINV_PDXX, PINV_PDYY, PINV_PDZZ, PMZM_PRHODJ, &
@@ -244,3 +210,4 @@ END IF
!----------------------------------------------------------------------------
!
END SUBROUTINE TURB_HOR_TKE
+END MODULE MODE_TURB_HOR_TKE
diff --git a/src/mesonh/turb/turb_hor_uv.f90 b/src/common/turb/mode_turb_hor_uv.F90
similarity index 75%
rename from src/mesonh/turb/turb_hor_uv.f90
rename to src/common/turb/mode_turb_hor_uv.F90
index 3fcecc20e2d98fa1844db2631a0c1e10256cd7f3..611679c73c5fa03ddca83a2daddd5cd1707a4d28 100644
--- a/src/mesonh/turb/turb_hor_uv.f90
+++ b/src/common/turb/mode_turb_hor_uv.F90
@@ -3,73 +3,9 @@
!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_TURB_HOR_UV
-! #######################
-!
-INTERFACE
-!
- SUBROUTINE TURB_HOR_UV(KSPLT, &
- OTURB_FLX, &
- TPFILE, &
- PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
- PDXX,PDYY,PDZZ,PDZX,PDZY, &
- PDIRCOSZW, &
- PCOSSLOPE,PSINSLOPE, &
- PRHODJ, &
- PCDUEFF,PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
- PUM,PVM,PUSLOPEM,PVSLOPEM, &
- PDP, &
- PRUS,PRVS )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KSPLT ! split process index
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
- ! PK = PLM * SQRT(PTKEM)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW
-! Director Cosinus along z directions at surface w-point
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
- ! between i and the slope vector
-REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
- ! between i and the slope vector
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU11M ! <uu> in the axes linked
- ! to the maximum slope direction and the surface normal and the binormal
- ! at time t - dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU12M ! <uv> in the same axes
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU22M ! <vv> in the same axes
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
-!
-! Variables at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM
-REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
- ! maximum slope direction
-REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
- ! direction normal to the maximum slope one
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS ! var. at t+1 -split-
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP ! TKE production terms
-!
-!
-END SUBROUTINE TURB_HOR_UV
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_HOR_UV
+MODULE MODE_TURB_HOR_UV
+IMPLICIT NONE
+CONTAINS
! ################################################################
SUBROUTINE TURB_HOR_UV(KSPLT, &
OTURB_FLX, &
@@ -126,19 +62,19 @@ END MODULE MODI_TURB_HOR_UV
USE MODD_CST
USE MODD_CONF
USE MODD_CTURB
-use modd_field, only: tfielddata, TYPEREAL
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_LES
!
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE
!
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_SHUMAN
-USE MODI_COEFJ
+USE MODE_COEFJ, ONLY: COEFJ
USE MODI_LES_MEAN_SUBGRID
!
USE MODI_SECOND_MNH
@@ -269,7 +205,7 @@ ZFLX(:,:,IKB-1:IKB-1) = 2. * MXM( MYM( ZFLX(:,:,IKB-1:IKB-1) ) ) &
- ZFLX(:,:,IKB:IKB)
!
! stores <U V>
-IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+IF ( TPFILE%LOPENED .AND. OTURB_FLX ) THEN
TZFIELD%CMNHNAME = 'UV_FLX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'UV_FLX'
@@ -280,7 +216,7 @@ IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLX)
END IF
!
!
@@ -353,3 +289,4 @@ END IF
!
!
END SUBROUTINE TURB_HOR_UV
+END MODULE MODE_TURB_HOR_UV
diff --git a/src/mesonh/turb/turb_hor_uw.f90 b/src/common/turb/mode_turb_hor_uw.F90
similarity index 77%
rename from src/mesonh/turb/turb_hor_uw.f90
rename to src/common/turb/mode_turb_hor_uw.F90
index d19c68bae6607c4805871d5e4169380917ccdb80..47005d4a3730f5920f87dc9b813f7f50f6d68985 100644
--- a/src/mesonh/turb/turb_hor_uw.f90
+++ b/src/common/turb/mode_turb_hor_uw.F90
@@ -3,61 +3,9 @@
!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_TURB_HOR_UW
-! #######################
-!
-INTERFACE
-!
- SUBROUTINE TURB_HOR_UW(KSPLT, &
- OTURB_FLX,KRR, &
- TPFILE, &
- PK,PINV_PDXX,PINV_PDZZ,PMZM_PRHODJ, &
- PDXX,PDZZ,PDZX, &
- PRHODJ,PTHVREF, &
- PUM,PWM,PTHLM,PRM,PSVM, &
- PTKEM,PLM, &
- PDP, &
- PRUS,PRWS )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KSPLT ! split process index
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
- ! PK = PLM * SQRT(PTKEM)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDXX ! 1./PDXX
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDZZ, PDZX
- ! Metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state VPT
-!
-! Variables at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PWM,PTHLM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t- dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRWS
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP ! TKE production terms
-!
-!
-!
-!
-END SUBROUTINE TURB_HOR_UW
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_HOR_UW
+MODULE MODE_TURB_HOR_UW
+IMPLICIT NONE
+CONTAINS
! ################################################################
SUBROUTINE TURB_HOR_UW(KSPLT, &
OTURB_FLX,KRR, &
@@ -117,20 +65,20 @@ END MODULE MODI_TURB_HOR_UW
USE MODD_CST
USE MODD_CONF
USE MODD_CTURB
-use modd_field, only: tfielddata, TYPEREAL
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_LES
USE MODD_NSV
!
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE
!
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_SHUMAN
-USE MODI_COEFJ
+USE MODE_COEFJ, ONLY: COEFJ
USE MODI_LES_MEAN_SUBGRID
!
USE MODI_SECOND_MNH
@@ -219,7 +167,7 @@ ZFLX(:,:,IKB) = 0.
ZFLX(:,:,IKB-1)=2.*ZFLX(:,:,IKB)- ZFLX(:,:,IKB+1)
!
! stores <U W>
-IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+IF ( TPFILE%LOPENED .AND. OTURB_FLX ) THEN
TZFIELD%CMNHNAME = 'UW_HFLX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'UW_HFLX'
@@ -230,7 +178,7 @@ IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLX)
END IF
!
!
@@ -297,3 +245,4 @@ END IF
!
END SUBROUTINE TURB_HOR_UW
+END MODULE MODE_TURB_HOR_UW
diff --git a/src/mesonh/turb/turb_hor_vw.f90 b/src/common/turb/mode_turb_hor_vw.F90
similarity index 77%
rename from src/mesonh/turb/turb_hor_vw.f90
rename to src/common/turb/mode_turb_hor_vw.F90
index df888c2c7ba810d520a842ae57584710b2708359..8ede64d515ea715cf2c3f0ee6fc09f7d06909b91 100644
--- a/src/mesonh/turb/turb_hor_vw.f90
+++ b/src/common/turb/mode_turb_hor_vw.F90
@@ -3,58 +3,9 @@
!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_TURB_HOR_VW
-! #######################
-!
-INTERFACE
-!
- SUBROUTINE TURB_HOR_VW(KSPLT, &
- OTURB_FLX,KRR, &
- TPFILE, &
- PK,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
- PDYY,PDZZ,PDZY, &
- PRHODJ,PTHVREF, &
- PVM,PWM,PTHLM,PRM,PSVM, &
- PTKEM,PLM, &
- PDP, &
- PRVS,PRWS )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KSPLT ! split process index
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PK ! Turbulent diffusion doef.
- ! PK = PLM * SQRT(PTKEM)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDYY ! 1./PDYY
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY, PDZZ, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state VPT
-!
-! Variables at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVM,PWM,PTHLM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t- dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS, PRWS ! var. at t+1 -split-
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP ! TKE production terms
-!
-END SUBROUTINE TURB_HOR_VW
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_HOR_VW
-! ################################################################
+MODULE MODE_TURB_HOR_VW
+IMPLICIT NONE
+CONTAINS
SUBROUTINE TURB_HOR_VW(KSPLT, &
OTURB_FLX,KRR, &
TPFILE, &
@@ -113,20 +64,20 @@ END MODULE MODI_TURB_HOR_VW
USE MODD_CST
USE MODD_CONF
USE MODD_CTURB
-use modd_field, only: tfielddata, TYPEREAL
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_LES
USE MODD_NSV
!
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE
!
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_SHUMAN
-USE MODI_COEFJ
+USE MODE_COEFJ, ONLY: COEFJ
USE MODI_LES_MEAN_SUBGRID
!
USE MODI_SECOND_MNH
@@ -221,7 +172,7 @@ ZFLX(:,:,IKB) = 0.
ZFLX(:,:,IKB-1)= 2.*ZFLX(:,:,IKB) - ZFLX(:,:,IKB+1)
!
! stores <V W>
-IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
+IF ( TPFILE%LOPENED .AND. OTURB_FLX ) THEN
TZFIELD%CMNHNAME = 'VW_HFLX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'VW_HFLX'
@@ -232,7 +183,7 @@ IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLX)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZFLX)
END IF
!
! compute the source for rho*V due to this residual flux ( the other part is
@@ -305,3 +256,4 @@ END IF
!
!
END SUBROUTINE TURB_HOR_VW
+END MODULE MODE_TURB_HOR_VW
diff --git a/src/arome/turb/turb_ver.F90 b/src/common/turb/mode_turb_ver.F90
similarity index 78%
rename from src/arome/turb/turb_ver.F90
rename to src/common/turb/mode_turb_ver.F90
index 3d8b6dd0defd8f3a6c120f463490b327dfc9dcc3..49ed101bb374d335175ae8b26f446b5bdf427f44 100644
--- a/src/arome/turb/turb_ver.F90
+++ b/src/common/turb/mode_turb_ver.F90
@@ -1,9 +1,14 @@
-! ######spl
- SUBROUTINE TURB_VER(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- OCLOSE_OUT,OTURB_FLX, &
- HTURBDIM,HTOM,PIMPL,PEXPL, &
- PTSTEP_UVW,PTSTEP_MET, PTSTEP_SV, &
- HFMFILE,HLUOUT, &
+!MNH_LIC Copyright 1994-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 MODE_TURB_VER
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE TURB_VER(KKA,KKU,KKL,KRR,KRRL,KRRI, &
+ OTURB_FLX, OOCEAN, &
+ HTURBDIM,HTOM,PIMPL,PEXPL, &
+ PTSTEP, TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
PCOSSLOPE,PSINSLOPE, &
PRHODJ,PTHVREF, &
@@ -15,10 +20,7 @@
PFWTH,PFWR,PFTH2,PFR2,PFTHR,PBL_DEPTH, &
PSBL_DEPTH,PLMO, &
PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS, &
- PDP,PTP,PSIGS,PWTH,PWRC,PWSV)
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
- USE MODD_CTURB, ONLY : LHARAT
+ PDP,PTP,PSIGS,PWTH,PWRC,PWSV )
! ###############################################################
!
!
@@ -109,17 +111,11 @@
!! field to be derivated
!! _(M,UW,...) represent the localization of the
!! field derivated
-!!
!!
-!! MXM,MXF,MYM,MYF,MZM,MZF
-!! : Shuman functions (mean operators)
-!! DXF,DYF,DZF,DZM
-!! : Shuman functions (difference operators)
-!!
-!! SUBROUTINE TRIDIAG : to compute the splitted implicit evolution
+!! SUBROUTINE TRIDIAG : to compute the split implicit evolution
!! of a variable located at a mass point
!!
-!! SUBROUTINE TRIDIAG_WIND: to compute the splitted implicit evolution
+!! SUBROUTINE TRIDIAG_WIND: to compute the split implicit evolution
!! of a variable located at a wind point
!!
!! FUNCTIONs ETHETA and EMOIST :
@@ -200,35 +196,46 @@
!! advection schemes
!! Feb. 2012 (Y. Seity) add possibility to run with
!! reversed vertical levels
+!! 10/2012 (J.Escobar) Bypass PGI bug , redefine some allocatable array inplace of automatic
+!! 08/2014 (J.Escobar) Bypass PGI memory leak bug , replace IF statement with IF THEN ENDIF
!! Modifications: July, 2015 (Wim de Rooy) switch for HARATU (Racmo turbulence scheme)
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! JL Redelsperger 03/2021 : add Ocean LES case
!!--------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
USE MODD_CST
USE MODD_CTURB
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_LES
-USE MODD_NSV, ONLY : NSV
+USE MODD_NSV, ONLY: NSV
!
-USE MODI_PRANDTL
-USE MODI_EMOIST
-USE MODI_ETHETA
+!USE MODE_PRANDTL, ONLY: PRANDTL
+USE MODE_EMOIST, ONLY: EMOIST
+USE MODE_ETHETA, ONLY: ETHETA
USE MODI_GRADIENT_M
USE MODI_GRADIENT_W
USE MODI_TURB
-USE MODI_TURB_VER_THERMO_FLUX
-USE MODI_TURB_VER_THERMO_CORR
-USE MODI_TURB_VER_DYN_FLUX
-USE MODI_TURB_VER_SV_FLUX
-USE MODI_TURB_VER_SV_CORR
+USE MODE_TURB_VER_THERMO_FLUX, ONLY: TURB_VER_THERMO_FLUX
+USE MODE_TURB_VER_THERMO_CORR, ONLY: TURB_VER_THERMO_CORR
+USE MODE_TURB_VER_DYN_FLUX, ONLY: TURB_VER_DYN_FLUX
+USE MODE_TURB_VER_SV_FLUX, ONLY: TURB_VER_SV_FLUX
+USE MODE_TURB_VER_SV_CORR, ONLY: TURB_VER_SV_CORR
USE MODI_LES_MEAN_SUBGRID
-USE MODI_SBL_DEPTH
+USE MODE_SBL_DEPTH, ONLY: SBL_DEPTH
+USE MODI_SECOND_MNH
!
-USE MODE_FMWRIT
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_PRANDTL
!
+!
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -241,21 +248,15 @@ INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -
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.
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
-CHARACTER*4, INTENT(IN) :: HTURBDIM ! dimensionality of the
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
! turbulence scheme
-CHARACTER*4, INTENT(IN) :: HTOM ! type of Third Order Moment
+CHARACTER(len=4), INTENT(IN) :: HTOM ! type of Third Order Moment
REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
-REAL, INTENT(IN) :: PTSTEP_UVW ! Dynamical timestep
-REAL, INTENT(IN) :: PTSTEP_MET ! Timestep for meteorological variables
-REAL, INTENT(IN) :: PTSTEP_SV ! Timestep for tracer variables
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output
- ! FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
+REAL, INTENT(IN) :: PTSTEP ! timestep
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
! Metric coefficients
@@ -298,7 +299,6 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
! direction normal to the maximum slope one
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
! PLENGTHM PLENGTHH used in case of LHARATU
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLENGTHM ! Turb. mixing length momentum
@@ -336,7 +336,9 @@ REAL, DIMENSION(:,:,:,:),INTENT(OUT) :: PWSV ! scalar flux
!
!* 0.2 declaration of local variables
!
-REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
+!JUAN BUG PGI
+!!$REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
+REAL, ALLOCATABLE, DIMENSION(:,:,:) :: &
ZBETA, & ! buoyancy coefficient
ZSQRT_TKE,& ! sqrt(e)
ZDTH_DZ, & ! d(th)/dz
@@ -357,17 +359,14 @@ REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
ZWV, & ! (v'w')
ZTHLP, & ! guess of potential temperature due to vert. turbulent flux
ZRP ! guess of total water due to vert. turbulent flux
-REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV) :: &
+
+!!$REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV) :: &
+REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: &
ZPSI_SV, & ! Prandtl number for scalars
- ZREDS1, & ! 1D Redeslperger number R_sv
- ZRED2THS, & ! 3D Redeslperger number R*2_thsv
- ZRED2RS ! 3D Redeslperger number R*2_rsv
+ ZREDS1, & ! 1D Redelsperger number R_sv
+ ZRED2THS, & ! 3D Redelsperger number R*2_thsv
+ ZRED2RS ! 3D Redelsperger number R*2_rsv
REAL, DIMENSION(SIZE(PLM,1),SIZE(PLM,2),SIZE(PLM,3)) :: ZLM
-INTEGER :: IRESP ! Return code of FM routines
-INTEGER :: IGRID ! C-grid indicator in LFIFM file
-INTEGER :: ILENCH ! Length of comment string in LFIFM file
-CHARACTER (LEN=100) :: YCOMMENT ! comment string in LFIFM file
-CHARACTER (LEN=16) :: YRECFM ! Name of the desired field in LFIFM file
!
LOGICAL :: GUSERV ! flag to use water vapor
INTEGER :: IKB,IKE ! index value for the Beginning
@@ -375,27 +374,53 @@ INTEGER :: IKB,IKE ! index value for the Beginning
INTEGER :: JSV ! loop counter on scalar variables
REAL :: ZTIME1
REAL :: ZTIME2
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+TYPE(TFIELDDATA) :: TZFIELD
+!----------------------------------------------------------------------------
+ALLOCATE ( ZBETA(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZSQRT_TKE(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)),&
+ ZDTH_DZ(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZDR_DZ(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZRED2TH3(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZRED2R3(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZRED2THR3(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)),&
+ ZBLL_O_E(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZETHETA(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZEMOIST(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZREDTH1(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZREDR1(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZPHI3(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZPSI3(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZD(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZWTHV(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZWU(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZWV(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZTHLP(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
+ ZRP(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) )
+
+ALLOCATE ( &
+ ZPSI_SV(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV), &
+ ZREDS1(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV), &
+ ZRED2THS(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV), &
+ ZRED2RS(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV) )
+
!----------------------------------------------------------------------------
!
!* 1. PRELIMINARIES
! -------------
!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('TURB_VER',0,ZHOOK_HANDLE)
-PTP (:,:,:) = 0.
-PDP (:,:,:) = 0.
!
IKB=KKA+JPVEXT_TURB*KKL
IKE=KKU-JPVEXT_TURB*KKL
-
!
!
! 3D Redelsperger numbers
!
!
-CALL PRANDTL(KKA,KKU,KKL,KRR,KRRI,OCLOSE_OUT,OTURB_FLX, &
- HTURBDIM, &
- HFMFILE,HLUOUT, &
+CALL PRANDTL(KKA,KKU,KKL,KRR,KRRI,OTURB_FLX, &
+ HTURBDIM, OOCEAN, &
+ TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
PTHVREF,PLOCPEXNM,PATHETA,PAMOIST, &
PLM,PLEPS,PTKEM,PTHLM,PRM,PSVM,PSRCM, &
@@ -404,9 +429,14 @@ CALL PRANDTL(KKA,KKU,KKL,KRR,KRRI,OCLOSE_OUT,OTURB_FLX, &
ZREDS1,ZRED2THS, ZRED2RS, &
ZBLL_O_E, &
ZETHETA, ZEMOIST )
+!
! Buoyancy coefficient
!
-ZBETA = XG/PTHVREF
+IF (OOCEAN) THEN
+ ZBETA = XG*XALPHAOC
+ELSE
+ ZBETA = XG/PTHVREF
+END IF
!
! Square root of Tke
!
@@ -414,17 +444,17 @@ ZSQRT_TKE = SQRT(PTKEM)
!
! gradients of mean quantities at previous time-step
!
-ZDTH_DZ = GZ_M_W(PTHLM(:,:,:),PDZZ, KKA, KKU, KKL)
+ZDTH_DZ = GZ_M_W(KKA, KKU, KKL,PTHLM(:,:,:),PDZZ)
ZDR_DZ = 0.
-IF (KRR>0) ZDR_DZ = GZ_M_W(PRM(:,:,:,1),PDZZ, KKA, KKU, KKL)
+IF (KRR>0) ZDR_DZ = GZ_M_W(KKA, KKU, KKL,PRM(:,:,:,1),PDZZ)
!
!
! Denominator factor in 3rd order terms
!
IF (.NOT. LHARAT) THEN
-ZD(:,:,:) = (1.+ZREDTH1+ZREDR1) * (1.+0.5*(ZREDTH1+ZREDR1))
+ ZD(:,:,:) = (1.+ZREDTH1+ZREDR1) * (1.+0.5*(ZREDTH1+ZREDR1))
ELSE
-ZD(:,:,:) = 1.
+ ZD(:,:,:) = 1.
ENDIF
!
! Phi3 and Psi3 Prandtl numbers
@@ -450,8 +480,6 @@ IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
-
-!ENDIF
!----------------------------------------------------------------------------
!
!
@@ -468,16 +496,15 @@ END IF
!
IF (LHARAT) THEN
-ZLM=PLENGTHH
+ ZLM=PLENGTHH
ELSE
-ZLM=PLM
+ ZLM=PLM
ENDIF
!
CALL TURB_VER_THERMO_FLUX(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- OCLOSE_OUT,OTURB_FLX,HTURBDIM,HTOM, &
- PIMPL,PEXPL, &
- PTSTEP_MET, &
- HFMFILE,HLUOUT, &
+ OTURB_FLX,HTURBDIM,HTOM,OOCEAN, &
+ PIMPL,PEXPL,PTSTEP, &
+ TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
PRHODJ,PTHVREF, &
PSFTHM,PSFRM,PSFTHP,PSFRP, &
@@ -491,14 +518,10 @@ ENDIF
MFMOIST,PBL_DEPTH,ZWTHV, &
PRTHLS,PRRS,ZTHLP,ZRP,PTP,PWTH,PWRC )
!
-!
-!
-! Use Lh (=Lq) from vdfexcuhl as input for turb_ver_thermo_corr
-
CALL TURB_VER_THERMO_CORR(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- OCLOSE_OUT,OTURB_FLX,HTURBDIM,HTOM, &
+ OTURB_FLX,HTURBDIM,HTOM, &
PIMPL,PEXPL, &
- HFMFILE,HLUOUT, &
+ TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW, &
PRHODJ,PTHVREF, &
PSFTHM,PSFRM,PSFTHP,PSFRP, &
@@ -525,15 +548,12 @@ ENDIF
! -----------------------------------------------
!
!
-IF (LHARAT) THEN
-ZLM=PLENGTHM
-ENDIF
-
+IF (LHARAT) ZLM=PLENGTHM
+!
CALL TURB_VER_DYN_FLUX(KKA,KKU,KKL, &
- OCLOSE_OUT,OTURB_FLX,KRR, &
- HTURBDIM,PIMPL,PEXPL, &
- PTSTEP_UVW, &
- HFMFILE,HLUOUT, &
+ OTURB_FLX,KRR, OOCEAN, &
+ HTURBDIM,PIMPL,PEXPL,PTSTEP, &
+ TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
PCOSSLOPE,PSINSLOPE, &
PRHODJ, &
@@ -541,7 +561,7 @@ CALL TURB_VER_DYN_FLUX(KKA,KKU,KKL, &
PTHLM,PRM,PSVM,PUM,PVM,PWM,PUSLOPEM,PVSLOPEM, &
PTKEM,ZLM,MFMOIST,ZWU,ZWV, &
PRUS,PRVS,PRWS, &
- PDP,PTP )
+ PDP,PTP )
!
!----------------------------------------------------------------------------
!
@@ -549,16 +569,13 @@ CALL TURB_VER_DYN_FLUX(KKA,KKU,KKL, &
!* 8. SOURCES OF PASSIVE SCALAR VARIABLES
! -----------------------------------
!
-IF (LHARAT) THEN
-ZLM=PLENGTHH
-ENDIF
-
+IF (LHARAT) ZLM=PLENGTHH
+!
IF (SIZE(PSVM,4)>0) &
CALL TURB_VER_SV_FLUX(KKA,KKU,KKL, &
- OCLOSE_OUT,OTURB_FLX,HTURBDIM, &
- PIMPL,PEXPL, &
- PTSTEP_SV, &
- HFMFILE,HLUOUT, &
+ OTURB_FLX,HTURBDIM, &
+ PIMPL,PEXPL,PTSTEP, &
+ TPFILE, &
PDZZ,PDIRCOSZW, &
PRHODJ,PWM, &
PSFSVM,PSFSVP, &
@@ -568,7 +585,7 @@ CALL TURB_VER_SV_FLUX(KKA,KKU,KKL, &
!
!
IF (SIZE(PSVM,4)>0 .AND. LLES_CALL) &
-CALL TURB_VER_SV_CORR(KKA,KKU,KKL,KRR,KRRL,KRRI, &
+CALL TURB_VER_SV_CORR(KKA,KKU,KKL,KRR,KRRL,KRRI,OOCEAN, &
PDZZ, &
PTHLM,PRM,PTHVREF, &
PLOCPEXNM,PATHETA,PAMOIST,PSRCM,ZPHI3,ZPSI3, &
@@ -590,40 +607,57 @@ IF (SIZE(PSBL_DEPTH)>0) CALL SBL_DEPTH(IKB,IKE,PZZ,ZWU,ZWV,ZWTHV,PLMO,PSBL_DEPTH
! ------
!
!
-IF ( OTURB_FLX .AND. OCLOSE_OUT .AND. .NOT. LHARAT) THEN
+IF ( OTURB_FLX .AND. TPFILE%LOPENED .AND. .NOT. LHARAT) THEN
!
! stores the Turbulent Prandtl number
!
- YRECFM ='PHI3'
- YCOMMENT='X_Y_Z_PHI3 (0)'
- IGRID = 4
- ILENCH=LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZPHI3,IGRID,ILENCH,YCOMMENT,IRESP)
+ TZFIELD%CMNHNAME = 'PHI3'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'PHI3'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'Turbulent Prandtl number'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPHI3)
!
! stores the Turbulent Schmidt number
!
- YRECFM ='PSI3'
- YCOMMENT='X_Y_Z_PSI3 (0)'
- IGRID = 4
- ILENCH=LEN(YCOMMENT)
-!
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZPSI3,IGRID,ILENCH,YCOMMENT,IRESP)
+ TZFIELD%CMNHNAME = 'PSI3'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'PSI3'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'Turbulent Schmidt number'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPSI3)
!
!
! stores the Turbulent Schmidt number for the scalar variables
!
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
DO JSV=1,NSV
- WRITE(YRECFM, '("PSI_SV_",I3.3)') JSV
- YCOMMENT='X_Y_Z_'//YRECFM//' (0)'
- IGRID = 4
- ILENCH=LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZPSI_SV(:,:,:,JSV), &
- IGRID,ILENCH,YCOMMENT,IRESP)
+ WRITE(TZFIELD%CMNHNAME, '("PSI_SV_",I3.3)') JSV
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZPSI_SV(:,:,:,JSV))
END DO
-
+!
END IF
!
!
!----------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('TURB_VER',1,ZHOOK_HANDLE)
-END SUBROUTINE TURB_VER
+END SUBROUTINE TURB_VER
+END MODULE MODE_TURB_VER
diff --git a/src/mesonh/turb/turb_ver_dyn_flux.f90 b/src/common/turb/mode_turb_ver_dyn_flux.F90
similarity index 80%
rename from src/mesonh/turb/turb_ver_dyn_flux.f90
rename to src/common/turb/mode_turb_ver_dyn_flux.F90
index 51bc4e7e1b868799b038e1e56b089bd2cb88ae22..12915e63529d9791f97de93bbb1fe0f9cad3846b 100644
--- a/src/mesonh/turb/turb_ver_dyn_flux.f90
+++ b/src/common/turb/mode_turb_ver_dyn_flux.F90
@@ -2,92 +2,11 @@
!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_TURB_VER_DYN_FLUX
-! ####################
-!
-INTERFACE
-!
- SUBROUTINE TURB_VER_DYN_FLUX(KKA,KKU,KKL, &
- OTURB_FLX,KRR, &
- HTURBDIM,PIMPL,PEXPL, &
- PTSTEP, &
- TPFILE, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
- PCOSSLOPE,PSINSLOPE, &
- PRHODJ, &
- PCDUEFF,PTAU11M,PTAU12M,PTAU33M, &
- PTHLM,PRM,PSVM,PUM,PVM,PWM,PUSLOPEM,PVSLOPEM, &
- PTKEM,PLM,PWU,PWV, &
- PRUS,PRVS,PRWS, &
- PDP,PTP )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=AR
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
-REAL, INTENT(IN) :: PTSTEP ! Double Time Step
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux points
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
- ! normal to the ground surface
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
- ! between i and the slope vector
-REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
- ! between i and the slope vector
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU11M ! <uu> in the axes linked
- ! to the maximum slope direction and the surface normal and the binormal
- ! at time t - dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU12M ! <uv> in the same axes
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHLM
- ! Wind at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
-REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
- ! maximum slope direction
-REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
- ! direction normal to the maximum slope one
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWU ! momentum flux u'w'
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWV ! momentum flux v'w'
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS
- ! cumulated sources for the prognostic variables
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDP ! Dynamic TKE production term
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTP ! Thermal TKE production term
-!
-!
-!
-END SUBROUTINE TURB_VER_DYN_FLUX
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_VER_DYN_FLUX
-!
-!
-! ###############################################################
- SUBROUTINE TURB_VER_DYN_FLUX(KKA,KKU,KKL, &
- OTURB_FLX,KRR, &
+MODULE MODE_TURB_VER_DYN_FLUX
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE TURB_VER_DYN_FLUX(KKA,KKU,KKL, &
+ OTURB_FLX,KRR, OOCEAN, &
HTURBDIM,PIMPL,PEXPL, &
PTSTEP, &
TPFILE, &
@@ -96,7 +15,7 @@ END MODULE MODI_TURB_VER_DYN_FLUX
PRHODJ, &
PCDUEFF,PTAU11M,PTAU12M,PTAU33M, &
PTHLM,PRM,PSVM,PUM,PVM,PWM,PUSLOPEM,PVSLOPEM, &
- PTKEM,PLM,PWU,PWV, &
+ PTKEM,PLM,MFMOIST,PWU,PWV, &
PRUS,PRVS,PRWS, &
PDP,PTP )
! ###############################################################
@@ -196,9 +115,6 @@ END MODULE MODI_TURB_VER_DYN_FLUX
!! DXF,DYF,DZF,DZM
!! : Shuman functions (difference operators)
!!
-!! SUBROUTINE TRIDIAG : to compute the split implicit evolution
-!! of a variable located at a mass point
-!!
!! SUBROUTINE TRIDIAG_WIND: to compute the split implicit evolution
!! of a variable located at a wind point
!!
@@ -277,6 +193,7 @@ END MODULE MODI_TURB_VER_DYN_FLUX
!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
!! change of YCOMMENT
!! 2012-02 Y. Seity, add possibility to run with reversed vertical levels
+!! Modifications July 2015 (Wim de Rooy) LHARATU switch
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! Q. Rodier 17/01/2019 : cleaning : remove cyclic conditions on DP and ZA
@@ -286,11 +203,13 @@ END MODULE MODI_TURB_VER_DYN_FLUX
!* 0. DECLARATIONS
! ------------
!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
USE MODD_CONF
USE MODD_CST
USE MODD_CTURB
-USE MODD_DYN_n, ONLY: LOCEAN
-use modd_field, only: tfielddata, TYPEREAL
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
USE MODD_NSV
@@ -305,9 +224,9 @@ USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_GRADIENT_M
USE MODI_SECOND_MNH
-USE MODI_SHUMAN
-USE MODI_TRIDIAG
-USE MODI_TRIDIAG_WIND
+USE MODI_SHUMAN , ONLY: MZM, MZF, MXM, MXF, MYM, MYF,&
+ & DZM, DXF, DXM, DYF, DYM
+USE MODE_TRIDIAG_WIND, ONLY: TRIDIAG_WIND
USE MODI_LES_MEAN_SUBGRID
!
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
@@ -324,6 +243,7 @@ INTEGER, INTENT(IN) :: KKU !uppest atmosphere array i
INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
INTEGER, INTENT(IN) :: KRR ! number of moist var.
CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
! turbulence scheme
@@ -342,6 +262,8 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
! between i and the slope vector
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
+REAL, DIMENSION(:,:,:), INTENT(IN) :: MFMOIST ! moist mass flux dual scheme
+
!
REAL, DIMENSION(:,:), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
REAL, DIMENSION(:,:), INTENT(IN) :: PTAU11M ! <uu> in the axes linked
@@ -403,33 +325,46 @@ REAL, DIMENSION(SIZE(PDZZ,1),SIZE(PDZZ,2),1) :: ZCOEFFLXU, &
! PVSLOPEM in local 3D arrays
INTEGER :: IIU,IJU ! size of array in x,y,z directions
!
-REAL :: ZTIME1, ZTIME2
+REAL :: ZTIME1, ZTIME2, ZCMFS
TYPE(TFIELDDATA) :: TZFIELD
!----------------------------------------------------------------------------
!
!* 1. PRELIMINARIES
! -------------
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('TURB_VER_DYN_FLUX',0,ZHOOK_HANDLE)
+!
ZA=XUNDEF
PDP=XUNDEF
!
IIU=SIZE(PUM,1)
IJU=SIZE(PUM,2)
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE,IIU,IJU)
+IKB=KKA+JPVEXT_TURB*KKL
+IKE=KKU-JPVEXT_TURB*KKL
IKB=KKA+JPVEXT_TURB*KKL
IKE=KKU-JPVEXT_TURB*KKL
IKT=SIZE(PUM,3)
IKTB=1+JPVEXT_TURB
IKTE=IKT-JPVEXT_TURB
-
-
!
-ZSOURCE(:,:,:) = 0.
+ZSOURCE = 0.
+ZFLXZ = 0.
+ZCMFS = XCMFS
+IF (LHARAT) ZCMFS=1.
!
ZDIRSINZW(:,:) = SQRT(1.-PDIRCOSZW(:,:)**2)
! compute the coefficients for the uncentred gradient computation near the
! ground
!
-ZKEFF(:,:,:) = MZM( PLM(:,:,:) * SQRT(PTKEM(:,:,:)) )
+! With LHARATU length scale and TKE are at half levels so remove MZM
+!
+IF (LHARAT) THEN
+ ZKEFF(:,:,:) = PLM(:,:,:) * SQRT(PTKEM(:,:,:)) + 50*MFMOIST(:,:,:)
+ELSE
+ ZKEFF(:,:,:) = MZM(PLM(:,:,:) * SQRT(PTKEM(:,:,:)), KKA, KKU, KKL)
+ENDIF
+
!
ZUSLOPEM(:,:,1)=PUSLOPEM(:,:)
ZVSLOPEM(:,:,1)=PVSLOPEM(:,:)
@@ -444,8 +379,8 @@ ZVSLOPEM(:,:,1)=PVSLOPEM(:,:)
!
! Preparation of the arguments for TRIDIAG_WIND
!
-ZA(:,:,:) = -PTSTEP * XCMFS * &
- MXM( ZKEFF ) * MXM(MZM( PRHODJ )) / &
+ZA(:,:,:) = -PTSTEP * ZCMFS * &
+ MXM( ZKEFF ) * MXM(MZM(PRHODJ, KKA, KKU, KKL)) / &
MXM( PDZZ )**2
!
!
@@ -466,7 +401,7 @@ ZCOEFS(:,:,1:1)=MXM(ZCOEFS(:,:,1:1) / PDZZ(:,:,IKB:IKB) )
!
!
! ZSOURCE= FLUX /DZ
-IF (LOCEAN) THEN ! OCEAN MODEL ONLY
+IF (OOCEAN) THEN ! OCEAN MODEL ONLY
! Sfx flux assumed to be in SI & at vorticity point
IF (LCOUPLES) THEN
ZSOURCE(:,:,IKE:IKE) = XSSUFL_C(:,:,1:1)/PDZZ(:,:,IKE:IKE) &
@@ -521,8 +456,8 @@ PRUS(:,:,:)=PRUS(:,:,:)+MXM(PRHODJ(:,:,:))*(ZRES(:,:,:)-PUM(:,:,:))/PTSTEP
!
! vertical flux of the U wind component
!
-ZFLXZ(:,:,:) = -XCMFS * MXM(ZKEFF) * &
- DZM (PIMPL*ZRES + PEXPL*PUM) / MXM(PDZZ)
+ZFLXZ(:,:,:) = -ZCMFS * MXM(ZKEFF) * &
+ DZM(PIMPL*ZRES + PEXPL*PUM, KKA, KKU, KKL) / MXM(PDZZ)
!
! surface flux
ZFLXZ(:,:,IKB:IKB) = MXM(PDZZ(:,:,IKB:IKB)) * &
@@ -532,14 +467,14 @@ ZFLXZ(:,:,IKB:IKB) = MXM(PDZZ(:,:,IKB:IKB)) * &
!
ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
-IF (LOCEAN) THEN !ocean model at phys sfc (ocean domain top)
+IF (OOCEAN) THEN !ocean model at phys sfc (ocean domain top)
ZFLXZ(:,:,IKE:IKE) = MXM(PDZZ(:,:,IKE:IKE)) * &
ZSOURCE(:,:,IKE:IKE) &
/ 0.5 / ( 1. + MXM(PRHODJ(:,:,KKU:KKU)) / MXM(PRHODJ(:,:,IKE:IKE)) )
ZFLXZ(:,:,KKU) = ZFLXZ(:,:,IKE)
END IF
!
-IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+IF ( OTURB_FLX .AND. TPFILE%LOPENED ) THEN
! stores the U wind component vertical flux
TZFIELD%CMNHNAME = 'UW_VFLX'
TZFIELD%CSTDNAME = ''
@@ -561,7 +496,7 @@ PWU(:,:,:) = ZFLXZ(:,:,:)
! Contribution to the dynamic production of TKE
! compute the dynamic production at the mass point
!
-PDP(:,:,:) = - MZF( MXF ( ZFLXZ * GZ_U_UW(PUM,PDZZ) ) )
+PDP(:,:,:) = - MZF(MXF(ZFLXZ * GZ_U_UW(PUM,PDZZ, KKA, KKU, KKL)), KKA, KKU, KKL)
!
! evaluate the dynamic production at w(IKB+KKL) in PDP(IKB)
PDP(:,:,IKB:IKB) = - MXF ( &
@@ -569,7 +504,7 @@ PDP(:,:,IKB:IKB) = - MXF (
/ MXM(PDZZ(:,:,IKB+KKL:IKB+KKL)) &
)
!
-IF (LOCEAN) THEN
+IF (OOCEAN) THEN
! evaluate the dynamic production at w(IKE-KKL) in PDP(IKE)
PDP(:,:,IKE:IKE) = - MXF ( &
ZFLXZ(:,:,IKE-KKL:IKE-KKL) * (PUM(:,:,IKE:IKE)-PUM(:,:,IKE-KKL:IKE-KKL)) &
@@ -581,10 +516,10 @@ END IF
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(MXF(ZFLXZ)), X_LES_SUBGRID_WU )
- CALL LES_MEAN_SUBGRID( MZF(MXF(GZ_U_UW(PUM,PDZZ) &
- & *ZFLXZ)), X_LES_RES_ddxa_U_SBG_UaU )
- CALL LES_MEAN_SUBGRID( XCMFS * ZKEFF, X_LES_SUBGRID_Km )
+ CALL LES_MEAN_SUBGRID(MZF(MXF(ZFLXZ), KKA, KKU, KKL), X_LES_SUBGRID_WU )
+ CALL LES_MEAN_SUBGRID(MZF(MXF(GZ_U_UW(PUM,PDZZ, KKA, KKU, KKL) &
+ & *ZFLXZ), KKA, KKU, KKL), X_LES_RES_ddxa_U_SBG_UaU )
+ CALL LES_MEAN_SUBGRID( ZCMFS * ZKEFF, X_LES_SUBGRID_Km )
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
@@ -596,24 +531,24 @@ IF(HTURBDIM=='3DIM') THEN
! Compute the source for the W wind component
! used to compute the W source at the ground
ZFLXZ(:,:,KKA) = 2 * ZFLXZ(:,:,IKB) - ZFLXZ(:,:,IKB+KKL) ! extrapolation
- IF (LOCEAN) THEN
+ IF (OOCEAN) THEN
ZFLXZ(:,:,KKU) = 2 * ZFLXZ(:,:,IKE) - ZFLXZ(:,:,IKE-KKL) ! extrapolation
END IF
!
IF (.NOT. LFLAT) THEN
PRWS(:,:,:)= PRWS &
- -DXF( MZM( MXM(PRHODJ) /PDXX ) * ZFLXZ ) &
- +DZM( PRHODJ / MZF(PDZZ ) * &
- MXF( MZF( ZFLXZ*PDZX ) / PDXX ) &
- )
+ -DXF( MZM(MXM(PRHODJ) /PDXX, KKA, KKU, KKL) * ZFLXZ ) &
+ +DZM(PRHODJ / MZF(PDZZ, KKA, KKU, KKL) * &
+ MXF(MZF(ZFLXZ*PDZX, KKA, KKU, KKL) / PDXX ), &
+ KKA, KKU, KKL)
ELSE
- PRWS(:,:,:)= PRWS -DXF( MZM( MXM(PRHODJ) /PDXX ) * ZFLXZ )
+ PRWS(:,:,:)= PRWS -DXF(MZM(MXM(PRHODJ) /PDXX, KKA, KKU, KKL) * ZFLXZ )
END IF
!
! Complete the Dynamical production with the W wind component
!
- ZA(:,:,:)=-MZF( MXF ( ZFLXZ * GX_W_UW( PWM,PDXX,PDZZ,PDZX) ) )
+ ZA(:,:,:)=-MZF(MXF(ZFLXZ * GX_W_UW(PWM,PDXX,PDZZ,PDZX, KKA, KKU, KKL)), KKA, KKU, KKL)
!
!
! evaluate the dynamic production at w(IKB+KKL) in PDP(IKB)
@@ -629,7 +564,7 @@ IF(HTURBDIM=='3DIM') THEN
) / (0.5*(PDXX(:,:,IKB+KKL:IKB+KKL)+PDXX(:,:,IKB:IKB))) &
)
!
-IF (LOCEAN) THEN
+IF (OOCEAN) THEN
! evaluate the dynamic production at w(IKE-KKL) in PDP(IKE)
ZA(:,:,IKE:IKE) = - MXF ( &
ZFLXZ(:,:,IKE-KKL:IKE-KKL) * &
@@ -639,7 +574,7 @@ IF (LOCEAN) THEN
+(PWM(:,:,IKE-KKL:IKE-KKL)-PWM(:,:,IKE:IKE )) &
/(PDZZ(:,:,IKE-KKL:IKE-KKL)+PDZZ(:,:,IKE:IKE )) &
) &
- * PDZX(:,:,IKE-KKL:IKE-KKL) &
+ * PDZX(:,:,IKE-KKL:IKE-KKL) &
) / (0.5*(PDXX(:,:,IKE-KKL:IKE-KKL)+PDXX(:,:,IKE:IKE))) &
)
END IF
@@ -650,17 +585,17 @@ END IF
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(MXF(GX_W_UW(PWM,PDXX,&
- PDZZ,PDZX)*ZFLXZ)), X_LES_RES_ddxa_W_SBG_UaW )
- CALL LES_MEAN_SUBGRID( MXF(GX_M_U(KKA,KKU,KKL,PTHLM,PDXX,PDZZ,PDZX)&
- * MZF(ZFLXZ)), X_LES_RES_ddxa_Thl_SBG_UaW )
+ CALL LES_MEAN_SUBGRID(MZF(MXF(GX_W_UW(PWM,PDXX,&
+ PDZZ,PDZX, KKA, KKU, KKL)*ZFLXZ), KKA, KKU, KKL), X_LES_RES_ddxa_W_SBG_UaW )
+ CALL LES_MEAN_SUBGRID(MXF(GX_M_U(KKA, KKU, KKL,PTHLM,PDXX,PDZZ,PDZX)&
+ * MZF(ZFLXZ, KKA, KKU, KKL)), X_LES_RES_ddxa_Thl_SBG_UaW )
IF (KRR>=1) THEN
- CALL LES_MEAN_SUBGRID(MXF(GX_U_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)&
- *MZF(ZFLXZ)),X_LES_RES_ddxa_Rt_SBG_UaW )
+ CALL LES_MEAN_SUBGRID(MXF(GX_U_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX, KKA, KKU, KKL)&
+ *MZF(ZFLXZ, KKA, KKU, KKL)),X_LES_RES_ddxa_Rt_SBG_UaW )
END IF
DO JSV=1,NSV
CALL LES_MEAN_SUBGRID( MXF(GX_U_M(PSVM(:,:,:,JSV),PDXX,PDZZ,&
- PDZX)*MZF(ZFLXZ)),X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV) )
+ PDZX, KKA, KKU, KKL)*MZF(ZFLXZ, KKA, KKU, KKL)),X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV) )
END DO
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
@@ -677,8 +612,8 @@ END IF
!
! Preparation of the arguments for TRIDIAG_WIND
!!
-ZA(:,:,:) = - PTSTEP * XCMFS * &
- MYM( ZKEFF ) * MYM(MZM( PRHODJ )) / &
+ZA(:,:,:) = - PTSTEP * ZCMFS * &
+ MYM( ZKEFF ) * MYM(MZM(PRHODJ, KKA, KKU, KKL)) / &
MYM( PDZZ )**2
!
!
@@ -697,7 +632,7 @@ ZCOEFS(:,:,1)= ZCOEFFLXU(:,:,1) * PSINSLOPE(:,:) * PDIRCOSZW(:,:) &
! average this flux to be located at the V,W vorticity point
ZCOEFS(:,:,1:1)=MYM(ZCOEFS(:,:,1:1) / PDZZ(:,:,IKB:IKB) )
!
-IF (LOCEAN) THEN ! Ocean case
+IF (OOCEAN) THEN ! Ocean case
IF (LCOUPLES) THEN
ZSOURCE(:,:,IKE:IKE) = XSSVFL_C(:,:,1:1)/PDZZ(:,:,IKE:IKE) &
*0.5 * ( 1. + MYM(PRHODJ(:,:,KKU:KKU)) / MYM(PRHODJ(:,:,IKE:IKE)) )
@@ -749,8 +684,8 @@ PRVS(:,:,:)=PRVS(:,:,:)+MYM(PRHODJ(:,:,:))*(ZRES(:,:,:)-PVM(:,:,:))/PTSTEP
!
! vertical flux of the V wind component
!
-ZFLXZ(:,:,:) = -XCMFS * MYM(ZKEFF) * &
- DZM( PIMPL*ZRES + PEXPL*PVM ) / MYM(PDZZ)
+ZFLXZ(:,:,:) = -ZCMFS * MYM(ZKEFF) * &
+ DZM(PIMPL*ZRES + PEXPL*PVM, KKA, KKU, KKL) / MYM(PDZZ)
!
ZFLXZ(:,:,IKB:IKB) = MYM(PDZZ(:,:,IKB:IKB)) * &
( ZSOURCE(:,:,IKB:IKB) &
@@ -760,14 +695,14 @@ ZFLXZ(:,:,IKB:IKB) = MYM(PDZZ(:,:,IKB:IKB)) * &
!
ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
!
-IF (LOCEAN) THEN
+IF (OOCEAN) THEN
ZFLXZ(:,:,IKE:IKE) = MYM(PDZZ(:,:,IKE:IKE)) * &
ZSOURCE(:,:,IKE:IKE) &
/ 0.5 / ( 1. + MYM(PRHODJ(:,:,KKU:KKU)) / MYM(PRHODJ(:,:,IKE:IKE)) )
ZFLXZ(:,:,KKU) = ZFLXZ(:,:,IKE)
END IF
!
-IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+IF ( OTURB_FLX .AND. TPFILE%LOPENED ) THEN
! stores the V wind component vertical flux
TZFIELD%CMNHNAME = 'VW_VFLX'
TZFIELD%CSTDNAME = ''
@@ -789,7 +724,7 @@ PWV(:,:,:) = ZFLXZ(:,:,:)
! Contribution to the dynamic production of TKE
! compute the dynamic production contribution at the mass point
!
-ZA(:,:,:) = - MZF( MYF ( ZFLXZ * GZ_V_VW(PVM,PDZZ) ) )
+ZA(:,:,:) = - MZF(MYF(ZFLXZ * GZ_V_VW(PVM,PDZZ, KKA, KKU, KKL)), KKA, KKU, KKL)
!
! evaluate the dynamic production at w(IKB+KKL) in PDP(IKB)
ZA(:,:,IKB:IKB) = &
@@ -798,7 +733,7 @@ ZFLXZ(:,:,IKB+KKL:IKB+KKL) * (PVM(:,:,IKB+KKL:IKB+KKL)-PVM(:,:,IKB:IKB)) &
/ MYM(PDZZ(:,:,IKB+KKL:IKB+KKL)) &
)
!
-IF (LOCEAN) THEN
+IF (OOCEAN) THEN
! evaluate the dynamic production at w(IKE-KKL) in PDP(IKE)
ZA(:,:,IKE:IKE) = - MYF ( &
ZFLXZ(:,:,IKE-KKL:IKE-KKL) * (PVM(:,:,IKE:IKE)-PVM(:,:,IKE-KKL:IKE-KKL)) &
@@ -812,9 +747,9 @@ PDP(:,:,:)=PDP(:,:,:)+ZA(:,:,:)
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(MYF(ZFLXZ)), X_LES_SUBGRID_WV )
- CALL LES_MEAN_SUBGRID( MZF(MYF(GZ_V_VW(PVM,PDZZ)*&
- & ZFLXZ)), X_LES_RES_ddxa_V_SBG_UaV )
+ CALL LES_MEAN_SUBGRID(MZF(MYF(ZFLXZ), KKA, KKU, KKL), X_LES_SUBGRID_WV )
+ CALL LES_MEAN_SUBGRID(MZF(MYF(GZ_V_VW(PVM,PDZZ, KKA, KKU, KKL)*&
+ & ZFLXZ), KKA, KKU, KKL), X_LES_RES_ddxa_V_SBG_UaV )
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
@@ -825,25 +760,25 @@ END IF
IF(HTURBDIM=='3DIM') THEN
! Compute the source for the W wind component
ZFLXZ(:,:,KKA) = 2 * ZFLXZ(:,:,IKB) - ZFLXZ(:,:,IKB+KKL) ! extrapolation
- IF (LOCEAN) THEN
+ IF (OOCEAN) THEN
ZFLXZ(:,:,KKU) = 2 * ZFLXZ(:,:,IKE) - ZFLXZ(:,:,IKE-KKL) ! extrapolation
END IF
!
IF (.NOT. L2D) THEN
IF (.NOT. LFLAT) THEN
PRWS(:,:,:)= PRWS(:,:,:) &
- -DYF( MZM( MYM(PRHODJ) /PDYY ) * ZFLXZ ) &
- +DZM( PRHODJ / MZF(PDZZ ) * &
- MYF( MZF( ZFLXZ*PDZY ) / PDYY ) &
- )
+ -DYF( MZM(MYM(PRHODJ) /PDYY, KKA, KKU, KKL) * ZFLXZ ) &
+ +DZM(PRHODJ / MZF(PDZZ, KKA, KKU, KKL) * &
+ MYF(MZF(ZFLXZ*PDZY, KKA, KKU, KKL) / PDYY ), &
+ KKA, KKU, KKL)
ELSE
- PRWS(:,:,:)= PRWS(:,:,:) -DYF( MZM( MYM(PRHODJ) /PDYY ) * ZFLXZ )
+ PRWS(:,:,:)= PRWS(:,:,:) -DYF(MZM(MYM(PRHODJ) /PDYY, KKA, KKU, KKL) * ZFLXZ )
END IF
END IF
!
! Complete the Dynamical production with the W wind component
IF (.NOT. L2D) THEN
- ZA(:,:,:) = - MZF( MYF ( ZFLXZ * GY_W_VW( PWM,PDYY,PDZZ,PDZY) ) )
+ ZA(:,:,:) = - MZF(MYF(ZFLXZ * GY_W_VW(PWM,PDYY,PDZZ,PDZY, KKA, KKU, KKL)), KKA, KKU, KKL)
!
! evaluate the dynamic production at w(IKB+KKL) in PDP(IKB)
ZA(:,:,IKB:IKB) = - MYF ( &
@@ -858,7 +793,7 @@ IF(HTURBDIM=='3DIM') THEN
) / (0.5*(PDYY(:,:,IKB+KKL:IKB+KKL)+PDYY(:,:,IKB:IKB))) &
)
!
- IF (LOCEAN) THEN
+ IF (OOCEAN) THEN
ZA(:,:,IKE:IKE) = - MYF ( &
ZFLXZ(:,:,IKE-KKL:IKE-KKL) * &
( DYM( PWM(:,:,IKE-KKL:IKE-KKL) ) &
@@ -880,13 +815,16 @@ IF(HTURBDIM=='3DIM') THEN
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(MYF(GY_W_VW(PWM,PDYY,&
- PDZZ,PDZY)*ZFLXZ)), X_LES_RES_ddxa_W_SBG_UaW , .TRUE. )
- CALL LES_MEAN_SUBGRID( MYF(GY_M_V(KKA,KKU,KKL,PTHLM,PDYY,PDZZ,PDZY)&
- *MZF(ZFLXZ)), X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE. )
+ CALL LES_MEAN_SUBGRID(MZF(MYF(GY_W_VW(PWM,PDYY,&
+ &PDZZ,PDZY, KKA, KKU, KKL)*ZFLXZ), KKA, KKU, KKL), &
+ &X_LES_RES_ddxa_W_SBG_UaW , .TRUE. )
+ CALL LES_MEAN_SUBGRID(MYF(GY_M_V(KKA, KKU, KKL,PTHLM,PDYY,PDZZ,PDZY)*&
+ &MZF(ZFLXZ, KKA, KKU, KKL)), &
+ &X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE. )
IF (KRR>=1) THEN
- CALL LES_MEAN_SUBGRID( MYF(GY_V_M(PRM(:,:,:,1),PDYY,PDZZ,&
- PDZY)*MZF(ZFLXZ)),X_LES_RES_ddxa_Rt_SBG_UaW , .TRUE. )
+ CALL LES_MEAN_SUBGRID(MYF(GY_V_M(PRM(:,:,:,1),PDYY,PDZZ,&
+ &PDZY, KKA, KKU, KKL)*MZF(ZFLXZ, KKA, KKU, KKL)),&
+ &X_LES_RES_ddxa_Rt_SBG_UaW , .TRUE. )
END IF
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
@@ -900,9 +838,9 @@ END IF
!* 7. DIAGNOSTIC COMPUTATION OF THE 1D <W W> VARIANCE
! -----------------------------------------------
!
-IF ( OTURB_FLX .AND. tpfile%lopened .AND. HTURBDIM == '1DIM') THEN
+IF ( OTURB_FLX .AND. TPFILE%LOPENED .AND. HTURBDIM == '1DIM') THEN
ZFLXZ(:,:,:)= (2./3.) * PTKEM(:,:,:) &
- -XCMFS*PLM(:,:,:)*SQRT(PTKEM(:,:,:))*GZ_W_M(PWM,PDZZ)
+ -ZCMFS*PLM(:,:,:)*SQRT(PTKEM(:,:,:))*GZ_W_M(PWM,PDZZ, KKA, KKU, KKL)
! to be tested &
! +XCMFB*(4./3.)*PLM(:,:,:)/SQRT(PTKEM(:,:,:))*PTP(:,:,:)
! stores the W variance
@@ -921,4 +859,6 @@ END IF
!
!----------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('TURB_VER_DYN_FLUX',1,ZHOOK_HANDLE)
END SUBROUTINE TURB_VER_DYN_FLUX
+END MODULE MODE_TURB_VER_DYN_FLUX
diff --git a/src/arome/turb/turb_ver_sv_corr.F90 b/src/common/turb/mode_turb_ver_sv_corr.F90
similarity index 79%
rename from src/arome/turb/turb_ver_sv_corr.F90
rename to src/common/turb/mode_turb_ver_sv_corr.F90
index 25744253b913e3b7ea2203fb5e77e26b6de466ce..9fb527829b7e3db91ac9bde036de9a18889a7bff 100644
--- a/src/arome/turb/turb_ver_sv_corr.F90
+++ b/src/common/turb/mode_turb_ver_sv_corr.F90
@@ -1,12 +1,16 @@
-! ######spl
- SUBROUTINE TURB_VER_SV_CORR(KKA,KKU,KKL,KRR,KRRL,KRRI, &
+!MNH_LIC Copyright 2002-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 MODE_TURB_VER_SV_CORR
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE TURB_VER_SV_CORR(KKA,KKU,KKL,KRR,KRRL,KRRI,OOCEAN, &
PDZZ, &
PTHLM,PRM,PTHVREF, &
PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PPHI3,PPSI3, &
PWM,PSVM, &
PTKEM,PLM,PLEPS,PPSI_SV )
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ###############################################################
!
!
@@ -48,12 +52,16 @@
!* 0. DECLARATIONS
! ------------
!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
USE MODD_CST
USE MODD_CTURB
USE MODD_PARAMETERS
USE MODD_LES
USE MODD_CONF
USE MODD_NSV, ONLY : NSV,NSV_LGBEG,NSV_LGEND
+USE MODD_BLOWSNOW
!
!
USE MODI_GRADIENT_U
@@ -61,10 +69,12 @@ USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_GRADIENT_M
USE MODI_SHUMAN , ONLY : MZF
-USE MODI_EMOIST
-USE MODI_ETHETA
+USE MODE_EMOIST, ONLY: EMOIST
+USE MODE_ETHETA, ONLY: ETHETA
USE MODI_LES_MEAN_SUBGRID
!
+USE MODI_SECOND_MNH
+!
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -73,6 +83,7 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid var.
INTEGER, INTENT(IN) :: KRRI ! number of ice var.
@@ -104,6 +115,9 @@ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PPSI_SV ! Inv.Turb.Sch.for scalars
!
REAL, DIMENSION(SIZE(PSVM,1),SIZE(PSVM,2),SIZE(PSVM,3)) :: &
ZA, ZFLXZ
+!
+REAL :: ZCSV !constant for the scalar flux
+!
INTEGER :: JSV ! loop counters
!
REAL :: ZTIME1, ZTIME2
@@ -117,6 +131,13 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('TURB_VER_SV_CORR',0,ZHOOK_HANDLE)
CALL SECOND_MNH(ZTIME1)
!
+IF(LBLOWSNOW) THEN
+! See Vionnet (PhD, 2012) for a complete discussion around the value of the Schmidt number for blowing snow variables
+ ZCSV= XCHF/XRSNOW
+ELSE
+ ZCSV= XCHF
+ENDIF
+!
DO JSV=1,NSV
!
IF (LNOMIXLG .AND. JSV >= NSV_LGBEG .AND. JSV<= NSV_LGEND) CYCLE
@@ -125,8 +146,8 @@ DO JSV=1,NSV
!
IF (LLES_CALL) THEN
! approximation: diagnosed explicitely (without implicit term)
- ZFLXZ(:,:,:) = PPSI_SV(:,:,:,JSV)*GZ_M_W(PSVM(:,:,:,JSV),PDZZ, KKA, KKU, KKL)**2
- ZFLXZ(:,:,:) = XCHF / ZCSVD * PLM * PLEPS * MZF(ZFLXZ(:,:,:), KKA, KKU, KKL)
+ ZFLXZ(:,:,:) = PPSI_SV(:,:,:,JSV)*GZ_M_W(KKA, KKU, KKL,PSVM(:,:,:,JSV),PDZZ)**2
+ ZFLXZ(:,:,:) = ZCSV / ZCSVD * PLM * PLEPS * MZF(ZFLXZ(:,:,:), KKA, KKU, KKL)
CALL LES_MEAN_SUBGRID(-2.*ZCSVD*SQRT(PTKEM)*ZFLXZ/PLEPS, X_LES_SUBGRID_DISS_Sv2(:,:,:,JSV) )
CALL LES_MEAN_SUBGRID(MZF(PWM, KKA, KKU, KKL)*ZFLXZ, X_LES_RES_W_SBG_Sv2(:,:,:,JSV) )
END IF
@@ -135,19 +156,19 @@ DO JSV=1,NSV
!
IF (LLES_CALL) THEN
! approximation: diagnosed explicitely (without implicit term)
- ZA(:,:,:) = ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM)
- ZFLXZ(:,:,:)= ( XCSHF * PPHI3 + XCHF * PPSI_SV(:,:,:,JSV) ) &
- * GZ_M_W(PTHLM,PDZZ, KKA, KKU, KKL) &
- * GZ_M_W(PSVM(:,:,:,JSV),PDZZ, KKA, KKU, KKL)
+ ZA(:,:,:) = ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM,OOCEAN)
+ ZFLXZ(:,:,:)= ( XCSHF * PPHI3 + ZCSV * PPSI_SV(:,:,:,JSV) ) &
+ * GZ_M_W(KKA, KKU, KKL,PTHLM,PDZZ) &
+ * GZ_M_W(KKA, KKU, KKL,PSVM(:,:,:,JSV),PDZZ)
ZFLXZ(:,:,:)= PLM * PLEPS / (2.*ZCTSVD) * MZF(ZFLXZ, KKA, KKU, KKL)
CALL LES_MEAN_SUBGRID( ZA*ZFLXZ, X_LES_SUBGRID_SvThv(:,:,:,JSV) )
CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLXZ, X_LES_SUBGRID_SvPz(:,:,:,JSV), .TRUE.)
!
IF (KRR>=1) THEN
- ZA(:,:,:) = EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM)
- ZFLXZ(:,:,:)= ( XCHF * PPSI3 + XCHF * PPSI_SV(:,:,:,JSV) ) &
- * GZ_M_W(PRM(:,:,:,1),PDZZ, KKA, KKU, KKL) &
- * GZ_M_W(PSVM(:,:,:,JSV),PDZZ, KKA, KKU, KKL)
+ ZA(:,:,:) = EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM,OOCEAN)
+ ZFLXZ(:,:,:)= ( ZCSV * PPSI3 + ZCSV * PPSI_SV(:,:,:,JSV) ) &
+ * GZ_M_W(KKA, KKU, KKL,PRM(:,:,:,1),PDZZ) &
+ * GZ_M_W(KKA, KKU, KKL,PSVM(:,:,:,JSV),PDZZ)
ZFLXZ(:,:,:)= PLM * PLEPS / (2.*ZCQSVD) * MZF(ZFLXZ, KKA, KKU, KKL)
CALL LES_MEAN_SUBGRID( ZA*ZFLXZ, X_LES_SUBGRID_SvThv(:,:,:,JSV) , .TRUE.)
CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLXZ, X_LES_SUBGRID_SvPz(:,:,:,JSV), .TRUE.)
@@ -162,3 +183,4 @@ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
!
IF (LHOOK) CALL DR_HOOK('TURB_VER_SV_CORR',1,ZHOOK_HANDLE)
END SUBROUTINE TURB_VER_SV_CORR
+END MODULE MODE_TURB_VER_SV_CORR
diff --git a/src/arome/turb/turb_ver_sv_flux.F90 b/src/common/turb/mode_turb_ver_sv_flux.F90
similarity index 84%
rename from src/arome/turb/turb_ver_sv_flux.F90
rename to src/common/turb/mode_turb_ver_sv_flux.F90
index d19712dc51381e9a0f56ace65d0f65e95bdb98dc..271ee734e6aabd3d2cda09b7eba343113fa6e402 100644
--- a/src/arome/turb/turb_ver_sv_flux.F90
+++ b/src/common/turb/mode_turb_ver_sv_flux.F90
@@ -1,9 +1,15 @@
-! ######spl
- SUBROUTINE TURB_VER_SV_FLUX(KKA,KKU,KKL, &
- OCLOSE_OUT,OTURB_FLX,HTURBDIM, &
+!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 MODE_TURB_VER_SV_FLUX
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE TURB_VER_SV_FLUX(KKA,KKU,KKL, &
+ OTURB_FLX,HTURBDIM, &
PIMPL,PEXPL, &
PTSTEP, &
- HFMFILE,HLUOUT, &
+ TPFILE, &
PDZZ,PDIRCOSZW, &
PRHODJ,PWM, &
PSFSVM,PSFSVP, &
@@ -11,10 +17,6 @@
PTKEM,PLM,MFMOIST,PPSI_SV, &
PRSVS,PWSV )
!
-
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
- USE MODD_CTURB, ONLY : LHARAT
!
!
!!**** *TURB_VER_SV_FLUX* -compute the source terms due to the vertical turbulent
@@ -111,10 +113,10 @@
!! DXF,DYF,DZF,DZM
!! : Shuman functions (difference operators)
!!
-!! SUBROUTINE TRIDIAG : to compute the splitted implicit evolution
+!! SUBROUTINE TRIDIAG : to compute the split implicit evolution
!! of a variable located at a mass point
!!
-!! SUBROUTINE TRIDIAG_WIND: to compute the splitted implicit evolution
+!! SUBROUTINE TRIDIAG_WIND: to compute the split implicit evolution
!! of a variable located at a wind point
!!
!! FUNCTIONs ETHETA and EMOIST :
@@ -195,31 +197,42 @@
!! change of YCOMMENT
!! Feb 2012(Y. Seity) add possibility to run with reversed
!! vertical levels
-!! Modifications: July 2015 (Wim de Rooy) LHARATU switch
+!! Modifications: July 2015 (Wim de Rooy) LHARAT switch
+!! Feb 2017(M. Leriche) add initialisation of ZSOURCE
+!! to avoid unknwon values outside physical domain
+!! and avoid negative values in sv tendencies
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!!--------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
USE MODD_CST
USE MODD_CTURB
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_LES
USE MODD_CONF
-USE MODD_NSV, ONLY : NSV_LGBEG,NSV_LGEND
+USE MODD_NSV, ONLY: XSVMIN, NSV_LGBEG, NSV_LGEND
+USE MODD_BLOWSNOW
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE
!
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_GRADIENT_M
USE MODI_SHUMAN , ONLY : DZM, MZM, MZF
-USE MODI_TRIDIAG
-USE MODI_TRIDIAG_WIND
-USE MODI_EMOIST
-USE MODI_ETHETA
-USE MODE_FMWRIT
+USE MODE_TRIDIAG, ONLY: TRIDIAG
+USE MODE_EMOIST, ONLY: EMOIST
+USE MODE_ETHETA, ONLY: ETHETA
USE MODI_LES_MEAN_SUBGRID
!
+USE MODI_SECOND_MNH
+!
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -228,18 +241,13 @@ IMPLICIT NONE
INTEGER, INTENT(IN) :: KKA !near ground array index
INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
-CHARACTER*4, INTENT(IN) :: HTURBDIM ! dimensionality of the
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
! turbulence scheme
REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
REAL, INTENT(IN) :: PTSTEP ! Double Time Step
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output
- ! FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ
! Metric coefficients
@@ -281,9 +289,6 @@ REAL, DIMENSION(SIZE(PSVM,1),SIZE(PSVM,2),SIZE(PSVM,3)) :: &
ZFLXZ, & ! vertical flux of the treated variable
ZSOURCE, & ! source of evolution for the treated variable
ZKEFF ! effectif diffusion coeff = LT * SQRT( TKE )
-INTEGER :: IRESP ! Return code of FM routines
-INTEGER :: IGRID ! C-grid indicator in LFIFM file
-INTEGER :: ILENCH ! Length of comment string in LFIFM file
INTEGER :: IKB,IKE ! I index values for the Beginning and End
! mass points of the domain in the 3 direct.
INTEGER :: IKT ! array size in k direction
@@ -291,12 +296,13 @@ INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
INTEGER :: JSV ! loop counters
INTEGER :: JK ! loop
INTEGER :: ISV ! number of scalar var.
-CHARACTER (LEN=100) :: YCOMMENT ! comment string in LFIFM file
-CHARACTER (LEN=16) :: YRECFM ! Name of the desired field in LFIFM file
!
REAL :: ZTIME1, ZTIME2
REAL :: ZCSVP = 4.0 ! constant for scalar flux presso-correlation (RS81)
+REAL :: ZCSV !constant for the scalar flux
+!
+TYPE(TFIELDDATA) :: TZFIELD
!----------------------------------------------------------------------------
!
!* 1. PRELIMINARIES
@@ -314,12 +320,17 @@ IKTB =1+JPVEXT_TURB
ISV=SIZE(PSVM,4)
!
IF (LHARAT) THEN
-ZKEFF(:,:,:) = PLM(:,:,:) * SQRT(PTKEM(:,:,:)) + 50.*MFMOIST(:,:,:)
+ ZKEFF(:,:,:) = PLM(:,:,:) * SQRT(PTKEM(:,:,:)) + 50.*MFMOIST(:,:,:)
ELSE
-ZKEFF(:,:,:) = MZM(PLM(:,:,:) * SQRT(PTKEM(:,:,:)), KKA, KKU, KKL)
+ ZKEFF(:,:,:) = MZM(PLM(:,:,:) * SQRT(PTKEM(:,:,:)), KKA, KKU, KKL)
ENDIF
-
!
+IF(LBLOWSNOW) THEN
+! See Vionnet (PhD, 2012) for a complete discussion around the value of the Schmidt number for blowing snow variables
+ ZCSV= XCHF/XRSNOW
+ELSE
+ ZCSV= XCHF
+ENDIF
!----------------------------------------------------------------------------
!
!* 8. SOURCES OF PASSIVE SCALAR VARIABLES
@@ -330,15 +341,16 @@ DO JSV=1,ISV
IF (LNOMIXLG .AND. JSV >= NSV_LGBEG .AND. JSV<= NSV_LGEND) CYCLE
!
! Preparation of the arguments for TRIDIAG
-IF (LHARAT) THEN
- ZA(:,:,:) = -PTSTEP* &
- ZKEFF * MZM(PRHODJ, KKA, KKU, KKL) / &
- PDZZ**2
-ELSE
- ZA(:,:,:) = -PTSTEP*XCHF*PPSI_SV(:,:,:,JSV) * &
- ZKEFF * MZM(PRHODJ, KKA, KKU, KKL) / &
- PDZZ**2
-ENDIF
+ IF (LHARAT) THEN
+ ZA(:,:,:) = -PTSTEP* &
+ ZKEFF * MZM(PRHODJ, KKA, KKU, KKL) / &
+ PDZZ**2
+ ELSE
+ ZA(:,:,:) = -PTSTEP*ZCSV*PPSI_SV(:,:,:,JSV) * &
+ ZKEFF * MZM(PRHODJ, KKA, KKU, KKL) / &
+ PDZZ**2
+ ENDIF
+ ZSOURCE(:,:,:) = 0.
!
! Compute the sources for the JSVth scalar variable
@@ -359,17 +371,17 @@ ENDIF
ZSOURCE(:,:,IKTB+1:IKTE-1) = 0.
ZSOURCE(:,:,IKE) = 0.
!
-! Obtention of the splitted JSV scalar variable at t+ deltat
+! Obtention of the split JSV scalar variable at t+ deltat
CALL TRIDIAG(KKA,KKU,KKL,PSVM(:,:,:,JSV),ZA,PTSTEP,PEXPL,PIMPL,PRHODJ,ZSOURCE,ZRES)
!
! Compute the equivalent tendency for the JSV scalar variable
PRSVS(:,:,:,JSV)= PRSVS(:,:,:,JSV)+ &
PRHODJ(:,:,:)*(ZRES(:,:,:)-PSVM(:,:,:,JSV))/PTSTEP
!
- IF ( (OTURB_FLX .AND. OCLOSE_OUT) .OR. LLES_CALL ) THEN
+ IF ( (OTURB_FLX .AND. TPFILE%LOPENED) .OR. LLES_CALL ) THEN
! Diagnostic of the cartesian vertical flux
!
- ZFLXZ(:,:,:) = -XCHF * PPSI_SV(:,:,:,JSV) * MZM(PLM*SQRT(PTKEM), KKA, KKU, KKL) / PDZZ * &
+ ZFLXZ(:,:,:) = -ZCSV * PPSI_SV(:,:,:,JSV) * MZM(PLM*SQRT(PTKEM), KKA, KKU, KKL) / PDZZ * &
DZM(PIMPL*ZRES(:,:,:) + PEXPL*PSVM(:,:,:,JSV), KKA, KKU, KKL)
! surface flux
!* in 3DIM case, a part of the flux goes vertically, and another goes horizontally
@@ -393,23 +405,31 @@ ENDIF
PWSV(:,:,IKE,JSV)=PWSV(:,:,IKE-KKL,JSV)
END IF
!
- IF (OTURB_FLX .AND. OCLOSE_OUT) THEN
+ IF (OTURB_FLX .AND. TPFILE%LOPENED) THEN
! stores the JSVth vertical flux
- WRITE(YRECFM,'("WSV_FLX_",I3.3)') JSV
- YCOMMENT='X_Y_Z_'//YRECFM//' (SVUNIT*M/S)'
- IGRID = 4
- ILENCH=LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZFLXZ,IGRID,ILENCH,YCOMMENT,IRESP)
+ WRITE(TZFIELD%CMNHNAME,'("WSV_FLX_",I3.3)') JSV
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ !PW: TODO: use the correct units of the JSV variable (and multiply it by m s-1)
+ TZFIELD%CUNITS = 'SVUNIT m s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
END IF
!
! Storage in the LES configuration
-
+ !
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
CALL LES_MEAN_SUBGRID(MZF(ZFLXZ, KKA, KKU, KKL), X_LES_SUBGRID_WSv(:,:,:,JSV) )
CALL LES_MEAN_SUBGRID(GZ_W_M(PWM,PDZZ, KKA, KKU, KKL)*MZF(ZFLXZ, KKA, KKU, KKL), &
X_LES_RES_ddxa_W_SBG_UaSv(:,:,:,JSV) )
- CALL LES_MEAN_SUBGRID(MZF(GZ_M_W(PSVM(:,:,:,JSV),PDZZ, KKA, KKU, KKL)*ZFLXZ, KKA, KKU, KKL), &
+ CALL LES_MEAN_SUBGRID(MZF(GZ_M_W(KKA, KKU, KKL,PSVM(:,:,:,JSV),PDZZ)*ZFLXZ, KKA, KKU, KKL), &
X_LES_RES_ddxa_Sv_SBG_UaSv(:,:,:,JSV) )
CALL LES_MEAN_SUBGRID(-ZCSVP*SQRT(PTKEM)/PLM*MZF(ZFLXZ, KKA, KKU, KKL), X_LES_SUBGRID_SvPz(:,:,:,JSV) )
CALL LES_MEAN_SUBGRID(MZF(PWM*ZFLXZ, KKA, KKU, KKL), X_LES_RES_W_SBG_WSv(:,:,:,JSV) )
@@ -423,3 +443,4 @@ END DO ! end of scalar loop
!
IF (LHOOK) CALL DR_HOOK('TURB_VER_SV_FLUX',1,ZHOOK_HANDLE)
END SUBROUTINE TURB_VER_SV_FLUX
+END MODULE MODE_TURB_VER_SV_FLUX
diff --git a/src/arome/turb/turb_ver_thermo_corr.F90 b/src/common/turb/mode_turb_ver_thermo_corr.F90
similarity index 93%
rename from src/arome/turb/turb_ver_thermo_corr.F90
rename to src/common/turb/mode_turb_ver_thermo_corr.F90
index 1e343bb2705068a5d5dc6dd48f38c7a405b577ec..db08f0ce62947783ab09870fd2b49ff4d4245f2d 100644
--- a/src/arome/turb/turb_ver_thermo_corr.F90
+++ b/src/common/turb/mode_turb_ver_thermo_corr.F90
@@ -1,8 +1,14 @@
-! ######spl
- SUBROUTINE TURB_VER_THERMO_CORR(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- OCLOSE_OUT,OTURB_FLX,HTURBDIM,HTOM, &
+!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 MODE_TURB_VER_THERMO_CORR
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE TURB_VER_THERMO_CORR(KKA,KKU,KKL,KRR,KRRL,KRRI, &
+ OTURB_FLX,HTURBDIM,HTOM, &
PIMPL,PEXPL, &
- HFMFILE,HLUOUT, &
+ TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW, &
PRHODJ,PTHVREF, &
PSFTHM,PSFRM,PSFTHP,PSFRP, &
@@ -13,11 +19,7 @@
PRED2R3, PRED2THR3, PBLL_O_E, PETHETA, &
PEMOIST, PREDTH1, PREDR1, PPHI3, PPSI3, PD, &
PFWTH,PFWR,PFTH2,PFR2,PFTHR, &
- PTHLP,PRP,MFMOIST,PSIGS )
- USE PARKIND1, ONLY : JPRB
- USE YOMHOOK , ONLY : LHOOK, DR_HOOK
- USE MODD_CTURB, ONLY : LHARAT
-
+ PTHLP,PRP,MFMOIST,PSIGS )
! ###############################################################
!
!
@@ -115,12 +117,6 @@
!! DXF,DYF,DZF,DZM
!! : Shuman functions (difference operators)
!!
-!! SUBROUTINE TRIDIAG : to compute the splitted implicit evolution
-!! of a variable located at a mass point
-!!
-!! SUBROUTINE TRIDIAG_WIND: to compute the splitted implicit evolution
-!! of a variable located at a wind point
-!!
!! FUNCTIONs ETHETA and EMOIST :
!! allows to compute:
!! - the coefficients for the turbulent correlation between
@@ -147,7 +143,7 @@
!!
!! Module MODD_PARAMETERS
!!
-!! JPVEXT : number of vertical external points
+!! JPVEXT_TURB : number of vertical external points
!! JPHEXT : number of horizontal external points
!!
!!
@@ -199,14 +195,19 @@
!! change of YCOMMENT
!! 2012-02 (Y. Seity) add possibility to run with reversed
!! vertical levels
-!! Modifications July 2015 (Wim de Rooy) LHARATU switch
+!! Modifications July 2015 (Wim de Rooy) LHARAT switch
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!!--------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
USE MODD_CST
USE MODD_CTURB
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_CONF
USE MODD_LES
@@ -216,14 +217,13 @@ USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_GRADIENT_M
USE MODI_SHUMAN , ONLY : DZM, MZM, MZF
-USE MODI_TRIDIAG
-USE MODE_FMWRIT
USE MODI_LES_MEAN_SUBGRID
-USE MODI_PRANDTL
-USE MODI_TRIDIAG_THERMO
!
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_PRANDTL
!
+USE MODI_SECOND_MNH
+!
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -236,18 +236,13 @@ INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -
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.
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
-CHARACTER*4, INTENT(IN) :: HTURBDIM ! dimensionality of the
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
! turbulence scheme
-CHARACTER*4, INTENT(IN) :: HTOM ! type of Third Order Moment
+CHARACTER(len=4), INTENT(IN) :: HTOM ! type of Third Order Moment
REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output
- ! FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ, PDXX, PDYY, PDZX, PDZY
! Metric coefficients
@@ -349,7 +344,7 @@ LOGICAL :: GFWTH ! flag to use w'2th'
LOGICAL :: GFR2 ! flag to use w'r'2
LOGICAL :: GFWR ! flag to use w'2r'
LOGICAL :: GFTHR ! flag to use w'th'r'
-
+TYPE(TFIELDDATA) :: TZFIELD
!----------------------------------------------------------------------------
!
!* 1. PRELIMINARIES
@@ -513,12 +508,18 @@ ENDIF
!
!
! stores <THl THl>
- IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
- YRECFM ='THL_VVAR'
- YCOMMENT='X_Y_Z_THL_VVAR (KELVIN**2)'
- IGRID = 1
- ILENCH=LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZFLXZ,IGRID,ILENCH,YCOMMENT,IRESP)
+ IF ( OTURB_FLX .AND. TPFILE%LOPENED ) THEN
+ TZFIELD%CMNHNAME = 'THL_VVAR'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'THL_VVAR'
+ TZFIELD%CUNITS = 'K2'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_THL_VVAR'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
END IF
!
! and we store in LES configuration
@@ -674,12 +675,18 @@ ENDIF
2. * PATHETA(:,:,:) * PAMOIST(:,:,:) * ZFLXZ(:,:,:)
END IF
! stores <THl Rnp>
- IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
- YRECFM ='THLRCONS_VCOR'
- YCOMMENT='X_Y_Z_THLRCONS_VCOR (KELVIN*KG/KG)'
- IGRID = 1
- ILENCH=LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZFLXZ,IGRID,ILENCH,YCOMMENT,IRESP)
+ IF ( OTURB_FLX .AND. TPFILE%LOPENED ) THEN
+ TZFIELD%CMNHNAME = 'THLRCONS_VCOR'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'THLRCONS_VCOR'
+ TZFIELD%CUNITS = 'K kg kg-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_THLRCONS_VCOR'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
END IF
!
! and we store in LES configuration
@@ -801,12 +808,18 @@ ENDIF
PSIGS(:,:,:) = PSIGS(:,:,:) + PAMOIST(:,:,:) **2 * ZFLXZ(:,:,:)
END IF
! stores <Rnp Rnp>
- IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
- YRECFM ='RTOT_VVAR'
- YCOMMENT='X_Y_Z_RTOT_VVAR (KG/KG **2)'
- IGRID = 1
- ILENCH=LEN(YCOMMENT)
- CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZFLXZ,IGRID,ILENCH,YCOMMENT,IRESP)
+ IF ( OTURB_FLX .AND. TPFILE%LOPENED ) THEN
+ TZFIELD%CMNHNAME = 'RTOT_VVAR'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'RTOT_VVAR'
+ TZFIELD%CUNITS = 'kg2 kg-2'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_RTOT_VVAR'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
END IF
!
! and we store in LES configuration
@@ -831,8 +844,12 @@ ENDIF
! Extrapolate PSIGS at the ground and at the top
PSIGS(:,:,KKA) = PSIGS(:,:,IKB)
PSIGS(:,:,KKU) = PSIGS(:,:,IKE)
- PSIGS(:,:,:) = MAX (PSIGS(:,:,:) , 0.)
+#ifdef REPRO48
+ PSIGS(:,:,:) = MAX (PSIGS(:,:,:) , 0.)
PSIGS(:,:,:) = SQRT(PSIGS(:,:,:))
+#else
+ PSIGS(:,:,:) = SQRT( MAX (PSIGS(:,:,:) , 1.E-12) )
+#endif
END IF
!
@@ -842,3 +859,4 @@ ENDIF
!----------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('TURB_VER_THERMO_CORR',1,ZHOOK_HANDLE)
END SUBROUTINE TURB_VER_THERMO_CORR
+END MODULE MODE_TURB_VER_THERMO_CORR
diff --git a/src/mesonh/turb/turb_ver_thermo_flux.f90 b/src/common/turb/mode_turb_ver_thermo_flux.F90
similarity index 71%
rename from src/mesonh/turb/turb_ver_thermo_flux.f90
rename to src/common/turb/mode_turb_ver_thermo_flux.F90
index cf539984e7751f862a6251a3e80b048274740073..16c320423a0560bae32296ebfb4942442246c178 100644
--- a/src/mesonh/turb/turb_ver_thermo_flux.f90
+++ b/src/common/turb/mode_turb_ver_thermo_flux.F90
@@ -2,125 +2,12 @@
!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_TURB_VER_THERMO_FLUX
-! ####################
-!
-INTERFACE
-!
- SUBROUTINE TURB_VER_THERMO_FLUX(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- OTURB_FLX,HTURBDIM,HTOM, &
- PIMPL,PEXPL, &
- PTSTEP, &
- TPFILE, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
- PRHODJ,PTHVREF, &
- PSFTHM,PSFRM,PSFTHP,PSFRP, &
- PWM,PTHLM,PRM,PSVM, &
- PTKEM,PLM,PLEPS, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
- PBETA, PSQRT_TKE, PDTH_DZ, PDR_DZ, PRED2TH3, &
- PRED2R3, PRED2THR3, PBLL_O_E, PETHETA, &
- PEMOIST, PREDTH1, PREDR1, PPHI3, PPSI3, PD, &
- PFWTH,PFWR,PFTH2,PFR2,PFTHR,PBL_DEPTH, &
- PWTHV,PRTHLS,PRRS,PTHLP,PRP,PTP,PWTH,PWRC )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=AR O
-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.
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-CHARACTER(len=4), INTENT(IN) :: HTOM ! type of Third Order Moment
-REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
-REAL, INTENT(IN) :: PTSTEP ! Double Time Step
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ, PDXX, PDYY, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
- ! normal to the ground surface
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitudes
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state Virtual
- ! Potential Temperature
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM ! surface fluxes at time
-! ! t - deltat
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHP,PSFRP ! surface fluxes at time
-! ! t + deltat
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM
-! Vertical wind
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
-! potential temperature at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios
- ! at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Mixing ratios
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
- ! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFRAC_ICE ! ri fraction of rc+ri
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PBETA ! buoyancy coefficient
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE ! sqrt(e)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTH_DZ ! d(th)/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDR_DZ ! d(rt)/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2TH3 ! 3D Redeslperger number R*2_th
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2R3 ! 3D Redeslperger number R*2_r
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2THR3 ! 3D Redeslperger number R*2_thr
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E ! beta * Lk * Leps / tke
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA ! Coefficient for theta in theta_v computation
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST ! Coefficient for r in theta_v computation
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1 ! 1D Redelsperger number for Th
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1 ! 1D Redelsperger number for r
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3 ! Prandtl number for temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3 ! Prandtl number for vapor
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PD ! Denominator in Prandtl numbers
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWTH ! d(w'2th' )/dz (at flux point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWR ! d(w'2r' )/dz (at flux point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTH2 ! d(w'th'2 )/dz (at mass point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFR2 ! d(w'r'2 )/dz (at mass point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTHR ! d(w'th'r')/dz (at mass point)
-REAL, DIMENSION(:,:), INTENT(INOUT):: PBL_DEPTH ! BL depth
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTHV ! buoyancy flux
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHLS ! cumulated source for theta
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS ! cumulated source for rt
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHLP ! guess of thl at t+ deltat
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRP ! guess of r at t+ deltat
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTP ! Dynamic and thermal
- ! TKE production terms
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTH ! heat flux
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWRC ! cloud water flux
-!
-!
-END SUBROUTINE TURB_VER_THERMO_FLUX
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_VER_THERMO_FLUX
-!
-!
-! ###############################################################
- SUBROUTINE TURB_VER_THERMO_FLUX(KKA,KKU,KKL,KRR, KRRL, KRRI, &
- OTURB_FLX,HTURBDIM,HTOM, &
+MODULE MODE_TURB_VER_THERMO_FLUX
+IMPLICIT NONE
+CONTAINS
+
+SUBROUTINE TURB_VER_THERMO_FLUX(KKA,KKU,KKL,KRR,KRRL,KRRI, &
+ OTURB_FLX,HTURBDIM,HTOM,OOCEAN, &
PIMPL,PEXPL, &
PTSTEP, &
TPFILE, &
@@ -133,7 +20,7 @@ END MODULE MODI_TURB_VER_THERMO_FLUX
PBETA, PSQRT_TKE, PDTH_DZ, PDR_DZ, PRED2TH3, &
PRED2R3, PRED2THR3, PBLL_O_E, PETHETA, &
PEMOIST, PREDTH1, PREDR1, PPHI3, PPSI3, PD, &
- PFWTH,PFWR,PFTH2,PFR2,PFTHR,PBL_DEPTH, &
+ PFWTH,PFWR,PFTH2,PFR2,PFTHR,MFMOIST,PBL_DEPTH,&
PWTHV,PRTHLS,PRRS,PTHLP,PRP,PTP,PWTH,PWRC )
! ###############################################################
!
@@ -322,6 +209,7 @@ END MODULE MODI_TURB_VER_THERMO_FLUX
!! change of YCOMMENT
!! 2012-02 (Y. Seity) add possibility to run with reversed
!! vertical levels
+!! Modifications July 2015 (Wim de Rooy) LHARAT switch
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! 2021 (D. Ricard) last version of HGRAD turbulence scheme
!! Leronard terms instead of Reynolds terms
@@ -336,9 +224,13 @@ END MODULE MODI_TURB_VER_THERMO_FLUX
!* 0. DECLARATIONS
! ------------
!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
USE MODD_CST
+USE MODD_CONF, ONLY: CPROGRAM
USE MODD_CTURB
-use modd_field, only: tfielddata, TYPEREAL
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODD_GRID_n, ONLY: XZS, XXHAT, XYHAT
USE MODD_IO, ONLY: TFILEDATA
USE MODD_METRICS_n, ONLY: XDXX, XDYY, XDZX, XDZY, XDZZ
@@ -347,7 +239,6 @@ USE MODD_TURB_n, ONLY: LHGRAD, XCOEFHGRADTHL, XCOEFHGRADRM, XALTHGRAD, X
USE MODD_CONF
USE MODD_LES
USE MODD_DIM_n
-USE MODD_DYN_n, ONLY: LOCEAN
USE MODD_OCEANH
USE MODD_REF, ONLY: LCOUPLES
USE MODD_TURB_n
@@ -357,17 +248,13 @@ USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_GRADIENT_M
-USE MODI_GRADIENT_UV
-USE MODI_GRADIENT_UW
-USE MODI_GRADIENT_VW
-USE MODI_SHUMAN
-USE MODI_TRIDIAG
+USE MODI_SHUMAN , ONLY : DZF, DZM, MZF, MZM, MYF, MXF
+USE MODE_TRIDIAG, ONLY: TRIDIAG
USE MODI_LES_MEAN_SUBGRID
-USE MODI_PRANDTL
-USE MODI_TRIDIAG_THERMO
-USE MODI_TM06_H
+USE MODE_TRIDIAG_THERMO, ONLY: TRIDIAG_THERMO
+USE MODE_TM06_H, ONLY: TM06_H
!
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE
USE MODE_PRANDTL
!
USE MODI_SECOND_MNH
@@ -388,6 +275,7 @@ INTEGER, INTENT(IN) :: KRRL ! number of liquid water v
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
! turbulence scheme
CHARACTER(len=4), INTENT(IN) :: HTOM ! type of Third Order Moment
@@ -402,6 +290,7 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitudes
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
+REAL, DIMENSION(:,:,:), INTENT(IN) :: MFMOIST ! moist mass flux dual scheme
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state Virtual
! Potential Temperature
!
@@ -420,6 +309,8 @@ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Mixing ratios
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
+!
+! In case LHARAT=TRUE, PLM already includes all stability corrections
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
@@ -475,7 +366,7 @@ REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
ZDFDDTDZ, & ! dF/d(dTh/dz)
ZDFDDRDZ, & ! dF/d(dr/dz)
Z3RDMOMENT,& ! 3 order term in flux or variance equation
- ZF_NEW, &
+ ZF_LEONARD,& ! Leonard terms
ZRWTHL, &
ZRWRNP, &
ZCLD_THOLD
@@ -488,7 +379,6 @@ INTEGER :: IKT ! array size in k direction
INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
INTEGER :: JI, JJ ! loop indexes
!
-!
INTEGER :: IIB,IJB ! Lower bounds of the physical
! sub-domain in x and y directions
INTEGER :: IIE,IJE ! Upper bounds of the physical
@@ -500,17 +390,14 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZYHAT_ll ! Position y in the conformal
! plane (array on the complete domain)
!
!
-CHARACTER (LEN=100) :: YCOMMENT ! comment string in LFIFM file
-CHARACTER (LEN=LEN_HREC) :: YRECFM ! Name of the desired field in LFIFM file
-!
REAL :: ZTIME1, ZTIME2
REAL :: ZDELTAX
-REAL :: ZXBEG,ZXEND,ZYBEG,ZYEND ! Forcing size for ocean deep convection
+REAL :: ZXBEG,ZXEND,ZYBEG,ZYEND ! Forcing size for ocean deep convection
REAL, DIMENSION(SIZE(XXHAT),SIZE(XYHAT)) :: ZDIST ! distance
! from the center of the cooling
REAL :: ZFLPROV
INTEGER :: JKM ! vertical index loop
-INTEGER :: JSW
+INTEGER :: JSW
REAL :: ZSWA ! index for time flux interpolation
!
INTEGER :: IIU, IJU
@@ -527,13 +414,17 @@ TYPE(TFIELDDATA) :: TZFIELD
!
!* 1. PRELIMINARIES
! -------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('TURB_VER_THERMO_FLUX',0,ZHOOK_HANDLE)
+!
! Size for a given proc & a given model
IIU=SIZE(PTHLM,1)
IJU=SIZE(PTHLM,2)
!
!! Compute Shape of sfc flux for Oceanic Deep Conv Case
!
-IF (LOCEAN .AND. LDEEPOC) THEN
+IF (OOCEAN .AND. LDEEPOC) THEN
!* 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 )
@@ -542,7 +433,7 @@ IF (LOCEAN .AND. LDEEPOC) THEN
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)
- CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE,IIU,IJU)
DO JJ = IJB,IJE
DO JI = IIB,IIE
ZDIST(JI,JJ) = SQRT( &
@@ -569,9 +460,14 @@ GUSERV = (KRR/=0)
! compute the coefficients for the uncentred gradient computation near the
! ground
!
-ZKEFF(:,:,:) = MZM( PLM(:,:,:) * SQRT(PTKEM(:,:,:)) )
+IF (LHARAT) THEN
+! LHARAT so TKE and length scales at half levels!
+ ZKEFF(:,:,:) = PLM(:,:,:) * SQRT(PTKEM(:,:,:)) +50.*MFMOIST(:,:,:)
+ELSE
+ ZKEFF(:,:,:) = MZM(PLM(:,:,:) * SQRT(PTKEM(:,:,:)), KKA, KKU, KKL)
+ENDIF
!
-! define a cloud mask with ri and rc (used after with a threshold) for Leonard terms
+! Define a cloud mask with ri and rc (used after with a threshold) for Leonard terms
!
IF(LHGRAD) THEN
IF ( KRRL >= 1 ) THEN
@@ -608,27 +504,32 @@ END IF
!
! Compute the turbulent flux F and F' at time t-dt.
!
-ZF (:,:,:) = -XCSHF*PPHI3*ZKEFF*DZM(PTHLM)/PDZZ
-ZDFDDTDZ(:,:,:) = -XCSHF*ZKEFF*D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,GUSERV)
+IF (LHARAT) THEN
+ ZF (:,:,:) = -ZKEFF*DZM(PTHLM, KKA, KKU, KKL)/PDZZ
+ ZDFDDTDZ(:,:,:) = -ZKEFF
+ELSE
+ ZF (:,:,:) = -XCSHF*PPHI3*ZKEFF*DZM(PTHLM, KKA, KKU, KKL)/PDZZ
+ ZDFDDTDZ(:,:,:) = -XCSHF*ZKEFF*D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,GUSERV)
+END IF
!
IF (LHGRAD) THEN
! Compute the Leonard terms for thl
ZDELTAX= XXHAT(3) - XXHAT(2)
- ZF_NEW (:,:,:)= XCOEFHGRADTHL*ZDELTAX*ZDELTAX/12.0*( &
- MXF(GX_W_UW(PWM(:,:,:), XDXX, XDZZ, XDZX))&
- *MZM(GX_M_M(PTHLM(:,:,:),XDXX,XDZZ,XDZX)) &
- + MYF(GY_W_VW(PWM(:,:,:), XDYY,XDZZ,XDZY)) &
- *MZM(GY_M_M(PTHLM(:,:,:),XDYY,XDZZ,XDZY)) )
+ ZF_LEONARD (:,:,:)= XCOEFHGRADTHL*ZDELTAX*ZDELTAX/12.0*( &
+ MXF(GX_W_UW(PWM(:,:,:), XDXX,XDZZ,XDZX,KKA,KKU,KKL))&
+ *MZM(GX_M_M(PTHLM(:,:,:),XDXX,XDZZ,XDZX,KKA, KKU, KKL), KKA, KKU, KKL) &
+ + MYF(GY_W_VW(PWM(:,:,:), XDYY,XDZZ,XDZY,KKA,KKU,KKL)) &
+ *MZM(GY_M_M(PTHLM(:,:,:),XDYY,XDZZ,XDZY,KKA, KKU, KKL), KKA, KKU, KKL) )
END IF
!
! Effect of 3rd order terms in temperature flux (at flux point)
!
! d(w'2th')/dz
IF (GFWTH) THEN
- Z3RDMOMENT= M3_WTH_W2TH(PREDTH1,PREDR1,PD,ZKEFF,PTKEM)
+ Z3RDMOMENT= M3_WTH_W2TH(KKA,KKU,KKL,PREDTH1,PREDR1,PD,ZKEFF,PTKEM)
!
ZF = ZF + Z3RDMOMENT * PFWTH
- ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_W2TH_O_DDTDZ(PREDTH1,PREDR1,&
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
& PD,PBLL_O_E,PETHETA,ZKEFF,PTKEM) * PFWTH
END IF
!
@@ -636,39 +537,39 @@ END IF
IF (GFTH2) THEN
Z3RDMOMENT= M3_WTH_WTH2(PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA)
!
- ZF = ZF + Z3RDMOMENT * MZM(PFTH2)
+ ZF = ZF + Z3RDMOMENT * MZM(PFTH2, KKA, KKU, KKL)
ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_WTH2_O_DDTDZ(Z3RDMOMENT,PREDTH1,PREDR1,&
- & PD,PBLL_O_E,PETHETA) * MZM(PFTH2)
+ & PD,PBLL_O_E,PETHETA) * MZM(PFTH2, KKA, KKU, KKL)
END IF
!
! d(w'2r')/dz
IF (GFWR) THEN
- ZF = ZF + M3_WTH_W2R(PD,ZKEFF,&
+ ZF = ZF + M3_WTH_W2R(KKA,KKU,KKL,PD,ZKEFF,&
& PTKEM,PBLL_O_E,PEMOIST,PDTH_DZ) * PFWR
- ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_W2R_O_DDTDZ(PREDTH1,PREDR1,&
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_W2R_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
& PD,ZKEFF,PTKEM,PBLL_O_E,PEMOIST) * PFWR
END IF
!
! d(w'r'2)/dz
IF (GFR2) THEN
- ZF = ZF + M3_WTH_WR2(PD,ZKEFF,PTKEM,&
- & PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTH_DZ) * MZM(PFR2)
- ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_WR2_O_DDTDZ(PREDTH1,PREDR1,PD,&
- & ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST) * MZM(PFR2)
+ ZF = ZF + M3_WTH_WR2(KKA,KKU,KKL,PD,ZKEFF,PTKEM,&
+ & PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTH_DZ) * MZM(PFR2, KKA, KKU, KKL)
+ ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_WR2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,&
+ & ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST) * MZM(PFR2, KKA, KKU, KKL)
END IF
!
! d(w'th'r')/dz
IF (GFTHR) THEN
- Z3RDMOMENT= M3_WTH_WTHR(PREDR1,PD,ZKEFF,PTKEM,PSQRT_TKE,PBETA,&
+ Z3RDMOMENT= M3_WTH_WTHR(KKA,KKU,KKL,PREDR1,PD,ZKEFF,PTKEM,PSQRT_TKE,PBETA,&
& PLEPS,PEMOIST)
!
- ZF = ZF + Z3RDMOMENT * MZM(PFTHR)
+ ZF = ZF + Z3RDMOMENT * MZM(PFTHR, KKA, KKU, KKL)
ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_WTHR_O_DDTDZ(Z3RDMOMENT,PREDTH1,&
- & PREDR1,PD,PBLL_O_E,PETHETA) * MZM(PFTHR)
+ & PREDR1,PD,PBLL_O_E,PETHETA) * MZM(PFTHR, KKA, KKU, KKL)
END IF
! compute interface flux
IF (LCOUPLES) THEN ! Autocoupling O-A LES
- IF (LOCEAN) THEN ! ocean model in coupled case
+ IF (OOCEAN) THEN ! ocean model in coupled case
ZF(:,:,IKE) = (XSSTFL_C(:,:,1)+XSSRFL_C(:,:,1)) &
*0.5* ( 1. + PRHODJ(:,:,KKU)/PRHODJ(:,:,IKE) )
ELSE ! atmosph model in coupled case
@@ -691,11 +592,14 @@ ELSE ! No coupling O and A cases
* 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
END IF
!
- IF (LOCEAN) THEN
+ IF (OOCEAN) THEN
ZF(:,:,IKE) = XSSTFL(:,:) *0.5*(1. + PRHODJ(:,:,KKU) / PRHODJ(:,:,IKE))
ELSE !end ocean case (in nocoupled case)
! atmos top
- ZF(:,:,IKE)=0.
+#ifdef REPRO48
+#else
+ ZF(:,:,IKE)=0.
+#endif
END IF
END IF !end no coupled cases
!
@@ -712,7 +616,8 @@ IF (LHGRAD) THEN
ZALT(:,:,JK) = PZZ(:,:,JK)-XZS(:,:)
END DO
WHERE ( (ZCLD_THOLD(:,:,:) >= XCLDTHOLD) .AND. ( ZALT(:,:,:) >= XALTHGRAD) )
- ZRWTHL(:,:,:) = -GZ_W_M(MZM(PRHODJ(:,:,:))*ZF_NEW(:,:,:),XDZZ)
+ ZRWTHL(:,:,:) = -GZ_W_M(MZM(PRHODJ(:,:,:), KKA, KKU, KKL)*ZF_LEONARD(:,:,:),XDZZ,&
+ KKA, KKU, KKL)
END WHERE
END IF
!
@@ -723,16 +628,16 @@ PRTHLS(:,:,:)= PRTHLS(:,:,:) + ZRWTHL(:,:,:)
! Conservative potential temperature flux :
!
ZFLXZ(:,:,:) = ZF &
- + PIMPL * ZDFDDTDZ * DZM(PTHLP - PTHLM) / PDZZ
+ + PIMPL * ZDFDDTDZ * DZM(PTHLP - PTHLM, KKA, KKU, KKL) / PDZZ
! replace the flux by the Leonard terms
IF (LHGRAD) THEN
WHERE ( (ZCLD_THOLD(:,:,:) >= XCLDTHOLD) .AND. ( ZALT(:,:,:) >= XALTHGRAD) )
- ZFLXZ(:,:,:) = ZF_NEW(:,:,:)
+ ZFLXZ(:,:,:) = ZF_LEONARD(:,:,:)
END WHERE
END IF
!
ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
-IF (LOCEAN) THEN
+IF (OOCEAN) THEN
ZFLXZ(:,:,KKU) = ZFLXZ(:,:,IKE)
END IF
!
@@ -742,16 +647,16 @@ END DO
!
PWTH(:,:,IKB)=0.5*(ZFLXZ(:,:,IKB)+ZFLXZ(:,:,IKB+KKL))
!
-IF (LOCEAN) THEN
+IF (OOCEAN) THEN
PWTH(:,:,IKE)=0.5*(ZFLXZ(:,:,IKE)+ZFLXZ(:,:,IKE+KKL))
PWTH(:,:,KKA)=0.
PWTH(:,:,KKU)=ZFLXZ(:,:,KKU)
ELSE
- PWTH(:,:,IKE)=PWTH(:,:,IKE-KKL)
PWTH(:,:,KKA)=0.5*(ZFLXZ(:,:,KKA)+ZFLXZ(:,:,KKA+KKL))
+ PWTH(:,:,IKE)=PWTH(:,:,IKE-KKL)
END IF
!
-IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+IF ( OTURB_FLX .AND. TPFILE%LOPENED ) THEN
! stores the conservative potential temperature vertical flux
TZFIELD%CMNHNAME = 'THW_FLX'
TZFIELD%CSTDNAME = ''
@@ -767,63 +672,65 @@ IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
END IF
!
! Contribution of the conservative temperature flux to the buoyancy flux
-IF (LOCEAN) THEN
- PTP(:,:,:)= XG*XALPHAOC * MZF(ZFLXZ )
+IF (OOCEAN) THEN
+ PTP(:,:,:)= XG*XALPHAOC * MZF(ZFLXZ,KKA, KKU, KKL )
ELSE
IF (KRR /= 0) THEN
- PTP(:,:,:) = PBETA * MZF( MZM(PETHETA) * ZFLXZ )
+ PTP(:,:,:) = PBETA * MZF( MZM(PETHETA,KKA, KKU, KKL) * ZFLXZ,KKA, KKU, KKL )
PTP(:,:,IKB)= PBETA(:,:,IKB) * PETHETA(:,:,IKB) * &
0.5 * ( ZFLXZ (:,:,IKB) + ZFLXZ (:,:,IKB+KKL) )
ELSE
- PTP(:,:,:)= PBETA * MZF( ZFLXZ )
+ PTP(:,:,:)= PBETA * MZF( ZFLXZ,KKA, KKU, KKL )
END IF
END IF
!
! Buoyancy flux at flux points
!
-PWTHV = MZM(PETHETA) * ZFLXZ
+PWTHV = MZM(PETHETA, KKA, KKU, KKL) * ZFLXZ
PWTHV(:,:,IKB) = PETHETA(:,:,IKB) * ZFLXZ(:,:,IKB)
!
-IF (LOCEAN) THEN
+IF (OOCEAN) THEN
! temperature contribution to Buy flux
PWTHV(:,:,IKE) = PETHETA(:,:,IKE) * ZFLXZ(:,:,IKE)
END IF
!* 2.3 Partial vertical divergence of the < Rc w > flux
-!
-IF ( KRRL >= 1 ) THEN
- IF ( KRRI >= 1 ) THEN
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
- PRHODJ*PATHETA*2.*PSRCM*DZF(ZFLXZ/PDZZ) &
- *(1.0-PFRAC_ICE(:,:,:))
- PRRS(:,:,:,4) = PRRS(:,:,:,4) - &
- PRHODJ*PATHETA*2.*PSRCM*DZF(ZFLXZ/PDZZ) &
- *PFRAC_ICE(:,:,:)
- ELSE
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
- PRHODJ*PATHETA*2.*PSRCM*DZF(ZFLXZ/PDZZ)
- END IF
+! Correction for qc and qi negative in AROME
+IF(CPROGRAM/='AROME ') THEN
+ IF ( KRRL >= 1 ) THEN
+ IF ( KRRI >= 1 ) THEN
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
+ PRHODJ*PATHETA*2.*PSRCM*DZF(ZFLXZ/PDZZ, KKA, KKU, KKL) &
+ *(1.0-PFRAC_ICE(:,:,:))
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) - &
+ PRHODJ*PATHETA*2.*PSRCM*DZF(ZFLXZ/PDZZ, KKA, KKU, KKL) &
+ *PFRAC_ICE(:,:,:)
+ ELSE
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
+ PRHODJ*PATHETA*2.*PSRCM*DZF(ZFLXZ/PDZZ, KKA, KKU, KKL)
+ END IF
+ END IF
END IF
!
!* 2.4 Storage in LES configuration
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(ZFLXZ), X_LES_SUBGRID_WThl )
- CALL LES_MEAN_SUBGRID( MZF(PWM*ZFLXZ), X_LES_RES_W_SBG_WThl )
- CALL LES_MEAN_SUBGRID( GZ_W_M(PWM,PDZZ)*MZF(ZFLXZ),&
+ CALL LES_MEAN_SUBGRID(MZF(ZFLXZ, KKA, KKU, KKL), X_LES_SUBGRID_WThl )
+ CALL LES_MEAN_SUBGRID(MZF(PWM*ZFLXZ, KKA, KKU, KKL), X_LES_RES_W_SBG_WThl )
+ CALL LES_MEAN_SUBGRID(GZ_W_M(PWM,PDZZ, KKA, KKU, KKL)*MZF(ZFLXZ, KKA, KKU, KKL),&
& X_LES_RES_ddxa_W_SBG_UaThl )
- CALL LES_MEAN_SUBGRID( MZF(PDTH_DZ*ZFLXZ), X_LES_RES_ddxa_Thl_SBG_UaThl )
- CALL LES_MEAN_SUBGRID( -XCTP*PSQRT_TKE/PLM*MZF(ZFLXZ), X_LES_SUBGRID_ThlPz )
- CALL LES_MEAN_SUBGRID( MZF(MZM(PETHETA)*ZFLXZ), X_LES_SUBGRID_WThv )
+ CALL LES_MEAN_SUBGRID(MZF(PDTH_DZ*ZFLXZ, KKA, KKU, KKL), X_LES_RES_ddxa_Thl_SBG_UaThl )
+ CALL LES_MEAN_SUBGRID(-XCTP*PSQRT_TKE/PLM*MZF(ZFLXZ, KKA, KKU, KKL), X_LES_SUBGRID_ThlPz )
+ CALL LES_MEAN_SUBGRID(MZF(MZM(PETHETA, KKA, KKU, KKL)*ZFLXZ, KKA, KKU, KKL), X_LES_SUBGRID_WThv )
IF (KRR>=1) THEN
- CALL LES_MEAN_SUBGRID( MZF(PDR_DZ*ZFLXZ), X_LES_RES_ddxa_Rt_SBG_UaThl )
+ CALL LES_MEAN_SUBGRID(MZF(PDR_DZ*ZFLXZ, KKA, KKU, KKL), X_LES_RES_ddxa_Rt_SBG_UaThl )
END IF
!* diagnostic of mixing coefficient for heat
- ZA = DZM(PTHLP)
+ ZA = DZM(PTHLP, KKA, KKU, KKL)
WHERE (ZA==0.) ZA=1.E-6
ZA = - ZFLXZ / ZA * PDZZ
ZA(:,:,IKB) = XCSHF*PPHI3(:,:,IKB)*ZKEFF(:,:,IKB)
- ZA = MZF( ZA )
+ ZA = MZF(ZA, KKA, KKU, KKL)
ZA = MIN(MAX(ZA,-1000.),1000.)
CALL LES_MEAN_SUBGRID( ZA, X_LES_SUBGRID_Kh )
!
@@ -848,27 +755,32 @@ IF (HTOM=='TM06') CALL TM06_H(IKB,IKTB,IKTE,PTSTEP,PZZ,ZFLXZ,PBL_DEPTH)
IF (KRR /= 0) THEN
! Compute the turbulent flux F and F' at time t-dt.
!
- ZF (:,:,:) = -XCSHF*PPSI3*ZKEFF*DZM(PRM(:,:,:,1))/PDZZ
+ IF (LHARAT) THEN
+ ZF (:,:,:) = -ZKEFF*DZM(PRM(:,:,:,1), KKA, KKU, KKL)/PDZZ
+ ZDFDDRDZ(:,:,:) = -ZKEFF
+ ELSE
+ ZF (:,:,:) = -XCSHF*PPSI3*ZKEFF*DZM(PRM(:,:,:,1), KKA, KKU, KKL)/PDZZ
ZDFDDRDZ(:,:,:) = -XCSHF*ZKEFF*D_PSI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,GUSERV)
+ ENDIF
!
! Compute Leonard Terms for Cloud mixing ratio
IF (LHGRAD) THEN
ZDELTAX= XXHAT(3) - XXHAT(2)
- ZF_NEW (:,:,:)= XCOEFHGRADRM*ZDELTAX*ZDELTAX/12.0*( &
- MXF(GX_W_UW(PWM(:,:,:), XDXX, XDZZ, XDZX)) &
- *MZM(GX_M_M(PRM(:,:,:,1),XDXX,XDZZ,XDZX)) &
- +MYF(GY_W_VW(PWM(:,:,:), XDYY,XDZZ,XDZY)) &
- *MZM(GY_M_M(PRM(:,:,:,1),XDYY,XDZZ,XDZY)) )
+ ZF_LEONARD (:,:,:)= XCOEFHGRADRM*ZDELTAX*ZDELTAX/12.0*( &
+ MXF(GX_W_UW(PWM(:,:,:), XDXX,XDZZ,XDZX,KKA,KKU,KKL)) &
+ *MZM(GX_M_M(PRM(:,:,:,1),XDXX,XDZZ,XDZX,KKA,KKU,KKL),KKA,KKU,KKL) &
+ +MYF(GY_W_VW(PWM(:,:,:), XDYY,XDZZ,XDZY,KKA,KKU,KKL)) &
+ *MZM(GY_M_M(PRM(:,:,:,1),XDYY,XDZZ,XDZY,KKA,KKU,KKL),KKA,KKU,KKL) )
END IF
!
! Effect of 3rd order terms in temperature flux (at flux point)
!
! d(w'2r')/dz
IF (GFWR) THEN
- Z3RDMOMENT= M3_WR_W2R(PREDR1,PREDTH1,PD,ZKEFF,PTKEM)
+ Z3RDMOMENT= M3_WR_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,ZKEFF,PTKEM)
!
ZF = ZF + Z3RDMOMENT * PFWR
- ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_W2R_O_DDRDZ(PREDR1,PREDTH1,PD,&
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,&
& PBLL_O_E,PEMOIST,ZKEFF,PTKEM) * PFWR
END IF
!
@@ -876,40 +788,40 @@ IF (KRR /= 0) THEN
IF (GFR2) THEN
Z3RDMOMENT= M3_WR_WR2(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
!
- ZF = ZF + Z3RDMOMENT * MZM(PFR2)
+ ZF = ZF + Z3RDMOMENT * MZM(PFR2, KKA, KKU, KKL)
ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_WR2_O_DDRDZ(Z3RDMOMENT,PREDR1,&
- & PREDTH1,PD,PBLL_O_E,PEMOIST) * MZM(PFR2)
+ & PREDTH1,PD,PBLL_O_E,PEMOIST) * MZM(PFR2, KKA, KKU, KKL)
END IF
!
! d(w'2th')/dz
IF (GFWTH) THEN
- ZF = ZF + M3_WR_W2TH(PD,ZKEFF,&
+ ZF = ZF + M3_WR_W2TH(KKA,KKU,KKL,PD,ZKEFF,&
& PTKEM,PBLL_O_E,PETHETA,PDR_DZ) * PFWTH
- ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_W2TH_O_DDRDZ(PREDR1,PREDTH1,&
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,&
& PD,ZKEFF,PTKEM,PBLL_O_E,PETHETA) * PFWTH
END IF
!
! d(w'th'2)/dz
IF (GFTH2) THEN
- ZF = ZF + M3_WR_WTH2(PD,ZKEFF,PTKEM,&
- & PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDR_DZ) * MZM(PFTH2)
- ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_WTH2_O_DDRDZ(PREDR1,PREDTH1,PD,&
- &ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA) * MZM(PFTH2)
+ ZF = ZF + M3_WR_WTH2(KKA,KKU,KKL,PD,ZKEFF,PTKEM,&
+ & PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDR_DZ) * MZM(PFTH2, KKA, KKU, KKL)
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,&
+ &ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA) * MZM(PFTH2, KKA, KKU, KKL)
END IF
!
! d(w'th'r')/dz
IF (GFTHR) THEN
- Z3RDMOMENT= M3_WR_WTHR(PREDTH1,PD,ZKEFF,PTKEM,PSQRT_TKE,PBETA,&
+ Z3RDMOMENT= M3_WR_WTHR(KKA,KKU,KKL,PREDTH1,PD,ZKEFF,PTKEM,PSQRT_TKE,PBETA,&
& PLEPS,PETHETA)
!
- ZF = ZF + Z3RDMOMENT * MZM(PFTHR)
- ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_WTHR_O_DDRDZ(Z3RDMOMENT,PREDR1, &
- & PREDTH1,PD,PBLL_O_E,PEMOIST) * MZM(PFTHR)
+ ZF = ZF + Z3RDMOMENT * MZM(PFTHR, KKA, KKU, KKL)
+ ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_WTHR_O_DDRDZ(KKA,KKU,KKL,Z3RDMOMENT,PREDR1, &
+ & PREDTH1,PD,PBLL_O_E,PEMOIST) * MZM(PFTHR, KKA, KKU, KKL)
END IF
!
! compute interface flux
IF (LCOUPLES) THEN ! coupling NH O-A
- IF (LOCEAN) THEN ! ocean model in coupled case
+ IF (OOCEAN) THEN ! ocean model in coupled case
! evap effect on salinity to be added later !!!
ZF(:,:,IKE) = 0.
ELSE ! atmosph model in coupled case
@@ -934,13 +846,16 @@ IF (KRR /= 0) THEN
* 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
END IF
!
- IF (LOCEAN) THEN
+ IF (OOCEAN) THEN
! General ocean case
! salinity/evap effect to be added later !!!!!
ZF(:,:,IKE) = 0.
ELSE !end ocean case (in nocoupled case)
! atmos top
- ZF(:,:,IKE)=0.
+#ifdef REPRO48
+#else
+ ZF(:,:,IKE)=0.
+#endif
END IF
END IF!end no coupled cases
! Compute the split conservative potential temperature at t+deltat
@@ -957,7 +872,7 @@ IF (KRR /= 0) THEN
ZALT(:,:,JK) = PZZ(:,:,JK)-XZS(:,:)
END DO
WHERE ( (ZCLD_THOLD(:,:,:) >= XCLDTHOLD ) .AND. ( ZALT(:,:,:) >= XALTHGRAD ) )
- ZRWRNP (:,:,:) = -GZ_W_M(MZM(PRHODJ(:,:,:))*ZF_NEW(:,:,:),XDZZ)
+ ZRWRNP (:,:,:) = -GZ_W_M(MZM(PRHODJ(:,:,:),KKA,KKU,KKL)*ZF_LEONARD(:,:,:),XDZZ,KKA,KKU,KKL)
END WHERE
END IF
!
@@ -968,12 +883,12 @@ IF (KRR /= 0) THEN
! cons. mixing ratio flux :
!
ZFLXZ(:,:,:) = ZF &
- + PIMPL * ZDFDDRDZ * DZM(PRP - PRM(:,:,:,1)) / PDZZ
+ + PIMPL * ZDFDDRDZ * DZM(PRP - PRM(:,:,:,1), KKA, KKU, KKL) / PDZZ
!
! replace the flux by the Leonard terms above ZALT and ZCLD_THOLD
IF (LHGRAD) THEN
WHERE ( (ZCLD_THOLD(:,:,:) >= XCLDTHOLD ) .AND. ( ZALT(:,:,:) >= XALTHGRAD ) )
- ZFLXZ(:,:,:) = ZF_NEW(:,:,:)
+ ZFLXZ(:,:,:) = ZF_LEONARD(:,:,:)
END WHERE
END IF
!
@@ -987,7 +902,7 @@ IF (KRR /= 0) THEN
PWRC(:,:,IKE)=PWRC(:,:,IKE-KKL)
!
!
- IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+ IF ( OTURB_FLX .AND. TPFILE%LOPENED ) THEN
! stores the conservative mixing ratio vertical flux
TZFIELD%CMNHNAME = 'RCONSW_FLX'
TZFIELD%CSTDNAME = ''
@@ -1003,10 +918,10 @@ IF (KRR /= 0) THEN
END IF
!
! Contribution of the conservative water flux to the Buoyancy flux
- IF (LOCEAN) THEN
- ZA(:,:,:)= -XG*XBETAOC * MZF(ZFLXZ )
+ IF (OOCEAN) THEN
+ ZA(:,:,:)= -XG*XBETAOC * MZF(ZFLXZ, KKA, KKU, KKL )
ELSE
- ZA(:,:,:) = PBETA * MZF( MZM(PEMOIST) * ZFLXZ )
+ ZA(:,:,:) = PBETA * MZF( MZM(PEMOIST, KKA, KKU, KKL) * ZFLXZ,KKA,KKU,KKL )
ZA(:,:,IKB) = PBETA(:,:,IKB) * PEMOIST(:,:,IKB) * &
0.5 * ( ZFLXZ (:,:,IKB) + ZFLXZ (:,:,IKB+KKL) )
PTP(:,:,:) = PTP(:,:,:) + ZA(:,:,:)
@@ -1014,40 +929,42 @@ IF (KRR /= 0) THEN
!
! Buoyancy flux at flux points
!
- PWTHV = PWTHV + MZM(PEMOIST) * ZFLXZ
+ PWTHV = PWTHV + MZM(PEMOIST, KKA, KKU, KKL) * ZFLXZ
PWTHV(:,:,IKB) = PWTHV(:,:,IKB) + PEMOIST(:,:,IKB) * ZFLXZ(:,:,IKB)
- IF (LOCEAN) THEN
+ IF (OOCEAN) THEN
PWTHV(:,:,IKE) = PWTHV(:,:,IKE) + PEMOIST(:,:,IKE)* ZFLXZ(:,:,IKE)
END IF
!
!* 3.3 Complete vertical divergence of the < Rc w > flux
-!
- IF ( KRRL >= 1 ) THEN
- IF ( KRRI >= 1 ) THEN
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
- PRHODJ*PAMOIST*2.*PSRCM*DZF(ZFLXZ/PDZZ ) &
- *(1.0-PFRAC_ICE(:,:,:))
- PRRS(:,:,:,4) = PRRS(:,:,:,4) - &
- PRHODJ*PAMOIST*2.*PSRCM*DZF(ZFLXZ/PDZZ ) &
- *PFRAC_ICE(:,:,:)
- ELSE
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
- PRHODJ*PAMOIST*2.*PSRCM*DZF(ZFLXZ/PDZZ )
- END IF
- END IF
+! Correction of qc and qi negative for AROME
+IF(CPROGRAM/='AROME ') THEN
+ IF ( KRRL >= 1 ) THEN
+ IF ( KRRI >= 1 ) THEN
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
+ PRHODJ*PAMOIST*2.*PSRCM*DZF(ZFLXZ/PDZZ,KKA,KKU,KKL ) &
+ *(1.0-PFRAC_ICE(:,:,:))
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) - &
+ PRHODJ*PAMOIST*2.*PSRCM*DZF(ZFLXZ/PDZZ,KKA,KKU,KKL ) &
+ *PFRAC_ICE(:,:,:)
+ ELSE
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
+ PRHODJ*PAMOIST*2.*PSRCM*DZF(ZFLXZ/PDZZ,KKA,KKU,KKL )
+ END IF
+ END IF
+END IF
!
!* 3.4 Storage in LES configuration
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(ZFLXZ), X_LES_SUBGRID_WRt )
- CALL LES_MEAN_SUBGRID( MZF(PWM*ZFLXZ), X_LES_RES_W_SBG_WRt )
- CALL LES_MEAN_SUBGRID( GZ_W_M(PWM,PDZZ)*MZF(ZFLXZ),&
+ CALL LES_MEAN_SUBGRID(MZF(ZFLXZ, KKA, KKU, KKL), X_LES_SUBGRID_WRt )
+ CALL LES_MEAN_SUBGRID(MZF(PWM*ZFLXZ, KKA, KKU, KKL), X_LES_RES_W_SBG_WRt )
+ CALL LES_MEAN_SUBGRID(GZ_W_M(PWM,PDZZ, KKA, KKU, KKL)*MZF(ZFLXZ, KKA, KKU, KKL),&
& X_LES_RES_ddxa_W_SBG_UaRt )
- CALL LES_MEAN_SUBGRID( MZF(PDTH_DZ*ZFLXZ), X_LES_RES_ddxa_Thl_SBG_UaRt )
- CALL LES_MEAN_SUBGRID( MZF(PDR_DZ*ZFLXZ), X_LES_RES_ddxa_Rt_SBG_UaRt )
- CALL LES_MEAN_SUBGRID( MZF(MZM(PEMOIST)*ZFLXZ), X_LES_SUBGRID_WThv , .TRUE. )
- CALL LES_MEAN_SUBGRID( -XCTP*PSQRT_TKE/PLM*MZF(ZFLXZ), X_LES_SUBGRID_RtPz )
+ CALL LES_MEAN_SUBGRID(MZF(PDTH_DZ*ZFLXZ, KKA, KKU, KKL), X_LES_RES_ddxa_Thl_SBG_UaRt )
+ CALL LES_MEAN_SUBGRID(MZF(PDR_DZ*ZFLXZ, KKA, KKU, KKL), X_LES_RES_ddxa_Rt_SBG_UaRt )
+ CALL LES_MEAN_SUBGRID(MZF(MZM(PEMOIST, KKA, KKU, KKL)*ZFLXZ, KKA, KKU, KKL), X_LES_SUBGRID_WThv , .TRUE. )
+ CALL LES_MEAN_SUBGRID(-XCTP*PSQRT_TKE/PLM*MZF(ZFLXZ, KKA, KKU, KKL), X_LES_SUBGRID_RtPz )
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
@@ -1063,21 +980,28 @@ END IF
!
!* 4.1 <w Rc>
!
-IF ( ((OTURB_FLX .AND. tpfile%lopened) .OR. LLES_CALL) .AND. (KRRL > 0) ) THEN
- !
- ! recover the Conservative potential temperature flux :
- ZA(:,:,:) = DZM(PIMPL * PTHLP + PEXPL * PTHLM) / PDZZ * &
- (-PPHI3*MZM(PLM*PSQRT_TKE)) * XCSHF
+IF ( ((OTURB_FLX .AND. TPFILE%LOPENED) .OR. LLES_CALL) .AND. (KRRL > 0) ) THEN
+!
+! recover the Conservative potential temperature flux :
+! With LHARAT is true tke and length scales at half levels
+! yet modify to use length scale and tke at half levels from vdfexcuhl
+ IF (LHARAT) THEN
+ ZA(:,:,:) = DZM(PIMPL * PTHLP + PEXPL * PTHLM, KKA, KKU, KKL) / PDZZ * &
+ (-PLM*PSQRT_TKE)
+ ELSE
+ ZA(:,:,:) = DZM(PIMPL * PTHLP + PEXPL * PTHLM, KKA, KKU, KKL) / PDZZ * &
+ (-PPHI3*MZM(PLM*PSQRT_TKE, KKA, KKU, KKL)) * XCSHF
+ ENDIF
ZA(:,:,IKB) = ( PIMPL*PSFTHP(:,:) + PEXPL*PSFTHM(:,:) ) &
* PDIRCOSZW(:,:)
!
! compute <w Rc>
- ZFLXZ(:,:,:) = MZM( PAMOIST * 2.* PSRCM ) * ZFLXZ(:,:,:) + &
- MZM( PATHETA * 2.* PSRCM ) * ZA(:,:,:)
+ ZFLXZ(:,:,:) = MZM(PAMOIST * 2.* PSRCM, KKA, KKU, KKL) * ZFLXZ(:,:,:) + &
+ MZM(PATHETA * 2.* PSRCM, KKA, KKU, KKL) * ZA(:,:,:)
ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
!
! store the liquid water mixing ratio vertical flux
- IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
+ IF ( OTURB_FLX .AND. TPFILE%LOPENED ) THEN
TZFIELD%CMNHNAME = 'RCW_FLX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'RCW_FLX'
@@ -1095,15 +1019,17 @@ IF ( ((OTURB_FLX .AND. tpfile%lopened) .OR. LLES_CALL) .AND. (KRRL > 0) ) THEN
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(ZFLXZ), X_LES_SUBGRID_WRc )
+ CALL LES_MEAN_SUBGRID( MZF(ZFLXZ, KKA, KKU, KKL), X_LES_SUBGRID_WRc )
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
!
END IF !end of <w Rc>
-IF (LOCEAN.AND.LDEEPOC) THEN
+IF (OOCEAN .AND. LDEEPOC) THEN
DEALLOCATE(ZXHAT_ll,ZYHAT_ll)
END IF
!
!----------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('TURB_VER_THERMO_FLUX',1,ZHOOK_HANDLE)
END SUBROUTINE TURB_VER_THERMO_FLUX
+END MODULE MODE_TURB_VER_THERMO_FLUX
diff --git a/src/common/turb/mode_update_lm.F90 b/src/common/turb/mode_update_lm.F90
new file mode 100644
index 0000000000000000000000000000000000000000..d5ab737b0b7d15fd55afbec372f9990a33654f2a
--- /dev/null
+++ b/src/common/turb/mode_update_lm.F90
@@ -0,0 +1,119 @@
+!MNH_LIC Copyright 2006-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 MODE_UPDATE_LM
+IMPLICIT NONE
+CONTAINS
+SUBROUTINE UPDATE_LM(HLBCX,HLBCY,PLM,PLEPS)
+! #################################################################
+!
+!!**** *UPDATE_LM* - routine to set external points for mixing length
+!!
+!! PURPOSE
+!! -------
+!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation (routine UPDATE_LM)
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original april 2006
+!! V.Masson : Exchange of East and North sides
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_CONF
+USE MODD_PARAMETERS
+!
+USE MODE_ll
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X boundary type
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y boundary type
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLM ! mixing length
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLEPS ! dissipative length
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: IIB ! First physical index in x direction
+INTEGER :: IJB ! First physical index in y direction
+INTEGER :: IIE ! last physical index in x direction
+INTEGER :: IJE ! last physical index in y direction
+INTEGER :: JI ! loop index
+!
+TYPE(LIST_ll), POINTER :: TZLM_ll ! list of fields to exchange
+INTEGER :: IINFO_ll ! return code of parallel routine
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE DIMENSIONS OF ARRAYS :
+! ----------------------------
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+NULLIFY(TZLM_ll)
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. UPDATE HALOs :
+! -------------
+!
+!
+!!$IF(NHALO == 1) THEN
+ CALL ADD3DFIELD_ll( TZLM_ll, PLM, 'UPDATE_LM::PLM' )
+ CALL ADD3DFIELD_ll( TZLM_ll, PLEPS, 'UPDATE_LM::PLEPS' )
+ CALL UPDATE_HALO_ll(TZLM_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZLM_ll)
+!!$END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. UPDATE EXTERNAL POINTS OF GLOBAL DOMAIN:
+! ---------------------------------------
+!
+IF ( HLBCX(1) /= "CYCL" .AND. LWEST_ll()) THEN
+ PLM (IIB-1,:,:) = PLM (IIB,:,:)
+ PLEPS(IIB-1,:,:) = PLEPS(IIB,:,:)
+END IF
+IF ( HLBCX(2) /= "CYCL" .AND. LEAST_ll()) THEN
+ PLM (IIE+1,:,:) = PLM (IIE,:,:)
+ PLEPS(IIE+1,:,:) = PLEPS(IIE,:,:)
+END IF
+IF ( HLBCY(1) /= "CYCL" .AND. LSOUTH_ll()) THEN
+ DO JI=1,SIZE(PLM,1)
+ PLM (JI,IJB-1,:) = PLM (JI,IJB,:)
+ PLEPS(JI,IJB-1,:) = PLEPS(JI,IJB,:)
+ END DO
+END IF
+IF ( HLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
+ DO JI=1,SIZE(PLM,1)
+ PLM (JI,IJE+1,:) = PLM (JI,IJE,:)
+ PLEPS(JI,IJE+1,:) = PLEPS(JI,IJE,:)
+ END DO
+END IF
+!-----------------------------------------------------------------------------
+END SUBROUTINE UPDATE_LM
+END MODULE MODE_UPDATE_LM
diff --git a/src/arome/turb/modi_les_mean_subgrid.F90 b/src/common/turb/modi_les_mean_subgrid.F90
similarity index 100%
rename from src/arome/turb/modi_les_mean_subgrid.F90
rename to src/common/turb/modi_les_mean_subgrid.F90
diff --git a/src/arome/turb/modi_turb.F90 b/src/common/turb/modi_turb.F90
similarity index 62%
rename from src/arome/turb/modi_turb.F90
rename to src/common/turb/modi_turb.F90
index 2a15db137e613a63a888128d9abfb866c0d3eed8..b2b57f334a08349e3a242d6428ddd63f5420922b 100644
--- a/src/arome/turb/modi_turb.F90
+++ b/src/common/turb/modi_turb.F90
@@ -5,30 +5,29 @@
INTERFACE
!
SUBROUTINE TURB(KKA, KKU, KKL, KMI,KRR,KRRL,KRRI,HLBCX,HLBCY, &
- & KSPLIT,KMODEL_CL, &
- & OCLOSE_OUT,OTURB_FLX,OTURB_DIAG,OSUBG_COND,ORMC01, &
- & HTURBDIM,HTURBLEN,HTOM,HTURBLEN_CL,HINST_SFU, &
- & HMF_UPDRAFT,PIMPL,PTSTEP_UVW, PTSTEP_MET,PTSTEP_SV, &
- & HFMFILE,HLUOUT,PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
+ & KSPLIT,KMODEL_CL, &
+ & OTURB_FLX,OTURB_DIAG,OSUBG_COND,ORMC01,OOCEAN, &
+ & HTURBDIM,HTURBLEN,HTOM,HTURBLEN_CL,HCLOUD, &
+ & PIMPL,PTSTEP,TPFILE, &
+ & PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
& PDIRCOSXW,PDIRCOSYW,PDIRCOSZW,PCOSSLOPE,PSINSLOPE, &
- & PRHODJ,PTHVREF,PRHODREF, &
+ & PRHODJ,PTHVREF, &
& PSFTH,PSFRV,PSFSV,PSFU,PSFV, &
- & PPABSM,PUM,PVM,PWM,PTKEM,PSVM,PSRCM, &
+ & PPABST,PUT,PVT,PWT,PTKET,PSVT,PSRCT, &
& PLENGTHM,PLENGTHH,MFMOIST, &
& PBL_DEPTH, PSBL_DEPTH, &
- & PUT,PVT,PWT,PCEI,PCEI_MIN,PCEI_MAX,PCOEF_AMPL_SAT, &
- & PTHLM,PRM, &
+ & PCEI,PCEI_MIN,PCEI_MAX,PCOEF_AMPL_SAT, &
+ & PTHLT,PRT, &
& PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS,PRTKES, &
- & PHGRAD,PSIGS, &
+ & PSIGS, &
+ & PFLXZTHVMF,PWTH,PWRC,PWSV,PDP,PTP,PTDIFF,PTDISS, &
+ & TBUDGETS, KBUDGETS, &
+ & PEDR,PLEM,PRTKEMS,PTPMF, &
& PDRUS_TURB,PDRVS_TURB, &
- & PDRTHLS_TURB,PDRRTS_TURB,PDRSVS_TURB, &
- & PFLXZTHVMF,PWTH,PWRC,PWSV,PDP,PTP,PTPMF,PTDIFF, &
- & PTDISS,PEDR,YDDDH,YDLDDH,YDMDDH)
-
+ & PDRTHLS_TURB,PDRRTS_TURB,PDRSVS_TURB )
!
-USE DDH_MIX, ONLY : TYP_DDH
-USE YOMLDDH, ONLY : TLDDH
-USE YOMMDDH, ONLY : TMDDH
+USE MODD_BUDGET, ONLY : TBUDGETDATA
+USE MODD_IO, ONLY : TFILEDATA
!
INTEGER, INTENT(IN) :: KKA !near ground array index
INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
@@ -38,11 +37,8 @@ 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.
CHARACTER(LEN=*),DIMENSION(:),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-CHARACTER(LEN=4),INTENT(IN) :: HMF_UPDRAFT ! Type of mass flux
INTEGER, INTENT(IN) :: KSPLIT ! number of time-splitting
INTEGER, INTENT(IN) :: KMODEL_CL ! model number for cloud mixing length
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
@@ -50,21 +46,16 @@ LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
LOGICAL, INTENT(IN) :: OSUBG_COND ! switch for SUBGrid
! CONDensation
LOGICAL, INTENT(IN) :: ORMC01 ! switch for RMC01 lengths in SBL
-CHARACTER*4 , INTENT(IN) :: HTURBDIM ! dimensionality of the
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
+CHARACTER(LEN=4) , INTENT(IN) :: HTURBDIM ! dimensionality of the
! turbulence scheme
-CHARACTER*4 , INTENT(IN) :: HTURBLEN ! kind of mixing length
-CHARACTER*4 , INTENT(IN) :: HTOM ! kind of Third Order Moment
-CHARACTER*4 , INTENT(IN) :: HTURBLEN_CL ! kind of cloud mixing length
-CHARACTER*1 , INTENT(IN) :: HINST_SFU ! temporal location of the
- ! surface friction flux
+CHARACTER(LEN=4) , INTENT(IN) :: HTURBLEN ! kind of mixing length
+CHARACTER(LEN=4) , INTENT(IN) :: HTOM ! kind of Third Order Moment
+CHARACTER(LEN=4) , INTENT(IN) :: HTURBLEN_CL ! kind of cloud mixing length
REAL, INTENT(IN) :: PIMPL ! degree of implicitness
-REAL, INTENT(IN) :: PTSTEP_UVW ! Dynamical timestep
-REAL, INTENT(IN) :: PTSTEP_MET ! Timestep for meteorological variables
-REAL, INTENT(IN) :: PTSTEP_SV ! Timestep for tracer variables
-CHARACTER(LEN=*), INTENT(IN) :: HFMFILE ! Name of the output
- ! FM-file
-CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
- ! model n
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
+REAL, INTENT(IN) :: PTSTEP ! Timestep
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file for MesoNH
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
! metric coefficients
@@ -81,8 +72,6 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: MFMOIST ! Moist mass flux DUal sch
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential
! Temperature of the reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! dry density of the
- ! reference state
!
REAL, DIMENSION(:,:), INTENT(IN) :: PSFTH,PSFRV, &
! normal surface fluxes of theta and Rv
@@ -92,17 +81,15 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSV
! normal surface fluxes of Scalar var.
!
! prognostic variables at t- deltat
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM ! wind components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! passive scal. var.
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! Second-order flux
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT,PWT ! wind components
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKET ! TKE
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! passive scal. var.
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCT ! Second-order flux
! s'rc'/2Sigma_s2 at time t-1 multiplied by Lambda_3
REAL, DIMENSION(:,:), INTENT(INOUT) :: PBL_DEPTH ! BL depth for TOMS
REAL, DIMENSION(:,:), INTENT(INOUT) :: PSBL_DEPTH ! SBL depth for RMC01
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT,PWT ! Wind at t
-!
! variables for cloud mixing length
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCEI ! Cloud Entrainment instability
! index to emphasize localy
@@ -111,8 +98,8 @@ REAL, INTENT(IN) :: PCEI_MIN ! minimum threshold for the instability index
REAL, INTENT(IN) :: PCEI_MAX ! maximum threshold for the instability index CEI
REAL, INTENT(IN) :: PCOEF_AMPL_SAT ! saturation of the amplification coefficient
! thermodynamical variables which are transformed in conservative var.
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHLM ! conservative pot. temp.
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRM ! water var. where
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHLT ! conservative pot. temp.
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT ! water var. where
! PRM(:,:,:,1) is the conservative mixing ratio
!
! sources of momentum, conservative potential temperature, Turb. Kin. Energy,
@@ -120,18 +107,18 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRM ! water var. where
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS,PRVS,PRWS,PRTHLS,PRTKES
! Source terms for all water kinds, PRRS(:,:,:,1) is used for the conservative
! mixing ratio
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
+REAL, DIMENSION(:,:,:), INTENT(IN),OPTIONAL :: PRTKEMS
! Source terms for all passive scalar variables
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
! Sigma_s at time t+1 : square root of the variance of the deviation to the
! saturation
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PHGRAD
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDRUS_TURB ! evolution of rhoJ*U by turbulence only
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDRVS_TURB ! evolution of rhoJ*V by turbulence only
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDRTHLS_TURB ! evolution of rhoJ*thl by turbulence only
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDRRTS_TURB ! evolution of rhoJ*rt by turbulence only
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PDRSVS_TURB ! evolution of rhoJ*Sv by turbulence only
+REAL, DIMENSION(:,:,:), INTENT(OUT),OPTIONAL :: PDRUS_TURB ! evolution of rhoJ*U by turbulence only
+REAL, DIMENSION(:,:,:), INTENT(OUT),OPTIONAL :: PDRVS_TURB ! evolution of rhoJ*V by turbulence only
+REAL, DIMENSION(:,:,:), INTENT(OUT),OPTIONAL :: PDRTHLS_TURB ! evolution of rhoJ*thl by turbulence only
+REAL, DIMENSION(:,:,:), INTENT(OUT),OPTIONAL :: PDRRTS_TURB ! evolution of rhoJ*rt by turbulence only
+REAL, DIMENSION(:,:,:,:), INTENT(OUT),OPTIONAL :: PDRSVS_TURB ! evolution of rhoJ*Sv by turbulence only
REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLXZTHVMF
! MF contribution for vert. turb. transport
! used in the buoy. prod. of TKE
@@ -140,20 +127,18 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWRC ! cloud water flux
REAL, DIMENSION(:,:,:,:),INTENT(OUT) :: PWSV ! scalar flux
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDP ! Dynamic TKE production
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTP ! Thermal TKE production
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTPMF ! Thermal TKE production
+REAL, DIMENSION(:,:,:), INTENT(OUT),OPTIONAL :: PTPMF ! Thermal TKE production
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTDIFF ! Diffusion TKE term
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTDISS ! Dissipation TKE term
-
-REAL, DIMENSION(:,:,:),INTENT(OUT) :: PEDR ! eddy dissipation rate
-
+!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLENGTHM
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLENGTHH
!
-
-TYPE(TYP_DDH), INTENT(INOUT) :: YDDDH
-TYPE(TLDDH), INTENT(IN) :: YDLDDH
-TYPE(TMDDH), INTENT(IN) :: YDMDDH
-
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT), OPTIONAL :: PEDR ! EDR
+REAL, DIMENSION(:,:,:), INTENT(OUT), OPTIONAL :: PLEM ! Mixing length
!
!-------------------------------------------------------------------------------
!
diff --git a/src/common/turb/shallow_mf.F90 b/src/common/turb/shallow_mf.F90
index 2cb9a26b638e41e40f9ade7f15cf79e38ccc3660..814869f50f9f33b5914a93c2779b8fddbaa4aa21 100644
--- a/src/common/turb/shallow_mf.F90
+++ b/src/common/turb/shallow_mf.F90
@@ -76,7 +76,7 @@ USE MODD_PARAMETERS, ONLY: JPVEXT
USE MODD_NEB, ONLY: NEB
USE MODD_PARAM_MFSHALL_n
-USE MODI_THL_RT_FROM_TH_R_MF
+USE MODE_THL_RT_FROM_TH_R_MF, ONLY: THL_RT_FROM_TH_R_MF
USE MODE_COMPUTE_UPDRAFT, ONLY: COMPUTE_UPDRAFT
USE MODE_COMPUTE_UPDRAFT_RHCJ10, ONLY: COMPUTE_UPDRAFT_RHCJ10
USE MODE_COMPUTE_UPDRAFT_RAHA, ONLY: COMPUTE_UPDRAFT_RAHA
@@ -236,7 +236,7 @@ ELSEIF (HMF_UPDRAFT == 'RHCJ') THEN
PZZ,PDZZ, &
PSFTH,PSFRV,PPABSM,PRHODREF, &
PUM,PVM,PTKEM, &
- PEXNM,PTHM,PRM(:,:,1),ZTHLM,ZRTM,PSVM, &
+ PTHM,PRM(:,:,1),ZTHLM,ZRTM,PSVM, &
PTHL_UP,PRT_UP,PRV_UP,PRC_UP,PRI_UP, &
PTHV_UP, PW_UP, PU_UP, PV_UP, ZSV_UP, &
PFRAC_UP,ZFRAC_ICE_UP,ZRSAT_UP,PEMF,PDETR,&
diff --git a/src/mesonh/turb/turb.f90 b/src/common/turb/turb.F90
similarity index 70%
rename from src/mesonh/turb/turb.f90
rename to src/common/turb/turb.F90
index 228241e2ce6e40965f1766ef2b8396210a08c4c9..5c0e60d3cf0f429bdaf89a8396f33f7c3eeb7379 100644
--- a/src/mesonh/turb/turb.f90
+++ b/src/common/turb/turb.F90
@@ -3,150 +3,26 @@
!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_TURB
-! ################
-!
-INTERFACE
-!
- SUBROUTINE TURB(KKA, KKU, KKL, KMI,KRR,KRRL,KRRI,HLBCX,HLBCY, &
- KSPLIT,KMODEL_CL, &
- OTURB_FLX,OTURB_DIAG,OSUBG_COND,ORMC01, &
- HTURBDIM,HTURBLEN,HTOM,HTURBLEN_CL,HCLOUD,PIMPL, &
- PTSTEP,TPFILE,PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
- PDIRCOSXW,PDIRCOSYW,PDIRCOSZW,PCOSSLOPE,PSINSLOPE, &
- PRHODJ,PTHVREF, &
- PSFTH,PSFRV,PSFSV,PSFU,PSFV, &
- PPABST,PUT,PVT,PWT,PTKET,PSVT,PSRCT, &
- PBL_DEPTH, PSBL_DEPTH, &
- PCEI,PCEI_MIN,PCEI_MAX,PCOEF_AMPL_SAT, &
- PTHLT,PRT, &
- PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS,PRTKES,PRTKEMS,PSIGS,&
- PFLXZTHVMF,PWTH,PWRC,PWSV,PDYP,PTHP,PTR,PDISS,PLEM )
-
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=AR
-INTEGER, INTENT(IN) :: KMI ! model index number
-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.
-CHARACTER(LEN=*),DIMENSION(:),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-INTEGER, INTENT(IN) :: KSPLIT ! number of time-splitting
-INTEGER, INTENT(IN) :: KMODEL_CL ! model number for cloud mixing length
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
- ! diagnostic fields in the syncronous FM-file
-LOGICAL, INTENT(IN) :: OSUBG_COND ! switch for SUBGrid
- ! CONDensation
-LOGICAL, INTENT(IN) :: ORMC01 ! switch for RMC01 lengths in SBL
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-CHARACTER(len=4), INTENT(IN) :: HTURBLEN ! kind of mixing length
-CHARACTER(len=4), INTENT(IN) :: HTOM ! kind of Third Order Moment
-CHARACTER(len=4), INTENT(IN) :: HTURBLEN_CL ! kind of cloud mixing length
- ! surface friction flux
-REAL, INTENT(IN) :: PIMPL ! degree of implicitness
-CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
-REAL, INTENT(IN) :: PTSTEP ! timestep
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
- ! metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! physical distance
-! between 2 succesive grid points along the K direction
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSXW, PDIRCOSYW, PDIRCOSZW
-! Director Cosinus along x, y and z directions at surface w-point
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
- ! between i and the slope vector
-REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
- ! between i and the slope vector
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential
- ! Temperature of the reference state
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTH,PSFRV, &
-! normal surface fluxes of theta and Rv
- PSFU,PSFV
-! normal surface fluxes of (u,v) parallel to the orography
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSV
-! normal surface fluxes of Scalar var.
-!
-! prognostic variables at t- deltat
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT,PWT ! wind components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKET ! TKE
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! passive scal. var.
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCT ! Second-order flux
- ! s'rc'/2Sigma_s2 at time t-1 multiplied by Lambda_3
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PBL_DEPTH ! BL depth for TOMS
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PSBL_DEPTH ! SBL depth for RMC01
-!
-!
-! variables for cloud mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCEI ! Cloud Entrainment instability
- ! index to emphasize localy
- ! turbulent fluxes
-REAL, INTENT(IN) :: PCEI_MIN ! minimum threshold for the instability index CEI
-REAL, INTENT(IN) :: PCEI_MAX ! maximum threshold for the instability index CEI
-REAL, INTENT(IN) :: PCOEF_AMPL_SAT ! saturation of the amplification coefficient
-! thermodynamical variables which are transformed in conservative var.
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHLT ! conservative pot. temp.
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT ! water var. where
- ! PRT(:,:,:,1) is the conservative mixing ratio
-!
-! sources of momentum, conservative potential temperature, Turb. Kin. Energy,
-! TKE dissipation
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS,PRVS,PRWS,PRTHLS,PRTKES
-! Source terms for all water kinds, PRRS(:,:,:,1) is used for the conservative
-! mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTKEMS
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
-! Source terms for all passive scalar variables
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
-! Sigma_s at time t+1 : square root of the variance of the deviation to the
-! saturation
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLXZTHVMF
-! MF contribution for vert. turb. transport
-! used in the buoy. prod. of TKE
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTH ! heat flux
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWRC ! cloud water flux
-REAL, DIMENSION(:,:,:,:),INTENT(OUT) :: PWSV ! scalar flux
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDYP ! Dynamical production of TKE
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHP ! Thermal production of TKE
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTR ! Transport production of TKE
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDISS ! Dissipation of TKE
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLEM ! Mixing length
-
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE TURB
-!
-END INTERFACE
-!
-END MODULE MODI_TURB
-!
-! #################################################################
- SUBROUTINE TURB(KKA, KKU, KKL, KMI,KRR,KRRL,KRRI,HLBCX,HLBCY, &
- KSPLIT,KMODEL_CL, &
- OTURB_FLX,OTURB_DIAG,OSUBG_COND,ORMC01, &
- HTURBDIM,HTURBLEN,HTOM,HTURBLEN_CL,HCLOUD,PIMPL, &
- PTSTEP,TPFILE,PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
- PDIRCOSXW,PDIRCOSYW,PDIRCOSZW,PCOSSLOPE,PSINSLOPE, &
- PRHODJ,PTHVREF, &
- PSFTH,PSFRV,PSFSV,PSFU,PSFV, &
- PPABST,PUT,PVT,PWT,PTKET,PSVT,PSRCT, &
- PBL_DEPTH, PSBL_DEPTH, &
- PCEI,PCEI_MIN,PCEI_MAX,PCOEF_AMPL_SAT, &
- PTHLT,PRT, &
- PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS,PRTKES,PRTKEMS,PSIGS,&
- PFLXZTHVMF,PWTH,PWRC,PWSV,PDYP,PTHP,PTR,PDISS,PLEM )
+ SUBROUTINE TURB(KKA,KKU,KKL,KMI,KRR,KRRL,KRRI,HLBCX,HLBCY, &
+ & KSPLIT,KMODEL_CL, &
+ & OTURB_FLX,OTURB_DIAG,OSUBG_COND,ORMC01,OOCEAN, &
+ & HTURBDIM,HTURBLEN,HTOM,HTURBLEN_CL,HCLOUD,PIMPL, &
+ & PTSTEP,TPFILE,PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
+ & PDIRCOSXW,PDIRCOSYW,PDIRCOSZW,PCOSSLOPE,PSINSLOPE, &
+ & PRHODJ,PTHVREF, &
+ & PSFTH,PSFRV,PSFSV,PSFU,PSFV, &
+ & PPABST,PUT,PVT,PWT,PTKET,PSVT,PSRCT, &
+ & PLENGTHM,PLENGTHH,MFMOIST, &
+ & PBL_DEPTH,PSBL_DEPTH, &
+ & PCEI,PCEI_MIN,PCEI_MAX,PCOEF_AMPL_SAT, &
+ & PTHLT,PRT, &
+ & PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS,PRTKES, &
+ & PSIGS, &
+ & PFLXZTHVMF,PWTH,PWRC,PWSV,PDP,PTP,PTDIFF,PTDISS, &
+ & TBUDGETS, KBUDGETS, &
+ & PEDR,PLEM,PRTKEMS,PTPMF, &
+ & PDRUS_TURB,PDRVS_TURB, &
+ & PDRTHLS_TURB,PDRRTS_TURB,PDRSVS_TURB )
! #################################################################
!
!
@@ -230,7 +106,7 @@ END MODULE MODI_TURB
!! IMPLICIT ARGUMENTS
!! ------------------
!!
-!! MODD_PARAMETERS : JPVEXT number of marginal vertical points
+!! MODD_PARAMETERS : JPVEXT_TURB number of marginal vertical points
!!
!! MODD_CONF : CCONF model configuration (start/restart)
!! L1D switch for 1D model version
@@ -335,6 +211,9 @@ END MODULE MODI_TURB
!! vertical levels
!! 10/2012 (J. Colin) Correct bug in DearDoff for dry simulations
!! 10/2012 J.Escobar Bypass PGI bug , redefine some allocatable array inplace of automatic
+!! 2014-11 Y. Seity, add output terms for TKE DDHs budgets
+!! July 2015 (Wim de Rooy) modifications to run with RACMO
+!! turbulence (LHARAT=TRUE)
!! 04/2016 (C.Lac) correction of negativity for KHKO
! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! Q. Rodier 01/2018: introduction of RM17
@@ -351,49 +230,46 @@ END MODULE MODI_TURB
!* 0. DECLARATIONS
! ------------
!
-use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudget_rv, lbudget_rc, &
- lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
- NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, &
- NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
- tbudgets
-USE MODD_CONF
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
+USE MODD_PARAMETERS, ONLY: JPVEXT_TURB
USE MODD_CST
USE MODD_CTURB
-USE MODD_DYN_n, ONLY : LOCEAN
-use modd_field, only: tfielddata, TYPEREAL
+USE MODD_CONF
+USE MODD_BUDGET, ONLY: LBUDGET_U, LBUDGET_V, LBUDGET_W, LBUDGET_TH, LBUDGET_RV, LBUDGET_RC, &
+ LBUDGET_RR, LBUDGET_RI, LBUDGET_RS, LBUDGET_RG, LBUDGET_RH, LBUDGET_SV, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, &
+ NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ TBUDGETDATA
+USE MODD_FIELD, ONLY: TFIELDDATA,TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
-USE MODD_NSV
-USE MODD_PARAMETERS, ONLY: JPVEXT_TURB
-USE MODD_PARAM_LIMA
USE MODD_TURB_n, ONLY: XCADAP
+USE MODD_NSV
!
+USE MODE_BL89, ONLY: BL89
+USE MODE_TURB_VER, ONLY : TURB_VER
+USE MODE_ROTATE_WIND, ONLY: ROTATE_WIND
+USE MODE_TURB_HOR_SPLT, ONLY: TURB_HOR_SPLT
+USE MODE_TKE_EPS_SOURCES, ONLY: TKE_EPS_SOURCES
+USE MODI_SHUMAN, ONLY : MZF, MXF, MYF
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
-USE MODI_BL89
-USE MODI_TURB_VER
-USE MODI_ROTATE_WIND
-USE MODI_TURB_HOR_SPLT
-USE MODI_TKE_EPS_SOURCES
-USE MODI_SHUMAN
-USE MODI_GRADIENT_M
USE MODI_LES_MEAN_SUBGRID
-USE MODI_RMC01
+USE MODE_RMC01, ONLY: RMC01
USE MODI_GRADIENT_W
-USE MODI_TM06
-USE MODI_UPDATE_LM
-USE MODI_GET_HALO
+USE MODE_TM06, ONLY: TM06
+USE MODE_UPDATE_LM, ONLY: UPDATE_LM
!
-use mode_budget, only: Budget_store_init, Budget_store_end
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_BUDGET, ONLY: BUDGET_STORE_INIT, BUDGET_STORE_END
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE
USE MODE_SBL
-use mode_sources_neg_correct, only: Sources_neg_correct
-!
-USE MODI_EMOIST
-USE MODI_ETHETA
+USE MODE_SOURCES_NEG_CORRECT, ONLY: SOURCES_NEG_CORRECT
!
-USE MODI_SECOND_MNH
+USE MODE_EMOIST, ONLY: EMOIST
+USE MODE_ETHETA, ONLY: ETHETA
!
USE MODD_IBM_PARAM_n, ONLY: LIBM, XIBM_LS, XIBM_XMUT
USE MODI_IBM_MIXINGLENGTH
@@ -422,11 +298,12 @@ LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
LOGICAL, INTENT(IN) :: OSUBG_COND ! switch for SUBGrid
! CONDensation
LOGICAL, INTENT(IN) :: ORMC01 ! switch for RMC01 lengths in SBL
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
+CHARACTER(LEN=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
! turbulence scheme
-CHARACTER(len=4), INTENT(IN) :: HTURBLEN ! kind of mixing length
-CHARACTER(len=4), INTENT(IN) :: HTOM ! kind of Third Order Moment
-CHARACTER(len=4), INTENT(IN) :: HTURBLEN_CL ! kind of cloud mixing length
+CHARACTER(LEN=4), INTENT(IN) :: HTURBLEN ! kind of mixing length
+CHARACTER(LEN=4), INTENT(IN) :: HTOM ! kind of Third Order Moment
+CHARACTER(LEN=4), INTENT(IN) :: HTURBLEN_CL ! kind of cloud mixing length
REAL, INTENT(IN) :: PIMPL ! degree of implicitness
CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme
REAL, INTENT(IN) :: PTSTEP ! timestep
@@ -443,6 +320,7 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
! between i and the slope vector
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
+REAL, DIMENSION(:,:,:), INTENT(IN) :: MFMOIST ! moist mass flux dual scheme
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential
! Temperature of the reference state
!
@@ -481,47 +359,63 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT ! water var. where
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS,PRVS,PRWS,PRTHLS,PRTKES
! Source terms for all water kinds, PRRS(:,:,:,1) is used for the conservative
! mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTKEMS
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
+REAL, DIMENSION(:,:,:), INTENT(IN),OPTIONAL :: PRTKEMS
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
! Source terms for all passive scalar variables
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
! Sigma_s at time t+1 : square root of the variance of the deviation to the
! saturation
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS
+REAL, DIMENSION(:,:,:), INTENT(OUT),OPTIONAL :: PDRUS_TURB ! evolution of rhoJ*U by turbulence only
+REAL, DIMENSION(:,:,:), INTENT(OUT),OPTIONAL :: PDRVS_TURB ! evolution of rhoJ*V by turbulence only
+REAL, DIMENSION(:,:,:), INTENT(OUT),OPTIONAL :: PDRTHLS_TURB ! evolution of rhoJ*thl by turbulence only
+REAL, DIMENSION(:,:,:), INTENT(OUT),OPTIONAL :: PDRRTS_TURB ! evolution of rhoJ*rt by turbulence only
+REAL, DIMENSION(:,:,:,:), INTENT(OUT),OPTIONAL :: PDRSVS_TURB ! evolution of rhoJ*Sv by turbulence only
REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLXZTHVMF
! MF contribution for vert. turb. transport
! used in the buoy. prod. of TKE
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTH ! heat flux
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWRC ! cloud water flux
REAL, DIMENSION(:,:,:,:),INTENT(OUT) :: PWSV ! scalar flux
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDYP ! Dynamical production of TKE
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHP ! Thermal production of TKE
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTR ! Transport production of TKE
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDISS ! Dissipation of TKE
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLEM ! Mixing length
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTP ! Thermal TKE production
+ ! MassFlux + turb
+REAL, DIMENSION(:,:,:), INTENT(OUT),OPTIONAL :: PTPMF ! Thermal TKE production
+ ! MassFlux Only
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDP ! Dynamic TKE production
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTDIFF ! Diffusion TKE term
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTDISS ! Dissipation TKE term
+!
+TYPE(TBUDGETDATA), DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
+!
+! length scale from vdfexcu
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLENGTHM, PLENGTHH
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT), OPTIONAL :: PEDR ! EDR
+REAL, DIMENSION(:,:,:), INTENT(OUT), OPTIONAL :: PLEM ! Mixing length
!
!
!-------------------------------------------------------------------------------
!
! 0.2 declaration of local variables
!
-REAL, ALLOCATABLE, DIMENSION(:,:,:) ::&
+REAL, DIMENSION(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)) :: &
ZCP, & ! Cp at t-1
ZEXN, & ! EXN at t-1
ZT, & ! T at t-1
ZLOCPEXNM, & ! Lv/Cp/EXNREF at t-1
- ZLMW, & ! Turbulent mixing length (work array)
+ ZLM,ZLMW, & ! Turbulent mixing length (+ work array)
ZLEPS, & ! Dissipative length
- ZTRH, & ! Dynamic and Thermal Production of TKE
+ ZTRH, & !
ZATHETA,ZAMOIST, & ! coefficients for s = f (Thetal,Rnp)
ZCOEF_DISS, & ! 1/(Cph*Exner) for dissipative heating
ZFRAC_ICE, & ! ri fraction of rc+ri
ZMWTH,ZMWR,ZMTH2,ZMR2,ZMTHR,& ! 3rd order moments
ZFWTH,ZFWR,ZFTH2,ZFR2,ZFTHR,& ! opposite of verticale derivate of 3rd order moments
- ZTHLM, ZTR, ZDISS ! initial potential temp.
-REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: &
+ ZTHLM,ZRTKEMS ! initial potential temp; TKE advective source
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),SIZE(PRT,4)) :: &
ZRM ! initial mixing ratio
-REAL, ALLOCATABLE, DIMENSION(:,:) :: ZTAU11M,ZTAU12M, &
+REAL, DIMENSION(SIZE(PTHLT,1),SIZE(PTHLT,2)) :: ZTAU11M,ZTAU12M, &
ZTAU22M,ZTAU33M, &
! tangential surface fluxes in the axes following the orography
ZUSLOPE,ZVSLOPE, &
@@ -555,58 +449,25 @@ REAL :: ZALPHA ! work coefficient :
! ! BL89 mixing length near the surface
!
REAL :: ZTIME1, ZTIME2
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)):: ZTT,ZEXNE,ZLV,ZLS,ZCPH,ZCOR
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)):: ZSHEAR, ZDUDZ, ZDVDZ
TYPE(TFIELDDATA) :: TZFIELD
!
-!------------------------------------------------------------------------------------------
-ALLOCATE ( &
- ZCP(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZEXN(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZT(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZLOCPEXNM(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZLMW(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZLEPS(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZTRH(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZATHETA(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZAMOIST(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZCOEF_DISS(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZFRAC_ICE(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZMWTH(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZMWR(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZMTH2(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZMR2(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZMTHR(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZFWTH(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZFWR(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZFTH2(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZFR2(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZFTHR(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZTHLM(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)) )
-
-ALLOCATE ( ZRM(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),SIZE(PRT,4)) )
-
-ALLOCATE ( &
- ZTAU11M(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
- ZTAU12M(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
- ZTAU22M(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
- ZTAU33M(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
- ZUSLOPE(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
- ZVSLOPE(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
- ZCDUEFF(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
- ZUSTAR(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
- ZLMO(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
- ZRVM(SIZE(PTHLT,1),SIZE(PTHLT,2)), &
- ZSFRV(SIZE(PTHLT,1),SIZE(PTHLT,2)) )
-
-!------------------------------------------------------------------------------------------
-!
!* 1.PRELIMINARIES
! -------------
!
!* 1.1 Set the internal domains, ZEXPL
!
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('TURB',0,ZHOOK_HANDLE)
+!
+IF (LHARAT .AND. HTURBDIM /= '1DIM') THEN
+ CALL ABOR1('LHARATU only implemented for option HTURBDIM=1DIM!')
+ENDIF
+IF (LHARAT .AND. LLES_CALL) THEN
+ CALL ABOR1('LHARATU not implemented for option LLES_CALL')
+ENDIF
+
IKT=SIZE(PTHLT,3)
IKTB=1+JPVEXT_TURB
IKTE=IKT-JPVEXT_TURB
@@ -645,7 +506,7 @@ END DO
!
!* 2.2 Exner function at t
!
-IF (LOCEAN) THEN
+IF (OOCEAN) THEN
ZEXN(:,:,:) = 1.
ELSE
ZEXN(:,:,:) = (PPABST(:,:,:)/XP00) ** (XRD/XCPD)
@@ -698,7 +559,7 @@ IF (KRRL >=1) THEN
END IF
!
!
- IF ( tpfile%lopened .AND. OTURB_DIAG ) THEN
+ IF ( TPFILE%LOPENED .AND. OTURB_DIAG ) THEN
TZFIELD%CMNHNAME = 'ATHETA'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'ATHETA'
@@ -709,7 +570,7 @@ IF (KRRL >=1) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZATHETA)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZATHETA)
!
TZFIELD%CMNHNAME = 'AMOIST'
TZFIELD%CSTDNAME = ''
@@ -721,7 +582,7 @@ IF (KRRL >=1) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZAMOIST)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZAMOIST)
END IF
!
ELSE
@@ -750,12 +611,22 @@ IF ( KRRL >= 1 ) THEN
END IF
END IF
!
+!* stores value of conservative variables & wind before turbulence tendency (AROME diag)
+IF(PRESENT(PDRUS_TURB)) THEN
+ PDRUS_TURB = PRUS
+ PDRVS_TURB = PRVS
+ PDRTHLS_TURB = PRTHLS
+ PDRRTS_TURB = PRRS(:,:,:,1)
+ PDRSVS_TURB = PRSVS
+END IF
!----------------------------------------------------------------------------
!
!* 3. MIXING LENGTH : SELECTION AND COMPUTATION
! -----------------------------------------
!
!
+IF (.NOT. LHARAT) THEN
+
SELECT CASE (HTURBLEN)
!
!* 3.1 BL89 mixing length
@@ -763,25 +634,25 @@ SELECT CASE (HTURBLEN)
CASE ('BL89')
ZSHEAR=0.
- CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,PLEM)
+ CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,ZLM,OOCEAN)
!
!* 3.2 RM17 mixing length
! ------------------
CASE ('RM17')
- ZDUDZ = MXF(MZF(GZ_U_UW(PUT,PDZZ)))
- ZDVDZ = MYF(MZF(GZ_V_VW(PVT,PDZZ)))
+ ZDUDZ = MXF(MZF(GZ_U_UW(PUT,PDZZ,KKA,KKU,KKL),KKA,KKU,KKL))
+ ZDVDZ = MYF(MZF(GZ_V_VW(PVT,PDZZ,KKA,KKU,KKL),KKA,KKU,KKL))
ZSHEAR = SQRT(ZDUDZ*ZDUDZ + ZDVDZ*ZDVDZ)
- CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,PLEM)
+ CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,ZLM,OOCEAN)
!
!* 3.3 Grey-zone combined RM17 & Deardorff mixing lengths
! --------------------------------------------------
CASE ('ADAP')
- ZDUDZ = MXF(MZF(GZ_U_UW(PUT,PDZZ)))
- ZDVDZ = MYF(MZF(GZ_V_VW(PVT,PDZZ)))
+ ZDUDZ = MXF(MZF(GZ_U_UW(PUT,PDZZ,KKA,KKU,KKL),KKA,KKU,KKL))
+ ZDVDZ = MYF(MZF(GZ_V_VW(PVT,PDZZ,KKA,KKU,KKL),KKA,KKU,KKL))
ZSHEAR = SQRT(ZDUDZ*ZDUDZ + ZDVDZ*ZDVDZ)
- CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,PLEM)
+ CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,ZLM,OOCEAN)
CALL DELT(ZLMW,ODZ=.FALSE.)
! The minimum mixing length is chosen between Horizontal grid mesh (not taking into account the vertical grid mesh) and RM17.
@@ -789,53 +660,56 @@ SELECT CASE (HTURBLEN)
! For LES grid meshes, this is equivalent to Deardorff : the base mixing lentgh is the horizontal grid mesh,
! and it is limited by a stability-based length (RM17), as was done in Deardorff length (but taking into account shear as well)
! For grid meshes in the grey zone, then this is the smaller of the two.
- PLEM = MIN(PLEM,XCADAP*ZLMW)
+ ZLM = MIN(ZLM,XCADAP*ZLMW)
!
!* 3.4 Delta mixing length
! -------------------
!
CASE ('DELT')
- CALL DELT(PLEM,ODZ=.TRUE.)
+ CALL DELT(ZLM,ODZ=.TRUE.)
!
!* 3.5 Deardorff mixing length
! -----------------------
!
CASE ('DEAR')
- CALL DEAR(PLEM)
+ CALL DEAR(ZLM)
!
!* 3.6 Blackadar mixing length
! -----------------------
!
CASE ('BLKR')
ZL0 = 100.
- PLEM(:,:,:) = ZL0
+ ZLM(:,:,:) = ZL0
ZALPHA=0.5**(-1.5)
!
DO JK=IKTB,IKTE
- PLEM(:,:,JK) = ( 0.5*(PZZ(:,:,JK)+PZZ(:,:,JK+KKL)) - &
+ ZLM(:,:,JK) = ( 0.5*(PZZ(:,:,JK)+PZZ(:,:,JK+KKL)) - &
& PZZ(:,:,KKA+JPVEXT_TURB*KKL) ) * PDIRCOSZW(:,:)
- PLEM(:,:,JK) = ZALPHA * PLEM(:,:,JK) * ZL0 / ( ZL0 + ZALPHA*PLEM(:,:,JK) )
+ ZLM(:,:,JK) = ZALPHA * ZLM(:,:,JK) * ZL0 / ( ZL0 + ZALPHA*ZLM(:,:,JK) )
END DO
!
- PLEM(:,:,IKTB-1) = PLEM(:,:,IKTB)
- PLEM(:,:,IKTE+1) = PLEM(:,:,IKTE)
+ ZLM(:,:,IKTB-1) = ZLM(:,:,IKTB)
+ ZLM(:,:,IKTE+1) = ZLM(:,:,IKTE)
!
!
!
END SELECT
!
-!
-!
!* 3.5 Mixing length modification for cloud
! -----------------------
IF (KMODEL_CL==KMI .AND. HTURBLEN_CL/='NONE') CALL CLOUD_MODIF_LM
+ENDIF ! end LHARRAT
!
!* 3.6 Dissipative length
! ------------------
-!
-ZLEPS(:,:,:)=PLEM(:,:,:)
+
+IF (LHARAT) THEN
+ ZLEPS=PLENGTHM*(3.75**2.)
+ELSE
+ ZLEPS=ZLM
+ENDIF
!
!* 3.7 Correction in the Surface Boundary Layer (Redelsperger 2001)
! ----------------------------------------
@@ -850,7 +724,7 @@ IF (ORMC01) THEN
ZSFRV=0.
ZLMO=LMO(ZUSTAR,ZTHLM(:,:,IKB),ZRVM,PSFTH,ZSFRV)
END IF
- CALL RMC01(HTURBLEN,KKA,KKU,KKL,PZZ,PDXX,PDYY,PDZZ,PDIRCOSZW,PSBL_DEPTH,ZLMO,PLEM,ZLEPS)
+ CALL RMC01(HTURBLEN,KKA,KKU,KKL,PZZ,PDXX,PDYY,PDZZ,PDIRCOSZW,PSBL_DEPTH,ZLMO,ZLM,ZLEPS)
END IF
!
!RMC01 is only applied on RM17 in ADAP
@@ -860,14 +734,14 @@ IF (HTURBLEN=='ADAP') ZLEPS = MIN(ZLEPS,ZLMW*XCADAP)
! ----------------------------------------------------------
!
IF (HTURBDIM=="3DIM") THEN
- CALL UPDATE_LM(HLBCX,HLBCY,PLEM,ZLEPS)
+ CALL UPDATE_LM(HLBCX,HLBCY,ZLM,ZLEPS)
END IF
!
!* 3.9 Mixing length correction if immersed walls
! ------------------------------------------
!
IF (LIBM) THEN
- CALL IBM_MIXINGLENGTH(PLEM,ZLEPS,XIBM_XMUT,XIBM_LS(:,:,:,1),PTKET)
+ CALL IBM_MIXINGLENGTH(ZLM,ZLEPS,XIBM_XMUT,XIBM_LS(:,:,:,1),PTKET)
ENDIF
!----------------------------------------------------------------------------
!
@@ -879,24 +753,28 @@ ENDIF
!
!
!
- IF (CPROGRAM/='AROME ') THEN
- CALL ROTATE_WIND(PUT,PVT,PWT, &
+IF (CPROGRAM/='AROME ') THEN
+ CALL ROTATE_WIND(PUT,PVT,PWT, &
PDIRCOSXW, PDIRCOSYW, PDIRCOSZW, &
PCOSSLOPE,PSINSLOPE, &
PDXX,PDYY,PDZZ, &
ZUSLOPE,ZVSLOPE )
!
- CALL UPDATE_ROTATE_WIND(ZUSLOPE,ZVSLOPE)
- ELSE
- ZUSLOPE=PUT(:,:,KKA)
- ZVSLOPE=PVT(:,:,KKA)
- END IF
+ CALL UPDATE_ROTATE_WIND(ZUSLOPE,ZVSLOPE)
+ELSE
+ ZUSLOPE=PUT(:,:,KKA)
+ ZVSLOPE=PVT(:,:,KKA)
+END IF
!
!
!* 4.2 compute the proportionality coefficient between wind and stress
!
- ZCDUEFF(:,:) =-SQRT ( (PSFU(:,:)**2 + PSFV(:,:)**2) / &
- (XMNH_TINY + ZUSLOPE(:,:)**2 + ZVSLOPE(:,:)**2 ) )
+ZCDUEFF(:,:) =-SQRT ( (PSFU(:,:)**2 + PSFV(:,:)**2) / &
+#ifdef REPRO48
+ (1.E-60 + ZUSLOPE(:,:)**2 + ZVSLOPE(:,:)**2 ) )
+#else
+ (XMNH_TINY + ZUSLOPE(:,:)**2 + ZVSLOPE(:,:)**2 ) )
+#endif
!
!* 4.6 compute the surface tangential fluxes
!
@@ -954,42 +832,42 @@ ENDIF
!* 5. TURBULENT SOURCES
! -----------------
!
-if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'VTURB', prus (:, :, :) )
-if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'VTURB', prvs (:, :, :) )
-if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W ), 'VTURB', prws (:, :, :) )
+IF( LBUDGET_U ) CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_U ), 'VTURB', PRUS(:, :, :) )
+IF( LBUDGET_V ) CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_V ), 'VTURB', PRVS(:, :, :) )
+IF( LBUDGET_W ) CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_W ), 'VTURB', PRWS(:, :, :) )
-if ( lbudget_th ) then
- if ( krri >= 1 .and. krrl >= 1 ) then
- call Budget_store_init( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) + zlvocpexnm(:, :, :) * prrs(:, :, :, 2) &
- + zlsocpexnm(:, :, :) * prrs(:, :, :, 4) )
- else if ( krrl >= 1 ) then
- call Budget_store_init( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) + zlocpexnm(:, :, :) * prrs(:, :, :, 2) )
- else
- call Budget_store_init( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) )
- end if
-end if
+IF( LBUDGET_TH ) THEN
+ IF( KRRI >= 1 .AND. KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_TH), 'VTURB', PRTHLS(:, :, :) + ZLVOCPEXNM(:, :, :) * PRRS(:, :, :, 2) &
+ + ZLSOCPEXNM(:, :, :) * PRRS(:, :, :, 4) )
+ ELSE IF( KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_TH), 'VTURB', PRTHLS(:, :, :) + ZLOCPEXNM(:, :, :) * PRRS(:, :, :, 2) )
+ ELSE
+ CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_TH), 'VTURB', PRTHLS(:, :, :) )
+ END IF
+END IF
-if ( lbudget_rv ) then
- if ( krri >= 1 .and. krrl >= 1 ) then
- call Budget_store_init( tbudgets(NBUDGET_RV), 'VTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) - prrs(:, :, :, 4) )
- else if ( krrl >= 1 ) then
- call Budget_store_init( tbudgets(NBUDGET_RV), 'VTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) )
- else
- call Budget_store_init( tbudgets(NBUDGET_RV), 'VTURB', prrs(:, :, :, 1) )
- end if
-end if
+IF( LBUDGET_RV ) THEN
+ IF( KRRI >= 1 .AND. KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_RV), 'VTURB', PRRS(:, :, :, 1) - PRRS(:, :, :, 2) - PRRS(:, :, :, 4) )
+ ELSE IF( KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_RV), 'VTURB', PRRS(:, :, :, 1) - PRRS(:, :, :, 2) )
+ ELSE
+ CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_RV), 'VTURB', PRRS(:, :, :, 1) )
+ END IF
+END IF
-if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'VTURB', prrs (:, :, :, 2) )
-if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'VTURB', prrs (:, :, :, 4) )
+IF( LBUDGET_RC ) CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_RC), 'VTURB', PRRS (:, :, :, 2) )
+IF( LBUDGET_RI ) CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_RI), 'VTURB', PRRS (:, :, :, 4) )
-if ( lbudget_sv ) then
- do jsv = 1, nsv
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'VTURB', prsvs(:, :, :, jsv) )
- end do
-end if
+IF( LBUDGET_SV ) THEN
+ DO JSV = 1, NSV
+ CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_SV1 - 1 + JSV), 'VTURB', PRSVS(:, :, :, JSV) )
+ END DO
+END IF
CALL TURB_VER(KKA,KKU,KKL,KRR, KRRL, KRRI, &
- OTURB_FLX, &
+ OTURB_FLX, OOCEAN, &
HTURBDIM,HTOM,PIMPL,ZEXPL, &
PTSTEP,TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
@@ -998,84 +876,91 @@ CALL TURB_VER(KKA,KKU,KKL,KRR, KRRL, KRRI, &
PSFTH,PSFRV,PSFSV,PSFTH,PSFRV,PSFSV, &
ZCDUEFF,ZTAU11M,ZTAU12M,ZTAU33M, &
PUT,PVT,PWT,ZUSLOPE,ZVSLOPE,PTHLT,PRT,PSVT, &
- PTKET,PLEM,ZLEPS, &
+ PTKET,ZLM,PLENGTHM,PLENGTHH,ZLEPS,MFMOIST, &
ZLOCPEXNM,ZATHETA,ZAMOIST,PSRCT,ZFRAC_ICE, &
ZFWTH,ZFWR,ZFTH2,ZFR2,ZFTHR,PBL_DEPTH, &
PSBL_DEPTH,ZLMO, &
PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS, &
- PDYP,PTHP,PSIGS,PWTH,PWRC,PWSV )
-
-if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'VTURB', prus(:, :, :) )
-if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V), 'VTURB', prvs(:, :, :) )
-if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W), 'VTURB', prws(:, :, :) )
+ PDP,PTP,PSIGS,PWTH,PWRC,PWSV )
-if ( lbudget_th ) then
- if ( krri >= 1 .and. krrl >= 1 ) then
- call Budget_store_end( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) + zlvocpexnm(:, :, :) * prrs(:, :, :, 2) &
- + zlsocpexnm(:, :, :) * prrs(:, :, :, 4) )
- else if ( krrl >= 1 ) then
- call Budget_store_end( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) + zlocpexnm(:, :, :) * prrs(:, :, :, 2) )
- else
- call Budget_store_end( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) )
- end if
-end if
+IF( LBUDGET_U ) CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_U), 'VTURB', PRUS(:, :, :) )
+IF( LBUDGET_V ) CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_V), 'VTURB', PRVS(:, :, :) )
+IF( LBUDGET_W ) CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_W), 'VTURB', PRWS(:, :, :) )
-if ( lbudget_rv ) then
- if ( krri >= 1 .and. krrl >= 1 ) then
- call Budget_store_end( tbudgets(NBUDGET_RV), 'VTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) - prrs(:, :, :, 4) )
- else if ( krrl >= 1 ) then
- call Budget_store_end( tbudgets(NBUDGET_RV), 'VTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) )
- else
- call Budget_store_end( tbudgets(NBUDGET_RV), 'VTURB', prrs(:, :, :, 1) )
- end if
-end if
+IF( LBUDGET_TH ) THEN
+ IF( KRRI >= 1 .AND. KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_TH), 'VTURB', PRTHLS(:, :, :) + ZLVOCPEXNM(:, :, :) * PRRS(:, :, :, 2) &
+ + ZLSOCPEXNM(:, :, :) * PRRS(:, :, :, 4) )
+ ELSE IF( KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_TH), 'VTURB', PRTHLS(:, :, :) + ZLOCPEXNM(:, :, :) * PRRS(:, :, :, 2) )
+ ELSE
+ CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_TH), 'VTURB', PRTHLS(:, :, :) )
+ END IF
+END IF
-if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'VTURB', prrs(:, :, :, 2) )
-if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'VTURB', prrs(:, :, :, 4) )
+IF( LBUDGET_RV ) THEN
+ IF( KRRI >= 1 .AND. KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_RV), 'VTURB', PRRS(:, :, :, 1) - PRRS(:, :, :, 2) - PRRS(:, :, :, 4) )
+ ELSE IF( KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_RV), 'VTURB', PRRS(:, :, :, 1) - PRRS(:, :, :, 2) )
+ ELSE
+ CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_RV), 'VTURB', PRRS(:, :, :, 1) )
+ END IF
+END IF
-if ( lbudget_sv ) then
- do jsv = 1, nsv
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'VTURB', prsvs(:, :, :, jsv) )
- end do
-end if
-!
-if ( hturbdim == '3DIM' ) then
- if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'HTURB', prus (:, :, :) )
- if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'HTURB', prvs (:, :, :) )
- if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W ), 'HTURB', prws (:, :, :) )
+IF( LBUDGET_RC ) CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_RC), 'VTURB', PRRS(:, :, :, 2) )
+IF( LBUDGET_RI ) CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_RI), 'VTURB', PRRS(:, :, :, 4) )
- if (lbudget_th) then
- if ( krri >= 1 .and. krrl >= 1 ) then
- call Budget_store_init( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) + zlvocpexnm(:, :, :) * prrs(:, :, :, 2) &
- + zlsocpexnm(:, :, :) * prrs(:, :, :, 4) )
- else if ( krrl >= 1 ) then
- call Budget_store_init( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) + zlocpexnm(:, :, :) * prrs(:, :, :, 2) )
- else
- call Budget_store_init( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) )
- end if
- end if
+IF( LBUDGET_SV ) THEN
+ DO JSV = 1, NSV
+ CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_SV1 - 1 + JSV), 'VTURB', PRSVS(:, :, :, JSV) )
+ END DO
+END IF
+!
+!Les budgets des termes horizontaux de la turb sont présents dans AROME
+! alors que ces termes ne sont pas calculés
+#ifdef REPRO48
+#else
+IF( HTURBDIM == '3DIM' ) THEN
+#endif
+ IF( LBUDGET_U ) CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_U ), 'HTURB', PRUS (:, :, :) )
+ IF( LBUDGET_V ) CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_V ), 'HTURB', PRVS (:, :, :) )
+ IF( LBUDGET_W ) CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_W ), 'HTURB', PRWS (:, :, :) )
- if ( lbudget_rv ) then
- if ( krri >= 1 .and. krrl >= 1 ) then
- call Budget_store_init( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) - prrs(:, :, :, 4) )
- else if ( krrl >= 1 ) then
- call Budget_store_init( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) )
- else
- call Budget_store_init( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) )
- end if
- end if
+ IF(LBUDGET_TH) THEN
+ IF( KRRI >= 1 .AND. KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_TH), 'HTURB', PRTHLS(:, :, :) + ZLVOCPEXNM(:, :, :) * PRRS(:, :, :, 2) &
+ + ZLSOCPEXNM(:, :, :) * PRRS(:, :, :, 4) )
+ ELSE IF( KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_TH), 'HTURB', PRTHLS(:, :, :) + ZLOCPEXNM(:, :, :) * PRRS(:, :, :, 2) )
+ ELSE
+ CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_TH), 'HTURB', PRTHLS(:, :, :) )
+ END IF
+ END IF
- if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HTURB', prrs(:, :, :, 2) )
- if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HTURB', prrs(:, :, :, 4) )
+ IF( LBUDGET_RV ) THEN
+ IF( KRRI >= 1 .AND. KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_RV), 'HTURB', PRRS(:, :, :, 1) - PRRS(:, :, :, 2) - PRRS(:, :, :, 4) )
+ ELSE IF( KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_RV), 'HTURB', PRRS(:, :, :, 1) - PRRS(:, :, :, 2) )
+ ELSE
+ CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_RV), 'HTURB', PRRS(:, :, :, 1) )
+ END IF
+ END IF
- if ( lbudget_sv ) then
- do jsv = 1, nsv
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'HTURB', prsvs(:, :, :, jsv) )
- end do
- end if
+ IF( LBUDGET_RC ) CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_RC), 'HTURB', PRRS(:, :, :, 2) )
+ IF( LBUDGET_RI ) CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_RI), 'HTURB', PRRS(:, :, :, 4) )
+ IF( LBUDGET_SV ) THEN
+ DO JSV = 1, NSV
+ CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_SV1 - 1 + JSV), 'HTURB', PRSVS(:, :, :, JSV) )
+ END DO
+ END IF
+!à supprimer une fois le précédent ifdef REPRO48 validé
+#ifdef REPRO48
+#else
CALL TURB_HOR_SPLT(KSPLIT, KRR, KRRL, KRRI, PTSTEP, &
- HLBCX,HLBCY,OTURB_FLX,OSUBG_COND, &
+ HLBCX,HLBCY,OTURB_FLX,OSUBG_COND,OOCEAN, &
TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
@@ -1084,46 +969,49 @@ if ( hturbdim == '3DIM' ) then
PSFTH,PSFRV,PSFSV, &
ZCDUEFF,ZTAU11M,ZTAU12M,ZTAU22M,ZTAU33M, &
PUT,PVT,PWT,ZUSLOPE,ZVSLOPE,PTHLT,PRT,PSVT, &
- PTKET,PLEM,ZLEPS, &
+ PTKET,ZLM,ZLEPS, &
ZLOCPEXNM,ZATHETA,ZAMOIST,PSRCT,ZFRAC_ICE, &
- PDYP,PTHP,PSIGS, &
+ PDP,PTP,PSIGS, &
ZTRH, &
PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS )
+#endif
+ IF( LBUDGET_U ) CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_U), 'HTURB', PRUS(:, :, :) )
+ IF( LBUDGET_V ) CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_V), 'HTURB', PRVS(:, :, :) )
+ IF( LBUDGET_W ) CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_W), 'HTURB', PRWS(:, :, :) )
- if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'HTURB', prus(:, :, :) )
- if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V), 'HTURB', prvs(:, :, :) )
- if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W), 'HTURB', prws(:, :, :) )
-
- if ( lbudget_th ) then
- if ( krri >= 1 .and. krrl >= 1 ) then
- call Budget_store_end( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) + zlvocpexnm(:, :, :) * prrs(:, :, :, 2) &
- + zlsocpexnm(:, :, :) * prrs(:, :, :, 4) )
- else if ( krrl >= 1 ) then
- call Budget_store_end( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) + zlocpexnm(:, :, :) * prrs(:, :, :, 2) )
- else
- call Budget_store_end( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) )
- end if
- end if
+ IF( LBUDGET_TH ) THEN
+ IF( KRRI >= 1 .AND. KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_TH), 'HTURB', PRTHLS(:, :, :) + ZLVOCPEXNM(:, :, :) * PRRS(:, :, :, 2) &
+ + ZLSOCPEXNM(:, :, :) * PRRS(:, :, :, 4) )
+ ELSE IF( KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_TH), 'HTURB', PRTHLS(:, :, :) + ZLOCPEXNM(:, :, :) * PRRS(:, :, :, 2) )
+ ELSE
+ CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_TH), 'HTURB', PRTHLS(:, :, :) )
+ END IF
+ END IF
- if ( lbudget_rv ) then
- if ( krri >= 1 .and. krrl >= 1 ) then
- call Budget_store_end( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) - prrs(:, :, :, 4) )
- else if ( krrl >= 1 ) then
- call Budget_store_end( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) )
- else
- call Budget_store_end( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) )
- end if
- end if
+ IF( LBUDGET_RV ) THEN
+ IF( KRRI >= 1 .AND. KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_RV), 'HTURB', PRRS(:, :, :, 1) - PRRS(:, :, :, 2) - PRRS(:, :, :, 4) )
+ ELSE IF( KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_RV), 'HTURB', PRRS(:, :, :, 1) - PRRS(:, :, :, 2) )
+ ELSE
+ CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_RV), 'HTURB', PRRS(:, :, :, 1) )
+ END IF
+ END IF
- if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HTURB', prrs(:, :, :, 2) )
- if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HTURB', prrs(:, :, :, 4) )
+ IF( LBUDGET_RC ) CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_RC), 'HTURB', PRRS(:, :, :, 2) )
+ IF( LBUDGET_RI ) CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_RI), 'HTURB', PRRS(:, :, :, 4) )
- if ( lbudget_sv ) then
- do jsv = 1, nsv
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'HTURB', prsvs(:, :, :, jsv) )
- end do
- end if
-end if
+ IF( LBUDGET_SV ) THEN
+ DO JSV = 1, NSV
+ CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_SV1 - 1 + JSV), 'HTURB', PRSVS(:, :, :, JSV) )
+ END DO
+ END IF
+#ifdef REPRO48
+#else
+END IF
+#endif
!----------------------------------------------------------------------------
!
!* 6. EVOLUTION OF THE TKE AND ITS DISSIPATION
@@ -1132,23 +1020,56 @@ end if
! 6.1 Contribution of mass-flux in the TKE buoyancy production if
! cloud computation is not statistical
- PTHP = PTHP + XG / PTHVREF * MZF( PFLXZTHVMF )
+PTP = PTP + XG / PTHVREF * MZF(PFLXZTHVMF,KKA, KKU, KKL)
+IF(PRESENT(PTPMF)) PTPMF=XG / PTHVREF * MZF(PFLXZTHVMF, KKA, KKU, KKL)
! 6.2 TKE evolution equation
-CALL TKE_EPS_SOURCES(KKA,KKU,KKL,KMI,PTKET,PLEM,ZLEPS,PDYP,ZTRH, &
- PRHODJ,PDZZ,PDXX,PDYY,PDZX,PDZY,PZZ, &
- PTSTEP,PIMPL,ZEXPL, &
- HTURBLEN,HTURBDIM, &
- TPFILE,OTURB_DIAG, &
- PTHP,PRTKES,PRTKEMS,PRTHLS,ZCOEF_DISS,PTR,PDISS )
-
+IF (.NOT. LHARAT) THEN
+!
+IF (LBUDGET_TH) THEN
+ IF ( KRRI >= 1 .AND. KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_TH), 'DISSH', PRTHLS+ ZLVOCPEXNM * PRRS(:,:,:,2) &
+ & + ZLSOCPEXNM * PRRS(:,:,:,4) )
+ ELSE IF ( KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_TH), 'DISSH', PRTHLS+ ZLOCPEXNM * PRRS(:,:,:,2) )
+ ELSE
+ CALL BUDGET_STORE_INIT( TBUDGETS(NBUDGET_TH), 'DISSH', PRTHLS(:, :, :) )
+ END IF
+END IF
+!
+IF(PRESENT(PRTKEMS)) THEN
+ ZRTKEMS=PRTKEMS
+ELSE
+ ZRTKEMS=0.
+END IF
+!
+CALL TKE_EPS_SOURCES(KKA,KKU,KKL,KMI,PTKET,ZLM,ZLEPS,PDP,ZTRH, &
+ & PRHODJ,PDZZ,PDXX,PDYY,PDZX,PDZY,PZZ, &
+ & PTSTEP,PIMPL,ZEXPL, &
+ & HTURBLEN,HTURBDIM, &
+ & TPFILE,OTURB_DIAG, &
+ & PTP,PRTKES,PRTHLS,ZCOEF_DISS,PTDIFF,PTDISS,ZRTKEMS,&
+ & TBUDGETS,KBUDGETS, PEDR=PEDR)
+IF (LBUDGET_TH) THEN
+ IF ( KRRI >= 1 .AND. KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_TH), 'DISSH', PRTHLS+ ZLVOCPEXNM * PRRS(:,:,:,2) &
+ & + ZLSOCPEXNM * PRRS(:,:,:,4) )
+ ELSE IF ( KRRL >= 1 ) THEN
+ CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_TH), 'DISSH', PRTHLS+ ZLOCPEXNM * PRRS(:,:,:,2) )
+ ELSE
+ CALL BUDGET_STORE_END( TBUDGETS(NBUDGET_TH), 'DISSH', PRTHLS(:, :, :) )
+ END IF
+END IF
+!
+ENDIF
+!
!----------------------------------------------------------------------------
!
!* 7. STORES SOME INFORMATIONS RELATED TO THE TURBULENCE SCHEME
! ---------------------------------------------------------
!
-IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
+IF ( OTURB_DIAG .AND. TPFILE%LOPENED ) THEN
!
! stores the mixing length
!
@@ -1162,7 +1083,7 @@ IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PLEM)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZLM)
!
IF (KRR /= 0) THEN
!
@@ -1178,7 +1099,7 @@ IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PTHLT)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,PTHLT)
!
! stores the conservative mixing ratio
!
@@ -1192,10 +1113,18 @@ IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PRT(:,:,:,1))
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,PRT(:,:,:,1))
END IF
END IF
!
+!* stores value of conservative variables & wind before turbulence tendency (AROME only)
+IF(PRESENT(PDRUS_TURB)) THEN
+ PDRUS_TURB = PRUS - PDRUS_TURB
+ PDRVS_TURB = PRVS - PDRVS_TURB
+ PDRTHLS_TURB = PRTHLS - PDRTHLS_TURB
+ PDRRTS_TURB = PRRS(:,:,:,1) - PDRRTS_TURB
+ PDRSVS_TURB = PRSVS - PDRSVS_TURB
+END IF
!----------------------------------------------------------------------------
!
!* 8. RETRIEVE NON-CONSERVATIVE VARIABLES
@@ -1221,8 +1150,7 @@ IF ( KRRL >= 1 ) THEN
END IF
! Remove non-physical negative values (unnecessary in a perfect world) + corresponding budgets
-call Sources_neg_correct( hcloud, 'NETUR', krr, ptstep, ppabst, pthlt, prt, prthls, prrs, prsvs )
-
+CALL SOURCES_NEG_CORRECT(HCLOUD, 'NETUR',KRR,PTSTEP,PPABST,PTHLT,PRT,PRTHLS,PRRS,PRSVS)
!----------------------------------------------------------------------------
!
!* 9. LES averaged surface fluxes
@@ -1260,14 +1188,14 @@ IF (LLES_CALL) THEN
CALL LES_MEAN_SUBGRID(2./3.*PTKET,X_LES_SUBGRID_U2)
X_LES_SUBGRID_V2 = X_LES_SUBGRID_U2
X_LES_SUBGRID_W2 = X_LES_SUBGRID_U2
- CALL LES_MEAN_SUBGRID(2./3.*PTKET*MZF(&
- & GZ_M_W(KKA,KKU,KKL,PTHLT,PDZZ)),X_LES_RES_ddz_Thl_SBG_W2)
+ CALL LES_MEAN_SUBGRID(2./3.*PTKET*MZF(GZ_M_W(KKA,KKU,KKL,PTHLT,PDZZ),&
+ KKA, KKU, KKL),X_LES_RES_ddz_Thl_SBG_W2)
IF (KRR>=1) &
- CALL LES_MEAN_SUBGRID(2./3.*PTKET*MZF(&
- & GZ_M_W(KKA,KKU,KKL,PRT(:,:,:,1),PDZZ)),X_LES_RES_ddz_Rt_SBG_W2)
+ CALL LES_MEAN_SUBGRID(2./3.*PTKET*MZF(GZ_M_W(KKA,KKU,KKL,PRT(:,:,:,1),PDZZ),&
+ &KKA, KKU, KKL),X_LES_RES_ddz_Rt_SBG_W2)
DO JSV=1,NSV
- CALL LES_MEAN_SUBGRID(2./3.*PTKET*MZF(&
- & GZ_M_W(KKA,KKU,KKL,PSVT(:,:,:,JSV),PDZZ)),X_LES_RES_ddz_Sv_SBG_W2(:,:,:,JSV))
+ CALL LES_MEAN_SUBGRID(2./3.*PTKET*MZF(GZ_M_W(KKA,KKU,KKL,PSVT(:,:,:,JSV),PDZZ), &
+ &KKA, KKU, KKL), X_LES_RES_ddz_Sv_SBG_W2(:,:,:,JSV))
END DO
END IF
@@ -1276,7 +1204,7 @@ IF (LLES_CALL) THEN
!* 12. LES mixing end dissipative lengths, presso-correlations
! -------------------------------------------------------
!
- CALL LES_MEAN_SUBGRID(PLEM,X_LES_SUBGRID_LMix)
+ CALL LES_MEAN_SUBGRID(ZLM,X_LES_SUBGRID_LMix)
CALL LES_MEAN_SUBGRID(ZLEPS,X_LES_SUBGRID_LDiss)
!
!* presso-correlations for subgrid Tke are equal to zero.
@@ -1287,12 +1215,11 @@ IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
-
-!
-
!
+IF(PRESENT(PLEM)) PLEM = ZLM
!----------------------------------------------------------------------------
!
+IF (LHOOK) CALL DR_HOOK('TURB',1,ZHOOK_HANDLE)
CONTAINS
!
!
@@ -1329,15 +1256,19 @@ REAL, DIMENSION(:,:), INTENT(INOUT) :: PUSLOPE,PVSLOPE
!
!* 0.2 Declarations of local variables :
!
-INTEGER :: IIB,IIE,IJB,IJE ! index values for the physical subdomain
+INTEGER :: IIB,IIE,IJB,IJE,IIU,IJU ! index values for the physical subdomain
TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
INTEGER :: IINFO_ll ! return code of parallel routine
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('TURB:UPDATE_ROTATE_WIND',0,ZHOOK_HANDLE)
!
!* 1 PROLOGUE
!
NULLIFY(TZFIELDS_ll)
!
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IIU=SIZE(PUSLOPE,1)
+IJU=SIZE(PUSLOPE,2)
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE,IIU,IJU)
!
! 2 Update halo if necessary
!
@@ -1367,6 +1298,8 @@ IF( HLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
PVSLOPE(:,IJE+1)=PVSLOPE(:,IJE)
END IF
!
+IF (LHOOK) CALL DR_HOOK('TURB:UPDATE_ROTATE_WIND',1,ZHOOK_HANDLE)
+!
END SUBROUTINE UPDATE_ROTATE_WIND
!
! ########################################################################
@@ -1409,6 +1342,8 @@ REAL, DIMENSION(SIZE(PEXN,1),SIZE(PEXN,2),SIZE(PEXN,3)) :: ZDRVSATDT
!
!-------------------------------------------------------------------------------
!
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+ IF (LHOOK) CALL DR_HOOK('TURB:COMPUTE_FUNCTION_THERMO',0,ZHOOK_HANDLE)
ZEPS = XMV / XMD
!
!* 1.1 Lv/Cph at t
@@ -1450,6 +1385,7 @@ REAL, DIMENSION(SIZE(PEXN,1),SIZE(PEXN,2),SIZE(PEXN,3)) :: ZDRVSATDT
!
PLOCPEXN(:,:,:) = PLOCPEXN(:,:,:) / PEXN(:,:,:)
!
+IF (LHOOK) CALL DR_HOOK('TURB:COMPUTE_FUNCTION_THERMO',1,ZHOOK_HANDLE)
END SUBROUTINE COMPUTE_FUNCTION_THERMO
!
! ####################
@@ -1483,6 +1419,8 @@ REAL :: ZD ! distance to the surface
!
!-------------------------------------------------------------------------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('TURB:DELT',0,ZHOOK_HANDLE)
IF (ODZ) THEN
! Dz is take into account in the computation
DO JK = IKTB,IKTE ! 1D turbulence scheme
@@ -1508,7 +1446,6 @@ ELSE
END IF
END IF
END IF
-
!
! mixing length limited by the distance normal to the surface
! (with the same factor as for BL89)
@@ -1518,7 +1455,7 @@ IF (.NOT. ORMC01) THEN
!
DO JJ=1,SIZE(PUT,2)
DO JI=1,SIZE(PUT,1)
- IF (LOCEAN) THEN
+ IF (OOCEAN) THEN
DO JK=IKTE,IKTB,-1
ZD=ZALPHA*(PZZ(JI,JJ,IKTE+1)-PZZ(JI,JJ,JK))
IF ( PLM(JI,JJ,JK)>ZD) THEN
@@ -1545,6 +1482,7 @@ END IF
PLM(:,:,KKA) = PLM(:,:,IKB )
PLM(:,:,KKU ) = PLM(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('TURB:DELT',1,ZHOOK_HANDLE)
END SUBROUTINE DELT
!
! ####################
@@ -1588,6 +1526,8 @@ REAL, DIMENSION(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)) :: &
!-------------------------------------------------------------------------------
!
! initialize the mixing length with the mesh grid
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('TURB:DEAR',0,ZHOOK_HANDLE)
! 1D turbulence scheme
PLM(:,:,IKTB:IKTE) = PZZ(:,:,IKTB+KKL:IKTE+KKL) - PZZ(:,:,IKTB:IKTE)
PLM(:,:,KKU) = PLM(:,:,IKE)
@@ -1601,8 +1541,8 @@ IF ( HTURBDIM /= '1DIM' ) THEN ! 3D turbulence scheme
END IF
! compute a mixing length limited by the stability
!
-ZETHETA(:,:,:) = ETHETA(KRR,KRRI,PTHLT,PRT,ZLOCPEXNM,ZATHETA,PSRCT)
-ZEMOIST(:,:,:) = EMOIST(KRR,KRRI,PTHLT,PRT,ZLOCPEXNM,ZAMOIST,PSRCT)
+ZETHETA(:,:,:) = ETHETA(KRR,KRRI,PTHLT,PRT,ZLOCPEXNM,ZATHETA,PSRCT,OOCEAN)
+ZEMOIST(:,:,:) = EMOIST(KRR,KRRI,PTHLT,PRT,ZLOCPEXNM,ZAMOIST,PSRCT,OOCEAN)
!
IF (KRR>0) THEN
DO JK = IKTB+1,IKTE-1
@@ -1612,7 +1552,7 @@ IF (KRR>0) THEN
(PTHLT(JI,JJ,JK )-PTHLT(JI,JJ,JK-KKL))/PDZZ(JI,JJ,JK ))
ZDRTDZ(JI,JJ,JK) = 0.5*((PRT(JI,JJ,JK+KKL,1)-PRT(JI,JJ,JK ,1))/PDZZ(JI,JJ,JK+KKL)+ &
(PRT(JI,JJ,JK ,1)-PRT(JI,JJ,JK-KKL,1))/PDZZ(JI,JJ,JK ))
- IF (LOCEAN) THEN
+ IF (OOCEAN) THEN
ZVAR=XG*(XALPHAOC*ZDTHLDZ(JI,JJ,JK)-XBETAOC*ZDRTDZ(JI,JJ,JK))
ELSE
ZVAR=XG/PTHVREF(JI,JJ,JK)* &
@@ -1632,7 +1572,7 @@ ELSE! For dry atmos or unsalted ocean runs
DO JI=1,SIZE(PUT,1)
ZDTHLDZ(JI,JJ,JK)= 0.5*((PTHLT(JI,JJ,JK+KKL)-PTHLT(JI,JJ,JK ))/PDZZ(JI,JJ,JK+KKL)+ &
(PTHLT(JI,JJ,JK )-PTHLT(JI,JJ,JK-KKL))/PDZZ(JI,JJ,JK ))
- IF (LOCEAN) THEN
+ IF (OOCEAN) THEN
ZVAR= XG*XALPHAOC*ZDTHLDZ(JI,JJ,JK)
ELSE
ZVAR= XG/PTHVREF(JI,JJ,JK)*ZETHETA(JI,JJ,JK)*ZDTHLDZ(JI,JJ,JK)
@@ -1655,7 +1595,7 @@ ELSE
ZDRTDZ(:,:,IKB)=0
ENDIF
!
-IF (LOCEAN) THEN
+IF (OOCEAN) THEN
ZWORK2D(:,:)=XG*(XALPHAOC*ZDTHLDZ(:,:,IKB)-XBETAOC*ZDRTDZ(:,:,IKB))
ELSE
ZWORK2D(:,:)=XG/PTHVREF(:,:,IKB)* &
@@ -1673,7 +1613,7 @@ IF (.NOT. ORMC01) THEN
!
DO JJ=1,SIZE(PUT,2)
DO JI=1,SIZE(PUT,1)
- IF (LOCEAN) THEN
+ IF (OOCEAN) THEN
DO JK=IKTE,IKTB,-1
ZD=ZALPHA*(PZZ(JI,JJ,IKTE+1)-PZZ(JI,JJ,JK))
IF ( PLM(JI,JJ,JK)>ZD) THEN
@@ -1701,6 +1641,7 @@ PLM(:,:,KKA) = PLM(:,:,IKB )
PLM(:,:,IKE ) = PLM(:,:,IKE-KKL)
PLM(:,:,KKU ) = PLM(:,:,KKU-KKL)
!
+IF (LHOOK) CALL DR_HOOK('TURB:DEAR',1,ZHOOK_HANDLE)
END SUBROUTINE DEAR
!
! #########################
@@ -1768,6 +1709,8 @@ REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZLM_CLOUD
!* 1. INITIALISATION
! --------------
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('TURB:CLOUD_MODIF_LM',0,ZHOOK_HANDLE)
ZPENTE = ( PCOEF_AMPL_SAT - 1. ) / ( PCEI_MAX - PCEI_MIN )
ZCOEF_AMPL_CEI_NUL = 1. - ZPENTE * PCEI_MIN
!
@@ -1792,7 +1735,7 @@ WHERE ( PCEI(:,:,:) < PCEI_MAX .AND. &
! ------------------------------------------
!
IF (HTURBLEN_CL == HTURBLEN) THEN
- ZLM_CLOUD(:,:,:) = PLEM(:,:,:)
+ ZLM_CLOUD(:,:,:) = ZLM(:,:,:)
ELSE
SELECT CASE (HTURBLEN_CL)
!
@@ -1800,7 +1743,7 @@ ELSE
! ------------------
CASE ('BL89','RM17','ADAP')
ZSHEAR=0.
- CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,ZLM_CLOUD)
+ CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,ZLM_CLOUD,OOCEAN)
!
!* 3.2 Delta mixing length
! -------------------
@@ -1819,7 +1762,7 @@ ENDIF
! -----------------------------------------------
!
! Impression before modification of the mixing length
-IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
+IF ( OTURB_DIAG .AND. TPFILE%LOPENED ) THEN
TZFIELD%CMNHNAME = 'LM_CLEAR_SKY'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'LM_CLEAR_SKY'
@@ -1830,22 +1773,22 @@ IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PLEM)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZLM)
ENDIF
!
! Amplification of the mixing length when the criteria are verified
!
-WHERE (ZCOEF_AMPL(:,:,:) /= 1.) PLEM(:,:,:) = ZCOEF_AMPL(:,:,:)*ZLM_CLOUD(:,:,:)
+WHERE (ZCOEF_AMPL(:,:,:) /= 1.) ZLM(:,:,:) = ZCOEF_AMPL(:,:,:)*ZLM_CLOUD(:,:,:)
!
! Cloud mixing length in the clouds at the points which do not verified the CEI
!
-WHERE (PCEI(:,:,:) == -1.) PLEM(:,:,:) = ZLM_CLOUD(:,:,:)
+WHERE (PCEI(:,:,:) == -1.) ZLM(:,:,:) = ZLM_CLOUD(:,:,:)
!
!
!* 5. IMPRESSION
! ----------
!
-IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
+IF ( OTURB_DIAG .AND. TPFILE%LOPENED ) THEN
TZFIELD%CMNHNAME = 'COEF_AMPL'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'COEF_AMPL'
@@ -1856,7 +1799,7 @@ IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZCOEF_AMPL)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZCOEF_AMPL)
!
TZFIELD%CMNHNAME = 'LM_CLOUD'
TZFIELD%CSTDNAME = ''
@@ -1867,10 +1810,11 @@ IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
- CALL IO_Field_write(TPFILE,TZFIELD,ZLM_CLOUD)
+ CALL IO_FIELD_WRITE(TPFILE,TZFIELD,ZLM_CLOUD)
!
ENDIF
!
+IF (LHOOK) CALL DR_HOOK('TURB:CLOUD_MODIF_LM',1,ZHOOK_HANDLE)
END SUBROUTINE CLOUD_MODIF_LM
!
END SUBROUTINE TURB
diff --git a/src/mesonh/aux/gradient_m.f90 b/src/mesonh/aux/gradient_m.f90
new file mode 100644
index 0000000000000000000000000000000000000000..60e7ffa577571ed62fb3f0c88ed9d63cb843b42a
--- /dev/null
+++ b/src/mesonh/aux/gradient_m.f90
@@ -0,0 +1,754 @@
+!MNH_LIC Copyright 1994-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_GRADIENT_M
+! ######################
+!
+INTERFACE
+!
+!
+FUNCTION GX_M_M(PA,PDXX,PDZZ,PDZX,KKA,KKU,KL) RESULT(PGX_M_M)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes (AROME)
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (AROME)
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_M_M ! result mass point
+!
+END FUNCTION GX_M_M
+!
+!
+FUNCTION GY_M_M(PA,PDYY,PDZZ,PDZY,KKA,KKU,KL) RESULT(PGY_M_M)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes (AROME)
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (AROME)
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_M_M ! result mass point
+!
+END FUNCTION GY_M_M
+!
+!
+FUNCTION GZ_M_M(PA,PDZZ,KKA,KKU,KL) RESULT(PGZ_M_M)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes (AROME)
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (AROME)
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_M_M ! result mass point
+!
+END FUNCTION GZ_M_M
+!
+ FUNCTION GX_M_U(KKA,KKU,KL,PY,PDXX,PDZZ,PDZX) RESULT(PGX_M_U)
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! d*xx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! d*zx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! d*zz
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PY ! variable at mass
+ ! localization
+REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2),SIZE(PY,3)) :: PGX_M_U ! result at flux
+ ! side
+END FUNCTION GX_M_U
+!
+!
+ FUNCTION GY_M_V(KKA,KKU,KL,PY,PDYY,PDZZ,PDZY) RESULT(PGY_M_V)
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY !d*yy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY !d*zy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ !d*zz
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PY ! variable at mass
+ ! localization
+REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2),SIZE(PY,3)) :: PGY_M_V ! result at flux
+ ! side
+END FUNCTION GY_M_V
+!
+ FUNCTION GZ_M_W(KKA, KKU, KL,PY,PDZZ) RESULT(PGZ_M_W)
+!
+IMPLICIT NONE
+!
+ ! Metric coefficient:
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ !d*zz
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PY ! variable at mass
+ ! localization
+REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2),SIZE(PY,3)) :: PGZ_M_W ! result at flux
+ ! side
+!
+END FUNCTION GZ_M_W
+!
+END INTERFACE
+!
+END MODULE MODI_GRADIENT_M
+!
+!
+!
+! #######################################################
+ FUNCTION GX_M_M(PA,PDXX,PDZZ,PDZX,KKA,KKU,KL) RESULT(PGX_M_M)
+! #######################################################
+!
+!!**** *GX_M_M* - Cartesian Gradient operator:
+!! computes the gradient in the cartesian X
+!! direction for a variable placed at the
+!! mass point and the result is placed at
+!! the mass point.
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the discrete gradient
+! along the X cartesian direction for a field PA placed at the
+! mass point. The result is placed at the mass point.
+!
+!
+! ( ______________z )
+! ( (___x ) )
+! 1 ( _x (d*zx dzm(PA) ) )
+! PGX_M_M = ---- (dxf(PA) - (------------)) )
+! ___x ( ( ) )
+! d*xx ( ( d*zz ) )
+!
+!
+!
+!!** METHOD
+!! ------
+!! The Chain rule of differencing is applied to variables expressed
+!! in the Gal-Chen & Somerville coordinates to obtain the gradient in
+!! the cartesian system
+!!
+!! EXTERNAL
+!! --------
+!! MXM,MXF,MZF : Shuman functions (mean operators)
+!! DXF,DZF : Shuman functions (finite difference operators)
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! MODD_CONF : LFLAT
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (GRAD_CAR operators)
+!! A Turbulence scheme for the Meso-NH model (Chapter 6)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart *INM and Meteo-France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 18/07/94
+!! 19/07/00 add the LFLAT switch (J. Stein)
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!-------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODI_SHUMAN
+USE MODD_CONF, ONLY:LFLAT
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes (AROME)
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (AROME)
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_M_M ! result mass point
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GX_M_M
+! --------------------
+!
+IF (.NOT. LFLAT) THEN
+ PGX_M_M(:,:,:)= (DXF(MXM(PA(:,:,:))) - &
+ MZF(MXF(PDZX)*DZM(PA(:,:,:)) &
+ /PDZZ(:,:,:)) ) /MXF(PDXX(:,:,:))
+ELSE
+ PGX_M_M(:,:,:)=DXF(MXM(PA(:,:,:))) / MXF(PDXX(:,:,:))
+END IF
+!
+!----------------------------------------------------------------------------
+!
+END FUNCTION GX_M_M
+!
+!
+! #######################################################
+ FUNCTION GY_M_M(PA,PDYY,PDZZ,PDZY,KKA,KKU,KL) RESULT(PGY_M_M)
+! #######################################################
+!
+!!**** *GY_M_M* - Cartesian Gradient operator:
+!! computes the gradient in the cartesian Y
+!! direction for a variable placed at the
+!! mass point and the result is placed at
+!! the mass point.
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the discrete gradient
+! along the Y cartesian direction for a field PA placed at the
+! mass point. The result is placed at the mass point.
+!
+!
+! ( ______________z )
+! ( (___y ) )
+! 1 ( _y (d*zy dzm(PA) ) )
+! PGY_M_M = ---- (dyf(PA) - (------------)) )
+! ___y ( ( ) )
+! d*yy ( ( d*zz ) )
+!
+!
+!!** METHOD
+!! ------
+!! The Chain rule of differencing is applied to variables expressed
+!! in the Gal-Chen & Somerville coordinates to obtain the gradient in
+!! the cartesian system
+!!
+!! EXTERNAL
+!! --------
+!! MYM,MYF,MZF : Shuman functions (mean operators)
+!! DYF,DZF : Shuman functions (finite difference operators)
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! MODD_CONF : LFLAT
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (GRAD_CAR operators)
+!! A Turbulence scheme for the Meso-NH model (Chapter 6)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart *INM and Meteo-France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 18/07/94
+!! 19/07/00 add the LFLAT switch (J. Stein)
+!-------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODD_CONF, ONLY:LFLAT
+USE MODI_SHUMAN
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes (AROME)
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (AROME)
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_M_M ! result mass point
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GY_M_M
+! --------------------
+!
+!
+IF (.NOT. LFLAT) THEN
+ PGY_M_M(:,:,:)= (DYF(MYM(PA))-MZF(MYF(PDZY)*DZM(PA)&
+ /PDZZ) ) /MYF(PDYY)
+ELSE
+ PGY_M_M(:,:,:)= DYF(MYM(PA))/MYF(PDYY)
+ENDIF
+!
+!----------------------------------------------------------------------------
+!
+END FUNCTION GY_M_M
+
+!
+!
+!
+! #############################################
+ FUNCTION GZ_M_M(PA,PDZZ) RESULT(PGZ_M_M)
+! #############################################
+!
+!!**** *GZ_M_M* - Cartesian Gradient operator:
+!! computes the gradient in the cartesian Z
+!! direction for a variable placed at the
+!! mass point and the result is placed at
+!! the mass point.
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the discrete gradient
+! along the Z cartesian direction for a field PA placed at the
+! mass point. The result is placed at the mass point.
+!
+! _________z
+! (dzm(PA))
+! PGZ_M_M = (------ )
+! ( d*zz )
+!
+!
+!!** METHOD
+!! ------
+!! The Chain rule of differencing is applied to variables expressed
+!! in the Gal-Chen & Somerville coordinates to obtain the gradient in
+!! the cartesian system
+!!
+!! EXTERNAL
+!! --------
+!! MZF : Shuman functions (mean operators)
+!! DZM : Shuman functions (finite difference operators)
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (GRAD_CAR operators)
+!! A Turbulence scheme for the Meso-NH model (Chapter 6)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart *INM and Meteo-France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 18/07/94
+!-------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODI_SHUMAN
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_M_M ! result mass point
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GZ_M_M
+! --------------------
+!
+PGZ_M_M(:,:,:)= MZF( DZM(PA(:,:,:))/PDZZ(:,:,:) )
+!
+!----------------------------------------------------------------------------
+!
+END FUNCTION GZ_M_M
+!
+!
+! ##################################################
+ FUNCTION GX_M_U(KKA,KKU,KL,PY,PDXX,PDZZ,PDZX) RESULT(PGX_M_U)
+! ##################################################
+!
+!!**** *GX_M_U * - Compute the gradient along x for a variable localized at
+!! a mass point
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to compute a gradient along x
+! direction for a field PY localized at a mass point. The result PGX_M_U
+! is localized at a x-flux point (u point).
+!
+! ( ____________z )
+! ( ________x )
+! 1 ( dzm(PY) )
+! PGX_M_U = ---- (dxm(PY) - d*zx -------- )
+! d*xx ( d*zz )
+!
+!
+!
+!!** METHOD
+!! ------
+!! We employ the Shuman operators to compute the derivatives and the
+!! averages. The metric coefficients PDXX,PDZX,PDZZ are dummy arguments.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! FUNCTION DXM: compute a finite difference along the x direction for
+!! a variable at a mass localization
+!! FUNCTION DZM: compute a finite difference along the y direction for
+!! a variable at a mass localization
+!! FUNCTION MXM: compute an average in the x direction for a variable
+!! at a mass localization
+!! FUNCTION MZF: compute an average in the z direction for a variable
+!! at a flux side
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! MODD_CONF : LFLAT
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation (function GX_M_U)
+!!
+!!
+!! AUTHOR
+!! ------
+!! P. Hereil and J. Stein * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/07/94
+!! Modification 16/03/95 change the order of the arguments
+!! 19/07/00 add the LFLAT switch + inlining(J. Stein)
+!! 20/08/00 optimization (J. Escobar)
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODI_SHUMAN
+USE MODD_CONF, ONLY:LFLAT
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and result
+! ------------------------------------
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! d*xx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! d*zx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! d*zz
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PY ! variable at mass
+ ! localization
+REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2),SIZE(PY,3)) :: PGX_M_U ! result at flux
+ ! side
+INTEGER IIU,IKU,JI,JK
+!
+INTEGER :: JJK,IJU
+INTEGER :: JIJK,JIJKOR,JIJKEND
+INTEGER :: JI_1JK, JIJK_1, JI_1JK_1, JIJKP1, JI_1JKP1
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE GRADIENT ALONG X
+! -----------------------------
+!
+IIU=SIZE(PY,1)
+IJU=SIZE(PY,2)
+IKU=SIZE(PY,3)
+IF (.NOT. LFLAT) THEN
+! PGX_M_U = ( DXM(PY) - MZF ( MXM( DZM(PY) /PDZZ ) * PDZX ) )/PDXX
+!! DO JK=1+JPVEXT_TURB,IKU-JPVEXT_TURB
+!! DO JI=1+JPHEXT,IIU
+!! PGX_M_U(JI,:,JK)= &
+!! ( PY(JI,:,JK)-PY(JI-1,:,JK) &
+!! -( (PY(JI,:,JK)-PY(JI,:,JK-1)) / PDZZ(JI,:,JK) &
+!! +(PY(JI-1,:,JK)-PY(JI-1,:,JK-1)) / PDZZ(JI-1,:,JK) &
+!! ) * PDZX(JI,:,JK)* 0.25 &
+!! -( (PY(JI,:,JK+1)-PY(JI,:,JK)) / PDZZ(JI,:,JK+1) &
+!! +(PY(JI-1,:,JK+1)-PY(JI-1,:,JK)) / PDZZ(JI-1,:,JK+1) &
+!! ) * PDZX(JI,:,JK+1)* 0.25 &
+!! ) / PDXX(JI,:,JK)
+!! END DO
+!! END DO
+ JIJKOR = 1 + JPHEXT + IIU*IJU*(JPVEXT_TURB+1 - 1)
+ JIJKEND = IIU*IJU*(IKU-JPVEXT_TURB)
+!CDIR NODEP
+!OCL NOVREC
+ DO JIJK=JIJKOR , JIJKEND
+! indexation
+ JI_1JK = JIJK - 1
+ JIJK_1 = JIJK - IIU*IJU*KL
+ JI_1JK_1 = JIJK - 1 - IIU*IJU*KL
+ JIJKP1 = JIJK + IIU*IJU*KL
+ JI_1JKP1 = JIJK - 1 + IIU*IJU*KL
+!
+ PGX_M_U(JIJK,1,1)= &
+ ( PY(JIJK,1,1)-PY(JI_1JK,1,1) &
+ -( (PY(JIJK,1,1)-PY(JIJK_1,1,1)) / PDZZ(JIJK,1,1) &
+ +(PY(JI_1JK,1,1)-PY(JI_1JK_1,1,1)) / PDZZ(JI_1JK,1,1) &
+ ) * PDZX(JIJK,1,1)* 0.25 &
+ -( (PY(JIJKP1,1,1)-PY(JIJK,1,1)) / PDZZ(JIJKP1,1,1) &
+ +(PY(JI_1JKP1,1,1)-PY(JI_1JK,1,1)) / PDZZ(JI_1JKP1,1,1) &
+ ) * PDZX(JIJKP1,1,1)* 0.25 &
+ ) / PDXX(JIJK,1,1)
+ END DO
+
+!
+ DO JI=1+JPHEXT,IIU
+ PGX_M_U(JI,:,KKU)= ( PY(JI,:,KKU)-PY(JI-1,:,KKU) ) / PDXX(JI,:,KKU)
+ PGX_M_U(JI,:,KKA)= PGX_M_U(JI,:,KKU) ! -999.
+ END DO
+ELSE
+! PGX_M_U = DXM(PY) / PDXX
+ PGX_M_U(1+1:IIU,:,:) = ( PY(1+1:IIU,:,:)-PY(1:IIU-1,:,:) ) & ! +JPHEXT
+ / PDXX(1+1:IIU,:,:)
+ENDIF
+DO JI=1,JPHEXT
+ PGX_M_U(JI,:,:)=PGX_M_U(IIU-2*JPHEXT+JI,:,:) ! for reprod JPHEXT <> 1
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END FUNCTION GX_M_U
+!
+!
+! ##################################################
+ FUNCTION GY_M_V(KKA,KKU,KL,PY,PDYY,PDZZ,PDZY) RESULT(PGY_M_V)
+! ##################################################
+!
+!!**** *GY_M_V * - Compute the gradient along y for a variable localized at
+!! a mass point
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to compute a gradient along y
+! direction for a field PY localized at a mass point. The result PGY_M_V
+! is localized at a y-flux point (v point).
+!
+! ( ____________z )
+! ( ________y )
+! 1 ( dzm(PY) )
+! PGY_M_V = ---- (dym(PY) - d*zy -------- )
+! d*yy ( d*zz )
+!
+!
+!
+!
+!!** METHOD
+!! ------
+!! We employ the Shuman operators to compute the derivatives and the
+!! averages. The metric coefficients PDYY,PDZY,PDZZ are dummy arguments.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! FUNCTION DYM: compute a finite difference along the y direction for
+!! a variable at a mass localization
+!! FUNCTION DZM: compute a finite difference along the y direction for
+!! a variable at a mass localization
+!! FUNCTION MYM: compute an average in the x direction for a variable
+!! at a mass localization
+!! FUNCTION MZF: compute an average in the z direction for a variable
+!! at a flux side
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! MODD_CONF : LFLAT
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation (function GY_M_V)
+!!
+!!
+!! AUTHOR
+!! ------
+!! P. Hereil and J. Stein * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/07/94
+!! Modification 16/03/95 change the order of the arguments
+!! 19/07/00 add the LFLAT switch + inlining(J. Stein)
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODI_SHUMAN
+USE MODD_CONF, ONLY:LFLAT
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+! -------------------------------------
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY !d*yy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY !d*zy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ !d*zz
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PY ! variable at mass
+ ! localization
+REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2),SIZE(PY,3)) :: PGY_M_V ! result at flux
+ ! side
+INTEGER IJU,IKU,JJ,JK
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE GRADIENT ALONG Y
+! ----------------------------
+!
+IJU=SIZE(PY,2)
+IKU=SIZE(PY,3)
+IF (.NOT. LFLAT) THEN
+! PGY_M_V = ( DYM(PY) - MZF ( MYM( DZM(PY) /PDZZ ) * PDZY ) )/PDYY
+ DO JK=1+JPVEXT_TURB,IKU-JPVEXT_TURB
+ DO JJ=1+JPHEXT,IJU
+ PGY_M_V(:,JJ,JK)= &
+ ( PY(:,JJ,JK)-PY(:,JJ-1,JK) &
+ -( (PY(:,JJ,JK)-PY(:,JJ,JK-KL)) / PDZZ(:,JJ,JK) &
+ +(PY(:,JJ-1,JK)-PY(:,JJ-KL,JK-KL)) / PDZZ(:,JJ-1,JK) &
+ ) * PDZY(:,JJ,JK)* 0.25 &
+ -( (PY(:,JJ,JK+KL)-PY(:,JJ,JK)) / PDZZ(:,JJ,JK+KL) &
+ +(PY(:,JJ-1,JK+KL)-PY(:,JJ-1,JK)) / PDZZ(:,JJ-1,JK+KL) &
+ ) * PDZY(:,JJ,JK+KL)* 0.25 &
+ ) / PDYY(:,JJ,JK)
+ END DO
+ END DO
+!
+ DO JJ=1+JPHEXT,IJU
+ PGY_M_V(:,JJ,KKU)= ( PY(:,JJ,KKU)-PY(:,JJ-1,KKU) ) / PDYY(:,JJ,KKU)
+ PGY_M_V(:,JJ,KKA)= PGY_M_V(:,JJ,KKU) ! -999.
+ END DO
+ELSE
+! PGY_M_V = DYM(PY)/PDYY
+ PGY_M_V(:,1+1:IJU,:) = ( PY(:,1+1:IJU,:)-PY(:,1:IJU-1,:) ) & ! +JPHEXT
+ / PDYY(:,1+1:IJU,:)
+ENDIF
+DO JJ=1,JPHEXT
+ PGY_M_V(:,JJ,:)=PGY_M_V(:,IJU-2*JPHEXT+JJ,:)
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END FUNCTION GY_M_V
+!
+!
+! #########################################
+ FUNCTION GZ_M_W(KKA,KKU,KL,PY,PDZZ) RESULT(PGZ_M_W)
+! #########################################
+!
+!!**** *GZ_M_W * - Compute the gradient along z direction for a
+!! variable localized at a mass point
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to compute a gradient along x,y,z
+! directions for a field PY localized at a mass point. The result PGZ_M_W
+! is localized at a z-flux point (w point)
+!
+!
+! dzm(PY)
+! PGZ_M_W = -------
+! d*zz
+!
+!!** METHOD
+!! ------
+!! We employ the Shuman operators to compute the derivatives and the
+!! averages. The metric coefficients PDZZ are dummy arguments.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! FUNCTION DZM : compute a finite difference along the z
+!! direction for a variable at a mass localization
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODI_SHUMAN : interface for the Shuman functions
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation (function GZ_M_W)
+!!
+!!
+!! AUTHOR
+!! ------
+!! P. Hereil and J. Stein * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/07/94
+!! Modification 16/03/95 change the order of the arguments
+!! 19/07/00 inlining(J. Stein)
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODI_SHUMAN
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+! -------------------------------------
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+
+ ! Metric coefficient:
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ !d*zz
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PY ! variable at mass
+ ! localization
+REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2),SIZE(PY,3)) :: PGZ_M_W ! result at flux
+ ! side
+!
+INTEGER :: IKT,IKTB,IKTE
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE GRADIENT ALONG Z
+! -----------------------------
+!
+IKT=SIZE(PY,3)
+IKTB=1+JPVEXT_TURB
+IKTE=IKT-JPVEXT_TURB
+
+PGZ_M_W(:,:,IKTB:IKTE) = (PY(:,:,IKTB:IKTE)-PY(:,:,IKTB-KL:IKTE-KL)) &
+ / PDZZ(:,:,IKTB:IKTE)
+PGZ_M_W(:,:,KKU)= (PY(:,:,KKU)-PY(:,:,KKU-KL)) &
+ / PDZZ(:,:,KKU)
+PGZ_M_W(:,:,KKA)= PGZ_M_W(:,:,KKU) ! -999.
+!
+!-------------------------------------------------------------------------------
+!
+END FUNCTION GZ_M_W
+
diff --git a/src/mesonh/aux/gradient_u.f90 b/src/mesonh/aux/gradient_u.f90
new file mode 100644
index 0000000000000000000000000000000000000000..1b82a616a9d4fa55add91fa4b321b2b93f586bf9
--- /dev/null
+++ b/src/mesonh/aux/gradient_u.f90
@@ -0,0 +1,334 @@
+!MNH_LIC Copyright 1994-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_GRADIENT_U
+! ######################
+!
+INTERFACE
+!
+!
+FUNCTION GX_U_M(PA,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_U_M)
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_U_M ! result mass point
+!
+END FUNCTION GX_U_M
+!
+!
+FUNCTION GY_U_UV(PA,PDYY,PDZZ,PDZY, KKA, KKU, KL) RESULT(PGY_U_UV)
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_U_UV ! result UV point
+!
+END FUNCTION GY_U_UV
+!
+!
+FUNCTION GZ_U_UW(PA,PDZZ, KKA, KKU, KL) RESULT(PGZ_U_UW)
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_U_UW ! result UW point
+!
+END FUNCTION GZ_U_UW
+!
+END INTERFACE
+!
+END MODULE MODI_GRADIENT_U
+!
+!
+!
+!
+! #######################################################
+ FUNCTION GX_U_M(PA,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_U_M)
+! #######################################################
+!
+!!**** *GX_U_M* - Cartesian Gradient operator:
+!! computes the gradient in the cartesian X
+!! direction for a variable placed at the
+!! U point and the result is placed at
+!! the mass point.
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the discrete gradient
+! along the X cartesian direction for a field PA placed at the
+! U point. The result is placed at the mass point.
+!
+!
+! ( ______________z )
+! ( (___________x ) )
+! 1 ( (d*zx dzm(PA) ) )
+! PGX_U_M = ---- (dxf(PA) - (------------)) )
+! ___x ( ( ) )
+! d*xx ( ( d*zz ) )
+!
+!
+!
+!!** METHOD
+!! ------
+!! The Chain rule of differencing is applied to variables expressed
+!! in the Gal-Chen & Somerville coordinates to obtain the gradient in
+!! the cartesian system
+!!
+!! EXTERNAL
+!! --------
+!! MXF,MZF : Shuman functions (mean operators)
+!! DXF,DZF : Shuman functions (finite difference operators)
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (GRAD_CAR operators)
+!! A Turbulence scheme for the Meso-NH model (Chapter 6)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart *INM and Meteo-France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 19/07/94
+!! 18/10/00 (V.Masson) add LFLAT switch
+!-------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODI_SHUMAN
+USE MODD_CONF
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_U_M ! result mass point
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GX_U_M
+! --------------------
+!
+IF (.NOT. LFLAT) THEN
+ PGX_U_M(:,:,:)= ( DXF(PA) - &
+ MZF(MXF(PDZX*DZM(PA)) / PDZZ ) &
+ ) / MXF(PDXX)
+ELSE
+ PGX_U_M(:,:,:)= DXF(PA) / MXF(PDXX)
+END IF
+!
+!----------------------------------------------------------------------------
+!
+END FUNCTION GX_U_M
+!
+!
+! #########################################################
+ FUNCTION GY_U_UV(PA,PDYY,PDZZ,PDZY, KKA, KKU, KL) RESULT(PGY_U_UV)
+! #########################################################
+!
+!!**** *GY_U_UV* - Cartesian Gradient operator:
+!! computes the gradient in the cartesian Y
+!! direction for a variable placed at the
+!! U point and the result is placed at
+!! the UV vorticity point.
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the discrete gradient
+! along the Y cartesian direction for a field PA placed at the
+! U point. The result is placed at the UV vorticity point.
+!
+!
+!
+! ( _________________z )
+! ( (___x _________y ) )
+! 1 ( (d*zy (dzm(PA))) ) )
+! PGY_U_UV= ---- (dym(PA) - ( (------ ) ) )
+! ___x ( ( ( ___x ) ) )
+! d*yy ( ( ( d*zz ) ) )
+!
+!
+!
+!!** METHOD
+!! ------
+!! The Chain rule of differencing is applied to variables expressed
+!! in the Gal-Chen & Somerville coordinates to obtain the gradient in
+!! the cartesian system
+!!
+!! EXTERNAL
+!! --------
+!! MXM,MYM,MZF : Shuman functions (mean operators)
+!! DYM,DZM : Shuman functions (finite difference operators)
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (GRAD_CAR operators)
+!! A Turbulence scheme for the Meso-NH model (Chapter 6)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart *INM and Meteo-France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 20/07/94
+!! 18/10/00 (V.Masson) add LFLAT switch
+!-------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODI_SHUMAN
+USE MODD_CONF
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_U_UV ! result UV point
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GY_U_UV
+! ---------------------
+!
+IF (.NOT. LFLAT) THEN
+ PGY_U_UV(:,:,:)= (DYM(PA)- MZF( MYM( DZM(PA)/&
+ MXM(PDZZ) ) *MXM(PDZY) ) ) / MXM(PDYY)
+ELSE
+ PGY_U_UV(:,:,:)= DYM(PA) / MXM(PDYY)
+END IF
+!
+!----------------------------------------------------------------------------
+!
+END FUNCTION GY_U_UV
+!
+!
+! #######################################################
+ FUNCTION GZ_U_UW(PA,PDZZ, KKA, KKU, KL) RESULT(PGZ_U_UW)
+! #######################################################
+!
+!!**** *GZ_U_UW - Cartesian Gradient operator:
+!! computes the gradient in the cartesian Z
+!! direction for a variable placed at the
+!! U point and the result is placed at
+!! the UW vorticity point.
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the discrete gradient
+! along the Z cartesian direction for a field PA placed at the
+! U point. The result is placed at the UW vorticity point.
+!
+! dzm(PA)
+! PGZ_U_UW = ------
+! ____x
+! d*zz
+!
+!!** METHOD
+!! ------
+!! The Chain rule of differencing is applied to variables expressed
+!! in the Gal-Chen & Somerville coordinates to obtain the gradient in
+!! the cartesian system
+!!
+!! EXTERNAL
+!! --------
+!! MXM : Shuman functions (mean operators)
+!! DZM : Shuman functions (finite difference operators)
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (GRAD_CAR operators)
+!! A Turbulence scheme for the Meso-NH model (Chapter 6)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart *INM and Meteo-France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 20/07/94
+!-------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODI_SHUMAN
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_U_UW ! result UW point
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GZ_U_UW
+! ---------------------
+!
+PGZ_U_UW(:,:,:)= DZM(PA) / MXM(PDZZ)
+!
+!----------------------------------------------------------------------------
+!
+END FUNCTION GZ_U_UW
diff --git a/src/mesonh/aux/gradient_v.f90 b/src/mesonh/aux/gradient_v.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2e976258486d0007a443b96f03861d61715dae0b
--- /dev/null
+++ b/src/mesonh/aux/gradient_v.f90
@@ -0,0 +1,333 @@
+!MNH_LIC Copyright 1994-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_GRADIENT_V
+! ######################
+!
+INTERFACE
+!
+!
+FUNCTION GY_V_M(PA,PDYY,PDZZ,PDZY, KKA, KKU, KL) RESULT(PGY_V_M)
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_V_M ! result mass point
+!
+END FUNCTION GY_V_M
+!
+FUNCTION GX_V_UV(PA,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_V_UV)
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_V_UV ! result UV point
+!
+END FUNCTION GX_V_UV
+!
+!
+FUNCTION GZ_V_VW(PA,PDZZ, KKA, KKU, KL) RESULT(PGZ_V_VW)
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_V_VW ! result VW point
+!
+END FUNCTION GZ_V_VW
+!
+!
+END INTERFACE
+!
+END MODULE MODI_GRADIENT_V
+!
+!
+!
+! #######################################################
+ FUNCTION GY_V_M(PA,PDYY,PDZZ,PDZY, KKA, KKU, KL) RESULT(PGY_V_M)
+! #######################################################
+!
+!!**** *GY_V_M* - Cartesian Gradient operator:
+!! computes the gradient in the cartesian Y
+!! direction for a variable placed at the
+!! V point and the result is placed at
+!! the mass point.
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the discrete gradient
+! along the Y cartesian direction for a field PA placed at the
+! V point. The result is placed at the mass point.
+!
+!
+! ( ______________z )
+! ( (___________y ) )
+! 1 ( (d*zy dzm(PA) ) )
+! PGY_V_M = ---- (dyf(PA) - (------------)) )
+! ___y ( ( ) )
+! d*yy ( ( d*zz ) )
+!
+!
+!!** METHOD
+!! ------
+!! The Chain rule of differencing is applied to variables expressed
+!! in the Gal-Chen & Somerville coordinates to obtain the gradient in
+!! the cartesian system
+!!
+!! EXTERNAL
+!! --------
+!! MYF,MZF : Shuman functions (mean operators)
+!! DYF,DZF : Shuman functions (finite difference operators)
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (GRAD_CAR operators)
+!! A Turbulence scheme for the Meso-NH model (Chapter 6)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart *INM and Meteo-France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 19/07/94
+!! 18/10/00 (V.Masson) add LFLAT switch
+!-------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODI_SHUMAN
+USE MODD_CONF
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_V_M ! result mass point
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GY_V_M
+! --------------------
+!
+IF (.NOT. LFLAT) THEN
+ PGY_V_M(:,:,:)= (DYF(PA) - &
+ MZF( MYF(PDZY*DZM(PA))/PDZZ ) &
+ ) / MYF(PDYY)
+ELSE
+ PGY_V_M(:,:,:)= DYF(PA) / MYF(PDYY)
+END IF
+!
+!----------------------------------------------------------------------------
+!
+END FUNCTION GY_V_M
+!
+!
+! #########################################################
+ FUNCTION GX_V_UV(PA,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_V_UV)
+! #########################################################
+!
+!!**** *GX_V_UV* - Cartesian Gradient operator:
+!! computes the gradient in the cartesian X
+!! direction for a variable placed at the
+!! V point and the result is placed at
+!! the UV vorticity point.
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the discrete gradient
+! along the X cartesian direction for a field PA placed at the
+! V point. The result is placed at the UV vorticity point.
+!
+!
+! ( _________________z )
+! ( (___y _________x ) )
+! 1 ( (d*zx (dzm(PA))) ) )
+! PGX_V_UV= ---- (dxm(PA) - ( (------ ) ) )
+! ___y ( ( ( ___y ) ) )
+! d*xx ( ( ( d*zz ) ) )
+!
+!
+!
+!!** METHOD
+!! ------
+!! The Chain rule of differencing is applied to variables expressed
+!! in the Gal-Chen & Somerville coordinates to obtain the gradient in
+!! the cartesian system
+!!
+!! EXTERNAL
+!! --------
+!! MXM,MZF,MYM : Shuman functions (mean operators)
+!! DXM,DZM : Shuman functions (finite difference operators)
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (GRAD_CAR operators)
+!! A Turbulence scheme for the Meso-NH model (Chapter 6)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart *INM and Meteo-France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 20/07/94
+!! 18/10/00 (V.Masson) add LFLAT switch
+!-------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODI_SHUMAN
+USE MODD_CONF
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_V_UV ! result UV point
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GX_V_UV
+! ---------------------
+!
+IF (.NOT. LFLAT) THEN
+ PGX_V_UV(:,:,:)= ( DXM(PA)- MZF( MXM( DZM(PA)/&
+ MYM(PDZZ) ) *MYM(PDZX) ) ) / MYM(PDXX)
+ELSE
+ PGX_V_UV(:,:,:)= DXM(PA) / MYM(PDXX)
+END IF
+!
+!----------------------------------------------------------------------------
+!
+END FUNCTION GX_V_UV
+!
+!
+! #######################################################
+ FUNCTION GZ_V_VW(PA,PDZZ, KKA, KKU, KL) RESULT(PGZ_V_VW)
+! #######################################################
+!
+!!**** *GZ_V_VW - Cartesian Gradient operator:
+!! computes the gradient in the cartesian Z
+!! direction for a variable placed at the
+!! V point and the result is placed at
+!! the VW vorticity point.
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the discrete gradient
+! along the Z cartesian direction for a field PA placed at the
+! V point. The result is placed at the VW vorticity point.
+!
+!
+! dzm(PA)
+! PGZ_V_VW = ------
+! ____y
+! d*zz
+!
+!!** METHOD
+!! ------
+!! The Chain rule of differencing is applied to variables expressed
+!! in the Gal-Chen & Somerville coordinates to obtain the gradient in
+!! the cartesian system
+!!
+!! EXTERNAL
+!! --------
+!! MYM : Shuman functions (mean operators)
+!! DZM : Shuman functions (finite difference operators)
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (GRAD_CAR operators)
+!! A Turbulence scheme for the Meso-NH model (Chapter 6)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart *INM and Meteo-France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 20/07/94
+!-------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODI_SHUMAN
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_V_VW ! result VW point
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GZ_V_VW
+! ---------------------
+!
+PGZ_V_VW(:,:,:)= DZM(PA) / MYM(PDZZ)
+!
+!----------------------------------------------------------------------------
+!
+END FUNCTION GZ_V_VW
diff --git a/src/mesonh/aux/gradient_w.f90 b/src/mesonh/aux/gradient_w.f90
new file mode 100644
index 0000000000000000000000000000000000000000..097016ea94da162d1ba2b7ca0f84cf6c64a38de0
--- /dev/null
+++ b/src/mesonh/aux/gradient_w.f90
@@ -0,0 +1,309 @@
+!MNH_LIC Copyright 1994-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_GRADIENT_W
+! ######################
+!
+INTERFACE
+!
+!
+FUNCTION GZ_W_M(PA,PDZZ, KKA, KKU, KL) RESULT(PGZ_W_M)
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_W_M ! result mass point
+!
+END FUNCTION GZ_W_M
+!
+FUNCTION GX_W_UW(PA,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_W_UW)
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_W_UW ! result UW point
+!
+END FUNCTION GX_W_UW
+!
+!
+FUNCTION GY_W_VW(PA,PDYY,PDZZ,PDZY, KKA, KKU, KL) RESULT(PGY_W_VW)
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_W_VW ! result VW point
+!
+END FUNCTION GY_W_VW
+!
+!
+END INTERFACE
+!
+END MODULE MODI_GRADIENT_W
+!
+!
+!
+! #######################################################
+ FUNCTION GZ_W_M(PA,PDZZ, KKA, KKU, KL) RESULT(PGZ_W_M)
+! #######################################################
+!
+!!**** *GZ_W_M* - Cartesian Gradient operator:
+!! computes the gradient in the cartesian Z
+!! direction for a variable placed at the
+!! W point and the result is placed at
+!! the mass point.
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the discrete gradient
+! along the Z cartesian direction for a field PA placed at the
+! W point. The result is placed at the mass point.
+!
+!!** METHOD
+!! ------
+!! The Chain rule of differencing is applied to variables expressed
+!! in the Gal-Chen & Somerville coordinates to obtain the gradient in
+!! the cartesian system
+!!
+!! EXTERNAL
+!! --------
+!! MZF : Shuman functions (mean operators)
+!! DZF : Shuman functions (finite difference operators)
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (GRAD_CAR operators)
+!! A Turbulence scheme for the Meso-NH model (Chapter 6)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart *INM and Meteo-France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 19/07/94
+!-------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODI_SHUMAN
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_W_M ! result mass point
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GZ_W_M
+! --------------------
+!
+PGZ_W_M(:,:,:)= DZF(PA(:,:,:))/(MZF(PDZZ(:,:,:)))
+!
+!----------------------------------------------------------------------------
+!
+END FUNCTION GZ_W_M
+!
+!
+! #########################################################
+ FUNCTION GX_W_UW(PA,PDXX,PDZZ,PDZX, KKA, KKU, KL) RESULT(PGX_W_UW)
+! #########################################################
+!
+!!**** *GX_W_UW* - Cartesian Gradient operator:
+!! computes the gradient in the cartesian X
+!! direction for a variable placed at the
+!! V point and the result is placed at
+!! the UW vorticity point.
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the discrete gradient
+! along the X cartesian direction for a field PA placed at the
+! W point. The result is placed at the UW vorticity point.
+!
+!!** METHOD
+!! ------
+!! The Chain rule of differencing is applied to variables expressed
+!! in the Gal-Chen & Somerville coordinates to obtain the gradient in
+!! the cartesian system
+!!
+!! EXTERNAL
+!! --------
+!! MXM,MZM,MZF : Shuman functions (mean operators)
+!! DXM,DZM : Shuman functions (finite difference operators)
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (GRAD_CAR operators)
+!! A Turbulence scheme for the Meso-NH model (Chapter 6)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart *INM and Meteo-France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 20/07/94
+!! 18/10/00 (V.Masson) add LFLAT switch
+!-------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODI_SHUMAN
+USE MODD_CONF
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_W_UW ! result UW point
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GX_W_UW
+! ---------------------
+!
+IF (.NOT. LFLAT) THEN
+ PGX_W_UW(:,:,:)= DXM(PA(:,:,:))/(MZM(PDXX(:,:,:))) &
+ -DZM(MXM(MZF(PA(:,:,:))))*PDZX(:,:,:) &
+ /( MZM(PDXX(:,:,:))*MXM(PDZZ(:,:,:)) )
+ELSE
+ PGX_W_UW(:,:,:)= DXM(PA(:,:,:))/(MZM(PDXX(:,:,:)))
+END IF
+!
+!----------------------------------------------------------------------------
+!
+END FUNCTION GX_W_UW
+!
+!
+! #########################################################
+ FUNCTION GY_W_VW(PA,PDYY,PDZZ,PDZY, KKA, KKU, KL) RESULT(PGY_W_VW)
+! #########################################################
+!
+!!**** *GY_W_VW* - Cartesian Gradient operator:
+!! computes the gradient in the cartesian Y
+!! direction for a variable placed at the
+!! W point and the result is placed at
+!! the VW vorticity point.
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the discrete gradient
+! along the Y cartesian direction for a field PA placed at the
+! W point. The result is placed at the VW vorticity point.
+!
+!!** METHOD
+!! ------
+!! The Chain rule of differencing is applied to variables expressed
+!! in the Gal-Chen & Somerville coordinates to obtain the gradient in
+!! the cartesian system
+!!
+!! EXTERNAL
+!! --------
+!! MYM,MZM,MZF : Shuman functions (mean operators)
+!! DYM,DZM : Shuman functions (finite difference operators)
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (GRAD_CAR operators)
+!! A Turbulence scheme for the Meso-NH model (Chapter 6)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart *INM and Meteo-France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 20/07/94
+!! 18/10/00 (V.Masson) add LFLAT switch
+!-------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODI_SHUMAN
+USE MODD_CONF
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dxx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzx
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_W_VW ! result VW point
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GY_W_VW
+! ---------------------
+!
+IF (.NOT. LFLAT) THEN
+ PGY_W_VW(:,:,:)= DYM(PA(:,:,:))/(MZM(PDYY(:,:,:))) &
+ -DZM(MYM(MZF(PA(:,:,:))))*PDZY(:,:,:) &
+ /( MZM(PDYY(:,:,:))*MYM(PDZZ(:,:,:)) )
+ELSE
+ PGY_W_VW(:,:,:)= DYM(PA(:,:,:))/(MZM(PDYY(:,:,:)))
+END IF
+!
+!----------------------------------------------------------------------------
+!
+END FUNCTION GY_W_VW
diff --git a/src/mesonh/micro/modd_dyn.f90 b/src/mesonh/aux/modd_dyn.f90
similarity index 100%
rename from src/mesonh/micro/modd_dyn.f90
rename to src/mesonh/aux/modd_dyn.f90
diff --git a/src/mesonh/aux/modd_io.f90 b/src/mesonh/aux/modd_io.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c8457cc2d32624a020d122c41cb318faa86a1d4c
--- /dev/null
+++ b/src/mesonh/aux/modd_io.f90
@@ -0,0 +1,159 @@
+!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.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/01/2019: use NEWUNIT argument of OPEN (removed ISTDOUT, ISTDERR, added NNULLUNIT, CNULLFILE)
+! P. 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: force TYPE to a known value for IO_File_add2list
+! P. Wautelet 12/03/2019: add TMAINFILE field in TFILEDATA
+! P. Wautelet 17/01/2020: add 'BUD' category for Print_msg + corresponding namelist variables
+! P. Wautelet 22/09/2020: add ldimreduced in tfiledata
+! P. Wautelet 10/11/2020: new data structures for netCDF dimensions
+!-----------------------------------------------------------------
+
+#define MNH_REDUCE_DIMENSIONS_IN_FILES 1
+
+MODULE MODD_IO
+!
+use modd_netcdf, only: tdimsnc
+USE MODD_PARAMETERS, ONLY: NDIRNAMELGTMAX, NFILENAMELGTMAX
+use modd_precision, only: CDFINT, LFIINT
+!
+IMPLICIT NONE
+!
+!
+INTEGER, PARAMETER :: NVERB_NO=0, NVERB_FATAL=1, NVERB_ERROR=2, NVERB_WARNING=3, NVERB_INFO=4, NVERB_DEBUG=5
+
+INTEGER :: NNULLUNIT = -1 ! /dev/null fortran unit, value set in IO_Init
+CHARACTER(LEN=*), PARAMETER :: CNULLFILE = "/dev/null"
+
+INTEGER, SAVE :: NIO_RANK ! Rank of IO process
+INTEGER, SAVE :: ISP !! Actual proc number
+INTEGER, SAVE :: ISNPROC !! Total number of allocated processes
+LOGICAL, SAVE :: GSMONOPROC = .FALSE. !! True if sequential execution (ISNPROC = 1)
+
+LOGICAL, SAVE :: L1D = .FALSE. ! TRUE if 1D model version
+LOGICAL, SAVE :: L2D = .FALSE. ! TRUE if 2D model version
+LOGICAL, SAVE :: LPACK = .FALSE. ! TRUE if FM compression occurs in 1D or 2D model version
+
+LOGICAL, SAVE :: LIOCDF4 = .FALSE. ! TRUE will enable full NetCDF4 (HDF5) I/O support
+LOGICAL, SAVE :: LLFIOUT = .FALSE. ! TRUE will also force LFI output when LIOCDF4 is on (debug only)
+LOGICAL, SAVE :: LLFIREAD = .FALSE. ! TRUE will force LFI read (instead of NetCDF) when LIOCDF4 is on (debug only)
+
+LOGICAL, SAVE :: LVERB_OUTLST = .TRUE. ! TRUE will PRINT_MSG in OUTPUT_LISTINGn files
+LOGICAL, SAVE :: LVERB_STDOUT = .FALSE. ! TRUE will also PRINT_MSG on standard output
+LOGICAL, SAVE :: LVERB_ALLPRC = .FALSE. ! FALSE: only process 0 do PRINT_MSG, TRUE: all processes
+INTEGER, SAVE :: NBUD_VERB = NVERB_INFO ! Verbosity level for budgets
+INTEGER, SAVE :: NBUD_ABORT_LEVEL = NVERB_ERROR ! Level of budget error necessary to force stop of application
+INTEGER, SAVE :: NIO_VERB = NVERB_INFO ! Verbosity level for IO
+INTEGER, SAVE :: NIO_ABORT_LEVEL = NVERB_ERROR ! Level of IO error necessary to force stop of application
+
+INTEGER, SAVE :: NGEN_VERB = NVERB_INFO ! Verbosity level for 'GEN' (generic) messages
+INTEGER, SAVE :: NGEN_ABORT_LEVEL = NVERB_ERROR ! Level of 'GEN' error necessary to force stop of application
+
+CHARACTER(LEN=NDIRNAMELGTMAX) :: CIO_DIR = '' ! Directory for IO
+
+logical, save :: LIO_ALLOW_NO_BACKUP = .false. ! Allow to have no valid backup time (useful for some tests)
+logical, save :: LIO_NO_WRITE = .false. ! Disable file writes (useful for benchs)
+
+!Structure containing one pointer to a file
+!Useful to create arrays of pointers to files
+TYPE TFILE_ELT
+ TYPE(TFILEDATA),POINTER :: TFILE => NULL()
+END TYPE TFILE_ELT
+
+!Structure describing the characteristics of an output or a backup
+TYPE TOUTBAK
+ INTEGER :: NID = -1 !Backup number
+ INTEGER :: NSTEP !Timestep number
+ REAL :: XTIME !Time from start of the segment (in seconds and rounded to a timestep)
+ INTEGER :: NOUTDAD = -1 !Index of the corresponding dad file (file with same time)
+ TYPE(TFILEDATA),POINTER :: TFILE => NULL() !Corresponding file
+ TYPE(TFILE_ELT),DIMENSION(:),ALLOCATABLE :: TFILE_IOZ !Corresponding Z-split files
+ INTEGER,DIMENSION(:),POINTER :: NFIELDLIST => NULL() !List of the fields to read or write
+END TYPE TOUTBAK
+
+!Structure describing the characteristics of a file
+TYPE TFILEDATA
+ CHARACTER(LEN=NFILENAMELGTMAX) :: CNAME = '' !Filename
+ CHARACTER(LEN=:),ALLOCATABLE :: CDIRNAME !Directory name
+ CHARACTER(LEN=13) :: CTYPE = "UNKNOWN" !Filetype (PGD, MNH, DES, NML...)
+ CHARACTER(LEN=7) :: CFORMAT = "UNKNOWN" !Fileformat (NETCDF4, LFI, LFICDF4...)
+ CHARACTER(LEN=7) :: CMODE = "UNKNOWN" !Opening mode (read, write...)
+ LOGICAL :: LOPENED = .FALSE. !Is the file opened
+ INTEGER :: NOPEN_CURRENT = 0 !Number of times the file is currently opened (several opens without close are allowed)
+ INTEGER :: NOPEN = 0 !Number of times the file has been opened (during the current execution)
+ INTEGER :: NCLOSE = 0 !Number of times the file has been closed (during the current execution)
+ !
+ INTEGER :: NMASTER_RANK = -1 !Rank of the master process (no meaning if LMULTIMASTERS=.T.)
+ INTEGER :: NMPICOMM = -1 !MPI communicator used for IO on this file
+ LOGICAL :: LMASTER = .FALSE. !True if process is master of the file (process that open/read/write/close)
+ LOGICAL :: LMULTIMASTERS = .FALSE. !True if several processes may access the file
+#if ( MNH_REDUCE_DIMENSIONS_IN_FILES == 1 )
+ logical :: ldimreduced = .true. !True if number of dimensions of fields can be reduced (for 2D simulations)
+#else
+ logical :: ldimreduced = .false. !True if number of dimensions of fields can be reduced (for 2D simulations)
+#endif
+ !
+ INTEGER :: NSUBFILES_IOZ = 0 !Number of sub-files (Z-split files based on this file)
+ !For example if 2 sub-files and this file is abcd,
+ !the 2 sub-files are abcd.Z001 and abcd.Z002
+ TYPE(TFILE_ELT),DIMENSION(:),ALLOCATABLE :: TFILES_IOZ !Corresponding Z-split files
+ !
+ 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
+ !
+#ifdef MNH_IOLFI
+ ! Fields for LFI files
+ INTEGER(KIND=LFIINT) :: NLFININAR = 0 !Number of articles of the LFI file (only accurate if file opened in read mode)
+ INTEGER(KIND=LFIINT) :: NLFINPRAR = 0 !Number of predicted articles of the LFI file (non crucial)
+ INTEGER :: NLFITYPE = -1 !Type of the file (used to generate list of files to transfers)
+ INTEGER :: NLFIVERB = 1 !LFI verbosity level
+ INTEGER(KIND=LFIINT) :: NLFIFLU = -1 !File identifier
+#endif
+ !
+#ifdef MNH_IOCDF4
+ ! Fields for netCDF files
+ INTEGER(KIND=CDFINT) :: NNCID = -1 !File identifier (corresponding to the actual group)
+ INTEGER(KIND=CDFINT) :: NNCNAR = 0 !Number of articles of the netCDF file (only accurate if file opened in read mode)
+ LOGICAL :: LNCREDUCE_FLOAT_PRECISION = .FALSE. ! Reduce the precision of floats to single precision
+ ! instead of double precision
+ LOGICAL :: LNCCOMPRESS = .FALSE. ! Do compression on fields
+ INTEGER(KIND=CDFINT) :: NNCCOMPRESS_LEVEL = 0 ! Compression level
+ type(tdimsnc), pointer :: tncdims => Null() ! Dimensions of netCDF file
+#endif
+ !
+ !Fields for other files
+ INTEGER :: NLU = -1 !Logical unit number
+ INTEGER :: NRECL = -1 !Fortran RECL (record length)
+ CHARACTER(LEN=11) :: CFORM = "UNKNOWN" !Fortran FORM (FORMATTED/UNFORMATTED)
+ CHARACTER(LEN=10) :: CACCESS = "UNKNOWN" !Fortran ACCESS (DIRECT/SEQUENTIAL/STREAM)
+ !
+ TYPE(TFILEDATA),POINTER :: TDADFILE => NULL() !Corresponding dad file
+ TYPE(TFILEDATA),POINTER :: TDESFILE => NULL() !Corresponding .des file
+ TYPE(TFILEDATA),POINTER :: TDATAFILE => NULL() !Corresponding data file (if .des file)
+ TYPE(TFILEDATA),POINTER :: TMAINFILE => NULL() !Corresponding main file if the file is an sub-file
+ !
+ TYPE(TFILEDATA),POINTER :: TFILE_PREV => NULL()
+ TYPE(TFILEDATA),POINTER :: TFILE_NEXT => NULL()
+END TYPE TFILEDATA
+
+!Structure containing a pointer to a file (useful to create arrays of pointers to files)
+TYPE TPTR2FILE
+ TYPE(TFILEDATA),POINTER :: TZFILE => NULL()
+END TYPE
+
+TYPE(TFILEDATA),POINTER,SAVE :: TFILE_FIRST => NULL()
+TYPE(TFILEDATA),POINTER,SAVE :: TFILE_LAST => NULL()
+
+TYPE(TFILEDATA),POINTER,SAVE :: TFILE_SURFEX => NULL() !Pointer used to find the file used when writing SURFEX fields in write_surf_mnh.f90
+
+TYPE(TFILEDATA),POINTER,SAVE :: TFILE_OUTPUTLISTING => NULL() !Pointer used to point to the file used when writing to OUTPUT_LISTINGn file
+
+!Non existing file which can be used as a dummy target
+TYPE(TFILEDATA),TARGET, SAVE :: TFILE_DUMMY = TFILEDATA(CNAME="dummy",CDIRNAME=NULL(),TFILES_IOZ=NULL())
+
+END MODULE MODD_IO
diff --git a/src/mesonh/micro/modd_lunit.f90 b/src/mesonh/aux/modd_lunit.f90
similarity index 100%
rename from src/mesonh/micro/modd_lunit.f90
rename to src/mesonh/aux/modd_lunit.f90
diff --git a/src/mesonh/micro/modd_parameters.f90 b/src/mesonh/aux/modd_parameters.f90
similarity index 97%
rename from src/mesonh/micro/modd_parameters.f90
rename to src/mesonh/aux/modd_parameters.f90
index c21c6e70955e1e1ecbe501225f6d3f83dd66a1ec..1fffa21efafab090585b757bec9603d4abf40d21 100644
--- a/src/mesonh/micro/modd_parameters.f90
+++ b/src/mesonh/aux/modd_parameters.f90
@@ -11,21 +11,21 @@
!!
!! PURPOSE
!! -------
-! The purpose of this declarative module is to specify the variables
-! which have the PARAMETER attribute
+! The purpose of this declarative module is to specify the variables
+! which have the PARAMETER attribute
!
!!
!!** IMPLICIT ARGUMENTS
!! ------------------
-!! None
+!! None
!!
!! REFERENCE
!! ---------
!! Book2 of documentation of Meso-NH (module MODD_PARAMETER)
-!!
+!!
!! AUTHOR
!! ------
-!! V. Ducrocq *Meteo France*
+!! V. Ducrocq *Meteo France*
!!
!! MODIFICATIONS
!! -------------
@@ -57,7 +57,7 @@ INTEGER,SAVE :: JPHEXT = 1 ! Horizontal External points number
!JUAN CYCLK
INTEGER, PARAMETER :: JPVEXT = 1 ! Vertical External points number
INTEGER, PARAMETER :: JPVEXT_TURB = 1 ! Vertical External points number
-INTEGER, PARAMETER :: JPMODELMAX = 8 ! Maximum allowed number of nested models
+INTEGER, PARAMETER :: JPMODELMAX = 8 ! Maximum allowed number of nested models
INTEGER, PARAMETER :: JPCPLFILEMAX = 24 ! Maximum allowed number of CouPLing FILEs
INTEGER, PARAMETER :: JPRIMMAX = 6 ! Maximum number of points for the
! horizontal relaxation for the outermost verticals
diff --git a/src/mesonh/aux/mode_thermo.f90 b/src/mesonh/aux/mode_thermo.f90
new file mode 100644
index 0000000000000000000000000000000000000000..935ffebd0606833ea3979137886485da05f041bd
--- /dev/null
+++ b/src/mesonh/aux/mode_thermo.f90
@@ -0,0 +1,2515 @@
+!MNH_LIC Copyright 1994-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 MODE_THERMO
+! #######################
+!
+!!**** *MODE_THERMO_MONO* - module for routines SM_FOES,SM_PMR_HU
+!!
+!! PURPOSE
+!! -------
+! The purpose of this executive module is to package
+! the routine SM_FOES, SM_PMR_HU without use of comlib parallel routine
+!
+!
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 28/08/94
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! J.Escobar : 5/10/2018 : add FLUSH , for better logging in case of PB
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+!--------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!-------------------------------------------------------------------------------
+USE MODE_MSG
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+IMPLICIT NONE
+
+PRIVATE
+
+PUBLIC :: DQSAT, DQSATI, QSAT, QSATI, SM_FOES, SM_PMR_HU
+
+INTERFACE SM_FOES
+ MODULE PROCEDURE SM_FOES_0D
+ MODULE PROCEDURE SM_FOES_1D
+ MODULE PROCEDURE SM_FOES_2D
+ MODULE PROCEDURE SM_FOES_2D_MASK
+ MODULE PROCEDURE SM_FOES_3D
+END INTERFACE
+INTERFACE QSAT
+ MODULE PROCEDURE QSATW_3D
+ MODULE PROCEDURE QSATW_2D
+ MODULE PROCEDURE QSATW_2D_MASK
+ MODULE PROCEDURE QSATW_1D
+ MODULE PROCEDURE QSATW_0D
+END INTERFACE
+INTERFACE DQSAT
+ MODULE PROCEDURE DQSATW_O_DT_2D_MASK
+ MODULE PROCEDURE DQSATW_O_DT_1D
+ MODULE PROCEDURE DQSATW_O_DT_3D
+END INTERFACE
+INTERFACE QSATI
+ MODULE PROCEDURE QSATI_3D
+ MODULE PROCEDURE QSATI_2D
+ MODULE PROCEDURE QSATI_2D_MASK
+ MODULE PROCEDURE QSATI_1D
+ MODULE PROCEDURE QSATI_0D
+END INTERFACE
+INTERFACE DQSATI
+ MODULE PROCEDURE DQSATI_O_DT_2D_MASK
+ MODULE PROCEDURE DQSATI_O_DT_1D
+ MODULE PROCEDURE DQSATI_O_DT_3D
+END INTERFACE
+INTERFACE SM_PMR_HU
+ MODULE PROCEDURE SM_PMR_HU_1D
+ MODULE PROCEDURE SM_PMR_HU_3D
+END INTERFACE
+CONTAINS
+!-------------------------------------------------------------------------------
+! ####################################
+ FUNCTION SM_FOES_3D(PT) RESULT(PFOES)
+! ####################################
+!
+!!**** *SM_FOES_3D * - function to compute saturation vapor pressure from
+!! temperature
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
+!
+!!** METHOD
+!! ------
+!! Given temperature T (PT), the saturation vapor pressure es(T)
+!! (FOES(PT)) is computed by integration of the Clapeyron equation
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
+!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
+!!
+!! with :
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
+!! gammaw (XGAMW) = (Cl -Cpv) /Rv
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : comtains physical constants
+!! XALPW : Constant for saturation vapor pressure function
+!! XBETAW : Constant for saturation vapor pressure function
+!! XGAMW : Constant for saturation vapor pressure function
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 28/08/94
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
+ ! (Kelvin)
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: PFOES ! saturation vapor
+ ! pressure
+ ! (Pascal)
+!
+!* 0.2 Declarations of local variables
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE SATURATION VAPOR PRESSURE
+! ---------------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_FOES_3D',0,ZHOOK_HANDLE)
+PFOES(:,:,:) = EXP( XALPW - XBETAW/PT(:,:,:) - XGAMW*LOG(PT(:,:,:)) )
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_FOES_3D',1,ZHOOK_HANDLE)
+END FUNCTION SM_FOES_3D
+! ####################################
+ FUNCTION SM_FOES_1D(PT) RESULT(PFOES)
+! ####################################
+!
+!!**** *SM_FOES_1D * - function to compute saturation vapor pressure from
+!! temperature
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
+!
+!!** METHOD
+!! ------
+!! Given temperature T (PT), the saturation vapor pressure es(T)
+!! (FOES(PT)) is computed by integration of the Clapeyron equation
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
+!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
+!!
+!! with :
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
+!! gammaw (XGAMW) = (Cl -Cpv) /Rv
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : comtains physical constants
+!! XALPW : Constant for saturation vapor pressure function
+!! XBETAW : Constant for saturation vapor pressure function
+!! XGAMW : Constant for saturation vapor pressure function
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 28/08/94
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+!
+!
+REAL, DIMENSION(:), INTENT(IN) :: PT ! Temperature
+ ! (Kelvin)
+REAL, DIMENSION(SIZE(PT)) :: PFOES ! saturation vapor
+ ! pressure
+ ! (Pascal)
+!
+!* 0.2 Declarations of local variables
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE SATURATION VAPOR PRESSURE
+! ---------------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_FOES_1D',0,ZHOOK_HANDLE)
+PFOES(:) = EXP( XALPW - XBETAW/PT(:) - XGAMW*LOG(PT(:)) )
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_FOES_1D',1,ZHOOK_HANDLE)
+END FUNCTION SM_FOES_1D
+!-------------------------------------------------------------------------------
+! ####################################################
+ FUNCTION SM_PMR_HU_3D(PP,PTV,PHU,PR,KITERMAX) RESULT(PMR)
+! ####################################################
+!
+!!**** *SM_PMR_HU_3D * - function to compute vapor mixing ratio
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the vapor mixing ratio
+! from pressure, virtual temperature and relative humidity
+!
+!
+!!** METHOD
+!! ------
+!! Given Pressure (PP), Virtual temperature (PTV) and Relative
+!! humidity (PHU), the vapor mixing ratio is computed by iterating
+!! the following procedure :
+!! T ----> es(T)
+!! es(T) ,HU ----> es(Td)
+!! es(Td), P ----> r
+!! r , Tv ----> T
+!!
+!! at the beginning T=Tv
+!!
+!! EXTERNAL
+!! --------
+!! SM_FOES : to compute saturation vapor pressure
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : comtains physical constants
+!! XRV : gas constant for vapor
+!! XRD : gas constant for dry air
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 30/08/94
+!! Modification 16/03/95 remove the EPSILON function
+!! Modification 15/09/97 (V. Masson) add solid and liquid water phases
+!! in thetav computation
+!! Modification 22/01/2019 (P. Wautelet) use standard FLUSH statement
+!! instead of non standard intrinsics!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_LUNIT_n, ONLY: TLUOUT
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PP ! Pressure
+ ! (Pa)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTV ! Virtual Temperature
+ ! (Kelvin)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PHU ! Relative humidity
+ ! (percent)
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PR ! vapor, liquid and
+ ! solid water mixing
+ ! ratio
+
+INTEGER, INTENT(IN), OPTIONAL :: KITERMAX ! maximum number
+ ! of iterations
+ ! (default 10)
+!
+REAL, DIMENSION(SIZE(PP,1),SIZE(PP,2),SIZE(PP,3)) :: PMR ! vapor mixing ratio
+!
+!* 0.2 Declarations of local variables
+!
+REAL, DIMENSION(SIZE(PP,1),SIZE(PP,2),SIZE(PP,3)) :: ZT ! temperature
+REAL, DIMENSION(SIZE(PP,1),SIZE(PP,2),SIZE(PP,3)) :: ZDT ! increment of
+ ! temperature between two iterations
+REAL :: ZRDSRV ! Rd/Rv
+REAL, DIMENSION(SIZE(PP,1),SIZE(PP,2),SIZE(PP,3)) :: ZESTD ! es(Td)
+REAL, DIMENSION(SIZE(PP,1),SIZE(PP,2),SIZE(PP,3)) :: ZRSLW ! total solid and liquid water mixing ratio
+INTEGER :: ITERMAX ! Maximum number
+ ! of iteration
+INTEGER :: ITER ! iteration number of
+REAL :: ZEPS ! a small number
+INTEGER, DIMENSION(3) :: IMAXLOC ! localisation of
+ ! a maximum
+INTEGER :: ILUOUT
+ ! logical unit for
+ ! output-listing
+ ! and error code
+INTEGER :: JRR ! loop counter
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE VAPOR MIXING RATIO
+! --------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_PMR_HU_3D',0,ZHOOK_HANDLE)
+ITERMAX = 10
+IF (PRESENT(KITERMAX)) ITERMAX=KITERMAX
+ZRDSRV = XRD /XRV
+ZEPS = XEPS_DT
+!
+ZRSLW(:,:,:)=0.
+DO JRR=2,SIZE(PR,4)
+ ZRSLW(:,:,:)=ZRSLW(:,:,:)+PR(:,:,:,JRR)
+END DO
+!
+ZT(:,:,:) = PTV(:,:,:)
+DO ITER=1,ITERMAX
+ ZESTD(:,:,:) = PHU(:,:,:) * SM_FOES(ZT(:,:,:)) * 0.01
+ PMR (:,:,:) = ZRDSRV * ZESTD(:,:,:) /(PP(:,:,:) - ZESTD(:,:,:))
+ ZDT(:,:,:) = ZT(:,:,:)
+ ZT(:,:,:) = PTV(:,:,:) * (1.+PMR(:,:,:)+ZRSLW(:,:,:)) / (1.+ PMR(:,:,:)/ZRDSRV)
+ ZDT(:,:,:) = ABS(ZDT(:,:,:) - ZT(:,:,:))
+END DO
+!-------------------------------------------------------------------------------
+!
+!* 2. NO CONVERGENCE
+! --------------
+!
+IF ( ANY(ZDT > ZEPS) ) THEN
+ ILUOUT = TLUOUT%NLU
+ WRITE(ILUOUT,*) 'ERROR IN FUNCTION SM_PMR_HU (module MODE_THERMO)'
+ WRITE(ILUOUT,*) 'FUNCTION FAILS TO CONVERGE AFTER ', ITERMAX,' ITERATIONS'
+ WRITE(ILUOUT,*) 'EPS = ' , ZEPS
+ IMAXLOC(:) = MAXLOC(ZDT)
+ WRITE(ILUOUT,*) 'MAXIMUM RESIDUAL DT :', MAXVAL(ZDT)
+! WRITE(ILUOUT,*) 'LOCATION OF THIS MAXIMUM I=',IMAXLOC(1),' J=',IMAXLOC(2), &
+! ' K=',IMAXLOC(3)
+ WRITE(ILUOUT,*) 'MR AT THIS MAXIMUM : ', PMR(IMAXLOC(1),IMAXLOC(2),IMAXLOC(3))
+ WRITE(ILUOUT,*) 'T AT THIS MAXIMUM : ', ZT(IMAXLOC(1),IMAXLOC(2),IMAXLOC(3))
+ WRITE(ILUOUT,*) 'JOB ABORTED '
+ FLUSH(unit=ILUOUT)
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'SM_PMR_HU_3D', 'failed to converge' )
+END IF
+!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_PMR_HU_3D',1,ZHOOK_HANDLE)
+END FUNCTION SM_PMR_HU_3D
+! ################################################################
+ FUNCTION SM_PMR_HU_1D(PP,PTV,PHU,PR,KITERMAX) RESULT(PMR)
+! ################################################################
+!
+!!**** *SM_PMR_HU_1D * - function to compute vapor mixing ratio
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the vapor mixing ratio
+! from pressure, virtual temperature and relative humidity
+!
+!
+!!** METHOD
+!! ------
+!! Given Pressure (PP), Virtual temperature (PTV) and Relative
+!! humidity (PHU), the vapor mixing ratio is computed by iterating
+!! the following procedure :
+!! T ----> es(T)
+!! es(T) ,HU ----> es(Td)
+!! es(Td), P ----> r
+!! r , Tv ----> T
+!!
+!! at the beginning T=Tv
+!!
+!! EXTERNAL
+!! --------
+!! SM_FOES : to compute saturation vapor pressure
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : comtains physical constants
+!! XRV : gas constant for vapor
+!! XRD : gas constant for dry air
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 30/08/94
+!! Modification 16/03/95 remove the EPSILON function
+!! Modification 15/09/97 (V. Masson) add solid and liquid water phases
+!! in thetav computation
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_LUNIT_n, ONLY: TLUOUT
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+!
+!
+REAL, DIMENSION(:), INTENT(IN) :: PP ! Pressure
+ ! (Pa)
+REAL, DIMENSION(:), INTENT(IN) :: PTV ! Virtual Temperature
+ ! (Kelvin)
+REAL, DIMENSION(:), INTENT(IN) :: PHU ! Relative humidity
+ ! (percent)
+REAL, DIMENSION(:,:), INTENT(IN) :: PR ! vapor, liquid and solid
+ ! water mixing ratio
+INTEGER, INTENT(IN), OPTIONAL :: KITERMAX ! maximum number
+ ! of iterations
+ ! (default 10)
+!
+REAL, DIMENSION(SIZE(PP)) :: PMR ! vapor mixing ratio
+!
+!* 0.2 Declarations of local variables
+!
+REAL, DIMENSION(SIZE(PP)) :: ZT ! temperature
+REAL, DIMENSION(SIZE(PP)) :: ZDT ! increment of
+ ! temperature between two iterations
+REAL :: ZRDSRV ! Rd/Rv
+REAL, DIMENSION(SIZE(PP)) :: ZESTD ! es(Td)
+REAL, DIMENSION(SIZE(PP)) :: ZRSLW ! total solid and liquid water mixing ratio
+INTEGER :: ITERMAX ! Maximum number
+ ! of iteration
+INTEGER :: ITER ! iteration number of
+REAL :: ZEPS ! a small number
+INTEGER,DIMENSION(1) :: IMAXLOC ! localisation of
+ ! a maximum
+INTEGER :: ILUOUT,IRESP
+ ! logical unit for
+ ! output-listing
+ ! and error code
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE VAPOR MIXING RATIO
+! --------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_PMR_HU_1D',0,ZHOOK_HANDLE)
+ITERMAX = 10
+IF (PRESENT(KITERMAX)) ITERMAX=KITERMAX
+ZRDSRV = XRD /XRV
+ZEPS = 1.E-5
+!
+IF (SIZE(PR,2)>1) THEN
+ ZRSLW(:)=SUM(PR(:,2:),DIM=2)
+ELSE
+ ZRSLW(:)=0.
+END IF
+!
+ZT(:) = PTV(:)
+DO ITER=1,ITERMAX
+ ZESTD(:) = PHU(:) * SM_FOES(ZT(:)) * 0.01
+ PMR (:) = ZRDSRV * ZESTD(:) /(PP(:) - ZESTD(:))
+ ZDT(:) = ZT(:)
+ ZT(:) = PTV(:) * (1.+PMR(:)+ZRSLW(:)) / (1.+ PMR(:)/ZRDSRV)
+ ZDT(:) = ABS(ZDT(:) - ZT(:))
+END DO
+!-------------------------------------------------------------------------------
+!
+!* 2. NO CONVERGENCE
+! --------------
+!
+IF (ANY(ZDT>ZEPS)) THEN
+ ILUOUT = TLUOUT%NLU
+ WRITE(ILUOUT,*) 'ERROR IN FUNCTION SM_PMR_HU (module MODE_THERMO)'
+ WRITE(ILUOUT,*) 'FUNCTION FAILS TO CONVERGE AFTER ', ITERMAX,' ITERATIONS'
+ WRITE(ILUOUT,*) 'EPS = ' , ZEPS
+ IMAXLOC = MAXLOC(ZDT)
+ WRITE(ILUOUT,*) 'MAXIMUM RESIDUAL DT :', MAXVAL(ZDT)
+ WRITE(ILUOUT,*) 'MR AT THIS MAXIMUM : ', PMR(IMAXLOC)
+ WRITE(ILUOUT,*) 'T AT THIS MAXIMUM : ', ZT(IMAXLOC)
+ WRITE(ILUOUT,*) 'JOB ABORTED '
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'SM_PMR_HU_1D', 'failed to converge' )
+END IF
+!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_PMR_HU_1D',1,ZHOOK_HANDLE)
+END FUNCTION SM_PMR_HU_1D
+! ####################################
+ FUNCTION SM_FOES_0D(PT) RESULT(PFOES)
+! ####################################
+!
+!!**** *SM_FOES_0D * - function to compute saturation vapor pressure from
+!! temperature
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
+!
+!!** METHOD
+!! ------
+!! Given temperature T (PT), the saturation vapor pressure es(T)
+!! (FOES(PT)) is computed by integration of the Clapeyron equation
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
+!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
+!!
+!! with :
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
+!! gammaw (XGAMW) = (Cl -Cpv) /Rv
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : comtains physical constants
+!! XALPW : Constant for saturation vapor pressure function
+!! XBETAW : Constant for saturation vapor pressure function
+!! XGAMW : Constant for saturation vapor pressure function
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 28/08/94
+!! 24/12/97 (V. Masson) version for 0D arrays
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+!
+!
+REAL, INTENT(IN) :: PT ! Temperature
+ ! (Kelvin)
+REAL :: PFOES ! saturation vapor
+ ! pressure
+ ! (Pascal)
+!
+!* 0.2 Declarations of local variables
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE SATURATION VAPOR PRESSURE
+! ---------------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_FOES_0D',0,ZHOOK_HANDLE)
+PFOES = EXP( XALPW - XBETAW/PT - XGAMW*LOG(PT) )
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_FOES_0D',1,ZHOOK_HANDLE)
+END FUNCTION SM_FOES_0D
+!
+!-------------------------------------------------------------------------------
+! ####################################
+ FUNCTION SM_FOES_2D(PT) RESULT(PFOES)
+! ####################################
+!
+!!**** *SM_FOES_2D * - function to compute saturation vapor pressure from
+!! temperature
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
+!
+!!** METHOD
+!! ------
+!! Given temperature T (PT), the saturation vapor pressure es(T)
+!! (FOES(PT)) is computed by integration of the Clapeyron equation
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
+!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
+!!
+!! with :
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
+!! gammaw (XGAMW) = (Cl -Cpv) /Rv
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : comtains physical constants
+!! XALPW : Constant for saturation vapor pressure function
+!! XBETAW : Constant for saturation vapor pressure function
+!! XGAMW : Constant for saturation vapor pressure function
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 28/08/94
+!! 24/12/97 (V. Masson) version for 2D arrays
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+!
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PT ! Temperature
+ ! (Kelvin)
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: PFOES ! saturation vapor
+ ! pressure
+ ! (Pascal)
+!
+!* 0.2 Declarations of local variables
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE SATURATION VAPOR PRESSURE
+! ---------------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_FOES_2D',0,ZHOOK_HANDLE)
+PFOES(:,:) = EXP( XALPW - XBETAW/PT(:,:) - XGAMW*LOG(PT(:,:)) )
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_FOES_2D',1,ZHOOK_HANDLE)
+END FUNCTION SM_FOES_2D
+!
+!-------------------------------------------------------------------------------
+!
+! ################################################
+ FUNCTION SM_FOES_2D_MASK(OMASK,PT) RESULT(PFOES)
+! ################################################
+!
+!!**** *SM_FOES_2D * - function to compute saturation vapor pressure from
+!! temperature
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
+!
+!!** METHOD
+!! ------
+!! Given temperature T (PT), the saturation vapor pressure es(T)
+!! (FOES(PT)) is computed by integration of the Clapeyron equation
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
+!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
+!!
+!! with :
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
+!! gammaw (XGAMW) = (Cl -Cpv) /Rv
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : comtains physical constants
+!! XALPW : Constant for saturation vapor pressure function
+!! XBETAW : Constant for saturation vapor pressure function
+!! XGAMW : Constant for saturation vapor pressure function
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 28/08/94
+!! 24/12/97 (V. Masson) version for 2D arrays
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+!
+!
+LOGICAL, DIMENSION(:,:), INTENT(IN) :: OMASK ! Localization mask
+REAL, DIMENSION(:,:), INTENT(IN) :: PT ! Temperature
+ ! (Kelvin)
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: PFOES ! saturation vapor
+ ! pressure
+ ! (Pascal)
+!
+!* 0.2 Declarations of local variables
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE SATURATION VAPOR PRESSURE
+! ---------------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_FOES_2D_MASK',0,ZHOOK_HANDLE)
+WHERE (OMASK(:,:))
+ PFOES(:,:) = EXP( XALPW - XBETAW/PT(:,:) - XGAMW*LOG(PT(:,:)) )
+END WHERE
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:SM_FOES_2D_MASK',1,ZHOOK_HANDLE)
+END FUNCTION SM_FOES_2D_MASK
+!
+!-------------------------------------------------------------------------------
+!
+! ######################################
+ FUNCTION QSATW_3D(PT,PP) RESULT(PQSAT)
+! ######################################
+!
+!!**** *QSATW * - function to compute saturation vapor humidity from
+!! temperature
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
+!
+!!** METHOD
+!! ------
+!! Given temperature T (PT), the saturation vapor pressure es(T)
+!! (FOES(PT)) is computed by integration of the Clapeyron equation
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
+!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
+!!
+!! with :
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
+!! gammaw (XGAMW) = (Cl -Cpv) /Rv
+!!
+!! Then, the specific humidity at saturation is deduced.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : comtains physical constants
+!! XALPW : Constant for saturation vapor pressure function
+!! XBETAW : Constant for saturation vapor pressure function
+!! XGAMW : Constant for saturation vapor pressure function
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 21/09/98
+!! S. Riette april 2011 : protection in high statosphere where ZFOES > PP
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
+ ! (Kelvin)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PP ! Pressure
+ ! (Pa)
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: PQSAT ! saturation vapor
+ ! specific humidity
+ ! with respect to
+ ! water (kg/kg)
+!
+!* 0.2 Declarations of local variables
+!
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZFOES ! saturation vapor
+ ! pressure
+ ! (Pascal)
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE SATURATION VAPOR PRESSURE
+! ---------------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATW_3D',0,ZHOOK_HANDLE)
+ZFOES(:,:,:) = MIN(EXP( XALPW - XBETAW/PT(:,:,:) - XGAMW*LOG(PT(:,:,:)) ), 0.99*PP(:,:,:))
+!
+!* 2. COMPUTE SATURATION HUMIDITY
+! ---------------------------
+!
+PQSAT(:,:,:) = XRD/XRV*ZFOES(:,:,:)/PP(:,:,:) &
+ / (1.+(XRD/XRV-1.)*ZFOES(:,:,:)/PP(:,:,:))
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATW_3D',1,ZHOOK_HANDLE)
+END FUNCTION QSATW_3D
+!
+!-------------------------------------------------------------------------------
+!
+! ######################################
+ FUNCTION QSATW_2D(PT,PP) RESULT(PQSAT)
+! ######################################
+!
+!!**** *QSATW * - function to compute saturation vapor humidity from
+!! temperature
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
+!
+!!** METHOD
+!! ------
+!! Given temperature T (PT), the saturation vapor pressure es(T)
+!! (FOES(PT)) is computed by integration of the Clapeyron equation
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
+!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
+!!
+!! with :
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
+!! gammaw (XGAMW) = (Cl -Cpv) /Rv
+!!
+!! Then, the specific humidity at saturation is deduced.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : comtains physical constants
+!! XALPW : Constant for saturation vapor pressure function
+!! XBETAW : Constant for saturation vapor pressure function
+!! XGAMW : Constant for saturation vapor pressure function
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 21/09/98
+!! S. Riette april 2011 : protection in high statosphere where ZFOES > PP
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+!
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PT ! Temperature
+ ! (Kelvin)
+REAL, DIMENSION(:,:), INTENT(IN) :: PP ! Pressure
+ ! (Pa)
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: PQSAT ! saturation vapor
+ ! specific humidity
+ ! with respect to
+ ! water (kg/kg)
+!
+!* 0.2 Declarations of local variables
+!
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: ZFOES ! saturation vapor
+ ! pressure
+ ! (Pascal)
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE SATURATION VAPOR PRESSURE
+! ---------------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATW_2D',0,ZHOOK_HANDLE)
+ZFOES(:,:) = MIN(EXP( XALPW - XBETAW/PT(:,:) - XGAMW*LOG(PT(:,:)) ), 0.99*PP(:,:))
+!
+!* 2. COMPUTE SATURATION HUMIDITY
+! ---------------------------
+!
+PQSAT(:,:) = XRD/XRV*ZFOES(:,:)/PP(:,:) &
+ / (1.+(XRD/XRV-1.)*ZFOES(:,:)/PP(:,:))
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATW_2D',1,ZHOOK_HANDLE)
+END FUNCTION QSATW_2D
+!
+!-------------------------------------------------------------------------------
+!
+! #################################################
+ FUNCTION QSATW_2D_MASK(OMASK,PT,PP) RESULT(PQSAT)
+! #################################################
+!
+!!**** *QSATW * - function to compute saturation vapor humidity from
+!! temperature
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
+!
+!!** METHOD
+!! ------
+!! Given temperature T (PT), the saturation vapor pressure es(T)
+!! (FOES(PT)) is computed by integration of the Clapeyron equation
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
+!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
+!!
+!! with :
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
+!! gammaw (XGAMW) = (Cl -Cpv) /Rv
+!!
+!! Then, the specific humidity at saturation is deduced.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : comtains physical constants
+!! XALPW : Constant for saturation vapor pressure function
+!! XBETAW : Constant for saturation vapor pressure function
+!! XGAMW : Constant for saturation vapor pressure function
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 21/09/98
+!! S. Riette april 2011 : protection in high statosphere where ZFOES > PP
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+!
+!
+LOGICAL, DIMENSION(:,:), INTENT(IN) :: OMASK ! Localization mask
+REAL, DIMENSION(:,:), INTENT(IN) :: PT ! Temperature
+ ! (Kelvin)
+REAL, DIMENSION(:,:), INTENT(IN) :: PP ! Pressure
+ ! (Pa)
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: PQSAT ! saturation vapor
+ ! specific humidity
+ ! with respect to
+ ! water (kg/kg)
+!
+!* 0.2 Declarations of local variables
+!
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: ZFOES ! saturation vapor
+ ! pressure
+ ! (Pascal)
+!
+!-------------------------------------------------------------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATW_2D_MASK',0,ZHOOK_HANDLE)
+WHERE (OMASK(:,:))
+!
+!* 1. COMPUTE SATURATION VAPOR PRESSURE
+! ---------------------------------
+!
+ ZFOES(:,:) = MIN(EXP( XALPW - XBETAW/PT(:,:) - XGAMW*LOG(PT(:,:)) ), 0.99*PP(:,:))
+!
+!* 2. COMPUTE SATURATION HUMIDITY
+! ---------------------------
+!
+ PQSAT(:,:) = XRD/XRV*ZFOES(:,:)/PP(:,:) &
+ / (1.+(XRD/XRV-1.)*ZFOES(:,:)/PP(:,:))
+ELSEWHERE
+!
+!* 3. BOGUS VALUE
+! -----------
+!
+ PQSAT(:,:) = 0.
+END WHERE
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATW_2D_MASK',1,ZHOOK_HANDLE)
+END FUNCTION QSATW_2D_MASK
+!
+!-------------------------------------------------------------------------------
+!
+! ######################################
+ FUNCTION QSATW_1D(PT,PP) RESULT(PQSAT)
+! ######################################
+!
+!!**** *QSATW * - function to compute saturation vapor humidity from
+!! temperature
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
+!
+!!** METHOD
+!! ------
+!! Given temperature T (PT), the saturation vapor pressure es(T)
+!! (FOES(PT)) is computed by integration of the Clapeyron equation
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
+!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
+!!
+!! with :
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
+!! gammaw (XGAMW) = (Cl -Cpv) /Rv
+!!
+!! Then, the specific humidity at saturation is deduced.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : comtains physical constants
+!! XALPW : Constant for saturation vapor pressure function
+!! XBETAW : Constant for saturation vapor pressure function
+!! XGAMW : Constant for saturation vapor pressure function
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 21/09/98
+!! S. Riette april 2011 : protection in high statosphere where ZFOES > PP
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+!
+!
+REAL, DIMENSION(:), INTENT(IN) :: PT ! Temperature
+ ! (Kelvin)
+REAL, DIMENSION(:), INTENT(IN) :: PP ! Pressure
+ ! (Pa)
+REAL, DIMENSION(SIZE(PT,1)) :: PQSAT ! saturation vapor
+ ! specific humidity
+ ! with respect to
+ ! water (kg/kg)
+!
+!* 0.2 Declarations of local variables
+!
+REAL, DIMENSION(SIZE(PT,1)) :: ZFOES ! saturation vapor
+ ! pressure
+ ! (Pascal)
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE SATURATION VAPOR PRESSURE
+! ---------------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATW_1D',0,ZHOOK_HANDLE)
+ZFOES(:) = MIN(EXP( XALPW - XBETAW/PT(:) - XGAMW*LOG(PT(:)) ), 0.99*PP(:))
+!
+!* 2. COMPUTE SATURATION HUMIDITY
+! ---------------------------
+!
+PQSAT(:) = XRD/XRV*ZFOES(:)/PP(:) &
+ / (1.+(XRD/XRV-1.)*ZFOES(:)/PP(:))
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATW_1D',1,ZHOOK_HANDLE)
+END FUNCTION QSATW_1D
+!
+!-------------------------------------------------------------------------------
+!
+! ######################################
+ FUNCTION QSATW_0D(PT,PP) RESULT(PQSAT)
+! ######################################
+!
+!!**** *QSATW * - function to compute saturation vapor humidity from
+!! temperature
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
+!
+!!** METHOD
+!! ------
+!! Given temperature T (PT), the saturation vapor pressure es(T)
+!! (FOES(PT)) is computed by integration of the Clapeyron equation
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
+!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
+!!
+!! with :
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
+!! gammaw (XGAMW) = (Cl -Cpv) /Rv
+!!
+!! Then, the specific humidity at saturation is deduced.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : comtains physical constants
+!! XALPW : Constant for saturation vapor pressure function
+!! XBETAW : Constant for saturation vapor pressure function
+!! XGAMW : Constant for saturation vapor pressure function
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 21/09/98
+!! S. Riette april 2011 : protection in high statosphere where ZFOES > PP
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+!
+!
+REAL, INTENT(IN) :: PT ! Temperature
+ ! (Kelvin)
+REAL, INTENT(IN) :: PP ! Pressure
+ ! (Pa)
+REAL :: PQSAT ! saturation vapor
+ ! specific humidity
+ ! with respect to
+ ! water (kg/kg)
+!
+!* 0.2 Declarations of local variables
+!
+REAL :: ZFOES ! saturation vapor
+ ! pressure
+ ! (Pascal)
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE SATURATION VAPOR PRESSURE
+! ---------------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATW_0D',0,ZHOOK_HANDLE)
+ZFOES = MIN(EXP( XALPW - XBETAW/PT - XGAMW*LOG(PT) ), 0.99*PP)
+!
+!* 2. COMPUTE SATURATION HUMIDITY
+! ---------------------------
+!
+PQSAT = XRD/XRV*ZFOES/PP / (1.+(XRD/XRV-1.)*ZFOES/PP)
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATW_0D',1,ZHOOK_HANDLE)
+END FUNCTION QSATW_0D
+!
+!-------------------------------------------------------------------------------
+!
+! ##############################################################
+ FUNCTION DQSATW_O_DT_2D_MASK(OMASK,PT,PP,PQSAT) RESULT(PDQSAT)
+! ##############################################################
+!
+!!**** *QSATW * - function to compute saturation vapor humidity from
+!! temperature
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
+!
+!!** METHOD
+!! ------
+!! Given temperature T (PT), the saturation vapor pressure es(T)
+!! (FOES(PT)) is computed by integration of the Clapeyron equation
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
+!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
+!!
+!! with :
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
+!! gammaw (XGAMW) = (Cl -Cpv) /Rv
+!!
+!! Then, the specific humidity at saturation is deduced.
+!!
+!! Finally, dqsat / dT (T) is computed.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : comtains physical constants
+!! XALPW : Constant for saturation vapor pressure function
+!! XBETAW : Constant for saturation vapor pressure function
+!! XGAMW : Constant for saturation vapor pressure function
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 21/09/98
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+!
+!
+LOGICAL, DIMENSION(:,:), INTENT(IN) :: OMASK ! Localization mask
+REAL, DIMENSION(:,:), INTENT(IN) :: PT ! Temperature
+ ! (Kelvin)
+REAL, DIMENSION(:,:), INTENT(IN) :: PP ! Pressure
+ ! (Pa)
+REAL, DIMENSION(:,:), INTENT(IN) :: PQSAT ! saturation vapor
+ ! specific humidity
+ ! with respect to
+ ! water (kg/kg))
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: PDQSAT ! derivative according
+ ! to temperature of
+ ! saturation vapor
+ ! specific humidity
+ ! with respect to
+ ! water (kg/kg))
+!
+!* 0.2 Declarations of local variables
+!
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: ZFOES ! saturation vapor
+ ! pressure
+ ! (Pascal)
+!
+!-------------------------------------------------------------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:DQSATW_O_DT_2D_MASK',0,ZHOOK_HANDLE)
+WHERE (OMASK(:,:))
+!
+!* 1. COMPUTE SATURATION VAPOR PRESSURE
+! ---------------------------------
+!
+ ZFOES(:,:) = PP(:,:) / (1.+XRD/XRV*(1./PQSAT(:,:)-1.))
+!
+!* 2. DERIVATION ACCORDING TO TEMPERATURE
+! -----------------------------------
+!
+ PDQSAT(:,:) = PQSAT(:,:) / (1.+(XRD/XRV-1.)*ZFOES(:,:)/PP(:,:) ) &
+ * (XBETAW/PT(:,:)**2 - XGAMW/PT(:,:))
+ELSEWHERE
+!
+!* 3. BOGUS VALUE
+! -----------
+!
+ PDQSAT(:,:) = 0.
+END WHERE
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:DQSATW_O_DT_2D_MASK',1,ZHOOK_HANDLE)
+END FUNCTION DQSATW_O_DT_2D_MASK
+!
+!-------------------------------------------------------------------------------
+! ##############################################################
+ FUNCTION DQSATW_O_DT_1D(PT,PP,PQSAT) RESULT(PDQSAT)
+! ##############################################################
+!
+!!**** *QSATW * - function to compute saturation vapor humidity from
+!! temperature
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
+!
+!!** METHOD
+!! ------
+!! Given temperature T (PT), the saturation vapor pressure es(T)
+!! (FOES(PT)) is computed by integration of the Clapeyron equation
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
+!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
+!!
+!! with :
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
+!! gammaw (XGAMW) = (Cl -Cpv) /Rv
+!!
+!! Then, the specific humidity at saturation is deduced.
+!!
+!! Finally, dqsat / dT (T) is computed.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : comtains physical constants
+!! XALPW : Constant for saturation vapor pressure function
+!! XBETAW : Constant for saturation vapor pressure function
+!! XGAMW : Constant for saturation vapor pressure function
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 21/09/98
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+!
+!
+REAL, DIMENSION(:), INTENT(IN) :: PT ! Temperature
+ ! (Kelvin)
+REAL, DIMENSION(:), INTENT(IN) :: PP ! Pressure
+ ! (Pa)
+REAL, DIMENSION(:), INTENT(IN) :: PQSAT ! saturation vapor
+ ! specific humidity
+ ! with respect to
+ ! water (kg/kg))
+REAL, DIMENSION(SIZE(PT)) :: PDQSAT ! derivative according
+ ! to temperature of
+ ! saturation vapor
+ ! specific humidity
+ ! with respect to
+ ! water (kg/kg))
+!
+!* 0.2 Declarations of local variables
+!
+REAL, DIMENSION(SIZE(PT)) :: ZFOES ! saturation vapor
+ ! pressure
+ ! (Pascal)
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. COMPUTE SATURATION VAPOR PRESSURE
+! ---------------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:DQSATW_O_DT_1D',0,ZHOOK_HANDLE)
+ZFOES(:) = PP(:) / (1.+XRD/XRV*(1./PQSAT(:)-1.))
+!
+!* 2. DERIVATION ACCORDING TO TEMPERATURE
+! -----------------------------------
+!
+PDQSAT(:) = PQSAT(:) / (1.+(XRD/XRV-1.)*ZFOES(:)/PP(:) ) &
+ * (XBETAW/PT(:)**2 - XGAMW/PT(:))
+!
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:DQSATW_O_DT_1D',1,ZHOOK_HANDLE)
+END FUNCTION DQSATW_O_DT_1D
+!
+!-------------------------------------------------------------------------------
+! ##############################################################
+ FUNCTION DQSATW_O_DT_3D(PT,PP,PQSAT) RESULT(PDQSAT)
+! ##############################################################
+!
+!!**** *QSATW * - function to compute saturation vapor humidity from
+!! temperature
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
+!
+!!** METHOD
+!! ------
+!! Given temperature T (PT), the saturation vapor pressure es(T)
+!! (FOES(PT)) is computed by integration of the Clapeyron equation
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
+!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
+!!
+!! with :
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
+!! gammaw (XGAMW) = (Cl -Cpv) /Rv
+!!
+!! Then, the specific humidity at saturation is deduced.
+!!
+!! Finally, dqsat / dT (T) is computed.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : comtains physical constants
+!! XALPW : Constant for saturation vapor pressure function
+!! XBETAW : Constant for saturation vapor pressure function
+!! XGAMW : Constant for saturation vapor pressure function
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 21/09/98
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
+ ! (Kelvin)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PP ! Pressure
+ ! (Pa)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQSAT ! saturation vapor
+ ! specific humidity
+ ! with respect to
+ ! water (kg/kg))
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: PDQSAT ! derivative according
+ ! to temperature of
+ ! saturation vapor
+ ! specific humidity
+ ! with respect to
+ ! water (kg/kg))
+!
+!* 0.2 Declarations of local variables
+!
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZFOES ! saturation vapor
+ ! pressure
+ ! (Pascal)
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. COMPUTE SATURATION VAPOR PRESSURE
+! ---------------------------------
+!
+ZFOES(:,:,:) = PP(:,:,:) / (1.+XRD/XRV*(1./PQSAT(:,:,:)-1.))
+!
+!* 2. DERIVATION ACCORDING TO TEMPERATURE
+! -----------------------------------
+!
+PDQSAT(:,:,:) = PQSAT(:,:,:) / (1.+(XRD/XRV-1.)*ZFOES(:,:,:)/PP(:,:,:) ) &
+ * (XBETAW/PT(:,:,:)**2 - XGAMW/PT(:,:,:))
+!
+!-------------------------------------------------------------------------------
+!
+END FUNCTION DQSATW_O_DT_3D
+!
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+!
+! ##############################################################
+ FUNCTION DQSATI_O_DT_2D_MASK(OMASK,PT,PP,PQSAT) RESULT(PDQSAT)
+! ##############################################################
+!
+!!**** *QSATW * - function to compute saturation vapor humidity from
+!! temperature (with respect to ice)
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
+!
+!!** METHOD
+!! ------
+!! Given temperature T (PT), the saturation vapor pressure es(T)
+!! (FOES(PT)) is computed by integration of the Clapeyron equation
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
+!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
+!!
+!! with :
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
+!! gammaw (XGAMW) = (Cl -Cpv) /Rv
+!!
+!! Then, the specific humidity at saturation is deduced.
+!!
+!! Finally, dqsat / dT (T) is computed.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : comtains physical constants
+!! XALPW : Constant for saturation vapor pressure function
+!! XBETAW : Constant for saturation vapor pressure function
+!! XGAMW : Constant for saturation vapor pressure function
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 21/09/98
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+!
+!
+LOGICAL, DIMENSION(:,:), INTENT(IN) :: OMASK ! Localization mask
+REAL, DIMENSION(:,:), INTENT(IN) :: PT ! Temperature
+ ! (Kelvin)
+REAL, DIMENSION(:,:), INTENT(IN) :: PP ! Pressure
+ ! (Pa)
+REAL, DIMENSION(:,:), INTENT(IN) :: PQSAT ! saturation vapor
+ ! specific humidity
+ ! with respect to
+ ! water (kg/kg))
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: PDQSAT ! derivative according
+ ! to temperature of
+ ! saturation vapor
+ ! specific humidity
+ ! with respect to
+ ! water (kg/kg))
+!
+!* 0.2 Declarations of local variables
+!
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: ZFOES ! saturation vapor
+ ! pressure
+ ! (Pascal)
+!
+!-------------------------------------------------------------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:DQSATI_O_DT_2D_MASK',0,ZHOOK_HANDLE)
+WHERE (OMASK(:,:))
+!
+!* 1. COMPUTE SATURATION VAPOR PRESSURE
+! ---------------------------------
+!
+ ZFOES(:,:) = PP(:,:) / (1.+XRD/XRV*(1./PQSAT(:,:)-1.))
+!
+!* 3. DERIVATION ACCORDING TO TEMPERATURE
+! -----------------------------------
+!
+ PDQSAT(:,:) = PQSAT(:,:) / (1.+(XRD/XRV-1.)*ZFOES(:,:)/PP(:,:) ) &
+ * (XBETAI/PT(:,:)**2 - XGAMI/PT(:,:))
+ELSEWHERE
+!
+!* 3. BOGUS VALUE
+! -----------
+!
+ PDQSAT(:,:) = 0.
+END WHERE
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:DQSATI_O_DT_2D_MASK',1,ZHOOK_HANDLE)
+END FUNCTION DQSATI_O_DT_2D_MASK
+!
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+! ##############################################################
+ FUNCTION DQSATI_O_DT_1D(PT,PP,PQSAT) RESULT(PDQSAT)
+! ##############################################################
+!
+!!**** *QSATW * - function to compute saturation vapor humidity from
+!! temperature (with respect to ice)
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
+!
+!!** METHOD
+!! ------
+!! Given temperature T (PT), the saturation vapor pressure es(T)
+!! (FOES(PT)) is computed by integration of the Clapeyron equation
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
+!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
+!!
+!! with :
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
+!! gammaw (XGAMW) = (Cl -Cpv) /Rv
+!!
+!! Then, the specific humidity at saturation is deduced.
+!!
+!! Finally, dqsat / dT (T) is computed.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : comtains physical constants
+!! XALPW : Constant for saturation vapor pressure function
+!! XBETAW : Constant for saturation vapor pressure function
+!! XGAMW : Constant for saturation vapor pressure function
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 21/09/98
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+!
+!
+REAL, DIMENSION(:), INTENT(IN) :: PT ! Temperature
+ ! (Kelvin)
+REAL, DIMENSION(:), INTENT(IN) :: PP ! Pressure
+ ! (Pa)
+REAL, DIMENSION(:), INTENT(IN) :: PQSAT ! saturation vapor
+ ! specific humidity
+ ! with respect to
+ ! water (kg/kg))
+REAL, DIMENSION(SIZE(PT)) :: PDQSAT ! derivative according
+ ! to temperature of
+ ! saturation vapor
+ ! specific humidity
+ ! with respect to
+ ! water (kg/kg))
+!
+!* 0.2 Declarations of local variables
+!
+REAL, DIMENSION(SIZE(PT)) :: ZFOES ! saturation vapor
+ ! pressure
+ ! (Pascal)
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. COMPUTE SATURATION VAPOR PRESSURE
+! ---------------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:DQSATI_O_DT_1D',0,ZHOOK_HANDLE)
+ZFOES(:) = PP(:) / (1.+XRD/XRV*(1./PQSAT(:)-1.))
+!
+!* 3. DERIVATION ACCORDING TO TEMPERATURE
+! -----------------------------------
+!
+PDQSAT(:) = PQSAT(:) / (1.+(XRD/XRV-1.)*ZFOES(:)/PP(:) ) &
+ * (XBETAI/PT(:)**2 - XGAMI/PT(:))
+!
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:DQSATI_O_DT_1D',1,ZHOOK_HANDLE)
+END FUNCTION DQSATI_O_DT_1D
+!
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+! ##############################################################
+ FUNCTION DQSATI_O_DT_3D(PT,PP,PQSAT) RESULT(PDQSAT)
+! ##############################################################
+!
+!!**** *QSATW * - function to compute saturation vapor humidity from
+!! temperature (with respect to ice)
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
+!
+!!** METHOD
+!! ------
+!! Given temperature T (PT), the saturation vapor pressure es(T)
+!! (FOES(PT)) is computed by integration of the Clapeyron equation
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
+!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
+!!
+!! with :
+!! alphaw (XALPW) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! betaw (XBETAW) = Lv(Tt)/Rv + gammaw Tt
+!! gammaw (XGAMW) = (Cl -Cpv) /Rv
+!!
+!! Then, the specific humidity at saturation is deduced.
+!!
+!! Finally, dqsat / dT (T) is computed.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : comtains physical constants
+!! XALPW : Constant for saturation vapor pressure function
+!! XBETAW : Constant for saturation vapor pressure function
+!! XGAMW : Constant for saturation vapor pressure function
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 21/09/98
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
+ ! (Kelvin)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PP ! Pressure
+ ! (Pa)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQSAT ! saturation vapor
+ ! specific humidity
+ ! with respect to
+ ! water (kg/kg))
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: PDQSAT ! derivative according
+ ! to temperature of
+ ! saturation vapor
+ ! specific humidity
+ ! with respect to
+ ! water (kg/kg))
+!
+!* 0.2 Declarations of local variables
+!
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZFOES ! saturation vapor
+ ! pressure
+ ! (Pascal)
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. COMPUTE SATURATION VAPOR PRESSURE
+! ---------------------------------
+!
+ZFOES(:,:,:) = PP(:,:,:) / (1.+XRD/XRV*(1./PQSAT(:,:,:)-1.))
+!
+!* 3. DERIVATION ACCORDING TO TEMPERATURE
+! -----------------------------------
+!
+PDQSAT(:,:,:) = PQSAT(:,:,:) / (1.+(XRD/XRV-1.)*ZFOES(:,:,:)/PP(:,:,:) ) &
+ * (XBETAI/PT(:,:,:)**2 - XGAMI/PT(:,:,:))
+!
+!-------------------------------------------------------------------------------
+!
+END FUNCTION DQSATI_O_DT_3D
+!
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+!
+! ######################################
+ FUNCTION QSATI_3D(PT,PP) RESULT(PQSAT)
+! ######################################
+!
+!!**** *QSATI * - function to compute saturation vapor humidity from
+!! temperature
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
+!
+!!** METHOD
+!! ------
+!! Given temperature T (PT), the saturation vapor pressure es(T)
+!! (FOES(PT)) is computed by integration of the Clapeyron equation
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
+!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
+!!
+!! with :
+!! alphaw (XALPI) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! betaw (XBETAI) = Lv(Tt)/Rv + gammaw Tt
+!! gammaw (XGAMI) = (Cl -Cpv) /Rv
+!!
+!! Then, the specific humidity at saturation is deduced.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : comtains physical constants
+!! XALPI : Constant for saturation vapor pressure function
+!! XBETAI : Constant for saturation vapor pressure function
+!! XGAMI : Constant for saturation vapor pressure function
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 21/09/98
+!! S. Riette april 2011 : protection in high statosphere where ZFOES > PP
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
+ ! (Kelvin)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PP ! Pressure
+ ! (Pa)
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: PQSAT ! saturation vapor
+ ! specific humidity
+ ! with respect to
+ ! water (kg/kg)
+!
+!* 0.2 Declarations of local variables
+!
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZFOES ! saturation vapor
+ ! pressure
+ ! (Pascal)
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE SATURATION VAPOR PRESSURE
+! ---------------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATI_3D',0,ZHOOK_HANDLE)
+ZFOES(:,:,:) = MIN(EXP( XALPI - XBETAI/PT(:,:,:) - XGAMI*LOG(PT(:,:,:)) ), 0.99*PP(:,:,:))
+!
+!* 2. COMPUTE SATURATION HUMIDITY
+! ---------------------------
+!
+PQSAT(:,:,:) = XRD/XRV*ZFOES(:,:,:)/PP(:,:,:) &
+ / (1.+(XRD/XRV-1.)*ZFOES(:,:,:)/PP(:,:,:))
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATI_3D',1,ZHOOK_HANDLE)
+END FUNCTION QSATI_3D
+!
+!-------------------------------------------------------------------------------
+!
+! ######################################
+ FUNCTION QSATI_2D(PT,PP) RESULT(PQSAT)
+! ######################################
+!
+!!**** *QSATI * - function to compute saturation vapor humidity from
+!! temperature
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
+!
+!!** METHOD
+!! ------
+!! Given temperature T (PT), the saturation vapor pressure es(T)
+!! (FOES(PT)) is computed by integration of the Clapeyron equation
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
+!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
+!!
+!! with :
+!! alphaw (XALPI) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! betaw (XBETAI) = Lv(Tt)/Rv + gammaw Tt
+!! gammaw (XGAMI) = (Cl -Cpv) /Rv
+!!
+!! Then, the specific humidity at saturation is deduced.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : comtains physical constants
+!! XALPI : Constant for saturation vapor pressure function
+!! XBETAI : Constant for saturation vapor pressure function
+!! XGAMI : Constant for saturation vapor pressure function
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 21/09/98
+!! S. Riette april 2011 : protection in high statosphere where ZFOES > PP
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+!
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PT ! Temperature
+ ! (Kelvin)
+REAL, DIMENSION(:,:), INTENT(IN) :: PP ! Pressure
+ ! (Pa)
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: PQSAT ! saturation vapor
+ ! specific humidity
+ ! with respect to
+ ! water (kg/kg)
+!
+!* 0.2 Declarations of local variables
+!
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: ZFOES ! saturation vapor
+ ! pressure
+ ! (Pascal)
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE SATURATION VAPOR PRESSURE
+! ---------------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATI_2D',0,ZHOOK_HANDLE)
+ZFOES(:,:) = MIN(EXP( XALPI - XBETAI/PT(:,:) - XGAMI*LOG(PT(:,:)) ), 0.99*PP(:,:))
+!
+!* 2. COMPUTE SATURATION HUMIDITY
+! ---------------------------
+!
+PQSAT(:,:) = XRD/XRV*ZFOES(:,:)/PP(:,:) &
+ / (1.+(XRD/XRV-1.)*ZFOES(:,:)/PP(:,:))
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATI_2D',1,ZHOOK_HANDLE)
+END FUNCTION QSATI_2D
+!
+!-------------------------------------------------------------------------------
+!
+! #################################################
+ FUNCTION QSATI_2D_MASK(OMASK,PT,PP) RESULT(PQSAT)
+! #################################################
+!
+!!**** *QSATI * - function to compute saturation vapor humidity from
+!! temperature
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
+!
+!!** METHOD
+!! ------
+!! Given temperature T (PT), the saturation vapor pressure es(T)
+!! (FOES(PT)) is computed by integration of the Clapeyron equation
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
+!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
+!!
+!! with :
+!! alphaw (XALPI) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! betaw (XBETAI) = Lv(Tt)/Rv + gammaw Tt
+!! gammaw (XGAMI) = (Cl -Cpv) /Rv
+!!
+!! Then, the specific humidity at saturation is deduced.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : comtains physical constants
+!! XALPI : Constant for saturation vapor pressure function
+!! XBETAI : Constant for saturation vapor pressure function
+!! XGAMI : Constant for saturation vapor pressure function
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 21/09/98
+!! S. Riette april 2011 : protection in high statosphere where ZFOES > PP
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+!
+!
+LOGICAL, DIMENSION(:,:), INTENT(IN) :: OMASK ! Localization mask
+REAL, DIMENSION(:,:), INTENT(IN) :: PT ! Temperature
+ ! (Kelvin)
+REAL, DIMENSION(:,:), INTENT(IN) :: PP ! Pressure
+ ! (Pa)
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: PQSAT ! saturation vapor
+ ! specific humidity
+ ! with respect to
+ ! water (kg/kg)
+!
+!* 0.2 Declarations of local variables
+!
+REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2)) :: ZFOES ! saturation vapor
+ ! pressure
+ ! (Pascal)
+!
+!-------------------------------------------------------------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATI_2D_MASK',0,ZHOOK_HANDLE)
+WHERE (OMASK(:,:))
+!
+!* 1. COMPUTE SATURATION VAPOR PRESSURE
+! ---------------------------------
+!
+ ZFOES(:,:) = MIN(EXP( XALPI - XBETAI/PT(:,:) - XGAMI*LOG(PT(:,:)) ), 0.99*PP(:,:))
+!
+!* 2. COMPUTE SATURATION HUMIDITY
+! ---------------------------
+!
+ PQSAT(:,:) = XRD/XRV*ZFOES(:,:)/PP(:,:) &
+ / (1.+(XRD/XRV-1.)*ZFOES(:,:)/PP(:,:))
+ELSEWHERE
+!
+!* 3. BOGUS VALUE
+! -----------
+!
+ PQSAT(:,:) = 0.
+END WHERE
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATI_2D_MASK',1,ZHOOK_HANDLE)
+END FUNCTION QSATI_2D_MASK
+!
+!-------------------------------------------------------------------------------
+!
+! ######################################
+ FUNCTION QSATI_1D(PT,PP) RESULT(PQSAT)
+! ######################################
+!
+!!**** *QSATI * - function to compute saturation vapor humidity from
+!! temperature
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
+!
+!!** METHOD
+!! ------
+!! Given temperature T (PT), the saturation vapor pressure es(T)
+!! (FOES(PT)) is computed by integration of the Clapeyron equation
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
+!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
+!!
+!! with :
+!! alphaw (XALPI) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! betaw (XBETAI) = Lv(Tt)/Rv + gammaw Tt
+!! gammaw (XGAMI) = (Cl -Cpv) /Rv
+!!
+!! Then, the specific humidity at saturation is deduced.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : comtains physical constants
+!! XALPI : Constant for saturation vapor pressure function
+!! XBETAI : Constant for saturation vapor pressure function
+!! XGAMI : Constant for saturation vapor pressure function
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 21/09/98
+!! S. Riette april 2011 : protection in high statosphere where ZFOES > PP
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+!
+!
+REAL, DIMENSION(:), INTENT(IN) :: PT ! Temperature
+ ! (Kelvin)
+REAL, DIMENSION(:), INTENT(IN) :: PP ! Pressure
+ ! (Pa)
+REAL, DIMENSION(SIZE(PT,1)) :: PQSAT ! saturation vapor
+ ! specific humidity
+ ! with respect to
+ ! water (kg/kg)
+!
+!* 0.2 Declarations of local variables
+!
+REAL, DIMENSION(SIZE(PT,1)) :: ZFOES ! saturation vapor
+ ! pressure
+ ! (Pascal)
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE SATURATION VAPOR PRESSURE
+! ---------------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATI_1D',0,ZHOOK_HANDLE)
+ZFOES(:) = MIN(EXP( XALPI - XBETAI/PT(:) - XGAMI*LOG(PT(:)) ), 0.99*PP(:))
+!
+!* 2. COMPUTE SATURATION HUMIDITY
+! ---------------------------
+!
+PQSAT(:) = XRD/XRV*ZFOES(:)/PP(:) &
+ / (1.+(XRD/XRV-1.)*ZFOES(:)/PP(:))
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATI_1D',1,ZHOOK_HANDLE)
+END FUNCTION QSATI_1D
+!
+!-------------------------------------------------------------------------------
+!
+! ######################################
+ FUNCTION QSATI_0D(PT,PP) RESULT(PQSAT)
+! ######################################
+!
+!!**** *QSATI * - function to compute saturation vapor humidity from
+!! temperature
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute the saturation vapor
+! pressure from temperature
+!
+!
+!!** METHOD
+!! ------
+!! Given temperature T (PT), the saturation vapor pressure es(T)
+!! (FOES(PT)) is computed by integration of the Clapeyron equation
+!! from the triple point temperature Tt (XTT) and the saturation vapor
+!! pressure of the triple point es(Tt) (XESTT), i.e
+!!
+!! es(T)= EXP( alphaw - betaw /T - gammaw Log(T) )
+!!
+!! with :
+!! alphaw (XALPI) = LOG(es(Tt))+ betaw/Tt + gammaw Log(Tt)
+!! betaw (XBETAI) = Lv(Tt)/Rv + gammaw Tt
+!! gammaw (XGAMI) = (Cl -Cpv) /Rv
+!!
+!! Then, the specific humidity at saturation is deduced.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : comtains physical constants
+!! XALPI : Constant for saturation vapor pressure function
+!! XBETAI : Constant for saturation vapor pressure function
+!! XGAMI : Constant for saturation vapor pressure function
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 21/09/98
+!! S. Riette april 2011 : protection in high statosphere where ZFOES > PP
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+!
+!
+REAL, INTENT(IN) :: PT ! Temperature
+ ! (Kelvin)
+REAL, INTENT(IN) :: PP ! Pressure
+ ! (Pa)
+REAL :: PQSAT ! saturation vapor
+ ! specific humidity
+ ! with respect to
+ ! water (kg/kg)
+!
+!* 0.2 Declarations of local variables
+!
+REAL :: ZFOES ! saturation vapor
+ ! pressure
+ ! (Pascal)
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE SATURATION VAPOR PRESSURE
+! ---------------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATI_0D',0,ZHOOK_HANDLE)
+ZFOES = MIN(EXP( XALPI - XBETAI/PT - XGAMI*LOG(PT) ), 0.99*PP)
+!
+!* 2. COMPUTE SATURATION HUMIDITY
+! ---------------------------
+!
+PQSAT = XRD/XRV*ZFOES/PP / (1.+(XRD/XRV-1.)*ZFOES/PP)
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('MODE_THERMO:QSATI_0D',1,ZHOOK_HANDLE)
+END FUNCTION QSATI_0D
+!
+!-------------------------------------------------------------------------------
+END MODULE MODE_THERMO
diff --git a/src/mesonh/aux/mode_tools_ll.f90 b/src/mesonh/aux/mode_tools_ll.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a617c26fbbcb83687687c02881242b89ac2c2411
--- /dev/null
+++ b/src/mesonh/aux/mode_tools_ll.f90
@@ -0,0 +1,3658 @@
+!MNH_LIC Copyright 1998-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.
+!-----------------------------------------------------------------
+! Modifications:
+! J. Escobar 15/09/2015: WENO5 & JPHEXT <> 1
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 26/04/2019: use modd_precision parameters for datatypes of MPI communications
+!-----------------------------------------------------------------
+
+! ####################
+ MODULE MODE_TOOLS_ll
+! ####################
+!
+!! Purpose
+!! -------
+!
+! The Purpose of this module is to provide subroutines and functions for
+! for the initialization of parallel data variables
+!
+!! Routines Of The User Interface
+!! ------------------------------
+!
+! FUNCTIONS : LNORTH_ll, LSOUTH_ll, LEAST_ll, LWEST_ll
+! SUBROUTINES : GET_DIM_EXT_ll, GET_OR_ll, GET_INDICE_ll, GET_PHYSICAL_ll
+! GET_INTERSECTION_ll,
+! GET_GLOBALSLICE_ll
+! (GET_1DGLOBALSLICE_ll, GET_2DGLOBALSLICE_ll),
+! GET_SLICE_ll
+! (GET_1DSLICE_ll, GET_2DSLICE_ll)
+! GET_L2_NORM_ll
+!
+!! Reference
+!! ---------
+!
+! User Interface for Meso-NH parallel package
+! Ph. Kloos, L. Giraud, R. Guivarch, D. Lugato
+!
+!! Authors
+!! -------
+!
+! R. Guivarch, D. Lugato * CERFACS *
+! Ph. Kloos * CERFACS - CNRM *
+!
+! Modif
+! Juan/Didier 12/03/2009: array bound bug correction with 1proc/MPIVIDE
+! J. Escobar 27/06/2011 correction for gridnesting with different SHAPE
+!
+USE MODD_MPIF
+use modd_precision, only: MNHINT_MPI, MNHREAL_MPI
+USE MODD_STRUCTURE_ll
+USE MODD_VAR_ll, ONLY : NMNH_COMM_WORLD
+
+use mode_msg
+
+implicit none
+
+interface GET_GLOBALSLICE_ll
+ module procedure GET_1DGLOBALSLICE_ll, GET_2DGLOBALSLICE_ll
+end interface
+
+interface GET_SLICE_ll
+ module procedure GET_1DSLICE_ll, GET_2DSLICE_ll
+end interface
+
+CONTAINS
+
+ SUBROUTINE SLIDE_COORD(KDIM_DATA,KDIM_PROC,THIS_PROC,KOR,KEND)
+
+ !! Purpose
+ !
+ ! Compute for the processor=THIS_PROC the origine/end of slide in decomposing
+ ! an array of data of dimension=KDIM_DATA on KDIM_PROC
+ !
+ !! Author
+ !! ------
+ ! J. ESCOBAR * LA *
+
+ IMPLICIT NONE
+ !
+ !* 0.1 declarations of arguments
+ !
+ INTEGER, INTENT(IN) :: KDIM_DATA ! dimension of data to split
+ INTEGER, INTENT(IN) :: KDIM_PROC ! numbers of processor to use in splitting
+ INTEGER, INTENT(IN) :: THIS_PROC ! processor id from 1..NB_PROC
+ INTEGER, INTENT(OUT) :: KOR,KEND ! Origine/End coordonate
+ !
+ !* 0.2 declarations of local variables
+ !
+ INTEGER :: IDIM_SLIDE ! slide dimension ( without rest/delta )
+ INTEGER :: IREST ! number of point in surabondance to distribut
+ INTEGER :: IDELTAOR,IDELTAEND ! offset in origine to apply
+
+ IDIM_SLIDE = KDIM_DATA/KDIM_PROC
+ IREST = MOD(KDIM_DATA,KDIM_PROC)
+ IDELTAOR = MIN(IREST,THIS_PROC-1)
+ IDELTAEND = MIN(IREST,THIS_PROC)
+
+ KOR = ( THIS_PROC - 1 ) * IDIM_SLIDE + 1 + IDELTAOR
+ KEND = THIS_PROC * IDIM_SLIDE + IDELTAEND
+
+ END SUBROUTINE SLIDE_COORD
+
+!
+! ########################################
+ LOGICAL FUNCTION LNORTH_ll(K,HSPLITTING)
+! ########################################
+!
+!!**** *LNORTH_ll* - function which returns the position on to the boundaries
+! of the subdomain K according to the splitting
+!
+!! Purpose
+!! -------
+! the Purpose of this routine is to offer a transparent way to obtain
+! the position of a subdomain
+!
+!!** Method
+!! ------
+! if the argument HSPLITTING is omitted the 2Way splitting is considered
+! if the argument K is omitted, the local subdomain is considered
+!
+!! External
+!! --------
+!
+!! Implicit Arguments
+!! ------------------
+! Module MODD_VAR_ll
+! TCRRT_PROCONF - Current configuration for current model
+! IP - Number of local processor=subdomain
+! NPROC - Number of processors
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! R. Guivarch
+!
+!! Modifications
+!! -------------
+! Original 01/05/98
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_VAR_ll, ONLY : TCRRT_PROCONF, IP, NPROC
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ INTEGER, INTENT(IN), OPTIONAL :: K ! number of the subdomain
+ CHARACTER(len=1), INTENT(IN), OPTIONAL :: HSPLITTING ! kind of splitting
+!
+!* 0.2 declarations of local variables
+!
+ INTEGER :: IT ! number of the tested subdomain
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTATION OF THE RESULT :
+! -------------------------
+!
+ IF( PRESENT(K) ) THEN
+ IT = K
+ ELSE
+ IT = IP
+ ENDIF
+!
+ LNORTH_ll = .FALSE.
+!
+ IF(.NOT.PRESENT(HSPLITTING)) THEN
+ LNORTH_ll = TCRRT_PROCONF%TBOUND(IT)%NORTH
+ ELSEIF(HSPLITTING .EQ. 'B') THEN
+ LNORTH_ll = TCRRT_PROCONF%TBOUND(IT)%NORTH
+ ELSEIF(HSPLITTING .EQ. 'X') THEN
+ LNORTH_ll = (IT.EQ.NPROC)
+ ELSEIF(HSPLITTING .EQ. 'Y') THEN
+ LNORTH_ll = .TRUE.
+ ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+ END FUNCTION LNORTH_ll
+!
+! #######################################
+ LOGICAL FUNCTION LWEST_ll(K,HSPLITTING)
+! #######################################
+!
+!!**** *LWEST_ll* - function which returns the position on to the boundaries
+! of the subdomain K according to the splitting
+!
+!! Purpose
+!! -------
+! the Purpose of this routine is to offer a transparent way to obtain
+! the position of a subdomain
+!
+!!** Method
+!! ------
+! if the argument HSPLITTING is omitted the 2Way splitting is considered
+! if the argument K is omitted, the local subdomain is considered
+!
+!! External
+!! --------
+!
+!! Implicit Arguments
+!! ------------------
+! Module MODD_VAR_ll
+! TCRRT_PROCONF - Current configuration for current model
+! IP - Number of local processor=subdomain
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! R. Guivarch
+!
+!! Modifications
+!! -------------
+! Original 01/05/98
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_VAR_ll, ONLY : TCRRT_PROCONF, IP
+!
+ IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+ INTEGER, INTENT(IN), OPTIONAL :: K ! number of the subdomain
+ CHARACTER(len=1), INTENT(IN), OPTIONAL :: HSPLITTING ! kind of splitting
+
+!!
+!* 0.2 declarations of local variables
+!
+ INTEGER :: IT ! number of the tested subdomain
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTATION OF THE RESULT :
+! -------------------------
+!
+ IF( PRESENT(K) ) THEN
+ IT = K
+ ELSE
+ IT = IP
+ ENDIF
+!
+ LWEST_ll = .FALSE.
+!
+ IF(.NOT.PRESENT(HSPLITTING)) THEN
+ LWEST_ll = TCRRT_PROCONF%TBOUND(IT)%WEST
+ ELSEIF(HSPLITTING .EQ. 'B') THEN
+ LWEST_ll = TCRRT_PROCONF%TBOUND(IT)%WEST
+ ELSEIF(HSPLITTING .EQ. 'X') THEN
+ LWEST_ll = .TRUE.
+ ELSEIF(HSPLITTING .EQ. 'Y') THEN
+ LWEST_ll = (IT.EQ.1)
+ ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+ END FUNCTION LWEST_ll
+!
+! ########################################
+ LOGICAL FUNCTION LSOUTH_ll(K,HSPLITTING)
+! ########################################
+!
+!!**** *LSOUTH_ll* - function which returns the position on to the boundaries
+!! of the subdomain K according to the splitting
+!!
+!! Purpose
+!! -------
+! the Purpose of this routine is to offer a transparent way to obtain
+! the position of a subdomain
+!
+!!** Method
+!! ------
+! if the argument HSPLITTING is omitted the 2Way splitting is considered
+! if the argument K is omitted, the local subdomain is considered
+!
+!! External
+!! --------
+!
+!! Implicit Arguments
+!! ------------------
+! Module MODD_VAR_ll
+! TCRRT_PROCONF - Current configuration for current model
+! IP - Number of local processor=subdomain
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! R. Guivarch
+!
+!! Modifications
+!! -------------
+! Original 01/05/98
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_VAR_ll, ONLY : TCRRT_PROCONF, IP
+!
+ IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+ INTEGER, INTENT(IN), OPTIONAL :: K ! number of the subdomain
+ CHARACTER(len=1), INTENT(IN), OPTIONAL :: HSPLITTING ! kind of splitting
+
+!!
+!* 0.2 declarations of local variables
+!
+ INTEGER :: IT ! number of the tested subdomain
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTATION OF THE RESULT :
+! -------------------------
+!
+ IF( PRESENT(K) ) THEN
+ IT = K
+ ELSE
+ IT = IP
+ ENDIF
+!
+ LSOUTH_ll = .FALSE.
+!
+ IF(.NOT.PRESENT(HSPLITTING)) THEN
+ LSOUTH_ll = TCRRT_PROCONF%TBOUND(IT)%SOUTH
+ ELSEIF(HSPLITTING .EQ. 'B') THEN
+ LSOUTH_ll = TCRRT_PROCONF%TBOUND(IT)%SOUTH
+ ELSEIF(HSPLITTING .EQ. 'X') THEN
+ LSOUTH_ll = (IT.EQ.1)
+ ELSEIF(HSPLITTING .EQ. 'Y') THEN
+ LSOUTH_ll = .TRUE.
+ ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+ END FUNCTION LSOUTH_ll
+!
+! #######################################
+ LOGICAL FUNCTION LEAST_ll(K,HSPLITTING)
+! #######################################
+!
+!!**** *LEAST_ll* - function which returns the position on to the boundaries
+!! of the subdomain K according to the splitting
+!!
+!! Purpose
+!! -------
+! the Purpose of this routine is to offer a transparent way to obtain
+! the position of a subdomain
+!
+!!** Method
+!! ------
+! if the argument HSPLITTING is omitted the 2Way splitting is considered
+! if the argument K is omitted, the local subdomain is considered
+!
+!! External
+!! --------
+!
+!! Implicit Arguments
+!! ------------------
+! Module MODD_VAR_ll
+! TCRRT_PROCONF - Current configuration for current model
+! IP - Number of local processor=subdomain
+! NPROC - Number of processors
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! R. Guivarch
+!
+!! Modifications
+!! -------------
+! Original 01/05/98
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_VAR_ll, ONLY : TCRRT_PROCONF, IP, NPROC
+!
+ IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+ INTEGER, INTENT(IN), OPTIONAL :: K ! number of the subdomain
+ CHARACTER(len=1), INTENT(IN), OPTIONAL :: HSPLITTING ! kind of splitting
+
+!!
+!* 0.2 declarations of local variables
+!
+ INTEGER :: IT ! number of the tested subdomain
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTATION OF THE RESULT :
+! -------------------------
+!
+ IF( PRESENT(K) ) THEN
+ IT = K
+ ELSE
+ IT = IP
+ ENDIF
+!
+ LEAST_ll = .FALSE.
+!
+ IF(.NOT.PRESENT(HSPLITTING)) THEN
+ LEAST_ll = TCRRT_PROCONF%TBOUND(IT)%EAST
+ ELSEIF(HSPLITTING .EQ. 'B') THEN
+ LEAST_ll = TCRRT_PROCONF%TBOUND(IT)%EAST
+ ELSEIF(HSPLITTING .EQ. 'X') THEN
+ LEAST_ll = .TRUE.
+ ELSEIF(HSPLITTING .EQ. 'Y') THEN
+ LEAST_ll = (IT.EQ.NPROC)
+ ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+ END FUNCTION LEAST_ll
+!
+! #################################################
+ SUBROUTINE GET_DIM_EXT_ll( HSPLIT, KXDIM, KYDIM )
+! #################################################
+!
+!!**** *GET_DIM_EXT_ll* - returns the dimensions of the extended 2way subdomain
+! or of the x-slices subdomain or of the y-slices
+! subdomain of the local processor
+!
+!! Purpose
+!! -------
+! the Purpose of this routine is to give subdomain dimension
+!
+!!** Method
+!! ------
+! if HSPLIT='B', the dimensions of the extended 2way subdomain are returned
+! if HSPLIT='X', the dimensions of x-slices subdomain are returned
+! if HSPLIT='Y', the dimensions of y-slices subdomain are returned
+!
+!! External
+!! --------
+!
+!! Implicit Arguments
+!! ------------------
+! Module MODD_VAR_ll
+! TCRRT_COMDATA - Current communication data structure for current model
+! and local processor
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! R. Guivarch
+!
+!! Modifications
+!! -------------
+! Original 01/05/98
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_VAR_ll, ONLY : TCRRT_COMDATA
+!
+ IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+ CHARACTER(len=1), INTENT(IN) :: HSPLIT
+!
+ INTEGER, INTENT(OUT) :: KXDIM, KYDIM
+!
+!
+!* 0.2 declarations of local variables
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. Return the dimensions
+!
+ IF( HSPLIT .EQ. 'B' ) THEN
+ KXDIM = TCRRT_COMDATA%TSPLIT_B%NDIMXE
+ KYDIM = TCRRT_COMDATA%TSPLIT_B%NDIMYE
+ ELSEIF ( HSPLIT .EQ. 'X' ) THEN
+ KXDIM = TCRRT_COMDATA%TSPLIT_X%NDIMXP
+ KYDIM = TCRRT_COMDATA%TSPLIT_X%NDIMYP
+ ELSE
+ KXDIM = TCRRT_COMDATA%TSPLIT_Y%NDIMXP
+ KYDIM = TCRRT_COMDATA%TSPLIT_Y%NDIMYP
+ ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+ END SUBROUTINE GET_DIM_EXT_ll
+!
+! ##################################################
+ SUBROUTINE GET_DIM_PHYS_ll( HSPLIT, KXDIM, KYDIM )
+! ##################################################
+!
+!!**** *GET_DIM_PHYS_ll* - returns the dimensions of the physical
+! 2way subdomain or of the x-slices subdomain or
+! of the y-slices subdomain of the local processor
+!
+!! Purpose
+!! -------
+! the Purpose of this routine is to give subdomain dimension
+!
+!!** Method
+!! ------
+! if HSPLIT='B', the dimensions of the physical 2way subdomain are returned
+! if HSPLIT='X', the dimensions of x-slices subdomain are returned
+! if HSPLIT='Y', the dimensions of y-slices subdomain are returned
+!
+!! External
+!! --------
+!
+!! Implicit Arguments
+!! ------------------
+! Module MODD_VAR_ll
+! TCRRT_COMDATA - Current communication data structure for current model
+! and local processor
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! R. Guivarch
+!
+!! Modifications
+!! -------------
+! Original 01/05/98
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_VAR_ll, ONLY : TCRRT_COMDATA
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ CHARACTER(len=1), INTENT(IN) :: HSPLIT
+!
+ INTEGER, INTENT(OUT) :: KXDIM, KYDIM
+!
+!* 0.2 declarations of local variables
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. Return the dimensions
+!
+ IF( HSPLIT .EQ. 'B' ) THEN
+ KXDIM = TCRRT_COMDATA%TSPLIT_B%NDIMXP
+ KYDIM = TCRRT_COMDATA%TSPLIT_B%NDIMYP
+ ELSEIF ( HSPLIT .EQ. 'X' ) THEN
+ KXDIM = TCRRT_COMDATA%TSPLIT_X%NDIMXP
+ KYDIM = TCRRT_COMDATA%TSPLIT_X%NDIMYP
+ ELSE
+ KXDIM = TCRRT_COMDATA%TSPLIT_Y%NDIMXP
+ KYDIM = TCRRT_COMDATA%TSPLIT_Y%NDIMYP
+ ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+ END SUBROUTINE GET_DIM_PHYS_ll
+!
+! ##########################################
+ SUBROUTINE GET_OR_ll( HSPLIT, KXOR, KYOR )
+! ##########################################
+!
+!!**** *GET_OR_ll* - returns the origin'coordinates of the extended
+! 2way subdomain or of the x-slices subdomain
+! or of the y-slices
+! subdomain of the local processor (global indices)
+!
+!! Purpose
+!! -------
+! the Purpose of this routine is to give subdomain origin
+!
+!!** Method
+!! ------
+! if HSPLIT = 'B', the origin of the extended subdomain are returned
+! if HSPLIT = 'X', the origin of x-slices subdomain are returned
+! if HSPLIT = 'Y', the origin of y-slices subdomain are returned
+!
+!! External
+!! --------
+!
+!! Implicit Arguments
+!! ------------------
+! Module MODD_VAR_ll
+! TCRRT_COMDATA - Current communication data structure for current model
+! and local processor
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! R. Guivarch
+!
+!! Modifications
+!! -------------
+! Original 01/05/98
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_VAR_ll, ONLY : TCRRT_COMDATA
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ CHARACTER(len=1), INTENT(IN) :: HSPLIT
+!
+ INTEGER, INTENT(OUT) :: KXOR, KYOR
+!
+!* 0.2 declarations of local variables
+!
+!-------------------------------------------------------------------------------
+!
+!* 1.
+!
+ IF( HSPLIT .EQ. 'B' ) THEN
+ KXOR = TCRRT_COMDATA%TSPLIT_B%NXORE
+ KYOR = TCRRT_COMDATA%TSPLIT_B%NYORE
+ ELSEIF ( HSPLIT .EQ. 'X' ) THEN
+ KXOR = TCRRT_COMDATA%TSPLIT_X%NXORP
+ KYOR = TCRRT_COMDATA%TSPLIT_X%NYORP
+ ELSE
+ KXOR = TCRRT_COMDATA%TSPLIT_Y%NXORP
+ KYOR = TCRRT_COMDATA%TSPLIT_Y%NYORP
+ ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+ END SUBROUTINE GET_OR_ll
+!
+! ####################################################
+ SUBROUTINE GET_INDICE_ll( KXOR, KYOR, KXEND, KYEND, KSIZE1, KSIZE2 )
+! ####################################################
+!
+!!**** *GET_INDICE_ll* - returns the origin's coordinates and the end's
+! coordinates of the local physical
+! subdomain (in local indices)
+!
+!! Purpose
+!! -------
+!
+!!** Method
+!! ------
+!
+!! External
+!! --------
+! Module MODE_TOOLS_ll
+! LWEST_ll, LSOUTH_ll, LEAST_ll, LNORTH_ll
+!
+!! Implicit Arguments
+!! ------------------
+! Module MODD_VAR_ll
+! TCRRT_COMDATA - Current communication data structure for current model
+! and local processor
+! JPHALO- halo size
+!
+! Module MODD_PARAMETERS_ll
+! JPHEXT - halo size
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! R. Guivarch
+!
+!! Modifications
+!! -------------
+! Original 08/07/98
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_PARAMETERS_ll, ONLY : JPHEXT
+ USE MODD_VAR_ll, ONLY : TCRRT_COMDATA, JPHALO
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ INTEGER, INTENT(OUT) :: KXOR, KYOR, KXEND, KYEND
+ INTEGER, INTENT(IN),OPTIONAL :: KSIZE1, KSIZE2
+!
+!* 0.2 declarations of local variables
+!
+!-------------------------------------------------------------------------------
+!
+ IF(LWEST_ll()) THEN
+ KXOR = 1 + JPHEXT
+ ELSE
+ KXOR = 1 + JPHALO
+ ENDIF
+!
+ IF(LSOUTH_ll()) THEN
+ KYOR = 1 + JPHEXT
+ ELSE
+ KYOR = 1 + JPHALO
+ ENDIF
+!
+ IF(LEAST_ll()) THEN
+ KXEND = TCRRT_COMDATA%TSPLIT_B%NDIMXE - JPHEXT
+ ELSE
+ KXEND = TCRRT_COMDATA%TSPLIT_B%NDIMXE - JPHALO
+ ENDIF
+!
+ IF(LNORTH_ll()) THEN
+ KYEND = TCRRT_COMDATA%TSPLIT_B%NDIMYE - JPHEXT
+ ELSE
+ KYEND = TCRRT_COMDATA%TSPLIT_B%NDIMYE - JPHALO
+ ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+ END SUBROUTINE GET_INDICE_ll
+!
+! ##########################################
+ SUBROUTINE GET_GLOBALDIMS_ll(KIMAX, KJMAX, KMODEL)
+! ##########################################
+!
+!!**** *GET_GLOBALDIMS_ll* - returns the global horizontal dimensions
+! of the current model (External halo excluded)
+!
+!! Purpose
+!! -------
+!
+!!** Method
+!! ------
+!
+!! External
+!! --------
+!
+!! Implicit Arguments
+!! ------------------
+! Module MODD_VAR_ll
+! TCRRT_PROCONF - Current configuration for current model
+!
+! Module MODD_DIM_ll
+! NDXRATIO_ALL, NDYRATIO_ALL, NXOR_ALL, NYOR_ALL,
+! NXEND_ALL, NYEND_ALL
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! P. Kloos (CERFACS)
+!
+! Modifications
+!! -------------
+! Original 15 september 1998
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_DIM_ll, ONLY : NDXRATIO_ALL, NDYRATIO_ALL, &
+ NXOR_ALL, NYOR_ALL, &
+ NXEND_ALL, NYEND_ALL
+ USE MODD_VAR_ll, ONLY : TCRRT_PROCONF
+
+ USE MODD_PARAMETERS_ll, ONLY : JPHEXT
+!
+ IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+ INTEGER, INTENT(OUT) :: KIMAX, KJMAX ! current model dimensions
+ INTEGER, OPTIONAL, INTENT(IN) :: KMODEL ! number of the current model
+!
+!* 0.2 declarations of local variables
+!
+ INTEGER :: IMODEL ! number of the current model
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. Extract the number of the current model.
+!
+IF ( PRESENT(KMODEL) ) THEN
+ IMODEL = KMODEL
+ELSE
+ IMODEL = TCRRT_PROCONF%NUMBER
+ENDIF
+!
+!* 2. Compute the dimensions of the model
+!
+ KIMAX = NDXRATIO_ALL(IMODEL) * (NXEND_ALL(IMODEL)-NXOR_ALL(IMODEL) -2*JPHEXT + 1)
+ KJMAX = NDYRATIO_ALL(IMODEL) * (NYEND_ALL(IMODEL)-NYOR_ALL(IMODEL) -2*JPHEXT + 1)
+!
+!-------------------------------------------------------------------------------
+!
+ END SUBROUTINE GET_GLOBALDIMS_ll
+!
+! ######################################################
+ SUBROUTINE GET_PHYSICAL_ll( KXOR, KYOR, KXEND, KYEND )
+! ######################################################
+!
+!!**** *GET_PHYSICAL_ll* - returns the origin's coordinates and the end's
+! coordinates of the intersection
+! of the physical global domain with the local
+! extended subdomain (in local indices)
+!
+!! Purpose
+!! -------
+!
+!!** Method
+!! ------
+!
+!! External
+!! --------
+! Module MODE_TOOLS_ll
+! LWEST_ll, LSOUTH_ll, LEAST_ll, LNORTH_ll
+!
+!! Implicit Arguments
+!! ------------------
+! Module MODD_VAR_ll
+! TCRRT_COMDATA - Current communication data structure for current model
+! and local processor
+!
+! Module MODD_PARAMETERS_ll
+! JPHEXT
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! R. Guivarch
+!
+!! Modifications
+!! -------------
+! Original 01/05/98
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_PARAMETERS_ll, ONLY : JPHEXT
+ USE MODD_VAR_ll, ONLY : TCRRT_COMDATA
+!
+ IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+ INTEGER, INTENT(OUT) :: KXOR, KYOR, KXEND, KYEND
+!
+!
+!* 0.2 declarations of local variables
+!
+!-------------------------------------------------------------------------------
+!
+ KXOR = 1
+ IF(LWEST_ll()) KXOR = KXOR + JPHEXT
+!
+ KYOR = 1
+ IF(LSOUTH_ll()) KYOR = KYOR + JPHEXT
+!
+ KXEND = TCRRT_COMDATA%TSPLIT_B%NDIMXE
+ IF(LEAST_ll()) KXEND = KXEND - JPHEXT
+!
+ KYEND = TCRRT_COMDATA%TSPLIT_B%NDIMYE
+ IF(LNORTH_ll()) KYEND = KYEND - JPHEXT
+!
+!
+ END SUBROUTINE GET_PHYSICAL_ll
+!
+! ###################################################################
+ SUBROUTINE GET_INTERSECTION_ll( KXOR,KYOR,KXEND,KYEND,KXORI,KYORI,&
+ KXENDI,KYENDI,HDOM,KINFO,KIP)
+! ###################################################################
+!
+!!**** *GET_INTERSECTION_ll* - routine to get the indices of the intersection
+! between a geographic region and the EXTENDED or
+! PHYSICAL subdomain of the KIP or current
+! processor.
+! The input indices are global.
+! The output indices are local.
+! If the returned indices are null
+! the intersection is void.
+!
+!! Purpose
+!! -------
+!
+!!** Method
+!! ------
+! The processor computes the intersection of a sub-domain
+! with the geographic region.
+!
+!! External
+!! --------
+!
+!! Implicit Arguments
+!! ------------------
+! Module MODD_VAR_ll
+! TCRRT_PROCONF - Current configuration for current model
+! IP - Number of the local processor
+!
+! Module MODD_PARAMETERS_ll
+! JPHEXT, JPVEXT - halo sizes
+!
+! Module MODD_STRUCTURE_ll
+! type MODELSPLITTING_ll
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! R. Guivarch, D. Gazen
+!
+!! Modifications
+!! -------------
+! Original 20/01/99
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_STRUCTURE_ll, ONLY : MODELSPLITTING_ll
+ USE MODD_PARAMETERS_ll, ONLY : JPHEXT, JPVEXT
+ USE MODD_VAR_ll, ONLY : TCRRT_PROCONF, IP
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ CHARACTER(LEN=4), INTENT(IN) :: HDOM ! 'EXTE' for extended subdomain
+ ! 'PHYS' for physical subdomain
+ INTEGER, INTENT(IN) :: KXOR, KYOR, KXEND, KYEND ! Coordinates of the region
+ INTEGER, INTENT(OUT) :: KXORI, KYORI, KXENDI, KYENDI ! Global Coordinates of
+ ! the intersection
+ INTEGER, INTENT(OUT) :: KINFO ! Returned Info
+ INTEGER, INTENT(IN), OPTIONAL:: KIP ! Processor number
+ ! (or subdomain number)
+!
+!* 0.2 declarations of local variables
+!
+ INTEGER :: IIMAX_ll, IJMAX_ll ! size of the total physical model
+ INTEGER :: IXORI, IYORI, IXENDI, IYENDI ! Local coordinates of intersection
+ TYPE(MODELSPLITTING_ll), POINTER :: TZSPLIT ! 2way-splitting
+ INTEGER :: IXOR, IYOR, IXEND, IYEND ! global coordinate of KIP subdomain
+ INTEGER :: IIP ! subdomain or processor number
+!
+!-------------------------------------------------------------------------------
+!
+ KINFO = 0
+ IF (PRESENT(KIP)) THEN
+ IIP = KIP
+ ELSE
+ IIP = IP
+ END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. INITIALISE BOUNDARY VALUES
+! --------------------------
+!
+! 1.1 'EXTE'nded sub-domain
+
+ TZSPLIT => TCRRT_PROCONF%TSPLITS_B(IIP)
+!
+ IXOR = TZSPLIT%NXORE
+ IYOR = TZSPLIT%NYORE
+ IXEND = TZSPLIT%NXENDE
+ IYEND = TZSPLIT%NYENDE
+!
+! 1.2 'PHYS'ical sub-domain
+!
+ IF (HDOM=='PHYS') THEN
+ IF (.NOT. LWEST_ll(IIP)) IXOR = TZSPLIT%NXORP
+ IF (.NOT. LEAST_ll(IIP)) IXEND = TZSPLIT%NXENDP
+ IF (.NOT. LSOUTH_ll(IIP)) IYOR = TZSPLIT%NYORP
+ IF (.NOT. LNORTH_ll(IIP)) IYEND = TZSPLIT%NYENDP
+ END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. THE COORDINATES ARE NOT IN THE PHYSICAL DOMAIN -> ERROR :
+! -------------------------------------------------------
+!
+ CALL GET_GLOBALDIMS_ll(IIMAX_ll, IJMAX_ll)
+!
+ IF((KXOR < 1 ) .OR. (KYOR < 1 ) .OR. &
+ (KXEND > IIMAX_ll + 2*JPHEXT) .OR. (KYEND > IJMAX_ll + 2*JPHEXT)) THEN
+!
+! Error
+!
+ KINFO = -1
+!
+ RETURN
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. THE COORDINATES ARE IN THE PHYSICAL DOMAIN :
+! ------------------------------------------
+!
+ ELSE
+!
+ IXORI = MAX( IXOR, KXOR )
+ IYORI = MAX( IYOR, KYOR )
+!
+ IXENDI = MIN( IXEND, KXEND )
+ IYENDI = MIN( IYEND, KYEND )
+!
+!* 3.1 The intersection is empty
+!
+ IF((IXORI > IXENDI) .OR. (IYORI > IYENDI)) THEN
+!
+ KXORI = 0
+ KYORI = 0
+!
+ KXENDI = 0
+ KYENDI = 0
+!
+ KINFO = 1
+!
+ ELSE
+!
+!* 3.2 Switch to local coordinates
+!
+ KXORI = IXORI - TZSPLIT%NXORE + 1
+ KYORI = IYORI - TZSPLIT%NYORE + 1
+ KXENDI = IXENDI - TZSPLIT%NXORE + 1
+ KYENDI = IYENDI - TZSPLIT%NYORE + 1
+ ENDIF
+!
+ ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+ END SUBROUTINE GET_INTERSECTION_ll
+!
+! ##################################################################
+! SUBROUTINE GET_GLOBALSLICE_ll(PARRAY, HDIR, KLOC, PGLOBALSLICE, &
+! KB, KE, KERR)
+! ##################################################################
+!
+!! Purpose
+!! -------
+! The Purpose of this routine is to get a slice of the
+! domain in the x or y direction.
+!
+! ###################################################################
+ SUBROUTINE GET_1DGLOBALSLICE_ll(PARRAY, HDIR, KLOC, PGLOBALSLICE, &
+ KB, KE, KERR)
+! ###################################################################
+!
+!! Purpose
+!! -------
+! The Purpose of this routine is to extract a slice of an horizontal
+! field PARRAY along the x or y direction
+!
+!!** Method
+!! ------
+!
+! An MPI communicator with the processes corresponding to the
+! subdomains intersecting with the slice is built. This
+! communicator is then used to gather the whole slice (i.e.
+! the global slice) on these procs. The global slice is then
+! broadcasted on all procs that are not on the slice.
+!
+!! External
+!! --------
+! Module MODE_TOOLS_ll
+! LWEST_ll, LSOUTH_ll, LNORTH_ll, LEAST_ll
+! GET_GLOBALDIMS_ll
+!
+!! Implicit Arguments
+!! ------------------
+! Module MODD_STRUCTURE_ll
+! type MODELSPLITTING_ll
+!
+! Module MODD_VAR_ll
+! NPROC - Number of processors
+! TCRRT_PROCONF - Current configuration for current model
+! IP - Number of the local processor
+!
+! Module MODD_PARAMETERS_ll
+! JPHEXT - halo size
+!
+!! Reference
+!! ---------
+!
+! User Interface for the MesoNH Parallel Package
+!
+!! Author
+!! ------
+! P. Kloos (CERFACS)
+!
+!! Modifications
+!! -------------
+! Original 14 August 1998
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT
+ USE MODD_STRUCTURE_ll, ONLY: MODELSPLITTING_ll
+ USE MODD_VAR_ll, ONLY: NPROC, TCRRT_PROCONF, IP
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ REAL, DIMENSION(:,:), TARGET, INTENT(IN) :: PARRAY ! horizontal field
+ CHARACTER(LEN=1), INTENT(IN) :: HDIR ! direction ("X" or "Y")
+ INTEGER, INTENT(IN) :: KLOC ! coordinate of the slice
+ ! to extract
+ ! (in global coordinates)
+ REAL, DIMENSION(:), INTENT(OUT) :: PGLOBALSLICE ! output slice
+ INTEGER, OPTIONAL :: KB, KE ! begin and end positions of the
+ ! extracted slices
+ ! (global coordinates)
+ INTEGER, OPTIONAL :: KERR ! error code
+!
+!* 0.2 declarations of local variables
+!
+ TYPE(MODELSPLITTING_ll), POINTER :: TZSPLIT
+ INTEGER :: IDIM, IDIM2
+ INTEGER :: INUMPROC, IERR
+ INTEGER :: ILOC ! local location of the slice
+ INTEGER :: ICOUNT ! number of relevant procs (= those which are on the slice)
+ INTEGER :: ISIZE ! length of the local slice
+ INTEGER, DIMENSION(:), ALLOCATABLE :: IPROCS ! array of procs that are on
+ ! the slice
+ INTEGER, DIMENSION(:), ALLOCATABLE :: ISIZES ! length of the local slice
+ ! on all procs
+ INTEGER, DIMENSION(:), ALLOCATABLE :: IDISPL ! array of locations of the
+ ! procs in the slice
+ ! (for MPI_ALLGATHERV)
+ INTEGER :: IWRLD_GROUP ! world group
+ INTEGER :: IGROUP_GLOBALSLICE ! group for the proc on the slice
+ INTEGER :: ICOMM_GLOBALSLICE ! communicator for the proc on the slice
+ INTEGER :: IGROUP, ICOMM
+ INTEGER, DIMENSION(NPROC) :: IGLOBALSLICEPROC
+ INTEGER, DIMENSION(2) :: IOR, IEND, IORP, IENDP, IORE, IENDE ! splitting
+ INTEGER :: IWEST, IEAST, INORTH, ISOUTH
+ INTEGER :: IB, IE ! beginning and end of the local slice
+ INTEGER :: IDISPL1 ! beginning of the slice (global)
+ INTEGER :: J ! loop index
+ INTEGER :: IGLOBALSLICELENGTH ! length of the global slice
+ INTEGER, DIMENSION(2) :: IMAX ! maximum dimensions
+ REAL, DIMENSION(:), POINTER :: ZPTR
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. INITIALISATIONS
+! ---------------
+ IWEST=0; IEAST=0; INORTH=0; ISOUTH=0
+ IB=0; IE=0
+ IDISPL1=0
+!
+!* 1.1 Get current splitting
+!
+ IF (LWEST_ll()) IWEST=-1
+ IF (LEAST_ll()) IEAST=1
+ IF (LNORTH_ll()) INORTH=1
+ IF (LSOUTH_ll()) ISOUTH=-1
+ TZSPLIT => TCRRT_PROCONF%TSPLITS_B(IP)
+ IOR(1) = TZSPLIT%NXORP+IWEST
+ IOR(2) = TZSPLIT%NYORP+ISOUTH
+ IEND(1) = TZSPLIT%NXENDP+IEAST
+ IEND(2) = TZSPLIT%NYENDP+INORTH
+!
+ IORP(1) = TZSPLIT%NXORP
+ IORP(2) = TZSPLIT%NYORP
+ IENDP(1) = TZSPLIT%NXENDP
+ IENDP(2) = TZSPLIT%NYENDP
+!
+ IORE(1) = TZSPLIT%NXORE
+ IORE(2) = TZSPLIT%NYORE
+ IENDE(1) = TZSPLIT%NXENDE
+ IENDE(2) = TZSPLIT%NYENDE
+!
+ IGLOBALSLICEPROC = 0
+ CALL GET_GLOBALDIMS_ll(IMAX(1),IMAX(2))
+ IMAX(:) = IMAX(:) + 2*JPHEXT
+!
+!* 1.2 Set dimension (1 for X and 2 for Y)
+!
+ IDIM = IACHAR(HDIR)-IACHAR('X')+1
+ IDIM2 = 3-IDIM ! IDIM's inverse
+!
+!* 1.4 Set beginning and end of local slice
+!
+ IF (PRESENT(KB) .AND. PRESENT(KE)) THEN
+!
+!* Test the ranges
+!
+ IF((KB < 1 ) .OR. (KE > IMAX(IDIM))) THEN
+!
+! Error
+!
+ KERR = -1
+ RETURN
+!
+ ENDIF
+!
+ IB = MAX(KB, IOR(IDIM)) - IORE(IDIM) + 1
+ IE = MIN(KE, IEND(IDIM)) - IORE(IDIM) + 1
+! IDISPL1 = KB-1 ! old version
+ IDISPL1 = 0
+ ELSE ! default : physical domain
+ IB = 1+JPHEXT
+ IE = IENDP(IDIM)-IORE(IDIM)+1
+! IDISPL1 = JPHEXT ! old version
+ IDISPL1 = 0
+ ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. CREATE MPI COMMUNICATOR WITH THE PROCS ON THE SLICE
+! ---------------------------------------------------
+!
+!* 2.1 Test if i am on the slice
+! if so, INUMPROC = my MPI rank
+! if not, INUMPROC = MPI_PROC_NULL
+!
+ IF (KLOC >= IOR(IDIM2) .AND. KLOC <= IEND(IDIM2) .AND. IB<=IE) THEN
+!
+! Set local location
+!
+ ILOC = KLOC-IORE(IDIM2)+1
+!
+! Set relevant procs
+!
+ INUMPROC = IP-1
+!
+! Set lenght of the local slice
+!
+ ISIZE = IE - IB + 1
+!
+!* 2.2 Have ZPTR point to the slice
+!
+ SELECT CASE(HDIR)
+ CASE("X")
+ ZPTR => PARRAY(IB:IE,ILOC)
+!
+ CASE("Y")
+ ZPTR => PARRAY(ILOC,IB:IE)
+!
+ CASE DEFAULT
+ call Print_msg( NVERB_FATAL, 'GEN', 'GET_1DGLOBALSLICE_ll', 'invalid HDIR dummy argument ('//hdir//')' )
+!
+ END SELECT
+!
+ ELSE
+!
+ INUMPROC = MPI_PROC_NULL
+!
+ ENDIF
+!
+!* 2.3 Gather values of INUMPROC
+!
+ CALL MPI_ALLGATHER( (/ INUMPROC /) , 1, MNHINT_MPI, IGLOBALSLICEPROC, 1, &
+ MNHINT_MPI, NMNH_COMM_WORLD, IERR)
+!
+!* 2.4 Get MPI world group
+!
+ CALL MPI_COMM_GROUP(NMNH_COMM_WORLD, IWRLD_GROUP, IERR)
+!
+!* 2.5 Count number of proc that contain the slice
+!
+ ICOUNT = COUNT(IGLOBALSLICEPROC.NE.MPI_PROC_NULL)
+!
+!* 2.6 Create MPI group with the procs that contain the slice
+!
+ ALLOCATE(IPROCS(ICOUNT))
+ IPROCS = PACK(IGLOBALSLICEPROC, MASK=IGLOBALSLICEPROC.NE.MPI_PROC_NULL)
+ CALL MPI_GROUP_INCL(IWRLD_GROUP, ICOUNT, IPROCS, IGROUP_GLOBALSLICE, IERR)
+!
+!* 2.7 Create MPI communicator associated to new group
+!
+ CALL MPI_COMM_CREATE(NMNH_COMM_WORLD, IGROUP_GLOBALSLICE, &
+ ICOMM_GLOBALSLICE, IERR)
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. GATHER THE LOCAL SLICES ON ALL PROCS THAT CONTAIN THE SLICE
+! -----------------------------------------------------------
+!
+!* 3.1 Have the length of the local slice on each proc known
+! by all procs on the global slice
+!
+ IF (ICOMM_GLOBALSLICE .NE. MPI_COMM_NULL) THEN
+!
+ ALLOCATE(ISIZES(ICOUNT))
+ ISIZES = 0
+ CALL MPI_ALLGATHER( (/ ISIZE /) , 1, MNHINT_MPI, ISIZES, 1, MNHINT_MPI, &
+ ICOMM_GLOBALSLICE, IERR)
+!
+!* 3.2 Compute array of displacements in the slice relative to the
+! origin of the global domain
+!
+ ALLOCATE(IDISPL(ICOUNT+1))
+ IDISPL(1) = IDISPL1
+ DO J=2, ICOUNT+1
+ IDISPL(J) = IDISPL(J-1)+ISIZES(J-1)
+ ENDDO
+ IGLOBALSLICELENGTH = IDISPL(ICOUNT+1) - IDISPL(1)
+!
+!* 3.3 Have the values of the local slice on each proc known
+! by all procs on the global slice
+!
+ CALL MPI_ALLGATHERV(ZPTR, ISIZE, MNHREAL_MPI, PGLOBALSLICE, &
+ ISIZES, IDISPL, MNHREAL_MPI, ICOMM_GLOBALSLICE, IERR)
+!
+!* 3.4 Delete slice communicator
+!
+ CALL MPI_COMM_FREE(ICOMM_GLOBALSLICE, IERR)
+!
+ DEALLOCATE(ISIZES, IDISPL)
+!
+ ENDIF
+!
+!* 3.5 Delete slice group
+!
+ CALL MPI_GROUP_FREE(IGROUP_GLOBALSLICE, IERR)
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. BROADCAST THE SLICE ON ALL PROCS THAT ARE NOT ON THE SLICE
+! ----------------------------------------------------------
+!
+!* 4.1 Create communicator with the first proc
+!* on the slice and the procs that are not on the
+!* slice
+!
+ CALL MPI_GROUP_EXCL(IWRLD_GROUP, ICOUNT-1, IPROCS(2:2), IGROUP, IERR)
+ CALL MPI_COMM_CREATE(NMNH_COMM_WORLD, IGROUP, ICOMM, IERR)
+!
+!* 4.2 Broadcast the slice
+!
+ IF (ICOMM .NE. MPI_COMM_NULL) THEN
+!
+ CALL MPI_BCAST(IGLOBALSLICELENGTH, 1, MNHINT_MPI, IPROCS(1), ICOMM, IERR)
+ CALL MPI_BCAST(PGLOBALSLICE(IDISPL1+1), IGLOBALSLICELENGTH, MNHREAL_MPI, &
+ IPROCS(1), ICOMM, IERR)
+!
+ CALL MPI_COMM_FREE(ICOMM, IERR)
+ CALL MPI_GROUP_FREE(IGROUP, IERR)
+!
+ ENDIF
+!
+ CALL MPI_GROUP_FREE(IWRLD_GROUP, IERR)
+!
+ IF (PRESENT(KERR)) KERR=IERR
+!
+ DEALLOCATE(IPROCS)
+!
+!-------------------------------------------------------------------------------
+!
+ END SUBROUTINE GET_1DGLOBALSLICE_ll
+!
+! ###################################################################
+ SUBROUTINE GET_2DGLOBALSLICE_ll(PARRAY, HDIR, KLOC, PGLOBALSLICE, &
+ KB, KE, KKB, KKE, KERR)
+! ###################################################################
+!
+!! Purpose
+!! -------
+! The Purpose of this routine is to extract a slice of
+! 3D field PARRAY along the x or y direction
+!
+!!** Method
+!! ------
+!
+! An MPI communicator with the processes corresponding to the
+! subdomains intersecting with the slice is built. This
+! communicator is then used to gather the whole slice (i.e.
+! the global slice) on these procs. The global slice is then
+! broadcasted on all procs that are not on the slice.
+!
+!! External
+!! --------
+! Module MODE_TOOLS_ll
+! LWEST_ll, LSOUTH_ll, LNORTH_ll, LEAST_ll
+! GET_GLOBALDIMS_ll
+!
+!! Implicit Arguments
+!! ------------------
+! Module MODD_STRUCTURE_ll
+! type MODELSPLITTING_ll
+!
+! Module MODD_VAR_ll
+! NPROC - Number of processors
+! TCRRT_PROCONF - Current configuration for current model
+! IP - Number of the local processor
+!
+! Module MODD_PARAMETERS_ll
+! JPHEXT, JPVEXT - halo size
+!
+!! Reference
+!! ---------
+!
+! User Interface for the MesoNH Parallel Package
+!
+!! Author
+!! ------
+! P. Kloos (CERFACS)
+!
+!! Modifications
+!! -------------
+! Original 14 August 1998
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT, JPVEXT
+ USE MODD_STRUCTURE_ll, ONLY: MODELSPLITTING_ll
+ USE MODD_VAR_ll, ONLY: NPROC, TCRRT_PROCONF, IP
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ REAL, DIMENSION(:,:,:), TARGET, INTENT(IN) :: PARRAY ! horizontal field
+ CHARACTER(LEN=1), INTENT(IN) :: HDIR ! direction ("X" or "Y")
+ INTEGER, INTENT(IN) :: KLOC ! coordinate of the slice
+ ! to extract
+ ! (in global coordinates)
+ REAL, DIMENSION(:,:), INTENT(OUT) :: PGLOBALSLICE ! output slice
+ INTEGER, OPTIONAL :: KB, KE ! begin and end positions of the
+ ! extracted slices in the HDIR
+ ! direction
+ INTEGER, OPTIONAL :: KKB, KKE ! begin and end positions of the
+ ! extracted slices in the vertical
+ ! direction
+ INTEGER, OPTIONAL :: KERR ! error code
+!
+!* 0.2 declarations of local variables
+!
+ TYPE(MODELSPLITTING_ll), POINTER :: TZSPLIT
+ INTEGER :: IDIM, IDIM2
+ INTEGER :: INUMPROC, IERR
+ INTEGER :: ILOC ! local location of the slice
+ INTEGER :: ICOUNT ! number of relevant procs (= those which are on the slice)
+ INTEGER :: ISIZE ! length of the local slice
+ INTEGER, DIMENSION(:), ALLOCATABLE :: IPROCS ! array of procs that are on
+ ! the slice
+ INTEGER, DIMENSION(:), ALLOCATABLE :: ISIZES ! length of the local slice
+ ! on all procs
+ INTEGER, DIMENSION(:), ALLOCATABLE :: IDISPL ! array of locations of the
+ ! procs in the slice
+ ! (for MPI_ALLGATHERV)
+ INTEGER :: IWRLD_GROUP ! world group
+ INTEGER :: IGROUP_GLOBALSLICE ! group for the proc on the slice
+ INTEGER :: ICOMM_GLOBALSLICE ! communicator for the proc on the slice
+ INTEGER :: IGROUP, ICOMM
+ INTEGER, DIMENSION(NPROC) :: IGLOBALSLICEPROC
+ INTEGER, DIMENSION(2) :: IOR, IEND, IORP, IENDP, IORE, IENDE ! splitting
+ INTEGER :: IWEST, IEAST, INORTH, ISOUTH
+ INTEGER :: IB, IE ! beginning and end of the local slice
+ INTEGER :: IDISPL1 ! beginning of the slice (global)
+ INTEGER :: J ! loop index
+ INTEGER :: IGLOBALSLICELENGTH ! length of the global slice
+ INTEGER :: IGLOBALSLICEHEIGHT
+ INTEGER :: JK
+ INTEGER, DIMENSION(2) :: IMAX ! maximum dimensions
+ REAL, DIMENSION(:,:), ALLOCATABLE :: ZPTR
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. INITIALISATIONS
+! ---------------
+ IWEST=0; IEAST=0; INORTH=0; ISOUTH=0
+ IB=0; IE=0
+ IDISPL1=0
+!
+!* 1.1 Get current splitting
+!
+ IF (LWEST_ll()) IWEST=-1
+ IF (LEAST_ll()) IEAST=1
+ IF (LNORTH_ll()) INORTH=1
+ IF (LSOUTH_ll()) ISOUTH=-1
+ TZSPLIT => TCRRT_PROCONF%TSPLITS_B(IP)
+ IOR(1) = TZSPLIT%NXORP+IWEST
+ IOR(2) = TZSPLIT%NYORP+ISOUTH
+ IEND(1) = TZSPLIT%NXENDP+IEAST
+ IEND(2) = TZSPLIT%NYENDP+INORTH
+!
+ IORP(1) = TZSPLIT%NXORP
+ IORP(2) = TZSPLIT%NYORP
+ IENDP(1) = TZSPLIT%NXENDP
+ IENDP(2) = TZSPLIT%NYENDP
+!
+ IORE(1) = TZSPLIT%NXORE
+ IORE(2) = TZSPLIT%NYORE
+ IENDE(1) = TZSPLIT%NXENDE
+ IENDE(2) = TZSPLIT%NYENDE
+!
+ IGLOBALSLICEPROC = 0
+ CALL GET_GLOBALDIMS_ll(IMAX(1),IMAX(2))
+ IMAX(:) = IMAX(:) + 2*JPHEXT
+!
+!* 1.2 Set dimension (1 for X and 2 for Y)
+!
+ IDIM = IACHAR(HDIR)-IACHAR('X')+1
+ IDIM2 = 3-IDIM ! IDIM's inverse
+!
+ IGLOBALSLICEHEIGHT = KKE - KKB + 1
+!
+!* 1.4 Set beginning and end of local slice
+!
+ IF (.NOT.PRESENT(KKB) .AND. .NOT.PRESENT(KKE)) THEN
+ KKB = 1 + JPVEXT
+ KKE = SIZE(PARRAY,3) - JPVEXT
+ ENDIF
+!
+ IF (PRESENT(KB) .AND. PRESENT(KE)) THEN
+!
+!* Test the ranges
+!
+ IF((KB < 1 ) .OR. (KE > IMAX(IDIM))) THEN
+!
+! Error
+!
+ KERR = -1
+ RETURN
+!
+ ENDIF
+!
+ IB = MAX(KB, IOR(IDIM)) - IORE(IDIM) + 1
+ IE = MIN(KE, IEND(IDIM)) - IORE(IDIM) + 1
+! IDISPL1 = KB-1 ! old version
+ IDISPL1 = 0
+ ELSE ! default : physical domain
+ IB = 1+JPHEXT
+ IE = IENDP(IDIM)-IORE(IDIM)+1
+! IDISPL1 = JPHEXT ! old version
+ IDISPL1 = 0
+ ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. CREATE MPI COMMUNICATOR WITH THE PROCS ON THE SLICE
+! ---------------------------------------------------
+!
+!* 2.1 Test if i am on the slice
+! if so, INUMPROC = my MPI rank
+! if not, INUMPROC = MPI_PROC_NULL
+!
+ IF (KLOC >= IOR(IDIM2) .AND. KLOC <= IEND(IDIM2) .AND. IB<=IE) THEN
+!
+! Set local location
+!
+ ILOC = KLOC-IORE(IDIM2)+1
+!
+! Set relevant procs
+!
+ INUMPROC = IP-1
+!
+! Set lenght of the local slice
+!
+ ISIZE = IE - IB + 1
+!
+!* 2.2 Have ZPTR point to the slice
+!
+ SELECT CASE(HDIR)
+ CASE("X")
+ ALLOCATE(ZPTR(IE-IB+1, IGLOBALSLICEHEIGHT))
+ ZPTR = PARRAY(IB:IE,ILOC,KKB:KKE)
+!
+ CASE("Y")
+ ALLOCATE(ZPTR(IE-IB+1, IGLOBALSLICEHEIGHT))
+ ZPTR = PARRAY(ILOC,IB:IE,KKB:KKE)
+!
+ CASE DEFAULT
+ call Print_msg( NVERB_FATAL, 'GEN', 'GET_2DGLOBALSLICE_ll', 'invalid HDIR dummy argument ('//hdir//')' )
+!
+ END SELECT
+!
+ ELSE
+!
+ INUMPROC = MPI_PROC_NULL
+!
+ ENDIF
+!
+!* 2.3 Gather values of INUMPROC
+!
+ CALL MPI_ALLGATHER( (/ INUMPROC /) , 1, MNHINT_MPI, IGLOBALSLICEPROC, 1, &
+ MNHINT_MPI, NMNH_COMM_WORLD, IERR)
+!
+!* 2.4 Get MPI world group
+!
+ CALL MPI_COMM_GROUP(NMNH_COMM_WORLD, IWRLD_GROUP, IERR)
+!
+!* 2.5 Count number of proc that contain the slice
+!
+ ICOUNT = COUNT(IGLOBALSLICEPROC.NE.MPI_PROC_NULL)
+!
+!* 2.6 Create MPI group with the procs that contain the slice
+!
+ ALLOCATE(IPROCS(ICOUNT+1))
+ IPROCS(1:ICOUNT) = PACK(IGLOBALSLICEPROC, MASK=IGLOBALSLICEPROC.NE.MPI_PROC_NULL)
+ IPROCS(ICOUNT+1) = MPI_PROC_NULL
+ PRINT *,'SIZE(IPROCS) = ',SIZE(IPROCS)
+ CALL MPI_GROUP_INCL(IWRLD_GROUP, ICOUNT, IPROCS, IGROUP_GLOBALSLICE, IERR)
+!
+!* 2.7 Create MPI communicator associated to new group
+!
+ CALL MPI_COMM_CREATE(NMNH_COMM_WORLD, IGROUP_GLOBALSLICE, &
+ ICOMM_GLOBALSLICE, IERR)
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. GATHER THE LOCAL SLICES ON ALL PROCS THAT CONTAIN THE SLICE
+! -----------------------------------------------------------
+!
+!* 3.1 Have the length of the local slice on each proc known
+! by all procs on the global slice
+!
+ IF (ICOMM_GLOBALSLICE .NE. MPI_COMM_NULL) THEN
+!
+ ALLOCATE(ISIZES(ICOUNT))
+ ISIZES = 0
+ CALL MPI_ALLGATHER( (/ ISIZE /) , 1, MNHINT_MPI, ISIZES, 1, MNHINT_MPI, &
+ ICOMM_GLOBALSLICE, IERR)
+!
+!* 3.2 Compute array of displacements in the slice relative to the
+! origin of the global domain
+!
+ ALLOCATE(IDISPL(ICOUNT+1))
+ IDISPL(1) = IDISPL1
+ DO J=2, ICOUNT+1
+ IDISPL(J) = IDISPL(J-1)+ISIZES(J-1)
+ ENDDO
+ IGLOBALSLICELENGTH = IDISPL(ICOUNT+1) - IDISPL(1)
+!
+!
+!* 3.3 Have the values of the local slice on each proc known
+! by all procs on the global slice
+!
+ DO JK = 1, IGLOBALSLICEHEIGHT
+ CALL MPI_ALLGATHERV(ZPTR(1,JK), ISIZE, MNHREAL_MPI, &
+ PGLOBALSLICE(1,JK), ISIZES, IDISPL, &
+ MNHREAL_MPI, ICOMM_GLOBALSLICE, IERR)
+ ENDDO
+!
+!* 3.4 Delete slice communicator
+!
+ CALL MPI_COMM_FREE(ICOMM_GLOBALSLICE, IERR)
+!
+ DEALLOCATE(ISIZES, IDISPL)
+ DEALLOCATE(ZPTR)
+!
+ ENDIF
+!
+!* 3.5 Delete slice group
+!
+ CALL MPI_GROUP_FREE(IGROUP_GLOBALSLICE, IERR)
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. BROADCAST THE SLICE ON ALL PROCS THAT ARE NOT ON THE SLICE
+! ----------------------------------------------------------
+!
+!* 4.1 Create communicator with the first proc
+!* on the slice and the procs that are not on the
+!* slice
+!
+ CALL MPI_GROUP_EXCL(IWRLD_GROUP, ICOUNT-1, IPROCS(2:2), IGROUP, IERR)
+ CALL MPI_COMM_CREATE(NMNH_COMM_WORLD, IGROUP, ICOMM, IERR)
+!
+!* 4.2 Broadcast the slice
+!
+ IF (ICOMM .NE. MPI_COMM_NULL) THEN
+!
+ CALL MPI_BCAST(IGLOBALSLICELENGTH, 1, MNHINT_MPI, IPROCS(1), ICOMM, IERR)
+ DO JK = 1, IGLOBALSLICEHEIGHT
+ CALL MPI_BCAST(PGLOBALSLICE(1,JK), IGLOBALSLICELENGTH, MNHREAL_MPI, &
+ IPROCS(1), ICOMM, IERR)
+ ENDDO
+!
+ CALL MPI_COMM_FREE(ICOMM, IERR)
+!
+ ENDIF
+!
+ CALL MPI_GROUP_FREE(IGROUP, IERR)
+!
+! CALL MPI_GROUP_FREE(IWRLD_GROUP, IERR)
+!
+ IF (PRESENT(KERR)) KERR=IERR
+!
+ DEALLOCATE(IPROCS)
+!
+ END SUBROUTINE GET_2DGLOBALSLICE_ll
+!
+! ###################################################################
+! SUBROUTINE GET_SLICE_ll(PARRAY, HDIR, KLOC, PSLICE, KB, KE, KERR)
+! ###################################################################
+!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to get a slice of the
+! domain in the x or y direction.
+!
+! ###################################################################
+ SUBROUTINE GET_1DSLICE_ll(PARRAY, HDIR, KLOC, PSLICE, KB, KE, KERR)
+! ###################################################################
+!
+!! Purpose
+!! -------
+! The Purpose of this routine is to extract a slice of an horizontal
+! field PARRAY along the x or y direction
+!
+!!** Method
+!! ------
+!!
+! An MPI communicator with the processes corresponding to the
+! subdomains intersecting with the slice is built. This
+! communicator is then used to gather the whole slice (i.e.
+! the global slice) on these procs. The global slice is then
+! broadcasted on all procs that are not on the slice.
+!
+!! External
+!! --------
+! Module MODE_TOOLS_ll
+! LWEST_ll, LSOUTH_ll, LNORTH_ll, LEAST_ll
+! GET_GLOBALDIMS_ll
+!
+!! Implicit Arguments
+!! ------------------
+! Module MODD_STRUCTURE_ll
+! type MODELSPLITTING_ll
+!
+! Module MODD_VAR_ll
+! NPROC - Number of processors
+! TCRRT_PROCONF - Current configuration for current model
+! IP - Number of the local processor
+!
+! Module MODD_PARAMETERS_ll
+! JPHEXT, JPVEXT - halo size
+!
+!! Reference
+!! ---------
+! User Interface for the MesoNH Parallel Package
+!
+!! Author
+!! ------
+! P. Kloos (CERFACS)
+!
+!! Modifications
+!! -------------
+! Original 14 August 1998
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT
+ USE MODD_STRUCTURE_ll, ONLY: MODELSPLITTING_ll
+ USE MODD_VAR_ll, ONLY: NPROC, TCRRT_PROCONF, IP
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ REAL, DIMENSION(:,:), TARGET, INTENT(IN) :: PARRAY ! horizontal field
+ CHARACTER(LEN=1), INTENT(IN) :: HDIR ! direction ("X" or "Y")
+ INTEGER, INTENT(IN) :: KLOC ! coordinate of the slice to
+ ! extract (in global coordinates)
+ REAL, DIMENSION(:), INTENT(OUT) :: PSLICE ! output slice
+ INTEGER, OPTIONAL :: KB, KE ! begin and end positions of the
+ ! extracted slices
+ ! (local coordinates)
+ INTEGER, OPTIONAL :: KERR ! error code
+
+!
+!* 0.2 declarations of local variables
+!
+ TYPE(MODELSPLITTING_ll), POINTER :: TZSPLIT
+ INTEGER :: IDIM, IDIM2
+ INTEGER :: INUMPROC, IERR
+ INTEGER :: ILOC ! local location of the slice
+ INTEGER :: ICOUNT ! number of relevant procs (= those which are on the slice)
+ INTEGER :: ISIZE ! length of the local slice
+ INTEGER, DIMENSION(:), ALLOCATABLE :: IPROCS ! array of procs that are on
+ ! the slice
+ INTEGER, DIMENSION(:), ALLOCATABLE :: ISIZES ! length of the local slice
+ ! on all procs
+ INTEGER, DIMENSION(:), ALLOCATABLE :: IDISPL ! array of locations of the
+ ! procs in the slice
+ ! (for MPI_ALLGATHERV)
+
+ REAL, DIMENSION(:), ALLOCATABLE :: ITOTALSLICE
+
+ INTEGER :: IWRLD_GROUP ! world group
+ INTEGER :: IGROUP_SLICE ! group for the proc on the slice
+ INTEGER :: ICOMM_SLICE ! communicator for the proc on the slice
+ INTEGER :: IGROUP, ICOMM
+ INTEGER, DIMENSION(NPROC) :: ISLICEPROC
+ INTEGER, DIMENSION(2) :: IOR, IEND, IORP, IENDP, IORE, IENDE ! splitting
+ INTEGER :: IWEST, IEAST, INORTH, ISOUTH
+ INTEGER :: IB, IE ! beginning and end of the local slice
+ INTEGER :: IDISPL1 ! beginning of the slice (global)
+ INTEGER :: J ! loop index
+ INTEGER :: ISLICELENGTH ! length of the global slice
+ INTEGER, DIMENSION(2) :: IMAX ! maximum dimensions
+ REAL, DIMENSION(:), POINTER :: ZPTR
+ INTEGER :: IRES
+!
+ INTEGER :: IIB, IIE, IJB, IJE
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. INITIALISATIONS
+! ---------------
+ IWEST=0; IEAST=0; INORTH=0; ISOUTH=0
+ IB=0; IE=0
+ IDISPL1=0
+!
+!* 1.1 Get current splitting
+!
+ IF (LWEST_ll()) IWEST=-JPHEXT ! -1
+ IF (LEAST_ll()) IEAST=JPHEXT ! 1
+ IF (LNORTH_ll()) INORTH=JPHEXT ! 1
+ IF (LSOUTH_ll()) ISOUTH=-JPHEXT ! -1
+ TZSPLIT => TCRRT_PROCONF%TSPLITS_B(IP)
+ IOR(1) = TZSPLIT%NXORP+IWEST
+ IOR(2) = TZSPLIT%NYORP+ISOUTH
+ IEND(1) = TZSPLIT%NXENDP+IEAST
+ IEND(2) = TZSPLIT%NYENDP+INORTH
+!
+ CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+!
+ IIB = IIB+IWEST
+ IJB = IJB+ISOUTH
+ IIE = IIE+IEAST
+ IJE = IJE+INORTH
+!
+ IORP(1) = TZSPLIT%NXORP
+ IORP(2) = TZSPLIT%NYORP
+ IENDP(1) = TZSPLIT%NXENDP
+ IENDP(2) = TZSPLIT%NYENDP
+!
+ IORE(1) = TZSPLIT%NXORE
+ IORE(2) = TZSPLIT%NYORE
+ IENDE(1) = TZSPLIT%NXENDE
+ IENDE(2) = TZSPLIT%NYENDE
+!
+ ISLICEPROC = 0
+ CALL GET_GLOBALDIMS_ll(IMAX(1),IMAX(2))
+ IMAX(:) = IMAX(:) + 2*JPHEXT
+!
+!* 1.2 Set dimension (1 for X and 2 for Y)
+!
+ IDIM = IACHAR(HDIR)-IACHAR('X')+1
+ IDIM2 = 3-IDIM ! IDIM's inverse
+
+ ALLOCATE(ITOTALSLICE(IMAX(IDIM)))
+
+!
+!* 1.4 Set beginning and end of local slice
+!
+ IF (PRESENT(KB) .AND. PRESENT(KE)) THEN
+!
+!* Test the ranges
+!
+ IF((KB < 1 ) .OR. (KE > IENDE(IDIM))) THEN
+!
+! Error
+!
+ KERR = -1
+ RETURN
+!
+ ENDIF
+!
+ IB = KB
+ IE = KE
+!
+!* Correction in case the user has specified the
+!* extended subdomain (so that the halo overlapping
+!* between two processors won't be gathered twice).
+!
+ IF (IB == 1) IB = IOR(IDIM)-IORE(IDIM)+1
+ IF (IE == IENDE(IDIM)-IORE(IDIM)+1) IE = IEND(IDIM)-IORE(IDIM)+1
+!
+! IDISPL1 = KB-1 ! old version
+ IDISPL1 = 0
+ ELSE ! default : physical domain
+ IB = 1+JPHEXT
+ IE = IENDP(IDIM)-IORE(IDIM)+1
+! IDISPL1 = JPHEXT ! old version
+ IDISPL1 = 0
+ ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. CREATE MPI COMMUNICATOR WITH THE PROCS ON THE SLICE
+! ---------------------------------------------------
+!
+!* 2.1 Test if i am on the slice
+! if so, INUMPROC = my MPI rank
+! if not, INUMPROC = MPI_PROC_NULL
+!
+!
+ IF (KLOC >= IOR(IDIM2) .AND. KLOC <= IEND(IDIM2) .AND. IB<=IE) THEN
+!
+! Set local location
+!
+ ILOC = KLOC-IORE(IDIM2)+1
+!
+! Set relevant procs
+!
+ INUMPROC = IP-1
+!
+! Set lenght of the local slice
+!
+! ISIZE = IENDE(IDIM) - IORE(IDIM) + 1
+!
+!* 2.2 Have ZPTR point to the slice
+!
+ SELECT CASE(HDIR)
+ CASE("X")
+ ISIZE = IIE - IIB + 1
+ ZPTR => PARRAY(IIB:IIE,ILOC)
+!
+ CASE("Y")
+ ISIZE = IJE -IJB + 1
+ ZPTR => PARRAY(ILOC,IJB:IJE)
+!
+ CASE DEFAULT
+ call Print_msg( NVERB_FATAL, 'GEN', 'GET_1DSLICE_ll', 'invalid HDIR dummy argument ('//hdir//')' )
+!
+ END SELECT
+!
+ ELSE
+!
+ INUMPROC = MPI_PROC_NULL
+!
+ ENDIF
+!
+!* 2.3 Gather values of INUMPROC
+!
+ CALL MPI_ALLGATHER( (/ INUMPROC /) , 1, MNHINT_MPI, ISLICEPROC, 1, MNHINT_MPI, &
+ NMNH_COMM_WORLD, IERR)
+!
+!* 2.4 Get MPI world group
+!
+ CALL MPI_COMM_GROUP(NMNH_COMM_WORLD, IWRLD_GROUP, IERR)
+!
+!* 2.5 Count number of proc that contain the slice
+!
+ ICOUNT = COUNT(ISLICEPROC.NE.MPI_PROC_NULL)
+!
+!* 2.6 Create MPI group with the procs that contain the slice
+!
+ ALLOCATE(IPROCS(ICOUNT+1))
+ IPROCS(1:ICOUNT) = PACK(ISLICEPROC, MASK=ISLICEPROC.NE.MPI_PROC_NULL)
+ IPROCS(ICOUNT+1) = MPI_PROC_NULL
+ CALL MPI_GROUP_INCL(IWRLD_GROUP, ICOUNT, IPROCS, IGROUP_SLICE, IERR)
+!
+!* 2.7 Create MPI communicator associated to new group
+!
+ CALL MPI_COMM_CREATE(NMNH_COMM_WORLD, IGROUP_SLICE, ICOMM_SLICE, IERR)
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. GATHER THE LOCAL SLICES ON ALL PROCS THAT CONTAIN THE SLICE
+! -----------------------------------------------------------
+!
+!* 3.1 Have the length of the local slice on each proc known
+! by all procs on the global slice
+!
+ IF (ICOMM_SLICE .NE. MPI_COMM_NULL) THEN
+!
+ ALLOCATE(ISIZES(ICOUNT))
+ ISIZES = 0
+ CALL MPI_ALLGATHER( (/ ISIZE /) , 1, MNHINT_MPI, ISIZES, 1, MNHINT_MPI, &
+ ICOMM_SLICE, IERR)
+!
+!* 3.2 Compute array of displacements in the slice relative to the
+! origin of the global domain
+!
+ ALLOCATE(IDISPL(ICOUNT+1))
+ IDISPL(1) = IDISPL1
+ DO J=2, ICOUNT+1
+ IDISPL(J) = IDISPL(J-1)+ISIZES(J-1)
+ ENDDO
+ ISLICELENGTH = IDISPL(ICOUNT+1) - IDISPL(1)
+!
+!* 3.3 Have the values of the local slice on each proc known
+! by all procs on the global slice
+!
+ CALL MPI_ALLGATHERV(ZPTR, ISIZE, MNHREAL_MPI, ITOTALSLICE, ISIZES, &
+ IDISPL, MNHREAL_MPI, ICOMM_SLICE, IERR)
+!
+ DEALLOCATE(ISIZES, IDISPL)
+!
+!* 3.4 Delete slice communicator
+!
+ CALL MPI_COMM_FREE(ICOMM_SLICE, IERR)
+!
+ ENDIF
+!
+!* 3.5 Delete slice group
+!
+ CALL MPI_GROUP_FREE(IGROUP_SLICE, IERR)
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. BROADCAST THE SLICE ON ALL PROCS THAT ARE NOT ON THE SLICE
+! ----------------------------------------------------------
+!
+!* 4.1 Create communicator with the first proc
+!* on the slice and the procs that are not on the
+!* slice
+!
+ CALL MPI_GROUP_EXCL(IWRLD_GROUP, ICOUNT-1, IPROCS(2:2), IGROUP, IERR)
+
+ CALL MPI_COMM_CREATE(NMNH_COMM_WORLD, IGROUP, ICOMM, IERR)
+! CALL MPI_COMM_COMPARE(ICOMM, MPI_COMM_NULL, IRES, IERR)
+!
+!* 4.2 Broadcast the slice
+!
+ IF (ICOMM .NE. MPI_COMM_NULL) THEN
+!
+ CALL MPI_BCAST(ISLICELENGTH, 1, MNHINT_MPI, IPROCS(1), ICOMM, IERR)
+ CALL MPI_BCAST(ITOTALSLICE, ISLICELENGTH, MNHREAL_MPI, &
+ IPROCS(1), ICOMM, IERR)
+ CALL MPI_COMM_FREE(ICOMM, IERR)
+ ENDIF
+!
+ PSLICE(1:(KE-KB+1)) = &
+ ITOTALSLICE((IORE(IDIM) + KB - 1): (IORE(IDIM) + KE - 1))
+
+ CALL MPI_GROUP_FREE(IGROUP, IERR)
+ CALL MPI_GROUP_FREE(IWRLD_GROUP, IERR)
+!
+ IF (PRESENT(KERR)) KERR=IERR
+!
+ DEALLOCATE(IPROCS)
+ DEALLOCATE(ITOTALSLICE)
+!
+!-------------------------------------------------------------------------------
+!
+ END SUBROUTINE GET_1DSLICE_ll
+!
+! #######################################################
+ SUBROUTINE GET_2DSLICE_ll(PARRAY, HDIR, KLOC, PSLICE, &
+ KB, KE, KKB, KKE, KERR)
+! #######################################################
+!
+!! Purpose
+!! -------
+! The Purpose of this routine is to extract a slice of
+! 3D field PARRAY along the x or y direction
+!
+!!** Method
+!! ------
+!!
+! An MPI communicator with the processes corresponding to the
+! subdomains intersecting with the slice is built. This
+! communicator is then used to gather the whole slice (i.e.
+! the global slice) on these procs. The global slice is then
+! broadcasted on all procs that are not on the slice.
+!
+!! External
+!! --------
+! Module MODE_TOOLS_ll
+! LWEST_ll, LSOUTH_ll, LNORTH_ll, LEAST_ll
+! GET_GLOBALDIMS_ll
+!
+!! Implicit Arguments
+!! ------------------
+! Module MODD_STRUCTURE_ll
+! type MODELSPLITTING_ll
+!
+! Module MODD_VAR_ll
+! NPROC - Number of processors
+! TCRRT_PROCONF - Current configuration for current model
+! IP - Number of the local processor
+!
+! Module MODD_PARAMETERS_ll
+! JPHEXT, JPVEXT - halo size
+!
+!! Reference
+!! ---------
+! User Interface for the MesoNH Parallel Package
+!
+!! Author
+!! ------
+! P. Kloos (CERFACS)
+!
+!! Modifications
+!! -------------
+! Original 14 August 1998
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT, JPVEXT
+ USE MODD_STRUCTURE_ll, ONLY: MODELSPLITTING_ll
+ USE MODD_VAR_ll, ONLY: NPROC, TCRRT_PROCONF, IP
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ REAL, DIMENSION(:,:,:), TARGET, INTENT(IN) :: PARRAY ! horizontal field
+ CHARACTER(LEN=1), INTENT(IN) :: HDIR ! direction ("X" or "Y")
+ INTEGER, INTENT(IN) :: KLOC ! coordinate of the slice to
+ ! extract (in global coordinates)
+ REAL, DIMENSION(:,:), INTENT(OUT) :: PSLICE ! output slice
+ INTEGER, OPTIONAL :: KB, KE ! begin and end positions of the
+ ! extracted slices in the HDIR
+ ! direction
+ INTEGER, OPTIONAL :: KKB, KKE ! begin and end positions of the
+ ! extracted slices in the vertical ! direction
+ INTEGER, OPTIONAL :: KERR ! error code
+
+!
+!* 0.2 declarations of local variables
+!
+ TYPE(MODELSPLITTING_ll), POINTER :: TZSPLIT
+ INTEGER :: IDIM, IDIM2
+ INTEGER :: INUMPROC, IERR
+ INTEGER :: ILOC ! local location of the slice
+ INTEGER :: ICOUNT ! number of relevant procs (= those which are on the slice)
+ INTEGER :: ISIZE ! length of the local slice
+ INTEGER, DIMENSION(:), ALLOCATABLE :: IPROCS ! array of procs that are on
+ ! the slice
+ INTEGER, DIMENSION(:), ALLOCATABLE :: ISIZES ! length of the local slice
+ ! on all procs
+ INTEGER, DIMENSION(:), ALLOCATABLE :: IDISPL ! array of locations of the
+ ! procs in the slice
+ ! (for MPI_ALLGATHERV)
+!
+ REAL, DIMENSION(:,:), ALLOCATABLE :: ITOTALSLICE
+!
+ INTEGER :: IWRLD_GROUP ! world group
+ INTEGER :: IGROUP_SLICE ! group for the proc on the slice
+ INTEGER :: ICOMM_SLICE ! communicator for the proc on the slice
+ INTEGER :: IGROUP, ICOMM
+ INTEGER, DIMENSION(NPROC) :: ISLICEPROC
+ INTEGER, DIMENSION(2) :: IOR, IEND, IORP, IENDP, IORE, IENDE ! splitting
+ INTEGER :: IWEST, IEAST, INORTH, ISOUTH
+ INTEGER :: IB, IE ! beginning and end of the local slice
+ INTEGER :: IDISPL1 ! beginning of the slice (global)
+ INTEGER :: J ! loop index
+ INTEGER :: ISLICELENGTH ! length of the global slice
+ INTEGER :: ISLICEHEIGHT
+ INTEGER :: JK
+ INTEGER, DIMENSION(2) :: IMAX ! maximum dimensions
+ REAL, DIMENSION(:,:), ALLOCATABLE :: ZPTR
+!
+ INTEGER :: IIB, IIE, IJB, IJE
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. INITIALISATIONS
+! ---------------
+ IWEST=0; IEAST=0; INORTH=0; ISOUTH=0
+ IB=0; IE=0
+ IDISPL1=0
+!
+!* 1.1 Get current splitting
+!
+ IF (LWEST_ll()) IWEST=-1
+ IF (LEAST_ll()) IEAST=1
+ IF (LNORTH_ll()) INORTH=1
+ IF (LSOUTH_ll()) ISOUTH=-1
+
+ TZSPLIT => TCRRT_PROCONF%TSPLITS_B(IP)
+ IOR(1) = TZSPLIT%NXORP+IWEST
+ IOR(2) = TZSPLIT%NYORP+ISOUTH
+ IEND(1) = TZSPLIT%NXENDP+IEAST
+ IEND(2) = TZSPLIT%NYENDP+INORTH
+!
+ IORP(1) = TZSPLIT%NXORP
+ IORP(2) = TZSPLIT%NYORP
+ IENDP(1) = TZSPLIT%NXENDP
+ IENDP(2) = TZSPLIT%NYENDP
+!
+ IORE(1) = TZSPLIT%NXORE
+ IORE(2) = TZSPLIT%NYORE
+ IENDE(1) = TZSPLIT%NXENDE
+ IENDE(2) = TZSPLIT%NYENDE
+!
+ CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+!
+ IIB = IIB+IWEST
+ IJB = IJB+ISOUTH
+ IIE = IIE+IEAST
+ IJE = IJE+INORTH
+!
+ ISLICEPROC = 0
+ CALL GET_GLOBALDIMS_ll(IMAX(1),IMAX(2))
+ IMAX(:) = IMAX(:) + 2*JPHEXT
+!
+!* 1.2 Set dimension (1 for X and 2 for Y)
+!
+ IDIM = IACHAR(HDIR)-IACHAR('X')+1
+ IDIM2 = 3-IDIM ! IDIM's inverse
+!
+ ISLICEHEIGHT = KKE - KKB + 1
+ ALLOCATE(ITOTALSLICE(IMAX(IDIM),ISLICEHEIGHT))
+!
+!* 1.4 Set beginning and end of local slice
+!
+ IF (.NOT.PRESENT(KKB) .AND. .NOT.PRESENT(KKE)) THEN
+ KKB = 1 + JPVEXT
+ KKE = SIZE(PARRAY,3) - JPVEXT
+ ENDIF
+!
+ IF (PRESENT(KB) .AND. PRESENT(KE)) THEN
+!
+!* Test the ranges
+!
+ IF((KB < 1 ) .OR. (KE > IMAX(IDIM))) THEN
+!
+! Error
+!
+ KERR = -1
+ RETURN
+!
+ ENDIF
+!
+ IB = KB
+ IE = KE
+!
+!* Correction in case the user has specified the
+!* extended subdomain (so that the halo overlapping
+!* between two processors won't be gathered twice).
+!
+ IF (IB == 1) IB = IOR(IDIM)-IORE(IDIM)+1
+ IF (IE == IENDE(IDIM)-IORE(IDIM)+1) IE = IEND(IDIM)-IORE(IDIM)+1
+!
+! IDISPL1 = KB-1 ! old version
+ IDISPL1 = 0
+ ELSE ! default : physical domain
+ IB = 1+JPHEXT
+ IE = IENDP(IDIM)-IORE(IDIM)+1
+! IDISPL1 = JPHEXT ! old version
+ IDISPL1 = 0
+ ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. CREATE MPI COMMUNICATOR WITH THE PROCS ON THE SLICE
+! ---------------------------------------------------
+!
+!* 2.1 Test if i am on the slice
+! if so, INUMPROC = my MPI rank
+! if not, INUMPROC = MPI_PROC_NULL
+!
+ IF (KLOC >= IOR(IDIM2) .AND. KLOC <= IEND(IDIM2) .AND. IB<=IE) THEN
+!
+! Set local location
+!
+ ILOC = KLOC-IORE(IDIM2)+1
+!
+! Set relevant procs
+!
+ INUMPROC = IP-1
+!
+! Set lenght of the local slice
+!
+! ISIZE = IE - IB + 1
+!
+!* 2.2 Have ZPTR point to the slice
+!
+ SELECT CASE(HDIR)
+ CASE("X")
+ ISIZE = IIE - IIB + 1
+ ALLOCATE(ZPTR(ISIZE, ISLICEHEIGHT))
+ ZPTR = PARRAY(IIB:IIE,ILOC,KKB:KKE)
+!
+ CASE("Y")
+ ISIZE = IJE - IJB + 1
+ ALLOCATE(ZPTR(ISIZE, ISLICEHEIGHT))
+ ZPTR = PARRAY(ILOC,IJB:IJE,KKB:KKE)
+!
+ CASE DEFAULT
+ call Print_msg( NVERB_FATAL, 'GEN', 'GET_2DSLICE_ll', 'invalid HDIR dummy argument ('//hdir//')' )
+!
+ END SELECT
+!
+ ELSE
+!
+ INUMPROC = MPI_PROC_NULL
+!
+ ENDIF
+!
+!* 2.3 Gather values of INUMPROC
+!
+ CALL MPI_ALLGATHER( (/ INUMPROC /) , 1, MNHINT_MPI, ISLICEPROC, 1, MNHINT_MPI, &
+ NMNH_COMM_WORLD, IERR)
+!
+!* 2.4 Get MPI world group
+!
+ CALL MPI_COMM_GROUP(NMNH_COMM_WORLD, IWRLD_GROUP, IERR)
+!
+!* 2.5 Count number of proc that contain the slice
+!
+ ICOUNT = COUNT(ISLICEPROC.NE.MPI_PROC_NULL)
+!
+!* 2.6 Create MPI group with the procs that contain the slice
+!
+ ALLOCATE(IPROCS(ICOUNT+1))
+ IPROCS(1:ICOUNT) = PACK(ISLICEPROC, MASK=ISLICEPROC.NE.MPI_PROC_NULL)
+ IPROCS(ICOUNT+1) = MPI_PROC_NULL
+ CALL MPI_GROUP_INCL(IWRLD_GROUP, ICOUNT, IPROCS, IGROUP_SLICE, IERR)
+!
+!* 2.7 Create MPI communicator associated to new group
+!
+ CALL MPI_COMM_CREATE(NMNH_COMM_WORLD, IGROUP_SLICE, ICOMM_SLICE, IERR)
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. GATHER THE LOCAL SLICES ON ALL PROCS THAT CONTAIN THE SLICE
+! -----------------------------------------------------------
+!
+!* 3.1 Have the length of the local slice on each proc known
+! by all procs on the global slice
+!
+ IF (ICOMM_SLICE .NE. MPI_COMM_NULL) THEN
+!
+ ALLOCATE(ISIZES(ICOUNT))
+ ISIZES = 0
+ CALL MPI_ALLGATHER( (/ ISIZE /) , 1, MNHINT_MPI, ISIZES, 1, MNHINT_MPI, &
+ ICOMM_SLICE, IERR)
+!
+!* 3.2 Compute array of displacements in the slice relative to the
+! origin of the global domain
+!
+ ALLOCATE(IDISPL(ICOUNT+1))
+ IDISPL(1) = IDISPL1
+ DO J=2, ICOUNT+1
+ IDISPL(J) = IDISPL(J-1)+ISIZES(J-1)
+ ENDDO
+ ISLICELENGTH = IDISPL(ICOUNT+1) - IDISPL(1)
+!
+!
+!* 3.3 Have the values of the local slice on each proc known
+! by all procs on the global slice
+!
+ DO JK = 1, ISLICEHEIGHT
+ CALL MPI_ALLGATHERV(ZPTR(1,JK), ISIZE, MNHREAL_MPI, &
+ ITOTALSLICE(1,JK), &
+ ISIZES, IDISPL, MNHREAL_MPI, ICOMM_SLICE, IERR)
+ ENDDO
+!
+!* 3.4 Delete slice communicator
+!
+ CALL MPI_COMM_FREE(ICOMM_SLICE, IERR)
+!
+ DEALLOCATE(ISIZES, IDISPL)
+ DEALLOCATE(ZPTR)
+!
+ ENDIF
+!
+!* 3.5 Delete slice group
+!
+ CALL MPI_GROUP_FREE(IGROUP_SLICE, IERR)
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. BROADCAST THE SLICE ON ALL PROCS THAT ARE NOT ON THE SLICE
+! ----------------------------------------------------------
+!
+!* 4.1 Create communicator with the first proc
+!* on the slice and the procs that are not on the
+!* slice
+!
+ CALL MPI_GROUP_EXCL(IWRLD_GROUP, ICOUNT-1, IPROCS(2:2), IGROUP, IERR)
+ CALL MPI_COMM_CREATE(NMNH_COMM_WORLD, IGROUP, ICOMM, IERR)
+!
+!* 4.2 Broadcast the slice
+!
+ IF (ICOMM .NE. MPI_COMM_NULL) THEN
+!
+ CALL MPI_BCAST(ISLICELENGTH, 1, MNHINT_MPI, IPROCS(1), ICOMM, IERR)
+ DO JK = 1, ISLICEHEIGHT
+ CALL MPI_BCAST(ITOTALSLICE(1,JK), ISLICELENGTH, MNHREAL_MPI, &
+ IPROCS(1), ICOMM, IERR)
+ ENDDO
+!
+ CALL MPI_COMM_FREE(ICOMM, IERR)
+!
+ ENDIF
+ PSLICE(1:(KE-KB+1),KKB:KKE) = &
+ ITOTALSLICE((IORE(IDIM) + KB - 1):(IORE(IDIM) + KE - 1),&
+ 1:ISLICEHEIGHT)
+!
+ CALL MPI_GROUP_FREE(IGROUP, IERR)
+!
+ CALL MPI_GROUP_FREE(IWRLD_GROUP, IERR)
+!
+ IF (PRESENT(KERR)) KERR=IERR
+!
+ DEALLOCATE(IPROCS)
+ DEALLOCATE(ITOTALSLICE)
+!
+ END SUBROUTINE GET_2DSLICE_ll
+!
+! ####################################################
+ SUBROUTINE INTERSECTION( TPSPLIT, K, TPZONE, TPRES )
+! ####################################################
+!
+!!**** *INTERSECTION* - routine to compute the intersections of a zone TPZONE,
+! in a domain D with the subsets of D resulting
+! from a splitting TPSPLIT of D
+! (TPSPLIT is a any splitting of D in K parts with
+! or without overlapping)
+!
+! the result TPRES is a splitting
+!!
+!! Purpose
+!! -------
+! To compute the correspondants of a processor for each kind of
+! exchange, the exchange's zones have to be computed ; these zones
+! can be seen as intersections between zones of the domain.
+!
+!!** Method
+!! ------
+! For each element of the splitting TPSPLIT, its intersection with
+! the ZONE_ll TPZONE is computed by a max and a min computations on the
+! coordinates of the TPSPLIT'element and TPZONE
+!
+!! External
+!! --------
+! MAX, MIN - functions which compute the MIN and the MAX between 2 elements
+!
+!! Implicit Arguments
+!! ------------------
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! R. Guivarch
+!!
+!! Modifications
+!! -------------
+! Original 01/05/98
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
+ USE MODD_VAR_ll, ONLY : DIMZ
+!
+ IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+ TYPE(ZONE_ll), DIMENSION(:), INTENT(IN) :: TPSPLIT ! Splitting of the domain
+!
+ INTEGER, INTENT(IN) :: K ! Number of elements of TPSPLIT
+!
+ TYPE(ZONE_ll), INTENT(IN) :: TPZONE ! Zone to be split
+!
+ TYPE(ZONE_ll), DIMENSION(:), INTENT(OUT) :: TPRES ! Splitting of the zone
+!
+!* 0.2 declarations of local variables
+!
+ INTEGER :: J ! loop control variable
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. LIST AND COMPUTE INTERSECTION BETWEEN TPSPLIT(J) AND TPZONE :
+! -----------------------------------------------------------
+!
+ DO J = 1, K
+!
+! Which subdomain is the owner of TPSPLIT(J)
+ TPRES(J)%NUMBER = TPSPLIT(J)%NUMBER
+!
+! Computation of the origin coordinate
+ TPRES(J)%NXOR = MAX( TPZONE%NXOR, TPSPLIT(J)%NXOR )
+ TPRES(J)%NYOR = MAX( TPZONE%NYOR, TPSPLIT(J)%NYOR )
+!
+! Computation of the last coordinate
+ TPRES(J)%NXEND = MIN( TPZONE%NXEND, TPSPLIT(J)%NXEND )
+ TPRES(J)%NYEND = MIN( TPZONE%NYEND, TPSPLIT(J)%NYEND )
+!
+! for z-direction all the domain is considered
+ TPRES(J)%NZOR = 1
+ TPRES(J)%NZEND = DIMZ
+!
+! if the intersection is void, the result is nullified
+ IF((TPRES(J)%NXOR > TPRES(J)%NXEND) .OR. &
+ (TPRES(J)%NYOR > TPRES(J)%NYEND) ) &
+ TPRES(J) = ZONE_ll ( 0, 0, 0, 0, 0, 0, 0, 0 )
+!
+ ENDDO
+!
+!-------------------------------------------------------------------------------
+!
+ END SUBROUTINE INTERSECTION
+!
+! ####################################
+ SUBROUTINE ADD_ZONE( TPHEAD, TPELT )
+! ####################################
+!
+!!**** *ADD_ZONE* - routine to add a zone at the end of a correspondant
+!
+!! Purpose
+!! -------
+! the Purpose of this routine is to add a element of type ZONE_ll to
+! a variable of type CRSPD_ll which is a list of ZONE_ll
+!
+!!** Method
+!! ------
+! if the list is void, we create the list and put the element
+! as the first element else we add the element at the end of the list
+!
+!! External
+!! --------
+!
+!! Implicit Arguments
+!! ------------------
+! Module MODD_STRUCTURE_ll
+! types CRSPD_ll, ZONE_ll
+!
+! Module MODD_VAR_ll
+! IP - Number of the local processor
+!
+!! Reference
+!! ---------
+!
+!! Author
+! ------
+! R. Guivarch
+!
+!! Modifications
+!! -------------
+! Original 01/05/98
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_STRUCTURE_ll, ONLY : CRSPD_ll, ZONE_ll
+ USE MODD_VAR_ll, ONLY : IP
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ TYPE(CRSPD_ll), POINTER :: TPHEAD ! head of the list
+!
+ TYPE(ZONE_ll), INTENT(IN) :: TPELT ! element to be added
+!
+!* 0.2 declarations of local variables
+!
+ TYPE(CRSPD_ll), POINTER :: TZCURRENT, TZNEW ! intermediate variables
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. ADD THE ELEMENT TPELT :
+! ---------------------
+!
+ IF(.NOT.ASSOCIATED(TPHEAD)) THEN
+!
+! first element of the list
+!
+ ALLOCATE(TPHEAD)
+ TPHEAD%TELT = TPELT
+ NULLIFY( TPHEAD%TNEXT )
+ TPHEAD%NCARD = 1
+ IF (TPELT%NUMBER /= IP) THEN
+ TPHEAD%NCARDDIF = 1
+ ELSE
+ TPHEAD%NCARDDIF = 0
+ ENDIF
+!
+ ELSE
+!
+! others elements
+!
+ TZCURRENT => TPHEAD
+!
+! Go to the end of the list
+ DO WHILE(ASSOCIATED(TZCURRENT%TNEXT))
+ TZCURRENT => TZCURRENT%TNEXT
+ ENDDO
+!
+! Add the element
+ ALLOCATE(TZNEW)
+ TZNEW%TELT = TPELT
+ NULLIFY(TZNEW%TNEXT)
+!
+ TZCURRENT%TNEXT => TZNEW
+!
+ TPHEAD%NCARD = TPHEAD%NCARD + 1
+ IF (TPELT%NUMBER /= IP) TPHEAD%NCARDDIF = TPHEAD%NCARDDIF + 1
+!
+ ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+ END SUBROUTINE ADD_ZONE
+!
+! ##################################
+ INTEGER FUNCTION SIZE_ZONE(TPZONE)
+! ##################################
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ TYPE(ZONE_ll) :: TPZONE
+!
+!-------------------------------------------------------------------------------
+!
+ SIZE_ZONE = &
+ (TPZONE%NXEND - TPZONE%NXOR + 1) * (TPZONE%NYEND - TPZONE%NYOR + 1)
+!
+!-------------------------------------------------------------------------------
+!
+ END FUNCTION SIZE_ZONE
+!
+! #####################################
+ INTEGER FUNCTION GET_MAX_SIZE(TPLIST)
+! #####################################
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ TYPE(CRSPD_ll), POINTER :: TPLIST
+!
+!* 0.2 declarations of local variables
+!
+ TYPE(CRSPD_ll), POINTER :: TZLIST
+ INTEGER :: KCURSIZE, KMAXSIZE
+!
+!-------------------------------------------------------------------------------
+!
+ KMAXSIZE = 0
+ TZLIST => TPLIST
+ DO WHILE(ASSOCIATED(TZLIST))
+ KCURSIZE = SIZE_ZONE(TZLIST%TELT)
+ IF (KMAXSIZE < KCURSIZE) KMAXSIZE = KCURSIZE
+ TZLIST => TZLIST%TNEXT
+ ENDDO
+!
+ GET_MAX_SIZE = KMAXSIZE
+!
+!-------------------------------------------------------------------------------
+!
+ END FUNCTION GET_MAX_SIZE
+!
+! #################################################
+ SUBROUTINE EXTRACT_ZONE( TPSPLITS, TPPZS, TPEZS )
+! #################################################
+!
+!!**** *EXTRACT_ZONE* - routine to construct two splittings variables
+!! from a MODELSPLITTING_ll variable
+!
+!! Purpose
+!! -------
+! the Purpose of this routine is to extract two splittings TPPZS,
+! physical zone splitting and TPEZS, extended zone splitting
+! from a MODELSPLITTING_ll TPSPLITS
+!
+!!** Method
+!! ------
+!
+!! External
+!! --------
+!
+!! Implicit Arguments
+!! ------------------
+! Module MODD_STRUCTURE_ll
+! types MODELSPLITTING_ll, ZONE_ll
+!
+! Module MODD_VAR_ll
+! NPROC - Number of processors
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! R. Guivarch
+!
+!! Modifications
+!! -------------
+! Original 01/05/98
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_STRUCTURE_ll, ONLY : MODELSPLITTING_ll, ZONE_ll
+ USE MODD_VAR_ll, ONLY : NPROC
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ TYPE(MODELSPLITTING_ll), DIMENSION(:), POINTER :: TPSPLITS
+!
+ TYPE(ZONE_ll), DIMENSION(:), INTENT(OUT) :: TPPZS, TPEZS
+!
+!* 0.2 declarations of local variables
+!
+ INTEGER :: J ! loop control variable
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. FILL TPPZS AND TPEZS FOR EACH J :
+! -------------------------------
+!
+ DO J = 1, NPROC
+!
+ TPPZS(J) = ZONE_ll( 0, 0, 0, 0, 0, 0, 0, 0 )
+ TPEZS(J) = ZONE_ll( 0, 0, 0, 0, 0, 0, 0, 0 )
+!
+ TPPZS(J)%NUMBER = TPSPLITS(J)%NUMBER
+ TPPZS(J)%NXOR = TPSPLITS(J)%NXORP
+ TPPZS(J)%NYOR = TPSPLITS(J)%NYORP
+ TPPZS(J)%NXEND = TPSPLITS(J)%NXENDP
+ TPPZS(J)%NYEND = TPSPLITS(J)%NYENDP
+!
+ TPEZS(J)%NUMBER = TPSPLITS(J)%NUMBER
+ TPEZS(J)%NXOR = TPSPLITS(J)%NXORE
+ TPEZS(J)%NYOR = TPSPLITS(J)%NYORE
+ TPEZS(J)%NXEND = TPSPLITS(J)%NXENDE
+ TPEZS(J)%NYEND = TPSPLITS(J)%NYENDE
+!
+ ENDDO
+!
+!-----------------------------------------------------------------------
+!
+ END SUBROUTINE EXTRACT_ZONE
+!
+! #################################################
+ SUBROUTINE EXTRACT_ZONE_EXTENDED( TPSPLITS, TPPZS, TPEZS_EXTENDED, HALOSIZE )
+! #################################################
+!
+!!**** *EXTRACT_ZONE* - routine to construct two splittings variables
+!! from a MODELSPLITTING_ll variable
+!
+!! Purpose
+!! -------
+! the Purpose of this routine is to extract two splittings TPPZS,
+! physical zone splitting and TPEZS_EXTENDED, extended zone splitting with halo of size HALOSIZE
+! from a MODELSPLITTING_ll TPSPLITS
+!
+!!** Method
+!! ------
+!
+!! External
+!! --------
+!
+!! Implicit Arguments
+!! ------------------
+! Module MODD_STRUCTURE_ll
+! types MODELSPLITTING_ll, ZONE_ll
+!
+! Module MODD_VAR_ll
+! NPROC - Number of processors
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! R. Guivarch
+!
+!! Modifications
+!! -------------
+! Original 01/05/98
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_STRUCTURE_ll, ONLY : MODELSPLITTING_ll, ZONE_ll
+ USE MODD_VAR_ll, ONLY : NPROC
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ TYPE(MODELSPLITTING_ll), DIMENSION(:), POINTER :: TPSPLITS
+!
+ TYPE(ZONE_ll), DIMENSION(:), INTENT(OUT) :: TPPZS, TPEZS_EXTENDED
+!
+ INTEGER, INTENT(IN) :: HALOSIZE
+!
+!* 0.2 declarations of local variables
+!
+ INTEGER :: J ! loop control variable
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. FILL TPPZS AND TPEZS FOR EACH J :
+! -------------------------------
+!
+ DO J = 1, NPROC
+!
+ TPPZS(J) = ZONE_ll( 0, 0, 0, 0, 0, 0, 0, 0 )
+ TPEZS_EXTENDED(J) = ZONE_ll( 0, 0, 0, 0, 0, 0, 0, 0 )
+!
+ TPPZS(J)%NUMBER = TPSPLITS(J)%NUMBER
+ TPPZS(J)%NXOR = TPSPLITS(J)%NXORP+1
+ TPPZS(J)%NYOR = TPSPLITS(J)%NYORP+1
+ TPPZS(J)%NXEND = TPSPLITS(J)%NXENDP+1
+ TPPZS(J)%NYEND = TPSPLITS(J)%NYENDP+1
+!
+ IF ( TPSPLITS(J)%NDIMXP < HALOSIZE .OR. TPSPLITS(J)%NDIMYP < HALOSIZE ) THEN
+ WRITE(*,*) "WARNING : HALOSIZE is greater than model dimension"
+ WRITE(*,*) "HALOSIZE = ", HALOSIZE
+ WRITE(*,*) "model dimensions : ", TPSPLITS(J)%NDIMXP, "x", TPSPLITS(J)%NDIMYP
+ ENDIF
+!
+ TPEZS_EXTENDED(J)%NUMBER = TPSPLITS(J)%NUMBER
+ TPEZS_EXTENDED(J)%NXOR = TPSPLITS(J)%NXORP+1-HALOSIZE
+ TPEZS_EXTENDED(J)%NYOR = TPSPLITS(J)%NYORP+1-HALOSIZE
+ TPEZS_EXTENDED(J)%NXEND = TPSPLITS(J)%NXENDP+1+HALOSIZE
+ TPEZS_EXTENDED(J)%NYEND = TPSPLITS(J)%NYENDP+1+HALOSIZE
+!
+ ENDDO
+!
+!-----------------------------------------------------------------------
+!
+ END SUBROUTINE EXTRACT_ZONE_EXTENDED
+!
+! ###########################################
+ SUBROUTINE GLOBAL2LOCAL(TPPROCONF, TPCRSPD)
+! ###########################################
+!
+!!**** *GLOBAL2LOCAL* - routine to switch from global coordinates to local ones
+!
+!! Purpose
+!! -------
+! the Purpose of this routine is to compute the coordinates of the
+! subdomains included in a variable of type CRSPD_ll in the local
+! referential for 2way splitting of the local subdomain
+!
+!!** Method
+!! ------
+! the coordinates of the elements of TPCRSPD are global ;
+! the coordinates of the local subdomain in 2way splitting
+! are in the variable TPPROCONF%TSPLITS_B(IP) ;
+!
+! we substract the coordinates of each element by the origin
+! of the extended subdomain to obtain local coordinates
+!
+!! External
+!! --------
+!!
+!! Implicit Arguments
+!! ------------------
+! Module MODD_STRUCTURE_ll
+! types PROCONF_ll, CRSPD_ll, ZONE_ll
+!
+! Module MODD_VAR_ll
+! IP - Number of the local processor
+!
+!! Reference
+!! ---------
+!!
+!! Author
+!! ------
+!! Ph. Kloos
+!!
+!! Modifications
+!! -------------
+!! Original 01/05/98
+!! 03/02/99 change declaration of TPPROCONF
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_STRUCTURE_ll, ONLY : PROCONF_ll, CRSPD_ll, ZONE_ll
+ USE MODD_VAR_ll, ONLY : IP
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ TYPE(PROCONF_ll), POINTER :: TPPROCONF
+ TYPE(CRSPD_ll), POINTER :: TPCRSPD ! CRSPD_ll to be switched
+!
+!
+!* 0.2 declarations of local variables
+!
+! intermediate variables to describe the list and the elements
+ TYPE(ZONE_ll), POINTER :: TZZONE
+ TYPE(CRSPD_ll), POINTER :: TZCRSPD
+!
+! 2way-splitting
+ TYPE(MODELSPLITTING_ll), POINTER :: TPSPLIT
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. SWITCH :
+! ------
+!
+! we point to the structure which contains informations
+! of the 2way local subdomain
+ TPSPLIT => TPPROCONF%TSPLITS_B(IP)
+!
+! we list the variable TPCRSPD of type CRSPD_ll
+ TZCRSPD => TPCRSPD
+ DO WHILE (ASSOCIATED(TZCRSPD))
+ TZZONE => TZCRSPD%TELT
+!
+! we substract the origin of the local subdomain (extended subdomain)
+ TZZONE%NXOR = TZZONE%NXOR - TPSPLIT%NXORE + 1
+ TZZONE%NXEND = TZZONE%NXEND - TPSPLIT%NXORE + 1
+ TZZONE%NYOR = TZZONE%NYOR - TPSPLIT%NYORE + 1
+ TZZONE%NYEND = TZZONE%NYEND - TPSPLIT%NYORE + 1
+!
+ TZCRSPD => TZCRSPD%TNEXT
+ ENDDO
+!
+!-----------------------------------------------------------------------
+!
+ END SUBROUTINE GLOBAL2LOCAL
+!
+! ################################
+ SUBROUTINE G2LX(TPSPLIT,TPCRSPD)
+! ################################
+!
+!!**** *G2LX* - routine to switch from global coordinates to local ones
+!
+!! Purpose
+!! -------
+! the Purpose of this routine is to compute the coordinates of the
+! subdomains included in a variable of type CRSPD_ll in the local
+! referentiel for x-slices or y-slices splitting of the local subdomain
+!
+!!** Method
+!! ------
+! the coordinates of the elements of TPCRSPD are global ;
+! the coordinates of the local subdomain in 2way splitting
+! are in the variable TPSPLIT ;
+!
+! we substract the coordinates of each element by the origin
+! of the extended subdomain to obtain local coordinates
+!
+!! External
+!! --------
+!
+!! Implicit Arguments
+!! ------------------
+! Module MODD_STRUCTURE_ll
+! types MODELSPLITTING_ll, CRSPD_ll
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! R. Guivarch
+!
+!! Modifications
+!! -------------
+! Original 01/05/98
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_STRUCTURE_ll, ONLY : MODELSPLITTING_ll, CRSPD_ll
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ TYPE(MODELSPLITTING_ll), INTENT(IN) :: TPSPLIT ! x-slices or y-slices
+ ! splitting
+!
+ TYPE(CRSPD_ll), POINTER :: TPCRSPD ! CRSPD_ll to be switch
+!
+!* 0.2 declarations of local variables
+!
+! intermediate variables to describe the list and the elements
+ TYPE(ZONE_ll), POINTER :: TZZONE
+ TYPE(CRSPD_ll), POINTER :: TZCRSPD
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. SWITCH :
+! ------
+! we list the variable TPCRSPD of type CRSPD_ll
+ TZCRSPD => TPCRSPD
+ DO WHILE (ASSOCIATED(TZCRSPD))
+ TZZONE => TZCRSPD%TELT
+!
+! we substract the origin of the local subdomain (physical subdomain)
+ TZZONE%NXOR = TZZONE%NXOR - TPSPLIT%NXORP + 1
+ TZZONE%NXEND = TZZONE%NXEND - TPSPLIT%NXORP + 1
+ TZZONE%NYOR = TZZONE%NYOR - TPSPLIT%NYORP + 1
+ TZZONE%NYEND = TZZONE%NYEND - TPSPLIT%NYORP + 1
+!
+ TZCRSPD => TZCRSPD%TNEXT
+ ENDDO
+!
+!-------------------------------------------------------------------------------
+!
+ END SUBROUTINE G2LX
+!
+! #################################################
+ SUBROUTINE GET_OR_SURFEX_ll( HSPLIT, KOR )
+! #################################################
+!
+!!**** *GET_LOCAL_PORTION_OF_SURFEX_FIELD2D* - returns the origin index of the extended
+! 2way subdomain or of the x-slices subdomain
+! or of the y-slices
+! subdomain of the local processor in a surfex field (global indices)
+!
+!! Purpose
+!! -------
+!! returns the origin index of the extended
+!! 2way subdomain or of the x-slices subdomain
+!! or of the y-slices
+!! subdomain of the local processor in a surfex field (global indices)
+!
+!!** Method
+!! ------
+!
+!! External
+!! --------
+!
+!! Implicit Arguments
+!! ------------------
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! M.Moge
+!
+!! Modifications
+!! -------------
+! Original 16/12/14
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_PARAMETERS, ONLY : JPHEXT
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ CHARACTER(len=1), INTENT(IN) :: HSPLIT
+ INTEGER, INTENT(OUT) :: KOR
+!
+!* 0.2 declarations of local variables
+!
+ INTEGER :: IXOR_ll, IYOR_ll ! beginning of local subdomain in global coordinates
+!
+!-------------------------------------------------------------------------------
+!
+ CALL GET_OR_ll( HSPLIT, IXOR_ll, IYOR_ll )
+ KOR = (IXOR_ll-JPHEXT)*(IYOR_ll-JPHEXT)
+!
+!-----------------------------------------------------------------------
+!
+ END SUBROUTINE GET_OR_SURFEX_ll
+!
+!
+! #################################################
+ SUBROUTINE GET_LOCAL_PORTION_OF_SURFEX_FIELD2D( PSURFEXFIELDGLB, POUTPUTFIELDLCL )
+! #################################################
+!
+!!**** *GET_LOCAL_PORTION_OF_SURFEX_FIELD2D* - extracts local portion of a global
+!! surfex field (2D field stored in 1D array)
+!
+!! Purpose
+!! -------
+! extract local portion of a global
+!! surfex field (2D field stored in 1D array)
+!
+!!** Method
+!! ------
+!
+!! External
+!! --------
+!
+!! Implicit Arguments
+!! ------------------
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! M.Moge
+!
+!! Modifications
+!! -------------
+! Original 08/12/14
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_DIM_n, ONLY : NIMAX_ll, NJMAX_ll
+ USE MODD_PARAMETERS, ONLY : JPHEXT
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ REAL, DIMENSION(:), INTENT(IN) :: PSURFEXFIELDGLB
+!
+ REAL, DIMENSION(:), INTENT(OUT) :: POUTPUTFIELDLCL
+!
+!* 0.2 declarations of local variables
+!
+ INTEGER :: JI,JJ ! loop control variables
+ INTEGER :: IXOR, IYOR, IXEND, IYEND ! beginning and end of local subdomain in local coordinates
+ INTEGER :: IXOR_ll, IYOR_ll ! beginning of local subdomain in global coordinates
+ INTEGER :: ICOUNT
+!
+!-------------------------------------------------------------------------------
+!
+ CALL GET_INDICE_ll( IXOR, IYOR, IXEND, IYEND )
+ CALL GET_OR_ll( 'B', IXOR_ll, IYOR_ll )
+!
+ ICOUNT = 1
+ DO JJ=IYOR_ll+IYOR-1-JPHEXT,IYOR_ll+IYEND-1-JPHEXT
+ DO JI=IXOR_ll+IXOR-1-JPHEXT,IXOR_ll+IXEND-1-JPHEXT
+ POUTPUTFIELDLCL(ICOUNT) = PSURFEXFIELDGLB(JI+(NIMAX_ll)*(JJ-1))
+ ICOUNT = ICOUNT+1
+ ENDDO
+ ENDDO
+!
+!-----------------------------------------------------------------------
+!
+ END SUBROUTINE GET_LOCAL_PORTION_OF_SURFEX_FIELD2D
+!
+!
+! #################################################
+ SUBROUTINE SET_LOCAL_PORTION_OF_SURFEX_FIELD2D( PFIELDLCL, PSURFEXFIELDGLB )
+! #################################################
+!
+!!**** *GET_LOCAL_PORTION_OF_SURFEX_FIELD2D* - sets values of local portion of a global
+!! surfex field (2D field stored in 1D array)
+!
+!! Purpose
+!! -------
+! sets values of local portion of a global
+!! surfex field (2D field stored in 1D array)
+!
+!!** Method
+!! ------
+!
+!! External
+!! --------
+!
+!! Implicit Arguments
+!! ------------------
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! M.Moge
+!
+!! Modifications
+!! -------------
+! Original 09/12/14
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_DIM_n, ONLY : NIMAX_ll, NJMAX_ll
+ USE MODD_PARAMETERS, ONLY : JPHEXT
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ REAL, DIMENSION(:), INTENT(IN) :: PFIELDLCL
+!
+ REAL, DIMENSION(:), INTENT(OUT) :: PSURFEXFIELDGLB
+!
+!* 0.2 declarations of local variables
+!
+ INTEGER :: JI,JJ ! loop control variables
+ INTEGER :: IXOR, IYOR, IXEND, IYEND ! beginning and end of local subdomain in local coordinates
+ INTEGER :: IXOR_ll, IYOR_ll ! beginning of local subdomain in global coordinates
+ INTEGER :: ICOUNT
+!
+!-------------------------------------------------------------------------------
+!
+ CALL GET_INDICE_ll( IXOR, IYOR, IXEND, IYEND )
+ CALL GET_OR_ll( 'B', IXOR_ll, IYOR_ll )
+!
+ ICOUNT = 1
+ DO JJ=IYOR_ll+IYOR-1-JPHEXT,IYOR_ll+IYEND-1-JPHEXT
+ DO JI=IXOR_ll+IXOR-1-JPHEXT,IXOR_ll+IXEND-1-JPHEXT
+ PSURFEXFIELDGLB(JI+(NIMAX_ll)*(JJ-1)) = PFIELDLCL(ICOUNT)
+ ICOUNT = ICOUNT+1
+ ENDDO
+ ENDDO
+!
+!-----------------------------------------------------------------------
+!
+ END SUBROUTINE SET_LOCAL_PORTION_OF_SURFEX_FIELD2D
+!
+!
+! #################################################
+ SUBROUTINE GET_MEAN_OF_COORD_SQRT_ll(PARRAY,KSIZELOC,KSIZEGLB,PMEANSQRT)
+! #################################################
+!
+!!**** *GET_L2_NORM_ll* - computes the L2 norm of 1D array PARRAY accross all processes
+!
+!! Purpose
+!! -------
+! computes the L2 norm of 1D array PARRAY accross all processes
+!
+!!** Method
+!! ------
+!
+!! External
+!! --------
+!
+!! Implicit Arguments
+!! ------------------
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! M.Moge
+!
+!! Modifications
+!! -------------
+! Original 10/12/14
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ REAL, DIMENSION(:), INTENT(IN) :: PARRAY
+ INTEGER, INTENT(IN) :: KSIZELOC
+ INTEGER, INTENT(IN) :: KSIZEGLB
+!
+ REAL, INTENT(OUT) :: PMEANSQRT
+!
+!* 0.2 declarations of local variables
+!
+ REAL :: IMEANSQRTLOC
+ INTEGER :: IINFO
+!
+!-------------------------------------------------------------------------------
+!
+IMEANSQRTLOC = SUM(SQRT(PARRAY))
+CALL MPI_ALLREDUCE(IMEANSQRTLOC, PMEANSQRT, 1, MNHREAL_MPI, MPI_SUM, NMNH_COMM_WORLD,IINFO)
+PMEANSQRT = PMEANSQRT / KSIZEGLB
+!
+!-----------------------------------------------------------------------
+!
+ END SUBROUTINE GET_MEAN_OF_COORD_SQRT_ll
+!
+! ##########################################################################
+ FUNCTION SPREAD_X_ll(HSPLIT, PSOURCE, KDIM, KX, KCOPIES) RESULT(PSPREAD_X)
+! ##########################################################################
+!
+!!**** *SPREAD_X_ll* - perform the spread in y-direction of the local
+!! part of a x-vector for the local processor
+!
+!! Purpose
+!! -------
+!
+!!** Method
+!! ------
+! In function of the position of the local subdomain, we extract
+! the local part of the x-vector and spread it in y-direction.
+! the spread is done with the dimension of the local subdomain in
+! y-direction
+
+!! External
+!! --------
+! Module MODE_TOOLS_ll
+! GET_DIM_EXT_ll
+! GET_OR_ll
+!
+!! Implicit Arguments
+!! ------------------
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! R. Guivarch
+!
+!! Modifications
+!! -------------
+! Original 01/05/98
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ IMPLICIT NONE
+!
+!
+!* 0.0 declarations of arguments
+!
+ CHARACTER(len=1), INTENT(IN) :: HSPLIT ! Splitting flag (B, X or Y)
+!
+ REAL, DIMENSION(:), INTENT(IN) :: PSOURCE ! x-vector
+!
+ INTEGER, INTENT(IN) :: KDIM ! direction of the spread
+!
+ INTEGER, INTENT(IN) :: KX, KCOPIES ! dimension of the local subdomain
+!
+!* 0.1 declaration of returned variable
+!
+ REAL, DIMENSION( KX , KCOPIES ) :: PSPREAD_X
+
+!* 0.2 declarations of local variables
+!
+ REAL, ALLOCATABLE :: ZSUBSET(:) ! Intermediate buffer
+!
+ INTEGER :: INDEX
+ INTEGER :: JI ! loop control variable
+!
+ INTEGER :: IXOR, IYOR, IDIMX, IDIMY ! origin of the local subdoamin
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. GET THE ORIGIN AND THE DIMENSION OF THE LOCAL SUBDOMAIN :
+! -------------------------------------------------------
+!
+ CALL GET_OR_ll( HSPLIT, IXOR, IYOR )
+ CALL GET_DIM_EXT_ll( HSPLIT, IDIMX, IDIMY )
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. ALLOCATION OF THE INTERMEDIATE BUFFER :
+! -------------------------------------
+!
+ ALLOCATE(ZSUBSET(IDIMX))
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. FILL THE INTERMEDIATE BUFFER :
+! ----------------------------
+!
+ INDEX = 0
+ DO JI = IXOR, IXOR + IDIMX - 1
+!
+ INDEX = INDEX + 1
+ ZSUBSET(INDEX) = PSOURCE(JI)
+!
+ ENDDO
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. SPREAD THE BUFFER IN Y-DIRECTION WITH KCOPIES
+!
+ PSPREAD_X = SPREAD(ZSUBSET, KDIM, KCOPIES )
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. DEALLOCATION OF THE INTERMEDIATE BUFFER :
+! -------------------------------------
+!
+ DEALLOCATE(ZSUBSET)
+!
+!-------------------------------------------------------------------------------
+!
+ END FUNCTION SPREAD_X_ll
+!
+! ##########################################################################
+ FUNCTION SPREAD_Y_ll(HSPLIT, PSOURCE, KDIM, KY, KCOPIES) RESULT(PSPREAD_Y)
+! ##########################################################################
+!
+!!**** *SPREAD_Y_ll* - perform the spread in x-direction of the local
+!! part of a y-vector for the local processor
+!
+!! Purpose
+!! -------
+!
+!!** Method
+!! ------
+! In function of the position of the local subdomain, we extract
+! the local part of the y-vector and spread it in x-direction.
+! the spread is done with the dimension of the local subdomain in
+! x-direction
+!
+!! External
+!! --------
+! Module MODE_TOOLS_ll
+! GET_DIM_EXT_ll, GET_OR_ll
+!
+!! Implicit Arguments
+!! ------------------
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! R. Guivarch
+!
+!! Modifications
+!! -------------
+! Original 01/05/98
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ IMPLICIT NONE
+!
+!
+!* 0.0 declarations of arguments
+!
+ CHARACTER(len=1), INTENT(IN) :: HSPLIT ! Splitting flag (B, X or Y)
+!
+ REAL, DIMENSION(:), INTENT(IN) :: PSOURCE ! x-vector
+!
+ INTEGER, INTENT(IN) :: KDIM ! direction of the spread
+!
+ INTEGER, INTENT(IN) :: KY, KCOPIES ! dimension of the local subdomain
+!
+!* 0.1 declaration of returned variable
+!
+ REAL, DIMENSION( KCOPIES , KY ) :: PSPREAD_Y
+!
+
+!* 0.2 declarations of local variables
+!
+ REAL, ALLOCATABLE :: ZSUBSET(:) ! Intermediate buffer
+!
+ INTEGER :: INDEX
+ INTEGER :: JJ ! loop control variable
+!
+ INTEGER :: IXOR, IYOR, IDIMX, IDIMY ! origin of the local subdoamin
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. GET THE ORIGIN AND THE DIMENSION OF THE LOCAL SUBDOMAIN :
+! -------------------------------------------------------
+!
+ CALL GET_OR_ll( HSPLIT, IXOR, IYOR )
+ CALL GET_DIM_EXT_ll( HSPLIT, IDIMX, IDIMY )
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. ALLOCATION OF THE INTERMEDIATE BUFFER :
+! -------------------------------------
+!
+ ALLOCATE(ZSUBSET(IDIMY))
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. FILL THE INTERMEDIATE BUFFER :
+! ----------------------------
+!
+ INDEX = 0
+ DO JJ = IYOR, IYOR + IDIMY - 1
+!
+ INDEX = INDEX + 1
+ ZSUBSET(INDEX) = PSOURCE(JJ)
+!
+ ENDDO
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. SPREAD THE BUFFER IN X-DIRECTION WITH KCOPIES
+!
+ PSPREAD_Y = SPREAD(ZSUBSET, KDIM, KCOPIES )
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. DEALLOCATION OF THE INTERMEDIATE BUFFER :
+! -------------------------------------
+!
+ DEALLOCATE(ZSUBSET)
+!
+!-------------------------------------------------------------------------------
+!
+ END FUNCTION SPREAD_Y_ll
+!
+! #################################################################
+ FUNCTION SPREAD_XY_ll( HSPLIT, PSOURCE, KDIM, KX, KY, KCOPIES ) &
+ RESULT( PSPREAD_XY )
+! #################################################################
+!
+!!**** *SPREAD_XY_ll* - perform the spread in z-direction of the local
+!! part of a 2D-array for the local processor
+!
+!! Purpose
+!! -------
+!
+!!** Method
+!! ------
+! In function of the position of the local subdomain, we extract
+! the local part of the 2D-array and spread it in z-direction.
+! the spread is done with KCOPIES
+
+!! External
+!! --------
+! Module MODE_TOOLS_ll
+! GET_DIM_EXT_ll, GET_OR_ll
+!
+!! Implicit Arguments
+!! ------------------
+!
+!! Reference
+!! ---------
+!
+!! Author
+!! ------
+! R. Guivarch
+!
+!! Modifications
+!! -------------
+! Original 01/05/98
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ IMPLICIT NONE
+!
+!
+!* 0.0 declarations of arguments
+!
+ CHARACTER(len=1), INTENT(IN) :: HSPLIT ! Splitting flag (B, X or Y)
+!
+ REAL, DIMENSION(:,:), INTENT(IN) :: PSOURCE ! x-vector
+!
+ INTEGER, INTENT(IN) :: KDIM ! direction of the spread
+!
+ INTEGER, INTENT(IN) :: KX, KY ! dimension of the local subdomain
+!
+ INTEGER, INTENT(IN) :: KCOPIES ! number of spread
+!
+!* 0.1 declaration of returned variable
+!
+ REAL, DIMENSION( KX , KY, KCOPIES ) :: PSPREAD_XY
+
+!* 0.2 declarations of local variables
+!
+ REAL, ALLOCATABLE :: ZSUBSET(:,:) ! Intermediate buffer
+!
+ INTEGER :: INDEXX, INDEXY
+ INTEGER :: JI, JJ ! loop control variable
+!
+ INTEGER :: IXOR, IYOR, IDIMX, IDIMY ! origin of the local subdoamin
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. GET THE ORIGIN AND THE DIMENSION OF THE LOCAL SUBDOMAIN :
+! -------------------------------------------------------
+!
+ CALL GET_OR_ll( HSPLIT, IXOR, IYOR )
+ CALL GET_DIM_EXT_ll( HSPLIT, IDIMX, IDIMY )
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. ALLOCATION OF THE INTERMEDIATE BUFFER :
+! -------------------------------------
+!
+ ALLOCATE(ZSUBSET(IDIMX,IDIMY))
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. FILL THE INTERMEDIATE BUFFER :
+! ----------------------------
+ INDEXY = 0
+!
+ DO JJ = IYOR, IYOR + IDIMY - 1
+!
+ INDEXY = INDEXY + 1
+ INDEXX = 0
+!
+ DO JI = IXOR, IXOR + IDIMX - 1
+!
+ INDEXX = INDEXX + 1
+ ZSUBSET(INDEXX, INDEXY) = PSOURCE(JI,JJ)
+!
+ ENDDO
+!
+ ENDDO
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. SPREAD THE BUFFER IN Z-DIRECTION WITH KCOPIES
+!
+ PSPREAD_XY = SPREAD(ZSUBSET, KDIM, KCOPIES )
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. DEALLOCATION OF THE INTERMEDIATE BUFFER :
+! -----------------------------------------
+!
+ DEALLOCATE(ZSUBSET)
+!
+!-------------------------------------------------------------------------------
+!
+ END FUNCTION SPREAD_XY_ll
+!
+END MODULE MODE_TOOLS_ll
diff --git a/src/mesonh/aux/shuman.f90 b/src/mesonh/aux/shuman.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f0a1e3f12f08d5f1132de0e102030230bd0f1c61
--- /dev/null
+++ b/src/mesonh/aux/shuman.f90
@@ -0,0 +1,1291 @@
+!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$
+!-----------------------------------------------------------------
+! ##################
+ MODULE MODI_SHUMAN
+! ##################
+!
+INTERFACE
+!
+FUNCTION DXF(PA) RESULT(PDXF)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
+ ! side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDXF ! result at mass
+ ! localization
+END FUNCTION DXF
+!
+FUNCTION DXM(PA) RESULT(PDXM)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass
+ ! localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDXM ! result at flux
+ ! side
+END FUNCTION DXM
+!
+FUNCTION DYF(PA) RESULT(PDYF)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
+ ! side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDYF ! result at mass
+ ! localization
+END FUNCTION DYF
+!
+FUNCTION DYM(PA) RESULT(PDYM)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass
+ ! localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDYM ! result at flux
+ ! side
+END FUNCTION DYM
+!
+FUNCTION DZF(PA, KKA, KKU, KL) RESULT(PDZF)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
+ ! side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDZF ! result at mass
+ ! localization
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes (AROME)
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (AROME)
+END FUNCTION DZF
+!
+FUNCTION DZM(PA, KKA, KKU, KL) RESULT(PDZM)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass
+ ! localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDZM ! result at flux
+ ! side
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes (AROME)
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (AROME)
+END FUNCTION DZM
+!
+FUNCTION MXF(PA) RESULT(PMXF)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
+ ! side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMXF ! result at mass
+ ! localization
+END FUNCTION MXF
+!
+FUNCTION MXM(PA) RESULT(PMXM)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMXM ! result at flux localization
+END FUNCTION MXM
+
+FUNCTION MYF(PA) RESULT(PMYF)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
+ ! side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMYF ! result at mass
+ ! localization
+END FUNCTION MYF
+!
+FUNCTION MYM(PA) RESULT(PMYM)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMYM ! result at flux localization
+END FUNCTION MYM
+!
+FUNCTION MZF(PA,KKA,KKU,KL) RESULT(PMZF)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
+ ! side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMZF ! result at mass
+ ! localization
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes (AROME)
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (AROME)
+END FUNCTION MZF
+!
+FUNCTION MZM(PA,KKA,KKU,KL) RESULT(PMZM)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMZM ! result at flux localization
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes (AROME)
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (AROME)
+END FUNCTION MZM
+!
+END INTERFACE
+!
+END MODULE MODI_SHUMAN
+!
+!
+! ###############################
+ FUNCTION MXF(PA) RESULT(PMXF)
+! ###############################
+!
+!!**** *MXF* - Shuman operator : mean operator in x direction for a
+!! variable at a flux side
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a mean
+! along the x direction (I index) for a field PA localized at a x-flux
+! point (u point). The result is localized at a mass point.
+!
+!!** METHOD
+!! ------
+!! The result PMXF(i,:,:) is defined by 0.5*(PA(i,:,:)+PA(i+1,:,:))
+!! At i=size(PA,1), PMXF(i,:,:) are replaced by the values of PMXF,
+!! which are the right values in the x-cyclic case
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!! correction of in halo/pseudo-cyclic calculation for JPHEXT<> 1
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
+ ! side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMXF ! result at mass
+ ! localization
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JI ! Loop index in x direction
+INTEGER :: IIU ! upper bound in x direction of PA
+!
+INTEGER :: JJK,IJU,IKU
+INTEGER :: JIJK,JIJKOR,JIJKEND
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF MXF
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+JIJKOR = 1 + 1
+JIJKEND = IIU*IJU*IKU
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PMXF(JIJK-1,1,1) = 0.5*( PA(JIJK-1,1,1)+PA(JIJK,1,1) )
+END DO
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JI=1,JPHEXT
+ DO JJK=1,IJU*IKU
+ PMXF(IIU-JPHEXT+JI,JJK,1) = PMXF(JPHEXT+JI,JJK,1) ! for reprod JPHEXT <> 1
+ END DO
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END FUNCTION MXF
+! ###############################
+ FUNCTION MXM(PA) RESULT(PMXM)
+! ###############################
+!
+!!**** *MXM* - Shuman operator : mean operator in x direction for a
+!! mass variable
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a mean
+! along the x direction (I index) for a field PA localized at a mass
+! point. The result is localized at a x-flux point (u point).
+!
+!!** METHOD
+!! ------
+!! The result PMXM(i,:,:) is defined by 0.5*(PA(i,:,:)+PA(i-1,:,:))
+!! At i=1, PMXM(1,:,:) are replaced by the values of PMXM,
+!! which are the right values in the x-cyclic case.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!! correction of in halo/pseudo-cyclic calculation for JPHEXT<> 1
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMXM ! result at flux localization
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JI ! Loop index in x direction
+INTEGER :: IIU ! Size of the array in the x direction
+!
+INTEGER :: JJK,IJU,IKU
+INTEGER :: JIJK,JIJKOR,JIJKEND
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF MXM
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+JIJKOR = 1 + 1
+JIJKEND = IIU*IJU*IKU
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PMXM(JIJK,1,1) = 0.5*( PA(JIJK,1,1)+PA(JIJK-1,1,1) )
+END DO
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JI=1,JPHEXT
+ DO JJK=1,IJU*IKU
+ PMXM(JI,JJK,1) = PMXM(IIU-2*JPHEXT+JI,JJK,1) ! for reprod JPHEXT <> 1
+ END DO
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END FUNCTION MXM
+! ###############################
+ FUNCTION MYF(PA) RESULT(PMYF)
+! ###############################
+!
+!!**** *MYF* - Shuman operator : mean operator in y direction for a
+!! variable at a flux side
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a mean
+! along the y direction (J index) for a field PA localized at a y-flux
+! point (v point). The result is localized at a mass point.
+!
+!!** METHOD
+!! ------
+!! The result PMYF(i,:,:) is defined by 0.5*(PA(:,j,:)+PA(:,j+1,:))
+!! At j=size(PA,2), PMYF(:,j,:) are replaced by the values of PMYF,
+!! which are the right values in the y-cyclic case
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!! correction of in halo/pseudo-cyclic calculation for JPHEXT<> 1
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
+ ! side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMYF ! result at mass
+ ! localization
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JJ ! Loop index in y direction
+INTEGER :: IJU ! upper bound in y direction of PA
+!
+INTEGER :: IIU,IKU
+INTEGER :: JIJK,JIJKOR,JIJKEND
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF MYF
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+JIJKOR = 1 + IIU
+JIJKEND = IIU*IJU*IKU
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PMYF(JIJK-IIU,1,1) = 0.5*( PA(JIJK-IIU,1,1)+PA(JIJK,1,1) )
+END DO
+!
+DO JJ=1,JPHEXT
+ PMYF(:,IJU-JPHEXT+JJ,:) = PMYF(:,JPHEXT+JJ,:) ! for reprod JPHEXT <> 1
+END DO
+!
+!
+!-------------------------------------------------------------------------------
+!
+END FUNCTION MYF
+! ###############################
+ FUNCTION MYM(PA) RESULT(PMYM)
+! ###############################
+!
+!!**** *MYM* - Shuman operator : mean operator in y direction for a
+!! mass variable
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a mean
+! along the y direction (J index) for a field PA localized at a mass
+! point. The result is localized at a y-flux point (v point).
+!
+!!** METHOD
+!! ------
+!! The result PMYM(:,j,:) is defined by 0.5*(PA(:,j,:)+PA(:,j-1,:))
+!! At j=1, PMYM(:,j,:) are replaced by the values of PMYM,
+!! which are the right values in the y-cyclic case.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!! correction of in halo/pseudo-cyclic calculation for JPHEXT<> 1
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMYM ! result at flux localization
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JJ ! Loop index in y direction
+INTEGER :: IJU ! Size of the array in the y direction
+!
+!
+INTEGER :: IIU,IKU
+INTEGER :: JIJK,JIJKOR,JIJKEND
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF MYM
+! ------------------
+!
+IIU=SIZE(PA,1)
+IJU=SIZE(PA,2)
+IKU=SIZE(PA,3)
+!
+JIJKOR = 1 + IIU
+JIJKEND = IIU*IJU*IKU
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PMYM(JIJK,1,1) = 0.5*( PA(JIJK,1,1)+PA(JIJK-IIU,1,1) )
+END DO
+!
+DO JJ=1,JPHEXT
+ PMYM(:,JJ,:) = PMYM(:,IJU-2*JPHEXT+JJ,:) ! for reprod JPHEXT <> 1
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END FUNCTION MYM
+! ###############################
+ FUNCTION MZF(PA,KKA,KKU,KL) RESULT(PMZF)
+! ###############################
+!
+!!**** *MZF* - Shuman operator : mean operator in z direction for a
+!! variable at a flux side
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a mean
+! along the z direction (K index) for a field PA localized at a z-flux
+! point (w point). The result is localized at a mass point.
+!
+!!** METHOD
+!! ------
+!! The result PMZF(:,:,k) is defined by 0.5*(PA(:,:,k)+PA(:,:,k+1))
+!! At k=size(PA,3), PMZF(:,:,k) is defined by -999.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/07/94
+!! optimisation 20/08/00 J. Escobar
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
+ ! side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMZF ! result at mass
+ ! localization
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes (for AROME only)
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (for AROME only)
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JK ! Loop index in z direction
+INTEGER :: IKU ! upper bound in z direction of PA
+!
+INTEGER :: IIU,IJU
+INTEGER :: JIJ
+INTEGER :: JIJK,JIJKOR,JIJKEND
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF MZF
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+JIJKOR = 1 + IIU*IJU
+JIJKEND = IIU*IJU*IKU
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PMZF(JIJK-IIU*IJU,1,1) = 0.5*( PA(JIJK-IIU*IJU,1,1)+PA(JIJK,1,1) )
+END DO
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJ=1,IIU*IJU
+ PMZF(JIJ,1,IKU) = PMZF(JIJ,1,IKU-1) !-999.
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END FUNCTION MZF
+! ###############################
+ FUNCTION MZM(PA,KKA,KKU,KL) RESULT(PMZM)
+! ###############################
+!
+!!**** *MZM* - Shuman operator : mean operator in z direction for a
+!! mass variable
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a mean
+! along the z direction (K index) for a field PA localized at a mass
+! point. The result is localized at a z-flux point (w point).
+!
+!!** METHOD
+!! ------
+!! The result PMZM(:,:,k) is defined by 0.5*(PA(:,:,k)+PA(:,:,k-1))
+!! At k=1, PMZM(:,:,1) is defined by -999.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/07/94
+!! optimisation 20/08/00 J. Escobar
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMZM ! result at flux localization
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes (for AROME only)
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (for AROME only)
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JK ! Loop index in z direction
+INTEGER :: IKU ! upper bound in z direction of PA
+!
+INTEGER :: IIU,IJU
+INTEGER :: JIJ,JI,JJ
+INTEGER :: JIJK,JIJKOR,JIJKEND
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF MZM
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+JIJKOR = 1 + IIU*IJU
+JIJKEND = IIU*IJU*IKU
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PMZM(JIJK,1,1) = 0.5*( PA(JIJK,1,1)+PA(JIJK-IIU*IJU,1,1) )
+END DO
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJ=1,IIU*IJU
+ PMZM(JIJ,1,1) = -999.
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END FUNCTION MZM
+! ###############################
+ FUNCTION DXF(PA) RESULT(PDXF)
+! ###############################
+!
+!!**** *DXF* - Shuman operator : finite difference operator in x direction
+!! for a variable at a flux side
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a finite difference
+! along the x direction (I index) for a field PA localized at a x-flux
+! point (u point). The result is localized at a mass point.
+!
+!!** METHOD
+!! ------
+!! The result PDXF(i,:,:) is defined by (PA(i+1,:,:)-PA(i,:,:))
+!! At i=size(PA,1), PDXF(i,:,:) are replaced by the values of PDXF,
+!! which are the right values in the x-cyclic case
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!! correction of in halo/pseudo-cyclic calculation for JPHEXT<> 1
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
+ ! side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDXF ! result at mass
+ ! localization
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JI ! Loop index in x direction
+INTEGER :: IIU ! upper bound in x direction of PA
+!
+INTEGER :: JJK,IJU,IKU
+INTEGER :: JIJK,JIJKOR,JIJKEND
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF DXF
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+JIJKOR = 1 + 1
+JIJKEND = IIU*IJU*IKU
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PDXF(JIJK-1,1,1) = PA(JIJK,1,1) - PA(JIJK-1,1,1)
+END DO
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JI=1,JPHEXT
+ DO JJK=1,IJU*IKU
+ PDXF(IIU-JPHEXT+JI,JJK,1) = PDXF(JPHEXT+JI,JJK,1) ! for reprod JPHEXT <> 1
+ END DO
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END FUNCTION DXF
+! ###############################
+ FUNCTION DXM(PA) RESULT(PDXM)
+! ###############################
+!
+!!**** *DXM* - Shuman operator : finite difference operator in x direction
+!! for a variable at a mass localization
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a finite difference
+! along the x direction (I index) for a field PA localized at a mass
+! point. The result is localized at a x-flux point (u point).
+!
+!!** METHOD
+!! ------
+!! The result PDXM(i,:,:) is defined by (PA(i,:,:)-PA(i-1,:,:))
+!! At i=1, PDXM(1,:,:) are replaced by the values of PDXM,
+!! which are the right values in the x-cyclic case.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass
+ ! localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDXM ! result at flux
+ ! side
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JI ! Loop index in x direction
+INTEGER :: IIU ! Size of the array in the x direction
+!
+!
+INTEGER :: JJK,IJU,IKU
+INTEGER :: JIJK,JIJKOR,JIJKEND
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF DXM
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+JIJKOR = 1 + 1
+JIJKEND = IIU*IJU*IKU
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PDXM(JIJK,1,1) = PA(JIJK,1,1) - PA(JIJK-1,1,1)
+END DO
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JI=1,JPHEXT
+ DO JJK=1,IJU*IKU
+ PDXM(JI,JJK,1) = PDXM(IIU-2*JPHEXT+JI,JJK,1) ! for reprod JPHEXT <> 1
+ END DO
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END FUNCTION DXM
+! ###############################
+ FUNCTION DYF(PA) RESULT(PDYF)
+! ###############################
+!
+!!**** *DYF* - Shuman operator : finite difference operator in y direction
+!! for a variable at a flux side
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a finite difference
+! along the y direction (J index) for a field PA localized at a y-flux
+! point (v point). The result is localized at a mass point.
+!
+!!** METHOD
+!! ------
+!! The result PDYF(:,j,:) is defined by (PA(:,j+1,:)-PA(:,j,:))
+!! At j=size(PA,2), PDYF(:,j,:) are replaced by the values of PDYM,
+!! which are the right values in the y-cyclic case
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!! correction of in halo/pseudo-cyclic calculation for JPHEXT<> 1
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
+ ! side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDYF ! result at mass
+ ! localization
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JJ ! Loop index in y direction
+INTEGER :: IJU ! upper bound in y direction of PA
+!
+!
+INTEGER :: IIU,IKU
+INTEGER :: JIJK,JIJKOR,JIJKEND
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF DYF
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+JIJKOR = 1 + IIU
+JIJKEND = IIU*IJU*IKU
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PDYF(JIJK-IIU,1,1) = PA(JIJK,1,1) - PA(JIJK-IIU,1,1)
+END DO
+!
+DO JJ=1,JPHEXT
+ PDYF(:,IJU-JPHEXT+JJ,:) = PDYF(:,JPHEXT+JJ,:) ! for reprod JPHEXT <> 1
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END FUNCTION DYF
+! ###############################
+ FUNCTION DYM(PA) RESULT(PDYM)
+! ###############################
+!
+!!**** *DYM* - Shuman operator : finite difference operator in y direction
+!! for a variable at a mass localization
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a finite difference
+! along the y direction (J index) for a field PA localized at a mass
+! point. The result is localized at a y-flux point (v point).
+!
+!!** METHOD
+!! ------
+!! The result PDYM(:,j,:) is defined by (PA(:,j,:)-PA(:,j-1,:))
+!! At j=1, PDYM(:,1,:) are replaced by the values of PDYM,
+!! which are the right values in the y-cyclic case.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!! correction of in halo/pseudo-cyclic calculation for JPHEXT<> 1
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass
+ ! localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDYM ! result at flux
+ ! side
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JJ ! Loop index in y direction
+INTEGER :: IJU ! Size of the array in the y direction
+!
+!
+INTEGER :: IIU,IKU
+INTEGER :: JIJK,JIJKOR,JIJKEND
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF DYM
+! ------------------
+!
+IIU=SIZE(PA,1)
+IJU=SIZE(PA,2)
+IKU=SIZE(PA,3)
+!
+JIJKOR = 1 + IIU
+JIJKEND = IIU*IJU*IKU
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PDYM(JIJK,1,1) = PA(JIJK,1,1) - PA(JIJK-IIU,1,1)
+END DO
+!
+DO JJ=1,JPHEXT
+ PDYM(:,JJ,:) = PDYM(:,IJU-2*JPHEXT+JJ,:) ! for reprod JPHEXT <> 1
+END DO
+!
+!
+!-------------------------------------------------------------------------------
+!
+END FUNCTION DYM
+! ###############################
+ FUNCTION DZF(PA, KKA, KKU, KL) RESULT(PDZF)
+! ###############################
+!
+!!**** *DZF* - Shuman operator : finite difference operator in z direction
+!! for a variable at a flux side
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a finite difference
+! along the z direction (K index) for a field PA localized at a z-flux
+! point (w point). The result is localized at a mass point.
+!
+!!** METHOD
+!! ------
+!! The result PDZF(:,:,k) is defined by (PA(:,:,k+1)-PA(:,:,k))
+!! At k=size(PA,3), PDZF(:,:,k) is defined by -999.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/07/94
+!! optimisation 20/08/00 J. Escobar
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
+ ! side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDZF ! result at mass
+ ! localization
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes (AROME)
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (AROME)
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JK ! Loop index in z direction
+INTEGER :: IKU ! upper bound in z direction of PA
+!
+!
+INTEGER :: IIU,IJU
+INTEGER :: JIJ
+INTEGER :: JIJK,JIJKOR,JIJKEND
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF DZF
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+JIJKOR = 1 + IIU*IJU
+JIJKEND = IIU*IJU*IKU
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PDZF(JIJK-IIU*IJU,1,1) = PA(JIJK,1,1)-PA(JIJK-IIU*IJU,1,1)
+END DO
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJ=1,IIU*IJU
+ PDZF(JIJ,1,IKU) = -999.
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END FUNCTION DZF
+! ###############################
+ FUNCTION DZM(PA, KKA, KKU, KL) RESULT(PDZM)
+! ###############################
+!
+!!**** *DZM* - Shuman operator : finite difference operator in z direction
+!! for a variable at a mass localization
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a finite difference
+! along the z direction (K index) for a field PA localized at a mass
+! point. The result is localized at a z-flux point (w point).
+!
+!!** METHOD
+!! ------
+!! The result PDZM(:,j,:) is defined by (PA(:,:,k)-PA(:,:,k-1))
+!! At k=1, PDZM(:,:,k) is defined by -999.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/07/94
+!! optimisation 20/08/00 J. Escobar
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass
+ ! localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDZM ! result at flux
+ ! side
+INTEGER, INTENT(IN),OPTIONAL :: KKA, KKU ! near ground and uppest atmosphere array indexes (AROME)
+INTEGER, INTENT(IN),OPTIONAL :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise (AROME)
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JK ! Loop index in z direction
+INTEGER :: IKU ! upper bound in z direction of PA
+!
+!
+INTEGER :: IIU,IJU
+INTEGER :: JIJ
+INTEGER :: JIJK,JIJKOR,JIJKEND
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF DZM
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+JIJKOR = 1 + IIU*IJU
+JIJKEND = IIU*IJU*IKU
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PDZM(JIJK,1,1) = PA(JIJK,1,1)-PA(JIJK-IIU*IJU,1,1)
+END DO
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJ=1,IIU*IJU
+ PDZM(JIJ,1,1) = -999.
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END FUNCTION DZM
diff --git a/src/mesonh/ext/ground_paramn.f90 b/src/mesonh/ext/ground_paramn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c213d7c6e8c8c981f3a005e5ae3bdbfc4552899e
--- /dev/null
+++ b/src/mesonh/ext/ground_paramn.f90
@@ -0,0 +1,1032 @@
+!MNH_LIC Copyright 1994-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_GROUND_PARAM_n
+! ##########
+!
+INTERFACE
+!
+ SUBROUTINE GROUND_PARAM_n( PSFTH, PSFRV, PSFSV, PSFCO2, PSFU, PSFV, &
+ PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD )
+!
+!* surface fluxes
+! --------------
+!
+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. (ppp.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)
+!
+END SUBROUTINE GROUND_PARAM_n
+!
+END INTERFACE
+!
+END MODULE MODI_GROUND_PARAM_n
+!
+! ######################################################################
+ SUBROUTINE GROUND_PARAM_n( PSFTH, PSFRV, PSFSV, PSFCO2, PSFU, PSFV, &
+ PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD )
+! #######################################################################
+!
+!
+!!**** *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
+!-------------------------------------------------------------------------------
+!
+!* 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
+#endif
+!
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_CST, ONLY : XP00, XCPD, XRD, XRV,XRHOLW, XDAY, XPI, XLVTT, XMD, XAVOGADRO
+USE MODD_PARAMETERS, ONLY : JPVEXT, XUNDEF
+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
+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 : 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, 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 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
+!
+IMPLICIT NONE
+!
+!
+!
+!* 0.1 declarations of arguments
+!
+!* surface fluxes
+! --------------
+!
+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. (ppp.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)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!
+!* 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 ! 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), DIMENSION(:), ALLOCATABLE :: YSV_SURF ! name of the scalar variables
+ ! sent to SURFEX
+!
+REAL :: ZTIMEC
+INTEGER :: ILUOUT ! logical unit
+!
+!-------------------------------------------------------------------------------
+!
+!
+ILUOUT=TLUOUT%NLU
+IKB= 1+JPVEXT
+IKU=NKMAX + 2* JPVEXT
+IKE=IKU-JPVEXT
+!
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+!
+PSFTH = XUNDEF
+PSFRV = XUNDEF
+PSFSV = XUNDEF
+PSFCO2 = XUNDEF
+PSFU = XUNDEF
+PSFV = XUNDEF
+PDIR_ALB = XUNDEF
+PSCA_ALB = XUNDEF
+PEMIS = XUNDEF
+PTSRAD = XUNDEF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 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(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(:)
+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-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-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,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 .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
+!
+!* 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 (ppp.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) = PSFSV(:,:,JSV)
+ END DO
+ELSE
+ PSFSV(:,:,NSV_CHEMBEG:NSV_CHEMEND) = 0.
+END IF
+!
+!* conversion from dust flux (kg/m2/s) to (ppp.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 (ppp.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 (ppp.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)
+!
+!
+!* Diagnostics
+! -----------
+!
+!
+IF (LDIAG_IN_RUN) THEN
+ !
+ XCURRENT_SFCO2(:,:) = ZSFCO2(:,:)
+ XCURRENT_DSTAOD(:,:)=0.0
+ XCURRENT_SLTAOD(:,:)=0.0
+ IF (CRAD=='ECMW') 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_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_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
+!
+!==================================================================================
+!
+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_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
+ZSFTQ = XUNDEF
+IF (NSV>0) ZSFTS = XUNDEF
+ZSFCO2 = XUNDEF
+ZSFU = XUNDEF
+ZSFV = XUNDEF
+!
+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_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_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/ice_adjust_bis.f90 b/src/mesonh/ext/ice_adjust_bis.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c6f72a0868eee72ac6bd97ad98e4d3bd692529b2
--- /dev/null
+++ b/src/mesonh/ext/ice_adjust_bis.f90
@@ -0,0 +1,155 @@
+!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
+!
+USE MODI_COMPUTE_FUNCTION_THERMO
+USE MODE_TH_R_FROM_THL_RT_3D
+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
+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_3D(YFRAC_ICE,ZFRAC_ICE(:,:,:),PP(:,:,:), &
+ ZTHL(:,:,:), ZRW(:,:,:), PTH(:,:,:), &
+ ZRV(:,:,:), ZRC(:,:,:), ZRI(:,:,:), &
+ ZRSATW(:,:,:), ZRSATI(:,:,:),OOCEAN=.FALSE.)
+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(:,:,:)
+!
+END SUBROUTINE ICE_ADJUST_BIS
diff --git a/src/mesonh/ext/lesn.f90 b/src/mesonh/ext/lesn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..acd15c8ed71f03f1986109b77a3979ceb09279bc
--- /dev/null
+++ b/src/mesonh/ext/lesn.f90
@@ -0,0 +1,3569 @@
+!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_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, 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
+!
+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 :: 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
+!-------------------------------------------------------------------------------
+!
+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)
+!
+ILUOUT = TLUOUT%NLU
+!
+!-------------------------------------------------------------------------------
+!
+!* interpolation coefficients for Z type grid
+!
+IF (CSPECTRA_LEVEL_TYPE=='Z') THEN
+ IF (ALLOCATED(XCOEFLIN_CURRENT_SPEC)) DEALLOCATE(XCOEFLIN_CURRENT_SPEC)
+ IF (ALLOCATED(NKLIN_CURRENT_SPEC )) DEALLOCATE(NKLIN_CURRENT_SPEC )
+ !
+ ALLOCATE(XCOEFLIN_CURRENT_SPEC(IIU,IJU,NSPECTRA_K))
+ 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))
+ELSE
+ ALLOCATE(ZRI_LES (0,0,0))
+ ALLOCATE(ZIWP_LES(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) )
+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) )
+!
+ 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(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)
+! ---------------------------
+!
+DEALLOCATE(LLES_CURRENT_CART_MASK)
+IF (LLES_NEB_MASK) DEALLOCATE(LLES_CURRENT_NEB_MASK)
+IF (LLES_CORE_MASK) DEALLOCATE(LLES_CURRENT_CORE_MASK)
+IF (LLES_MY_MASK) THEN
+ DEALLOCATE(LLES_CURRENT_MY_MASKS)
+END IF
+IF (LLES_CS_MASK) THEN
+ DEALLOCATE(LLES_CURRENT_CS1_MASK)
+ IF (NSV_CS >= 2) DEALLOCATE(LLES_CURRENT_CS2_MASK)
+ IF (NSV_CS == 3) 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
+ XLES_BL_HEIGHT(NLES_CURRENT_TCOUNT) = BL_DEPTH_DIAG(IKB,IKE,ZFRIC_SURF, XLES_ZS, &
+ ZFRIC_LES, XLES_Z, &
+ XFTOP_O_FSURF )
+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/phys_paramn.f90 b/src/mesonh/ext/phys_paramn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6b62cc0a441f49a5e4464064f836b1bedf31b495
--- /dev/null
+++ b/src/mesonh/ext/phys_paramn.f90
@@ -0,0 +1,1606 @@
+!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_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
+!!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_ADV_n, ONLY : XRTKEMS
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_ri, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
+ tbudgets, xtime_bu_process
+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
+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_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
+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_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
+USE MODD_OCEANH
+USE MODD_OUT_n
+USE MODD_PARAM_C2R2, ONLY : LSEDC
+USE MODD_PARAMETERS
+USE MODD_PARAM_ICE, ONLY : LSEDIC
+USE MODD_PARAM_KAFR_n
+USE MODD_PARAM_LIMA, ONLY : MSEDC => LSEDC, XRTMIN_LIMA=>XRTMIN
+USE MODD_PARAM_MFSHALL_n
+USE MODD_PARAM_n
+USE MODD_PARAM_RAD_n
+USE MODD_PASPOL
+USE MODD_PASPOL_n
+USE MODD_PRECIP_n
+use modd_precision, only: MNHTIME
+USE MODD_RADIATIONS_n
+USE MODD_RAIN_ICE_DESCR, 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_CLOUD, ONLY : CTURBLEN_CLOUD,NMODEL_CLOUD, &
+ XCEI,XCEI_MIN,XCEI_MAX,XCOEF_AMPL_SAT
+USE MODD_TURB_FLUX_AIRCRAFT_BALLOON, ONLY : XTHW_FLUX, XRCW_FLUX, XSVW_FLUX
+USE MODD_TURB_n
+
+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_MNH_TIMING
+USE MODE_MODELN_HANDLER
+USE MODE_MPPDB
+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_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
+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
+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 !LHARAT turb option from AROME
+!
+!-----------------------------------------------------------------------------
+
+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)
+!
+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( MAXVAL(XCLDFR(:,:,:)).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)
+ 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) = 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., 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, XCLDFR, 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, 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 ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'RAD', xrths(:, :, :) )
+ XRTHS(:,:,:) = XRTHS(:,:,:) + XRHODJ(:,:,:)*XDTHRAD(:,:,:)
+ if ( 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 (LOCEAN .AND. (.NOT.LCOUPLES)) THEN
+!
+ ALLOCATE( ZIZOCE(IKU)); ZIZOCE(:)=0.
+ ALLOCATE( ZPROSOL1(IKU))
+ ALLOCATE( ZPROSOL2(IKU))
+ ALLOCATE(XSSUFL(IIU,IJU))
+ ALLOCATE(XSSVFL(IIU,IJU))
+ ALLOCATE(XSSTFL(IIU,IJU))
+ ALLOCATE(XSSOLA(IIU,IJU))
+ ! Time interpolation
+ JSW = INT(TDTCUR%xtime/REAL(NINFRT))
+ ZSWA = TDTCUR%xtime/REAL(NINFRT)-REAL(JSW)
+ XSSTFL = (XSSTFL_T(JSW+1)*(1.-ZSWA)+XSSTFL_T(JSW+2)*ZSWA)
+ XSSUFL = (XSSUFL_T(JSW+1)*(1.-ZSWA)+XSSUFL_T(JSW+2)*ZSWA)
+ XSSVFL = (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) = XROC*ZIZOCE(IKU)
+ ZPROSOL2(IKU) = (1.-XROC)*ZIZOCE(IKU)
+ IF(NVERB >= 5 ) THEN
+ WRITE(ILUOUT,*)'ZSWA JSW TDTCUR XTSTEP FT FU FV SolarR(IKU)', NINFRT, ZSWA,JSW,&
+ TDTCUR%xtime, XTSTEP, XSSTFL(2,2), XSSUFL(2,2),XSSVFL(2,2),ZIZOCE(IKU)
+ END IF
+ if ( 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)/XD1)
+ ZPROSOL2(JKM) = ZPROSOL2(JKM+1)* exp(-XDZZ(2,2,JKM)/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 ( lbudget_th ) call Budget_store_end ( tbudgets(NBUDGET_TH), 'OCEAN', xrths(:, :, :) )
+ DEALLOCATE( ZIZOCE)
+ DEALLOCATE (ZPROSOL1)
+ DEALLOCATE (ZPROSOL2)
+END IF
+!
+!
+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 ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'DCONV', xrths(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'DCONV', xrrs (:, :, :, 1) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DCONV', xrrs (:, :, :, 2) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'DCONV', xrrs (:, :, :, 4) )
+ if ( 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
+ !
+ DO JSV=NSV_DSTBEG,NSV_DSTEND
+ ZSVDST(:,:,:,JSV-NSV_DSTBEG+1) = XRSVS(:,:,:,JSV) * XTSTEP / XRHODJ(:,:,:)
+ ENDDO
+ 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
+ !
+ DO JSV=NSV_SLTBEG,NSV_SLTEND
+ ZSVSLT(:,:,:,JSV-NSV_SLTBEG+1) = XRSVS(:,:,:,JSV) * XTSTEP / XRHODJ(:,:,:)
+ ENDDO
+ 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) * 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 * ( &
+ XLVTT * XDRCCONV(:,:,:) + XLSTT * XDRICONV(:,:,:) ) *&
+ ( XP00 / XPABST(:,:,:) ) ** ( XRD / XCPD )
+ END IF
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'DCONV', xrths(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'DCONV', xrrs (:, :, :, 1) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DCONV', xrrs (:, :, :, 2) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'DCONV', xrrs (:, :, :, 4) )
+ if ( 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(ZSFTH, ZSFRV, ZSFSV, ZSFCO2, ZSFU, ZSFV, &
+ ZDIR_ALB, ZSCA_ALB, ZEMIS, ZTSRAD )
+ !
+ 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
+ ZSFTH = 0.
+ ZSFRV = 0.
+ ZSFSV = 0.
+ ZSFCO2 = 0.
+ ZSFU = 0.
+ ZSFV = 0.
+END IF
+!
+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)) THEN
+ DEALLOCATE(XTHW_FLUX)
+ ALLOCATE(XTHW_FLUX(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)))
+ELSE
+ ALLOCATE(XTHW_FLUX(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)))
+END IF
+
+IF(ALLOCATED(XRCW_FLUX)) THEN
+ DEALLOCATE(XRCW_FLUX)
+ ALLOCATE(XRCW_FLUX(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)))
+ELSE
+ ALLOCATE(XRCW_FLUX(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)))
+END IF
+!
+IF(ALLOCATED(XSVW_FLUX)) THEN
+ DEALLOCATE(XSVW_FLUX)
+ ALLOCATE(XSVW_FLUX(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),SIZE(XSVT,4)))
+ELSE
+ ALLOCATE(XSVW_FLUX(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),SIZE(XSVT,4)))
+END IF
+!
+ CALL TURB( 1, IKU, 1, IMI, NRR, NRRL, NRRI, CLBCX, CLBCY, 1, NMODEL_CLOUD, &
+ LTURB_FLX, LTURB_DIAG, LSUBG_COND, LRMC01, LOCEAN, &
+ CTURBDIM, CTURBLEN, CTOM, CTURBLEN_CLOUD, CCLOUD,XIMPL, &
+ XTSTEP, TPFILE, &
+ XDXX, XDYY, XDZZ, XDZX, XDZY, XZZ, &
+ XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, XCOSSLOPE, XSINSLOPE, &
+ XRHODJ, XTHVREF, &
+ 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, XTR, XDISS, &
+ TBUDGETS, KBUDGETS=SIZE(TBUDGETS),PLEM=XLEM,PRTKEMS=XRTKEMS )
+!
+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, CMF_UPDRAFT, CMF_CLOUD, LMIXUV, &
+ LMF_FLX,TPFILE,ZTIME_LES_MF, &
+ XIMPL_MF, XTSTEP, &
+ XDZZ, XZZ,XDXHAT(1),XDYHAT(1), &
+ XRHODJ, XRHODREF, XPABST, ZEXN, ZSFTH, ZSFRV, &
+ XTHT,XRT,XUT,XVT,XWT,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
+!
+!
+!* deallocate sf flux array for ocean model (in grid nesting, dimensions can vary)
+!
+IF (LOCEAN .AND. (.NOT. LCOUPLES)) THEN
+ DEALLOCATE(XSSUFL)
+ DEALLOCATE(XSSVFL)
+ DEALLOCATE(XSSTFL)
+ DEALLOCATE(XSSOLA)
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 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
new file mode 100644
index 0000000000000000000000000000000000000000..a1c1ec6c6a4d7ab52ea4549f93ffc4a35a2deb5b
--- /dev/null
+++ b/src/mesonh/ext/prep_ideal_case.f90
@@ -0,0 +1,1933 @@
+!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.
+!-----------------------------------------------------------------
+! #######################
+ 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_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_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 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
+!
+!JUAN
+USE MODE_SPLITTINGZ_ll
+USE MODD_SUB_MODEL_n
+USE MODE_MNH_TIMING
+USE MODN_CONFZ
+!JUAN
+USE MODE_TH_R_FROM_THL_RT_3D
+!
+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 MODI_INI_CST
+USE MODI_INI_NEB
+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 :: ZXHAT_ll, ZYHAT_ll
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE ::ZTHL,ZT,ZRT,ZFRAC_ICE,&
+ ZEXN,ZLVOCPEXN,ZLSOCPEXN,ZCPH, &
+ ZRSATW, ZRSATI
+ ! 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
+CALL INI_NEB
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. SET DEFAULT VALUES :
+! --------------------
+!
+!
+!* 2.1 For variables in DESFM file
+!
+CALL ALLOC_FIELD_SCALARS()
+!
+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(1)
+!
+CALL INI_FIELD_SCALARS()
+!
+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))
+!
+! 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.
+!
+ ALLOCATE(ZXHAT_ll(NIMAX_ll+2*JPHEXT),ZYHAT_ll(NJMAX_ll+2*JPHEXT))
+ ZXHAT_ll=0.
+ ZYHAT_ll=0.
+ CALL SM_LATLON(XLATCEN,XLONCEN, &
+ -XDELTAX*(NIMAX_ll/2-0.5+JPHEXT), &
+ -XDELTAY*(NJMAX_ll/2-0.5+JPHEXT), &
+ XLATORI,XLONORI)
+ DEALLOCATE(ZXHAT_ll,ZYHAT_ll)
+!
+ 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
+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,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
+!
+ALLOCATE(ZXHAT_ll(NIMAX_ll+ 2 * JPHEXT),ZYHAT_ll(NJMAX_ll+2 * JPHEXT))
+CALL GATHERALL_FIELD_ll('XX',XXHAT,ZXHAT_ll,NRESP) !//
+CALL GATHERALL_FIELD_ll('YY',XYHAT,ZYHAT_ll,NRESP) !//
+IF (CTYPELOC /= 'IJGRID') THEN
+ NILOC = MINLOC(ABS(XXHATLOC-ZXHAT_ll(:)))
+ NJLOC = MINLOC(ABS(XYHATLOC-ZYHAT_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(DATE(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(DATE(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,XZHAT,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))
+ 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_3D('T',ZFRAC_ICE,XPABST,ZTHL,ZRT,XTHT,XRT(:,:,:,1), &
+ XRT(:,:,:,2),XRT(:,:,:,4),ZRSATW, ZRSATI,OOCEAN=.FALSE.)
+END IF
+ DEALLOCATE(ZEXN)
+ DEALLOCATE(ZT)
+ DEALLOCATE(ZCPH)
+ DEALLOCATE(ZLVOCPEXN)
+ DEALLOCATE(ZLSOCPEXN)
+ DEALLOCATE(ZTHL)
+ DEALLOCATE(ZRT)
+! 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)
+!
+!-------------------------------------------------------------------------------
+!
+!* 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()
+!
+END PROGRAM PREP_IDEAL_CASE
diff --git a/src/mesonh/ext/resolved_cloud.f90 b/src/mesonh/ext/resolved_cloud.f90
new file mode 100644
index 0000000000000000000000000000000000000000..fe77e35d3e53e33e750edcf23eaa01e24e32ea5d
--- /dev/null
+++ b/src/mesonh/ext/resolved_cloud.f90
@@ -0,0 +1,1064 @@
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ##########################
+ MODULE MODI_RESOLVED_CLOUD
+! ##########################
+INTERFACE
+ SUBROUTINE RESOLVED_CLOUD ( HCLOUD, HACTCCN, HSCONV, HMF_CLOUD, &
+ KRR, KSPLITR, KSPLITG, KMI, KTCOUNT, &
+ HLBCX, HLBCY, TPFILE, HRAD, HTURBDIM, &
+ OSUBG_COND, OSIGMAS, HSUBG_AUCV, &
+ PTSTEP, PZZ, PRHODJ, PRHODREF, PEXNREF, &
+ PPABST, PTHT, PRT, PSIGS, PSIGQSAT, PMFCONV, &
+ PTHM, PRCM, PPABSM, &
+ PW_ACT,PDTHRAD, PTHS, PRS, PSVT, PSVS, PSRCS, PCLDFR,&
+ PCIT, OSEDIC, OACTIT, OSEDC, OSEDI, &
+ ORAIN, OWARM, OHHONI, OCONVHG, &
+ PCF_MF,PRC_MF, PRI_MF, &
+ PINPRC,PINPRC3D,PINPRR,PINPRR3D, PEVAP3D, &
+ PINPRS,PINPRS3D,PINPRG,PINPRG3D,PINPRH,PINPRH3D, &
+ PSOLORG,PMI, &
+ PSPEEDC, PSPEEDR, PSPEEDS, PSPEEDG, PSPEEDH, &
+ PINDEP, PSUPSAT, PNACT, PNPRO,PSSPRO, PRAINFR, &
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
+ PSEA,PTOWN )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! kind of cloud
+CHARACTER(LEN=4), INTENT(IN) :: HACTCCN ! kind of CCN activation scheme
+ ! paramerization
+CHARACTER(LEN=4), INTENT(IN) :: HSCONV ! Shallow convection scheme
+CHARACTER(LEN=4), INTENT(IN) :: HMF_CLOUD! Type of statistical cloud
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! integrations for rain sedimendation
+INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
+ ! integrations for ice sedimendation
+INTEGER, INTENT(IN) :: KMI ! Model index
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Dimensionality of the
+ ! turbulence scheme
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid Cond.
+LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
+ ! use values computed in CONDENSATION
+ ! or that from turbulence scheme
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV
+ ! Kind of Subgrid autoconversion method
+REAL, INTENT(IN) :: PTSTEP ! Time step :XTSTEP in namelist
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ !Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference dry air density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PRT ! Moist variables at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
+REAL, INTENT(IN) :: PSIGQSAT! coeff applied to qsat variance contribution
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure time t-Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at time t-Dt
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_ACT ! W for CCN activation
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD! THeta RADiative Tendancy
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable sources
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Scalar variable at time t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable sources
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice number
+ ! concentration at time t
+LOGICAL, INTENT(IN) :: OSEDIC! Switch to activate the
+ ! cloud droplet sedimentation
+ ! for ICE3
+LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
+ ! activation through temp.
+ ! evolution in C2R2 and KHKO
+LOGICAL, INTENT(IN) :: OSEDC ! Switch to activate the
+ ! cloud droplet sedimentation
+ ! for C2R2 or KHKO
+LOGICAL, INTENT(IN) :: OSEDI ! Switch to activate the
+ ! cloud crystal sedimentation
+LOGICAL, INTENT(IN) :: ORAIN ! Switch to activate the
+ ! raindrop formation
+LOGICAL, INTENT(IN) :: OWARM ! Control of the rain formation
+ ! by slow warm microphysical
+ ! processes
+LOGICAL, INTENT(IN) :: OHHONI! enable haze freezing
+LOGICAL, INTENT(IN) :: OCONVHG! Switch for conversion from
+ ! hail to graupel
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux solid mixing ratio
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! evap profile
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRC3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRS3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRG3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRH3D ! sed flux of precip
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSOLORG ![%] solubility fraction of soa
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PMI
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDC ! Cloud sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDR ! Rain sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDS ! Snow sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDG ! Graupel sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDH ! Hail sedimentation speed
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSUPSAT !sursat
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNACT !concentrtaion d'aérosols activés au temps t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNPRO !concentrtaion d'aérosols activés au temps t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSSPRO !sursat
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR ! Rain fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HRC !HighLow liquid content
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HCF !HighLow liquid cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HRI !HighLow ice content
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HCF !HighLow ice clous fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
+!
+END SUBROUTINE RESOLVED_CLOUD
+END INTERFACE
+END MODULE MODI_RESOLVED_CLOUD
+!
+! ##########################################################################
+ SUBROUTINE RESOLVED_CLOUD ( HCLOUD, HACTCCN, HSCONV, HMF_CLOUD, &
+ KRR, KSPLITR, KSPLITG, KMI, KTCOUNT, &
+ HLBCX, HLBCY, TPFILE, HRAD, HTURBDIM, &
+ OSUBG_COND, OSIGMAS, HSUBG_AUCV, &
+ PTSTEP, PZZ, PRHODJ, PRHODREF, PEXNREF, &
+ PPABST, PTHT, PRT, PSIGS, PSIGQSAT, PMFCONV, &
+ PTHM, PRCM, PPABSM, &
+ PW_ACT,PDTHRAD, PTHS, PRS, PSVT, PSVS, PSRCS, PCLDFR,&
+ PCIT, OSEDIC, OACTIT, OSEDC, OSEDI, &
+ ORAIN, OWARM, OHHONI, OCONVHG, &
+ PCF_MF,PRC_MF, PRI_MF, &
+ PINPRC,PINPRC3D,PINPRR,PINPRR3D, PEVAP3D, &
+ PINPRS,PINPRS3D,PINPRG,PINPRG3D,PINPRH,PINPRH3D, &
+ PSOLORG,PMI, &
+ PSPEEDC, PSPEEDR, PSPEEDS, PSPEEDG, PSPEEDH, &
+ PINDEP, PSUPSAT, PNACT, PNPRO,PSSPRO, PRAINFR, &
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
+ PSEA,PTOWN )
+! ##########################################################################
+!
+!!**** * - compute the resolved clouds and precipitation
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the microphysical sources
+!! related to the resolved clouds and precipitation
+!!
+!!
+!!** METHOD
+!! ------
+!! The main actions of this routine is to call the routines computing the
+!! microphysical sources. Before that:
+!! - it computes the real absolute pressure,
+!! - negative values of the current guess of all mixing ratio are removed.
+!! This is done by a global filling algorithm based on a multiplicative
+!! method (Rood, 1987), in order to conserved the total mass in the
+!! simulation domain.
+!! - Sources are transformed in physical tendencies, by removing the
+!! multiplicative term Rhod*J.
+!! - External points values are filled owing to the use of cyclic
+!! l.b.c., in order to performe computations on the full domain.
+!! After calling to microphysical routines, the physical tendencies are
+!! switched back to prognostic variables.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! Subroutine SLOW_TERMS: Computes the explicit microphysical sources
+!! Subroutine FAST_TERMS: Performs the saturation adjustment for l
+!! Subroutine RAIN_ICE : Computes the explicit microphysical sources for i
+!! Subroutine ICE_ADJUST: Performs the saturation adjustment for i+l
+!! MIN_ll,SUM3D_ll : distributed functions equivalent to MIN and SUM
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS : contains declarations of parameter variables
+!! JPHEXT : Horizontal external points number
+!! JPVEXT : Vertical external points number
+!! Module MODD_CST
+!! XP00 ! Reference pressure
+!! XRD ! Gaz constant for dry air
+!! XCPD ! Cpd (dry air)
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book1 and book2 of documentation ( routine RESOLVED_CLOUD )
+!!
+!! AUTHOR
+!! ------
+!! E. Richard * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 21/12/94
+!! Modifications: June 8, 1995 ( J.Stein )
+!! Cleaning to improve efficienty and clarity
+!! in agreement with the MESO-NH coding norm
+!! March 1, 1996 ( J.Stein )
+!! store the cloud fraction
+!! March 18, 1996 ( J.Stein )
+!! check that ZMASSPOS /= 0
+!! Oct. 12, 1996 ( J.Stein )
+!! remove the negative values correction
+!! for the KES2 case
+!! Modifications: Dec 14, 1995 (J.-P. Pinty)
+!! Add the mixed-phase option
+!! Modifications: Jul 01, 1996 (J.-P. Pinty)
+!! Change arg. list in routine FAST_TERMS
+!! Modifications: Jan 27, 1997 (J.-P. Pinty)
+!! add W and SV in arg. list
+!! Modifications: March 23, 98 (E.Richard)
+!! correction of negative value based on
+!! rv+rc+ri and thetal or thetail conservation
+!! Modifications: April 08, 98 (J.-P. Lafore and V. Ducrocq )
+!! modify the correction of negative values
+!! Modifications: June 08, 00 (J.-P. Pinty and J.-M. Cohard)
+!! add the C2R2 scheme
+!! Modifications: April 08, 01 (J.-P. Pinty)
+!! add the C3R5 scheme
+!! Modifications: July 21, 01 (J.-P. Pinty)
+!! Add OHHONI and PW_ACT (for haze freezing)
+!! Modifications: Sept 21, 01 (J.-P. Pinty)
+!! Add XCONC_CCN limitation
+!! Modifications: Nov 21, 02 (J.-P. Pinty)
+!! Add ICE4 and C3R5 options
+!! June, 2005 (V. Masson)
+!! Technical change in interface for scalar arguments
+!! Modifications : March, 2006 (O.Geoffroy)
+!! Add KHKO scheme
+!! Modifications : March 2013 (O.Thouron)
+!! Add prognostic supersaturation
+!! July, 2015 (O.Nuissier/F.Duffourg) Add microphysics diagnostic for
+!! aircraft, ballon and profiler
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! M.Mazoyer : 04/2016 : Temperature radiative tendency used for
+!! activation by cooling (OACTIT)
+!! Modification 01/2016 (JP Pinty) Add LIMA
+!! 10/2016 M.Mazoyer New KHKO output fields
+!! 10/2016 (C.Lac) Add droplet deposition
+!! S.Riette : 11/2016 : ice_adjust before and after rain_ice
+!! ICE3/ICE4 modified, old version under LRED=F
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 01/02/2019: ZRSMIN is now allocatable (instead of size of XRTMIN which was sometimes not allocated)
+! C. Lac 02/2019: add rain fraction as an output field
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! B. Vie 03/2020: LIMA negativity checks after turbulence, advection and microphysics budgets
+! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation
+! P. Wautelet 11/06/2020: bugfix: correct ZSVS array indices
+! P. Wautelet 11/06/2020: bugfix: add "Non local correction for precipitating species" for ICE4
+! P. Wautelet + Benoit Vié 06/2020: improve removal of negative scalar variables + adapt the corresponding budgets
+! P. Wautelet 23/06/2020: remove ZSVS and ZSVT to improve code readability
+! P. Wautelet 30/06/2020: move removal of negative scalar variables to Sources_neg_correct
+! P. Wautelet 30/06/2020: remove non-local corrections
+! B. Vie 06/2020: add prognostic supersaturation for LIMA
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODD_BUDGET, ONLY: TBUDGETS
+USE MODD_CH_AEROSOL, ONLY: LORILAM
+USE MODD_DUST, ONLY: LDUST
+use modd_cst, only: xcpd, xrd, xp00, xrholw
+USE MODD_DUST , ONLY: LDUST
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_NSV, ONLY: 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
+USE MODD_PARAM_C2R2, ONLY: LSUPSAT
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
+USE MODD_PARAM_ICE, ONLY: CSEDIM, LADJ_BEFORE, LADJ_AFTER, CFRAC_ICE_ADJUST, LRED
+USE MODD_PARAM_LIMA, ONLY: LADJ, LCOLD, LPTSPLIT, LSPRO, NMOD_CCN, NMOD_IFN, NMOD_IMM
+USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
+USE MODD_SALT, ONLY: LSALT
+USE MODD_TURB_n, ONLY: CSUBG_AUCV_RI, CCONDENS, CLAMBDA3, CSUBG_MF_PDF
+!
+USE MODE_ll
+use mode_sources_neg_correct, only: Sources_neg_correct
+!
+USE MODI_C2R2_ADJUST
+USE MODI_FAST_TERMS
+USE MODI_GET_HALO
+USE MODI_ICE_ADJUST
+USE MODI_KHKO_NOTADJUST
+USE MODI_LIMA
+USE MODI_LIMA_ADJUST
+USE MODI_LIMA_ADJUST_SPLIT
+USE MODI_LIMA_COLD
+USE MODI_LIMA_MIXED
+USE MODI_LIMA_NOTADJUST
+USE MODI_LIMA_WARM
+USE MODI_RAIN_C2R2_KHKO
+USE MODI_RAIN_ICE_RED
+USE MODI_SHUMAN
+USE MODI_SLOW_TERMS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+!
+CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! kind of cloud paramerization
+CHARACTER(LEN=4), INTENT(IN) :: HACTCCN ! kind of CCN activation scheme
+CHARACTER(LEN=4), INTENT(IN) :: HSCONV ! Shallow convection scheme
+CHARACTER(LEN=4), INTENT(IN) :: HMF_CLOUD! Type of statistical cloud
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
+ ! integrations for rain sedimendation
+INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
+ ! integrations for ice sedimendation
+INTEGER, INTENT(IN) :: KMI ! Model index
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Dimensionality of the
+ ! turbulence scheme
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid Cond.
+LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
+ ! use values computed in CONDENSATION
+ ! or that from turbulence scheme
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV
+ ! Kind of Subgrid autoconversion method
+REAL, INTENT(IN) :: PTSTEP ! Time step :XTSTEP in namelist
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ !Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference dry air density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PRT ! Moist variables at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
+REAL, INTENT(IN) :: PSIGQSAT! coeff applied to qsat variance contribution
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure time t-Dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at time t-Dt
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_ACT ! W for CCN activation
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD! THeta RADiative Tendancy
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable sources
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Scalar variable at time t
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable sources
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice number
+ ! concentration at time t
+LOGICAL, INTENT(IN) :: OSEDIC! Switch to activate the
+ ! cloud droplet sedimentation
+ ! for ICE3
+LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
+ ! activation through temp.
+ ! evolution in C2R2 and KHKO
+LOGICAL, INTENT(IN) :: OSEDC ! Switch to activate the
+ ! cloud droplet sedimentation
+LOGICAL, INTENT(IN) :: OSEDI ! Switch to activate the
+ ! cloud crystal sedimentation
+LOGICAL, INTENT(IN) :: ORAIN ! Switch to activate the
+ ! raindrop formation
+LOGICAL, INTENT(IN) :: OWARM ! Control of the rain formation
+ ! by slow warm microphysical
+ ! processes
+LOGICAL, INTENT(IN) :: OHHONI! enable haze freezing
+LOGICAL, INTENT(IN) :: OCONVHG! Switch for conversion from
+ ! hail to graupel
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux solid mixing ratio
+!
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! evap profile
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRC3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRS3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRG3D ! sed flux of precip
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRH3D ! sed flux of precip
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSOLORG ![%] solubility fraction of soa
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PMI
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDC ! Cloud sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDR ! Rain sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDS ! Snow sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDG ! Graupel sedimentation speed
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDH ! Hail sedimentation speed
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSUPSAT !sursat
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNACT !concentrtaion d'aérosols activés au temps t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNPRO !concentrtaion d'aérosols activés au temps t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSSPRO !sursat
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR ! Rain fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HRC !HighLow liquid content
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HCF !HighLow liquid cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HRI !HighLow ice content
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HCF !HighLow ice clous fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
+!
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: JRR,JSV ! Loop index for the moist and scalar variables
+INTEGER :: IIB ! Define the physical domain
+INTEGER :: IIE !
+INTEGER :: IJB !
+INTEGER :: IJE !
+INTEGER :: IKB !
+INTEGER :: IKE !
+INTEGER :: IKU
+INTEGER :: IINFO_ll ! return code of parallel routine
+INTEGER :: JK,JI,JL
+!
+!
+!
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZDZZ
+real, dimension(:,:,:), allocatable :: ZEXN
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZZZ
+ ! model layer height
+! REAL :: ZMASSTOT ! total mass for one water category
+! ! including the negative values
+! REAL :: ZMASSPOS ! total mass for one water category
+! ! after removing the negative values
+! REAL :: ZRATIO ! ZMASSTOT / ZMASSCOR
+!
+INTEGER :: ISVBEG ! first scalar index for microphysics
+INTEGER :: ISVEND ! last scalar index for microphysics
+REAL, DIMENSION(:), ALLOCATABLE :: ZRSMIN ! Minimum value for tendencies
+LOGICAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: LLMICRO ! mask to limit computation
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3), KRR) :: ZFPR
+!
+INTEGER :: JMOD, JMOD_IFN
+LOGICAL :: GWEST,GEAST,GNORTH,GSOUTH
+! 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
+ZSIGQSAT2D(:,:) = PSIGQSAT
+!
+!------------------------------------------------------------------------------
+!
+!* 1. PRELIMINARY COMPUTATIONS
+! ------------------------
+!
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB=1+JPVEXT
+IKE=SIZE(PZZ,3) - JPVEXT
+IKU=SIZE(PZZ,3)
+!
+GWEST = LWEST_ll()
+GEAST = LEAST_ll()
+GSOUTH = LSOUTH_ll()
+GNORTH = LNORTH_ll()
+!
+IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO') THEN
+ ISVBEG = NSV_C2R2BEG
+ ISVEND = NSV_C2R2END
+ELSE IF (HCLOUD == 'C3R5') THEN
+ ISVBEG = NSV_C2R2BEG
+ ISVEND = NSV_C1R3END
+ELSE IF (HCLOUD == 'LIMA') THEN
+ ISVBEG = NSV_LIMA_BEG
+ ISVEND = NSV_LIMA_END
+ELSE
+ ISVBEG = 0
+ ISVEND = -1
+END IF
+!
+IF (HCLOUD(1:3)=='ICE' .AND. LRED) THEN
+ ALLOCATE(ZRSMIN(SIZE(XRTMIN)))
+ ZRSMIN(:) = XRTMIN(:) / PTSTEP
+END IF
+!
+!* 2. TRANSFORMATION INTO PHYSICAL TENDENCIES
+! ---------------------------------------
+!
+PTHS(:,:,:) = PTHS(:,:,:) / PRHODJ(:,:,:)
+DO JRR = 1,KRR
+ PRS(:,:,:,JRR) = PRS(:,:,:,JRR) / PRHODJ(:,:,:)
+END DO
+!
+IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN
+ DO JSV = ISVBEG, ISVEND
+ PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) / PRHODJ(:,:,:)
+ ENDDO
+ENDIF
+!
+! complete the lateral boundaries to avoid possible problems
+!
+DO JI=1,JPHEXT
+ PTHS(JI,:,:) = PTHS(IIB,:,:)
+ PTHS(IIE+JI,:,:) = PTHS(IIE,:,:)
+ PTHS(:,JI,:) = PTHS(:,IJB,:)
+ PTHS(:,IJE+JI,:) = PTHS(:,IJE,:)
+!
+ PRS(JI,:,:,:) = PRS(IIB,:,:,:)
+ PRS(IIE+JI,:,:,:) = PRS(IIE,:,:,:)
+ PRS(:,JI,:,:) = PRS(:,IJB,:,:)
+ PRS(:,IJE+JI,:,:) = PRS(:,IJE,:,:)
+END DO
+!
+! complete the physical boundaries to avoid some computations
+!
+IF(GWEST .AND. HLBCX(1) /= 'CYCL') PRT(:IIB-1,:,:,2:) = 0.0
+IF(GEAST .AND. HLBCX(2) /= 'CYCL') PRT(IIE+1:,:,:,2:) = 0.0
+IF(GSOUTH .AND. HLBCY(1) /= 'CYCL') PRT(:,:IJB-1,:,2:) = 0.0
+IF(GNORTH .AND. HLBCY(2) /= 'CYCL') PRT(:,IJE+1:,:,2:) = 0.0
+!
+IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN
+DO JI=1,JPHEXT
+ PSVS(JI, :, :, ISVBEG:ISVEND) = PSVS(IIB, :, :, ISVBEG:ISVEND)
+ PSVS(IIE+JI, :, :, ISVBEG:ISVEND) = PSVS(IIE, :, :, ISVBEG:ISVEND)
+ PSVS(:, JI, :, ISVBEG:ISVEND) = PSVS(:, IJB, :, ISVBEG:ISVEND)
+ PSVS(:, IJE+JI, :, ISVBEG:ISVEND) = PSVS(:, IJE, :, ISVBEG:ISVEND)
+END DO
+ !
+! complete the physical boundaries to avoid some computations
+!
+ IF(GWEST .AND. HLBCX(1) /= 'CYCL') PSVT(:IIB-1, :, :, ISVBEG:ISVEND) = 0.0
+ IF(GEAST .AND. HLBCX(2) /= 'CYCL') PSVT(IIE+1:, :, :, ISVBEG:ISVEND) = 0.0
+ IF(GSOUTH .AND. HLBCY(1) /= 'CYCL') PSVT(:, :IJB-1, :, ISVBEG:ISVEND) = 0.0
+ IF(GNORTH .AND. HLBCY(2) /= 'CYCL') PSVT(:, IJE+1:, :, ISVBEG:ISVEND) = 0.0
+ENDIF
+!
+! complete the vertical boundaries
+!
+PTHS(:,:,IKB-1) = PTHS(:,:,IKB)
+PTHS(:,:,IKE+1) = PTHS(:,:,IKE)
+!
+PRS(:,:,IKB-1,:) = PRS(:,:,IKB,:)
+PRS(:,:,IKE+1,:) = PRS(:,:,IKE,:)
+!
+PRT(:,:,IKB-1,:) = PRT(:,:,IKB,:)
+PRT(:,:,IKE+1,:) = PRT(:,:,IKE,:)
+!
+IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO' &
+ .OR. HCLOUD == 'LIMA') THEN
+ PSVS(:,:,IKB-1,ISVBEG:ISVEND) = PSVS(:,:,IKB,ISVBEG:ISVEND)
+ PSVS(:,:,IKE+1,ISVBEG:ISVEND) = PSVS(:,:,IKE,ISVBEG:ISVEND)
+ PSVT(:,:,IKB-1,ISVBEG:ISVEND) = PSVT(:,:,IKB,ISVBEG:ISVEND)
+ PSVT(:,:,IKE+1,ISVBEG:ISVEND) = PSVT(:,:,IKE,ISVBEG:ISVEND)
+ENDIF
+!
+!
+!* 3. REMOVE NEGATIVE VALUES
+! ----------------------
+!
+!* 3.1 Non local correction for precipitating species (Rood 87)
+!
+! IF ( HCLOUD == 'KESS' &
+! .OR. HCLOUD == 'ICE3' .OR. HCLOUD == 'ICE4' &
+! .OR. HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' &
+! .OR. HCLOUD == 'KHKO' .OR. HCLOUD == 'LIMA' ) THEN
+! !
+! DO JRR = 3,KRR
+! SELECT CASE (JRR)
+! CASE(3,5,6,7) ! rain, snow, graupel and hail
+!
+! IF ( MIN_ll( PRS(:,:,:,JRR), IINFO_ll) < 0.0 ) THEN
+! !
+! ! compute the total water mass computation
+! !
+! ZMASSTOT = MAX( 0. , SUM3D_ll( PRS(:,:,:,JRR), IINFO_ll ) )
+! !
+! ! remove the negative values
+! !
+! PRS(:,:,:,JRR) = MAX( 0., PRS(:,:,:,JRR) )
+! !
+! ! compute the new total mass
+! !
+! ZMASSPOS = MAX(XMNH_TINY,SUM3D_ll( PRS(:,:,:,JRR), IINFO_ll ) )
+! !
+! ! correct again in such a way to conserve the total mass
+! !
+! ZRATIO = ZMASSTOT / ZMASSPOS
+! PRS(:,:,:,JRR) = PRS(:,:,:,JRR) * ZRATIO
+! !
+! END IF
+! END SELECT
+! END DO
+! END IF
+!
+!* 3.2 Adjustement for liquid and solid cloud
+!
+! Remove non-physical negative values (unnecessary in a perfect world) + corresponding budgets
+call Sources_neg_correct( hcloud, 'NEGA', krr, ptstep, ppabst, ptht, prt, pths, prs, psvs, prhodj )
+!
+!* 3.4 Limitations of Na and Nc to the CCN max number concentration
+!
+! Commented by O.Thouron 03/2013
+!IF ((HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO') &
+! .AND.(XCONC_CCN > 0)) THEN
+! IF ((HACTCCN /= 'ABRK')) THEN
+! ZSVT(:,:,:,1) = MIN( ZSVT(:,:,:,1),XCONC_CCN )
+! ZSVT(:,:,:,2) = MIN( ZSVT(:,:,:,2),XCONC_CCN )
+! ZSVS(:,:,:,1) = MIN( ZSVS(:,:,:,1),XCONC_CCN )
+! ZSVS(:,:,:,2) = MIN( ZSVS(:,:,:,2),XCONC_CCN )
+! END IF
+!END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+SELECT CASE ( HCLOUD )
+ CASE ('REVE')
+!
+!* 4. REVERSIBLE MICROPHYSICAL SCHEME
+! -------------------------------
+!
+ CALL FAST_TERMS ( KRR, KMI, HRAD, HTURBDIM, &
+ HSCONV, HMF_CLOUD, OSUBG_COND, PTSTEP, &
+ PRHODJ, PSIGS, PPABST, &
+ PCF_MF,PRC_MF, &
+ PRVT=PRT(:,:,:,1), PRCT=PRT(:,:,:,2), &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR )
+!
+ CASE ('KESS')
+!
+!* 5. KESSLER MICROPHYSICAL SCHEME
+! ----------------------------
+!
+!
+!* 5.1 Compute the explicit microphysical sources
+!
+ CALL SLOW_TERMS ( KSPLITR, PTSTEP, KMI, HSUBG_AUCV, &
+ PZZ, PRHODJ, PRHODREF, PCLDFR, &
+ PTHT, PRT(:,:,:,1), PRT(:,:,:,2), PRT(:,:,:,3), PPABST, &
+ PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
+ PINPRR, PINPRR3D, PEVAP3D )
+!
+!* 5.2 Perform the saturation adjustment
+!
+ CALL FAST_TERMS ( KRR, KMI, HRAD, HTURBDIM, &
+ HSCONV, HMF_CLOUD, OSUBG_COND, PTSTEP, &
+ PRHODJ, PSIGS, PPABST, &
+ PCF_MF,PRC_MF, &
+ PRVT=PRT(:,:,:,1), PRCT=PRT(:,:,:,2), &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), PRRS=PRS(:,:,:,3), &
+ PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR )
+!
+!
+ CASE ('C2R2','KHKO')
+!
+!* 7. 2-MOMENT WARM MICROPHYSICAL SCHEME C2R2 or KHKO
+! ---------------------------------------
+!
+!
+!* 7.1 Compute the explicit microphysical sources
+!
+!
+ CALL RAIN_C2R2_KHKO ( HCLOUD, OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
+ TPFILE, PZZ, PRHODJ, PRHODREF, PEXNREF, &
+ PPABST, PTHT, PRT(:,:,:,1), PRT(:,:,:,2), PRT(:,:,:,3), &
+ PTHM, PRCM, PPABSM, &
+ PW_ACT,PDTHRAD,PTHS, PRS(:,:,:,1),PRS(:,:,:,2),PRS(:,:,:,3), &
+ PSVT(:,:,:,NSV_C2R2BEG), PSVT(:,:,:,NSV_C2R2BEG+1), &
+ PSVT(:,:,:,NSV_C2R2BEG+2), PSVS(:,:,:,NSV_C2R2BEG), &
+ PSVS(:,:,:,NSV_C2R2BEG+1), PSVS(:,:,:,NSV_C2R2BEG+2), &
+ PINPRC, PINPRR, PINPRR3D, PEVAP3D , &
+ PSVT(:,:,:,:), PSOLORG, PMI, HACTCCN, &
+ PINDEP, PSUPSAT, PNACT )
+!
+!
+!* 7.2 Perform the saturation adjustment
+!
+ IF (LSUPSAT) THEN
+ CALL KHKO_NOTADJUST (KRR, KTCOUNT,TPFILE, HRAD, &
+ PTSTEP, PRHODJ, PPABSM, PPABST, PRHODREF, PZZ, &
+ PTHT,PRT(:,:,:,1),PRT(:,:,:,2),PRT(:,:,:,3), &
+ PTHS,PRS(:,:,:,1),PRS(:,:,:,2),PRS(:,:,:,3), &
+ PSVS(:,:,:,NSV_C2R2BEG+1), PSVS(:,:,:,NSV_C2R2BEG), &
+ PSVS(:,:,:,NSV_C2R2BEG+3), PCLDFR, PSRCS, PNPRO, PSSPRO )
+!
+ ELSE
+ CALL C2R2_ADJUST ( KRR,TPFILE, HRAD, &
+ HTURBDIM, OSUBG_COND, PTSTEP, &
+ PRHODJ, PSIGS, PPABST, &
+ PTHS=PTHS, PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PCNUCS=PSVS(:,:,:,NSV_C2R2BEG), &
+ PCCS=PSVS(:,:,:,NSV_C2R2BEG+1), &
+ PSRCS=PSRCS, PCLDFR=PCLDFR, PRRS=PRS(:,:,:,3) )
+!
+ END IF
+!
+ CASE ('ICE3')
+!
+!* 9. MIXED-PHASE MICROPHYSICAL SCHEME (WITH 3 ICE SPECIES)
+! -----------------------------------------------------
+!
+ allocate( zexn( size( pzz, 1 ), size( pzz, 2 ), size( pzz, 3 ) ) )
+ ZEXN(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
+!
+!* 9.1 Compute the explicit microphysical sources
+!
+!
+ DO JK=IKB,IKE
+ ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK)
+ ENDDO
+ ZZZ = MZF( PZZ )
+ IF(LRED .AND. LADJ_BEFORE) THEN
+ CALL ICE_ADJUST (1, IKU, 1, KRR, CFRAC_ICE_ADJUST, CCONDENS, CLAMBDA3, &
+ 'ADJU', OSUBG_COND, OSIGMAS, .FALSE., CSUBG_MF_PDF, &
+ PTSTEP, ZSIGQSAT2D, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABST, ZZZ, &
+ ZEXN, PCF_MF, PRC_MF, PRI_MF, &
+ PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PTH=PTHS*PTSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
+ PRR=PRS(:,:,:,3)*PTSTEP, &
+ PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
+ PRS=PRS(:,:,:,5)*PTSTEP, &
+ PRG=PRS(:,:,:,6)*PTSTEP, &
+ TBUDGETS=TBUDGETS,KBUDGETS=SIZE(TBUDGETS), &
+ PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
+ PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
+ ENDIF
+ IF (LRED) THEN
+ LLMICRO(:,:,:)=PRT(:,:,:,2)>XRTMIN(2) .OR. &
+ PRT(:,:,:,3)>XRTMIN(3) .OR. &
+ PRT(:,:,:,4)>XRTMIN(4) .OR. &
+ PRT(:,:,:,5)>XRTMIN(5) .OR. &
+ PRT(:,:,:,6)>XRTMIN(6)
+ LLMICRO(:,:,:)=LLMICRO(:,:,:) .OR. &
+ PRS(:,:,:,2)>ZRSMIN(2) .OR. &
+ PRS(:,:,:,3)>ZRSMIN(3) .OR. &
+ PRS(:,:,:,4)>ZRSMIN(4) .OR. &
+ PRS(:,:,:,5)>ZRSMIN(5) .OR. &
+ PRS(:,:,:,6)>ZRSMIN(6)
+ CALL RAIN_ICE_RED (COUNT(LLMICRO), SIZE(PTHT, 1), SIZE(PTHT, 2), &
+ SIZE(PTHT, 3), COUNT(LLMICRO), &
+ OSEDIC, .FALSE.,CSEDIM, HSUBG_AUCV, CSUBG_AUCV_RI,&
+ OWARM,1,IKU,1, &
+ PTSTEP, KRR, LLMICRO, ZEXN, &
+ ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT,PCLDFR,&
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
+ PTHT, PRT(:,:,:,1), PRT(:,:,:,2), &
+ PRT(:,:,:,3), PRT(:,:,:,4), &
+ PRT(:,:,:,5), PRT(:,:,:,6), &
+ PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
+ PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
+ PINPRC,PINPRR, PEVAP3D, &
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, &
+ TBUDGETS,SIZE(TBUDGETS), &
+ PSEA,PTOWN, PFPR=ZFPR )
+ ELSE
+ CALL RAIN_ICE_RED (COUNT(LLMICRO), SIZE(PTHT, 1), SIZE(PTHT, 2), &
+ SIZE(PTHT, 3), COUNT(LLMICRO), &
+ OSEDIC, .FALSE.,CSEDIM, HSUBG_AUCV, CSUBG_AUCV_RI,&
+ OWARM,1,IKU,1, &
+ PTSTEP, KRR, LLMICRO, 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 )
+ END IF
+!
+!* 9.2 Perform the saturation adjustment over cloud ice and cloud water
+!
+!
+ IF (.NOT. LRED .OR. (LRED .AND. LADJ_AFTER) ) THEN
+ CALL ICE_ADJUST (1, IKU, 1, KRR, CFRAC_ICE_ADJUST, CCONDENS, CLAMBDA3, &
+ 'DEPI', OSUBG_COND, OSIGMAS, .FALSE.,CSUBG_MF_PDF, &
+ PTSTEP, ZSIGQSAT2D, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABST, ZZZ, &
+ ZEXN, PCF_MF, PRC_MF, PRI_MF, &
+ PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PTH=PTHS*PTSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
+ PRR=PRS(:,:,:,3)*PTSTEP, &
+ PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
+ PRS=PRS(:,:,:,5)*PTSTEP, &
+ PRG=PRS(:,:,:,6)*PTSTEP, &
+ TBUDGETS=TBUDGETS,KBUDGETS=SIZE(TBUDGETS), &
+ PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
+ PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
+ END IF
+
+ deallocate( zexn )
+!
+ CASE ('ICE4')
+!
+!* 10. MIXED-PHASE MICROPHYSICAL SCHEME (WITH 4 ICE SPECIES)
+! -----------------------------------------------------
+!
+ allocate( zexn( size( pzz, 1 ), size( pzz, 2 ), size( pzz, 3 ) ) )
+ ZEXN(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
+!
+!* 10.1 Compute the explicit microphysical sources
+!
+!
+ DO JK=IKB,IKE
+ ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK)
+ ENDDO
+ ZZZ = MZF( PZZ )
+ IF(LRED .AND. LADJ_BEFORE) THEN
+ CALL ICE_ADJUST (1, IKU, 1, KRR, CFRAC_ICE_ADJUST, CCONDENS, CLAMBDA3, &
+ 'ADJU', OSUBG_COND, OSIGMAS, .FALSE., CSUBG_MF_PDF, &
+ PTSTEP, ZSIGQSAT2D, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABST, ZZZ, &
+ ZEXN, PCF_MF, PRC_MF, PRI_MF, &
+ PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PTH=PTHS*PTSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
+ PRR=PRS(:,:,:,3)*PTSTEP, &
+ PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
+ PRS=PRS(:,:,:,5)*PTSTEP, &
+ PRG=PRS(:,:,:,6)*PTSTEP, &
+ TBUDGETS=TBUDGETS,KBUDGETS=SIZE(TBUDGETS), &
+ PRH=PRS(:,:,:,7)*PTSTEP, &
+ PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
+ PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
+ ENDIF
+ IF (LRED) THEN
+ LLMICRO(:,:,:)=PRT(:,:,:,2)>XRTMIN(2) .OR. &
+ PRT(:,:,:,3)>XRTMIN(3) .OR. &
+ PRT(:,:,:,4)>XRTMIN(4) .OR. &
+ PRT(:,:,:,5)>XRTMIN(5) .OR. &
+ PRT(:,:,:,6)>XRTMIN(6) .OR. &
+ PRT(:,:,:,7)>XRTMIN(7)
+ LLMICRO(:,:,:)=LLMICRO(:,:,:) .OR. &
+ PRS(:,:,:,2)>ZRSMIN(2) .OR. &
+ PRS(:,:,:,3)>ZRSMIN(3) .OR. &
+ PRS(:,:,:,4)>ZRSMIN(4) .OR. &
+ PRS(:,:,:,5)>ZRSMIN(5) .OR. &
+ PRS(:,:,:,6)>ZRSMIN(6) .OR. &
+ PRS(:,:,:,7)>ZRSMIN(7)
+ CALL RAIN_ICE_RED (COUNT(LLMICRO), SIZE(PTHT, 1), SIZE(PTHT, 2), SIZE(PTHT, 3),&
+ COUNT(LLMICRO), OSEDIC, .FALSE., CSEDIM, HSUBG_AUCV, CSUBG_AUCV_RI,&
+ OWARM, 1, IKU, 1, &
+ PTSTEP, KRR, LLMICRO, ZEXN, &
+ ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF,&
+ PTHT, PRT(:,:,:,1), PRT(:,:,:,2), &
+ PRT(:,:,:,3), PRT(:,:,:,4), &
+ PRT(:,:,:,5), PRT(:,:,:,6), &
+ PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
+ PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
+ PINPRC, PINPRR, PEVAP3D, &
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, &
+ TBUDGETS,SIZE(TBUDGETS), &
+ PSEA, PTOWN, &
+ PRT(:,:,:,7), PRS(:,:,:,7), PINPRH, PFPR=ZFPR )
+
+ ELSE
+ CALL RAIN_ICE_RED (COUNT(LLMICRO), SIZE(PTHT, 1), SIZE(PTHT, 2), SIZE(PTHT, 3),&
+ COUNT(LLMICRO), OSEDIC, .FALSE., CSEDIM, HSUBG_AUCV, CSUBG_AUCV_RI,&
+ OWARM, 1, IKU, 1, &
+ PTSTEP, KRR, LLMICRO, 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 )
+ 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 (1, IKU, 1, KRR, CFRAC_ICE_ADJUST, CCONDENS, CLAMBDA3, &
+ 'DEPI', OSUBG_COND, OSIGMAS, .FALSE., CSUBG_MF_PDF, &
+ PTSTEP, ZSIGQSAT2D, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABST, ZZZ, &
+ ZEXN, PCF_MF, PRC_MF, PRI_MF, &
+ PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PTH=PTHS*PTSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
+ PRR=PRS(:,:,:,3)*PTSTEP, &
+ PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
+ PRS=PRS(:,:,:,5)*PTSTEP, &
+ PRG=PRS(:,:,:,6)*PTSTEP, &
+ TBUDGETS=TBUDGETS,KBUDGETS=SIZE(TBUDGETS), &
+ PRH=PRS(:,:,:,7)*PTSTEP, &
+ PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
+ PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
+ END IF
+
+ deallocate( zexn )
+!
+!
+!* 12. 2-MOMENT MIXED-PHASE MICROPHYSICAL SCHEME LIMA
+! --------------------------------------------------------------
+!
+!
+!* 12.1 Compute the explicit microphysical sources
+!
+ CASE ('LIMA')
+ !
+ DO JK=IKB,IKE
+ ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK)
+ ENDDO
+ ZZZ = MZF( PZZ )
+ IF (LPTSPLIT) THEN
+ CALL LIMA (1, IKU, 1, &
+ PTSTEP, TPFILE, &
+ PRHODREF, PEXNREF, ZDZZ, &
+ PRHODJ, PPABSM, 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, ZICEFR, ZPRCFR )
+ ELSE
+
+ IF (OWARM) CALL LIMA_WARM(OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
+ TPFILE, KRR, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PW_ACT, PPABSM, PPABST, &
+ PDTHRAD, PRCM, &
+ PTHT, PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PINPRC, PINPRR, PINDEP, PINPRR3D, PEVAP3D )
+!
+ IF (LCOLD) CALL LIMA_COLD(OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
+ KRR, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PW_ACT, &
+ PTHM, PPABSM, &
+ PTHT, PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PINPRS, PINPRG, PINPRH )
+!
+ IF (OWARM .AND. LCOLD) CALL LIMA_MIXED(OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
+ KRR, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PW_ACT, &
+ PTHM, PPABSM, &
+ 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, PPABSM, PPABST, PRHODREF, PEXNREF, PZZ, &
+ PTHT,PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS,PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PCLDFR, PSRCS )
+ ELSE IF (LPTSPLIT) THEN
+ CALL LIMA_ADJUST_SPLIT(KRR, KMI, TPFILE, CCONDENS, CLAMBDA3, &
+ OSUBG_COND, OSIGMAS, PTSTEP, PSIGQSAT, &
+ PRHODREF, PRHODJ, PEXNREF, PPABST, PSIGS, PMFCONV, PPABST, ZZZ, &
+ PDTHRAD, PW_ACT, &
+ PRT, PRS, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS, PSRCS, PCLDFR, PRC_MF, PCF_MF )
+ ELSE
+ CALL LIMA_ADJUST(KRR, KMI, TPFILE, &
+ OSUBG_COND, PTSTEP, &
+ PRHODREF, PRHODJ, PEXNREF, PPABST, PPABST, &
+ PRT, PRS, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS, PSRCS, PCLDFR )
+ ENDIF
+!
+END SELECT
+!
+IF(HCLOUD=='ICE3' .OR. HCLOUD=='ICE4' ) THEN
+ PINPRC3D=ZFPR(:,:,:,2) / XRHOLW
+ PINPRR3D=ZFPR(:,:,:,3) / XRHOLW
+ PINPRS3D=ZFPR(:,:,:,5) / XRHOLW
+ PINPRG3D=ZFPR(:,:,:,6) / XRHOLW
+ IF(KRR==7) PINPRH3D=ZFPR(:,:,:,7) / XRHOLW
+ WHERE (PRT(:,:,:,2) > 1.E-04 )
+ PSPEEDC=ZFPR(:,:,:,2) / (PRT(:,:,:,2) * PRHODREF(:,:,:))
+ ENDWHERE
+ WHERE (PRT(:,:,:,3) > 1.E-04 )
+ PSPEEDR=ZFPR(:,:,:,3) / (PRT(:,:,:,3) * PRHODREF(:,:,:))
+ ENDWHERE
+ WHERE (PRT(:,:,:,5) > 1.E-04 )
+ PSPEEDS=ZFPR(:,:,:,5) / (PRT(:,:,:,5) * PRHODREF(:,:,:))
+ ENDWHERE
+ WHERE (PRT(:,:,:,6) > 1.E-04 )
+ PSPEEDG=ZFPR(:,:,:,6) / (PRT(:,:,:,6) * PRHODREF(:,:,:))
+ ENDWHERE
+ IF(KRR==7) THEN
+ WHERE (PRT(:,:,:,7) > 1.E-04 )
+ PSPEEDH=ZFPR(:,:,:,7) / (PRT(:,:,:,7) * PRHODREF(:,:,:))
+ ENDWHERE
+ ENDIF
+ENDIF
+
+! Remove non-physical negative values (unnecessary in a perfect world) + corresponding budgets
+call Sources_neg_correct( hcloud, 'NECON', krr, ptstep, ppabst, ptht, prt, pths, prs, psvs, prhodj )
+
+!-------------------------------------------------------------------------------
+!
+!
+!* 13. SWITCH BACK TO THE PROGNOSTIC VARIABLES
+! ---------------------------------------
+!
+PTHS(:,:,:) = PTHS(:,:,:) * PRHODJ(:,:,:)
+!
+DO JRR = 1,KRR
+ PRS(:,:,:,JRR) = PRS(:,:,:,JRR) * PRHODJ(:,:,:)
+END DO
+!
+IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN
+ DO JSV = ISVBEG, ISVEND
+ PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) * PRHODJ(:,:,:)
+ ENDDO
+ENDIF
+
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE RESOLVED_CLOUD
diff --git a/src/mesonh/ext/set_rsou.f90 b/src/mesonh/ext/set_rsou.f90
new file mode 100644
index 0000000000000000000000000000000000000000..9f7cca3e1c76de20267a8a398b309e005b804022
--- /dev/null
+++ b/src/mesonh/ext/set_rsou.f90
@@ -0,0 +1,1633 @@
+!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_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 MODE_TH_R_FROM_THL_RT_1D
+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
+!
+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))
+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_1D('T',ZFRAC_ICE,ZPRESS,ZTHLM,ZMRT,ZTHM,ZMRM,ZMRCM,ZMRIM, &
+ ZRSATW, ZRSATI,OOCEAN=.FALSE.)
+ 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)
+!-------------------------------------------------------------------------------
+!
+!* 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
+!
+END SUBROUTINE SET_RSOU
diff --git a/src/mesonh/ext/shallow_mf_pack.f90 b/src/mesonh/ext/shallow_mf_pack.f90
new file mode 100644
index 0000000000000000000000000000000000000000..5001e4bad2c8926109efca0bcc1c4cf4469ba006
--- /dev/null
+++ b/src/mesonh/ext/shallow_mf_pack.f90
@@ -0,0 +1,481 @@
+!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, &
+ HMF_UPDRAFT, HMF_CLOUD, OMIXUV, &
+ OMF_FLX,TPFILE,PTIME_LES, &
+ PIMPL_MF, PTSTEP, &
+ PDZZ, PZZ, PDX,PDY, &
+ PRHODJ, PRHODREF, &
+ PPABSM, PEXN, &
+ PSFTH,PSFRV, &
+ PTHM,PRM,PUM,PVM,PWM,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.
+CHARACTER (LEN=4), INTENT(IN) :: HMF_UPDRAFT! Type of Mass Flux Scheme
+ ! 'NONE' if no parameterization
+CHARACTER (LEN=4), INTENT(IN) :: HMF_CLOUD ! Type of statistical cloud
+ ! scheme
+LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
+LOGICAL, INTENT(IN) :: OMF_FLX ! switch to write the
+ ! MF fluxes in the synchronous FM-file
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+REAL(kind=MNHTIME),DIMENSION(2), INTENT(OUT) :: PTIME_LES ! time spent in LES computations
+REAL, INTENT(IN) :: PIMPL_MF ! degre of implicitness
+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,PWM ! 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, &
+ HMF_UPDRAFT, HMF_CLOUD, OMIXUV, &
+ OMF_FLX,TPFILE,PTIME_LES, &
+ PIMPL_MF, PTSTEP, &
+ PDZZ, PZZ, PDX,PDY, &
+ PRHODJ, PRHODREF, &
+ PPABSM, PEXN, &
+ PSFTH,PSFRV, &
+ PTHM,PRM,PUM,PVM,PWM,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_budget, only: lbudget_u, lbudget_v, lbudget_th, lbudget_rv, lbudget_sv, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_TH, NBUDGET_RV, NBUDGET_SV1, &
+ tbudgets
+USE MODD_CONF
+USE MODD_CST
+USE MODD_IO, ONLY: TFILEDATA
+use modd_field, only: tfielddata, TYPEREAL
+USE MODD_NSV
+USE MODD_PARAMETERS
+USE MODD_PARAM_ICE, ONLY: CFRAC_ICE_SHALLOW_MF
+USE MODD_PARAM_MFSHALL_n
+use modd_precision, only: MNHTIME
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+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.
+CHARACTER (LEN=4), INTENT(IN) :: HMF_UPDRAFT! Type of Mass Flux Scheme
+ ! 'NONE' if no parameterization
+CHARACTER (LEN=4), INTENT(IN) :: HMF_CLOUD ! Type of statistical cloud
+ ! scheme
+LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
+LOGICAL, INTENT(IN) :: OMF_FLX ! switch to write the
+ ! MF fluxes in the synchronous FM-file
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+REAL(kind=MNHTIME),DIMENSION(2), INTENT(OUT) :: PTIME_LES ! time spent in LES computations
+REAL, INTENT(IN) :: PIMPL_MF ! degre of implicitness
+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,PWM ! 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)) :: ZZZ ! Height of flux point
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDZZ ! Metric coefficients
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3)) :: ZRHODJ ! dry density * Grid size
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3)) :: ZRHODREF ! dry density of the
+ ! reference state
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3)) :: ZPABSM ! Pressure at time t-1
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3)) :: ZEXN ! Exner function at t-dt
+
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3)) :: ZTHM ! Theta at t-dt
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3),SIZE(PRM,4)) :: ZRM ! water var. at t-dt
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3)) :: ZUM,ZVM,ZWM ! wind components at t-dt
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3)) :: ZTKEM ! tke at t-dt
+
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3),SIZE(PSVM,4)) :: ZSVM ! scalar variable a t-dt
+
+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)) :: ZTHL_DO ! downdraft characteristics
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3)) :: ZTHV_DO ! downdraft characteristics
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3)) :: ZRT_DO ! downdraft characteristics
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3)) :: ZU_DO ! downdraft characteristics
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2),SIZE(PTHM,3)) :: ZV_DO ! downdraft 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
+INTEGER,DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2)) :: IKLCL,IKETL,IKCTL ! level of LCL,ETL and CTL
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2)) :: ZSFTH ! Surface sensible heat flux
+REAL, DIMENSION(SIZE(PTHM,1)*SIZE(PTHM,2)) :: ZSFRV ! Surface latent heat flux
+!
+!
+!* 3D arrays
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZWORK ! work array
+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
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZWMM ! wind on mass point
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDUDT ! tendency of U by massflux scheme
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDVDT ! tendency of V by massflux scheme
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDTHLDT ! tendency of thl by massflux scheme
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZDRTDT ! tendency of Rt by massflux scheme
+REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3),SIZE(PSVM,4)) :: ZDSVDT ! tendency of Sv by massflux scheme
+
+INTEGER :: IIU, IJU, IKU, IKB, IKE, IRR, ISV
+INTEGER :: JK,JRR,JSV ! Loop counters
+
+TYPE(TFIELDDATA) :: TZFIELD
+!------------------------------------------------------------------------
+
+!!! 1. Initialisation
+
+! 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)
+
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'MAFL', prus (:, :, :) )
+if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'MAFL', prvs (:, :, :) )
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'MAFL', prths(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'MAFL', prrs (:, :, :, 1) )
+if ( lbudget_sv ) then
+ do jsv = 1, isv
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'MAFL', prsvs(:, :, :, jsv) )
+ end do
+end if
+
+ZSVM(:,:,:) = 0.
+!
+!
+! wind on mass points
+ZUMM=MXF(PUM)
+ZVMM=MYF(PVM)
+ZWMM=MZF(PWM)
+!
+!!! 2. Pack input variables
+!
+DO JK=1,IKU
+ ZZZ (:,JK) = RESHAPE(PZZ (:,:,JK),(/ IIU*IJU /) )
+ ZDZZ (:,JK) = RESHAPE(PDZZ (:,:,JK),(/ IIU*IJU /) )
+ ZRHODJ (:,JK) = RESHAPE(PRHODJ (:,:,JK),(/ IIU*IJU /) )
+ ZTHM (:,JK) = RESHAPE(PTHM (:,:,JK),(/ IIU*IJU /) )
+ ZTKEM (:,JK) = RESHAPE(PTKEM (:,:,JK),(/ IIU*IJU /) )
+ ZPABSM (:,JK) = RESHAPE(PPABSM (:,:,JK),(/ IIU*IJU /) )
+ ZEXN (:,JK) = RESHAPE(PEXN (:,:,JK),(/ IIU*IJU /) )
+ ZRHODJ (:,JK) = RESHAPE(PRHODJ (:,:,JK),(/ IIU*IJU /) )
+ ZRHODREF(:,JK) = RESHAPE(PRHODREF(:,:,JK),(/ IIU*IJU /) )
+ ZUM (:,JK) = RESHAPE(ZUMM (:,:,JK),(/ IIU*IJU /) )
+ ZVM (:,JK) = RESHAPE(ZVMM (:,:,JK),(/ IIU*IJU /) )
+ ZWM (:,JK) = RESHAPE(ZWMM (:,:,JK),(/ IIU*IJU /) )
+ DO JRR=1,IRR
+ ZRM (:,JK,JRR) = RESHAPE(PRM (:,:,JK,JRR),(/ IIU*IJU /) )
+ END DO
+ DO JSV=1,ISV
+ IF (LNOMIXLG .AND. JSV >= NSV_LGBEG .AND. JSV<= NSV_LGEND) CYCLE
+ ZSVM(:,JK,JSV) = RESHAPE(PSVM (:,:,JK,JSV),(/ IIU*IJU /) )
+ END DO
+END DO
+
+ZSFTH(:)=RESHAPE(PSFTH(:,:),(/ IIU*IJU /) )
+ZSFRV(:)=RESHAPE(PSFRV(:,:),(/ IIU*IJU /) )
+
+!!! 3. Call of the physical parameterization of massflux vertical transport
+
+CALL SHALLOW_MF(1,IKU,1,KRR,KRRL,KRRI, &
+ HMF_UPDRAFT, HMF_CLOUD, CFRAC_ICE_SHALLOW_MF, OMIXUV, &
+ LNOMIXLG,NSV_LGBEG,NSV_LGEND, &
+ PIMPL_MF, PTSTEP, &
+ ZDZZ, ZZZ, &
+ ZRHODJ,ZRHODREF, &
+ ZPABSM, ZEXN, &
+ ZSFTH,ZSFRV, &
+ ZTHM,ZRM,ZUM,ZVM,ZTKEM,ZSVM, &
+ 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 )
+
+!!! 4. Unpack output variables
+
+ZDTHLDT(:,:,:)=RESHAPE(ZDTHLDT_MF(:,:),(/ IIU,IJU,IKU /) )
+ZDRTDT(:,:,:)=RESHAPE(ZDRTDT_MF(:,:),(/ IIU,IJU,IKU /) )
+ZDUDT(:,:,:)=RESHAPE(ZDUDT_MF(:,:),(/ IIU,IJU,IKU /) )
+ZDVDT(:,:,:)=RESHAPE(ZDVDT_MF(:,:),(/ IIU,IJU,IKU /) )
+PSIGMF(:,:,:)=RESHAPE(ZSIGMF(:,:),(/ IIU,IJU,IKU /) )
+PRC_MF(:,:,:)=RESHAPE(ZRC_MF(:,:),(/ IIU,IJU,IKU /) )
+PRI_MF(:,:,:)=RESHAPE(ZRI_MF(:,:),(/ IIU,IJU,IKU /) )
+PCF_MF(:,:,:)=RESHAPE(ZCF_MF(:,:),(/ IIU,IJU,IKU /) )
+PFLXZTHVMF(:,:,:)=RESHAPE(ZFLXZTHVMF(:,:),(/ IIU,IJU,IKU /) )
+DO JSV=1,ISV
+ IF (LNOMIXLG .AND. JSV >= NSV_LGBEG .AND. JSV<= NSV_LGEND) CYCLE
+ ZDSVDT(:,:,:,JSV) = RESHAPE(ZDSVDT_MF(:,:,JSV),(/ IIU,IJU,IKU /) )
+END DO
+!
+!!! 5. 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(:,:,:)
+PRRS(:,:,:,1) = PRRS(:,:,:,1) + &
+ PRHODJ(:,:,:)*ZDRTDT(:,:,:)
+PRUS(:,:,:) = PRUS(:,:,:) +MXM( &
+ PRHODJ(:,:,:)*ZDUDT(:,:,:))
+PRVS(:,:,:) = PRVS(:,:,:) +MYM( &
+ PRHODJ(:,:,:)*ZDVDT(:,:,:))
+
+DO JSV=1,ISV
+ IF (LNOMIXLG .AND. JSV >= NSV_LGBEG .AND. JSV<= NSV_LGEND) CYCLE
+ PRSVS(:,:,:,JSV) = MAX((PRSVS(:,:,:,JSV) + &
+ PRHODJ(:,:,:)*ZDSVDT(:,:,:,JSV)),XSVMIN(JSV))
+END DO
+
+!!! 7. call to MesoNH budgets
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'MAFL', prus (:, :, :) )
+if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'MAFL', prvs (:, :, :) )
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'MAFL', prths(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'MAFL', prrs (:, :, :, 1) )
+if ( lbudget_sv ) then
+ do jsv = 1, isv
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'MAFL', prsvs(:, :, :, jsv) )
+ end do
+end if
+
+!!! 8. Prints the fluxes in output file
+!
+IF ( OMF_FLX .AND. tpfile%lopened ) THEN
+ ! stores the conservative potential temperature vertical flux
+ ZWORK(:,:,:)=RESHAPE(ZFLXZTHMF (:,:),(/ IIU,IJU,IKU /) )
+ TZFIELD%CMNHNAME = 'MF_THW_FLX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'MF_THW_FLX'
+ TZFIELD%CUNITS = 'K m s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_MF_THW_FLX'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK)
+ !
+ ! stores the conservative mixing ratio vertical flux
+ ZWORK(:,:,:)=RESHAPE(ZFLXZRMF(:,:),(/ IIU,IJU,IKU /) )
+ TZFIELD%CMNHNAME = 'MF_RCONSW_FLX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'MF_RCONSW_FLX'
+ TZFIELD%CUNITS = 'K m s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_MF_RCONSW_FLX'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK)
+ !
+ ! stores the theta_v vertical flux
+ TZFIELD%CMNHNAME = 'MF_THVW_FLX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'MF_THVW_FLX'
+ TZFIELD%CUNITS = 'K m s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_MF_THVW_FLX'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PFLXZTHVMF)
+ !
+ IF (OMIXUV) THEN
+ ! stores the U momentum vertical flux
+ ZWORK(:,:,:)=RESHAPE(ZFLXZUMF(:,:),(/ IIU,IJU,IKU /) )
+ TZFIELD%CMNHNAME = 'MF_UW_FLX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'MF_UW_FLX'
+ TZFIELD%CUNITS = 'm2 s-2'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_MF_UW_FLX'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK)
+ !
+ ! stores the V momentum vertical flux
+ ZWORK(:,:,:)=RESHAPE(ZFLXZVMF(:,:),(/ IIU,IJU,IKU /) )
+ TZFIELD%CMNHNAME = 'MF_VW_FLX'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'MF_VW_FLX'
+ TZFIELD%CUNITS = 'm2 s-2'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_MF_VW_FLX'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK)
+ !
+ END IF
+END IF
+
+!!! 9. 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/micro/ice_adjust_elec.f90 b/src/mesonh/micro/ice_adjust_elec.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a52ffd2b375acda4dd911a74577409144202de0c
--- /dev/null
+++ b/src/mesonh/micro/ice_adjust_elec.f90
@@ -0,0 +1,651 @@
+!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_ICE_ADJUST_ELEC
+! ###########################
+!
+INTERFACE
+!
+ SUBROUTINE ICE_ADJUST_ELEC (KRR, KMI, HRAD, HTURBDIM, HSCONV, HMF_CLOUD, &
+ OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT, &
+ PRHODJ, PEXNREF, PSIGS, PPABST, PZZ, &
+ PMFCONV, PCF_MF, PRC_MF, PRI_MF, &
+ PRVT, PRCT, PRVS, PRCS, PTHS, PSRCS, PCLDFR , &
+ PRRT, PRRS, PRIT, PRIS, PRST, PRSS, PRGT, PRGS, &
+ PQPIT, PQPIS, PQCT, PQCS, &
+ PQRT, PQRS, PQIT, PQIS, PQST, PQSS, PQGT, PQGS, &
+ PQNIT, PQNIS, PRHT, PRHS, PQHT, PQHS )
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KMI ! Model index
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Dimensionality of the
+ ! turbulence scheme
+CHARACTER(LEN=4), INTENT(IN) :: HSCONV ! Shallow convection scheme
+CHARACTER(LEN=4), INTENT(IN) :: HMF_CLOUD! Type of statistical cloud
+CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
+ ! Condensation
+LOGICAL :: OSIGMAS ! Switch for Sigma_s:
+ ! use values computed in CONDENSATION
+ ! or that from turbulence scheme
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height of model layer
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux solid mixing ratio
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rain water m.r. at t+1
+REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRIS ! Cloud ice m.r. at t+1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRSS ! Aggregate m.r. at t+1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS ! Graupel m.r. at t+1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHS ! Hail m.r. at t+1
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQPIT ! positive ion m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQPIS ! source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQNIT ! negative ion m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQNIS ! source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQRS ! Rain water m.r. at t+1
+REAL, DIMENSION(:,:,:), INTENT(INOUT):: PQIS ! Cloud ice m.r. at t+1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQSS ! Aggregate m.r. at t+1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQGS ! Graupel m.r. at t+1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQST ! Aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQGT ! Graupel m.r. at t
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PQHT ! Hail m.r. at t
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PQHS ! Hail m.r. at t+1
+!
+END SUBROUTINE ICE_ADJUST_ELEC
+END INTERFACE
+END MODULE MODI_ICE_ADJUST_ELEC
+!
+! ########################################################################
+ SUBROUTINE ICE_ADJUST_ELEC (KRR, KMI, HRAD, HTURBDIM, HSCONV, &
+ HMF_CLOUD, OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT,&
+ PRHODJ, PEXNREF, PSIGS, PPABST, PZZ, &
+ PMFCONV, PCF_MF, PRC_MF, PRI_MF, &
+ PRVT, PRCT, PRVS, PRCS, PTHS, PSRCS, PCLDFR , &
+ PRRT, PRRS, PRIT, PRIS, PRST, PRSS, PRGT, PRGS, &
+ PQPIT, PQPIS, PQCT, PQCS, &
+ PQRT, PQRS, PQIT, PQIS, PQST, PQSS, PQGT, PQGS, &
+ PQNIT, PQNIS, PRHT, PRHS, PQHT, PQHS )
+! ########################################################################
+!
+!!**** *ICE_ADJUST_ELEC* - compute the ajustment of water vapor in mixed-phase
+!! clouds
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the fast microphysical sources
+!! through a saturation ajustement procedure in case of mixed-phase clouds.
+!!
+!!
+!!** METHOD
+!! ------
+!! Langlois, Tellus, 1973 for the cloudless version.
+!! When cloud water is taken into account, refer to book 1 of the
+!! documentation.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST
+!! XP00 ! Reference pressure
+!! XMD,XMV ! Molar mass of dry air and molar mass of vapor
+!! XRD,XRV ! Gaz constant for dry air, gaz constant for vapor
+!! XCPD,XCPV ! Cpd (dry air), Cpv (vapor)
+!! XCL ! Cl (liquid)
+!! XCI ! Ci (ice)
+!! XTT ! Triple point temperature
+!! XLVTT ! Vaporization heat constant
+!! XLSTT ! Sublimation heat constant
+!! XALPW,XBETAW,XGAMW ! Constants for saturation vapor over liquid
+!! ! pressure function
+!! XALPI,XBETAI,XGAMI ! Constants for saturation vapor over ice
+!! ! pressure function
+!! Module MODD_CONF
+!! CCONF
+!!
+!!
+!! REFERENCE
+!! ---------
+!! Book 1 and Book2 of documentation ( routine ICE_ADJUST )
+!! Langlois, Tellus, 1973
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 2002
+!! C. Barthe 19/11/09 update to version 4.8.1
+!! M. Chong Mar. 2010 Add small ions
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_ri, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
+ tbudgets
+USE MODD_CONF
+USE MODD_CST
+USE MODD_ELEC_DESCR, ONLY : XRTMIN_ELEC, XQTMIN, XFC, XFI, XECHARGE
+USE MODD_NSV, ONLY : NSV_ELECBEG, NSV_ELECEND
+USE MODD_PARAMETERS
+USE MODD_RAIN_ICE_DESCR, ONLY : XRTMIN, XBI
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+use mode_tools_ll, only: GET_INDICE_ll
+
+USE MODI_CONDENSATION
+USE MODI_GET_HALO
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 Declarations of dummy arguments
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KMI ! Model index
+CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Dimensionality of the
+ ! turbulence scheme
+CHARACTER(LEN=4), INTENT(IN) :: HSCONV ! Shallow convection scheme
+CHARACTER(LEN=4), INTENT(IN) :: HMF_CLOUD! Type of statistical cloud
+CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
+ ! Condensation
+LOGICAL :: OSIGMAS ! Switch for Sigma_s:
+ ! use values computed in CONDENSATION
+ ! or that from turbulence scheme
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height of model layer
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux solid mixing ratio
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! Cloud fraction
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rain water m.r. at t+1
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Cloud ice m.r. at t+1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRSS ! Aggregate m.r. at t+1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS ! Graupel m.r. at t+1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHS ! Hail m.r. at t+1
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQPIT ! positive ion m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQPIS ! source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQNIT ! negative ion m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQNIS ! source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQCS ! Cloud water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQRS ! Rain water m.r. at t+1
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQIS ! Cloud ice m.r. at t+1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQSS ! Aggregate m.r. at t+1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQGS ! Graupel m.r. at t+1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQIT ! Cloud ice m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQST ! Aggregate m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PQGT ! Graupel m.r. at t
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PQHT ! Hail m.r. at t
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PQHS ! Hail m.r. at t+1
+!
+!
+!* 0.2 Declarations of local variables :
+!
+REAL :: ZEPS ! Mv/Md
+REAL :: ZT00,ZT0 ! Min and max temperature for the mixed phase liquid and solid water
+ ! for the coeff CND of the barycentric mixing ratio
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: ZEXNS,& ! guess of the Exner functon at t+1
+ ZT, & ! guess of the temperature at t+1
+ ZCPH, & ! guess of the CPh for the mixing
+ ZLV, & ! guess of the Lv at t+1
+ ZLS, & ! guess of the Ls at t+1
+ ZW1,ZW2,ZW3,ZW4,ZW5,ZW6,ZW7,& ! Work arrays for intermediate fields
+ ZW1_IN, ZW2_IN, ZW3_IN, &
+ ZCND ! CND=(T-T00)/(T0-T00) cf sc doc and TAO etal (89)
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: ZWE1, &
+ ZWE2
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
+ :: ZION_NUMBER, & !nearly Nb of elementary charge
+ ! in hydrometeor charge
+ ZADD ! ratio (0 or 1) of ZION_NUMBER
+ ! to add to positive
+ ! or negative ion number
+REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2)) :: ZSIGQSAT2D
+ !
+INTEGER :: IIU,IJU,IKU! dimensions of dummy arrays
+INTEGER :: IIB,IJB ! Horz index values of the first inner mass points
+INTEGER :: IIE,IJE ! Horz index values of the last inner mass points
+INTEGER :: IKB ! K index value of the first inner mass point
+INTEGER :: IKE ! K index value of the last inner mass point
+INTEGER :: JITER,ITERMAX ! iterative loop for first order adjustment
+!
+LOGICAL :: LPRETREATMENT, LNEW_ADJUST
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. PRELIMINARIES
+! -------------
+!
+IIU = SIZE(PEXNREF,1)
+IJU = SIZE(PEXNREF,2)
+IKU = SIZE(PEXNREF,3)
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB = 1 + JPVEXT
+IKE = IKU - JPVEXT
+!
+ZEPS = XMV / XMD
+!
+ITERMAX = 1
+!
+LPRETREATMENT=.TRUE. ! FALSE to retreive the previous MASDEV4_1 version
+LNEW_ADJUST =.TRUE. ! FALSE to retreive the previous MASDEV4_1 version
+ZT0 = XTT ! Usefull if LPRETREATMENT=T or LNEW_ADJUST=T
+ZT00 = XTT-40. ! Usefull if LPRETREATMENT=T or LNEW_ADJUST=T
+!
+!-------------------------------------------------------------------------------
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'DEPI', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'DEPI', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'DEPI', pris(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPI', pqpis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPI', pqnis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'DEPI', pqcs (:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'DEPI', pqis (:, :, :) * prhodj(:, :, :) )
+end if
+!
+!* 2. COMPUTE QUANTITIES WITH THE GUESS OF THE FUTURE INSTANT
+! -------------------------------------------------------
+!
+!* 2.1 estimate the pressure at t+1
+!
+ZEXNS(:,:,:) = ( PPABST(:,:,:) / XP00)**(XRD/XCPD)
+!
+! beginning of the iterative loop
+!
+DO JITER = 1, ITERMAX
+!
+!* 2.2 compute the intermediate temperature at t+1, T*
+!
+ ZT(:,:,:) = (PTHS(:,:,:) * PTSTEP) * ZEXNS(:,:,:)
+!
+!* 2.3 compute the latent heat of vaporization Lv(T*) at t+1
+! and the latent heat of sublimation Ls(T*) at t+1
+!
+ ZLV(:,:,:) = XLVTT + (XCPV - XCL) * (ZT(:,:,:) - XTT)
+ ZLS(:,:,:) = XLSTT + (XCPV - XCI) * (ZT(:,:,:) - XTT)
+!
+!* 2.4 compute the specific heat for moist air (Cph) at t+1
+!
+ IF ( KRR == 7 ) THEN
+ ZCPH(:,:,:) = XCPD + XCPV *PTSTEP* PRVS(:,:,:) &
+ + XCL *PTSTEP* (PRCS(:,:,:) + PRRS(:,:,:)) &
+ + XCI *PTSTEP* (PRIS(:,:,:) + PRSS(:,:,:) + PRGS(:,:,:) &
+ + PRHS(:,:,:))
+ ELSE IF( KRR == 6 ) THEN
+ ZCPH(:,:,:) = XCPD + XCPV *PTSTEP* PRVS(:,:,:) &
+ + XCL *PTSTEP* (PRCS(:,:,:) + PRRS(:,:,:)) &
+ + XCI *PTSTEP* (PRIS(:,:,:) + PRSS(:,:,:) + PRGS(:,:,:))
+ ELSE IF( KRR == 5 ) THEN
+ ZCPH(:,:,:) = XCPD + XCPV *PTSTEP* PRVS(:,:,:) &
+ + XCL *PTSTEP* (PRCS(:,:,:) + PRRS(:,:,:)) &
+ + XCI *PTSTEP* (PRIS(:,:,:) + PRSS(:,:,:))
+ ELSE IF( KRR == 3 ) THEN
+ ZCPH(:,:,:) = XCPD + XCPV *PTSTEP* PRVS(:,:,:) &
+ + XCL *PTSTEP* (PRCS(:,:,:) + PRRS(:,:,:))
+ ELSE IF( KRR == 2 ) THEN
+ ZCPH(:,:,:) = XCPD + XCPV *PTSTEP* PRVS(:,:,:) &
+ + XCL *PTSTEP* PRCS(:,:,:)
+ END IF
+!
+!
+!* 3. FIRST ORDER SUBGRID CONDENSATION SCHEME
+! ---------------------------------------
+!
+ IF (OSUBG_COND) THEN
+!
+!* 3.1 compute condensate, cloud fraction
+!
+ ! ZW3=water vapor ZW1=rc (OUT) ZW2=ri (OUT) PSRC= s'rci'/Sigma_s^2
+ ! ZW3_IN/ZW2_IN/ZW1_IN (IN)
+ ZW3_IN = PRVS * PTSTEP; ZW1_IN = PRCS * PTSTEP; ZW2_IN = PRIS * PTSTEP
+ ZW3=ZW3_IN; ZW2=ZW2_IN; ZW1=ZW1_IN
+ ZSIGQSAT2D(:,:)=PSIGQSAT
+ ZW4 = 1. ! PRODREF is not used if HL variables are not present
+!
+ CALL CONDENSATION( IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE,1, 'T', 'CB02', 'CB', &
+ PPABST, PZZ, ZW4, ZT, ZW3_IN, ZW3, ZW1_IN, ZW1, ZW2_IN, ZW2, &
+ PRSS*PTSTEP, PRGS*PTSTEP, &
+ PSIGS, PMFCONV, PCLDFR, PSRCS, .TRUE., &
+ OSIGMAS, .FALSE., ZSIGQSAT2D, PLV=ZLV, PLS=ZLS, PCPH=ZCPH )
+!
+!* 3.2 compute the variation of mixing ratio
+!
+ ! Rc - Rc*
+ ZW1(:,:,:) = (ZW1(:,:,:) / PTSTEP) - PRCS(:,:,:) ! Pcon = ----------
+ ! 2 Delta t
+
+ ZW2(:,:,:) = (ZW2(:,:,:) / PTSTEP) - PRIS(:,:,:) ! idem ZW1 but for Ri
+
+ ELSE
+!
+!
+!* 4. SECOND ORDER ALL OR NOTHING CONDENSATION SCHEME
+! FOR MIXED-PHASE CLOUD
+! -----------------------------------------------
+!
+!
+!* 4.1 Eventually pretreatment
+!
+ IF (LPRETREATMENT) THEN
+!
+! compute the saturation vapor pressures at t+1
+!
+ CALL GET_HALO(ZT)
+ ZW1(:,:,:) = EXP(XALPW - XBETAW/ZT(:,:,:) - XGAMW*ALOG(ZT(:,:,:))) ! e_sw
+ ZW2(:,:,:) = EXP(XALPI - XBETAI/ZT(:,:,:) - XGAMI*ALOG(ZT(:,:,:))) ! e_si
+ ZW1(:,:,:) = MIN(PPABST(:,:,:)/2.,ZW1(:,:,:)) ! safety limitation
+ ZW2(:,:,:) = MIN(PPABST(:,:,:)/2.,ZW2(:,:,:)) ! safety limitation
+!
+! compute the saturation mixing ratios at t+1
+!
+ ZW3(:,:,:) = ZW1(:,:,:) * ZEPS / &
+ ( PPABST(:,:,:) - ZW1(:,:,:)) ! r_sw
+ ZW4(:,:,:) = ZW2(:,:,:) * ZEPS / &
+ ( PPABST(:,:,:) - ZW2(:,:,:)) ! r_si
+!
+ WHERE(PRVS(:,:,:)*PTSTEP .LT. ZW4(:,:,:) .AND. &
+ PRCS(:,:,:) .GT. 0. .AND. ZT(:,:,:) .LT. XTT)
+!
+! Subsaturation case with respect to rsi(T,P) (and case rv<0):
+! Evaporation of rc>0 (while enough) to decrease the lack of vapor
+!
+ ZW5 (:,:,:)= MIN( PRCS , ZW4(:,:,:)/PTSTEP - PRVS(:,:,:) ) ! RVCNDC
+ PRVS(:,:,:)= PRVS(:,:,:) + ZW5(:,:,:)
+ PRCS(:,:,:)= PRCS(:,:,:) - ZW5(:,:,:)
+ PTHS(:,:,:)= PTHS(:,:,:) - ZW5(:,:,:) * ZLV(:,:,:) /(ZCPH(:,:,:)*PEXNREF(:,:,:))
+!
+ END WHERE
+!
+ WHERE (PRVS(:,:,:)*PTSTEP .GT. ZW3(:,:,:))
+!
+! Supersaturation case with respect to rsw(T,P):
+! Condensation of the vapor that is left
+!
+ ZW5 (:,:,:)= PRVS(:,:,:) - ZW3(:,:,:)/PTSTEP
+ PRVS(:,:,:)= PRVS(:,:,:) - ZW5(:,:,:) ! RVCNDC
+ PRCS(:,:,:)= PRCS(:,:,:) + ZW5(:,:,:)
+ PTHS(:,:,:)= PTHS(:,:,:) + ZW5(:,:,:) * ZLV(:,:,:) /(ZCPH(:,:,:)*PEXNREF(:,:,:))
+!
+ END WHERE
+!
+ WHERE (PRCS(:,:,:) .GT. 0. .AND. ZT(:,:,:) .LT. ZT00)
+!
+! Treatment of rc>0 if T<T00:
+!
+ PRIS(:,:,:)= PRIS(:,:,:) + PRCS(:,:,:)
+ PTHS(:,:,:)= PTHS(:,:,:) + PRCS(:,:,:) * &
+ (ZLS(:,:,:) - ZLV(:,:,:)) / (ZCPH(:,:,:) * PEXNREF(:,:,:))
+ PRCS(:,:,:)= 0.
+!
+ END WHERE
+!
+!* 4.2 compute the intermediate temperature at t+1, T*
+!
+ ZT(:,:,:) = (PTHS(:,:,:) * PTSTEP) * ZEXNS(:,:,:)
+!
+ END IF !end PRETREATMENT
+!
+!* 4.3 compute the saturation vapor pressures at t+1
+!
+ ZW1(:,:,:) = EXP(XALPW - XBETAW / ZT(:,:,:) - XGAMW * ALOG(ZT(:,:,:))) ! e_sw
+ ZW2(:,:,:) = EXP(XALPI - XBETAI / ZT(:,:,:) - XGAMI * ALOG(ZT(:,:,:))) ! e_si
+ ZW1(:,:,:) = MIN(PPABST(:,:,:)/2.,ZW1(:,:,:)) ! safety limitation
+ ZW2(:,:,:) = MIN(PPABST(:,:,:)/2.,ZW2(:,:,:)) ! safety limitation
+!
+!* 4.4 compute the saturation mixing ratios at t+1
+!
+ ZW3(:,:,:) = ZW1(:,:,:) * ZEPS &
+ / ( PPABST(:,:,:) - ZW1(:,:,:) ) ! r_sw
+ ZW4(:,:,:) = ZW2(:,:,:) * ZEPS &
+ / ( PPABST(:,:,:) - ZW2(:,:,:) ) ! r_si
+!
+!* 4.5 compute the saturation mixing ratio derivatives (r'_vs)
+!
+ ZW1(:,:,:) = (( XBETAW/ZT(:,:,:) - XGAMW ) / ZT(:,:,:)) & ! r'_sw
+ * ZW3(:,:,:) * ( 1. + ZW3(:,:,:)/ZEPS )
+ ZW2(:,:,:) = (( XBETAI/ZT(:,:,:) - XGAMI ) / ZT(:,:,:)) & ! r'_si
+ * ZW4(:,:,:) * ( 1. + ZW4(:,:,:)/ZEPS )
+!
+ IF (LNEW_ADJUST) THEN
+ ZCND(:,:,:)= (ZT(:,:,:) - ZT00) / (ZT0 - ZT00) ! Like Tao et al 89
+ ZCND(:,:,:)= MAX ( MIN(ZCND(:,:,:),1.) , 0. )
+ ELSE
+ WHERE ((PRCS(:,:,:)+PRIS(:,:,:)) .GT. 1.0E-20) &
+ ZCND(:,:,:)= PRCS(:,:,:) / (PRCS(:,:,:) + PRIS(:,:,:)) ! Like the original version
+ END IF
+!
+!* 4.5 compute L_v CND + L_s DEP and F'(T)
+!
+ WHERE ((PRCS(:,:,:)+PRIS(:,:,:)) .GT. 1.0E-20)
+!
+ ZW5(:,:,:) = ZLS(:,:,:) + (ZLV(:,:,:) - ZLS(:,:,:)) * ZCND(:,:,:)
+ ZW6(:,:,:) = ZCPH(:,:,:) * (PRCS(:,:,:) + PRIS(:,:,:)) + &
+ ZW5(:,:,:) * (PRCS(:,:,:) * ZW1(:,:,:) &
+ + PRIS(:,:,:) * ZW2(:,:,:))
+!
+!* 4.6 compute Delta 2
+!
+ ZW7(:,:,:) = (ZW5(:,:,:) / (ZW6(:,:,:) * ZT(:,:,:))) * &
+ (PRCS(:,:,:) * ZW1(:,:,:) * &
+ ((-2. * XBETAW + XGAMW * ZT(:,:,:)) / (XBETAW - XGAMW * ZT(:,:,:)) + &
+ (XBETAW - XGAMW * ZT(:,:,:)) * (1.0 + 2.0 * ZW3(:,:,:) / ZEPS) / ZT(:,:,:)) + &
+ PRIS(:,:,:) * ZW2(:,:,:) * &
+ ((-2. * XBETAI + XGAMI * ZT(:,:,:)) / (XBETAI - XGAMI * ZT(:,:,:)) + &
+ (XBETAI - XGAMI * ZT(:,:,:)) * (1.0 + 2.0 * ZW4(:,:,:) / ZEPS) / ZT(:,:,:)))
+!
+!* 4.7 compute Delta 1
+!
+ ZW6(:,:,:) = ZW5(:,:,:) * (PRCS(:,:,:) * ZW3(:,:,:) + PRIS(:,:,:) * ZW4(:,:,:) - &
+ PRVS(:,:,:) * PTSTEP * (PRCS(:,:,:) + PRIS(:,:,:))) / &
+ ZW6(:,:,:)
+!
+!* 4.8 compute the sources
+!
+ ZW3(:,:,:) = (ZCPH(:,:,:) / ZW5(:,:,:)) * &
+ (-ZW6(:,:,:) * (1.0 + 0.5 * ZW6(:,:,:) * ZW7(:,:,:))) / PTSTEP
+ ZW1(:,:,:) = ZW3(:,:,:) * ZCND(:,:,:) ! RVCNDC
+ ZW2(:,:,:) = ZW3(:,:,:) * (1.0 - ZCND(:,:,:)) ! RVDEPI
+!
+ ELSEWHERE
+!
+!* 4.9 special case when both r_c and r_i are zero
+!
+ ZW6(:,:,:) = ZCPH(:,:,:) + ZLV(:,:,:) * ZW1(:,:,:) ! F'(T)
+ ZW7(:,:,:) = (ZLV(:,:,:) / (ZW6(:,:,:) * ZT(:,:,:))) * & ! Delta 2
+ (ZW1(:,:,:) * &
+ ((-2. * XBETAW + XGAMW * ZT(:,:,:)) / (XBETAW - XGAMW * ZT(:,:,:)) + &
+ (XBETAW - XGAMW * ZT(:,:,:)) * (1.0 + 2.0 * ZW3(:,:,:) / ZEPS) / ZT(:,:,:)))
+ ZW6(:,:,:) = ZLV(:,:,:) * (ZW3(:,:,:) - PRVS(:,:,:) * PTSTEP) / ZW6(:,:,:) ! Delta 1
+ ZW1(:,:,:) = (ZCPH(:,:,:) / ZLV(:,:,:)) * & ! RVCNDC
+ (-ZW6(:,:,:) * ( 1.0 + 0.5 * ZW6(:,:,:) * ZW7(:,:,:))) / PTSTEP
+ ZW2(:,:,:) = 0.0 ! RVDEPI
+!
+ END WHERE
+ END IF
+!
+!* 5. COMPUTE THE SOURCES AND STORES THE CLOUD FRACTION
+! -------------------------------------------------
+!
+!* 5.1 compute the sources
+!
+!* 5.1.1 microphysics
+!
+ WHERE (ZW1(:,:,:) < 0.0)
+ ZW1(:,:,:) = MAX (ZW1(:,:,:), -PRCS(:,:,:)) ! Evaporation rate
+ ELSEWHERE
+ ZW1(:,:,:) = MIN (ZW1(:,:,:), PRVS(:,:,:)) ! Condensation rate
+ END WHERE
+!
+ PRVS(:,:,:) = PRVS(:,:,:) - ZW1(:,:,:)
+ PRCS(:,:,:) = PRCS(:,:,:) + ZW1(:,:,:)
+ PTHS(:,:,:) = PTHS(:,:,:) + &
+ ZW1(:,:,:) * ZLV(:,:,:) / (ZCPH(:,:,:) * PEXNREF(:,:,:))
+!
+ WHERE (ZW2(:,:,:) < 0.0)
+ ZW2(:,:,:) = MAX (ZW2(:,:,:), -PRIS(:,:,:)) ! Sublimation rate
+ ELSEWHERE
+ ZW2(:,:,:) = MIN (ZW2(:,:,:), PRVS(:,:,:)) ! Deposition rate
+ END WHERE
+!
+ PRVS(:,:,:) = PRVS(:,:,:) - ZW2(:,:,:)
+ PRIS(:,:,:) = PRIS(:,:,:) + ZW2(:,:,:)
+ PTHS(:,:,:) = PTHS(:,:,:) + &
+ ZW2(:,:,:) * ZLS(:,:,:) / (ZCPH(:,:,:) * PEXNREF(:,:,:))
+!
+!* 5.1.2 electricity
+!
+ ZWE1(:,:,:) = 0.
+ ZWE2(:,:,:) = 0.
+!
+! the electrical process due to condensation is removed and
+! capture of ions by cloud droplets is done in ion_attach_elec routine
+!
+! evaporation
+ WHERE (ABS(PRCT(:,:,:)) > XRTMIN_ELEC(2) .AND. &
+ ABS(PQCT(:,:,:)) > XQTMIN(2) .AND. &
+ ZW1(:,:,:) < -XRTMIN(1))
+ ZWE1(:,:,:) = (XFC / 3.) * (PQCT(:,:,:) / PRCT(:,:,:)) * (-ZW1(:,:,:))
+ ZION_NUMBER(:,:,:) = ABS(ZWE1(:,:,:)) / XECHARGE
+ ZADD(:,:,:) = 0.5 + SIGN(0.5, ZWE1(:,:,:))
+ PQPIS(:,:,:) = PQPIS(:,:,:) + &
+ ZADD(:,:,:) *ZION_NUMBER(:,:,:)
+ PQNIS(:,:,:) = PQNIS(:,:,:) + &
+ (1.-ZADD(:,:,:)) *ZION_NUMBER(:,:,:)
+ PQCS(:,:,:) = PQCS(:,:,:) - ZWE1(:,:,:)
+ END WHERE
+!
+! the electrical process due to deposition is removed and
+! capture of ions by raindropsp is done in ion_attach_elec routine
+!
+! sublimation
+ WHERE (ABS(PRIT(:,:,:)) > XRTMIN_ELEC(4) .AND. &
+ ABS(PQIT(:,:,:)) > XQTMIN(4) .AND. &
+ ZW2(:,:,:) < -XRTMIN(1))
+ ZWE2(:,:,:) = (XFI / XBI) * (PQIT(:,:,:) / PRIT(:,:,:)) * (-ZW2(:,:,:))
+ ZION_NUMBER(:,:,:) = ABS(ZWE2(:,:,:)) / XECHARGE
+ ZADD(:,:,:) = 0.5 + SIGN(0.5, ZWE2(:,:,:))
+ PQPIS(:,:,:) = PQPIS(:,:,:) + &
+ ZADD(:,:,:) *ZION_NUMBER(:,:,:)
+ PQNIS(:,:,:) = PQNIS(:,:,:) + &
+ (1.-ZADD(:,:,:)) *ZION_NUMBER(:,:,:)
+ PQIS(:,:,:) = PQIS(:,:,:) - ZWE2(:,:,:)
+ END WHERE
+END DO ! end of the iterative loop
+!
+!
+!* 5.2 compute the cloud fraction PCLDFR
+!
+IF (.NOT. OSUBG_COND) THEN
+ WHERE (PRCS(:,:,:) + PRIS(:,:,:) > 1.E-12 / PTSTEP)
+ PCLDFR(:,:,:) = 1.
+ ELSEWHERE
+ PCLDFR(:,:,:) = 0.
+ ENDWHERE
+ IF (SIZE(PSRCS,3) /= 0) THEN
+ PSRCS(:,:,:) = PCLDFR(:,:,:)
+ END IF
+ELSE
+ IF (HSCONV == 'EDKF' .AND. HMF_CLOUD == 'DIRE') THEN
+ PCLDFR(:,:,:) = MIN(1.,PCLDFR(:,:,:)+PCF_MF(:,:,:))
+ PRCS(:,:,:) = PRCS(:,:,:) + PRC_MF(:,:,:) / PTSTEP
+ PRIS(:,:,:) = PRIS(:,:,:)+PRI_MF(:,:,:)/PTSTEP
+ PRVS(:,:,:) = PRVS(:,:,:)- ( PRC_MF(:,:,:) + PRI_MF(:,:,:)) /PTSTEP
+ PTHS(:,:,:) = PTHS(:,:,:) + ( PRC_MF(:,:,:) * ZLV(:,:,:) + &
+ PRI_MF(:,:,:) * ZLS(:,:,:) ) / ZCPH(:,:,:) / &
+ PEXNREF(:,:,:) / PTSTEP
+ END IF
+ENDIF
+!
+!
+!
+!* 6. STORE THE BUDGET TERMS
+! ----------------------
+!
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'DEPI', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'DEPI', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'DEPI', pris(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPI', pqpis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPI', pqnis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'DEPI', pqcs (:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'DEPI', pqis (:, :, :) * prhodj(:, :, :) )
+end if
+!------------------------------------------------------------------------------
+!
+END SUBROUTINE ICE_ADJUST_ELEC
diff --git a/src/mesonh/micro/ini_ice_c1r3.f90 b/src/mesonh/micro/ini_ice_c1r3.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8de2f998d7bdb6c9f09808b619bbc0b3f253d97d
--- /dev/null
+++ b/src/mesonh/micro/ini_ice_c1r3.f90
@@ -0,0 +1,1128 @@
+!MNH_LIC Copyright 2000-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ########################
+ MODULE MODI_INI_ICE_C1R3
+! ########################
+!
+INTERFACE
+ SUBROUTINE INI_ICE_C1R3 ( PTSTEP, PDZMIN, KSPLITG )
+!
+INTEGER, INTENT(OUT):: KSPLITG ! Number of small time step
+ ! integration for rain
+ ! sedimendation
+!
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
+!
+!
+END SUBROUTINE INI_ICE_C1R3
+!
+END INTERFACE
+!
+END MODULE MODI_INI_ICE_C1R3
+! ###################################################
+ SUBROUTINE INI_ICE_C1R3 ( PTSTEP, PDZMIN, KSPLITG )
+! ###################################################
+!
+!!**** *INI_ICE_C1R3 * - initialize the constants necessary for the warm and
+!! cold microphysical schemes.
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize the constants used to
+!! resolve the mixed phase microphysical scheme. The collection kernels of
+!! the precipitating particles are recomputed if necessary if some parameters
+!! defining the ice categories have been modified. The number of small
+!! time steps leading to stable scheme for the rain, ice, snow and ggraupeln
+!! sedimentation is also computed (time-splitting technique).
+!!
+!!** METHOD
+!! ------
+!! The constants are initialized to their numerical values and the number
+!! of small time step is computed by dividing the 2* Deltat time interval of
+!! the Leap-frog scheme so that the stability criterion for the rain
+!! sedimentation is fulfilled for a Raindrop maximal fall velocity equal
+!! VTRMAX. The parameters defining the collection kernels are read and are
+!! checked against the new ones. If any change occurs, these kernels are
+!! recomputed and their numerical values are written in the output listiing.
+!!
+!! 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_REF
+!! XTHVREFZ ! Reference virtual pot.temp. without orography
+!! Module MODD_PARAMETERS
+!! JPVEXT !
+!! Module MODD_ICE_C1R3_DESCR
+!! Module MODD_ICE_C1R3_PARAM
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation ( routine INI_ICE_C1R3 )
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/12/2000
+!! J.-P. Pinty 28/05/2001 Correction for RHONI
+!! J.-P. Pinty 31/05/2001 Correction for ICNVS factors
+!! J.-P. Pinty 29/06/2001 Bug in RCHONI and RVHNCI
+!! J.-P. Pinty 29/06/2001 Add RHHONI process (freezing haze part.)
+!! J.-P. Pinty 23/09/2001 Review the HM process constants
+!! J.-P. Pinty 23/10/2001 Add XRHORSMIN
+!! J.-P. Pinty 05/04/2002 Add computation of the effective radius
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_ICE_C1R3_DESCR
+USE MODD_ICE_C1R3_PARAM
+USE MODD_LUNIT, ONLY: TLUOUT0
+USE MODD_PARAMETERS
+USE MODD_PARAM_C1R3
+USE MODD_PARAM_C2R2, ONLY : XALPHAC,XNUC,XALPHAR,XNUR
+USE MODD_RAIN_C2R2_DESCR, ONLY : XAR,XBR,XCR,XDR,XF0R,XF1R,XAC,XBC,XCC,XDC, &
+ XLBC,XLBEXC,XLBR,XLBEXR
+USE MODD_REF
+!
+use mode_msg
+!
+USE MODI_GAMMA
+USE MODI_GAMMA_INC
+USE MODE_READ_XKER_RACCS, ONLY: READ_XKER_RACCS
+USE MODE_READ_XKER_RDRYG, ONLY: READ_XKER_RDRYG
+USE MODE_READ_XKER_SDRYG, ONLY: READ_XKER_SDRYG
+USE MODE_RRCOLSS, ONLY: RRCOLSS
+USE MODE_RSCOLRG, ONLY: RSCOLRG
+USE MODE_RZCOLX, ONLY: RZCOLX
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+INTEGER, INTENT(OUT):: KSPLITG ! Number of small time step
+ ! integration for rain
+ ! sedimendation
+!
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
+! diat
+!
+!
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IKB ! Coordinates of the first physical
+ ! points along z
+INTEGER :: J1,J2 ! Internal loop indexes
+!
+REAL, DIMENSION(8) :: ZGAMI ! parameters involving various moments
+REAL, DIMENSION(2) :: ZGAMS ! of the generalized gamma law
+!
+REAL :: ZT ! Work variable
+REAL :: ZVTRMAX ! Raindrop maximal fall velocity
+REAL :: ZRHO00 ! Surface reference air density
+REAL :: ZRATE ! Geometrical growth of Lbda in the tabulated
+ ! functions and kernels
+REAL :: ZBOUND ! XDCSLIM*Lbda_s: upper bound for the partial
+ ! integration of the riming rate of the aggregates
+REAL :: ZEGS, ZEGR ! Bulk collection efficiencies
+!
+INTEGER :: IND ! Number of interval to integrate the kernels
+REAL :: ZESR ! Mean efficiency of rain-aggregate collection
+REAL :: ZFDINFTY ! Factor used to define the "infinite" diameter
+!
+!
+INTEGER :: ILUOUT0 ! Logical unit number for output-listing
+LOGICAL :: GFLAG ! Logical flag for printing the constatnts on the output
+ ! listing
+REAL :: ZCONC_MAX ! Maximal concentration for snow
+REAL :: ZFACT_NUCL! Amplification factor for the minimal ice concentration
+!
+INTEGER :: KND
+INTEGER :: KACCLBDAS,KACCLBDAR,KDRYLBDAG,KDRYLBDAS,KDRYLBDAR
+REAL :: PALPHAR,PALPHAS,PALPHAG
+REAL :: PNUR,PNUS,PNUG
+REAL :: PBR,PBS
+REAL :: PCR,PCS,PCG
+REAL :: PDR,PDS,PDG
+REAL :: PESR,PEGS,PEGR
+REAL :: PFDINFTY
+REAL :: PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN
+REAL :: PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN
+REAL :: PDRYLBDAR_MAX,PDRYLBDAR_MIN
+!
+REAL :: ZFAC_ZRNIC ! Zrnic factor used to decrease Long Kernels
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 0. FUNCTION STATEMENTS
+! -------------------
+!
+!
+!* 0.1 G(p) for p_moment of the Generalized GAMMA function
+!
+!
+! recall that MOMG(ZALPHA,ZNU,ZP)=GAMMA(ZNU+ZP/ZALPHA)/GAMMA(ZNU)
+!
+!
+! 1. INTIALIZE OUTPUT LISTING AND COMPUTE KSPLITG FOR EACH MODEL
+! -----------------------------------------------------------
+!
+ILUOUT0 = TLUOUT0%NLU
+!
+!* 1.1 Set the graupel maximum fall velocity
+!
+ZVTRMAX = 30.
+IF( CHEVRIMED_ICE_C1R3 == 'HAIL' ) THEN
+ ZVTRMAX = 60. ! Hail case
+END IF
+!
+!* 1.2 Compute the number of small time step integration
+!
+KSPLITG = 1
+SPLIT : DO
+ ZT = 2.* PTSTEP / REAL(KSPLITG)
+ IF ( ZT * ZVTRMAX / PDZMIN .LT. 1.) EXIT SPLIT
+ KSPLITG = KSPLITG + 1
+END DO SPLIT
+!
+IF (ALLOCATED(XRTMIN)) RETURN ! In case of nesting microphysics constants of
+! ! MODD_ICE_C1R3_PARAM are computed only once.
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. CHARACTERISTICS OF THE SPECIES
+! ------------------------------
+!
+!
+!* 2.1 Raindrops characteristics
+!
+!
+!* 2.2 Ice crystal characteristics
+!
+SELECT CASE (CPRISTINE_ICE_C1R3)
+ CASE('PLAT')
+ XAI = 0.82 ! Plates
+ XBI = 2.5 ! Plates
+ XC_I = 800. ! Plates
+ XDI = 1.0 ! Plates
+ XC1I = 1./XPI ! Plates
+ CASE('COLU')
+ XAI = 2.14E-3 ! Columns
+ XBI = 1.7 ! Columns
+ XC_I = 2.1E5 ! Columns
+ XDI = 1.585 ! Columns
+ XC1I = 0.8 ! Columns
+ CASE('BURO')
+ XAI = 44.0 ! Bullet rosettes
+ XBI = 3.0 ! Bullet rosettes
+ XC_I = 4.3E5 ! Bullet rosettes
+ XDI = 1.663 ! Bullet rosettes
+ XC1I = 0.5 ! Bullet rosettes
+END SELECT
+!
+! Note that XCCI=N_i (a locally predicted value) and XCXI=0.0, implicitly
+!
+XF0I = 1.00
+XF2I = 0.103
+XF0IS = 0.86
+XF1IS = 0.28
+!
+!
+!* 2.3 Snowflakes/aggregates characteristics
+!
+!
+XAS = 0.02
+XBS = 1.9
+XCS = 5.1
+XDS = 0.27
+!
+XCCS = 5.0
+XCXS = 1.0
+!
+XF0S = 0.86
+XF1S = 0.28
+!
+XC1S = 1./XPI
+!
+!
+!* 2.4 Heavily rimed crystals characteristics
+!
+!
+SELECT CASE (CHEVRIMED_ICE_C1R3)
+ CASE('GRAU')
+ XAG = 19.6 ! Lump graupel case
+ XBG = 2.8 ! Lump graupel case
+ XCG = 124. ! Lump graupel case
+ XDG = 0.66 ! Lump graupel case
+ CASE('HAIL')
+ XAG = 470. ! Hail case
+ XBG = 3.0 ! Hail case
+ XCG = 207. ! Hail case
+ XDG = 0.64 ! Hail case
+END SELECT
+!
+XCCG = 5.E5
+XCXG = -0.5
+! XCCG = 4.E4 ! Test of Ziegler (1988)
+! XCXG = -1.0 ! Test of Ziegler (1988)
+!
+XF0G = 0.86
+XF1G = 0.28
+!
+XC1G = 1./2.
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. DIMENSIONAL DISTRIBUTIONS OF THE SPECIES
+! ----------------------------------------
+!
+!
+!* 3.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
+!
+!* 3.3 Constants for shape parameter
+!
+XLBEXI = 1.0/XBI
+XLBI = XAI*MOMG(XALPHAI,XNUI,XBI)
+!
+XLBEXS = 1.0/(XCXS-XBS)
+XLBS = ( XAS*XCCS*MOMG(XALPHAS,XNUS,XBS) )**(-XLBEXS)
+!
+XLBEXG = 1.0/(XCXG-XBG)
+XLBG = ( XAG*XCCG*MOMG(XALPHAG,XNUG,XBG))**(-XLBEXG)
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" Shape Parameters")')
+ WRITE(UNIT=ILUOUT0,FMT='(" XLBEXI =",E13.6," XLBI =",E13.6)') XLBEXI,XLBI
+ WRITE(UNIT=ILUOUT0,FMT='(" XLBEXS =",E13.6," XLBS =",E13.6)') XLBEXS,XLBS
+ WRITE(UNIT=ILUOUT0,FMT='(" XLBEXG =",E13.6," XLBG =",E13.6)') XLBEXG,XLBG
+END IF
+!
+!* 3.4 Minimal values allowed for the mixing ratios
+!
+XLBDAS_MAX = 100000.0
+XLBDAG_MAX = 100000.0
+!
+ZCONC_MAX = 1.E6 ! Maximal concentration for falling particules set to 1 per cc
+XLBDAS_MAX = ( ZCONC_MAX/XCCS )**(1./XCXS)
+!
+ALLOCATE( XRTMIN(6) )
+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
+ALLOCATE( XCTMIN(6) )
+XCTMIN(1) = 1.0
+XCTMIN(2) = 1.0
+XCTMIN(3) = 1.0E-3
+XCTMIN(4) = 1.0E-3
+XCTMIN(5) = 1.0E-3
+XCTMIN(6) = 1.0E-3
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. CONSTANTS FOR THE SEDIMENTATION
+! -------------------------------
+!
+!
+!* 4.1 Exponent of the fall-speed air density correction
+!
+XCEXVT = 0.4
+!
+IKB = 1 + JPVEXT
+ZRHO00 = XP00/(XRD*XTHVREFZ(IKB))
+!
+!* 4.2 Constants for sedimentation
+!
+!! XEXRSEDI = (XBI+XDI)/XBI
+!! XEXCSEDI = 1.0-XEXRSEDI
+!! XFSEDI = (4.*XPI*900.)**(-XEXCSEDI) * &
+!! XC_I*XAI*MOMG(XALPHAI,XNUI,XBI+XDI) * &
+!! ((XAI*MOMG(XALPHAI,XNUI,XBI)))**(-XEXRSEDI) * &
+!! (ZRHO00)**XCEXVT
+!! !
+!! ! Computations made for Columns
+!! !
+!! XEXRSEDI = 1.9324
+!! XEXCSEDI =-0.9324
+!! XFSEDI = 3.89745E11*MOMG(XALPHAI,XNUI,3.285)* &
+!! MOMG(XALPHAI,XNUI,1.7)**(-XEXRSEDI)*(ZRHO00)**XCEXVT
+!! XEXCSEDI =-0.9324*3.0
+!! WRITE (ILUOUT0,FMT=*)' PRISTINE ICE SEDIMENTATION for columns XFSEDI=',XFSEDI
+!
+!
+XEXSEDS = (XBS+XDS-XCXS)/(XBS-XCXS)
+XFSEDS = XCS*XAS*XCCS*MOMG(XALPHAS,XNUS,XBS+XDS)* &
+ (XAS*XCCS*MOMG(XALPHAS,XNUS,XBS))**(-XEXSEDS)*(ZRHO00)**XCEXVT
+!
+XEXSEDG = (XBG+XDG-XCXG)/(XBG-XCXG)
+XFSEDG = XCG*XAG*XCCG*MOMG(XALPHAG,XNUG,XBG+XDG)* &
+ (XAG*XCCG*MOMG(XALPHAG,XNUG,XBG))**(-XEXSEDG)*(ZRHO00)**XCEXVT
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. CONSTANTS FOR THE SLOW COLD PROCESSES
+! -------------------------------------
+!
+!
+!* 5.1 Constants for ice nucleation
+!
+SELECT CASE (CPRISTINE_ICE_C1R3)
+ CASE('PLAT')
+ ZFACT_NUCL = 1.0 ! Plates
+ CASE('COLU')
+ ZFACT_NUCL = 25.0 ! Columns
+ CASE('BURO')
+ ZFACT_NUCL = 17.0 ! Bullet rosettes
+END SELECT
+!
+!* 5.1.1 Constants for nucleation from ice nuclei
+!
+XNUC_DEP = XFACTNUC_DEP*1000.*ZFACT_NUCL
+XEXSI_DEP = 12.96
+XEX_DEP = -0.639
+!
+XCONCI_MAX = 100.E3 ! Assume a maximum concentration of 100 per liter
+XNUC_CON = XFACTNUC_CON*1000.*ZFACT_NUCL
+XEXTT_CON = -0.262
+XEX_CON = -2.8
+!
+XMNU0 = 6.88E-13
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" Heterogeneous nucleation")')
+ WRITE(UNIT=ILUOUT0,FMT='(" XNUC_DEP=",E13.6," XEXSI=",E13.6," XEX=",E13.6)') &
+ XNUC_DEP,XEXSI_DEP,XEX_DEP
+ WRITE(UNIT=ILUOUT0,FMT='(" XNUC_CON=",E13.6," XEXTT=",E13.6," XEX=",E13.6)') &
+ XNUC_CON,XEXTT_CON,XEX_CON
+ WRITE(UNIT=ILUOUT0,FMT='(" mass of embryo XMNU0=",E13.6)') XMNU0
+END IF
+!
+!* 5.1.2 Constants for homogeneous nucleation from haze particules
+!
+XRHOI_HONH = 925.0
+XCEXP_DIFVAP_HONH = 1.94
+XCOEF_DIFVAP_HONH = (2.0*XPI)*0.211E-4*XP00/XTT**XCEXP_DIFVAP_HONH
+XCRITSAT1_HONH = 2.583
+XCRITSAT2_HONH = 207.83
+XTMIN_HONH = 180.0
+XTMAX_HONH = 240.0
+XDLNJODT1_HONH = 4.37
+XDLNJODT2_HONH = 0.03
+XC1_HONH = 100.0
+XC2_HONH = 22.6
+XC3_HONH = 0.1
+XRCOEF_HONH = (XPI/6.0)*XRHOI_HONH
+!
+!* 5.1.3 Constants for homogeneous nucleation from cloud droplets
+!
+XTEXP1_HONC = -606.3952*LOG(10.0)
+XTEXP2_HONC = -52.6611*LOG(10.0)
+XTEXP3_HONC = -1.7439*LOG(10.0)
+XTEXP4_HONC = -0.0265*LOG(10.0)
+XTEXP5_HONC = -1.536E-4*LOG(10.0)
+IF (XALPHAC == 3.0) THEN
+ XC_HONC = XPI/6.0
+ XR_HONC = XPI/6.0
+ELSE
+ WRITE(UNIT=ILUOUT0,FMT='(" Homogeneous nucleation")')
+ WRITE(UNIT=ILUOUT0,FMT='(" XALPHAC=",E13.6," IS NOT 3.0")') XALPHAC
+ WRITE(UNIT=ILUOUT0,FMT='(" No algorithm yet developed in this case !")')
+ call Print_msg(NVERB_FATAL,'GEN','INI_ICE_C1R3','')
+END IF
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" Homogeneous nucleation")')
+ WRITE(UNIT=ILUOUT0,FMT='(" XTEXP1_HONC=",E13.6)') XTEXP1_HONC
+ WRITE(UNIT=ILUOUT0,FMT='(" XTEXP2_HONC=",E13.6)') XTEXP2_HONC
+ WRITE(UNIT=ILUOUT0,FMT='(" XTEXP3_HONC=",E13.6)') XTEXP3_HONC
+ WRITE(UNIT=ILUOUT0,FMT='(" XTEXP4_HONC=",E13.6)') XTEXP4_HONC
+ WRITE(UNIT=ILUOUT0,FMT='(" XTEXP5_HONC=",E13.6)') XTEXP5_HONC
+ WRITE(UNIT=ILUOUT0,FMT='("XC_HONC=",E13.6," XR_HONC=",E13.6)') XC_HONC,XR_HONC
+END IF
+!
+!
+!* 5.2 Constants for vapor deposition on ice
+!
+XSCFAC = (0.63**(1./3.))*SQRT((ZRHO00)**XCEXVT) ! One assumes Sc=0.63
+!
+X0DEPI = (4.0*XPI)*XC1I*XF0I*MOMG(XALPHAI,XNUI,1.)
+X2DEPI = (4.0*XPI)*XC1I*XF2I*XC_I*MOMG(XALPHAI,XNUI,XDI+2.0)
+!
+! Harrington parameterization for ice to snow conversion
+!
+XDICNVS_LIM = 125.E-6 ! size in microns
+XLBDAICNVS_LIM = (50.0**(1.0/(XALPHAI)))/XDICNVS_LIM ! ZLBDAI Limitation
+XC0DEPIS = ((4.0*XPI)/(XAI*XBI))*XC1I*XF0IS* &
+ (XALPHAI/GAMMA(XNUI))*XDICNVS_LIM**(1.0-XBI)
+XC1DEPIS = ((4.0*XPI)/(XAI*XBI))*XC1I*XF1IS*SQRT(XC_I)* &
+ (XALPHAI/GAMMA(XNUI))*XDICNVS_LIM**(1.0-XBI+(XDI+1.0)/2.0)
+XR0DEPIS = XC0DEPIS *(XAI*XDICNVS_LIM**XBI)
+XR1DEPIS = XC1DEPIS *(XAI*XDICNVS_LIM**XBI)
+!
+! Harrington parameterization for snow to ice conversion
+!
+XLBDASCNVI_MAX = 6000. ! lbdas max after Field (1999)
+XCSCNVI_MAX = 1000. ! estimated ice conc. due to S->I conversion
+XRHORSMIN = (XLBDASCNVI_MAX/XLBS)**(1.0/XLBEXS)
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" snow is converted into pristine ice with ")')
+ WRITE(UNIT=ILUOUT0,FMT='(" XRHORSMIN=",E13.6)') XRHORSMIN
+END IF
+!
+XDSCNVI_LIM = 125.E-6 ! size in microns
+XLBDASCNVI_LIM = (50.0**(1.0/(XALPHAS)))/XDSCNVI_LIM ! ZLBDAS Limitation
+XC0DEPSI = ((4.0*XPI)/(XAS*XBS))*XC1S*XF0IS* &
+ (XALPHAS/GAMMA(XNUS))*XDSCNVI_LIM**(1.0-XBS)
+XC1DEPSI = ((4.0*XPI)/(XAS*XBS))*XC1S*XF1IS*SQRT(XCS)* &
+ (XALPHAS/GAMMA(XNUS))*XDSCNVI_LIM**(1.0-XBS+(XDS+1.0)/2.0)
+XR0DEPSI = XC0DEPSI *(XAS*XDSCNVI_LIM**XBS)
+XR1DEPSI = XC1DEPSI *(XAS*XDSCNVI_LIM**XBS)
+!
+! Vapor deposition on the snow and the graupels
+!
+X0DEPS = (4.0*XPI)*XCCS*XC1S*XF0S*MOMG(XALPHAS,XNUS,1.)
+X1DEPS = (4.0*XPI)*XCCS*XC1S*XF1S*SQRT(XCS)*MOMG(XALPHAS,XNUS,0.5*XDS+1.5)
+XEX0DEPS = XCXS-1.0
+XEX1DEPS = XCXS-0.5*(XDS+3.0)
+!
+X0DEPG = (4.0*XPI)*XCCG*XC1G*XF0G*MOMG(XALPHAG,XNUG,1.)
+X1DEPG = (4.0*XPI)*XCCG*XC1G*XF1G*SQRT(XCG)*MOMG(XALPHAG,XNUG,0.5*XDG+1.5)
+XEX0DEPG = XCXG-1.0
+XEX1DEPG = XCXG-0.5*(XDG+3.0)
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. CONSTANTS FOR THE COALESCENCE PROCESSES
+! --------------------------------------
+!
+!
+!* 6.0 Precalculation of the gamma function momentum
+!
+!
+ZGAMI(1) = GAMMA(XNUI)
+ZGAMI(2) = MOMG(XALPHAI,XNUI,3.)
+ZGAMI(3) = MOMG(XALPHAI,XNUI,6.)
+ZGAMI(4) = ZGAMI(3)-ZGAMI(2)**2 ! useful for Sig_I
+ZGAMI(5) = MOMG(XALPHAI,XNUI,9.)
+ZGAMI(6) = MOMG(XALPHAI,XNUI,3.+XBI)
+ZGAMI(7) = MOMG(XALPHAI,XNUI,XBI)
+ZGAMI(8) = MOMG(XALPHAI,XNUI,3.)/MOMG(XALPHAI,XNUI,2.)
+!
+ZGAMS(1) = GAMMA(XNUS)
+ZGAMS(2) = MOMG(XALPHAS,XNUS,3.)
+!
+!* 6.1 Csts for the coalescence processes
+!
+ZFAC_ZRNIC = 0.1
+XKER_ZRNIC_A1 = 2.59E15*ZFAC_ZRNIC**2! From Long a1=9.44E9 cm-3
+ ! so XKERA1= 9.44E9*1E6*(PI/6)**2
+XKER_ZRNIC_A2 = 3.03E3*ZFAC_ZRNIC ! From Long a2=5.78E3
+ ! so XKERA2= 5.78E3* (PI/6)
+!
+!* 6.2 Csts for the pristine ice selfcollection process
+!
+XSELFI = XKER_ZRNIC_A1*ZGAMI(3)
+XCOLEXII = 0.025 ! Temperature factor of the I+I collection efficiency
+!
+!* 6.3 Constants for pristine ice autoconversion
+!
+XTEXAUTI = 0.025 ! Temperature factor of the I+I collection efficiency
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" pristine ice autoconversion")')
+ WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XTEXAUTI=",E13.6)') XTEXAUTI
+END IF
+!
+XAUTO3 = 6.25E18*(ZGAMI(2))**(1./3.)*SQRT(ZGAMI(4))
+XAUTO4 = 0.5E6*(ZGAMI(4))**(1./6.)
+XLAUTS = 2.7E-2
+XLAUTS_THRESHOLD = 0.4
+XITAUTS= 0.27 ! (Notice that T2 of BR74 is uncorrect and that 0.27=1./3.7
+XITAUTS_THRESHOLD = 7.5
+!
+!* 6.4 Constants for snow aggregation
+!
+XCOLEXIS = 0.05 ! Temperature factor of the I+S collection efficiency
+XAGGS_CLARGE1 = XKER_ZRNIC_A2*ZGAMI(2)
+XAGGS_CLARGE2 = XKER_ZRNIC_A2*ZGAMS(2)
+XAGGS_RLARGE1 = XKER_ZRNIC_A2*ZGAMI(6)*XAI
+XAGGS_RLARGE2 = XKER_ZRNIC_A2*ZGAMI(7)*ZGAMS(2)*XAI
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" snow aggregation")')
+ WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XCOLEXIS=",E13.6)') XCOLEXIS
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. CONSTANTS FOR THE FAST COLD PROCESSES FOR THE AGGREGATES
+! --------------------------------------------------------
+!
+!
+!* 7.1 Constants for the riming of the aggregates
+!
+XDCSLIM = 0.007 ! D_cs^lim = 7 mm as suggested by Farley et al. (1989)
+XCOLCS = 1.0
+XEXCRIMSS= XCXS-XDS-2.0
+XCRIMSS = (XPI/4.0)*XCOLCS*XCCS*XCS*(ZRHO00**XCEXVT)*MOMG(XALPHAS,XNUS,XDS+2.0)
+XEXCRIMSG= XEXCRIMSS
+XCRIMSG = XCRIMSS
+XSRIMCG = XCCS*XAS*MOMG(XALPHAS,XNUS,XBS)
+XEXSRIMCG= XCXS-XBS
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" riming of the aggregates")')
+ WRITE(UNIT=ILUOUT0,FMT='(" D_cs^lim (Farley et al.) XDCSLIM=",E13.6)') XDCSLIM
+ WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLCS=",E13.6)') XCOLCS
+END IF
+!
+NGAMINC = 80
+XGAMINC_BOUND_MIN = 1.0E-1 ! Minimal value of (Lbda * D_cs^lim)**alpha
+XGAMINC_BOUND_MAX = 1.0E7 ! Maximal value of (Lbda * D_cs^lim)**alpha
+ZRATE = EXP(LOG(XGAMINC_BOUND_MAX/XGAMINC_BOUND_MIN)/REAL(NGAMINC-1))
+!
+ALLOCATE( XGAMINC_RIM1(NGAMINC) )
+ALLOCATE( XGAMINC_RIM2(NGAMINC) )
+!
+DO J1=1,NGAMINC
+ ZBOUND = XGAMINC_BOUND_MIN*ZRATE**(J1-1)
+ XGAMINC_RIM1(J1) = GAMMA_INC(XNUS+(2.0+XDS)/XALPHAS,ZBOUND)
+ XGAMINC_RIM2(J1) = GAMMA_INC(XNUS+XBS/XALPHAS ,ZBOUND)
+END DO
+!
+XRIMINTP1 = XALPHAS / LOG(ZRATE)
+XRIMINTP2 = 1.0 + XRIMINTP1*LOG( XDCSLIM/(XGAMINC_BOUND_MIN)**(1.0/XALPHAS) )
+!
+!* 7.1.1 Defining the constants for the Hallett-Mossop
+! secondary ice nucleation process
+!
+XHMTMIN = XTT - 8.0
+XHMTMAX = XTT - 3.0
+XHM1 = 9.3E-3 ! Obsolete parameterization
+XHM2 = 1.5E-3/LOG(10.0) ! from Ferrier (1995)
+XHM_YIELD = 5.E-3 ! A splinter is produced after the riming of 200 droplets
+XHM_COLLCS= 1.0 ! Collision efficiency snow/droplet (with Dc>25 microns)
+XHM_FACTS = XHM_YIELD*(XHM_COLLCS/XCOLCS)
+!
+! Notice: One magnitude of lambda discretized over 10 points for the droplets
+!
+XGAMINC_HMC_BOUND_MIN = 1.0E-3 ! Min value of (Lbda * (12,25) microns)**alpha
+XGAMINC_HMC_BOUND_MAX = 1.0E5 ! Max value of (Lbda * (12,25) microns)**alpha
+ZRATE = EXP(LOG(XGAMINC_HMC_BOUND_MAX/XGAMINC_HMC_BOUND_MIN)/REAL(NGAMINC-1))
+!
+ALLOCATE( XGAMINC_HMC(NGAMINC) )
+!
+DO J1=1,NGAMINC
+ ZBOUND = XGAMINC_HMC_BOUND_MIN*ZRATE**(J1-1)
+ XGAMINC_HMC(J1) = GAMMA_INC(XNUC,ZBOUND)
+END DO
+!
+XHMSINTP1 = XALPHAC / LOG(ZRATE)
+XHMSINTP2 = 1.0 + XHMSINTP1*LOG( 12.E-6/(XGAMINC_HMC_BOUND_MIN)**(1.0/XALPHAC) )
+XHMLINTP1 = XALPHAC / LOG(ZRATE)
+XHMLINTP2 = 1.0 + XHMLINTP1*LOG( 25.E-6/(XGAMINC_HMC_BOUND_MIN)**(1.0/XALPHAC) )
+!
+!* 7.2 Constants for the accretion of raindrops onto aggregates
+!
+XFRACCSS = ((XPI**2)/24.0)*XCCS*XRHOLW*(ZRHO00**XCEXVT)
+!
+XLBRACCS1 = MOMG(XALPHAS,XNUS,2.)*MOMG(XALPHAR,XNUR,3.)
+XLBRACCS3 = MOMG(XALPHAR,XNUR,5.)
+!
+XFSACCRG = (XPI/4.0)*XAS*XCCS*(ZRHO00**XCEXVT)
+!
+XLBSACCR1 = MOMG(XALPHAR,XNUR,2.)*MOMG(XALPHAS,XNUS,XBS)
+XLBSACCR2 = 2.*MOMG(XALPHAR,XNUR,1.)*MOMG(XALPHAS,XNUS,XBS+1.)
+XLBSACCR3 = MOMG(XALPHAS,XNUS,XBS+2.)
+!
+!* 7.2.1 Defining the ranges for the computation of the kernels
+!
+! Notice: One magnitude of lambda discretized over 10 points for rain
+! Notice: One magnitude of lambda discretized over 10 points for snow
+!
+NACCLBDAS = 40
+XACCLBDAS_MIN = 5.0E1 ! Minimal value of Lbda_s to tabulate XKER_RACCS
+XACCLBDAS_MAX = 5.0E5 ! Maximal value of Lbda_s to tabulate XKER_RACCS
+ZRATE = LOG(XACCLBDAS_MAX/XACCLBDAS_MIN)/REAL(NACCLBDAS-1)
+XACCINTP1S = 1.0 / ZRATE
+XACCINTP2S = 1.0 - LOG( XACCLBDAS_MIN ) / ZRATE
+NACCLBDAR = 40
+XACCLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RACCS
+XACCLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RACCS
+ZRATE = LOG(XACCLBDAR_MAX/XACCLBDAR_MIN)/REAL(NACCLBDAR-1)
+XACCINTP1R = 1.0 / ZRATE
+XACCINTP2R = 1.0 - LOG( XACCLBDAR_MIN ) / ZRATE
+!
+!* 7.2.2 Computations of the tabulated normalized kernels
+!
+IND = 50 ! Interval number, collection efficiency and infinite diameter
+ZESR = 1.0 ! factor used to integrate the dimensional distributions when
+ZFDINFTY = 20.0 ! computing the kernels XKER_RACCSS, XKER_RACCS and XKER_SACCRG
+!
+ALLOCATE( XKER_RACCSS(NACCLBDAS,NACCLBDAR) )
+ALLOCATE( XKER_RACCS (NACCLBDAS,NACCLBDAR) )
+ALLOCATE( XKER_SACCRG(NACCLBDAR,NACCLBDAS) )
+!
+CALL READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
+ PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PCR,PDR, &
+ PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN,&
+ PFDINFTY )
+IF( (KACCLBDAS/=NACCLBDAS) .OR. (KACCLBDAR/=NACCLBDAR) .OR. (KND/=IND) .OR. &
+ (PALPHAS/=XALPHAS) .OR. (PNUS/=XNUS) .OR. &
+ (PALPHAR/=XALPHAR) .OR. (PNUR/=XNUR) .OR. &
+ (PESR/=ZESR) .OR. (PBS/=XBS) .OR. (PBR/=XBR) .OR. &
+ (PCS/=XCS) .OR. (PDS/=XDS) .OR. (PCR/=XCR) .OR. (PDR/=XDR) .OR. &
+ (PACCLBDAS_MAX/=XACCLBDAS_MAX) .OR. (PACCLBDAR_MAX/=XACCLBDAR_MAX) .OR. &
+ (PACCLBDAS_MIN/=XACCLBDAS_MIN) .OR. (PACCLBDAR_MIN/=XACCLBDAR_MIN) .OR. &
+ (PFDINFTY/=ZFDINFTY) ) THEN
+ CALL RRCOLSS ( IND, XALPHAS, XNUS, XALPHAR, XNUR, &
+ ZESR, XBR, XCS, XDS, XCR, XDR, &
+ XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
+ ZFDINFTY, XKER_RACCSS, XAG, XBS, XAS )
+ CALL RZCOLX ( IND, XALPHAS, XNUS, XALPHAR, XNUR, &
+ ZESR, XBR, XCS, XDS, XCR, XDR, &
+ XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
+ ZFDINFTY, XKER_RACCS )
+ CALL RSCOLRG ( IND, XALPHAS, XNUS, XALPHAR, XNUR, &
+ ZESR, XBS, XCS, XDS, XCR, XDR, &
+ XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
+ ZFDINFTY, XKER_SACCRG,XAG, XBS, XAS )
+ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF RACSS KERNELS ****")')
+ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF RACS KERNELS ****")')
+ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF SACRG KERNELS ****")')
+ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
+ WRITE(UNIT=ILUOUT0,FMT='("KACCLBDAS=",I3)') NACCLBDAS
+ WRITE(UNIT=ILUOUT0,FMT='("KACCLBDAR=",I3)') NACCLBDAR
+ WRITE(UNIT=ILUOUT0,FMT='("PALPHAS=",E13.6)') XALPHAS
+ WRITE(UNIT=ILUOUT0,FMT='("PNUS=",E13.6)') XNUS
+ WRITE(UNIT=ILUOUT0,FMT='("PALPHAR=",E13.6)') XALPHAR
+ WRITE(UNIT=ILUOUT0,FMT='("PNUR=",E13.6)') XNUR
+ WRITE(UNIT=ILUOUT0,FMT='("PESR=",E13.6)') ZESR
+ WRITE(UNIT=ILUOUT0,FMT='("PBS=",E13.6)') XBS
+ WRITE(UNIT=ILUOUT0,FMT='("PBR=",E13.6)') XBR
+ WRITE(UNIT=ILUOUT0,FMT='("PCS=",E13.6)') XCS
+ WRITE(UNIT=ILUOUT0,FMT='("PDS=",E13.6)') XDS
+ WRITE(UNIT=ILUOUT0,FMT='("PCR=",E13.6)') XCR
+ WRITE(UNIT=ILUOUT0,FMT='("PDR=",E13.6)') XDR
+ WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAS_MAX=",E13.6)') &
+ XACCLBDAS_MAX
+ WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAR_MAX=",E13.6)') &
+ XACCLBDAR_MAX
+ WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAS_MIN=",E13.6)') &
+ XACCLBDAS_MIN
+ WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAR_MIN=",E13.6)') &
+ XACCLBDAR_MIN
+ WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_RACCSS) ) THEN")')
+ DO J1 = 1 , NACCLBDAS
+ DO J2 = 1 , NACCLBDAR
+ WRITE(UNIT=ILUOUT0,FMT='(" PKER_RACCSS(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_RACCSS(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_RACCS ) ) THEN")')
+ DO J1 = 1 , NACCLBDAS
+ DO J2 = 1 , NACCLBDAR
+ WRITE(UNIT=ILUOUT0,FMT='(" PKER_RACCS (",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_RACCS (J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_SACCRG) ) THEN")')
+ DO J1 = 1 , NACCLBDAR
+ DO J2 = 1 , NACCLBDAS
+ WRITE(UNIT=ILUOUT0,FMT='(" PKER_SACCRG(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_SACCRG(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+ ELSE
+ CALL READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, &
+ PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PCR,PDR, &
+ PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN,&
+ PFDINFTY,XKER_RACCSS,XKER_RACCS,XKER_SACCRG )
+ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_RACCSS")')
+ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_RACCS ")')
+ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_SACCRG")')
+END IF
+!
+!* 7.3 Constant for the conversion-melting rate
+!
+XFSCVMG = 2.0
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" conversion-melting of the aggregates")')
+ WRITE(UNIT=ILUOUT0,FMT='(" Conv. factor XFSCVMG=",E13.6)') XFSCVMG
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. CONSTANTS FOR THE FAST COLD PROCESSES FOR THE GRAUPELN
+! ------------------------------------------------------
+!
+!
+!* 8.1 Constants for the rain contact freezing
+!
+XCOLIR = 1.0
+!
+! values of these coeficients differ from the single-momemt rain_ice case
+!
+XEXRCFRI = -XDR-5.0
+XRCFRI = ((XPI**2)/24.0)*XRHOLW*XCOLIR*XCR*(ZRHO00**XCEXVT) &
+ *MOMG(XALPHAR,XNUR,XDR+5.0)
+XEXICFRR = -XDR-2.0
+XICFRR = (XPI/4.0)*XCOLIR*XCR*(ZRHO00**XCEXVT) &
+ *MOMG(XALPHAR,XNUR,XDR+2.0)
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" rain contact freezing")')
+ WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLIR=",E13.6)') XCOLIR
+END IF
+!
+!
+!* 8.2 Constants for the dry growth of the graupeln
+!
+!* 8.2.1 Constants for the cloud droplet collection by the graupeln
+! and for the Hallett-Mossop process
+!
+XCOLCG = 0.6 ! Estimated from Cober and List (1993)
+XFCDRYG = (XPI/4.0)*XCOLCG*XCCG*XCG*(ZRHO00**XCEXVT)*MOMG(XALPHAG,XNUG,XDG+2.0)
+!
+XHM_COLLCG= 0.9 ! Collision efficiency graupel/droplet (with Dc>25 microns)
+XHM_FACTG = XHM_YIELD*(XHM_COLLCG/XCOLCG)
+!
+!* 8.2.2 Constants for the cloud ice collection by the graupeln
+!
+XCOLIG = 0.25 ! Collection efficiency of I+G
+XCOLEXIG = 0.05 ! Temperature factor of the I+G collection efficiency
+XCOLIG = 0.01 ! Collection efficiency of I+G
+XCOLEXIG = 0.1 ! Temperature factor of the I+G collection efficiency
+WRITE (ILUOUT0, FMT=*) ' NEW Constants for the cloud ice collection by the graupeln'
+WRITE (ILUOUT0, FMT=*) ' XCOLIG, XCOLEXIG = ',XCOLIG,XCOLEXIG
+XFIDRYG = (XPI/4.0)*XCOLIG*XCCG*XCG*(ZRHO00**XCEXVT)*MOMG(XALPHAG,XNUG,XDG+2.0)
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" cloud ice collection by the graupeln")')
+ WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLIG=",E13.6)') XCOLIG
+ WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XCOLEXIG=",E13.6)') XCOLEXIG
+END IF
+!
+!* 8.2.3 Constants for the aggregate collection by the graupeln
+!
+XCOLSG = 0.25 ! Collection efficiency of S+G
+XCOLEXSG = 0.05 ! Temperature factor of the S+G collection efficiency
+XCOLSG = 0.01 ! Collection efficiency of S+G
+XCOLEXSG = 0.1 ! Temperature factor of the S+G collection efficiency
+WRITE (ILUOUT0, FMT=*) ' NEW Constants for the aggregate collection by the graupeln'
+WRITE (ILUOUT0, FMT=*) ' XCOLSG, XCOLEXSG = ',XCOLSG,XCOLEXSG
+XFSDRYG = (XPI/4.0)*XCOLSG*XCCG*XCCS*XAS*(ZRHO00**XCEXVT)
+!
+XLBSDRYG1 = MOMG(XALPHAG,XNUG,2.)*MOMG(XALPHAS,XNUS,XBS)
+XLBSDRYG2 = 2.*MOMG(XALPHAG,XNUG,1.)*MOMG(XALPHAS,XNUS,XBS+1.)
+XLBSDRYG3 = MOMG(XALPHAS,XNUS,XBS+2.)
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" aggregate collection by the graupeln")')
+ WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLSG=",E13.6)') XCOLSG
+ WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XCOLEXSG=",E13.6)') XCOLEXSG
+END IF
+!
+!* 8.2.4 Constants for the raindrop collection by the graupeln
+!
+XFRDRYG = ((XPI**2)/24.0)*XCCG*XRHOLW*(ZRHO00**XCEXVT)
+!
+XLBRDRYG1 = MOMG(XALPHAG,XNUG,2.)*MOMG(XALPHAR,XNUR,3.)
+XLBRDRYG2 = 2.*MOMG(XALPHAG,XNUG,1.)*MOMG(XALPHAR,XNUR,4.)
+XLBRDRYG3 = MOMG(XALPHAR,XNUR,5.)
+!
+! Notice: One magnitude of lambda discretized over 10 points
+!
+NDRYLBDAR = 40
+XDRYLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RDRYG
+XDRYLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RDRYG
+ZRATE = LOG(XDRYLBDAR_MAX/XDRYLBDAR_MIN)/REAL(NDRYLBDAR-1)
+XDRYINTP1R = 1.0 / ZRATE
+XDRYINTP2R = 1.0 - LOG( XDRYLBDAR_MIN ) / ZRATE
+NDRYLBDAS = 80
+XDRYLBDAS_MIN = 2.5E1 ! Minimal value of Lbda_s to tabulate XKER_SDRYG
+XDRYLBDAS_MAX = 2.5E9 ! Maximal value of Lbda_s to tabulate XKER_SDRYG
+ZRATE = LOG(XDRYLBDAS_MAX/XDRYLBDAS_MIN)/REAL(NDRYLBDAS-1)
+XDRYINTP1S = 1.0 / ZRATE
+XDRYINTP2S = 1.0 - LOG( XDRYLBDAS_MIN ) / ZRATE
+NDRYLBDAG = 40
+XDRYLBDAG_MIN = 1.0E3 ! Min value of Lbda_g to tabulate XKER_SDRYG,XKER_RDRYG
+XDRYLBDAG_MAX = 1.0E7 ! Max value of Lbda_g to tabulate XKER_SDRYG,XKER_RDRYG
+ZRATE = LOG(XDRYLBDAG_MAX/XDRYLBDAG_MIN)/REAL(NDRYLBDAG-1)
+XDRYINTP1G = 1.0 / ZRATE
+XDRYINTP2G = 1.0 - LOG( XDRYLBDAG_MIN ) / ZRATE
+!
+!* 8.2.5 Computations of the tabulated normalized kernels
+!
+IND = 50 ! Interval number, collection efficiency and infinite diameter
+ZEGS = 1.0 ! factor used to integrate the dimensional distributions when
+ZFDINFTY = 20.0 ! computing the kernels XKER_SDRYG
+!
+ALLOCATE( XKER_SDRYG(NDRYLBDAG,NDRYLBDAS) )
+!
+CALL READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
+ PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS, &
+ PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
+ PFDINFTY )
+IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAS/=NDRYLBDAS) .OR. (KND/=IND) .OR. &
+ (PALPHAG/=XALPHAG) .OR. (PNUG/=XNUG) .OR. &
+ (PALPHAS/=XALPHAS) .OR. (PNUS/=XNUS) .OR. &
+ (PEGS/=ZEGS) .OR. (PBS/=XBS) .OR. &
+ (PCG/=XCG) .OR. (PDG/=XDG) .OR. (PCS/=XCS) .OR. (PDS/=XDS) .OR. &
+ (PDRYLBDAG_MAX/=XDRYLBDAG_MAX) .OR. (PDRYLBDAS_MAX/=XDRYLBDAS_MAX) .OR. &
+ (PDRYLBDAG_MIN/=XDRYLBDAG_MIN) .OR. (PDRYLBDAS_MIN/=XDRYLBDAS_MIN) .OR. &
+ (PFDINFTY/=ZFDINFTY) ) THEN
+ CALL RZCOLX ( IND, XALPHAG, XNUG, XALPHAS, XNUS, &
+ ZEGS, XBS, XCG, XDG, XCS, XDS, &
+ XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
+ ZFDINFTY, XKER_SDRYG )
+ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF SDRYG KERNELS ****")')
+ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
+ WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAG=",I3)') NDRYLBDAG
+ WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAS=",I3)') NDRYLBDAS
+ WRITE(UNIT=ILUOUT0,FMT='("PALPHAG=",E13.6)') XALPHAG
+ WRITE(UNIT=ILUOUT0,FMT='("PNUG=",E13.6)') XNUG
+ WRITE(UNIT=ILUOUT0,FMT='("PALPHAS=",E13.6)') XALPHAS
+ WRITE(UNIT=ILUOUT0,FMT='("PNUS=",E13.6)') XNUS
+ WRITE(UNIT=ILUOUT0,FMT='("PEGS=",E13.6)') ZEGS
+ WRITE(UNIT=ILUOUT0,FMT='("PBS=",E13.6)') XBS
+ WRITE(UNIT=ILUOUT0,FMT='("PCG=",E13.6)') XCG
+ WRITE(UNIT=ILUOUT0,FMT='("PDG=",E13.6)') XDG
+ WRITE(UNIT=ILUOUT0,FMT='("PCS=",E13.6)') XCS
+ WRITE(UNIT=ILUOUT0,FMT='("PDS=",E13.6)') XDS
+ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MAX=",E13.6)') &
+ XDRYLBDAG_MAX
+ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAS_MAX=",E13.6)') &
+ XDRYLBDAS_MAX
+ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MIN=",E13.6)') &
+ XDRYLBDAG_MIN
+ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAS_MIN=",E13.6)') &
+ XDRYLBDAS_MIN
+ WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_SDRYG) ) THEN")')
+ DO J1 = 1 , NDRYLBDAG
+ DO J2 = 1 , NDRYLBDAS
+ WRITE(UNIT=ILUOUT0,FMT='("PKER_SDRYG(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_SDRYG(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+ ELSE
+ CALL READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, &
+ PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS, &
+ PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, &
+ PFDINFTY,XKER_SDRYG )
+ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_SDRYG")')
+END IF
+!
+!
+IND = 50 ! Number of interval used to integrate the dimensional
+ZEGR = 1.0 ! distributions when computing the kernel XKER_RDRYG
+ZFDINFTY = 20.0
+!
+ALLOCATE( XKER_RDRYG(NDRYLBDAG,NDRYLBDAR) )
+!
+CALL READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
+ PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
+ PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, &
+ PFDINFTY )
+IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAR/=NDRYLBDAR) .OR. (KND/=IND) .OR. &
+ (PALPHAG/=XALPHAG) .OR. (PNUG/=XNUG) .OR. &
+ (PALPHAR/=XALPHAR) .OR. (PNUR/=XNUR) .OR. &
+ (PEGR/=ZEGR) .OR. (PBR/=XBR) .OR. &
+ (PCG/=XCG) .OR. (PDG/=XDG) .OR. (PCR/=XCR) .OR. (PDR/=XDR) .OR. &
+ (PDRYLBDAG_MAX/=XDRYLBDAG_MAX) .OR. (PDRYLBDAR_MAX/=XDRYLBDAR_MAX) .OR. &
+ (PDRYLBDAG_MIN/=XDRYLBDAG_MIN) .OR. (PDRYLBDAR_MIN/=XDRYLBDAR_MIN) .OR. &
+ (PFDINFTY/=ZFDINFTY) ) THEN
+ CALL RZCOLX ( IND, XALPHAG, XNUG, XALPHAR, XNUR, &
+ ZEGR, XBR, XCG, XDG, XCR, XDR, &
+ XDRYLBDAG_MAX, XDRYLBDAR_MAX, XDRYLBDAG_MIN, XDRYLBDAR_MIN, &
+ ZFDINFTY, XKER_RDRYG )
+ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+ WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF RDRYG KERNELS ****")')
+ WRITE(UNIT=ILUOUT0,FMT='("*****************************************")')
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND
+ WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAG=",I3)') NDRYLBDAG
+ WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAR=",I3)') NDRYLBDAR
+ WRITE(UNIT=ILUOUT0,FMT='("PALPHAG=",E13.6)') XALPHAG
+ WRITE(UNIT=ILUOUT0,FMT='("PNUG=",E13.6)') XNUG
+ WRITE(UNIT=ILUOUT0,FMT='("PALPHAR=",E13.6)') XALPHAR
+ WRITE(UNIT=ILUOUT0,FMT='("PNUR=",E13.6)') XNUR
+ WRITE(UNIT=ILUOUT0,FMT='("PEGR=",E13.6)') ZEGR
+ WRITE(UNIT=ILUOUT0,FMT='("PBR=",E13.6)') XBR
+ WRITE(UNIT=ILUOUT0,FMT='("PCG=",E13.6)') XCG
+ WRITE(UNIT=ILUOUT0,FMT='("PDG=",E13.6)') XDG
+ WRITE(UNIT=ILUOUT0,FMT='("PCR=",E13.6)') XCR
+ WRITE(UNIT=ILUOUT0,FMT='("PDR=",E13.6)') XDR
+ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MAX=",E13.6)') &
+ XDRYLBDAG_MAX
+ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAR_MAX=",E13.6)') &
+ XDRYLBDAR_MAX
+ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MIN=",E13.6)') &
+ XDRYLBDAG_MIN
+ WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAR_MIN=",E13.6)') &
+ XDRYLBDAR_MIN
+ WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY
+ WRITE(UNIT=ILUOUT0,FMT='("!")')
+ WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_RDRYG) ) THEN")')
+ DO J1 = 1 , NDRYLBDAG
+ DO J2 = 1 , NDRYLBDAR
+ WRITE(UNIT=ILUOUT0,FMT='("PKER_RDRYG(",I3,",",I3,") = ",E13.6)') &
+ J1,J2,XKER_RDRYG(J1,J2)
+ END DO
+ END DO
+ WRITE(UNIT=ILUOUT0,FMT='("END IF")')
+ ELSE
+ CALL READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, &
+ PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, &
+ PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, &
+ PFDINFTY,XKER_RDRYG )
+ WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_RDRYG")')
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 9. SET-UP RADIATIVE PARAMETERS
+! ---------------------------
+!
+! R_eff_i = XFREFFI * (rho*r_i/N_i)**(1/3)
+!
+!
+XFREFFI = 0.5 * ZGAMI(8) * (1.0/XLBI)**XLBEXI
+!
+!-------------------------------------------------------------------------------
+!
+!* 10. SOME PRINTS FOR CONTROL
+! -----------------------
+!
+GFLAG = .TRUE.
+IF (GFLAG) THEN
+ WRITE(UNIT=ILUOUT0,FMT='(" Summary of the ice particule characteristics")')
+ WRITE(UNIT=ILUOUT0,FMT='(" PRISTINE ICE")')
+ WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+ XAI,XBI
+ WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+ XC_I,XDI
+ WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+ XALPHAI,XNUI
+ WRITE(UNIT=ILUOUT0,FMT='(" SNOW")')
+ WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+ XAS,XBS
+ WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+ XCS,XDS
+ WRITE(UNIT=ILUOUT0,FMT='(" concentration:CC=",E13.6," x=",E13.6)') &
+ XCCS,XCXS
+ WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+ XALPHAS,XNUS
+ WRITE(UNIT=ILUOUT0,FMT='(" GRAUPEL")')
+ WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') &
+ XAG,XBG
+ WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') &
+ XCG,XDG
+ WRITE(UNIT=ILUOUT0,FMT='(" concentration:CC=",E13.6," x=",E13.6)') &
+ XCCG,XCXG
+ WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') &
+ XALPHAG,XNUG
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+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 :: PALPHA ! first shape parameter of the dimensionnal distribution
+ REAL :: PNU ! second shape parameter of the dimensionnal distribution
+ REAL :: PP ! order of the moment
+ REAL :: PMOMG ! result: moment of order ZP
+!
+!------------------------------------------------------------------------------
+!
+!
+ PMOMG = GAMMA(PNU+PP/PALPHA)/GAMMA(PNU)
+!
+ END FUNCTION MOMG
+!
+!------------------------------------------------------------------------------
+!
+!
+END SUBROUTINE INI_ICE_C1R3
diff --git a/src/mesonh/micro/ini_param_elec.f90 b/src/mesonh/micro/ini_param_elec.f90
new file mode 100644
index 0000000000000000000000000000000000000000..d1eeb198f7d42d3312907491699c9bcf5a198609
--- /dev/null
+++ b/src/mesonh/micro/ini_param_elec.f90
@@ -0,0 +1,1093 @@
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ##########################
+ MODULE MODI_INI_PARAM_ELEC
+! ##########################
+!
+INTERFACE
+!
+ SUBROUTINE INI_PARAM_ELEC (TPINIFILE, HGETSVM, PRHO00, &
+ KRR, KND, PFDINFTY, IIU, IJU, IKU )
+!
+USE MODD_IO, ONLY : TFILEDATA
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file
+CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVM
+INTEGER, INTENT(IN) :: KND ! Number of intervals to integrate kernels
+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
+!
+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 )
+! ##############################################################
+!
+!!**** *INI_PARAM_ELEC* - initialize the constants necessary
+!! for the electrical scheme.
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to initialize the constants used to
+!! resolve the electrical scheme.
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!! Helsdon and Farley, 1987: A numerical study of a Montana thunderstorm:
+!! 2. Model results versus observations involving electrical aspects.
+!! J. Geophys. Res., 92, 5661-5675.
+!!
+!! Takahashi, 1978: Riming electrification as a charge generation
+!! mechanism in thunderstorms. J. Atmos. Sci., 35, 1536-1548.
+!!
+!! Gardiner et al., 1985: Measurements of initial potential gradient and
+!! particles charges in a Montana supercell thunderstorm.
+!! J. Geophys. Res., 90, 6079-6086.
+!!
+!! Saunders et al., 1991: The effect of liquid water on thunderstorm
+!! charging. J. Geophys. Res., 96, 11007-11017.
+!!
+!! AUTHOR
+!! ------
+!! Gilles Molinie * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! C. Barthe 01/02/2004 coefficients f/b
+!! C. Barthe 21/05/2004 Add limitations for the NI processes
+!! C. Barthe 31/05/2004 Add constants for the inductive process
+!! C. Barthe 10/11/2009 Update to Masdev 4.8.1
+!! M. Chong 26/01/10 Small ions parameters
+!! +Fair weather field from Helsdon-Farley
+!! (JGR, 1987, 5661-5675)
+!! J.-P. Pinty jan 2015 tabulate the equations for Saunders
+!! J. Escobar 8/01/2016 bug , missing YDIR='XY' in READ
+!! 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
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_ELEC_n
+USE MODD_ELEC_DESCR
+USE MODD_ELEC_PARAM
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_NSV, ONLY: NSV_ELECEND
+USE MODD_PARAMETERS
+USE MODD_PARAM_ICE
+USE MODD_RAIN_ICE_DESCR
+USE MODD_RAIN_ICE_PARAM
+USE MODD_VAR_ll
+!
+USE MODE_IO_FIELD_READ, only: IO_Field_read
+!
+USE MODI_MOMG
+USE MODE_RRCOLSS, ONLY: RRCOLSS
+USE MODE_RSCOLRG, ONLY: RSCOLRG
+USE MODE_RZCOLX, ONLY: RZCOLX
+USE MODI_VQZCOLX
+!
+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
+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
+!
+REAL :: ZESR ! Mean efficiency of rain-aggregate collection
+REAL :: ZEGS !
+REAL :: ZEGR
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZMANSELL1, ZMANSELL2 ! Used to initialize
+ ! XMANSELL array
+!
+INTEGER :: JLWC, JTEMP
+REAL, DIMENSION(:), ALLOCATABLE :: ZT, ZLWCC, ZEW
+!
+!-------------------------------------------------------------------------------
+! constants for electricity
+!
+XEPSILON = 8.85E-12 ! Dielectric permittivity of the air
+XECHARGE = 1.6E-19 ! Elementary charge (C)
+!
+!* 1. SHAPE PARAMETERS
+! ----------------
+!
+XCXR = -1.0 ! Raindrop characteristic : XCXR (not declared in ini_rain_ice.f90)
+!
+! Individual charge q(d) = e_x * d ** f_x with f_x = XFx
+!
+XFC = 0.5 ! cloud
+XFR = 1.3 ! rain
+XFI = 0.5 ! pristine ice
+XFS = 1.3 ! snow
+XFG = 2.0 ! graupel
+XFH = 2.0 ! hail
+!
+! Min/max values of e_x
+!
+XEGMIN = 1.E-12
+XEGMAX = 1.E-3
+!
+XESMIN = 1.E-14
+XESMAX = 1.E-4
+!
+XEIMIN = 1.E-12
+XEIMAX = 1.E-3
+!
+XECMIN = 1.E-12
+XECMAX = 1.E-3
+!
+XERMIN = 1.E-14
+XERMAX = 1.E-4
+!
+XEHMIN = 1.E-14
+XEHMAX = 1.E-4
+!
+! E=E_0 * exp(k_e*z)
+XE_0 = -100.
+XKEF = -2.E-4 ! 229.E-6
+!
+! E=E_0 (b1 exp(-a1 z) + b2 exp(-a2 z) + b3 exp(-a3 z) : Helsdon-Farley, 1987
+XE0_HF = -80.
+XA1_HF = 4.5E-3
+XB1_HF = 0.5
+XA2_HF = 3.8E-4
+XB2_HF = 0.65
+XA3_HF = 1.0E-4
+XB3_HF = 0.1
+!
+XIONCOMB = 1.6E-12
+XF_POS = 1.4E-4
+XF_NEG = 1.9E-4
+XEXPMOB = 1.4E-4
+!
+XFCORONA = 2.E-20
+XECORONA = 5000.
+!
+XJCURR_FW = -2.7E-12
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. COEFFICIENTS FOR CHARGE TRANSFERS
+! ---------------------------------
+!
+! proportionality coefficient between mass transfer and charge transfer rates
+! the mixing ratio is proportional to the volume of the particle
+! the electric charge is proportional to the surface of the particle
+!
+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
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. HOMOGENEOUS NUCLEATION
+! ----------------------
+!
+XALPHACQ = 3. !>
+XNUCQ = 1. ! >--- generic values
+XLBDACQ = 1.1E5 !>
+!
+XQHON = (1. / XRHOLW)
+XQHON = XQHON * MOMG(XALPHACQ,XNUCQ,XFC+3.)
+XQHON = XQHON / MOMG(XALPHACQ,XNUCQ,3.)
+XQHON = XQHON / (XLBDACQ**XFC)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. SEDIMENTATION
+! -------------
+IF (ALLOCATED(XQTMIN)) DEALLOCATE(XQTMIN)
+IF (ALLOCATED(XRTMIN_ELEC)) DEALLOCATE(XRTMIN_ELEC)
+!
+IF (KRR == 6) THEN
+ ALLOCATE( XQTMIN(6) )
+ ALLOCATE( XRTMIN_ELEC(6) )
+ELSE IF (KRR == 7) THEN
+ ALLOCATE( XQTMIN(7) )
+ ALLOCATE( XRTMIN_ELEC(7) )
+END IF
+!
+XQTMIN(1) = 1.0E-17 !
+XQTMIN(2) = 1.0E-17 !
+XQTMIN(3) = 1.0E-17 ! ten particles per cubic meter that carried a charge
+XQTMIN(4) = 1.0E-17 ! of one electron
+XQTMIN(5) = 1.0E-17 !
+XQTMIN(6) = 1.0E-17 !
+IF (KRR == 7) XQTMIN(7) = 1.0E-17 !
+!
+XRTMIN_ELEC(1) = 1.0E-6
+XRTMIN_ELEC(2) = 1.0E-6
+XRTMIN_ELEC(3) = 1.0E-6
+XRTMIN_ELEC(4) = 1.0E-6
+XRTMIN_ELEC(5) = 1.0E-6
+XRTMIN_ELEC(6) = 1.0E-6
+IF (KRR == 7) XRTMIN_ELEC(7) = 1.0E-6
+!
+XLBDAR_MAXE = 2.E3 ! Less than 10000 particles in cube meter of cloud.
+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
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 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)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. RIMING OF CLOUD DROPLETS ON SNOW
+! --------------------------------
+!
+XEXQSRIMCG = XCXS - XFS
+XQSRIMCG = XCCS * MOMG(XALPHAS,XNUS,XFS)
+!
+! The array containing the tabulated function M(fs,D_cs^lim)/M(fs)
+! is implemented in ini_rain_ice.f90
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 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
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. INITIALIZATIONS FOR THE NON INDUCTIVE PROCESSES
+! -----------------------------------------------
+!
+! arrays allocation for NI charging rate
+!
+ALLOCATE( XNI_SDRYG(IIU, IJU, IKU) )
+ALLOCATE( XNI_IDRYG(IIU, IJU, IKU) )
+ALLOCATE( XNI_IAGGS(IIU, IJU, IKU) )
+ALLOCATE( XIND_RATE(IIU, IJU, IKU) )
+ALLOCATE( XEW(IIU, IJU, IKU) )
+XEW(:,:,:) = 0.
+!
+SELECT CASE(HGETSVM(NSV_ELECEND))
+ CASE ('READ')
+ CALL IO_Field_read(TPINIFILE,'NI_IAGGS',XNI_IAGGS)
+ CALL IO_Field_read(TPINIFILE,'NI_IDRYG',XNI_IDRYG)
+ CALL IO_Field_read(TPINIFILE,'NI_SDRYG',XNI_SDRYG)
+ CALL IO_Field_read(TPINIFILE,'INDUC_CG',XIND_RATE)
+ CASE ('INIT')
+ XNI_IAGGS(:,:,:) = 0.
+ XNI_IDRYG(:,:,:) = 0.
+ XNI_SDRYG(:,:,:) = 0.
+ XIND_RATE(:,:,:) = 0.
+END SELECT
+
+!
+!* 8.1 Gardiner et al. (1985) parameterization
+!
+IF (CNI_CHARGING == 'GARDI') THEN
+ XLWCC = 0.1 ! g.m^-3
+END IF
+!
+!
+!* 8.2 Saunders et al. (1991) and
+!* Saunders and Peck (1998) parameterizations
+!
+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
+!
+! ice particle = the smallest particle (I-S and I-G collisions)
+ XIMP = 3.76 ! for positive charge
+ XINP = 2.5
+ XIKP = 4.92E13
+ XIKP_TAK = 6.1E12 ! for Takahashi
+ XIMN = 2.54 ! for negative charge
+ XINN = 2.8
+ XIKN = 5.25E8
+ XIKN_TAK = 4.3E7 ! for Takahashi
+!
+! snow = the smallest particle (S-G collisions)
+ XSMP = 0.44 ! for positive charge
+ XSNP = 2.5
+ XSKP = 52.8
+ XSKP_TAK = 6.5 ! for Takahashi
+ XSMN = 0.5 ! for negative charge
+ XSNN = 2.8
+ 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)
+!
+ 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)
+!
+ 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)
+!
+ 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)
+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)
+END IF
+!
+!
+!* 8.3 Takahashi (1978) parameterization
+!
+IF (CNI_CHARGING == 'TAKAH') THEN
+!
+! last column and line are duplicated for interpolation
+ NIND_TEMP = 31
+ NIND_LWC = 28
+ IF( .NOT.ALLOCATED(XMANSELL)) ALLOCATE( XMANSELL(NIND_LWC+1,NIND_TEMP+1))
+ ALLOCATE( ZMANSELL1(29,16) )
+ ALLOCATE( ZMANSELL2(29,16) )
+ ZMANSELL1 = RESHAPE( &
+(/ 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , 1.65, 3.3 , &
+ 4.95, 13.2 , 19.8 , 26.4 , 31.02, 33.0 , 42.9 , 46.2 , 49.5 , &
+ 52.8 , 49.5 , 39.6 , 36.3 , 32.34, 32.01, 32.01, 31.68, 31.35, 31.35, 31.35,&
+ 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , 0.33, 2.64, 4.95, 6.6 , &
+ 6.93, 15.18, 23.1 , 29.7 , 33.0 , 36.3 , 49.5 , 52.8 , 52.8 , &
+ 52.8 , 49.5 , 36.3 , 33.0 , 32.34, 32.01, 32.01, 31.35, 31.35, 31.35, 31.35,&
+ 0.0 , 0.0 , 0.0 , 0.0 , 0.33, 3.3 , 4.95, 6.6 , 7.59, &
+ 9.24, 17.16, 26.4 , 32.34, 36.3 , 39.6 , 52.8 , 56.1 , 56.1 , &
+ 56.1 , 42.9 , 33.0 , 32.01, 32.01, 31.68, 31.68, 31.02, 31.02, 30.36, 30.36,&
+ 0.0 , 0.0 , 0.0 , 0.33, 2.97, 5.61, 7.26, 8.25, 9.9 , &
+ 10.56, 19.8 , 28.71, 36.3 , 39.6 , 46.2 , 56.1 , 59.4 , 59.4 , &
+ 59.4 , 42.9 , 31.35, 31.35, 31.68, 31.35, 30.69, 30.36, 31.02, 30.03, 30.03,&
+ 0.0 , 0.0 , 0.33, 2.64, 5.61, 7.59, 9.24, 9.9 , 11.22, &
+ 11.88, 22.44, 31.35, 39.6 , 47.2 , 52.8 , 59.4 , 62.7 , 62.7 , &
+ 52.8 , 33.0 , 30.69, 30.69, 30.36, 30.69, 30.36, 30.03, 30.36, 30.03, 30.03,&
+ 0.0 , 0.0 , 0.33, 4.29, 7.26, 8.91, 10.23, 11.55, 12.21, &
+ 13.2 , 24.09, 33.0 , 39.6 , 49.5 , 56.1 , 56.1 , 56.1 , 66.0 , &
+ 49.5 , 31.35, 30.03, 29.7 , 29.37, 29.37, 29.37, 29.04, 30.03, 29.04, 29.04,&
+ 0.0 , 0.0 , 2.31, 6.6 , 8.91, 9.9 , 11.22, 13.2 , 13.2 , &
+ 14.85, 25.08, 36.3 , 42.9 , 49.5 , 52.8 , 46.2 , 42.9 , 52.8 , &
+ 42.9 , 28.05, 28.05, 29.71, 28.38, 28.71, 28.71, 28.71, 29.37, 28.71, 28.71,&
+ 0.0 , 0.0 , 4.29, 7.59, 9.9 , 10.23, 11.22, 14.85, 14.85, &
+ 16.5 , 26.4 , 36.3 , 42.9 , 42.9 , 46.2 , 42.9 , 39.6 , 46.2 , &
+ 33.0 , 24.75, 26.4 , 27.39, 27.39, 27.72, 28.05, 28.38, 29.04, 28.05, 28.05,&
+ 0.0 , 0.0 , 6.27, 9.24, 10.56, 12.21, 11.88, 15.18, 15.84, &
+ 16.5 , 27.39, 33.0 , 39.6 , 39.6 , 39.6 , 36.3 , 33.0 , 39.6 , &
+ 19.8 , 16.5 , 23.1 , 25.74, 26.73, 27.06, 27.39, 27.39, 28.38, 27.39, 27.39,&
+ 0.0 , 0.66, 6.93, 9.57, 11.22, 12.87, 12.54, 15.51, 16.5 , &
+ 18.15, 27.39, 31.02, 36.3 , 33.0 , 29.7 , 23.1 , 19.8 , 26.4 , &
+ 9.9 , 0.99, 20.46, 23.43, 25.41, 26.4 , 27.06, 27.06, 27.39, 27.06, 27.06,&
+ 0.0 , 2.64, 7.59, 10.23, 11.88, 13.53, 13.2 , 15.84, 16.5 , &
+ 19.14, 27.06, 28.71, 33.0 , 26.4 , 21.45, 16.5 , 9.9 , 3.3 , &
+ 0.0 , -6.6 , 18.15, 21.45, 23.76, 25.08, 26.07, 26.73, 26.73, 26.73, 26.73,&
+ 0.0 , 3.3 , 8.25, 10.89, 11.88, 13.53, 13.86, 15.84, 16.83, &
+ 18.81, 26.73, 27.39, 28.71, 21.45, 16.5 , 3.3 , 0.99, -0.99, &
+ -4.95,-16.5 , 16.5 , 19.8 , 22.77, 24.09, 25.08, 25.41, 25.74, 26.4 , 26.4 ,&
+ 0.0 , 4.62, 8.91, 11.22, 12.21, 13.53, 14.85, 16.17, 16.83, &
+ 18.81, 25.74, 26.4 , 26.4 , 16.5 , 2.97, 0.0 , -1.98, -9.9 , &
+ -11.55,-19.8 , 3.3 , 18.15, 20.13, 23.1 , 23.76, 24.42, 25.41, 25.41, 25.41,&
+ 0.0 , 5.8 , 9.24, 11.22, 12.54, 13.86, 15.18, 15.84, 16.83, &
+ 18.48, 24.42, 23.43, 22.44, 3.3 , 0.0 , -1.98, -4.29, -9.9 , &
+ -13.2 ,-26.4 , 0.0 , 16.83, 19.14, 21.45, 23.1 , 23.76, 24.42, 24.75, 24.75,&
+ 0.0 , 5.94, 9.57, 11.22, 12.54, 13.86, 14.85, 15.84, 16.5 , &
+ 17.82, 23.1 , 20.79, 19.47, 0.33, -1.32, -3.3 , -6.6 , -9.9 , &
+ -14.85,-33.0 , -0.33, 14.85, 18.48, 19.8 , 21.78, 23.1 , 23.76, 24.42, 24.42,&
+ 0.0 , 5.94, 9.57, 11.22, 12.54, 13.53, 14.85, 15.51, 16.5 , &
+ 16.83, 21.45, 17.82, 9.9 , -0.33, -2.31, -3.3 , -8.25, -9.99, &
+ -14.85,-33.0 , -1.32, 4.95, 17.49, 19.47, 20.79, 22.44, 23.43, 24.09, 24.09/)&
+ ,(/29, 16/))
+ ZMANSELL2 = RESHAPE( &
+(/ 0.0 , 6.27, 9.57, 10.89, 12.21, 13.53, 14.52, 15.18, 15.84, &
+ 16.17, 19.47, 9.9 , 0.0 , -0.99, -2.97, -4.95, -9.99, -9.99, &
+ -14.85,-29.7 , -2.97, 3.3 , 16.83, 19.14, 19.47, 21.12, 22.44, 23.43, 23.43,&
+ 0.0 , 5.94, 9.57, 10.89, 12.21, 13.2 , 14.19, 14.85, 15.18, &
+ 15.51, 17.16, 3.3 , -0.33, -1.65, -3.3 , -6.6 , -9.99, -9.99, &
+ -13.2 ,-28.1 , -3.3 , 2.64, 16.5 , 17.82, 19.14, 20.13, 21.45, 22.77, 22.77,&
+ 0.0 , 5.61, 8.91, 10.89, 11.88, 13.2 , 13.86, 14.52, 14.85, &
+ 14.85, 9.9 , 1.65, -0.99, -1.98, -3.3 , -6.6 , -9.99, -9.99, &
+ -13.2 ,-26.4 , -3.3 , 1.65, 13.2 , 17.49, 18.81, 19.8 , 20.79, 22.11, 22.11,&
+ 0.0 , 5.28, 8.58, 10.56, 11.55, 12.54, 13.2 , 13.86, 14.19, &
+ 13.86, 6.6 , 0.0 , -1.32, -2.31, -3.3 , -6.6 , -9.99, -9.99, &
+ -13.2 ,-24.8 , -3.3 , 1.32, 6.6 , 17.16, 18.48, 19.47, 20.46, 21.45, 21.45,&
+ 0.0 , 4.95, 8.25, 9.9 , 11.22, 11.88, 12.54, 12.87, 13.2 , &
+ 13.2 , 3.3 , -0.66, -1.98, -2.64, -3.3 , -6.6 , -9.9 , -9.9 , &
+ -13.2 ,-23.1 , -3.3 , 0.66, 4.95, 16.5 , 17.82, 18.81, 19.8 , 20.46, 20.46,&
+ 0.0 , 4.29, 7.59, 9.57, 10.56, 11.55, 11.88, 11.88, 12.21, &
+ 11.88, 2.64, -0.66, -2.31, -2.64, -3.3 , -6.6 , -9.9 , -9.9 , &
+ -13.2 ,-21.5 , -3.3 , 0.0 , 4.29, 14.85, 17.16, 18.48, 19.47, 20.13, 20.13,&
+ 0.0 , 3.96, 6.93, 8.91, 9.9 , 10.89, 10.89, 10.89, 10.89, &
+ 10.56, 0.99, -0.66, -2.31, -2.64, -3.3 , -6.6 , -9.9 , -9.99, &
+ -13.2 ,-19.8 , -6.6 , 0.0 , 3.3 , 13.2 , 16.83, 18.15, 19.47, 19.8 , 19.8 ,&
+ 0.0 , 2.97, 6.27, 8.25, 9.24, 9.9 , 10.23, 10.23, 9.9 , &
+ 9.57, 0.0 , -0.99, -2.31, -2.64, -3.3 , -6.6 , -9.9 , -9.99, &
+ -11.55,-18.2 , -9.9 , 0.0 , 3.3 , 11.55, 16.5 , 17.82, 18.81, 19.8 , 19.8 ,&
+ 0.0 , 0.66, 5.61, 7.59, 8.91, 9.24, 9.24, 9.24, 8.91, &
+ 8.58, 0.0 , -0.99, -1.98, -2.64, -3.3 , -6.6 , -9.9 , -9.9 , &
+ -11.55,-17.5 , -6.6 , 0.0 , 2.97, 8.25, 16.5 , 17.16, 18.48, 19.47, 19.47,&
+ 0.0 , 0.0 , 4.29, 6.6 , 7.59, 8.25, 8.25, 7.59, 7.92, &
+ 7.59, -0.33, -1.32, -1.98, -2.64, -3.3 , -4.95, -9.9 , -9.9 , &
+ -9.9 ,-16.5 , -6.6 , 0.0 , 2.97, 6.6 , 14.85, 16.83, 18.15, 19.47, 19.47,&
+ 0.0 , 0.0 , 2.64, 5.28, 6.93, 7.26, 7.59, 7.26, 6.93, &
+ 6.6 , -0.66, -1.32, -1.98, -2.64, -3.3 , -4.29, -8.25, -9.9 , &
+ -9.9 ,-16.5 , -6.6 , 0.0 , 2.64, 6.6 , 14.85, 16.5 , 17.82, 19.14, 19.14,&
+ 0.0 , 0.0 , 0.33, 3.63, 5.61, 6.6 , 6.6 , 6.6 , 4.95, &
+ 3.63, -0.66, -1.32, -1.98, -2.64, -3.3 , -3.3 , -6.6 , -8.25, &
+ -8.25,-16.5 , -6.6 , 0.0 , 2.64, 6.6 , 13.2 , 16.5 , 17.49, 18.81, 18.81,&
+ 0.0 , 0.0 , 0.0 , 0.99, 3.3 , 4.29, 4.29, 4.62, 3.3 , &
+ 2.97, -0.66, -1.32, -1.98, -2.64, -2.97, -2.97, -3.3 , -4.95, &
+ -4.95,-15.8 , -4.95, 0.0 , 2.31, 6.6 , 11.55, 16.5 , 17.49, 18.15, 18.15,&
+ 0.0 , 0.0 , 0.0 , 0.0 , 0.99, 3.3 , 2.64, 2.31, 2.31, &
+ 2.31, -0.66, -1.32, -1.98, -2.31, -2.97, -2.64, -2.97, -3.63, &
+ -4.95, -9.99, -4.95, 0.0 , 2.31, 6.6 , 9.9 , 14.85, 17.16, 18.15, 18.15,&
+ 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , 0.66, 0.99, 1.65, 1.98, &
+ 1.65, -0.66, -1.32, -1.65, -2.31, -2.64, -2.64, -2.97, -2.97, &
+ -3.3 , -9.99, -3.3 , 0.0 , 2.31, 6.6 , 9.9 , 14.85, 17.16, 18.15, 18.15,&
+ 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , 0.66, 0.99, 1.65, 1.98, &
+ 1.65, -0.66, -1.32, -1.65, -2.31, -2.64, -2.64, -2.97, -2.97, &
+ -3.3 , -9.99, -3.3 , 0.0 , 2.31, 6.6 , 9.9 , 14.85, 17.16, 18.15, 18.15/)&
+ ,(/29, 16/))
+ XMANSELL(:, 1:16) = ZMANSELL1(:,:)
+ XMANSELL(:,17:32) = ZMANSELL2(:,:)
+ DEALLOCATE(ZMANSELL1)
+ DEALLOCATE(ZMANSELL2)
+!
+ XMANSELL(:,:) = XMANSELL(:,:) * 1.E-15 ! in C
+END IF
+!
+!
+!* 8.4 Saunders et al. (1991) parameterization
+! Idem for Brooks et al. (1997), but with EW = ZRAR/3.
+!
+!
+IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2') THEN
+!
+ NIND_TEMP = 31
+ NIND_LWC = 28
+!
+ IF( .NOT.ALLOCATED(XSAUNDER)) ALLOCATE(XSAUNDER(NIND_LWC+1,NIND_TEMP+1))
+ ALLOCATE(ZT(NIND_TEMP+1)) ! Kelvin
+ ALLOCATE(ZLWCC(NIND_TEMP+1))
+ DO JTEMP = 1, NIND_TEMP+1
+ 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))
+!
+! LWC index (0.01 g.m^-3 --> 10 g.m^-3)
+! 0.01 to 0.09 every 0.01 (9 values)
+! 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)
+ END DO
+ DO JLWC = 10, 18
+ ZEW(JLWC)=0.1 + 0.1*REAL(JLWC-10)
+ END DO
+ DO JLWC = 19, NIND_LWC+1
+ ZEW(JLWC)=1.0 + REAL(JLWC-19)
+ END DO
+!
+!
+ XSAUNDER(:,:) = 0.0
+ DO JTEMP = 1, NIND_TEMP+1
+ DO JLWC = 1, NIND_LWC+1
+!
+! region S4 : positive
+ IF (ZT(JTEMP) <= (XTT-7.35) .AND. ZT(JTEMP) > (XTT-23.9458) .AND. &
+ ZEW(JLWC) > ZLWCC(JTEMP)) THEN
+ XSAUNDER(JLWC,JTEMP) = MAX( 0., &
+ 20.22*ZEW(JLWC)+1.36*(ZT(JTEMP)-XTT)+10.05 )
+ ENDIF
+!
+! region S1 : positive --> linear interpolation
+ IF (ZT(JTEMP) > (XTT-7.35) .AND. ZT(JTEMP) < XTT .AND. &
+ ZEW(JLWC) > ZLWCC(JTEMP)) THEN
+ XSAUNDER(JLWC,JTEMP) = MAX( 0.,-(2.75*ZEW(JLWC)+0.007)*(ZT(JTEMP)-XTT) )
+ ENDIF
+!
+! region S8 : positive
+ IF (ZT(JTEMP) <= (XTT-23.9458) .AND. ZT(JTEMP) > (XTT-40.0) .AND. &
+ ZEW(JLWC) > ZLWCC(JTEMP)) THEN
+ XSAUNDER(JLWC,JTEMP) = MAX( 0.,20.22*ZEW(JLWC)-22.26 )
+ ENDIF
+!
+! region S7 : negative
+ IF (ZT(JTEMP) <= (XTT-7.35) .AND. ZT(JTEMP) > (XTT-40.0) .AND. &
+ ZEW(JLWC) >= 0.104149 .AND. ZEW(JLWC) < ZLWCC(JTEMP)) THEN
+ XSAUNDER(JLWC,JTEMP) = MIN( 0.,3.02-31.76*ZEW(JLWC)+26.53*ZEW(JLWC)**2 )
+ ENDIF
+ END DO
+ END DO
+END IF
+!
+! SAUN1 doesn't take into account marginal positive and negative regions at
+! low LWC
+!
+IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'BSMP1') THEN
+ DO JTEMP = 1, NIND_TEMP+1
+ DO JLWC = 1, NIND_LWC+1
+!
+! region S1 : negative --> linear interpolation
+ IF (ZT(JTEMP) > (XTT-7.35) .AND. ZT(JTEMP) < XTT .AND. &
+ ZEW(JLWC) < ZLWCC(JTEMP) .AND. ZEW(JLWC) >= 0.104149) THEN
+ XSAUNDER(JLWC,JTEMP) = MIN( 0., &
+ (-0.41+4.32*ZEW(JLWC)-3.61*ZEW(JLWC)**2)*(ZT(JTEMP)-XTT) )
+ ENDIF
+ END DO
+ END DO
+!
+ XSAUNDER(:,:) = XSAUNDER(:,:) * 1.E-15 ! in C
+!
+END IF
+!
+! SAUN2 takes into account marginal positive and negative regions at low LWC
+!
+IF (CNI_CHARGING == 'SAUN2' .OR. CNI_CHARGING == 'BSMP2') THEN
+ DO JTEMP = 1, NIND_TEMP+1
+ DO JLWC = 1, NIND_LWC+1
+!
+! region S2 : negative
+ IF (ZT(JTEMP) <= (XTT-7.35) .AND. ZT(JTEMP) > (XTT-16.0) .AND. &
+ ZEW(JLWC) >= 0.026 .AND. ZEW(JLWC) < 0.14) THEN
+ XSAUNDER(JLWC,JTEMP) = MIN( 0.,-314.4*ZEW(JLWC) + 7.92 )
+ ENDIF
+!
+! region S3 : negative
+ IF (ZT(JTEMP) <= (XTT-7.35) .AND. ZT(JTEMP) > (XTT-16.0) .AND. &
+ ZEW(JLWC) >= 0.14 .AND. ZEW(JLWC) < 0.22) THEN
+ XSAUNDER(JLWC,JTEMP) = MIN( 0.,419.4 * ZEW(JLWC) - 92.64 )
+ ENDIF
+!
+! region S5 : positive
+ IF (ZT(JTEMP) < (XTT-20.0) .AND. ZT(JTEMP) > (XTT-40.0) .AND. &
+ ZEW(JLWC) >= 0.063034 .AND. ZEW(JLWC) < 0.12) THEN
+ XSAUNDER(JLWC,JTEMP) = MAX( 0.,2041.76*ZEW(JLWC) - 128.7 )
+ ENDIF
+!
+! region S6 : positive
+ IF (ZT(JTEMP) < (XTT-20.0) .AND. ZT(JTEMP) > (XTT-40.0) .AND. &
+ ZEW(JLWC) >= 0.12 .AND. ZEW(JLWC) < 0.1596) THEN
+ XSAUNDER(JLWC,JTEMP) = MAX( 0.,-2900.22*ZEW(JLWC) + 462.91 )
+ ENDIF
+!
+! region S1 : negative --> linear interpolation of S3
+ IF (ZT(JTEMP) > (XTT-7.35) .AND. ZT(JTEMP) < XTT .AND. &
+ ZEW(JLWC) >= 0.14 .AND. ZEW(JLWC) < ZLWCC(JTEMP)) THEN
+ XSAUNDER(JLWC,JTEMP) = MIN( 0.,(-57.06*ZEW(JLWC)+12.6)*(ZT(JTEMP)-XTT) )
+ ENDIF
+!
+! region S1 : negative --> linear interpolation of S2
+ IF (ZT(JTEMP) > (XTT-7.35) .AND. ZT(JTEMP) < XTT .AND. &
+ ZEW(JLWC) >= 0.026 .AND. ZEW(JLWC) < 0.14) THEN
+ XSAUNDER(JLWC,JTEMP) = MIN( 0.,(42.8*ZEW(JLWC)-1.08)*(ZT(JTEMP)-XTT) )
+ ENDIF
+ END DO
+ END DO
+!
+ XSAUNDER(:,:) = XSAUNDER(:,:) * 1.E-15 ! in C
+!
+END IF
+!
+!* 8.5 Takahashi with EW or ZRAR (Tsenova and Mitzeva, 2009, 2011)
+! here ZRAR = 9 * EW
+! Temperature index (0C --> -30C)
+! LWC index (0.01 g.m^-3 --> 10 g.m^-3)
+! 0.01 to 0.09 every 0.01 (9 values)
+! 0.10 to 0.90 every 0.10 (9 values)
+! 1.00 to 10.0 every 1.00 (10 values)
+!
+IF (CNI_CHARGING == 'TEEWC' .OR. CNI_CHARGING == 'TERAR') THEN
+!
+ NIND_TEMP = 31
+ NIND_LWC = 28
+!
+ IF( .NOT.ALLOCATED(XTAKA_TM)) ALLOCATE(XTAKA_TM(NIND_LWC+1,NIND_TEMP+1))
+ ALLOCATE(ZT(NIND_TEMP+1)) ! Kelvin
+ ALLOCATE(ZEW(NIND_LWC+1))
+ DO JTEMP = 1, NIND_TEMP+1
+ ZT(JTEMP) = 1.0 - REAL(JTEMP) + XTT
+ END DO
+
+ DO JLWC = 1, 9
+ ZEW(JLWC) = 0.01 * REAL(JLWC)
+ END DO
+ DO JLWC = 10, 18
+ ZEW(JLWC) = 0.1 + 0.1 * REAL(JLWC-10)
+ END DO
+ DO JLWC = 19, NIND_LWC+1
+ ZEW(JLWC) = 1.0 + REAL(JLWC-19)
+ END DO
+!
+ XTAKA_TM(:,:) = 0.0
+ DO JTEMP = 1, NIND_TEMP+1
+ DO JLWC = 1, NIND_LWC+1
+!
+! Eq. 1: >0
+ IF ( ZT(JTEMP) > (XTT - 10.) .AND. ZEW(JLWC) <= 1.6) THEN
+ XTAKA_TM(JLWC, JTEMP) = 146.981 * ZEW(JLWC) - 116.37 * ZEW(JLWC)**2 &
+ + 29.76 * ZEW(JLWC)**3 &
+ - 0.03 * (ZT(JTEMP) - XTT)**3 * ZEW(JLWC) &
+ - 2.58 * (ZT(JTEMP) - XTT) &
+ - 0.21 * (ZT(JTEMP) - XTT)**3 * ZEW(JLWC)**3 &
+ + 0.36 * (ZT(JTEMP) - XTT)**3 * ZEW(JLWC)**2 &
+ + 0.15 * (ZT(JTEMP) - XTT)**2 &
+ + 2.92 * (ZT(JTEMP) - XTT) * ZEW(JLWC)**3 &
+ - 4.22 * (ZT(JTEMP) - XTT) * ZEW(JLWC) - 8.506
+ END IF
+!
+! Eq. 2: >0
+ IF ( ZT(JTEMP) > (XTT - 10.) .AND. &
+ ZEW(JLWC) > 1.6 .AND. ZEW(JLWC) <= 8.) THEN
+ XTAKA_TM(JLWC, JTEMP) = 4.179 * (ZT(JTEMP) - XTT) &
+ - 0.005 * (ZT(JTEMP) - XTT)**2 * ZEW(JLWC)**2 &
+ + 0.916 * ZEW(JLWC)**2 &
+ - 1.333 * (ZT(JTEMP) - XTT) * ZEW(JLWC) &
+ - 7.465 * ZEW(JLWC) &
+ + 0.109 * (ZT(JTEMP) - XTT) * ZEW(JLWC)**2 &
+ + 0.001 * (ZT(JTEMP) - XTT)**2 * ZEW(JLWC)**3 &
+ - 0.035 * ZEW(JLWC)**3 + 50.84454
+ END IF
+!
+! Eq. 8: > 0
+ IF ( ZEW(JLWC) <= 0.4 .AND. &
+ ZT(JTEMP) <= (XTT - 10.) .AND. ZT(JTEMP) >= (XTT - 40.)) THEN
+ XTAKA_TM(JLWC, JTEMP) = - 3.3515 * (ZT(JTEMP) - XTT) &
+ + 95.957 * (ZT(JTEMP) - XTT) * ZEW(JLWC)**2 &
+ + 511.83 * ZEW(JLWC) &
+ + 17.448 * (ZT(JTEMP) - XTT)**2 * ZEW(JLWC)**3 &
+ - 0.0007 * (ZT(JTEMP) - XTT)**3 &
+ + 20.570 * (ZT(JTEMP) - XTT) * ZEW(JLWC) &
+ + 0.1656 * (ZT(JTEMP) - XTT)**2 * ZEW(JLWC) &
+ + 0.4954 * (ZT(JTEMP) - XTT)**3 * ZEW(JLWC)**3 &
+ - 0.0975 * (ZT(JTEMP) - XTT)**3 * ZEW(JLWC)**2 &
+ + 67.457 * (ZT(JTEMP) - XTT) * ZEW(JLWC)**3 &
+ - 0.1066 * (ZT(JTEMP) - XTT)**2 - 24.5715
+ END IF
+!
+! Eq. 9: < 0
+ IF ( ZT(JTEMP) <= (XTT - 10.) .AND. ZT(JTEMP) >= (XTT - 40.) .AND. &
+ ZEW(JLWC) > 0.4 .AND. ZEW(JLWC) <= 3.2) THEN
+ XTAKA_TM(JLWC, JTEMP) = - 1.5676 * (ZT(JTEMP) - XTT) * ZEW(JLWC) &
+ + 0.2484 * (ZT(JTEMP) - XTT) * ZEW(JLWC)**3 &
+ + 0.0112 * (ZT(JTEMP) - XTT)**3 &
+ + 19.199 * (ZT(JTEMP) - XTT) &
+ + 0.8051 * (ZT(JTEMP) - XTT)**2 &
+ - 83.4 * ZEW(JLWC) &
+ + 15.4 * ZEW(JLWC)**2 &
+ + 5.97 * ZEW(JLWC)**3 + 167.9278
+ END IF
+!
+! Eq. 10: > 0
+ IF ( ZT(JTEMP) <= (XTT - 10.) .AND. ZT(JTEMP) >= (XTT - 40.) .AND. &
+ ZEW(JLWC) > 3.2 .AND. ZEW(JLWC) <= 8. ) THEN
+ XTAKA_TM(JLWC, JTEMP) = 4.2127 * (ZT(JTEMP) - XTT) &
+ - 0.8311 * (ZT(JTEMP) - XTT) * ZEW(JLWC) &
+ + 0.0670 * (ZT(JTEMP) - XTT) * ZEW(JLWC) **2 &
+ + 0.0042 * (ZT(JTEMP) - XTT)**2 * ZEW(JLWC) &
+ + 40.9642
+ END IF
+ END DO
+ END DO
+!
+ XTAKA_TM(:,:) = XTAKA_TM(:,:) * 1.E-15 ! in C
+!
+END IF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 9. NON_INDUCTIVE PROCESS: AGGREGATION OF ICE ON SNOW
+! -------------------------------------------------
+!
+!* 9.1 Helsdon and Farley (1987) parameterization
+!
+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.)
+!
+!
+!* 9.3 Saunders et al.(1991) parameterization
+!
+XFQIAGGSBS = (XPI / 4.0) * XCCS
+!
+!
+!* 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))
+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) )
+!
+XFQRACCS = (XPI / 4.0) * XCCS * XCCR * (PRHO00**XCEXVT)
+!
+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.)
+!
+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.)
+!
+ZESR = 1.0
+!
+CALL RRCOLSS (KND, XALPHAS, XNUS, XALPHAR, XNUR, &
+ ZESR, XFR, XCS, XDS, XCR, XDR, &
+ XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
+ PFDINFTY, XKER_Q_RACCSS, XAG, XBS, XAS )
+!
+CALL RZCOLX (KND, XALPHAS, XNUS, XALPHAR, XNUR, &
+ ZESR, XFR, XCS, XDS, XCR, XDR, &
+ XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
+ PFDINFTY, XKER_Q_RACCS )
+!
+CALL RSCOLRG (KND, XALPHAS, XNUS, XALPHAR, XNUR, &
+ ZESR, XFS, XCS, XDS, XCR, XDR, &
+ XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, &
+ PFDINFTY, XKER_Q_SACCRG, XAG, XBS, XAS )
+!
+!-------------------------------------------------------------------------------
+!
+!* 11. DRY GROWTH OF GRAUPELN BY CAPTURE OF SNOW OR ICE
+! ------------------------------------------------
+!
+!* 11.1 charge transfer associated to mass transfer
+!
+IF( .NOT.ALLOCATED(XKER_Q_SDRYG)) ALLOCATE( XKER_Q_SDRYG(NDRYLBDAG,NDRYLBDAS) )
+!
+XFQSDRYG = (XPI / 4.0) * XCCS * XCCG * (PRHO00**XCEXVT)
+!
+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.)
+!
+ZEGS = 1. ! also initialized in ini_rain_ice_elec
+!
+CALL RZCOLX (KND, XALPHAG, XNUG, XALPHAS, XNUS, &
+ ZEGS, XFS, XCG, XDG, XCS, XDS, &
+ XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
+ PFDINFTY, XKER_Q_SDRYG )
+!
+!
+!* 11.2 NI process: Heldson et Farley (1987) parameterization
+!
+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
+!
+ 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, XCS, XDS, &
+ XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
+ PFDINFTY, 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 )
+END IF
+!
+!
+!* 11.4 NI process: Saunders et al. (1991) and
+!* Saunders and Peck (1998) parameterizations
+!
+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) )
+!
+! 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 )
+!
+! 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 )
+ENDIF
+!
+!
+!* 11.5 NI process: Takahashi (1978) parameterization
+!
+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))
+!
+! 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)
+ 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 )
+END IF
+!
+!
+!* 11.6 NI process: limit the charge exchanged during QSDRYG_boun
+!
+IF (CNI_CHARGING == 'TAKAH' .OR. CNI_CHARGING == 'SAP98' .OR. &
+ CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. &
+ CNI_CHARGING == 'GARDI' .OR. &
+ CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2' .OR. &
+ CNI_CHARGING == 'TEEWC' .OR. CNI_CHARGING == 'TERAR') THEN
+ 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, XCS, XDS, &
+ XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, &
+ PFDINFTY, XKER_Q_LIMSG)
+ENDIF
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 12. DRY GROWTH OF GRAUPELN BY CAPTURE OF RAINDROP
+! ---------------------------------------------
+!
+IF( .NOT.ALLOCATED(XKER_Q_RDRYG)) ALLOCATE( XKER_Q_RDRYG(NDRYLBDAG,NDRYLBDAR) )
+!
+XFQRDRYG = (XPI / 4.0) * XCCG * XCCR * (PRHO00**XCEXVT)
+!
+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.)
+!
+ZEGR = 1.0
+!
+CALL RZCOLX (KND, XALPHAG, XNUG, XALPHAR, XNUR, &
+ ZEGR, XFR, XCG, XDG, XCR, XDR, &
+ XDRYLBDAG_MAX, XDRYLBDAR_MAX, XDRYLBDAG_MIN, XDRYLBDAR_MIN, &
+ PFDINFTY, XKER_Q_RDRYG )
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 13. UPDATE THE Q=f(D) RELATION
+! --------------------------
+!
+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)
+!
+!
+!------------------------------------------------------------------------------
+!
+!* 14. INDUCTIVE PROCESS
+! -----------------
+!
+! d = 15 microns and N_c = 400 cm**(-3)
+!
+XCOLCG_IND = 0.8
+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.
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE INI_PARAM_ELEC
diff --git a/src/mesonh/micro/ini_rain_ice.f90 b/src/mesonh/micro/ini_rain_ice.f90
index c172f556ebca02c69cf1921f20fd8d2e1ec05fe3..ee733f4e23030bb3631c086a4fd7e1db1e72fb4d 100644
--- a/src/mesonh/micro/ini_rain_ice.f90
+++ b/src/mesonh/micro/ini_rain_ice.f90
@@ -128,6 +128,9 @@ USE MODE_READ_XKER_SWETH, ONLY: READ_XKER_SWETH
USE MODE_READ_XKER_GWETH, ONLY: READ_XKER_GWETH
USE MODE_READ_XKER_RWETH, ONLY: READ_XKER_RWETH
!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -196,6 +199,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('INI_RAIN_ICE',0,ZHOOK_HANDLE)
!
+IF (LHOOK) CALL DR_HOOK('INI_RAIN_ICE',0,ZHOOK_HANDLE)
!
!* 0. FUNCTION STATEMENTS
! -------------------
@@ -215,7 +219,7 @@ IF (CSEDIM == 'SPLI' .AND. .NOT. LRED ) THEN
ZVTRMAX = 40.
ELSE IF (HCLOUD == 'ICE3') THEN
ZVTRMAX = 10.
- END IF
+ END IF
END IF
!
!* 1.2 Compute the number of small time step integration
@@ -595,7 +599,8 @@ IF (GFLAG) THEN
WRITE(UNIT=KLUOUT,FMT='(" Crit. ice cont. XCRIAUTI=",E13.6)') XCRIAUTI
WRITE(UNIT=KLUOUT,FMT='(" A Coef. for cirrus law XACRIAUTI=",E13.6)')XACRIAUTI
WRITE(UNIT=KLUOUT,FMT='(" B Coef. for cirrus law XBCRIAUTI=",E13.6)')XBCRIAUTI
- WRITE(UNIT=KLUOUT,FMT='(" Temp degC at which cirrus law starts to be used=",E13.6)') XT0CRIAUTI
+ WRITE(UNIT=KLUOUT, &
+ & FMT='(" Temp degC at which cirrus law starts to be used=",E13.6)') XT0CRIAUTI
END IF
!
!
diff --git a/src/mesonh/micro/lima_adjust_split.f90 b/src/mesonh/micro/lima_adjust_split.f90
index edaeec82007c9f14ed51c77c8aa092ad3bbc1d7b..ab87f141f0ee8d1dc4cb3bae80bf3d81b4259f8c 100644
--- a/src/mesonh/micro/lima_adjust_split.f90
+++ b/src/mesonh/micro/lima_adjust_split.f90
@@ -269,11 +269,12 @@ REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) &
ZLV, & ! guess of the Lv at t+1
ZLS, & ! guess of the Ls at t+1
ZMASK,&
- ZRV, ZRV2, &
- ZRC, ZRC2, &
- ZRI, &
+ ZRV, ZRV2,ZRV_IN, &
+ ZRC, ZRC2,ZRC_IN, &
+ ZRI, ZRI_IN, &
ZSIGS, &
ZW_MF
+REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2)) :: ZSIGQSAT2D
LOGICAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) &
:: GMICRO ! Test where to compute cond/dep proc.
INTEGER :: IMICRO
@@ -500,15 +501,20 @@ DO JITER =1,ITERMAX
!
ZRV=PRVS*PTSTEP
ZRC=PRCS*PTSTEP
+ ZRV_IN=ZRV
+ ZRC_IN=ZRC
+ ZRI_IN=0.
ZRV2=PRVT
ZRC2=PRCT
ZRI=0.
ZSIGS=PSIGS
+ ZSIGQSAT2D(:,:)=PSIGQSAT
CALL CONDENSATION(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, 1, 'S', &
HCONDENS, HLAMBDA3, &
- PPABST, PZZ, PRHODREF, ZT, ZRV, ZRC, ZRI, PRSS*PTSTEP, PRGS*PTSTEP, &
- ZSIGS, PMFCONV, PCLDFR, PSRCS, .FALSE., OSIGMAS, &
- PSIGQSAT, PLV=ZLV, PLS=ZLS, PCPH=ZCPH )
+ PPABST, PZZ, PRHODREF, ZT, ZRV_IN, ZRV, ZRC_IN, ZRC, ZRI_IN, ZRI,&
+ PRSS*PTSTEP, PRGS*PTSTEP, &
+ ZSIGS, PMFCONV, PCLDFR, PSRCS, .FALSE., OSIGMAS, .FALSE., &
+ ZSIGQSAT2D, PLV=ZLV, PLS=ZLS, PCPH=ZCPH )
PCLDFR(:,:,:) = MIN(PCLDFR(:,:,:) + PCF_MF(:,:,:) , 1.)
ZRV(:,:,:) = ZRV(:,:,:) - MAX(MIN(PRC_MF(:,:,:), ZRV(:,:,:)),0.)
ZRC(:,:,:) = ZRC(:,:,:) + MAX(MIN(PRC_MF(:,:,:), ZRV(:,:,:)),0.)
diff --git a/src/mesonh/micro/modd_blankn.f90 b/src/mesonh/micro/modd_blankn.f90
deleted file mode 100644
index 6428103136f77d7639c070c7032add80316721f5..0000000000000000000000000000000000000000
--- a/src/mesonh/micro/modd_blankn.f90
+++ /dev/null
@@ -1,173 +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.
-!-----------------------------------------------------------------
-! #################
- MODULE MODD_BLANK_n
-! #################
-!
-!!**** *MODD_BLANK$n* - Declarative module for MesoNH developpers namelist
-!!
-!! PURPOSE
-!! -------
-!!
-!! Offer dummy real, integer, logical and character variables for
-!! test and debugging purposes.
-!!
-!!** METHOD
-!! ------
-!!
-!! Eight dummy real, integer, logical and character*80 variables are
-!! defined and passed through the namelist read operations. None of the
-!! MesoNH routines uses any of those variables. When a developper choses
-!! to introduce temporarily a parameter to some subroutine, he has to
-!! introduce a USE MODD_BLANK statement into that subroutine. Then he
-!! can use any of the variables defined here and change them easily via
-!! the namelist input.
-!!
-!! REFERENCE
-!! ---------
-!! None
-!!
-!! AUTHOR
-!! ------
-!! K. Suhre *Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-!! Original 25/04/96
-!! updated 17/11/00 (P Jabouille) Use dummy array
-!! updated 26/10/21 (Q.Rodier) Use for n model (grid-nesting)
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS, ONLY : JPDUMMY, JPMODELMAX
-!
-IMPLICIT NONE
-!
-TYPE BLANK_t
-!
- LOGICAL :: LDUMMY1
- LOGICAL :: LDUMMY2
- LOGICAL :: LDUMMY3
- LOGICAL :: LDUMMY4
- LOGICAL :: LDUMMY5
- LOGICAL :: LDUMMY6
- LOGICAL :: LDUMMY7
- LOGICAL :: LDUMMY8
-!
- CHARACTER(len=80) :: CDUMMY1
- CHARACTER(len=80) :: CDUMMY2
- CHARACTER(len=80) :: CDUMMY3
- CHARACTER(len=80) :: CDUMMY4
- CHARACTER(len=80) :: CDUMMY5
- CHARACTER(len=80) :: CDUMMY6
- CHARACTER(len=80) :: CDUMMY7
- CHARACTER(len=80) :: CDUMMY8
-!
- INTEGER :: NDUMMY1
- INTEGER :: NDUMMY2
- INTEGER :: NDUMMY3
- INTEGER :: NDUMMY4
- INTEGER :: NDUMMY5
- INTEGER :: NDUMMY6
- INTEGER :: NDUMMY7
- INTEGER :: NDUMMY8
-!
- REAL :: XDUMMY1
- REAL :: XDUMMY2
- REAL :: XDUMMY3
- REAL :: XDUMMY4
- REAL :: XDUMMY5
- REAL :: XDUMMY6
- REAL :: XDUMMY7
- REAL :: XDUMMY8
-!
-END TYPE BLANK_t
-!
-TYPE(BLANK_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: BLANK_MODEL
-!
-LOGICAL, POINTER :: LDUMMY1=>NULL()
-LOGICAL, POINTER :: LDUMMY2=>NULL()
-LOGICAL, POINTER :: LDUMMY3=>NULL()
-LOGICAL, POINTER :: LDUMMY4=>NULL()
-LOGICAL, POINTER :: LDUMMY5=>NULL()
-LOGICAL, POINTER :: LDUMMY6=>NULL()
-LOGICAL, POINTER :: LDUMMY7=>NULL()
-LOGICAL, POINTER :: LDUMMY8=>NULL()
-!
-CHARACTER(len=80), POINTER :: CDUMMY1=>NULL()
-CHARACTER(len=80), POINTER :: CDUMMY2=>NULL()
-CHARACTER(len=80), POINTER :: CDUMMY3=>NULL()
-CHARACTER(len=80), POINTER :: CDUMMY4=>NULL()
-CHARACTER(len=80), POINTER :: CDUMMY5=>NULL()
-CHARACTER(len=80), POINTER :: CDUMMY6=>NULL()
-CHARACTER(len=80), POINTER :: CDUMMY7=>NULL()
-CHARACTER(len=80), POINTER :: CDUMMY8=>NULL()
-!
-INTEGER, POINTER :: NDUMMY1=>NULL()
-INTEGER, POINTER :: NDUMMY2=>NULL()
-INTEGER, POINTER :: NDUMMY3=>NULL()
-INTEGER, POINTER :: NDUMMY4=>NULL()
-INTEGER, POINTER :: NDUMMY5=>NULL()
-INTEGER, POINTER :: NDUMMY6=>NULL()
-INTEGER, POINTER :: NDUMMY7=>NULL()
-INTEGER, POINTER :: NDUMMY8=>NULL()
-!
-REAL, POINTER :: XDUMMY1=>NULL()
-REAL, POINTER :: XDUMMY2=>NULL()
-REAL, POINTER :: XDUMMY3=>NULL()
-REAL, POINTER :: XDUMMY4=>NULL()
-REAL, POINTER :: XDUMMY5=>NULL()
-REAL, POINTER :: XDUMMY6=>NULL()
-REAL, POINTER :: XDUMMY7=>NULL()
-REAL, POINTER :: XDUMMY8=>NULL()
-!
-CONTAINS
-!
-SUBROUTINE BLANK_GOTO_MODEL(KFROM,KTO)
-INTEGER, INTENT(IN) :: KFROM, KTO
-!
-LDUMMY1=>BLANK_MODEL(KTO)%LDUMMY1
-LDUMMY2=>BLANK_MODEL(KTO)%LDUMMY2
-LDUMMY3=>BLANK_MODEL(KTO)%LDUMMY3
-LDUMMY4=>BLANK_MODEL(KTO)%LDUMMY4
-LDUMMY5=>BLANK_MODEL(KTO)%LDUMMY5
-LDUMMY6=>BLANK_MODEL(KTO)%LDUMMY6
-LDUMMY7=>BLANK_MODEL(KTO)%LDUMMY7
-LDUMMY8=>BLANK_MODEL(KTO)%LDUMMY8
-
-CDUMMY1=>BLANK_MODEL(KTO)%CDUMMY1
-CDUMMY2=>BLANK_MODEL(KTO)%CDUMMY2
-CDUMMY3=>BLANK_MODEL(KTO)%CDUMMY3
-CDUMMY4=>BLANK_MODEL(KTO)%CDUMMY4
-CDUMMY5=>BLANK_MODEL(KTO)%CDUMMY5
-CDUMMY6=>BLANK_MODEL(KTO)%CDUMMY6
-CDUMMY7=>BLANK_MODEL(KTO)%CDUMMY7
-CDUMMY8=>BLANK_MODEL(KTO)%CDUMMY8
-!
-NDUMMY1=>BLANK_MODEL(KTO)%NDUMMY1
-NDUMMY2=>BLANK_MODEL(KTO)%NDUMMY2
-NDUMMY3=>BLANK_MODEL(KTO)%NDUMMY3
-NDUMMY4=>BLANK_MODEL(KTO)%NDUMMY4
-NDUMMY5=>BLANK_MODEL(KTO)%NDUMMY5
-NDUMMY6=>BLANK_MODEL(KTO)%NDUMMY6
-NDUMMY7=>BLANK_MODEL(KTO)%NDUMMY7
-NDUMMY8=>BLANK_MODEL(KTO)%NDUMMY8
-!
-XDUMMY1=>BLANK_MODEL(KTO)%XDUMMY1
-XDUMMY2=>BLANK_MODEL(KTO)%XDUMMY2
-XDUMMY3=>BLANK_MODEL(KTO)%XDUMMY3
-XDUMMY4=>BLANK_MODEL(KTO)%XDUMMY4
-XDUMMY5=>BLANK_MODEL(KTO)%XDUMMY5
-XDUMMY6=>BLANK_MODEL(KTO)%XDUMMY6
-XDUMMY7=>BLANK_MODEL(KTO)%XDUMMY7
-XDUMMY8=>BLANK_MODEL(KTO)%XDUMMY8
-!
-END SUBROUTINE BLANK_GOTO_MODEL
-!
-END MODULE MODD_BLANK_n
diff --git a/src/mesonh/micro/modd_conf.f90 b/src/mesonh/micro/modd_conf.f90
deleted file mode 100644
index a7995fec5548247b67356044fe285d76f13b68f6..0000000000000000000000000000000000000000
--- a/src/mesonh/micro/modd_conf.f90
+++ /dev/null
@@ -1,127 +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.
-!-----------------------------------------------------------------
-! #################
- MODULE MODD_CONF
-! #################
-!
-!!**** *MODD_CONF* - declaration of configuration variables
-!!
-!! PURPOSE
-!! -------
-! The purpose of this declarative module is to specify the variables
-! which concern the configuration of all models. For exemple,
-! the type of geometry (Cartesian or conformal projection plane).
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of documentation of Meso-NH (module MODD_CONF)
-!! Technical Specifications Report of the Meso-NH (chapters 2 and 3)
-!!
-!! AUTHOR
-!! ------
-!! V. Ducrocq *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 05/05/94
-!! J. Stein 09/01/95 add the 1D switch
-!! J. Stein and P. Jabouille 30/04/96 add the storage type
-!! J.-P. Pinty 13/02/96 add LFORCING switch
-!! J. Stein 25/07/97 add the equation system switch
-!! P. Jabouille 07/05/98 add LPACK
-!! V. Masson 18/03/98 add the VERSION switch
-!! V. Masson 15/03/99 add PROGRAM swith
-!! P. Jabouille 21/07/99 add NHALO and CSPLIT
-!! P. Jabouille 26/06/01 lagrangian variables
-!! V. Masson 09/07/01 add LNEUTRAL switch
-!! P. Jabouille 18/04/02 add NBUGFIX and CBIBUSER
-!! C. Lac 01/04/14 add LCHECK
-!! G. Tanguy 01/04/14 add LCOUPLING
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-CHARACTER (LEN=5),SAVE :: CCONF ! Configuration of models
- ! 'START' for start configuration
- ! 'RESTART' for restart configuration
-LOGICAL,SAVE :: LTHINSHELL ! Logical for thinshell approximation
- ! .TRUE. = thinshell approximation
- ! .FALSE. = no thinshell approximation
-LOGICAL,SAVE :: LCARTESIAN ! Logical for cartesian geometry :
- ! .TRUE. = cartesian geometry
- ! .FALSE. = conformal projection
-LOGICAL,SAVE :: L2D = .FALSE. ! Logical for 2D model version
- ! .TRUE. = 2D model version
- ! .FALSE. = 3D model version
-LOGICAL,SAVE :: L1D ! Logical for 1D model version
- ! .TRUE. = 1D model version
- ! .FALSE. = 2D or 3D model version
-LOGICAL,SAVE :: LFLAT ! Logical for zero ororography
- ! .TRUE. = no orography (zs=0.)
- ! .FALSE. = orography
-INTEGER,SAVE :: NMODEL ! Number of nested models
-INTEGER,SAVE :: NVERB ! Level of informations on output-listing
- ! 0 for minimum of prints
- ! 5 for intermediate level of prints
- ! 10 for maximum of prints
-CHARACTER (LEN=5),SAVE :: CEXP ! Experiment name
-CHARACTER (LEN=5),SAVE :: CSEG ! name of segment
-LOGICAL,SAVE :: LFORCING ! Logical for forcing sources
- ! .TRUE. = add forcing sources
- ! .FALSE. = no forcing fields
-!
-CHARACTER (LEN=3),SAVE :: CEQNSYS! EQuatioN SYStem resolved by the MESONH model
- ! 'LHE' Lipps and HEmler anelastic system
- ! 'DUR' approximated form of the DURran version
- ! of the anelastic sytem
- ! 'MAE' classical Modified Anelastic Equations
- ! but with not any approximation in the
- ! momentum equation
- ! 'FCE' fully compressible equations ( not
- ! yet developped )
-LOGICAL,SAVE :: LPACK ! Logical to compress 1D or 2D FM files
-!
-!
-INTEGER,DIMENSION(3),SAVE :: NMNHVERSION ! Version of MesoNH
-INTEGER,SAVE :: NMASDEV ! NMASDEV=XY corresponds to the masdevX_Y
-INTEGER,SAVE :: NBUGFIX ! NBUGFIX=n corresponds to the BUGn of masdevX_Y
-CHARACTER(LEN=10),SAVE :: CBIBUSER! CBIBUSER is the name of the user binary library
-!
-CHARACTER(LEN=6),SAVE :: CPROGRAM ! CPROGRAM is the program currently running:
-! ! 'PGD ','ADVPGD','NESPGD','REAL ','IDEAL '
-! ! 'MESONH','SPAWN ','DIAG ','SPEC '
-!
-INTEGER,SAVE :: NHALO ! Size of the halo for parallel distribution
-!
-!INTEGER,SAVE :: JPHEXT = 1 ! Horizontal External points number
-!
-CHARACTER (LEN=10),SAVE :: CSPLIT ! kind of domain splitting for parallel distribution
- ! "BSPLITTING","XSPLITTING","YSPLITTING"
-LOGICAL,SAVE :: LLG ! Logical to use lagrangian variables
-LOGICAL,SAVE :: LINIT_LG ! to reinitialize lagrangian variables
-CHARACTER (LEN=5),SAVE :: CINIT_LG ! to reinitialize LG variables at every output
-LOGICAL,SAVE :: LNOMIXLG ! to use turbulence for lagrangian variables
-!
-LOGICAL,SAVE :: LNEUTRAL ! True if ref. theta field is uniform
-!
-LOGICAL,SAVE :: LCPL_AROME ! true if coupling file are issued from AROME
-LOGICAL,SAVE :: LCOUPLING ! true if coupling file (and not intial file)
- ! (with LCOUPLING=T in PREP_REAL_CASE)
-!
-LOGICAL,SAVE :: LCHECK ! To test reproducibility
-!
-END MODULE MODD_CONF
diff --git a/src/mesonh/micro/modd_les.f90 b/src/mesonh/micro/modd_les.f90
deleted file mode 100644
index db71d6f33aa854d4fa66308dece4c9cc7ad7bbcd..0000000000000000000000000000000000000000
--- a/src/mesonh/micro/modd_les.f90
+++ /dev/null
@@ -1,458 +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 MODD_LES
-! ###############
-!
-!!**** *MODD_LES* - declaration of prognostic variables
-!!
-!! PURPOSE
-!! -------
-! The purpose of this declarative module is to specify the
-! resolved fluxes and the spectra computed in LES mode
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of documentation of Meso-NH (module MODD_LES)
-!! Technical Specifications Report of the Meso-NH (chapters 2 and 3)
-!!
-!!
-!! AUTHOR
-!! ------
-!! J. Cuxart *INM and Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original March 10, 1995
-!!
-!! (J.Stein) Sept. 25, 1995 add the model number in LES mode
-!! J. Cuxart Oct. 4, 1996 New time series
-!! V. Masson Jan. 20, 2000 New LES routines variables & //
-!! V. Masson Nov. 6, 2002 LES budgets
-!! F. Couvreux Oct 1, 2006 LES PDF
-!! J.Pergaud Oct , 2007 MF LES
-!! P. Aumond Oct ,2009 User multimaskS + 4th order
-!! C.Lac Oct ,2014 Correction on user masks
-! 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 30/03/2021: budgets: LES cartesian subdomain limits are defined in the physical domain
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS
-!
-IMPLICIT NONE
-!
-!-------------------------------------------------------------------------------
-!
-!* namelist variables
-!
-LOGICAL :: LLES_MEAN ! flag to activate the mean computations
-LOGICAL :: LLES_RESOLVED ! flag to activate the resolved var. computations
-LOGICAL :: LLES_SUBGRID ! flag to activate the subgrid var. computations
-LOGICAL :: LLES_UPDRAFT ! flag to activate the computations in updrafts
-LOGICAL :: LLES_DOWNDRAFT ! flag to activate the computations in downdrafts
-LOGICAL :: LLES_SPECTRA ! flag to activate the spectra computations
-LOGICAL :: LLES_PDF ! flag to activate the pdf computations
-!
-INTEGER, DIMENSION(900) :: NLES_LEVELS ! physical model levels for LES comp.
-REAL, DIMENSION(900) :: XLES_ALTITUDES ! alt. levels for LES comp.
-INTEGER, DIMENSION(900) :: NSPECTRA_LEVELS ! physical model levels for spectra comp.
-REAL, DIMENSION(900) :: XSPECTRA_ALTITUDES ! alt. levels for spectra comp.
-!
-INTEGER, DIMENSION( 10) :: NLES_TEMP_SERIE_I ! I, J and Z point
-INTEGER, DIMENSION( 10) :: NLES_TEMP_SERIE_J ! localizations to
-INTEGER, DIMENSION( 10) :: NLES_TEMP_SERIE_Z ! record temporal data
-
-CHARACTER(LEN=4) :: CLES_NORM_TYPE ! type of turbulence normalization
-CHARACTER(LEN=3) :: CBL_HEIGHT_DEF ! definition of the boundary layer height
-
-REAL :: XLES_TEMP_SAMPLING ! temporal sampling between each computation
-REAL :: XLES_TEMP_MEAN_START ! time (in s) from the beginning of the simulation
-REAL :: XLES_TEMP_MEAN_END ! for start and end of the temporal averaged comp.
-REAL :: XLES_TEMP_MEAN_STEP ! time step for each averaging
-
-LOGICAL :: LLES_CART_MASK ! flag to use a cartesian mask
-INTEGER :: NLES_IINF ! definition of the cartesians mask in physical domain
-INTEGER :: NLES_ISUP ! for NLES_CART_MODNBR model
-INTEGER :: NLES_JINF ! "
-INTEGER :: NLES_JSUP ! "
-LOGICAL :: LLES_NEB_MASK ! flag to use a 2D nebulosity mask
-LOGICAL :: LLES_CORE_MASK ! flag to use a 3D cloud core mask
-LOGICAL :: LLES_MY_MASK ! flag to use its own mask (must be coded by user)
-INTEGER :: NLES_MASKS_USER ! number of user masks for LES computations
-LOGICAL :: LLES_CS_MASK ! flag to use conditional sampling mask
-INTEGER :: NPDF ! number of pdf intervals
-!
-!-------------------------------------------------------------------------------
-!
-INTEGER, DIMENSION(JPMODELMAX) :: NLESn_IINF ! definition of the cartesians mask in physical domain
-INTEGER, DIMENSION(JPMODELMAX) :: NLESn_ISUP ! for all models
-INTEGER, DIMENSION(JPMODELMAX) :: NLESn_JINF ! "
-INTEGER, DIMENSION(JPMODELMAX) :: NLESn_JSUP ! "
-!
-CHARACTER(LEN=4), DIMENSION(2,JPMODELMAX) :: CLES_LBCX
-! X boundary conditions for 2 points correlations computations for all models
-!
-CHARACTER(LEN=4), DIMENSION(2,JPMODELMAX) :: CLES_LBCY
-! Y boundary conditions for 2 points correlations computations for all models
-!
-!-------------------------------------------------------------------------------
-!
-LOGICAL :: LLES ! flag to compute the LES diagnostics
-!
-LOGICAL :: LLES_CALL ! flag to compute the LES diagnostics at current
-! ! time step
-!
-!
-LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: LLES_CURRENT_CART_MASK
-! 2D cartesian mask of the current model
-!
-LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: LLES_CURRENT_NEB_MASK
-! 2D nebulosity mask of the current model
-!
-LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: LLES_CURRENT_CORE_MASK
-! 2D surface precipitations mask of the current model
-!
-! 2D owner mask of the current model
-LOGICAL, DIMENSION(:,:,:,:), ALLOCATABLE :: LLES_CURRENT_MY_MASKS
-!
-LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: LLES_CURRENT_CS1_MASK
-LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: LLES_CURRENT_CS2_MASK
-LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: LLES_CURRENT_CS3_MASK
-! 2D conditional sampling mask of the current model
-!
-INTEGER :: NLES_CURRENT_TCOUNT
-! current model LES time counter
-!
-INTEGER :: NLES_CURRENT_TIMES
-! current model NLES_TIMES (number of LES samplings)
-!
-INTEGER :: NLES_CURRENT_IINF, NLES_CURRENT_ISUP, NLES_CURRENT_JINF, NLES_CURRENT_JSUP
-! coordinates (in physical domain) for write_diachro, set to NLESn_IINF(current model), etc...
-!
-REAL :: XLES_CURRENT_DOMEGAX, XLES_CURRENT_DOMEGAY
-! minimum wavelength in spectra analysis
-!
-CHARACTER(LEN=4), DIMENSION(2) :: CLES_CURRENT_LBCX
-! current model X boundary conditions for 2 points correlations computations
-!
-CHARACTER(LEN=4), DIMENSION(2) :: CLES_CURRENT_LBCY
-! current model Y boundary conditions for 2 points correlations computations
-!
-REAL, DIMENSION(:), ALLOCATABLE :: XLES_CURRENT_Z
-! altitudes for diachro
-!
-REAL :: XLES_CURRENT_ZS
-! orography (used for normalization of altitudes)
-!
-INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: NKLIN_CURRENT_LES
-! levels for vertical interpolation
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: XCOEFLIN_CURRENT_LES
-! coefficients for vertical interpolation
-!
-INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: NKLIN_CURRENT_SPEC
-! levels for vertical interpolation
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: XCOEFLIN_CURRENT_SPEC
-! coefficients for vertical interpolation
-!
-REAL,DIMENSION(2) :: XTIME_LES
-! time spent in subgrid LES computations in this time-step in TURB
-!
-!-------------------------------------------------------------------------------
-!
-!* normalization variables
-!
-REAL, DIMENSION(:), ALLOCATABLE :: XLES_NORM_M
-! normalization coefficient for distances (Meters)
-!
-REAL, DIMENSION(:), ALLOCATABLE :: XLES_NORM_K
-! normalization coefficient for temperatures (Kelvin)
-!
-REAL, DIMENSION(:), ALLOCATABLE :: XLES_NORM_S
-! normalization coefficient for times (Seconds)
-!
-REAL, DIMENSION(:), ALLOCATABLE :: XLES_NORM_RHO
-! normalization coefficient for densities
-!
-REAL, DIMENSION(:), ALLOCATABLE :: XLES_NORM_RV
-! normalization coefficient for mixing ratio
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: XLES_NORM_SV
-! normalization coefficient for scalar variables
-!
-REAL, DIMENSION(:), ALLOCATABLE :: XLES_NORM_P
-! normalization coefficient for pressure
-!
-!-------------------------------------------------------------------------------
-!
-!* monitoring variables
-!
-INTEGER :: NLES_MASKS ! number of masks for LES computations
-INTEGER :: NLES_K ! number of vertical levels for local diagnostics
-INTEGER :: NSPECTRA_K ! number of vertical levels for spectra
-!
-CHARACTER(LEN=1) :: CLES_LEVEL_TYPE ! type of vertical levels for local diag.
-CHARACTER(LEN=1) :: CSPECTRA_LEVEL_TYPE ! type of vertical levels for spectra
-!
-!-------------------------------------------------------------------------------
-!
-!* subgrid variables for current model
-!
-! ______
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_W_SBG_WThl ! <w'w'Thl'>
-! _____
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_W_SBG_WRt ! <w'w'Rt'>
-! _____
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_W_SBG_Thl2 ! <w'Thl'2>
-! ____
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_W_SBG_Rt2 ! <w'Rt'2>
-! _______
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_W_SBG_ThlRt! <w'Thl'Rt'>
-! _____
-REAL, DIMENSION(:,:,:,:),ALLOCATABLE:: X_LES_RES_W_SBG_WSv ! <w'w'Sv'>
-! ____
-REAL, DIMENSION(:,:,:,:),ALLOCATABLE:: X_LES_RES_W_SBG_Sv2 ! <w'Sv'2>
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: XLES_SUBGRID_RCSIGS ! rc sigmas
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: XLES_SUBGRID_RCSIGC ! rc sigmac
-! _____
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_U_SBG_UaU ! <du'/dxa ua'u'>
-! _____
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_V_SBG_UaV ! <dv'/dxa ua'v'>
-! _____
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_W_SBG_UaW ! <dw'/dxa ua'w'>
-! _______
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_W_SBG_UaThl ! <dw'/dxa ua'Thl'>
-! _____
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_Thl_SBG_UaW ! <dThl'/dxa ua'w'>
-! ___
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddz_Thl_SBG_W2 ! <dThl'/dz w'2>
-! ______
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_W_SBG_UaRt ! <dw'/dxa ua'Rt'>
-! _____
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_Rt_SBG_UaW ! <dRt'/dxa ua'w'>
-! ___
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddz_Rt_SBG_W2 ! <dRt'/dz w'2>
-! ______
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_Thl_SBG_UaRt! <dThl'/dxa ua'Rt'>
-! _______
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_Rt_SBG_UaThl! <dRt'/dxa ua'Thl'>
-! _______
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_Thl_SBG_UaThl! <dThl'/dxa ua'Thl'>
-! ______
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_Rt_SBG_UaRt ! <dRt'/dxa ua'Rt'>
-! ______
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_W_SBG_UaSv ! <dw'/dxa ua'Sv'>
-! _____
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_Sv_SBG_UaW ! <dSv'/dxa ua'w'>
-! ___
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: X_LES_RES_ddz_Sv_SBG_W2 ! <dSv'/dz w'2>
-! ______
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: X_LES_RES_ddxa_Sv_SBG_UaSv ! <dSv'/dxa ua'Sv'>
-!
-! ___
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_U2 ! <u'2>
-! ___
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_V2 ! <v'2>
-! ___
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_W2 ! <w'2>
-! _____
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_Thl2 ! <Thl'2>
-! ____
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_Rt2 ! <Rt'2>
-! ____
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_Rc2 ! <Rc'2>
-! ____
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_Ri2 ! <Ri'2>
-! _______
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_ThlRt ! <Thl'Rt'>
-! ____
-REAL, DIMENSION(:,:,:,:),ALLOCATABLE:: X_LES_SUBGRID_Sv2 ! <Sv'2>
-! ____
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_UV ! <u'v'>
-! ____
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WU ! <w'u'>
-! ____
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WV ! <w'v'>
-! ______
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_UThl ! <u'Thl'>
-! ______
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_VThl ! <v'Thl'>
-! ______
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WThl ! <w'Thl'>
-! _____
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_URt ! <u'Rt'>
-! _____
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_VRt ! <v'Rt'>
-! _____
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WRt ! <w'Rt'>
-! _____
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_URc ! <u'Rc'>
-! _____
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_VRc ! <v'Rc'>
-! _____
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WRc ! <w'Rc'>
-! _____
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: X_LES_SUBGRID_USv ! <u'Sv'>
-! _____
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: X_LES_SUBGRID_VSv ! <v'Sv'>
-! _____
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WSv ! <w'Sv'>
-! ___
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_UTke ! <u'e>
-! ___
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_VTke ! <v'e>
-! ___
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WTke ! <w'e>
-! ___
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_ddz_WTke ! <dw'e/dz>
-! ______
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WThv ! <w'Thv'>
-! ________
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_ThlThv ! <Thl'Thv'>
-! _______
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_RtThv ! <Rt'Thv'>
-! _______
-REAL, DIMENSION(:,:,:,:),ALLOCATABLE:: X_LES_SUBGRID_SvThv ! <Sv'Thv'>
-! ______
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_W2Thl ! <w'2Thl>
-! _____
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_W2Rt ! <w'2Rt>
-! _____
-REAL, DIMENSION(:,:,:,:),ALLOCATABLE:: X_LES_SUBGRID_W2Sv ! <w'2Sv>
-! _______
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WThlRt ! <w'ThlRt>
-! ______
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WThl2 ! <w'Thl2>
-! _____
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WRt2 ! <w'Rt2>
-! _____
-REAL, DIMENSION(:,:,:,:),ALLOCATABLE:: X_LES_SUBGRID_WSv2 ! <w'Sv2>
-! _______
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_DISS_Tke ! <epsilon>
-! ____________
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_DISS_Thl2 ! <epsilon_Thl2>
-! ___________
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_DISS_Rt2 ! <epsilon_Rt2>
-! ______________
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_DISS_ThlRt! <epsilon_ThlRt>
-! ___________
-REAL, DIMENSION(:,:,:,:),ALLOCATABLE:: X_LES_SUBGRID_DISS_Sv2 ! <epsilon_Sv2>
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WP ! <w'p'>
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_ThlPz ! <Thl'dp'/dz>
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_RtPz ! <Rt'dp'/dz>
-!
-REAL, DIMENSION(:,:,:,:),ALLOCATABLE:: X_LES_SUBGRID_SvPz ! <Sv'dp'/dz>
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_PHI3 ! phi3
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_PSI3 ! psi3
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_LMix ! mixing length
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_LDiss ! dissipative length
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_Km ! eddy diffusivity for momentum
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_Kh ! eddy diffusivity for heat
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_THLUP_MF ! Thl of the Updraft
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_RTUP_MF ! Rt of the Updraft
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_RVUP_MF ! Rv of the Updraft
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_RCUP_MF ! Rc of the Updraft
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_RIUP_MF ! Ri of the Updraft
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WUP_MF ! Thl of the Updraft
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_MASSFLUX ! Mass Flux
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_DETR ! Detrainment
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_ENTR ! Entrainment
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_FRACUP ! Updraft Fraction
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_THVUP_MF ! Thv of the Updraft
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WTHLMF ! Flux of thl
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WRTMF ! Flux of rt
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WTHVMF ! Flux of thv
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WUMF ! Flux of u
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: X_LES_SUBGRID_WVMF ! Flux of v
-!
-!* surface variables
-!
-REAL, DIMENSION(:), ALLOCATABLE :: X_LES_USTAR ! local u* temporal series
-REAL, DIMENSION(:), ALLOCATABLE :: X_LES_UW0 ! uw temporal series
-REAL, DIMENSION(:), ALLOCATABLE :: X_LES_VW0 ! vw temporal series
-REAL, DIMENSION(:), ALLOCATABLE :: X_LES_Q0 ! Qo temporal series
-REAL, DIMENSION(:), ALLOCATABLE :: X_LES_E0 ! Eo temporal series
-REAL, DIMENSION(:,:), ALLOCATABLE :: X_LES_SV0 ! scalar surface fluxes
-!
-!* pdf variables
-REAL :: XRV_PDF_MIN ! min of rv pdf
-REAL :: XRV_PDF_MAX ! max of rv pdf
-REAL :: XTH_PDF_MIN ! min of theta pdf
-REAL :: XTH_PDF_MAX ! max of theta pdf
-REAL :: XW_PDF_MIN ! min of w pdf
-REAL :: XW_PDF_MAX ! max of w pdf
-REAL :: XTHV_PDF_MIN ! min of thetav pdf
-REAL :: XTHV_PDF_MAX ! max of thetav pdf
-REAL :: XRC_PDF_MIN ! min of rc pdf
-REAL :: XRC_PDF_MAX ! max of rc pdf
-REAL :: XRR_PDF_MIN ! min of rr pdf
-REAL :: XRR_PDF_MAX ! max of rr pdf
-REAL :: XRI_PDF_MIN ! min of ri pdf
-REAL :: XRI_PDF_MAX ! max of ri pdf
-REAL :: XRS_PDF_MIN ! min of rs pdf
-REAL :: XRS_PDF_MAX ! max of rs pdf
-REAL :: XRG_PDF_MIN ! min of rg pdf
-REAL :: XRG_PDF_MAX ! max of rg pdf
-REAL :: XRT_PDF_MIN ! min of rt pdf
-REAL :: XRT_PDF_MAX ! max of rt pdf
-REAL :: XTHL_PDF_MIN ! min of thetal pdf
-REAL :: XTHL_PDF_MAX ! max of thetal pdf
-!-------------------------------------------------------------------------------
-!* pdf distribution
-!
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_RV ! rv pdf
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_TH ! theta pdf
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_W ! w pdf
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_THV ! thetav pdf
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_RC ! rc pdf
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_RR ! rr pdf
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_RI ! ri pdf
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_RS ! rs pdf
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_RG ! rg pdf
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_RT ! rt pdf
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XLES_PDF_THL ! thetal pdf
-!
-!
-!-------------------------------------------------------------------------------
-!
-END MODULE MODD_LES
diff --git a/src/mesonh/micro/modd_nsv.f90 b/src/mesonh/micro/modd_nsv.f90
deleted file mode 100644
index 7a842a5c1cacb3073ca3daa6139f327c1ed1543e..0000000000000000000000000000000000000000
--- a/src/mesonh/micro/modd_nsv.f90
+++ /dev/null
@@ -1,253 +0,0 @@
-!MNH_LIC Copyright 2001-2021 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-------------------------------------------------------------------------------
-! ###############
- MODULE MODD_NSV
-! ###############
-!
-!!**** *MODD_NSV* - declaration of scalar variables numbers
-!!
-!! PURPOSE
-!! -------
-!! Arrays to store the per-model NSV_* values number (suffix _A denote an array)
-!!
-!! AUTHOR
-!! ------
-!! D. Gazen L.A.
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/02/01
-!! J.-P. Pinty 29/11/02 add C3R5, ELEC
-!! V. Masson 01/2004 add scalar names
-!! M. Leriche 12/04/07 add aqueous chemistry
-!! M. Leriche 08/07/10 add ice phase chemistry
-!! C.Lac 07/11 add conditional sampling
-!! Pialat/Tulet 15/02/12 add ForeFire
-!! Modification 01/2016 (JP Pinty) Add LIMA
-!! V. Vionnet 07/17 add blowing snow
-! P. Wautelet 10/03/2021: add CSVNAMES and CSVNAMES_A to store the name of all the scalar variables
-! B. Vie 06/2021: add prognostic supersaturation for LIMA
-!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS, ONLY : JPMODELMAX, & ! Maximum allowed number of nested models
- JPSVMAX, & ! Maximum number of scalar variables
- JPSVNAMELGTMAX ! Maximum length of a scalar variable name
-!
-IMPLICIT NONE
-SAVE
-!
-REAL,DIMENSION(JPSVMAX) :: XSVMIN ! minimum value for SV variables
-!
-LOGICAL :: LINI_NSV = .FALSE. ! becomes True when routine INI_NSV is called
-!
-CHARACTER(LEN=JPSVNAMELGTMAX), DIMENSION(:,:), ALLOCATABLE, TARGET :: CSVNAMES_A !Names of all the scalar variables
-
-INTEGER,DIMENSION(JPMODELMAX)::NSV_A = 0 ! total number of scalar variables
- ! NSV_A = NSV_USER_A+NSV_C2R2_A+NSV_CHEM_A+..
-INTEGER,DIMENSION(JPMODELMAX)::NSV_USER_A = 0 ! number of user scalar variables with
- ! indices in the range : 1...NSV_USER_A
-!
-INTEGER,DIMENSION(JPMODELMAX)::NSV_C2R2_A = 0 ! number of liq scalar in C2R2
- ! and in C3R5
-INTEGER,DIMENSION(JPMODELMAX)::NSV_C2R2BEG_A = 0 ! with indices in the range :
-INTEGER,DIMENSION(JPMODELMAX)::NSV_C2R2END_A = 0 ! NSV_C2R2BEG_A...NSV_C2R2END_A
-!
-INTEGER,DIMENSION(JPMODELMAX)::NSV_C1R3_A = 0 ! number of ice scalar in C3R5
-INTEGER,DIMENSION(JPMODELMAX)::NSV_C1R3BEG_A = 0 ! with indices in the range :
-INTEGER,DIMENSION(JPMODELMAX)::NSV_C1R3END_A = 0 ! NSV_C1R3BEG_A...NSV_C1R3END_A
-!
-INTEGER,DIMENSION(JPMODELMAX)::NSV_ELEC_A = 0 ! number of scalar in ELEC
-INTEGER,DIMENSION(JPMODELMAX)::NSV_ELECBEG_A = 0 ! with indices in the range :
-INTEGER,DIMENSION(JPMODELMAX)::NSV_ELECEND_A = 0 ! NSV_ELECBEG_A...NSV_ELECEND_A
-!
-INTEGER,DIMENSION(JPMODELMAX)::NSV_CHEM_A = 0 ! number of chemical scalar
-INTEGER,DIMENSION(JPMODELMAX)::NSV_CHEMBEG_A = 0 ! with indices in the range :
-INTEGER,DIMENSION(JPMODELMAX)::NSV_CHEMEND_A = 0 ! NSV_CHEMBEG_A...NSV_CHEMEND_A
-!
-INTEGER,DIMENSION(JPMODELMAX)::NSV_CHGS_A = 0 ! number of gaseous chemcial species
-INTEGER,DIMENSION(JPMODELMAX)::NSV_CHGSBEG_A = 0 ! with indices
-INTEGER,DIMENSION(JPMODELMAX)::NSV_CHGSEND_A = 0 ! NSV_CHGSBEG_
-!
-INTEGER,DIMENSION(JPMODELMAX)::NSV_CHAC_A = 0 ! number of aqueous chemical species
-INTEGER,DIMENSION(JPMODELMAX)::NSV_CHACBEG_A = 0 ! with indices
-INTEGER,DIMENSION(JPMODELMAX)::NSV_CHACEND_A = 0 ! NSV_CHACBEG
-!
-INTEGER,DIMENSION(JPMODELMAX)::NSV_CHIC_A = 0 ! number of ice phase chemical species
-INTEGER,DIMENSION(JPMODELMAX)::NSV_CHICBEG_A = 0 ! with indices
-INTEGER,DIMENSION(JPMODELMAX)::NSV_CHICEND_A = 0 ! NSV_CHICBEG
-!
-INTEGER,DIMENSION(JPMODELMAX)::NSV_LG_A = 0 ! number of LaGrangian
-INTEGER,DIMENSION(JPMODELMAX)::NSV_LGBEG_A = 0 ! with indices in the range :
-INTEGER,DIMENSION(JPMODELMAX)::NSV_LGEND_A = 0 ! NSV_LGBEG_A...NSV_LGEND_A
-!
-INTEGER,DIMENSION(JPMODELMAX)::NSV_LNOX_A = 0 ! number of lightning NOx
-INTEGER,DIMENSION(JPMODELMAX)::NSV_LNOXBEG_A = 0 ! with indices in the range :
-INTEGER,DIMENSION(JPMODELMAX)::NSV_LNOXEND_A = 0 ! NSV_LNOXBEG_A...NSV_LNOXEND_A !
-INTEGER,DIMENSION(JPMODELMAX)::NSV_DST_A = 0 ! number of dust scalar
-INTEGER,DIMENSION(JPMODELMAX)::NSV_DSTBEG_A = 0 ! with indices in the range :
-INTEGER,DIMENSION(JPMODELMAX)::NSV_DSTEND_A = 0 ! NSV_DSTBEG_A...NSV_DSTEND_A
-!
-INTEGER,DIMENSION(JPMODELMAX)::NSV_SLT_A = 0 ! number of sea salt scalar
-INTEGER,DIMENSION(JPMODELMAX)::NSV_SLTBEG_A = 0 ! with indices in the range :
-INTEGER,DIMENSION(JPMODELMAX)::NSV_SLTEND_A = 0 ! NSV_SLTBEG_A...NSV_SLTEND_A
-!
-INTEGER,DIMENSION(JPMODELMAX)::NSV_AER_A = 0 ! number of aerosol scalar
-INTEGER,DIMENSION(JPMODELMAX)::NSV_AERBEG_A = 0 ! with indices in the range :
-INTEGER,DIMENSION(JPMODELMAX)::NSV_AEREND_A = 0 ! NSV_AERBEG_A...NSV_AEREND_A
-!
-INTEGER,DIMENSION(JPMODELMAX)::NSV_DSTDEP_A = 0 ! number of aerosol scalar
-INTEGER,DIMENSION(JPMODELMAX)::NSV_DSTDEPBEG_A = 0 ! with indices in the range :
-INTEGER,DIMENSION(JPMODELMAX)::NSV_DSTDEPEND_A = 0 ! NSV_AERBEG_A...NSV_AEREND_A
-!
-INTEGER,DIMENSION(JPMODELMAX)::NSV_AERDEP_A = 0 ! number of aerosol scalar
-INTEGER,DIMENSION(JPMODELMAX)::NSV_AERDEPBEG_A = 0 ! with indices in the range :
-INTEGER,DIMENSION(JPMODELMAX)::NSV_AERDEPEND_A = 0 ! NSV_AERBEG_A...NSV_AEREND_A
-!
-INTEGER,DIMENSION(JPMODELMAX)::NSV_SLTDEP_A = 0 ! number of aerosol scalar
-INTEGER,DIMENSION(JPMODELMAX)::NSV_SLTDEPBEG_A = 0 ! with indices in the range :
-INTEGER,DIMENSION(JPMODELMAX)::NSV_SLTDEPEND_A = 0 ! NSV_SLTBEG_A...NSV_SLTEND_A
-!
-INTEGER,DIMENSION(JPMODELMAX)::NSV_PP_A = 0 ! number of passive pol.
-INTEGER,DIMENSION(JPMODELMAX)::NSV_PPBEG_A = 0 ! with indices in the range :
-INTEGER,DIMENSION(JPMODELMAX)::NSV_PPEND_A = 0 ! NSV_PPBEG_A...NSV_PPEND_A
-!
-INTEGER,DIMENSION(JPMODELMAX)::NSV_CS_A = 0 ! number of condit.samplings
-INTEGER,DIMENSION(JPMODELMAX)::NSV_CSBEG_A = 0 ! with indices in the range :
-INTEGER,DIMENSION(JPMODELMAX)::NSV_CSEND_A = 0 ! NSV_CSBEG_A...NSV_CSEND_A
-!
-INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_A = 0 ! number of scalar in LIMA
-INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_BEG_A = 0 ! with indices in the range :
-INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_END_A = 0 ! NSV_LIMA_BEG_A...NSV_LIMA_END_A
-INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_NC_A = 0 ! First Nc variable
-INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_NR_A = 0 ! First Nr variable
-INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_CCN_FREE_A = 0 ! First Free CCN conc.
-INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_CCN_ACTI_A = 0 ! First Acti. CNN conc.
-INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_SCAVMASS_A = 0 ! Scavenged mass variable
-INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_NI_A = 0 ! First Ni var.
-INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_IFN_FREE_A = 0 ! First Free IFN conc.
-INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_IFN_NUCL_A = 0 ! First Nucl. IFN conc.
-INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_IMM_NUCL_A = 0 ! First Nucl. IMM conc.
-INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_HOM_HAZE_A = 0 ! Hom. freezing of CCN
-INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_SPRO_A = 0 ! Supersaturation
-!
-#ifdef MNH_FOREFIRE
-INTEGER,DIMENSION(JPMODELMAX)::NSV_FF_A = 0 ! number of ForeFire scalar variables
-INTEGER,DIMENSION(JPMODELMAX)::NSV_FFBEG_A = 0 ! with indices in the range :
-INTEGER,DIMENSION(JPMODELMAX)::NSV_FFEND_A = 0 ! NSV_FFBEG_A...NSV_FFEND_A
-#endif
-!
-INTEGER,DIMENSION(JPMODELMAX)::NSV_SNW_A = 0 ! number of blowing snow scalar
-INTEGER,DIMENSION(JPMODELMAX)::NSV_SNWBEG_A = 0 ! with indices in the range :
-INTEGER,DIMENSION(JPMODELMAX)::NSV_SNWEND_A = 0 ! NSV_SNWBEG_A...NSV_SNWEND_A
-!
-!###############################################################################
-!
-! variables updated for the current model
-!
-CHARACTER(LEN=JPSVNAMELGTMAX), DIMENSION(:), POINTER :: CSVNAMES !Names of all the scalar variables
-CHARACTER(LEN=6), DIMENSION(:), ALLOCATABLE :: CSV ! name of the scalar variables
-INTEGER :: NSV = 0 ! total number of user scalar variables
-!
-INTEGER :: NSV_USER = 0 ! number of user scalar variables with indices
- ! in the range : 1...NSV_USER
-INTEGER :: NSV_C2R2 = 0 ! number of liq scalar used in C2R2 and in C3R5
-INTEGER :: NSV_C2R2BEG = 0 ! with indices in the range :
-INTEGER :: NSV_C2R2END = 0 ! NSV_C2R2BEG...NSV_C2R2END
-!
-INTEGER :: NSV_C1R3 = 0 ! number of ice scalar used in C3R5
-INTEGER :: NSV_C1R3BEG = 0 ! with indices in the range :
-INTEGER :: NSV_C1R3END = 0 ! NSV_C1R3BEG...NSV_C1R3END
-!
-INTEGER :: NSV_ELEC = 0 ! number of scalar variables used in ELEC
-INTEGER :: NSV_ELECBEG = 0 ! with indices in the range :
-INTEGER :: NSV_ELECEND = 0 ! NSV_ELECBEG...NSV_ELECEND
-!
-INTEGER :: NSV_CHEM = 0 ! number of chemical scalar variables
-INTEGER :: NSV_CHEMBEG = 0 ! with indices in the range :
-INTEGER :: NSV_CHEMEND = 0 ! NSV_CHEMBEG...NSV_CHEMEND
-!
-INTEGER :: NSV_CHGS = 0 ! number of gas-phase chemicals
-INTEGER :: NSV_CHGSBEG = 0 ! with indices in the range :
-INTEGER :: NSV_CHGSEND = 0 ! NSV_CHGSBEG...NSV_CHGSEND
-!
-INTEGER :: NSV_CHAC = 0 ! number of aqueous-phase chemicals
-INTEGER :: NSV_CHACBEG = 0 ! with indices in the range :
-INTEGER :: NSV_CHACEND = 0 ! NSV_CHACBEG...NSV_CHACEND
-!
-INTEGER :: NSV_CHIC = 0 ! number of ice-phase chemicals
-INTEGER :: NSV_CHICBEG = 0 ! with indices in the range :
-INTEGER :: NSV_CHICEND = 0 ! NSV_CHICBEG...NSV_CHICEND
-!
-INTEGER :: NSV_LG = 0 ! number of lagrangian
-INTEGER :: NSV_LGBEG = 0 ! with indices in the range :
-INTEGER :: NSV_LGEND = 0 ! NSV_LGBEG...NSV_LGEND
-!
-INTEGER :: NSV_LNOX = 0 ! number of lightning NOx variables
-INTEGER :: NSV_LNOXBEG = 0 ! with indices in the range :
-INTEGER :: NSV_LNOXEND = 0 ! NSV_LNOXBEG...NSV_LNOXEND
-!
-INTEGER :: NSV_DST = 0 ! number of dust scalar variables
-INTEGER :: NSV_DSTBEG = 0 ! with indices in the range :
-INTEGER :: NSV_DSTEND = 0 ! NSV_DSTBEG...NSV_DSTEND
-
-INTEGER :: NSV_SLT = 0 ! number of sea salt scalar variables
-INTEGER :: NSV_SLTBEG = 0 ! with indices in the range :
-INTEGER :: NSV_SLTEND = 0 ! NSV_SLTBEG...NSV_SLTEND
-
-INTEGER :: NSV_AER = 0 ! number of aerosol scalar variables
-INTEGER :: NSV_AERBEG = 0 ! with indices in the range :
-INTEGER :: NSV_AEREND = 0 ! NSV_AERBEG...NSV_AEREND
-
-INTEGER :: NSV_DSTDEP = 0 ! number of aerosol scalar variables
-INTEGER :: NSV_DSTDEPBEG = 0 ! with indices in the range :
-INTEGER :: NSV_DSTDEPEND = 0 ! NSV_AERBEG...NSV_AEREND
-!
-INTEGER :: NSV_AERDEP = 0 ! number of aerosol scalar variables
-INTEGER :: NSV_AERDEPBEG = 0 ! with indices in the range :
-INTEGER :: NSV_AERDEPEND = 0 ! NSV_AERBEG...NSV_AEREND
-
-INTEGER :: NSV_SLTDEP = 0 ! number of aerosol scalar variables
-INTEGER :: NSV_SLTDEPBEG = 0 ! with indices in the range :
-INTEGER :: NSV_SLTDEPEND = 0 ! NSV_AERBEG...NSV_AEREND
-!
-INTEGER :: NSV_PP = 0 ! number of passive pollutants
-INTEGER :: NSV_PPBEG = 0 ! with indices in the range :
-INTEGER :: NSV_PPEND = 0 ! NSV_PPBEG...NSV_PPEND
-!
-INTEGER :: NSV_CS = 0 ! number of condit.samplings
-INTEGER :: NSV_CSBEG = 0 ! with indices in the range :
-INTEGER :: NSV_CSEND = 0 ! NSV_CSBEG...NSV_CSEND
-!
-INTEGER :: NSV_LIMA ! number of scalar in LIMA
-INTEGER :: NSV_LIMA_BEG ! with indices in the range :
-INTEGER :: NSV_LIMA_END ! NSV_LIMA_BEG_A...NSV_LIMA_END_A
-INTEGER :: NSV_LIMA_NC !
-INTEGER :: NSV_LIMA_NR !
-INTEGER :: NSV_LIMA_CCN_FREE !
-INTEGER :: NSV_LIMA_CCN_ACTI !
-INTEGER :: NSV_LIMA_SCAVMASS !
-INTEGER :: NSV_LIMA_NI !
-INTEGER :: NSV_LIMA_IFN_FREE !
-INTEGER :: NSV_LIMA_IFN_NUCL !
-INTEGER :: NSV_LIMA_IMM_NUCL !
-INTEGER :: NSV_LIMA_HOM_HAZE !
-INTEGER :: NSV_LIMA_SPRO !
-!
-#ifdef MNH_FOREFIRE
-INTEGER :: NSV_FF = 0 ! number of ForeFire scalar variables
-INTEGER :: NSV_FFBEG = 0 ! with indices in the range :
-INTEGER :: NSV_FFEND = 0 ! NSV_FFBEG...NSV_FFEND
-#endif
-!
-INTEGER :: NSV_SNW = 0 ! number of blowing snow scalar variables
-INTEGER :: NSV_SNWBEG = 0 ! with indices in the range :
-INTEGER :: NSV_SNWEND = 0 ! NSV_SNWBEG...NSV_SNWEND
-
-END MODULE MODD_NSV
diff --git a/src/mesonh/micro/mode_qsatmx_tab.F90 b/src/mesonh/micro/mode_qsatmx_tab.F90
new file mode 100644
index 0000000000000000000000000000000000000000..01d697b19bdeeb1cc011c4826e8c37da037cb944
--- /dev/null
+++ b/src/mesonh/micro/mode_qsatmx_tab.F90
@@ -0,0 +1,27 @@
+MODULE MODE_QSATMX_TAB
+IMPLICIT NONE
+CONTAINS
+FUNCTION QSATMX_TAB(P,T,FICE)
+
+ USE PARKIND1, ONLY : JPRB
+ USE MODD_CST ,ONLY : XEPSILO
+ USE MODE_TIWMX, ONLY : ESATI,ESATW
+
+ IMPLICIT NONE
+
+ REAL :: QSATMX_TAB
+ REAL, INTENT(IN) :: P,T,FICE
+
+ REAL :: ZES
+
+ ZES = ESATI(T)*FICE + ESATW(T)*(1.-FICE)
+ IF(ZES >= P)THEN ! temp > boiling point, condensation not possible.
+ ! Then this function lacks physical meaning,
+ ! here set to one
+ QSATMX_TAB = 1.
+ ELSE
+ QSATMX_TAB = XEPSILO*ZES/(P-ZES) !r
+ ENDIF
+
+END FUNCTION QSATMX_TAB
+END MODULE MODE_QSATMX_TAB
diff --git a/src/mesonh/micro/radtr_satel.f90 b/src/mesonh/micro/radtr_satel.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ccad5e716ca659cfd4a058ce37ea5b38b06ad531
--- /dev/null
+++ b/src/mesonh/micro/radtr_satel.f90
@@ -0,0 +1,738 @@
+!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 MODI_RADTR_SATEL
+! #######################
+INTERFACE
+!
+ SUBROUTINE RADTR_SATEL(KYEARF, KMONTHF, KDAYF, PSECF, &
+ KDLON, KFLEV, KSTATM, KRAD_COLNBR, PEMIS, PCCO2, &
+ PTSRAD, PSTATM, PTHT, PRT, PPABST, PZZ, &
+ PSIGS, PMFCONV, PCLDFR, OUSERI, OSIGMAS, &
+ OSUBG_COND, ORAD_SUBG_COND, PIRBT, PWVBT, KGEO,PSIGQSAT )
+!
+INTEGER, INTENT(IN) :: KYEARF ! year of Final date
+INTEGER, INTENT(IN) :: KMONTHF ! month of Final date
+INTEGER, INTENT(IN) :: KDAYF ! day of Final date
+REAL, INTENT(IN) :: PSECF ! number of seconds since date at 00 UTC
+!
+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) :: KSTATM !index of the standard atmosphere level
+ !just above the model top
+INTEGER, INTENT(IN) :: KRAD_COLNBR !factor by which the memory is split
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PEMIS !Surface IR EMISsivity
+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
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST !pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ !Model level heights
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s from turbulence scheme
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV! convective mass flux (kg /s m^2)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! cloud fraction
+!
+LOGICAL, INTENT(IN) :: OUSERI ! logical switch to compute both
+ ! liquid and solid condensate (OUSERI=.TRUE.)
+ ! or only liquid condensate (OUSERI=.FALSE.)
+LOGICAL, INTENT(IN) :: OSIGMAS! use present global Sigma_s values
+ ! or that from turbulence scheme
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid Condensation
+ ! (prognotic mode)
+LOGICAL, INTENT(IN) :: ORAD_SUBG_COND ! Switch for Subgrid Condensation
+ ! (diagnostic mode)
+!
+REAL, DIMENSION(:,:), INTENT(OUT):: PIRBT !IR Brightness Temp. (K)
+REAL, DIMENSION(:,:), INTENT(OUT):: PWVBT !WV Brightness Temp. (K)
+!
+INTEGER, INTENT(IN) :: KGEO !SATELLITE INDEX
+REAL, INTENT(IN) :: PSIGQSAT ! use an extra "qsat" variance contribution (OSIGMAS case)
+!
+END SUBROUTINE RADTR_SATEL
+END INTERFACE
+END MODULE MODI_RADTR_SATEL
+! #####################################################################
+ SUBROUTINE RADTR_SATEL(KYEARF, KMONTHF, KDAYF, PSECF, &
+ KDLON, KFLEV, KSTATM, KRAD_COLNBR, PEMIS, PCCO2, &
+ PTSRAD, PSTATM, PTHT, PRT, PPABST, PZZ, &
+ PSIGS, PMFCONV, PCLDFR, OUSERI, OSIGMAS, &
+ OSUBG_COND, ORAD_SUBG_COND, PIRBT, PWVBT, KGEO,PSIGQSAT)
+! #####################################################################
+!
+!!**** *RADTR_SATEL* -
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!! Chaboureau, J.-P., J.-P. Cammas, P. Mascart, J.-P. Pinty, C. Claud, R. Roca,
+!! and J.-J. Morcrette, 2000: Evaluation of a cloud system life-cycle simulated
+!! by Meso-NH during FASTEX using METEOSAT radiances and TOVS-3I cloud retrievals.
+!! Q. J. R. Meteorol. Soc., 126, 1735-1750.
+!! Chaboureau, J.-P. and P. Bechtold, 2002: A simple cloud parameterization from
+!! cloud resolving model data: Theory and application. J. Atmos. Sci., 59, 2362-2372.
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Chaboureau *L.A.*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 29/03/00
+!! J.-P. Chaboureau 15/04/03 add call to the subgrid condensation scheme
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! G.Delautier 04/2016 : BUG JPHEXT
+!! S. Riette 11/2016 : Condensation interface changed
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST
+USE MODD_PARAMETERS
+USE MODD_GRID_n
+!
+USE MODD_RAD_TRANSF
+USE MODE_ll
+!
+USE MODI_INIT_NBMOD
+USE MODI_DETER_ANGLE
+USE MODI_MAKE_RADSAT
+!
+USE MODI_CONDENSATION
+!
+IMPLICIT NONE
+!
+!* 0.1 DECLARATIONS OF DUMMY ARGUMENTS :
+!
+INTEGER, INTENT(IN) :: KYEARF ! year of Final date
+INTEGER, INTENT(IN) :: KMONTHF ! month of Final date
+INTEGER, INTENT(IN) :: KDAYF ! day of Final date
+REAL, INTENT(IN) :: PSECF ! number of seconds since date at 00 UTC
+!
+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) :: KSTATM !index of the standard atmosphere level
+ !just above the model top
+INTEGER, INTENT(IN) :: KRAD_COLNBR !factor by which the memory is split
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PEMIS !Surface IR EMISsivity
+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
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST !pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ !Model level heights
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s from turbulence scheme
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV! convective mass flux (kg /s m^2)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! cloud fraction
+!
+LOGICAL, INTENT(IN) :: OUSERI ! logical switch to compute both
+ ! liquid and solid condensate (OUSERI=.TRUE.)
+ ! or only liquid condensate (OUSERI=.FALSE.)
+LOGICAL, INTENT(IN) :: OSIGMAS! use present global Sigma_s values
+ ! or that from turbulence scheme
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid Condensation
+ ! (prognotic mode)
+LOGICAL, INTENT(IN) :: ORAD_SUBG_COND ! Switch for Subgrid Condensation
+ ! (diagnostic mode)
+!
+REAL, DIMENSION(:,:), INTENT(OUT):: PIRBT !IR Brightness Temp. (K)
+REAL, DIMENSION(:,:), INTENT(OUT):: PWVBT !WV Brightness Temp. (K)
+!
+INTEGER, INTENT(IN) :: KGEO !SATELLITE INDEX
+REAL, INTENT(IN) :: PSIGQSAT ! use an extra "qsat" variance contribution (OSIGMAS case)
+!
+!* 0.2 DECLARATIONS OF LOCAL VARIABLES
+!
+LOGICAL :: GPTDEP, GPVOIGT
+!
+! reference state
+!from inprof
+INTEGER :: IGL, ICABS, ING1, IUABS, IINIS, IENDS, ICONF, ICLOUD, IOVLP
+INTEGER :: IH2O, ICO2, IO3, ICNT, IN2O, ICH4, ICO, IC11, IC12, ICFC
+!
+LOGICAL, DIMENSION(KDLON) :: GDOIT_2D ! .TRUE. for the larger scale
+LOGICAL, DIMENSION(KDLON,KFLEV) :: GDOIT ! .TRUE. for all the levels of the
+ ! larger scale columns
+!
+INTEGER :: JI,JJ,JK,JK1,JK2,JKRAD ! loop indexes
+!
+INTEGER :: IIB,IIE ! I index value of the first/last inner mass point
+INTEGER :: IJB,IJE ! J index value of the first/last inner mass point
+INTEGER :: IKB,IKE ! K index value of the first/last inner mass point
+INTEGER :: IIU ! array size for the first index
+INTEGER :: IJU ! array size for the second index
+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
+INTEGER :: IDOIT_COL ! number of larger scale columns
+INTEGER :: IDOIT ! number of levels corresponding of the larger scale
+ ! columns are filled in
+INTEGER :: IDIM ! effective number of columns for which the radiation
+ ! code is run
+INTEGER, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,3)) :: IKKOZ ! indice array used to
+ ! vertically interpolate the ozone content on the model grid
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTAVE ! mean-layer temperature
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZQVAVE ! mean-layer specific humidity
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZO3AVE ! mean-layer ozone content
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZPRES_HL ! half-level pressure
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZT_HL ! half-level temperature
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCLDLD ! Downward cloud emissivity
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCLDLU ! Upward cloud emissivity
+REAL, DIMENSION(:), ALLOCATABLE :: ZVIEW ! cosecant of viewing angle
+REAL, DIMENSION(:), ALLOCATABLE :: ZREMIS ! Reformatted PEMIS array
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEXNT ! Exner function
+REAL, DIMENSION(SIZE(PSTATM,1)) :: ZSTAZZ,ZSTAOZ ! STAndard atmosphere height
+ ! and OZone content
+REAL :: ZOZ ! variable used to interpolate the ozone profile
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZDT0 ! surface discontinuity
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRADBT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRADBC
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRADFT
+REAL, DIMENSION(:), ALLOCATABLE :: ZULAT
+REAL, DIMENSION(:), ALLOCATABLE :: ZULON
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZZRADFT
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZWORK1, ZWORK3
+!
+! split arrays used to split the memory required by the ECMWF_radiation
+! subroutine, the fields have the same meaning as their complete counterpart
+REAL, DIMENSION(:), ALLOCATABLE :: ZREMIS_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZO3AVE_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZT_HL_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZPRES_HL_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZQVAVE_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZTAVE_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCLDLD_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCLDLU_SPLIT
+REAL, DIMENSION(:), ALLOCATABLE :: ZVIEW_SPLIT
+REAL, DIMENSION(:), ALLOCATABLE :: ZDT0_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRADBT_SPLIT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZRADBC_SPLIT
+!
+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
+!
+! Other arrays for emissivity
+REAL :: ZFLWP, ZFIWP, ZANGCOR, ZRADLP, ZMULTS, ZTMP, ZKI
+!
+! Other arrays for condensation
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTEMP ! Temperature
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSIGRC ! s r_c / sig_s^2
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZNCLD ! grid scale cloud fraction
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRC_IN, ZRC_OUT ! grid scale r_c mixing ratio (kg/kg)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRI_IN, ZRI_OUT ! grid scale r_i (kg/kg)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRV_IN, ZRV_OUT ! grid scale r_v (kg/kg)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHO
+REAL, DIMENSION(SIZE(PPABST,1),SIZE(PPABST,2)) :: ZSIGQSAT2D
+!----------------------------------------------------------------------------
+!
+!* 1. INITIALIZATION OF CONSTANTS FOR TRANSFERT CODE
+! ----------------------------------------------
+!
+CALL INIT_NBMOD(KFLEV, IGL, ICABS, ING1, IUABS, IINIS, IENDS, &
+ IH2O, ICO2, IO3, ICNT, IN2O, ICH4, ICO, IC11, IC12, ICFC, &
+ ICONF, ICLOUD, IOVLP, GPVOIGT, GPTDEP)
+X1CO2 = PCCO2 / 44.0 * XMD
+!
+!----------------------------------------------------------------------------
+!
+!* 2. COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES
+! ----------------------------------------------
+!
+IIU = SIZE(PTHT,1)
+IJU = SIZE(PTHT,2)
+IKU = SIZE(PTHT,3)
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB = 1 + JPVEXT
+IKE = IKU - JPVEXT
+!
+IKSTAE = SIZE(PSTATM,1)
+IKUP = IKE-JPVEXT+1
+!
+!----------------------------------------------------------------------------
+!
+!* 3. INITIALIZES THE MEAN-LAYER VARIABLES
+! ------------------------------------
+!
+ALLOCATE(ZEXNT(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ZEXNT(:,:,:)= ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
+!
+ALLOCATE(ZTAVE(KDLON,KFLEV))
+ALLOCATE(ZQVAVE(KDLON,KFLEV))
+!
+ZQVAVE(:,:) = 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)
+ ZTAVE(IIJ,JKRAD) = PTHT(JI,JJ,JK)*ZEXNT(JI,JJ,JK)
+ 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) = PRT(JI,JJ,JK,1)
+ 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
+!
+!----------------------------------------------------------------------------
+!
+!* 4. 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
+! 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
+END DO
+!
+! Surface temperature at the first level
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZT_HL(IIJ,1) = 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
+! 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
+!
+!----------------------------------------------------------------------------
+!
+!* 5. INITIALIZES THE OZONE PROFILES from the standard atmosphere
+! ------------------------------
+!
+ALLOCATE(ZO3AVE(KDLON,KFLEV))
+!
+ZSTAOZ(:) = PSTATM(:,6)/PSTATM(:,4)
+ZSTAZZ(:) = 1000.0*PSTATM(:,1)
+!
+DO JJ = IJB,IJE
+ DO JK2 = IKB,IKE
+ JKRAD = JK2-JPVEXT
+ IKKOZ(:,JK2) = IKB-1
+ DO JK1 = 1,IKSTAE
+ DO JI = IIB,IIE
+ IKKOZ(JI,JK2)=IKKOZ(JI,JK2) + NINT(0.5 + SIGN(0.5, &
+ -ZSTAZZ(JK1)+0.5*(PZZ(JI,JJ,JK2)+PZZ(JI,JJ,JK2+1)) ))
+ END DO
+ END DO
+ DO JI = IIB,IIE
+ ZOZ=(0.5*(PZZ(JI,JJ,JK2)+PZZ(JI,JJ,JK2+1))- ZSTAZZ(IKKOZ(JI,JK2))) &
+ /( ZSTAZZ(IKKOZ(JI,JK2)+1) - ZSTAZZ(IKKOZ(JI,JK2)))
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZO3AVE(IIJ,JKRAD) =( (1.- ZOZ) * ZSTAOZ(IKKOZ(JI,JK2)) &
+ + ZOZ * ZSTAOZ(IKKOZ(JI,JK2)+1))
+ END DO
+ END DO
+END DO
+!
+DO JK=IKUP,KFLEV
+ JK1 = (KSTATM)+(JK-IKUP)
+ ZO3AVE(:,JK) = ZSTAOZ(JK1)
+END DO
+!
+!----------------------------------------------------------------------------
+!
+!* 6. CALLS THE E.C.M.W.F. RADIATION CODE
+! -----------------------------------
+!
+!* 6.1 INITIALIZES 2D AND SURFACE FIELDS
+!
+ALLOCATE(ZREMIS(KDLON))
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZREMIS(IIJ) = PEMIS(JI,JJ)
+ END DO
+END DO
+!
+! initializes surface discontinuity field
+ALLOCATE(ZDT0(KDLON))
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZDT0(IIJ) = PTSRAD(JI,JJ) - PTHT(JI,JJ,1)*ZEXNT(JI,JJ,1)
+ END DO
+END DO
+!
+ALLOCATE(ZULAT(KDLON))
+ALLOCATE(ZULON(KDLON))
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ ZULON(IIJ) = XLON(JI,JJ)
+ ZULAT(IIJ) = XLAT(JI,JJ)
+ END DO
+END DO
+ALLOCATE(ZVIEW(KDLON))
+CALL DETER_ANGLE(KGEO, KDLON, ZULAT, ZULON, ZVIEW)
+DEALLOCATE(ZULAT)
+DEALLOCATE(ZULON)
+!
+!
+ALLOCATE(ZCLDLD(KDLON,KFLEV))
+ALLOCATE(ZCLDLU(KDLON,KFLEV))
+ZCLDLD = 0.
+ZCLDLU = 0.
+!
+IF( SIZE(PRT(:,:,:,:),4) >= 2 ) THEN
+ ALLOCATE(ZNCLD(IIU,IJU,IKU))
+ ALLOCATE(ZRC_IN(IIU,IJU,IKU))
+ ALLOCATE(ZRC_OUT(IIU,IJU,IKU))
+ ZRC_IN=PRT(:,:,:,2)
+ ALLOCATE(ZRI_IN(IIU,IJU,IKU))
+ ALLOCATE(ZRI_OUT(IIU,IJU,IKU))
+ ZRI_IN=0.
+ IF( OUSERI ) ZRI_IN=PRT(:,:,:,4)
+ IF ( .NOT. OSUBG_COND .AND. ORAD_SUBG_COND) THEN
+ PRINT*,' THE SUBGRID CONDENSATION SCHEME IN DIAGNOSTIC MODE IS ACTIVATED'
+ ALLOCATE(ZTEMP(IIU,IJU,IKU))
+ ZTEMP=PTHT*ZEXNT
+ ALLOCATE(ZSIGRC(IIU,IJU,IKU))
+ ALLOCATE(ZRV_IN(IIU,IJU,IKU))
+
+ ZRV_IN=PRT(:,:,:,1)
+ ALLOCATE(ZRHO(IIU,IJU,IKU))
+ ZRHO=1. !unused
+ ZSIGQSAT2D(:,:)=PSIGQSAT
+ CALL CONDENSATION( IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, 1, 'T', 'CB02', 'CB',&
+ PPABST, PZZ, ZRHO, ZTEMP, ZRV_IN, ZRV_OUT, ZRC_IN, ZRC_OUT, ZRI_IN, ZRI_OUT, PRT(:,:,:,5), PRT(:,:,:,6), PSIGS,&
+ PMFCONV, ZNCLD, ZSIGRC, OUSERI, OSIGMAS, .FALSE., PSIGQSAT=ZSIGQSAT2D )
+ DEALLOCATE(ZTEMP,ZSIGRC)
+ DEALLOCATE(ZRV_OUT)
+ ELSE
+ ZNCLD=PCLDFR
+ END IF
+ 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)
+ IF ( ZVIEW(IIJ) /= XUNDEF .AND. &
+ (ZRC_OUT(JI,JJ,JK) > 0. .OR. ZRI_OUT(JI,JJ,JK) > 0. ) ) THEN
+ ZFLWP = ZRC_OUT(JI,JJ,JK) / XG /MAX(1.E-10,ZNCLD(JI,JJ,JK)) &
+ * (PPABST(JI,JJ,JK)-PPABST(JI,JJ,JK+1))
+ ZFIWP = ZRI_OUT(JI,JJ,JK) / XG /MAX(1.E-10,ZNCLD(JI,JJ,JK)) &
+ * (PPABST(JI,JJ,JK)-PPABST(JI,JJ,JK+1))
+ ZANGCOR = ZVIEW(IIJ) / 1.66
+ !!!Parametrization following Ou and Chou, 1995 (Atmos. Res.)
+ ZTMP = ZTAVE(IIJ,JKRAD)-XTT !ZTMP in Celsius degree
+ ZRADLP = 326.3+12.42*ZTMP+0.197*(ZTMP**2)+0.0012*(ZTMP**3)
+ ZRADLP = MIN(140., MAX(20., ZRADLP))
+!!! Parametrization following Ebert and Curry, 1992 (JGR-d)
+ ZKI = 0.3 + 1290. / ZRADLP
+ ZCLDLD(IIJ,JKRAD) = ZNCLD(JI,JJ,JK)*(1.-EXP &
+ ( -158.*ZFLWP *ZANGCOR-ZKI*ZFIWP*ZVIEW(IIJ)))
+ ZCLDLU(IIJ,JKRAD) = ZNCLD(JI,JJ,JK)*(1.-EXP &
+ ( -130.*ZFLWP *ZANGCOR-ZKI*ZFIWP*ZVIEW(IIJ)))
+ END IF
+ END DO
+ END DO
+ END DO
+ DEALLOCATE(ZNCLD,ZRC_OUT,ZRI_OUT)
+END IF
+!
+DEALLOCATE(ZEXNT)
+!
+GDOIT_2D(:) = .FALSE.
+!
+! Flags the columns for which the computations have to be performed
+!
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ IF (ZVIEW(IIJ) /= XUNDEF) GDOIT_2D(IIJ) = .TRUE.
+ END DO
+END DO
+IDOIT_COL = COUNT( GDOIT_2D(:) ) ! number of larger scale columns
+!
+GDOIT(:,:) = SPREAD( GDOIT_2D(:),DIM=2,NCOPIES=KFLEV )
+IDOIT = IDOIT_COL*KFLEV
+ALLOCATE(ZWORK1(IDOIT))
+!
+! temperature profiles
+ZWORK1(:) = PACK( ZTAVE(:,:),MASK=GDOIT(:,:) )
+DEALLOCATE(ZTAVE)
+ALLOCATE(ZTAVE(IDOIT_COL,KFLEV))
+ZTAVE(:,:) = RESHAPE( ZWORK1(:),(/IDOIT_COL,KFLEV/) )
+!
+! vapor mixing ratio profiles
+ZWORK1(:) = PACK( ZQVAVE(:,:),MASK=GDOIT(:,:) )
+DEALLOCATE(ZQVAVE)
+ALLOCATE(ZQVAVE(IDOIT_COL,KFLEV))
+ZQVAVE(:,:) = RESHAPE( ZWORK1(:),(/IDOIT_COL,KFLEV/) )
+!
+! cloud emissivities
+ZWORK1(:) = PACK( ZCLDLD(:,:),MASK=GDOIT(:,:) )
+DEALLOCATE(ZCLDLD)
+ALLOCATE(ZCLDLD(IDOIT_COL,KFLEV))
+ZCLDLD(:,:) = RESHAPE( ZWORK1(:),(/IDOIT_COL,KFLEV/) )
+!
+ZWORK1(:) = PACK( ZCLDLU(:,:),MASK=GDOIT(:,:) )
+DEALLOCATE(ZCLDLU)
+ALLOCATE(ZCLDLU(IDOIT_COL,KFLEV))
+ZCLDLU(:,:) = RESHAPE( ZWORK1(:),(/IDOIT_COL,KFLEV/) )
+!
+! ozone content profiles
+ZWORK1(:) = PACK( ZO3AVE(:,:),MASK=GDOIT(:,:) )
+DEALLOCATE(ZO3AVE)
+ALLOCATE(ZO3AVE(IDOIT_COL,KFLEV))
+ZO3AVE(:,:) = RESHAPE( ZWORK1(:),(/IDOIT_COL,KFLEV/) )
+!
+! half-level variables
+ZWORK1(:) = PACK( ZPRES_HL(:,1:KFLEV),MASK=GDOIT(:,:) )
+DEALLOCATE(ZPRES_HL)
+ALLOCATE(ZPRES_HL(IDOIT_COL,KFLEV+1))
+ZPRES_HL(:,1:KFLEV) = RESHAPE( ZWORK1(:),(/IDOIT_COL,KFLEV/) )
+ZPRES_HL(:,KFLEV+1) = PSTATM(IKSTAE,2)*100.0
+!
+ZWORK1(:) = PACK( ZT_HL(:,1:KFLEV),MASK=GDOIT(:,:) )
+DEALLOCATE(ZT_HL)
+ALLOCATE(ZT_HL(IDOIT_COL,KFLEV+1))
+ZT_HL(:,1:KFLEV) = RESHAPE( ZWORK1(:),(/IDOIT_COL,KFLEV/) )
+ZT_HL(:,KFLEV+1) = PSTATM(IKSTAE,3)
+!
+! surface fields
+ALLOCATE(ZWORK3(IDOIT_COL))
+ZWORK3(:) = PACK( ZVIEW(:),MASK=GDOIT_2D(:) )
+DEALLOCATE(ZVIEW)
+ALLOCATE(ZVIEW(IDOIT_COL))
+ZVIEW(:) = ZWORK3(:)
+!
+ZWORK3(:) = PACK( ZREMIS(:),MASK=GDOIT_2D(:) )
+DEALLOCATE(ZREMIS)
+ALLOCATE(ZREMIS(IDOIT_COL))
+ZREMIS(:) = ZWORK3(:)
+!
+ZWORK3(:) = PACK( ZDT0(:),MASK=GDOIT_2D(:) )
+DEALLOCATE(ZDT0)
+ALLOCATE(ZDT0(IDOIT_COL))
+ZDT0(:) = ZWORK3(:)
+!
+DEALLOCATE(ZWORK1)
+DEALLOCATE(ZWORK3)
+!
+! radiation fields
+ALLOCATE(ZRADBC(IDOIT_COL,JPWVINT))
+ALLOCATE(ZRADBT(IDOIT_COL,JPWVINT))
+!
+IDIM = IDOIT_COL
+PRINT *,'KGEO =',KGEO,' IDIM =',IDIM
+!
+!* 6.2 CALLS THE ECMWF_RADIATION ROUTINES
+!
+! ***********************************************************
+! *CAUTION: Routine nbmvec is written in FORTRAN 77*
+! ***********************************************************
+!
+! mixing ratio -> specific humidity conversion
+ZQVAVE(:,:) = ZQVAVE(:,:) / (1.+ZQVAVE(:,:))
+!
+IF( IDIM <= KRAD_COLNBR ) THEN
+ !
+ ! there is less than KRAD_COLNBR verticals to be considered therefore
+ ! no split of the arrays is performed
+ !
+ CALL NBMVEC( 1, IDIM, IDIM, KFLEV, IGL, ICABS, ING1, IUABS, &
+ IH2O, ICO2, IO3, ICNT, IN2O, ICH4, ICO, IC11, IC12, ICFC, &
+ IINIS, IENDS, ICONF, ICLOUD, IOVLP, GPVOIGT, GPTDEP, &
+ ZTAVE, ZQVAVE, ZO3AVE, ZPRES_HL, ZT_HL, &
+ ZVIEW, ZCLDLD, ZCLDLU, ZDT0, ZREMIS, ZRADBC, ZRADBT)
+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( ZREMIS_SPLIT(IDIM_EFF))
+ ALLOCATE( ZO3AVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZT_HL_SPLIT(IDIM_EFF,KFLEV+1))
+ ALLOCATE( ZPRES_HL_SPLIT(IDIM_EFF,KFLEV+1))
+ ALLOCATE( ZQVAVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZTAVE_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZCLDLU_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZCLDLD_SPLIT(IDIM_EFF,KFLEV))
+ ALLOCATE( ZVIEW_SPLIT(IDIM_EFF))
+ ALLOCATE( ZDT0_SPLIT(IDIM_EFF))
+ ALLOCATE( ZRADBT_SPLIT(IDIM_EFF,JPWVINT))
+ ALLOCATE( ZRADBC_SPLIT(IDIM_EFF,JPWVINT))
+ END IF
+ !
+ ! fill the split arrays with their values
+ ! taken from the full arrays
+ !
+ IBEG = IDIM-IDIM_RESIDUE+1
+ IEND = IBEG+IDIM_EFF-1
+ ZREMIS_SPLIT(:) = ZREMIS( IBEG:IEND )
+ ZO3AVE_SPLIT(:,:) = ZO3AVE( IBEG:IEND ,:)
+ ZT_HL_SPLIT(:,:) = ZT_HL( IBEG:IEND ,:)
+ ZPRES_HL_SPLIT(:,:) = ZPRES_HL( IBEG:IEND ,:)
+ ZQVAVE_SPLIT(:,:) = ZQVAVE( IBEG:IEND ,:)
+ ZTAVE_SPLIT(:,:) = ZTAVE ( IBEG:IEND ,:)
+ ZCLDLU_SPLIT(:,:) = ZCLDLU ( IBEG:IEND ,:)
+ ZCLDLD_SPLIT(:,:) = ZCLDLD ( IBEG:IEND ,:)
+ ZVIEW_SPLIT(:) = ZVIEW ( IBEG:IEND )
+ ZDT0_SPLIT(:) = ZDT0 ( IBEG:IEND )
+ !
+ ! call ECMWF_radiation with the split arrays
+ !
+ CALL NBMVEC( 1, IDIM_EFF, IDIM_EFF, KFLEV, IGL, ICABS, ING1, IUABS,&
+ IH2O, ICO2, IO3, ICNT, IN2O, ICH4, ICO, IC11, IC12, ICFC, &
+ IINIS, IENDS, ICONF, ICLOUD, IOVLP, GPVOIGT, GPTDEP, &
+ ZTAVE_SPLIT, ZQVAVE_SPLIT, ZO3AVE_SPLIT, &
+ ZPRES_HL_SPLIT, ZT_HL_SPLIT, &
+ ZVIEW_SPLIT, ZCLDLD_SPLIT, ZCLDLU_SPLIT, ZDT0_SPLIT, &
+ ZREMIS_SPLIT, ZRADBC_SPLIT, ZRADBT_SPLIT)
+ !
+ ! fill the full output arrays with the split arrays
+ !
+ ZRADBT( IBEG:IEND ,:) = ZRADBT_SPLIT(:,:)
+ ZRADBC( IBEG:IEND ,:) = ZRADBC_SPLIT(:,:)
+ !
+ IDIM_RESIDUE = IDIM_RESIDUE - IDIM_EFF
+ !
+ ! desallocation of the split arrays
+ !
+ IF( JI_SPLIT >= INUM_CALL-1 ) THEN
+ DEALLOCATE(ZREMIS_SPLIT)
+ DEALLOCATE(ZO3AVE_SPLIT)
+ DEALLOCATE(ZT_HL_SPLIT)
+ DEALLOCATE(ZPRES_HL_SPLIT)
+ DEALLOCATE(ZQVAVE_SPLIT)
+ DEALLOCATE(ZTAVE_SPLIT)
+ DEALLOCATE(ZCLDLU_SPLIT)
+ DEALLOCATE(ZCLDLD_SPLIT)
+ DEALLOCATE(ZVIEW_SPLIT)
+ DEALLOCATE(ZDT0_SPLIT)
+ DEALLOCATE(ZRADBT_SPLIT)
+ DEALLOCATE(ZRADBC_SPLIT)
+ END IF
+ END DO
+END IF
+!
+DEALLOCATE(ZTAVE,ZQVAVE,ZO3AVE)
+DEALLOCATE(ZPRES_HL,ZT_HL)
+DEALLOCATE(ZREMIS)
+DEALLOCATE(ZDT0)
+DEALLOCATE(ZCLDLD,ZCLDLU)
+DEALLOCATE(ZVIEW)
+!
+ZRADBT = ZRADBT / XPI
+ALLOCATE(ZRADFT(IDIM,JPCAN))
+CALL MAKE_RADSAT(KYEARF, KMONTHF, KDAYF, PSECF, &
+ KGEO, IDIM, ZRADBT, ZRADFT)
+DEALLOCATE(ZRADBT)
+DEALLOCATE(ZRADBC)
+!
+ALLOCATE(ZWORK1(IDIM*JPCAN))
+ZWORK1(:) = PACK( ZRADFT(:,:),MASK=.TRUE. )
+ALLOCATE(ZZRADFT(KDLON,JPCAN))
+ZZRADFT(:,:) = UNPACK( ZWORK1(:),MASK=GDOIT(:,1:JPCAN),FIELD=XUNDEF )
+DEALLOCATE(ZRADFT)
+DEALLOCATE(ZWORK1)
+!
+PIRBT = XUNDEF
+PWVBT = XUNDEF
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
+ PIRBT(JI,JJ) = ZZRADFT(IIJ,1)
+ PWVBT(JI,JJ) = ZZRADFT(IIJ,2)
+ END DO
+END DO
+DEALLOCATE(ZZRADFT)
+!
+END SUBROUTINE RADTR_SATEL
diff --git a/src/mesonh/micro/rain_ice.f90 b/src/mesonh/micro/rain_ice.f90
index d736f5a9cc920751da778ad291aa4ad4898d93aa..e6b139e055f168a59da23f171e952bd9afff6004 100644
--- a/src/mesonh/micro/rain_ice.f90
+++ b/src/mesonh/micro/rain_ice.f90
@@ -245,7 +245,7 @@ use MODE_RAIN_ICE_WARM, only: RAIN_ICE_WARM
use mode_tools, only: Countjv
use mode_tools_ll, only: GET_INDICE_ll
-USE MODI_ICE4_RAINFR_VERT
+USE MODE_ICE4_RAINFR_VERT
IMPLICIT NONE
!
diff --git a/src/mesonh/micro/rain_ice_red.f90 b/src/mesonh/micro/rain_ice_red.f90
index e3d0fabd52c8b09aafead4b71716d4e091b87a83..f309723132c26e799d934b13c4935126b82c37dc 100644
--- a/src/mesonh/micro/rain_ice_red.f90
+++ b/src/mesonh/micro/rain_ice_red.f90
@@ -25,9 +25,10 @@ INTERFACE
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
PINPRC,PINPRR, PEVAP3D, &
- PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, PSEA, PTOWN, &
- PRHT, PRHS, PINPRH, PFPR, &
- TBUDGETS, KBUDGETS)
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, &
+ TBUDGETS, KBUDGETS, &
+ PSEA, PTOWN, &
+ PRHT, PRHS, PINPRH, PFPR )
!
!
USE MODD_BUDGET, ONLY: TBUDGETDATA
@@ -100,7 +101,7 @@ REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH! Hail instant pre
REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
!
TYPE(TBUDGETDATA), OPTIONAL, DIMENSION(KBUDGETS), INTENT(INOUT) :: TBUDGETS
-INTEGER, INTENT(IN) : KBUDGETS
+INTEGER, INTENT(IN) :: KBUDGETS
!
END SUBROUTINE RAIN_ICE_RED
END INTERFACE
@@ -115,9 +116,10 @@ END MODULE MODI_RAIN_ICE_RED
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
PINPRC, PINPRR, PEVAP3D, &
- PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, PSEA, PTOWN, &
- PRHT, PRHS, PINPRH, PFPR, &
- TBUDGETS, KBUDGETS)
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, &
+ TBUDGETS, KBUDGETS, &
+ PSEA, PTOWN, &
+ PRHT, PRHS, PINPRH, PFPR )
! ######################################################################
!
!!**** * - compute the explicit microphysical sources
@@ -281,7 +283,7 @@ END MODULE MODI_RAIN_ICE_RED
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-USE MODD_BUDGET, ONLY: TBUDGETDATA, LBU_ENABLE, &
+USE MODD_BUDGET, ONLY: TBUDGETDATA, LBU_ENABLE, &
& LBUDGET_TH, LBUDGET_RV, LBUDGET_RC, LBUDGET_RR, LBUDGET_RI, LBUDGET_RS, LBUDGET_RG, LBUDGET_RH, &
& NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH
USE MODD_CST, ONLY: XCI, XCL, XCPD, XCPV, XLSTT, XLVTT, XTT, XRHOLW
@@ -307,7 +309,6 @@ USE MODE_ICE4_RAINFR_VERT, ONLY: ICE4_RAINFR_VERT
USE MODE_ICE4_SEDIMENTATION_STAT, ONLY: ICE4_SEDIMENTATION_STAT
USE MODE_ICE4_SEDIMENTATION_SPLIT, ONLY: ICE4_SEDIMENTATION_SPLIT
USE MODE_ICE4_SEDIMENTATION_SPLIT_MOMENTUM, ONLY: ICE4_SEDIMENTATION_SPLIT_MOMENTUM
-USE MODE_ICE4_NUCLEATION_WRAPPER, ONLY: ICE4_NUCLEATION_WRAPPER
USE MODE_ICE4_TENDENCIES, ONLY: ICE4_TENDENCIES
!
IMPLICIT NONE
diff --git a/src/mesonh/turb/bl_depth_diag.f90 b/src/mesonh/turb/bl_depth_diag.f90
deleted file mode 100644
index 2e7fb121cdda00386511bb0254c18249bec192bb..0000000000000000000000000000000000000000
--- a/src/mesonh/turb/bl_depth_diag.f90
+++ /dev/null
@@ -1,200 +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 turb 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-! ################
- MODULE MODI_BL_DEPTH_DIAG
-! ################
-!
-INTERFACE BL_DEPTH_DIAG
-!
-!
- FUNCTION BL_DEPTH_DIAG_3D(KKB,KKE,PSURF,PZS,PFLUX,PZZ,PFTOP_O_FSURF)
-
-INTEGER, INTENT(IN) :: KKB ! bottom point
-INTEGER, INTENT(IN) :: KKE ! top point
-REAL, DIMENSION(:,:), INTENT(IN) :: PSURF ! surface flux
-REAL, DIMENSION(:,:), INTENT(IN) :: PZS ! orography
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLUX ! flux
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux points
-REAL, INTENT(IN) :: PFTOP_O_FSURF! Flux at BL top / Surface flux
-REAL, DIMENSION(SIZE(PSURF,1),SIZE(PSURF,2)) :: BL_DEPTH_DIAG_3D
-!
-END FUNCTION BL_DEPTH_DIAG_3D
-!
-!
- FUNCTION BL_DEPTH_DIAG_1D(KKB,KKE,PSURF,PZS,PFLUX,PZZ,PFTOP_O_FSURF)
-INTEGER, INTENT(IN) :: KKB ! bottom point
-INTEGER, INTENT(IN) :: KKE ! top point
-REAL, INTENT(IN) :: PSURF ! surface flux
-REAL, INTENT(IN) :: PZS ! orography
-REAL, DIMENSION(:), INTENT(IN) :: PFLUX ! flux
-REAL, DIMENSION(:), INTENT(IN) :: PZZ ! altitude of flux points
-REAL, INTENT(IN) :: PFTOP_O_FSURF! Flux at BL top / Surface flux
-REAL :: BL_DEPTH_DIAG_1D
-!
-END FUNCTION BL_DEPTH_DIAG_1D
-!
-END INTERFACE
-!
-END MODULE MODI_BL_DEPTH_DIAG
-!
-!-------------------------------------------------------------------------------
-!
-! ################
- MODULE MODI_BL_DEPTH_DIAG_3D
-! ################
-!
-!
-INTERFACE
-!
-!
- FUNCTION BL_DEPTH_DIAG_3D(KKB,KKE,PSURF,PZS,PFLUX,PZZ,PFTOP_O_FSURF)
-INTEGER, INTENT(IN) :: KKB ! bottom point
-INTEGER, INTENT(IN) :: KKE ! top point
-REAL, DIMENSION(:,:), INTENT(IN) :: PSURF ! surface flux
-REAL, DIMENSION(:,:), INTENT(IN) :: PZS ! orography
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLUX ! flux
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux points
-REAL, INTENT(IN) :: PFTOP_O_FSURF! Flux at BL top / Surface flux
-REAL, DIMENSION(SIZE(PSURF,1),SIZE(PSURF,2)) :: BL_DEPTH_DIAG_3D
-!
-END FUNCTION BL_DEPTH_DIAG_3D
-!
-!
-END INTERFACE
-!
-END MODULE MODI_BL_DEPTH_DIAG_3D
-!
-!-------------------------------------------------------------------------------
-!
-FUNCTION BL_DEPTH_DIAG_3D(KKB,KKE,PSURF,PZS,PFLUX,PZZ,PFTOP_O_FSURF)
-!
-!
-!!**** *SBL_DEPTH* - computes SBL depth
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! SBL is defined as the layer where momentum flux is equal to XSBL_FRAC of its surface value
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original nov. 2005
-!!
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!* 0.1 declarations of arguments
-!
-IMPLICIT NONE
-!
-INTEGER, INTENT(IN) :: KKB ! bottom point
-INTEGER, INTENT(IN) :: KKE ! top point
-REAL, DIMENSION(:,:), INTENT(IN) :: PSURF ! surface flux
-REAL, DIMENSION(:,:), INTENT(IN) :: PZS ! orography
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLUX ! flux
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux points
-REAL, INTENT(IN) :: PFTOP_O_FSURF! Flux at BL top / Surface flux
-REAL, DIMENSION(SIZE(PSURF,1),SIZE(PSURF,2)) :: BL_DEPTH_DIAG_3D
-!
-!
-! 0.2 declaration of local variables
-!
-INTEGER :: JI,JJ,JK ! loop counters
-INTEGER :: IKL ! +1 : MesoNH levels -1: Arome
-REAL :: ZFLX ! flux at top of BL
-!
-!----------------------------------------------------------------------------
-!
-IF (KKB < KKE) THEN
- IKL=1
-ELSE
- IKL=-1
-ENDIF
-
-BL_DEPTH_DIAG_3D(:,:) = 0.
-!
-
-DO JJ=1,SIZE(PSURF,2)
- DO JI=1,SIZE(PSURF,1)
- IF (PSURF(JI,JJ)==0.) CYCLE
- DO JK=KKB,KKE,IKL
- IF (PZZ(JI,JJ,JK-IKL)<=PZS(JI,JJ)) CYCLE
- ZFLX = PSURF(JI,JJ) * PFTOP_O_FSURF
- IF ( (PFLUX(JI,JJ,JK)-ZFLX)*(PFLUX(JI,JJ,JK-IKL)-ZFLX) <= 0. ) THEN
- BL_DEPTH_DIAG_3D(JI,JJ) = (PZZ (JI,JJ,JK-IKL) - PZS(JI,JJ)) &
- + (PZZ (JI,JJ,JK) - PZZ (JI,JJ,JK-IKL)) &
- * (ZFLX - PFLUX(JI,JJ,JK-IKL) ) &
- / (PFLUX(JI,JJ,JK) - PFLUX(JI,JJ,JK-IKL) )
- EXIT
- END IF
- END DO
- END DO
-END DO
-!
-BL_DEPTH_DIAG_3D(:,:) = BL_DEPTH_DIAG_3D(:,:) / (1. - PFTOP_O_FSURF)
-!
-END FUNCTION BL_DEPTH_DIAG_3D
-!
-!
-!-------------------------------------------------------------------------------
-!-------------------------------------------------------------------------------
-!
-FUNCTION BL_DEPTH_DIAG_1D(KKB,KKE,PSURF,PZS,PFLUX,PZZ,PFTOP_O_FSURF)
-!
-USE MODI_BL_DEPTH_DIAG_3D
-IMPLICIT NONE
-!
-INTEGER, INTENT(IN) :: KKB ! bottom point
-INTEGER, INTENT(IN) :: KKE ! top point
-REAL, INTENT(IN) :: PSURF ! surface flux
-REAL, INTENT(IN) :: PZS ! orography
-REAL, DIMENSION(:), INTENT(IN) :: PFLUX ! flux
-REAL, DIMENSION(:), INTENT(IN) :: PZZ ! altitude of flux points
-REAL, INTENT(IN) :: PFTOP_O_FSURF! Flux at BL top / Surface flux
-REAL :: BL_DEPTH_DIAG_1D
-!
-REAL, DIMENSION(1,1) :: ZSURF
-REAL, DIMENSION(1,1) :: ZZS
-REAL, DIMENSION(1,1,SIZE(PFLUX)) :: ZFLUX
-REAL, DIMENSION(1,1,SIZE(PZZ)) :: ZZZ
-REAL, DIMENSION(1,1) :: ZBL_DEPTH_DIAG
-!
-ZSURF = PSURF
-ZZS = PZS
-ZFLUX(1,1,:) = PFLUX(:)
-ZZZ (1,1,:) = PZZ (:)
-!
-ZBL_DEPTH_DIAG = BL_DEPTH_DIAG_3D(KKB,KKE,ZSURF,ZZS,ZFLUX,ZZZ,PFTOP_O_FSURF)
-!
-BL_DEPTH_DIAG_1D = ZBL_DEPTH_DIAG(1,1)
-!
-!-------------------------------------------------------------------------------
-!
-END FUNCTION BL_DEPTH_DIAG_1D
diff --git a/src/mesonh/turb/ini_cturb.f90 b/src/mesonh/turb/ini_cturb.f90
index 245dfa0632b533d2855e56b9fc3459a9e51a48cd..4da0d6452f856d60d7f795669619c3eca4dcc6ba 100644
--- a/src/mesonh/turb/ini_cturb.f90
+++ b/src/mesonh/turb/ini_cturb.f90
@@ -73,8 +73,15 @@ END MODULE MODI_INI_CTURB
USE MODD_CST
USE MODD_CTURB
!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
IMPLICIT NONE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('INI_CTURB',0,ZHOOK_HANDLE)
+!
! ---------------------------------------------------------------------------
!
! 1. SETTING THE NUMERICAL VALUES
@@ -85,7 +92,6 @@ IMPLICIT NONE
!XCED is now replaced by XCEDIS
!XCED = 0.70
!XCED = 0.84
-!
! Redelsperger-Sommeria (1981) = 0.70
! Schmidt-Schumann (1989) = 0.845
! Cheng-Canuto-Howard (2002) = 0.845
@@ -251,4 +257,5 @@ XSBL_O_BL = 0.05 ! SBL height / BL height ratio
XFTOP_O_FSURF = 0.05 ! Fraction of surface (heat or momentum) flux used to define top of BL
!
!
+IF (LHOOK) CALL DR_HOOK('INI_CTURB',1,ZHOOK_HANDLE)
END SUBROUTINE INI_CTURB
diff --git a/src/mesonh/turb/mf_turb_greyzone.f90 b/src/mesonh/turb/mf_turb_greyzone.f90
deleted file mode 100644
index ab28b6c61a22ce0a063e205612358f4fb6dda998..0000000000000000000000000000000000000000
--- a/src/mesonh/turb/mf_turb_greyzone.f90
+++ /dev/null
@@ -1,340 +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.
-! ######spl
- MODULE MODI_MF_TURB_GREYZONE
-! ######################
-!
-INTERFACE
-! #################################################################
- SUBROUTINE MF_TURB_GREYZONE(KKA,KKB,KKE,KKU,KKL,OMIXUV, &
- ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
- PIMPL, PTSTEP, &
- PDZZ, &
- PRHODJ, &
- PTHLM,PTHVM,PRTM,PUM,PVM,PSVM, &
- PTHLDT,PRTDT,PUDT,PVDT,PSVDT, &
- PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP,PSV_UP, &
- PTHL_DO,PTHV_DO,PRT_DO,PU_DO,PV_DO,PSV_DO, &
- PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, &
- PFLXZSVMF )
-
-! #################################################################
-!
-!
-!* 1.1 Declaration of Arguments
-!
-!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-
-LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
-LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
-INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
-INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
-REAL, INTENT(IN) :: PIMPL ! degree of implicitness
-REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! metric coefficients
-
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
-
-! Conservative var. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! conservative pot. temp.
-REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! water var. where
-! Virtual potential temperature at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM
-! Momentum at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PUM
-REAL, DIMENSION(:,:), INTENT(IN) :: PVM
-! scalar variables at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM
-!
-! Tendencies of conservative variables
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHLDT
-
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRTDT
-! Tendencies of momentum
-REAL, DIMENSION(:,:), INTENT(OUT) :: PUDT
-REAL, DIMENSION(:,:), INTENT(OUT) :: PVDT
-! Tendencies of scalar variables
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSVDT
-
-
-! Updraft characteritics
-REAL, DIMENSION(:,:), INTENT(IN) :: PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHL_DO,PTHV_DO,PRT_DO,PU_DO,PV_DO
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSV_UP, PSV_DO
-! Fluxes
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF
-
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PFLXZSVMF
-
-END SUBROUTINE MF_TURB_GREYZONE
-
-END INTERFACE
-!
-END MODULE MODI_MF_TURB_GREYZONE
-! #################################################################
- SUBROUTINE MF_TURB_GREYZONE(KKA, KKB, KKE, KKU, KKL,OMIXUV, &
- ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
- PIMPL, PTSTEP, &
- PDZZ, &
- PRHODJ, &
- PTHLM,PTHVM,PRTM,PUM,PVM,PSVM, &
- PTHLDT,PRTDT,PUDT,PVDT,PSVDT, &
- PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP,PSV_UP, &
- PTHL_DO,PTHV_DO,PRT_DO,PU_DO,PV_DO,PSV_DO, &
- PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, &
- PFLXZSVMF )
-
-! #################################################################
-!
-!
-!!**** *MF_TURB_GREYZONE* - computes the MF_turbulent source terms for the prognostic
-!! variables.
-!!
-!! PURPOSE
-!! -------
-!!**** The purpose of this routine is to compute the source terms in
-!! the evolution equations due to the MF turbulent mixing.
-!! The source term is computed as the divergence of the turbulent fluxes.
-!
-!!** METHOD
-!! ------
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!!
-!! MODIFICATIONS
-!! -------------
-!! 10/2009 (C.Lac) Introduction of different PTSTEP according to the
-!! advection schemes
-!! 09/2010 (V.Masson) Optimization
-!! S. Riette Jan 2012: support for both order of vertical levels
-!! suppression of useless initialisations
-!!
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAM_MFSHALL_n
-!
-USE MODI_SHUMAN_MF
-USE MODI_TRIDIAG_MASSFLUX
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
-LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
-INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
-INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
-REAL, INTENT(IN) :: PIMPL ! degree of implicitness
-REAL, INTENT(IN) :: PTSTEP ! Dynamical timestep
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! metric coefficients
-
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
-
-! Conservative var. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM ! conservative pot. temp.
-REAL, DIMENSION(:,:), INTENT(IN) :: PRTM ! water var. where
-! Virtual potential temperature at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHVM
-! Momentum at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PUM
-REAL, DIMENSION(:,:), INTENT(IN) :: PVM
-! scalar variables at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM
-!
-! Tendencies of conservative variables
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHLDT
-
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRTDT
-! Tendencies of momentum
-REAL, DIMENSION(:,:), INTENT(OUT) :: PUDT
-REAL, DIMENSION(:,:), INTENT(OUT) :: PVDT
-! Tendencies of scalar variables
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSVDT
-
-
-! Updraft/environment characteritics
-REAL, DIMENSION(:,:), INTENT(IN) :: PEMF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHL_DO,PTHV_DO,PRT_DO,PU_DO,PV_DO
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSV_UP,PSV_DO
-! Fluxes
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF
-
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PFLXZSVMF
-!
-!
-!
-!-------------------------------------------------------------------------------
-!
-! 0.2 declaration of local variables
-!
-
-REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2)) :: ZVARS
-
-!
-INTEGER :: ISV,JSV !number of scalar variables and Loop counter
-!
-!----------------------------------------------------------------------------
-!
-!* 1.PRELIMINARIES
-! -------------
-!
-!
-! number of scalar var
-ISV=SIZE(PSVM,3)
-
-!
-PFLXZSVMF = 0.
-PSVDT = 0.
-
-!
-!----------------------------------------------------------------------------
-!
-!* 2. COMPUTE THE MEAN FLUX OF CONSERVATIVE VARIABLES at time t-dt
-! (equation (3) of Soares et al)
-! + THE MEAN FLUX OF THETA_V (buoyancy flux)
-! -----------------------------------------------
-! ( Resulting fluxes are in flux level (w-point) as PEMF and PTHL_UP )
-!
-! downdraft data are on the flux points
-PFLXZTHMF(:,:) = PEMF(:,:)*(PTHL_UP(:,:)-PTHL_DO(:,:))
-
-PFLXZRMF(:,:) = PEMF(:,:)*(PRT_UP(:,:)-PRT_DO(:,:))
-
-PFLXZTHVMF(:,:) = PEMF(:,:)*(PTHV_UP(:,:)-PTHV_DO(:,:))
-
-IF (OMIXUV) THEN
- PFLXZUMF(:,:) = PEMF(:,:)*(PU_UP(:,:)-PU_DO(:,:))
- PFLXZVMF(:,:) = PEMF(:,:)*(PV_UP(:,:)-PV_DO(:,:))
-ELSE
- PFLXZUMF(:,:) = 0.
- PFLXZVMF(:,:) = 0.
-ENDIF
-!
-!
-!----------------------------------------------------------------------------
-!
-!* 3. COMPUTE TENDENCIES OF CONSERVATIVE VARIABLES (or treated as such...)
-! (implicit formulation)
-! --------------------------------------------
-!
-
-!
-!
-! 3.1 Compute the tendency for the conservative potential temperature
-! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point)
-!
-CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PTHLM,PFLXZTHMF,-PEMF,PTSTEP,PIMPL, &
- PDZZ,PRHODJ,ZVARS )
-! compute new flux
-!!!!!!!!!!!!!!!!!!!!!!!!!!
-! Pourquoi on le recalcule ici alors qu'il n'est pas utilisé ailleurs
-! sauf pour l'écriture ?
-! Est ce que ZVARS est au point de masse pour qu'il doivent être remis au point
-! de flux ?
-!!!!!!!!!!!!!!!!!!!!!!!!!!
-PFLXZTHMF(:,:) = PEMF(:,:)*(PTHL_UP(:,:)-MZM_MF(KKA,KKU,KKL,ZVARS(:,:)))
-
-!!! compute THL tendency
-!
-PTHLDT(:,:)= (ZVARS(:,:)-PTHLM(:,:))/PTSTEP
-
-!
-! 3.2 Compute the tendency for the conservative mixing ratio
-!
-CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PRTM(:,:),PFLXZRMF,-PEMF,PTSTEP,PIMPL, &
- PDZZ,PRHODJ,ZVARS )
-! compute new flux
-PFLXZRMF(:,:) = PEMF(:,:)*(PRT_UP(:,:)-MZM_MF(KKA,KKU,KKL,ZVARS(:,:)))
-
-!!! compute RT tendency
-PRTDT(:,:) = (ZVARS(:,:)-PRTM(:,:))/PTSTEP
-!
-
-IF (OMIXUV) THEN
- !
- ! 3.3 Compute the tendency for the (non conservative but treated as it) zonal momentum
- ! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point)
- !
-
- CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PUM,PFLXZUMF,-PEMF,PTSTEP,PIMPL, &
- PDZZ,PRHODJ,ZVARS )
- ! compute new flux
- PFLXZUMF(:,:) = PEMF(:,:)*(PU_UP(:,:)-MZM_MF(KKA,KKU,KKL,ZVARS(:,:)))
-
- ! compute U tendency
- PUDT(:,:)= (ZVARS(:,:)-PUM(:,:))/PTSTEP
-
- !
- !
- ! 3.4 Compute the tendency for the (non conservative but treated as it for the time beiing)
- ! meridian momentum
- ! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point)
- !
- CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PVM,PFLXZVMF,-PEMF,PTSTEP,PIMPL, &
- PDZZ,PRHODJ,ZVARS )
- ! compute new flux
- PFLXZVMF(:,:) = PEMF(:,:)*(PV_UP(:,:)-MZM_MF(KKA,KKU,KKL,ZVARS(:,:)))
-
- ! compute V tendency
- PVDT(:,:)= (ZVARS(:,:)-PVM(:,:))/PTSTEP
-ELSE
- PUDT(:,:)=0.
- PVDT(:,:)=0.
-ENDIF
-
-DO JSV=1,ISV
-
- IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
-
- !* compute mean flux of scalar variables at time t-dt
- ! ( Resulting fluxes are in flux level (w-point) as PEMF and PTHL_UP )
-
- PFLXZSVMF(:,:,JSV) = PEMF(:,:)*(PSV_UP(:,:,JSV)-MZM_MF(KKA,KKU,KKL,PSVM(:,:,JSV)))
-
- !
- ! 3.5 Compute the tendency for scalar variables
- ! (PDZZ and flux in w-point and PRHODJ is mass point, result in mass point)
- !
- CALL TRIDIAG_MASSFLUX(KKA,KKB,KKE,KKU,KKL,PSVM(:,:,JSV),PFLXZSVMF(:,:,JSV),&
- -PEMF,PTSTEP,PIMPL,PDZZ,PRHODJ,ZVARS )
- ! compute new flux
- PFLXZSVMF(:,:,JSV) = PEMF(:,:)*(PSV_UP(:,:,JSV)-MZM_MF(KKA,KKU,KKL,ZVARS))
-
- ! compute Sv tendency
- PSVDT(:,:,JSV)= (ZVARS(:,:)-PSVM(:,:,JSV))/PTSTEP
-
-ENDDO
-!
-END SUBROUTINE MF_TURB_GREYZONE
diff --git a/src/mesonh/turb/modd_cturb.f90 b/src/mesonh/turb/modd_cturb.f90
deleted file mode 100644
index db23e955b7e52ad14c9d4d5d555fb24895d8fbd9..0000000000000000000000000000000000000000
--- a/src/mesonh/turb/modd_cturb.f90
+++ /dev/null
@@ -1,91 +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 modd 2006/05/23 10:10:13
-!-----------------------------------------------------------------
-! #######################
- MODULE MODD_CTURB
-! #######################
-!
-!!**** *MODD_CTURB* - declaration of the turbulent scheme constants
-!!
-!! PURPOSE
-!! -------
-! The purpose of this declarative module is to declare the
-! turbulence scheme constants.
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! NONE
-!!
-!! REFERENCE
-!! ---------
-!! Book 2 of Meso-NH documentation (MODD_CTURB)
-!! Book 1 of Meso-NH documentation (Chapter Turbulence)
-!!
-!! AUTHOR
-!! ------
-!1 Joan Cuxart * INM and Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 08/08/94
-!! Nov 06, 2002 (V. Masson) add XALPSBL and XASBL
-!! May 06 Remove EPS
-!! Jan 2019 (Q. Rodier) Remove XASBL
-!----------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-REAL,SAVE :: XCMFS ! constant for the momentum flux due to shear
-REAL,SAVE :: XCMFB ! constant for the momentum flux due to buoyancy
-REAL,SAVE :: XCSHF ! constant for the sensible heat flux
-REAL,SAVE :: XCHF ! constant for the humidity flux
-REAL,SAVE :: XCTV ! constant for the temperature variance
-REAL,SAVE :: XCHV ! constant for the humidity variance
-REAL,SAVE :: XCHT1 ! first ct. for the humidity-temperature correlation
-REAL,SAVE :: XCHT2 ! second ct. for the humidity-temperature correlation
-!
-REAL,SAVE :: XCPR1 ! first ct. for the turbulent Prandtl numbers
-REAL,SAVE :: XCPR2 ! second ct. for the turbulent Prandtl numbers
-REAL,SAVE :: XCPR3 ! third ct. for the turbulent Prandtl numbers
-REAL,SAVE :: XCPR4 ! fourth ct. for the turbulent Prandtl numbers
-REAL,SAVE :: XCPR5 ! fifth ct. for the turbulent Prandtl numbers
-!
-REAL,SAVE :: XCET ! constant into the transport term of the TKE eq.
-REAL,SAVE :: XCED ! constant into the dissipation term of the TKE eq.
-!
-REAL,SAVE :: XCDP ! ct. for the production term in the dissipation eq.
-REAL,SAVE :: XCDD ! ct. for the destruction term in the dissipation eq.
-REAL,SAVE :: XCDT ! ct. for the transport term in the dissipation eq.
-!
-REAL,SAVE :: XTKEMIN ! mimimum value for the TKE
-REAL,SAVE :: XRM17 ! Rodier et al 2017 constant in shear term for mixing length
-!
-REAL,SAVE :: XLINI ! initial value for BL mixing length
-REAL,SAVE :: XLINF ! to prevent division by zero in the BL algorithm
-!
-REAL,SAVE :: XALPSBL ! constant linking TKE and friction velocity in the SBL
-!
-REAL,SAVE :: XCEP ! Constant for wind pressure-correlations
-REAL,SAVE :: XA0 ! Constant a0 for wind pressure-correlations
-REAL,SAVE :: XA2 ! Constant a2 for wind pressure-correlations
-REAL,SAVE :: XA3 ! Constant a3 for wind pressure-correlations
-REAL,SAVE :: XA5 ! Constant a5 for temperature pressure-correlations
-REAL,SAVE :: XCTD ! Constant for temperature and vapor dissipation
-REAL,SAVE :: XCTP ! Constant for temperature and vapor pressure-correlations
-!
-REAL,SAVE :: XPHI_LIM ! Threshold value for Phi3 and Psi3
-REAL,SAVE :: XSBL_O_BL ! SBL height / BL height ratio
-REAL,SAVE :: XFTOP_O_FSURF! Fraction of surface (heat or momentum) flux used to define top of BL
-!
-END MODULE MODD_CTURB
diff --git a/src/mesonh/turb/modd_diag_in_run.f90 b/src/mesonh/turb/modd_diag_in_run.f90
index b7bba80d0c045a7787cf64d952de4b44c6a2961f..6f9829570ec8a9f75685491317b5adc86b18e623 100644
--- a/src/mesonh/turb/modd_diag_in_run.f90
+++ b/src/mesonh/turb/modd_diag_in_run.f90
@@ -3,11 +3,6 @@
!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 modd 2006/10/24 10:07:40
-!-----------------------------------------------------------------
MODULE MODD_DIAG_IN_RUN
! Modifications
!! 02/2018 Q.Libois ECRAD
diff --git a/src/mesonh/turb/modd_turb_cloud.f90 b/src/mesonh/turb/modd_turb_cloud.f90
deleted file mode 100644
index 28b1f106f5854d3c081ff80594fb63ce6ff5b024..0000000000000000000000000000000000000000
--- a/src/mesonh/turb/modd_turb_cloud.f90
+++ /dev/null
@@ -1,58 +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 modd 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-! ##################
- MODULE MODD_TURB_CLOUD
-! ##################
-!
-!!**** *MODD_TURB_CLOUD* - declaration of parameters for cloud mixing length
-!!
-!! PURPOSE
-!! -------
-! The purpose of this declarative module is to declare the
-! variables that may be set by namelist for the cloud mixing length
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! M. Tomasini *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original September, 2004
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-INTEGER,SAVE :: NMODEL_CLOUD ! model number where the modification ! of the mixing length in the clouds is computed
-CHARACTER (LEN=4),SAVE :: CTURBLEN_CLOUD ! type of length in the clouds
- ! 'DEAR' Deardorff mixing length
- ! 'BL89' Bougeault and Lacarrere scheme
- ! 'DELT' length = ( volum) ** 1/3
-REAL,SAVE :: XCOEF_AMPL_SAT ! saturation of the amplification coefficient
-REAL,SAVE :: XCEI_MIN ! minimum threshold for the instability index CEI
- !(beginning of the amplification)
-REAL,SAVE :: XCEI_MAX ! maximum threshold for the instability index CEI
- !(beginning of the saturation of the amplification)
-REAL,SAVE,DIMENSION(:,:,:), ALLOCATABLE :: XCEI ! Cloud Entrainment instability
- ! index to emphasize localy
- ! turbulent fluxes
-!
-END MODULE MODD_TURB_CLOUD
diff --git a/src/mesonh/turb/modd_turb_flux_aircraft_balloon.f90 b/src/mesonh/turb/modd_turb_flux_aircraft_balloon.f90
deleted file mode 100644
index cd3e40b6268045b53d226868e496c3383b048df9..0000000000000000000000000000000000000000
--- a/src/mesonh/turb/modd_turb_flux_aircraft_balloon.f90
+++ /dev/null
@@ -1,54 +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$
-!-----------------------------------------------------------------
-!-----------------------------------------------------------------
-!-----------------------------------------------------------------
-! ######################################
- MODULE MODD_TURB_FLUX_AIRCRAFT_BALLOON
-! ######################################
-!
-!!**** *MODD_CVERT* - Declares work arrays for vertical cross-sections
-!!
-!! PURPOSE
-!! -------
-! For vertical cross-sections only, this declarative module declares
-! the arrays containing the sea-level altitudes and the model topography
-! of the oblique cross-section points.
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book2 of the TRACE volume of the Meso-NH user manual
-!! (MODD_CVERT)
-!!
-!! AUTHOR
-!! ------
-!! P.Lacarrere
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 18/09/06
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-IMPLICIT NONE
-!
-REAL,DIMENSION(:,:,:) ,ALLOCATABLE,SAVE :: XTHW_FLUX !sensible flux
-REAL,DIMENSION(:,:,:) ,ALLOCATABLE,SAVE :: XRCW_FLUX !Latent flux
-REAL,DIMENSION(:,:,:,:),ALLOCATABLE,SAVE :: XSVW_FLUX !turb scalar flux
-!
-END MODULE MODD_TURB_FLUX_AIRCRAFT_BALLOON
diff --git a/src/mesonh/turb/mode_compute_updraft_rhcj10.f90 b/src/mesonh/turb/mode_compute_updraft_rhcj10.f90
deleted file mode 100644
index abcbdc1c09192e02db5e837a06c68f79fbb2e77a..0000000000000000000000000000000000000000
--- a/src/mesonh/turb/mode_compute_updraft_rhcj10.f90
+++ /dev/null
@@ -1,590 +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 MODE_COMPUTE_UPDRAFT_RHCJ10
-! ###########################
-!
-IMPLICIT NONE
-CONTAINS
-!
-SUBROUTINE COMPUTE_UPDRAFT_RHCJ10(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, &
- OENTR_DETR,OMIXUV, &
- ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
- PZZ,PDZZ, &
- PSFTH,PSFRV, &
- PPABSM,PRHODREF,PUM,PVM, PTKEM, &
- PTHM,PRVM,PTHLM,PRTM, &
- PSVM,PTHL_UP,PRT_UP, &
- PRV_UP,PRC_UP,PRI_UP,PTHV_UP, &
- PW_UP,PU_UP, PV_UP, PSV_UP, &
- PFRAC_UP,PFRAC_ICE_UP,PRSAT_UP, &
- PEMF,PDETR,PENTR, &
- PBUO_INTEG,KKLCL,KKETL,KKCTL, &
- PDEPTH )
-! #################################################################
-!!
-!!**** *COMPUTE_UPDRAFT_RHCJ10* - calculates caracteristics of the updraft
-!!
-!!
-!! PURPOSE
-!! -------
-!!**** The purpose of this routine is to build the updraft following Rio et al (2010)
-!!
-!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! !! REFERENCE
-!! ---------
-!! Rio et al (2010) (Boundary Layer Meteorol 135:469-483)
-!!
-!! AUTHOR
-!! ------
-!! Y. Bouteloup (2012)
-!! R. Honert Janv 2013 ==> corection of some bugs
-!! R. El Khatib 15-Oct-2014 Optimization
-!! Q.Rodier 01/2019 : support RM17 mixing length
-!! --------------------------------------------------------------------------
-
-! WARNING ==> This updraft is not yet ready to use scalar variables
-
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-USE MODD_PARAM_MFSHALL_n
-USE MODD_TURB_n, ONLY : CTURBLEN
-USE MODI_TH_R_FROM_THL_RT_1D
-USE MODI_SHUMAN_MF, ONLY: MZF_MF, MZM_MF, GZ_M_W_MF
-
-USE MODE_COMPUTE_BL89_ML, ONLY: COMPUTE_BL89_ML
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-
-
-IMPLICIT NONE
-
-!* 1.1 Declaration of Arguments
-!
-!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
-LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux
-LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
-LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
-INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
-INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
-REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient
-
-REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV
-! normal surface fluxes of theta,rv,(u,v) parallel to the orography
-
-REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the
- ! reference state
-REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind
-REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind
-REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! pot. temp. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt
-
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
-REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP ! updraft rv, rc
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRI_UP ! updraft ri
-REAL, DIMENSION(:,:), INTENT(INOUT):: PTHV_UP ! updraft THv
-REAL, DIMENSION(:,:), INTENT(INOUT):: PW_UP,PFRAC_UP ! updraft w, fraction
-REAL, DIMENSION(:,:), INTENT(INOUT):: PFRAC_ICE_UP ! liquid/solid fraction in updraft
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRSAT_UP ! Rsat
-
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var.
-
-REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux,
- ! detrainment,entrainment
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
-INTEGER, DIMENSION(:), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL
-REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud
-! 1.2 Declaration of local variables
-!
-! Mean environment variables at t-dt at flux point
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTHM_F,ZRVM_F ! Theta,rv of
- ! updraft environnement
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZRTM_F, ZTHLM_F, ZTKEM_F ! rt, thetal,TKE,pressure,
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZUM_F,ZVM_F,ZRHO_F ! density,momentum
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZPRES_F,ZTHVM_F ! interpolated at the flux point
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZG_O_THVREF ! g*ThetaV ref
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZW_UP2 ! w**2 of the updraft
-
-REAL, DIMENSION(SIZE(PSVM,1),SIZE(PTHM,2),SIZE(PSVM,3)) :: ZSVM_F ! scalar variables
-
-
-
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZTH_UP ! updraft THETA
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZBUO ! Buoyancy
-
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZCOEF ! diminution coefficient for too high clouds
-
-REAL :: ZWTHVSURF ! Surface w'thetav'
-
-REAL :: ZRVORD ! RV/RD
-
-
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZMIX1,ZMIX2
-
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZLUP ! Upward Mixing length from the ground
-
-INTEGER :: ISV ! Number of scalar variables
-INTEGER :: IKU,IIJU ! array size in k
-INTEGER :: JK,JI,JSV ! loop counters
-
-LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GTEST,GTESTLCL
- ! Test if the ascent continue, if LCL or ETL is reached
-LOGICAL :: GLMIX
- ! To choose upward or downward mixing length
-LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GWORK1
-LOGICAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: GWORK2
-
-INTEGER :: ITEST
-
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZRC_UP, ZRI_UP, ZRV_UP, ZRSATW, ZRSATI
-
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZZDZ
-
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZTEST,ZDZ,ZWUP_MEAN !
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZCOE,ZWCOE,ZBUCOE
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZDETR_BUO, ZDETR_RT
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZW_MAX ! w**2 max of the updraft
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZZTOP ! Top of the updraft
-
-REAL :: ZDEPTH_MAX1, ZDEPTH_MAX2 ! control auto-extinction process
-
-REAL :: ZTMAX,ZRMAX, ZEPS ! control value
-
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZSHEAR,ZDUDZ,ZDVDZ ! vertical wind shear
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAFT_RHCJ10',0,ZHOOK_HANDLE)
-
-! Thresholds for the perturbation of
-! theta_l and r_t at the first level of the updraft
-
-ZTMAX=2.0
-ZRMAX=1.E-3
-ZEPS=1.E-15
-!------------------------------------------------------------------------
-! INITIALISATION
-
-! Initialisation of the constants
-ZRVORD = (XRV / XRD)
-
-! depth are different in compute_updraft (3000. and 4000.) ==> impact is small
-ZDEPTH_MAX1=4500. ! clouds with depth infeRIOr to this value are keeped untouched
-ZDEPTH_MAX2=5000. ! clouds with depth superior to this value are suppressed
-
-
-! Local variables, internal domain
-! Internal Domain
-
-IKU=SIZE(PTHM,2)
-IIJU =SIZE(PTHM,1)
-!number of scalar variables
-ISV=SIZE(PSVM,3)
-
-! Initialisation of intersesting Level :LCL,ETL,CTL
-KKLCL(:)=KKE
-KKETL(:)=KKE
-KKCTL(:)=KKE
-
-!
-! Initialisation
-!* udraft governing variables
-PEMF(:,:)=0.
-PDETR(:,:)=0.
-PENTR(:,:)=0.
-
-! Initialisation
-!* updraft core variables
-PRC_UP(:,:)=0.
-
-PW_UP(:,:)=0.
-ZTH_UP(:,:)=0.
-PFRAC_UP(:,:)=0.
-PTHV_UP(:,:)=0.
-
-PBUO_INTEG=0.
-ZBUO =0.
-
-!no ice cloud coded yet
-PRI_UP(:,:)=0.
-PFRAC_ICE_UP(:,:)=0.
-PRSAT_UP(:,:)=PRVM(:,:) ! should be initialised correctly but is (normaly) not used
-
-! Initialisation of environment variables at t-dt
-
-! variables at flux level
-ZTHLM_F(:,:) = MZM_MF(PTHLM(:,:), KKA, KKU, KKL)
-ZRTM_F (:,:) = MZM_MF(PRTM(:,:), KKA, KKU, KKL)
-ZUM_F (:,:) = MZM_MF(PUM(:,:), KKA, KKU, KKL)
-ZVM_F (:,:) = MZM_MF(PVM(:,:), KKA, KKU, KKL)
-ZTKEM_F(:,:) = MZM_MF(PTKEM(:,:), KKA, KKU, KKL)
-
-! This updraft is not yet ready to use scalar variables
-!DO JSV=1,ISV
-! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
-! *** SR merge AROME/Méso-nh: following two lines come from the AROME version
-! ZSVM_F(:,KKB:IKU,JSV) = 0.5*(PSVM(:,KKB:IKU,JSV)+PSVM(:,1:IKU-1,JSV))
-! ZSVM_F(:,1,JSV) = ZSVM_F(:,KKB,JSV)
-! *** the following single line comes from the Meso-NH version
-! ZSVM_F(:,:,JSV) = MZM_MF(KKA,KKU,KKL,PSVM(:,:,JSV))
-!END DO
-
-! Initialisation of updraft characteristics
-PTHL_UP(:,:)=ZTHLM_F(:,:)
-PRT_UP(:,:)=ZRTM_F(:,:)
-PU_UP(:,:)=ZUM_F(:,:)
-PV_UP(:,:)=ZVM_F(:,:)
-PSV_UP(:,:,:)=0.
-! This updraft is not yet ready to use scalar variables
-!IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) then
-! PSV_UP(:,:,:)=ZSVM_F(:,:,:)
-!ENDIF
-
-! Computation or initialisation of updraft characteristics at the KKB level
-! thetal_up,rt_up,thetaV_up, w,Buoyancy term and mass flux (PEMF)
-
-DO JI=1,IIJU
- !PTHL_UP(JI,KKB)= ZTHLM_F(JI,KKB)+MAX(0.,MIN(ZTMAX,(PSFTH(JI)/SQRT(ZTKEM_F(JI,KKB)))*XALP_PERT))
- !PRT_UP(JI,KKB) = ZRTM_F(JI,KKB)+MAX(0.,MIN(ZRMAX,(PSFRV(JI)/SQRT(ZTKEM_F(JI,KKB)))*XALP_PERT))
- PTHL_UP(JI,KKB)= ZTHLM_F(JI,KKB)
- PRT_UP(JI,KKB) = ZRTM_F(JI,KKB)
-ENDDO
-
-ZTHM_F (:,:) = MZM_MF(PTHM (:,:), KKA, KKU, KKL)
-ZPRES_F(:,:) = MZM_MF(PPABSM(:,:), KKA, KKU, KKL)
-ZRHO_F (:,:) = MZM_MF(PRHODREF(:,:), KKA, KKU, KKL)
-ZRVM_F (:,:) = MZM_MF(PRVM(:,:), KKA, KKU, KKL)
-
-! thetav at mass and flux levels
-DO JK=1,IKU
- DO JI=1,IIJU
- ZTHVM_F(JI,JK)=ZTHM_F(JI,JK)*((1.+ZRVORD*ZRVM_F(JI,JK))/(1.+ZRTM_F(JI,JK)))
- ENDDO
-ENDDO
-
-PTHV_UP(:,:)= ZTHVM_F(:,:)
-PRV_UP (:,:)= ZRVM_F (:,:)
-
-ZW_UP2(:,:)=ZEPS
-ZW_UP2(:,KKB) = MAX(0.0001,(2./3.)*ZTKEM_F(:,KKB))
-
-! Computation of non conservative variable for the KKB level of the updraft
-! (all or nothing ajustement)
-
-PRC_UP(:,KKB)=0.
-PRI_UP(:,KKB)=0.
-CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,KKB),ZPRES_F(:,KKB), &
- PTHL_UP(:,KKB),PRT_UP(:,KKB),ZTH_UP(:,KKB), &
- PRV_UP(:,KKB),PRC_UP(:,KKB),PRI_UP(:,KKB),ZRSATW(:),ZRSATI(:))
-
-DO JI=1,IIJU
- ! compute updraft thevav and buoyancy term at KKB level
- PTHV_UP(JI,KKB) = ZTH_UP(JI,KKB)*((1+ZRVORD*PRV_UP(JI,KKB))/(1+PRT_UP(JI,KKB)))
- ! compute mean rsat in updraft
- PRSAT_UP(JI,KKB) = ZRSATW(JI)*(1-PFRAC_ICE_UP(JI,KKB)) + ZRSATI(JI)*PFRAC_ICE_UP(JI,KKB)
-ENDDO
-
-!Tout est commente pour tester dans un premier temps la separation en deux de la
-! boucle verticale, une pour w et une pour PEMF
-
-ZG_O_THVREF=XG/ZTHVM_F
-
-! Calcul de la fermeture de Julien Pergaut comme limite max de PHY
-
-DO JK=KKB,KKE-KKL,KKL ! Vertical loop
- DO JI=1,IIJU
- ZZDZ(JI,JK) = MAX(ZEPS,PZZ(JI,JK+KKL)-PZZ(JI,JK)) ! <== Delta Z between two flux level
- ENDDO
-ENDDO
-
-! compute L_up
-GLMIX=.TRUE.
-ZTKEM_F(:,KKB)=0.
-!
-IF(CTURBLEN=='RM17') THEN
- ZDUDZ = MZF_MF(GZ_M_W_MF(PUM,PDZZ, KKA, KKU, KKL), KKA, KKU, KKL)
- ZDVDZ = MZF_MF(GZ_M_W_MF(PVM,PDZZ, KKA, KKU, KKL), KKA, KKU, KKL)
- ZSHEAR = SQRT(ZDUDZ*ZDUDZ + ZDVDZ*ZDVDZ)
-ELSE
- ZSHEAR = 0. !no shear in bl89 mixing length
-END IF
-!
-CALL COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ,ZTKEM_F(:,KKB),ZG_O_THVREF(:,KKB), &
- ZTHVM_F,KKB,GLMIX,.TRUE.,ZSHEAR,ZLUP)
-ZLUP(:)=MAX(ZLUP(:),1.E-10)
-
-DO JI=1,IIJU
- ! Compute Buoyancy flux at the ground
- ZWTHVSURF = (ZTHVM_F(JI,KKB)/ZTHM_F(JI,KKB))*PSFTH(JI)+ &
- (0.61*ZTHM_F(JI,KKB))*PSFRV(JI)
-
- ! Mass flux at KKB level (updraft triggered if PSFTH>0.)
- IF (ZWTHVSURF>0.010) THEN ! <== Not 0 Important to have stratocumulus !!!!!
- PEMF(JI,KKB) = XCMF * ZRHO_F(JI,KKB) * ((ZG_O_THVREF(JI,KKB))*ZWTHVSURF*ZLUP(JI))**(1./3.)
- PFRAC_UP(JI,KKB)=MIN(PEMF(JI,KKB)/(SQRT(ZW_UP2(JI,KKB))*ZRHO_F(JI,KKB)),XFRAC_UP_MAX)
-
- ZW_UP2(JI,KKB)=(PEMF(JI,KKB)/(PFRAC_UP(JI,KKB)*ZRHO_F(JI,KKB)))**2
- GTEST(JI)=.TRUE.
- ELSE
- PEMF(JI,KKB) =0.
- GTEST(JI)=.FALSE.
- ENDIF
-ENDDO
-
-
-!--------------------------------------------------------------------------
-
-! 3. Vertical ascending loop
-! -----------------------
-!
-! If GTEST = T the updraft starts from the KKB level and stops when GTEST becomes F
-!
-!
-GTESTLCL(:)=.FALSE.
-
-
-! Loop on vertical level to compute W
-
-ZW_MAX(:) = 0.
-ZZTOP(:) = 0.
-
-DO JK=KKB,KKE-KKL,KKL
-
-! IF the updraft top is reached for all column, stop the loop on levels
-
- !ITEST=COUNT(GTEST)
- !IF (ITEST==0) CYCLE ! <== I do not remember why I removed this ...
-
-! Computation of entrainment and detrainment with KF90
-! parameterization in clouds and LR01 in subcloud layer
-
-
-! to find the LCL (check if JK is LCL or not)
-
- DO JI=1,IIJU
- IF ((PRC_UP(JI,JK)+PRI_UP(JI,JK)>0.).AND.(.NOT.(GTESTLCL(JI)))) THEN
- KKLCL(JI) = JK
- GTESTLCL(JI)=.TRUE.
- ENDIF
- ENDDO
-
-
-! COMPUTE PENTR and PDETR at mass level JK
-
-
-! Buoyancy is computed on "flux" levels where updraft variables are known
-
- ! Compute theta_v of updraft at flux level JK
-
- ZRC_UP(:) =PRC_UP(:,JK) ! guess
- ZRI_UP(:) =PRI_UP(:,JK) ! guess
- ZRV_UP(:) =PRV_UP(:,JK)
- CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,JK),&
- PPABSM(:,JK),PTHL_UP(:,JK),PRT_UP(:,JK),&
- ZTH_UP(:,JK),ZRV_UP,ZRC_UP,ZRI_UP,ZRSATW(:),ZRSATI(:))
-
- DO JI=1,IIJU
- IF (GTEST(JI)) THEN
- PTHV_UP (JI,JK) = ZTH_UP(JI,JK)*(1.+ZRVORD*ZRV_UP(JI))/(1.+PRT_UP(JI,JK))
- ZBUO (JI,JK) = ZG_O_THVREF(JI,JK)*(PTHV_UP(JI,JK) - ZTHVM_F(JI,JK))
- PBUO_INTEG(JI,JK) = ZBUO(JI,JK)*(PZZ(JI,JK+KKL)-PZZ(JI,JK))
-
- ZDZ(JI) = MAX(ZEPS,PZZ(JI,JK+KKL)-PZZ(JI,JK))
- ZTEST(JI) = XA1*ZBUO(JI,JK) - XB*ZW_UP2(JI,JK)
-
- ! Ancien calcul de la vitesse
- ZCOE(JI) = ZDZ(JI)
- IF (ZTEST(JI)>0.) THEN
- ZCOE(JI) = ZDZ(JI)/(1.+ XBETA1)
- ENDIF
-
- ! Convective Vertical speed computation
- ZWCOE(JI) = (1.-XB*ZCOE(JI))/(1.+XB*ZCOE(JI))
- ZBUCOE(JI) = 2.*ZCOE(JI)/(1.+XB*ZCOE(JI))
-
- ! Second Rachel bug correction (XA1 has been forgotten ... not yet tested ...)
- !ZW_UP2(JI,JK+KKL) = MAX(ZEPS,ZW_UP2(JI,JK)*ZWCOE(JI) + ZBUO(JI,JK)*ZBUCOE(JI) )
- ZW_UP2(JI,JK+KKL) = MAX(ZEPS,ZW_UP2(JI,JK)*ZWCOE(JI) + XA1*ZBUO(JI,JK)*ZBUCOE(JI) )
- ZW_MAX(JI) = MAX(ZW_MAX(JI), SQRT(ZW_UP2(JI,JK+KKL)))
- ZWUP_MEAN(JI) = MAX(ZEPS,0.5*(ZW_UP2(JI,JK+KKL)+ZW_UP2(JI,JK)))
-
- ! Entrainement and detrainement
-
- ! First Rachel bug correction (Parenthesis around 1+beta1 ==> impact is small)
- PENTR(JI,JK) = MAX(0.,(XBETA1/(1.+XBETA1))*(XA1*ZBUO(JI,JK)/ZWUP_MEAN(JI)-XB))
- ZDETR_BUO(JI) = MAX(0., -(XBETA1/(1.+XBETA1))*XA1*ZBUO(JI,JK)/ZWUP_MEAN(JI))
- ZDETR_RT(JI) = XC*SQRT(MAX(0.,(PRT_UP(JI,JK) - ZRTM_F(JI,JK))) / MAX(ZEPS,ZRTM_F(JI,JK)) / ZWUP_MEAN(JI))
- PDETR(JI,JK) = ZDETR_RT(JI)+ZDETR_BUO(JI)
-
- ! If the updraft did not stop, compute cons updraft characteritics at jk+1
- ZZTOP(JI) = MAX(ZZTOP(JI),PZZ(JI,JK+KKL))
- ZMIX2(JI) = (PZZ(JI,JK+KKL)-PZZ(JI,JK))*PENTR(JI,JK) !&
-
- PTHL_UP(JI,JK+KKL)=(PTHL_UP(JI,JK)*(1.-0.5*ZMIX2(JI)) + PTHLM(JI,JK)*ZMIX2(JI)) &
- /(1.+0.5*ZMIX2(JI))
- PRT_UP(JI,JK+KKL) =(PRT_UP (JI,JK)*(1.-0.5*ZMIX2(JI)) + PRTM(JI,JK)*ZMIX2(JI)) &
- /(1.+0.5*ZMIX2(JI))
- ENDIF ! GTEST
- ENDDO
-
-
- IF(OMIXUV) THEN
- IF(JK/=KKB) THEN
- DO JI=1,IIJU
- IF(GTEST(JI)) THEN
- PU_UP(JI,JK+KKL) = (PU_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PUM(JI,JK)*ZMIX2(JI)+ &
- 0.5*XPRES_UV*(PZZ(JI,JK+KKL)-PZZ(JI,JK))*&
- ((PUM(JI,JK+KKL)-PUM(JI,JK))/PDZZ(JI,JK+KKL)+&
- (PUM(JI,JK)-PUM(JI,JK-KKL))/PDZZ(JI,JK)) ) &
- /(1+0.5*ZMIX2(JI))
- PV_UP(JI,JK+KKL) = (PV_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PVM(JI,JK)*ZMIX2(JI)+ &
- 0.5*XPRES_UV*(PZZ(JI,JK+KKL)-PZZ(JI,JK))*&
- ((PVM(JI,JK+KKL)-PVM(JI,JK))/PDZZ(JI,JK+KKL)+&
- (PVM(JI,JK)-PVM(JI,JK-KKL))/PDZZ(JI,JK)) ) &
- /(1+0.5*ZMIX2(JI))
- ENDIF
- ENDDO
- ELSE
- DO JI=1,IIJU
- IF(GTEST(JI)) THEN
- PU_UP(JI,JK+KKL) = (PU_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PUM(JI,JK)*ZMIX2(JI)+ &
- 0.5*XPRES_UV*(PZZ(JI,JK+KKL)-PZZ(JI,JK))*&
- ((PUM(JI,JK+KKL)-PUM(JI,JK))/PDZZ(JI,JK+KKL)) ) &
- /(1+0.5*ZMIX2(JI))
- PV_UP(JI,JK+KKL) = (PV_UP (JI,JK)*(1-0.5*ZMIX2(JI)) + PVM(JI,JK)*ZMIX2(JI)+ &
- 0.5*XPRES_UV*(PZZ(JI,JK+KKL)-PZZ(JI,JK))*&
- ((PVM(JI,JK+KKL)-PVM(JI,JK))/PDZZ(JI,JK+KKL)) ) &
- /(1+0.5*ZMIX2(JI))
- ENDIF
- ENDDO
- ENDIF
- ENDIF
-
-! This updraft is not yet ready to use scalar variables
-! DO JSV=1,ISV
-! IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
-! WHERE(GTEST)
-! PSV_UP(:,JK+KKL,JSV) = (PSV_UP (:,JK,JSV)*(1-0.5*ZMIX2(:)) + &
-! PSVM(:,JK,JSV)*ZMIX2(:)) /(1+0.5*ZMIX2(:))
-! ENDWHERE
-! ENDDO
-
-
-! Compute non cons. var. at level JK+KKL
- ZRC_UP(:)=PRC_UP(:,JK) ! guess = level just below
- ZRI_UP(:)=PRI_UP(:,JK) ! guess = level just below
- ZRV_UP(:)=PRV_UP(:,JK)
- CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,JK+KKL),ZPRES_F(:,JK+KKL), &
- PTHL_UP(:,JK+KKL),PRT_UP(:,JK+KKL),ZTH_UP(:,JK+KKL), &
- ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:))
-
- DO JI=1,IIJU
- IF(GTEST(JI)) THEN
- PRC_UP(JI,JK+KKL)=ZRC_UP(JI)
- PRV_UP(JI,JK+KKL)=ZRV_UP(JI)
- PRI_UP(JI,JK+KKL)=ZRI_UP(JI)
- PRSAT_UP(JI,JK+KKL) = ZRSATW(JI)*(1-PFRAC_ICE_UP(JI,JK+KKL)) + ZRSATI(JI)*PFRAC_ICE_UP(JI,JK+KKL)
-
- ! Compute the updraft theta_v, buoyancy and w**2 for level JK+1
- PTHV_UP(JI,JK+KKL) = ZTH_UP(JI,JK+KKL)*((1+ZRVORD*PRV_UP(JI,JK+KKL))/(1+PRT_UP(JI,JK+KKL)))
- ZMIX1(JI)=ZZDZ(JI,JK)*(PENTR(JI,JK)-PDETR(JI,JK))
- ENDIF
- ENDDO
-
- DO JI=1,IIJU
- IF(GTEST(JI)) THEN
- PEMF(JI,JK+KKL)=PEMF(JI,JK)*EXP(ZMIX1(JI))
- ENDIF
- ENDDO
-
- DO JI=1,IIJU
- IF(GTEST(JI)) THEN
- ! Updraft fraction must be smaller than XFRAC_UP_MAX
- PFRAC_UP(JI,JK+KKL)=MIN(XFRAC_UP_MAX, &
- &PEMF(JI,JK+KKL)/(SQRT(ZW_UP2(JI,JK+KKL))*ZRHO_F(JI,JK+KKL)))
- ENDIF
- ENDDO
-
-! Test if the updraft has reach the ETL
- DO JI=1,IIJU
- IF (GTEST(JI) .AND. (PBUO_INTEG(JI,JK)<=0.)) THEN
- KKETL(JI) = JK+KKL
- ENDIF
- ENDDO
-
-
-! Test is we have reached the top of the updraft
- DO JI=1,IIJU
- IF (GTEST(JI) .AND. ((ZW_UP2(JI,JK+KKL)<=ZEPS).OR.(PEMF(JI,JK+KKL)<=ZEPS))) THEN
- ZW_UP2 (JI,JK+KKL)=ZEPS
- PEMF (JI,JK+KKL)=0.
- GTEST (JI) =.FALSE.
- PTHL_UP (JI,JK+KKL)=ZTHLM_F(JI,JK+KKL)
- PRT_UP (JI,JK+KKL)=ZRTM_F(JI,JK+KKL)
- PRC_UP (JI,JK+KKL)=0.
- PRI_UP (JI,JK+KKL)=0.
- PRV_UP (JI,JK+KKL)=ZRVM_F (JI,JK+KKL)
- PTHV_UP (JI,JK+KKL)=ZTHVM_F(JI,JK+KKL)
- PFRAC_UP (JI,JK+KKL)=0.
- KKCTL (JI) =JK+KKL
- ENDIF
- ENDDO
-
-ENDDO ! Fin de la boucle verticale
-
-PW_UP(:,:)=SQRT(ZW_UP2(:,:))
-PEMF(:,KKB) =0.
-
-! Limits the shallow convection scheme when cloud heigth is higher than 3000m.
-! To do this, mass flux is multiplied by a coefficient decreasing linearly
-! from 1 (for clouds of 3000m of depth) to 0 (for clouds of 4000m of depth).
-! This way, all MF fluxes are diminished by this amount.
-! Diagnosed cloud fraction is also multiplied by the same coefficient.
-!
-DO JI=1,IIJU
- PDEPTH(JI) = MAX(0., PZZ(JI,KKCTL(JI)) - PZZ(JI,KKLCL(JI)) )
-ENDDO
-
-GWORK1(:)= (GTESTLCL(:) .AND. (PDEPTH(:) > ZDEPTH_MAX1) )
-GWORK2(:,:) = SPREAD( GWORK1(:), DIM=2, NCOPIES=IKU )
-ZCOEF(:,:) = SPREAD( (1.-(PDEPTH(:)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1)), DIM=2, NCOPIES=IKU)
-ZCOEF(:,:)=MIN(MAX(ZCOEF(:,:),0.),1.)
-DO JK=1, IKU
- DO JI=1,IIJU
- IF (GWORK2(JI,JK)) THEN
- PEMF(JI,JK) = PEMF(JI,JK) * ZCOEF(JI,JK)
- PFRAC_UP(JI,JK) = PFRAC_UP(JI,JK) * ZCOEF(JI,JK)
- ENDIF
- ENDDO
-ENDDO
-
-IF (LHOOK) CALL DR_HOOK('COMPUTE_UPDRAFT_RHCJ10',1,ZHOOK_HANDLE)
-
-END SUBROUTINE COMPUTE_UPDRAFT_RHCJ10
-END MODULE MODE_COMPUTE_UPDRAFT_RHCJ10
diff --git a/src/mesonh/turb/mode_prandtl.f90 b/src/mesonh/turb/mode_prandtl.f90
index 04dfe6155e2efdacbcf981be63e260d8046e1187..be6a381d6f187c578aafff06a772118472da08ba 100644
--- a/src/mesonh/turb/mode_prandtl.f90
+++ b/src/mesonh/turb/mode_prandtl.f90
@@ -5,6 +5,8 @@
!-----------------------------------------------------------------
! ####################
MODULE MODE_PRANDTL
+ USE PARKIND1, ONLY : JPRB
+ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ####################
!
!* modification 08/2010 V. Masson smoothing of the discontinuity in functions
@@ -14,11 +16,544 @@
USE MODD_CTURB, ONLY : XCTV, XCSHF, XCTD, XPHI_LIM, XCPR3, XCPR4, XCPR5
USE MODD_PARAMETERS, ONLY : JPVEXT_TURB
!
-USE MODI_SHUMAN
+USE MODI_SHUMAN, ONLY: MZM, MZF
IMPLICIT NONE
!----------------------------------------------------------------------------
CONTAINS
!----------------------------------------------------------------------------
+ SUBROUTINE PRANDTL(KKA,KKU,KKL,KRR,KRRI,OTURB_DIAG, &
+ HTURBDIM,OOCEAN, &
+ TPFILE, &
+ PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PTHVREF,PLOCPEXNM,PATHETA,PAMOIST, &
+ PLM,PLEPS,PTKEM,PTHLM,PRM,PSVM,PSRCM, &
+ PREDTH1,PREDR1, &
+ PRED2TH3, PRED2R3, PRED2THR3, &
+ PREDS1,PRED2THS3, PRED2RS3, &
+ PBLL_O_E, &
+ PETHETA, PEMOIST )
+! ###########################################################
+!
+!
+!!**** *PRANDTL* - routine to compute the Prandtl turbulent numbers
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to compute the Redelsperger
+! numbers and then get the turbulent Prandtl and Schmidt numbers:
+! * for the heat fluxes - PHI3 = 1/ Prandtl
+! * for the moisture fluxes - PSI3 = 1/ Schmidt
+!
+!!** METHOD
+!! ------
+!! The following steps are performed:
+!!
+!! 1 - default values of 1 are taken for phi3 and psi3 and different masks
+!! are defined depending on the presence of turbulence, stratification and
+!! humidity. The 1D Redelsperger numbers are computed
+!! * ZREDTH1 : (g / THVREF ) (LT**2 / TKE ) ETHETA (D Theta / Dz)
+!! * ZREDR1 : (g / THVREF ) (LT**2 / TKE ) EMOIST (D TW / Dz)
+!! 2 - 3D Redelsperger numbers are computed only for turbulent
+!! grid points where ZREDTH1 or ZREDR1 are > 0.
+!! 3 - PHI3 is computed only for turbulent grid points where ZREDTH1 > 0
+!! (turbulent thermally stratified points)
+!! 4 - PSI3 is computed only for turbulent grid points where ZREDR1 > 0
+!! (turbulent moist points)
+!!
+!!
+!! EXTERNAL
+!! --------
+!! FUNCTIONs ETHETA and EMOIST :
+!! allows to compute the coefficients
+!! for the turbulent correlation between any variable
+!! and the virtual potential temperature, of its correlations
+!! with the conservative potential temperature and the humidity
+!! conservative variable:
+!! ------- ------- -------
+!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
+!!
+!! GX_M_M, GY_M_M, GZ_M_M : Cartesian gradient operators
+!! MZM : Shuman function (mean operator in the z direction)
+!! Module MODI_ETHETA : interface module for ETHETA
+!! Module MODI_EMOIST : interface module for EMOIST
+!! Module MODI_SHUMAN : interface module for Shuman operators
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST : contains physical constants
+!! XG : gravity constant
+!!
+!! Module MODD_CTURB: contains the set of constants for
+!! the turbulence scheme
+!! XCTV,XCPR2 : constants for the turbulent prandtl numbers
+!! XTKEMIN : minimum value allowed for the TKE
+!!
+!! Module MODD_PARAMETERS
+!! JPVEXT_TURB : number of vertical marginal points
+!!
+!! REFERENCE
+!! ---------
+!! Book 2 of documentation (routine PRANDTL)
+!! Book 1 of documentation (Chapter: Turbulence)
+!!
+!! AUTHOR
+!! ------
+!! Joan Cuxart * INM and Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 18/10/94
+!! Modifications: Feb 14, 1995 (J.Cuxart and J.Stein)
+!! Doctorization and Optimization
+!! Modifications: March 21, 1995 (J.M. Carriere)
+!! Introduction of cloud water
+!! Modifications: March 21, 1995 (J. Cuxart and J.Stein)
+!! Phi3 and Psi3 at w point + cleaning
+!! Modifications: July 2, 1995 (J.Cuxart and Ph.Bougeault)
+!! change the value of Phi3 and Psi3 if negative
+!! Modifications: Sept 20, 1995 (J. Stein, J. Cuxart, J.L. Redelsperger)
+!! remove the Where + use REDTH1+REDR1 for the tests
+!! Modifications: October 10, 1995 (J. Cuxart and J.Stein)
+!! Psi3 for tPREDS1he scalar variables
+!! Modifications: February 27, 1996 (J.Stein) optimization
+!! Modifications: June 15, 1996 (P.Jabouille) return to the previous
+!! computation of Phi3 and Psi3
+!! Modifications: October 10, 1996 (J. Stein) change the temporal
+!! discretization
+!! Modifications: May 23, 1997 (J. Stein) bug in 3D Redels number at ground
+!! with orography
+!! Modifications: Feb 20, 1998 (J. Stein) bug in all the 3D cases due to
+!! the use of ZW1 instead of ZW2
+!! Feb 20, 2003 (JP Pinty) Add PFRAC_ICE
+!! July 2005 (Tomas, Masson) implicitation of PHI3 and PSI3
+!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
+!! change of YCOMMENT
+!! 2012-02 Y. Seity, add possibility to run with reversed
+!! vertical levels
+!! Modifications: July 2015 (Wim de Rooy) LHARAT (Racmo turbulence) switch
+!! 2017-09 J.Escobar, use epsilon XMNH_TINY_12 for R*4
+!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! JL Redelsperger 03/2021 : adding Ocean case for temperature only
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!
+USE MODD_CST
+USE MODD_CONF
+USE MODD_CTURB
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_PARAMETERS
+!
+USE MODI_GRADIENT_M
+USE MODE_EMOIST
+USE MODE_ETHETA
+USE MODI_SHUMAN, ONLY: MZM
+USE MODE_IO_FIELD_WRITE, ONLY: IO_FIELD_WRITE
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KKA !near ground array index
+INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
+INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
+
+INTEGER, INTENT(IN) :: KRR ! number of moist var.
+INTEGER, INTENT(IN) :: KRRI ! number of ice var.
+!
+LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
+ ! diagnostic fields in the syncronous FM-file
+LOGICAL, INTENT(IN) :: OOCEAN ! switch for Ocean model version
+CHARACTER(LEN=4), INTENT(IN) :: HTURBDIM ! Kind of turbulence param.
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
+ ! metric coefficients
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential Temp.
+ ! of the reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turbulent Mixing length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! Dissipative length
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM,PTKEM! Conservative Potential
+ ! Temperature and TKE at t-1
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios at t-1
+ ! with PRM(:,:,:,1) = cons.
+ ! mixing ratio
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Scalars at t-1
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM
+ ! s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PREDTH1 ! Redelsperger number R_theta
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PREDR1 ! Redelsperger number R_q
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2TH3 ! Redelsperger number R*2_theta
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2R3 ! Redelsperger number R*2_q
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2THR3! Redelsperger number R*2_thq
+REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PREDS1 ! Redelsperger number R_s
+REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PRED2THS3! Redelsperger number R*2_thsv
+REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PRED2RS3 ! Redelsperger number R*2_qsv
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBLL_O_E! beta*Lk*Leps/tke
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PETHETA ! coefficient E_theta
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEMOIST ! coefficient E_moist
+!
+!
+! 0.2 declaration of local variables
+!
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
+ ZW1, ZW2, ZW3
+! working variables
+!
+INTEGER :: IKB ! vertical index value for the first inner mass point
+INTEGER :: IKE ! vertical index value for the last inner mass point
+INTEGER :: IRESP ! Return code of FM routines
+INTEGER :: ILENG ! Length of the data field in LFIFM file
+INTEGER :: IGRID ! C-grid indicator in LFIFM file
+INTEGER :: ILENCH ! Length of comment string in LFIFM file
+CHARACTER (LEN=100) :: YCOMMENT ! comment string in LFIFM file
+CHARACTER (LEN=16) :: YRECFM ! Name of the desired field in LFIFM file
+INTEGER:: ISV ! number of scalar variables
+INTEGER:: JSV ! loop index for the scalar variables
+
+INTEGER :: JLOOP
+REAL :: ZMINVAL
+TYPE(TFIELDDATA) :: TZFIELD
+! ---------------------------------------------------------------------------
+!
+!* 1. DEFAULT VALUES, 1D REDELSPERGER NUMBERS
+! ----------------------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('PRANDTL',0,ZHOOK_HANDLE)
+
+IF (LHARAT) THEN
+PREDTH1(:,:,:)=0.
+PREDR1(:,:,:)=0.
+PRED2TH3(:,:,:)=0.
+PRED2R3(:,:,:)=0.
+PRED2THR3(:,:,:)=0.
+PREDS1(:,:,:,:)=0.
+PRED2THS3(:,:,:,:)=0.
+PRED2RS3(:,:,:,:)=0.
+PBLL_O_E(:,:,:)=0.
+ENDIF
+!
+IKB = KKA+JPVEXT_TURB*KKL
+IKE = KKU-JPVEXT_TURB*KKL
+ILENG=SIZE(PTHLM,1)*SIZE(PTHLM,2)*SIZE(PTHLM,3)
+ISV =SIZE(PSVM,4)
+!
+PETHETA(:,:,:) = MZM(ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM,OOCEAN), KKA, KKU, KKL)
+PEMOIST(:,:,:) = MZM(EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM,OOCEAN), KKA, KKU, KKL)
+PETHETA(:,:,KKA) = 2.*PETHETA(:,:,IKB) - PETHETA(:,:,IKB+KKL)
+PEMOIST(:,:,KKA) = 2.*PEMOIST(:,:,IKB) - PEMOIST(:,:,IKB+KKL)
+!
+!---------------------------------------------------------------------------
+IF (.NOT. LHARAT) THEN
+!
+! 1.3 1D Redelsperger numbers
+!
+PBLL_O_E(:,:,:) = MZM(XG / PTHVREF(:,:,:) * PLM(:,:,:) * PLEPS(:,:,:) / PTKEM(:,:,:), KKA, KKU, KKL)
+IF (KRR /= 0) THEN ! moist case
+ PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * PETHETA(:,:,:) * &
+ & GZ_M_W(KKA, KKU, KKL,PTHLM,PDZZ)
+ PREDR1(:,:,:) = XCTV*PBLL_O_E(:,:,:) * PEMOIST(:,:,:) * &
+ & GZ_M_W(KKA, KKU, KKL,PRM(:,:,:,1),PDZZ)
+ELSE ! dry case
+ PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * GZ_M_W(KKA, KKU, KKL,PTHLM,PDZZ)
+ PREDR1(:,:,:) = 0.
+END IF
+!
+! 3. Limits on 1D Redelperger numbers
+! --------------------------------
+!
+ZMINVAL = (1.-1./XPHI_LIM)
+!
+ZW1 = 1.
+ZW2 = 1.
+!
+WHERE (PREDTH1+PREDR1<-ZMINVAL)
+ ZW1 = (-ZMINVAL) / (PREDTH1+PREDR1)
+END WHERE
+!
+WHERE (PREDTH1<-ZMINVAL)
+ ZW2 = (-ZMINVAL) / (PREDTH1)
+END WHERE
+ZW2 = MIN(ZW1,ZW2)
+!
+ZW1 = 1.
+WHERE (PREDR1<-ZMINVAL)
+ ZW1 = (-ZMINVAL) / (PREDR1)
+END WHERE
+ZW1 = MIN(ZW2,ZW1)
+!
+!
+! 3. Modification of Mixing length and dissipative length
+! ----------------------------------------------------
+!
+PBLL_O_E(:,:,:) = PBLL_O_E(:,:,:) * ZW1(:,:,:)
+PREDTH1 (:,:,:) = PREDTH1 (:,:,:) * ZW1(:,:,:)
+PREDR1 (:,:,:) = PREDR1 (:,:,:) * ZW1(:,:,:)
+!
+! 4. Threshold for very small (in absolute value) Redelperger numbers
+! ----------------------------------------------------------------
+!
+ZW2=SIGN(1.,PREDTH1(:,:,:))
+PREDTH1(:,:,:)= ZW2(:,:,:) * MAX(1.E-30, ZW2(:,:,:)*PREDTH1(:,:,:))
+!
+IF (KRR /= 0) THEN ! dry case
+ ZW2=SIGN(1.,PREDR1(:,:,:))
+ PREDR1(:,:,:)= ZW2(:,:,:) * MAX(1.E-30, ZW2(:,:,:)*PREDR1(:,:,:))
+END IF
+!
+!
+!---------------------------------------------------------------------------
+!
+! For the scalar variables
+DO JSV=1,ISV
+ PREDS1(:,:,:,JSV)=XCTV*PBLL_O_E(:,:,:)*GZ_M_W(KKA, KKU, KKL,PSVM(:,:,:,JSV),PDZZ)
+END DO
+!
+DO JSV=1,ISV
+ ZW2=SIGN(1.,PREDS1(:,:,:,JSV))
+ PREDS1(:,:,:,JSV)= ZW2(:,:,:) * MAX(1.E-30, ZW2(:,:,:)*PREDS1(:,:,:,JSV))
+END DO
+!
+!---------------------------------------------------------------------------
+!
+!* 2. 3D REDELSPERGER NUMBERS
+! ------------------------
+!
+IF(HTURBDIM=='1DIM') THEN ! 1D case
+!
+!
+ PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2
+!
+ PRED2R3(:,:,:) = PREDR1(:,:,:) **2
+!
+ PRED2THR3(:,:,:) = PREDTH1(:,:,:) * PREDR1(:,:,:)
+!
+ELSE IF (L2D) THEN ! 3D case in a 2D model
+!
+ IF (KRR /= 0) THEN ! moist 3D case
+ PRED2TH3(:,:,:)= PREDTH1(:,:,:)**2+(XCTV*PBLL_O_E(:,:,:)*PETHETA(:,:,:) )**2 * &
+ MZM(GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL)**2, KKA, KKU, KKL)
+ PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
+!
+ PRED2R3(:,:,:)= PREDR1(:,:,:)**2 + (XCTV*PBLL_O_E(:,:,:)*PEMOIST(:,:,:))**2 * &
+ MZM(GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX, KKA, KKU, KKL)**2, KKA, KKU, KKL)
+ PRED2R3(:,:,IKB)=PRED2R3(:,:,IKB+KKL)
+!
+ PRED2THR3(:,:,:)= PREDR1(:,:,:) * PREDTH1(:,:,:) + XCTV**2*PBLL_O_E(:,:,:)**2 * &
+ PEMOIST(:,:,:) * PETHETA(:,:,:) * &
+ MZM(GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX, KKA, KKU, KKL)* &
+ GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL), KKA, KKU, KKL)
+ PRED2THR3(:,:,IKB)=PRED2THR3(:,:,IKB+KKL)
+!
+ ELSE ! dry 3D case in a 2D model
+ PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2 + XCTV**2*PBLL_O_E(:,:,:)**2 * &
+ MZM(GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL)**2, KKA, KKU, KKL)
+ PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
+!
+ PRED2R3(:,:,:) = 0.
+!
+ PRED2THR3(:,:,:) = 0.
+!
+ END IF
+!
+ELSE ! 3D case in a 3D model
+!
+ IF (KRR /= 0) THEN ! moist 3D case
+ PRED2TH3(:,:,:)= PREDTH1(:,:,:)**2 + ( XCTV*PBLL_O_E(:,:,:)*PETHETA(:,:,:) )**2 * &
+ MZM(GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL)**2 &
+ + GY_M_M(PTHLM,PDYY,PDZZ,PDZY, KKA, KKU, KKL)**2, KKA, KKU, KKL)
+ PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
+!
+ PRED2R3(:,:,:)= PREDR1(:,:,:)**2 + (XCTV*PBLL_O_E(:,:,:)*PEMOIST(:,:,:))**2 * &
+ MZM(GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX, KKA, KKU, KKL)**2 + &
+ GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY, KKA, KKU, KKL)**2, KKA, KKU, KKL)
+ PRED2R3(:,:,IKB)=PRED2R3(:,:,IKB+KKL)
+!
+ PRED2THR3(:,:,:)= PREDR1(:,:,:) * PREDTH1(:,:,:) + XCTV**2*PBLL_O_E(:,:,:)**2 * &
+ PEMOIST(:,:,:) * PETHETA(:,:,:) * &
+ MZM(GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX, KKA, KKU, KKL)* &
+ GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL)+ &
+ GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY, KKA, KKU, KKL)* &
+ GY_M_M(PTHLM,PDYY,PDZZ,PDZY, KKA, KKU, KKL), KKA, KKU, KKL)
+ PRED2THR3(:,:,IKB)=PRED2THR3(:,:,IKB+KKL)
+!
+ ELSE ! dry 3D case in a 3D model
+ PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2 + XCTV**2*PBLL_O_E(:,:,:)**2 * &
+ MZM(GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL)**2 &
+ + GY_M_M(PTHLM,PDYY,PDZZ,PDZY, KKA, KKU, KKL)**2, KKA, KKU, KKL)
+ PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
+!
+ PRED2R3(:,:,:) = 0.
+!
+ PRED2THR3(:,:,:) = 0.
+!
+ END IF
+!
+END IF ! end of the if structure on the turbulence dimensionnality
+!
+!
+!---------------------------------------------------------------------------
+!
+! 5. Prandtl numbers for scalars
+! ---------------------------
+DO JSV=1,ISV
+!
+ IF(HTURBDIM=='1DIM') THEN
+! 1D case
+ PRED2THS3(:,:,:,JSV) = PREDS1(:,:,:,JSV) * PREDTH1(:,:,:)
+ IF (KRR /= 0) THEN
+ PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) *PREDS1(:,:,:,JSV)
+ ELSE
+ PRED2RS3(:,:,:,JSV) = 0.
+ END IF
+!
+ ELSE IF (L2D) THEN ! 3D case in a 2D model
+!
+ IF (KRR /= 0) THEN
+ ZW1 = MZM((XG / PTHVREF * PLM * PLEPS / PTKEM)**2, KKA, KKU, KKL) *PETHETA
+ ELSE
+ ZW1 = MZM((XG / PTHVREF * PLM * PLEPS / PTKEM)**2, KKA, KKU, KKL)
+ END IF
+ PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + &
+ ZW1* &
+ MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX, KKA, KKU, KKL)* &
+ GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL), &
+ KKA, KKU, KKL)
+!
+ IF (KRR /= 0) THEN
+ PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
+ ZW1 * PEMOIST * &
+ MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX, KKA, KKU, KKL)* &
+ GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX, KKA, KKU, KKL), &
+ KKA, KKU, KKL)
+ ELSE
+ PRED2RS3(:,:,:,JSV) = 0.
+ END IF
+!
+ ELSE ! 3D case in a 3D model
+!
+ IF (KRR /= 0) THEN
+ ZW1 = MZM((XG / PTHVREF * PLM * PLEPS / PTKEM)**2, KKA, KKU, KKL) *PETHETA
+ ELSE
+ ZW1 = MZM((XG / PTHVREF * PLM * PLEPS / PTKEM)**2, KKA, KKU, KKL)
+ END IF
+ PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + &
+ ZW1* &
+ MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX, KKA, KKU, KKL)* &
+ GX_M_M(PTHLM,PDXX,PDZZ,PDZX, KKA, KKU, KKL) &
+ +GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY, KKA, KKU, KKL)* &
+ GY_M_M(PTHLM,PDYY,PDZZ,PDZY, KKA, KKU, KKL), &
+ KKA, KKU, KKL)
+!
+ IF (KRR /= 0) THEN
+ PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
+ ZW1 * PEMOIST * &
+ MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX, KKA, KKU, KKL)* &
+ GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX, KKA, KKU, KKL) &
+ +GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY, KKA, KKU, KKL)* &
+ GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY, KKA, KKU, KKL), &
+ KKA, KKU, KKL)
+ ELSE
+ PRED2RS3(:,:,:,JSV) = 0.
+ END IF
+!
+ END IF ! end of HTURBDIM if-block
+!
+END DO
+!
+!---------------------------------------------------------------------------
+!
+!* 6. SAVES THE REDELSPERGER NUMBERS
+! ------------------------------
+!
+IF ( OTURB_DIAG .AND. TPFILE%LOPENED ) THEN
+ !
+ ! stores the RED_TH1
+ TZFIELD%CMNHNAME = 'RED_TH1'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'RED_TH1'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_RED_TH1'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PREDTH1)
+ !
+ ! stores the RED_R1
+ TZFIELD%CMNHNAME = 'RED_R1'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'RED_R1'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_RED_R1'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PREDR1)
+ !
+ ! stores the RED2_TH3
+ TZFIELD%CMNHNAME = 'RED2_TH3'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'RED2_TH3'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_RED2_TH3'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PRED2TH3)
+ !
+ ! stores the RED2_R3
+ TZFIELD%CMNHNAME = 'RED2_R3'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'RED2_R3'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_RED2_R3'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PRED2R3)
+ !
+ ! stores the RED2_THR3
+ TZFIELD%CMNHNAME = 'RED2_THR3'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'RED2_THR3'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_RED2_THR3'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PRED2THR3)
+ !
+END IF
+!
+!---------------------------------------------------------------------------
+ENDIF ! (Done only if LHARAT is FALSE)
+!
+IF (LHOOK) CALL DR_HOOK('PRANDTL',1,ZHOOK_HANDLE)
+END SUBROUTINE PRANDTL
+!
SUBROUTINE SMOOTH_TURB_FUNCT(PPHI3,PF_LIM,PF)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3 ! Phi3
@@ -54,6 +589,8 @@ FUNCTION PHI3(PREDTH1,PREDR1,PRED2TH3,PRED2R3,PRED2THR3,HTURBDIM,OUSERV)
REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: ZW1, ZW2
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:PHI3',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PREDTH1,3)-JPVEXT_TURB
!
@@ -97,6 +634,7 @@ END IF
PHI3(:,:,IKB-1)=PHI3(:,:,IKB)
PHI3(:,:,IKE+1)=PHI3(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:PHI3',1,ZHOOK_HANDLE)
END FUNCTION PHI3
!----------------------------------------------------------------------------
FUNCTION PSI_SV(PREDTH1,PREDR1,PREDS1,PRED2THS,PRED2RS,PPHI3,PPSI3)
@@ -112,6 +650,8 @@ FUNCTION PSI_SV(PREDTH1,PREDR1,PREDS1,PRED2THS,PRED2RS,PPHI3,PPSI3)
INTEGER :: IKB, IKE
INTEGER :: JSV
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:PSI_SV',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PREDTH1,3)-JPVEXT_TURB
!
@@ -132,6 +672,7 @@ DO JSV=1,SIZE(PSI_SV,4)
PSI_SV(:,:,IKE+1,JSV)=PSI_SV(:,:,IKE,JSV)
END DO
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:PSI_SV',1,ZHOOK_HANDLE)
END FUNCTION PSI_SV
!----------------------------------------------------------------------------
FUNCTION D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV)
@@ -145,6 +686,8 @@ FUNCTION D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,OUS
REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: D_PHI3DTDZ_O_DDTDZ
INTEGER :: IKB, IKE,JL,JK,JJ
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PHI3DTDZ_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PREDTH1,3)-JPVEXT_TURB
!
@@ -204,6 +747,7 @@ CALL SMOOTH_TURB_FUNCT(PPHI3,PPHI3,D_PHI3DTDZ_O_DDTDZ)
D_PHI3DTDZ_O_DDTDZ(:,:,IKB-1)=D_PHI3DTDZ_O_DDTDZ(:,:,IKB)
D_PHI3DTDZ_O_DDTDZ(:,:,IKE+1)=D_PHI3DTDZ_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PHI3DTDZ_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_PHI3DTDZ_O_DDTDZ
!----------------------------------------------------------------------------
FUNCTION D_PHI3DRDZ_O_DDRDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV)
@@ -217,6 +761,8 @@ FUNCTION D_PHI3DRDZ_O_DDRDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,OUS
REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: D_PHI3DRDZ_O_DDRDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PHI3DRDZ_O_DDRDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PREDTH1,3)-JPVEXT_TURB
!
@@ -254,6 +800,7 @@ CALL SMOOTH_TURB_FUNCT(PPHI3,PPHI3,D_PHI3DRDZ_O_DDRDZ)
D_PHI3DRDZ_O_DDRDZ(:,:,IKB-1)=D_PHI3DRDZ_O_DDRDZ(:,:,IKB)
D_PHI3DRDZ_O_DDRDZ(:,:,IKE+1)=D_PHI3DRDZ_O_DDRDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PHI3DRDZ_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_PHI3DRDZ_O_DDRDZ
!----------------------------------------------------------------------------
FUNCTION D_PHI3DTDZ2_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,PDTDZ,HTURBDIM,OUSERV)
@@ -268,6 +815,8 @@ FUNCTION D_PHI3DTDZ2_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,PDTDZ,HTURB
REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: D_PHI3DTDZ2_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PHI3DTDZ2_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PREDTH1,3)-JPVEXT_TURB
!
@@ -320,6 +869,7 @@ CALL SMOOTH_TURB_FUNCT(PPHI3,PPHI3*2.*PDTDZ,D_PHI3DTDZ2_O_DDTDZ)
D_PHI3DTDZ2_O_DDTDZ(:,:,IKB-1)=D_PHI3DTDZ2_O_DDTDZ(:,:,IKB)
D_PHI3DTDZ2_O_DDTDZ(:,:,IKE+1)=D_PHI3DTDZ2_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PHI3DTDZ2_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_PHI3DTDZ2_O_DDTDZ
!----------------------------------------------------------------------------
FUNCTION M3_WTH_WTH2(PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA)
@@ -331,6 +881,8 @@ FUNCTION M3_WTH_WTH2(PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WTH_WTH2
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WTH2',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
@@ -339,6 +891,7 @@ M3_WTH_WTH2(:,:,:) = XCSHF*PBLL_O_E*PETHETA*0.5/XCTD &
M3_WTH_WTH2(:,:,IKB-1)=M3_WTH_WTH2(:,:,IKB)
M3_WTH_WTH2(:,:,IKE+1)=M3_WTH_WTH2(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WTH2',1,ZHOOK_HANDLE)
END FUNCTION M3_WTH_WTH2
!----------------------------------------------------------------------------
FUNCTION D_M3_WTH_WTH2_O_DDTDZ(PM3_WTH_WTH2,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA)
@@ -351,6 +904,8 @@ FUNCTION D_M3_WTH_WTH2_O_DDTDZ(PM3_WTH_WTH2,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WTH_WTH2_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WTH2_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
@@ -361,9 +916,13 @@ D_M3_WTH_WTH2_O_DDTDZ(:,:,:) = ( 0.5*XCSHF*PBLL_O_E*PETHETA*0.5/XCTD/PD &
D_M3_WTH_WTH2_O_DDTDZ(:,:,IKB-1)=D_M3_WTH_WTH2_O_DDTDZ(:,:,IKB)
D_M3_WTH_WTH2_O_DDTDZ(:,:,IKE+1)=D_M3_WTH_WTH2_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WTH2_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_WTH_WTH2_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WTH_W2TH(PREDTH1,PREDR1,PD,PKEFF,PTKE)
+FUNCTION M3_WTH_W2TH(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -372,18 +931,24 @@ FUNCTION M3_WTH_W2TH(PREDTH1,PREDR1,PD,PKEFF,PTKE)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WTH_W2TH
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_W2TH',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-M3_WTH_W2TH(:,:,:) = XCSHF*PKEFF*1.5/MZM(PTKE) &
+M3_WTH_W2TH(:,:,:) = XCSHF*PKEFF*1.5/MZM(PTKE, KKA, KKU, KKL) &
* (1. - 0.5*PREDR1*(1.+PREDR1)/PD ) / (1.+PREDTH1)
!
M3_WTH_W2TH(:,:,IKB-1)=M3_WTH_W2TH(:,:,IKB)
M3_WTH_W2TH(:,:,IKE+1)=M3_WTH_W2TH(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_W2TH',1,ZHOOK_HANDLE)
END FUNCTION M3_WTH_W2TH
!----------------------------------------------------------------------------
-FUNCTION D_M3_WTH_W2TH_O_DDTDZ(PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PKEFF,PTKE)
+FUNCTION D_M3_WTH_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PKEFF,PTKE)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -394,19 +959,25 @@ FUNCTION D_M3_WTH_W2TH_O_DDTDZ(PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PKEFF,PTKE)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WTH_W2TH_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_W2TH_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_WTH_W2TH_O_DDTDZ(:,:,:) = &
- - XCSHF*PKEFF*1.5/MZM(PTKE)/(1.+PREDTH1)**2*XCTV*PBLL_O_E*PETHETA &
+ - XCSHF*PKEFF*1.5/MZM(PTKE, KKA, KKU, KKL)/(1.+PREDTH1)**2*XCTV*PBLL_O_E*PETHETA &
* (1. - 0.5*PREDR1*(1.+PREDR1)/PD*( 1.+(1.+PREDTH1)*(1.5+PREDR1+PREDTH1)/PD) )
!
D_M3_WTH_W2TH_O_DDTDZ(:,:,IKB-1)=D_M3_WTH_W2TH_O_DDTDZ(:,:,IKB)
D_M3_WTH_W2TH_O_DDTDZ(:,:,IKE+1)=D_M3_WTH_W2TH_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_W2TH_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_WTH_W2TH_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WTH_W2R(PD,PKEFF,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
+FUNCTION M3_WTH_W2R(KKA,KKU,KKL,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
@@ -416,17 +987,23 @@ FUNCTION M3_WTH_W2R(PD,PKEFF,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WTH_W2R
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_W2R',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-M3_WTH_W2R(:,:,:) = - XCSHF*PKEFF*0.75*XCTV*PBLL_O_E/MZM(PTKE)*PEMOIST*PDTDZ/PD
+M3_WTH_W2R(:,:,:) = - XCSHF*PKEFF*0.75*XCTV*PBLL_O_E/MZM(PTKE, KKA, KKU, KKL)*PEMOIST*PDTDZ/PD
!
M3_WTH_W2R(:,:,IKB-1)=M3_WTH_W2R(:,:,IKB)
M3_WTH_W2R(:,:,IKE+1)=M3_WTH_W2R(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_W2R',1,ZHOOK_HANDLE)
END FUNCTION M3_WTH_W2R
!----------------------------------------------------------------------------
-FUNCTION D_M3_WTH_W2R_O_DDTDZ(PREDTH1,PREDR1,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST)
+FUNCTION D_M3_WTH_W2R_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -437,18 +1014,24 @@ FUNCTION D_M3_WTH_W2R_O_DDTDZ(PREDTH1,PREDR1,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WTH_W2R_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_W2R_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-D_M3_WTH_W2R_O_DDTDZ(:,:,:) = - XCSHF*PKEFF*0.75*XCTV*PBLL_O_E/MZM(PTKE)*PEMOIST/PD &
+D_M3_WTH_W2R_O_DDTDZ(:,:,:) = - XCSHF*PKEFF*0.75*XCTV*PBLL_O_E/MZM(PTKE, KKA, KKU, KKL)*PEMOIST/PD &
* (1. - PREDTH1*(1.5+PREDTH1+PREDR1)/PD)
!
D_M3_WTH_W2R_O_DDTDZ(:,:,IKB-1)=D_M3_WTH_W2R_O_DDTDZ(:,:,IKB)
D_M3_WTH_W2R_O_DDTDZ(:,:,IKE+1)=D_M3_WTH_W2R_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_W2R_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_WTH_W2R_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WTH_WR2(PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTDZ)
+FUNCTION M3_WTH_WR2(KKA,KKU,KKL,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
@@ -461,18 +1044,24 @@ FUNCTION M3_WTH_WR2(PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTDZ)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WTH_WR2
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WR2',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
M3_WTH_WR2(:,:,:) = - XCSHF*PKEFF*0.25*PBLL_O_E*XCTV*PEMOIST**2 &
- *MZM(PBETA*PLEPS/(PSQRT_TKE*PTKE))/XCTD*PDTDZ/PD
+ *MZM(PBETA*PLEPS/(PSQRT_TKE*PTKE), KKA, KKU, KKL)/XCTD*PDTDZ/PD
!
M3_WTH_WR2(:,:,IKB-1)=M3_WTH_WR2(:,:,IKB)
M3_WTH_WR2(:,:,IKE+1)=M3_WTH_WR2(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WR2',1,ZHOOK_HANDLE)
END FUNCTION M3_WTH_WR2
!----------------------------------------------------------------------------
-FUNCTION D_M3_WTH_WR2_O_DDTDZ(PREDTH1,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST)
+FUNCTION D_M3_WTH_WR2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -486,19 +1075,25 @@ FUNCTION D_M3_WTH_WR2_O_DDTDZ(PREDTH1,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PB
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WTH_WR2_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WR2_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_WTH_WR2_O_DDTDZ(:,:,:) = - XCSHF*PKEFF*0.25*PBLL_O_E*XCTV*PEMOIST**2 &
- *MZM(PBETA*PLEPS/(PSQRT_TKE*PTKE))/XCTD/PD &
+ *MZM(PBETA*PLEPS/(PSQRT_TKE*PTKE), KKA, KKU, KKL)/XCTD/PD &
* (1. - PREDTH1*(1.5+PREDTH1+PREDR1)/PD)
!
D_M3_WTH_WR2_O_DDTDZ(:,:,IKB-1)=D_M3_WTH_WR2_O_DDTDZ(:,:,IKB)
D_M3_WTH_WR2_O_DDTDZ(:,:,IKE+1)=D_M3_WTH_WR2_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WR2_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_WTH_WR2_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WTH_WTHR(PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PEMOIST)
+FUNCTION M3_WTH_WTHR(KKA,KKU,KKL,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PEMOIST)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
@@ -510,17 +1105,20 @@ FUNCTION M3_WTH_WTHR(PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PEMOIST)
REAL, DIMENSION(SIZE(PREDR1,1),SIZE(PREDR1,2),SIZE(PREDR1,3)) :: M3_WTH_WTHR
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WTHR',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-!M3_WTH_WTHR(:,:,:) = XCSHF*PKEFF*PEMOIST/MZM(PBETA*PTKE*PSQRT_TKE) &
+!M3_WTH_WTHR(:,:,:) = XCSHF*PKEFF*PEMOIST/MZM(PBETA*PTKE*PSQRT_TKE, KKA, KKU, KKL) &
! *0.5*PLEPS/XCTD*(1+PREDR1)/PD
-M3_WTH_WTHR(:,:,:) = XCSHF*PKEFF*PEMOIST*MZM(PBETA/PTKE*PSQRT_TKE) &
+M3_WTH_WTHR(:,:,:) = XCSHF*PKEFF*PEMOIST*MZM(PBETA/PTKE*PSQRT_TKE, KKA, KKU, KKL) &
*0.5*PLEPS/XCTD*(1+PREDR1)/PD
!
M3_WTH_WTHR(:,:,IKB-1)=M3_WTH_WTHR(:,:,IKB)
M3_WTH_WTHR(:,:,IKE+1)=M3_WTH_WTHR(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WTH_WTHR',1,ZHOOK_HANDLE)
END FUNCTION M3_WTH_WTHR
!----------------------------------------------------------------------------
FUNCTION D_M3_WTH_WTHR_O_DDTDZ(PM3_WTH_WTHR,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA)
@@ -533,6 +1131,8 @@ FUNCTION D_M3_WTH_WTHR_O_DDTDZ(PM3_WTH_WTHR,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WTH_WTHR_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WTHR_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
@@ -541,9 +1141,13 @@ D_M3_WTH_WTHR_O_DDTDZ(:,:,:) = - PM3_WTH_WTHR * (1.5+PREDTH1+PREDR1)/PD*XCTV*PBL
D_M3_WTH_WTHR_O_DDTDZ(:,:,IKB-1)=D_M3_WTH_WTHR_O_DDTDZ(:,:,IKB)
D_M3_WTH_WTHR_O_DDTDZ(:,:,IKE+1)=D_M3_WTH_WTHR_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WTH_WTHR_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_WTH_WTHR_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_TH2_W2TH(PREDTH1,PREDR1,PD,PDTDZ,PLM,PLEPS,PTKE)
+FUNCTION M3_TH2_W2TH(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PDTDZ,PLM,PLEPS,PTKE)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -554,18 +1158,24 @@ FUNCTION M3_TH2_W2TH(PREDTH1,PREDR1,PD,PDTDZ,PLM,PLEPS,PTKE)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_TH2_W2TH
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_W2TH',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-M3_TH2_W2TH(:,:,:) = - MZF((1.-0.5*PREDR1*(1.+PREDR1)/PD)/(1.+PREDTH1)*PDTDZ) &
+M3_TH2_W2TH(:,:,:) = - MZF((1.-0.5*PREDR1*(1.+PREDR1)/PD)/(1.+PREDTH1)*PDTDZ, KKA, KKU, KKL) &
* 1.5*PLM*PLEPS/PTKE*XCTV
!
M3_TH2_W2TH(:,:,IKB-1)=M3_TH2_W2TH(:,:,IKB)
M3_TH2_W2TH(:,:,IKE+1)=M3_TH2_W2TH(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_W2TH',1,ZHOOK_HANDLE)
END FUNCTION M3_TH2_W2TH
!----------------------------------------------------------------------------
-FUNCTION D_M3_TH2_W2TH_O_DDTDZ(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,OUSERV)
+FUNCTION D_M3_TH2_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,OUSERV)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -576,27 +1186,33 @@ FUNCTION D_M3_TH2_W2TH_O_DDTDZ(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,OUSERV)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_TH2_W2TH_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_W2TH_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
IF (OUSERV) THEN
! D_M3_TH2_W2TH_O_DDTDZ(:,:,:) = - 1.5*PLM*PLEPS/PTKE*XCTV * MZF( &
! (1.-0.5*PREDR1*(1.+PREDR1)/PD)*(1.-(1.5+PREDTH1+PREDR1)*(1.+PREDTH1)/PD ) &
-! / (1.+PREDTH1)**2 )
- D_M3_TH2_W2TH_O_DDTDZ(:,:,:) = - 1.5*PLM*PLEPS/PTKE*XCTV * MZF( &
+! / (1.+PREDTH1)**2, KKA, KKU, KKL)
+ D_M3_TH2_W2TH_O_DDTDZ(:,:,:) = - 1.5*PLM*PLEPS/PTKE*XCTV * MZF( &
(1.-0.5*PREDR1*(1.+PREDR1)/PD)*(1.-(1.5+PREDTH1+PREDR1)* &
- PREDTH1*(1.+PREDTH1)/PD ) / (1.+PREDTH1)**2 )
+ PREDTH1*(1.+PREDTH1)/PD ) / (1.+PREDTH1)**2, KKA, KKU, KKL)
ELSE
- D_M3_TH2_W2TH_O_DDTDZ(:,:,:) = - 1.5*PLM*PLEPS/PTKE*XCTV * MZF(1./(1.+PREDTH1)**2)
+ D_M3_TH2_W2TH_O_DDTDZ(:,:,:) = - 1.5*PLM*PLEPS/PTKE*XCTV * MZF(1./(1.+PREDTH1)**2, KKA, KKU, KKL)
END IF
!
D_M3_TH2_W2TH_O_DDTDZ(:,:,IKB-1)=D_M3_TH2_W2TH_O_DDTDZ(:,:,IKB)
D_M3_TH2_W2TH_O_DDTDZ(:,:,IKE+1)=D_M3_TH2_W2TH_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_W2TH_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_TH2_W2TH_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_TH2_WTH2(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE)
+FUNCTION M3_TH2_WTH2(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -605,18 +1221,24 @@ FUNCTION M3_TH2_WTH2(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_TH2_WTH2
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WTH2',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
M3_TH2_WTH2(:,:,:) = PLEPS*0.5/XCTD/PSQRT_TKE &
- * MZF( (1.+0.5*PREDTH1+1.5*PREDR1+0.5*PREDR1**2)/PD )
+ * MZF((1.+0.5*PREDTH1+1.5*PREDR1+0.5*PREDR1**2)/PD, KKA, KKU, KKL)
!
M3_TH2_WTH2(:,:,IKB-1)=M3_TH2_WTH2(:,:,IKB)
M3_TH2_WTH2(:,:,IKE+1)=M3_TH2_WTH2(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WTH2',1,ZHOOK_HANDLE)
END FUNCTION M3_TH2_WTH2
!----------------------------------------------------------------------------
-FUNCTION D_M3_TH2_WTH2_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA)
+FUNCTION D_M3_TH2_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -627,20 +1249,26 @@ FUNCTION D_M3_TH2_WTH2_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHET
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_TH2_WTH2_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WTH2_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_TH2_WTH2_O_DDTDZ(:,:,:) = PLEPS*0.5/XCTD/PSQRT_TKE*XCTV &
- * MZF( PBLL_O_E*PETHETA* (0.5/PD &
+ * MZF(PBLL_O_E*PETHETA* (0.5/PD &
- (1.5+PREDTH1+PREDR1)*(1.+0.5*PREDTH1+1.5*PREDR1+0.5*PREDR1**2)/PD**2 &
- ) )
+ ), KKA, KKU, KKL)
!
D_M3_TH2_WTH2_O_DDTDZ(:,:,IKB-1)=D_M3_TH2_WTH2_O_DDTDZ(:,:,IKB)
D_M3_TH2_WTH2_O_DDTDZ(:,:,IKE+1)=D_M3_TH2_WTH2_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WTH2_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_TH2_WTH2_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_TH2_W2R(PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
+FUNCTION M3_TH2_W2R(KKA,KKU,KKL,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
@@ -651,17 +1279,23 @@ FUNCTION M3_TH2_W2R(PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_TH2_W2R
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_W2R',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-M3_TH2_W2R(:,:,:) = 0.75*XCTV**2*MZF(PBLL_O_E*PEMOIST/PD*PDTDZ**2)*PLM*PLEPS/PTKE
+M3_TH2_W2R(:,:,:) = 0.75*XCTV**2*MZF(PBLL_O_E*PEMOIST/PD*PDTDZ**2, KKA, KKU, KKL)*PLM*PLEPS/PTKE
!
M3_TH2_W2R(:,:,IKB-1)=M3_TH2_W2R(:,:,IKB)
M3_TH2_W2R(:,:,IKE+1)=M3_TH2_W2R(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_W2R',1,ZHOOK_HANDLE)
END FUNCTION M3_TH2_W2R
!----------------------------------------------------------------------------
-FUNCTION D_M3_TH2_W2R_O_DDTDZ(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
+FUNCTION D_M3_TH2_W2R_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -674,18 +1308,24 @@ FUNCTION D_M3_TH2_W2R_O_DDTDZ(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_TH2_W2R_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_W2R_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_TH2_W2R_O_DDTDZ(:,:,:) = 0.75*XCTV**2*PLM*PLEPS/PTKE &
- * MZF( PBLL_O_E*PEMOIST/PD*PDTDZ*(2.-PREDTH1*(1.5+PREDTH1+PREDR1)/PD) )
+ * MZF(PBLL_O_E*PEMOIST/PD*PDTDZ*(2.-PREDTH1*(1.5+PREDTH1+PREDR1)/PD), KKA, KKU, KKL)
!
D_M3_TH2_W2R_O_DDTDZ(:,:,IKB-1)=D_M3_TH2_W2R_O_DDTDZ(:,:,IKB)
D_M3_TH2_W2R_O_DDTDZ(:,:,IKE+1)=D_M3_TH2_W2R_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_W2R_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_TH2_W2R_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_TH2_WR2(PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+FUNCTION M3_TH2_WR2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
@@ -695,17 +1335,23 @@ FUNCTION M3_TH2_WR2(PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_TH2_WR2
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WR2',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-M3_TH2_WR2(:,:,:) = 0.25*XCTV**2*MZF((PBLL_O_E*PEMOIST*PDTDZ)**2/PD)*PLEPS/PSQRT_TKE/XCTD
+M3_TH2_WR2(:,:,:) = 0.25*XCTV**2*MZF((PBLL_O_E*PEMOIST*PDTDZ)**2/PD, KKA, KKU, KKL)*PLEPS/PSQRT_TKE/XCTD
!
M3_TH2_WR2(:,:,IKB-1)=M3_TH2_WR2(:,:,IKB)
M3_TH2_WR2(:,:,IKE+1)=M3_TH2_WR2(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WR2',1,ZHOOK_HANDLE)
END FUNCTION M3_TH2_WR2
!----------------------------------------------------------------------------
-FUNCTION D_M3_TH2_WR2_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+FUNCTION D_M3_TH2_WR2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -717,18 +1363,24 @@ FUNCTION D_M3_TH2_WR2_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_TH2_WR2_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WR2_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_TH2_WR2_O_DDTDZ(:,:,:) = 0.25*XCTV**2*PLEPS/PSQRT_TKE/XCTD &
- * MZF( (PBLL_O_E*PEMOIST)**2*PDTDZ/PD*(2.-PREDTH1*(1.5+PREDTH1+PREDR1)/PD) )
+ * MZF((PBLL_O_E*PEMOIST)**2*PDTDZ/PD*(2.-PREDTH1*(1.5+PREDTH1+PREDR1)/PD), KKA, KKU, KKL)
!
D_M3_TH2_WR2_O_DDTDZ(:,:,IKB-1)=D_M3_TH2_WR2_O_DDTDZ(:,:,IKB)
D_M3_TH2_WR2_O_DDTDZ(:,:,IKE+1)=D_M3_TH2_WR2_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WR2_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_TH2_WR2_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_TH2_WTHR(PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+FUNCTION M3_TH2_WTHR(KKA,KKU,KKL,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
@@ -739,18 +1391,24 @@ FUNCTION M3_TH2_WTHR(PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_TH2_WTHR
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WTHR',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
M3_TH2_WTHR(:,:,:) = - 0.5*XCTV*PLEPS/PSQRT_TKE/XCTD &
- * MZF( PBLL_O_E*PEMOIST*PDTDZ*(1.+PREDR1)/PD )
+ * MZF(PBLL_O_E*PEMOIST*PDTDZ*(1.+PREDR1)/PD, KKA, KKU, KKL)
!
M3_TH2_WTHR(:,:,IKB-1)=M3_TH2_WTHR(:,:,IKB)
M3_TH2_WTHR(:,:,IKE+1)=M3_TH2_WTHR(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_TH2_WTHR',1,ZHOOK_HANDLE)
END FUNCTION M3_TH2_WTHR
!----------------------------------------------------------------------------
-FUNCTION D_M3_TH2_WTHR_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+FUNCTION D_M3_TH2_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -762,18 +1420,24 @@ FUNCTION D_M3_TH2_WTHR_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIS
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_TH2_WTHR_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WTHR_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_TH2_WTHR_O_DDTDZ(:,:,:) = - 0.5*XCTV*PLEPS/PSQRT_TKE/XCTD &
- * MZF( PBLL_O_E*PEMOIST*(1.+PREDR1)/PD * (1. -PREDTH1*(1.5+PREDTH1+PREDR1)/PD) )
+ * MZF(PBLL_O_E*PEMOIST*(1.+PREDR1)/PD * (1. -PREDTH1*(1.5+PREDTH1+PREDR1)/PD), KKA, KKU, KKL)
!
D_M3_TH2_WTHR_O_DDTDZ(:,:,IKB-1)=D_M3_TH2_WTHR_O_DDTDZ(:,:,IKB)
D_M3_TH2_WTHR_O_DDTDZ(:,:,IKE+1)=D_M3_TH2_WTHR_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_TH2_WTHR_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_TH2_WTHR_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_THR_WTHR(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE)
+FUNCTION M3_THR_WTHR(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -782,18 +1446,24 @@ FUNCTION M3_THR_WTHR(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_THR_WTHR
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_WTHR',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
M3_THR_WTHR(:,:,:) = 0.5*PLEPS/PSQRT_TKE/XCTD &
- * MZF( (1.+PREDTH1)*(1.+PREDR1)/PD )
+ * MZF((1.+PREDTH1)*(1.+PREDR1)/PD, KKA, KKU, KKL)
!
M3_THR_WTHR(:,:,IKB-1)=M3_THR_WTHR(:,:,IKB)
M3_THR_WTHR(:,:,IKE+1)=M3_THR_WTHR(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_WTHR',1,ZHOOK_HANDLE)
END FUNCTION M3_THR_WTHR
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_WTHR_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA)
+FUNCTION D_M3_THR_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -804,18 +1474,24 @@ FUNCTION D_M3_THR_WTHR_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHET
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_WTHR_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTHR_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_THR_WTHR_O_DDTDZ(:,:,:) = 0.5*PLEPS/PSQRT_TKE/XCTD * XCTV &
- * MZF( PETHETA*PBLL_O_E/PD*(1.+PREDR1)*(1.-(1.+PREDTH1)*(1.5+PREDTH1+PREDR1)/PD) )
+ * MZF(PETHETA*PBLL_O_E/PD*(1.+PREDR1)*(1.-(1.+PREDTH1)*(1.5+PREDTH1+PREDR1)/PD), KKA, KKU, KKL)
!
D_M3_THR_WTHR_O_DDTDZ(:,:,IKB-1)=D_M3_THR_WTHR_O_DDTDZ(:,:,IKB)
D_M3_THR_WTHR_O_DDTDZ(:,:,IKE+1)=D_M3_THR_WTHR_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTHR_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_THR_WTHR_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_THR_WTH2(PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+FUNCTION M3_THR_WTH2(KKA,KKU,KKL,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
@@ -826,18 +1502,24 @@ FUNCTION M3_THR_WTH2(PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_THR_WTH2
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_WTH2',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
M3_THR_WTH2(:,:,:) = - 0.25*PLEPS/PSQRT_TKE/XCTD*XCTV &
- * MZF( (1.+PREDR1)*PBLL_O_E*PETHETA*PDRDZ/PD )
+ * MZF((1.+PREDR1)*PBLL_O_E*PETHETA*PDRDZ/PD, KKA, KKU, KKL)
!
M3_THR_WTH2(:,:,IKB-1)=M3_THR_WTH2(:,:,IKB)
M3_THR_WTH2(:,:,IKE+1)=M3_THR_WTH2(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_WTH2',1,ZHOOK_HANDLE)
END FUNCTION M3_THR_WTH2
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_WTH2_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+FUNCTION D_M3_THR_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -849,18 +1531,24 @@ FUNCTION D_M3_THR_WTH2_O_DDTDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHET
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_WTH2_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTH2_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_THR_WTH2_O_DDTDZ(:,:,:) = - 0.25*PLEPS/PSQRT_TKE/XCTD*XCTV**2 &
- * MZF( -(1.+PREDR1)*(PBLL_O_E*PETHETA/PD)**2*PDRDZ*(1.5+PREDTH1+PREDR1) )
+ * MZF(-(1.+PREDR1)*(PBLL_O_E*PETHETA/PD)**2*PDRDZ*(1.5+PREDTH1+PREDR1), KKA, KKU, KKL)
!
D_M3_THR_WTH2_O_DDTDZ(:,:,IKB-1)=D_M3_THR_WTH2_O_DDTDZ(:,:,IKB)
D_M3_THR_WTH2_O_DDTDZ(:,:,IKE+1)=D_M3_THR_WTH2_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTH2_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_THR_WTH2_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_WTH2_O_DDRDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA)
+FUNCTION D_M3_THR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -871,20 +1559,26 @@ FUNCTION D_M3_THR_WTH2_O_DDRDZ(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHET
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_WTH2_O_DDRDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTH2_O_DDRDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_THR_WTH2_O_DDRDZ(:,:,:) = - 0.25*PLEPS/PSQRT_TKE/XCTD*XCTV &
- * MZF( PBLL_O_E*PETHETA/PD &
- *(-(1.+PREDR1)*PREDR1/PD*(1.5+PREDTH1+PREDR1)+(1.+2.*PREDR1)) &
- )
+ * MZF(PBLL_O_E*PETHETA/PD &
+ *(-(1.+PREDR1)*PREDR1/PD*(1.5+PREDTH1+PREDR1)+(1.+2.*PREDR1)), &
+ KKA, KKU, KKL)
!
D_M3_THR_WTH2_O_DDRDZ(:,:,IKB-1)=D_M3_THR_WTH2_O_DDRDZ(:,:,IKB)
D_M3_THR_WTH2_O_DDRDZ(:,:,IKE+1)=D_M3_THR_WTH2_O_DDRDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTH2_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_THR_WTH2_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_THR_W2TH(PREDR1,PD,PLM,PLEPS,PTKE,PDRDZ)
+FUNCTION M3_THR_W2TH(KKA,KKU,KKL,PREDR1,PD,PLM,PLEPS,PTKE,PDRDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
@@ -894,18 +1588,24 @@ FUNCTION M3_THR_W2TH(PREDR1,PD,PLM,PLEPS,PTKE,PDRDZ)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_THR_W2TH
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_W2TH',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
M3_THR_W2TH(:,:,:) = - 0.75*PLM*PLEPS/PTKE * XCTV &
- * MZF( (1.+PREDR1)*PDRDZ/PD )
+ * MZF((1.+PREDR1)*PDRDZ/PD, KKA, KKU, KKL)
!
M3_THR_W2TH(:,:,IKB-1)=M3_THR_W2TH(:,:,IKB)
M3_THR_W2TH(:,:,IKE+1)=M3_THR_W2TH(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_W2TH',1,ZHOOK_HANDLE)
END FUNCTION M3_THR_W2TH
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_W2TH_O_DDTDZ(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDRDZ,PETHETA)
+FUNCTION D_M3_THR_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDRDZ,PETHETA)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -918,19 +1618,25 @@ FUNCTION D_M3_THR_W2TH_O_DDTDZ(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDRDZ,P
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_W2TH_O_DDTDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2TH_O_DDTDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_THR_W2TH_O_DDTDZ(:,:,:) = - 0.75*PLM*PLEPS/PTKE * XCTV**2 &
- * MZF( -PETHETA*PBLL_O_E*(1.+PREDR1)*PDRDZ*(1.5+PREDTH1+PREDR1)/PD**2 )
+ * MZF(-PETHETA*PBLL_O_E*(1.+PREDR1)*PDRDZ*(1.5+PREDTH1+PREDR1)/PD**2, KKA, KKU, KKL)
!
D_M3_THR_W2TH_O_DDTDZ(:,:,IKB-1)=D_M3_THR_W2TH_O_DDTDZ(:,:,IKB)
D_M3_THR_W2TH_O_DDTDZ(:,:,IKE+1)=D_M3_THR_W2TH_O_DDTDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2TH_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_THR_W2TH_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_W2TH_O_DDRDZ(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE)
+FUNCTION D_M3_THR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -940,18 +1646,21 @@ FUNCTION D_M3_THR_W2TH_O_DDRDZ(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE)
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_W2TH_O_DDRDZ
INTEGER :: IKB, IKE
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2TH_O_DDRDZ',0,ZHOOK_HANDLE)
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
D_M3_THR_W2TH_O_DDRDZ(:,:,:) = - 0.75*PLM*PLEPS/PTKE * XCTV &
- * MZF( -(1.+PREDR1)*PREDR1*(1.5+PREDTH1+PREDR1)/PD**2 &
- +(1.+2.*PREDR1)/PD &
- )
+ * MZF(-(1.+PREDR1)*PREDR1*(1.5+PREDTH1+PREDR1)/PD**2 &
+ +(1.+2.*PREDR1)/PD, &
+ KKA, KKU, KKL)
!
D_M3_THR_W2TH_O_DDRDZ(:,:,IKB-1)=D_M3_THR_W2TH_O_DDRDZ(:,:,IKB)
D_M3_THR_W2TH_O_DDRDZ(:,:,IKE+1)=D_M3_THR_W2TH_O_DDRDZ(:,:,IKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2TH_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_THR_W2TH_O_DDRDZ
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
@@ -967,8 +1676,11 @@ FUNCTION PSI3(PREDR1,PREDTH1,PRED2R3,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV)
LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: PSI3
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:PSI3',0,ZHOOK_HANDLE)
PSI3 = PHI3(PREDR1,PREDTH1,PRED2R3,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:PSI3',1,ZHOOK_HANDLE)
END FUNCTION PSI3
!----------------------------------------------------------------------------
FUNCTION D_PSI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV)
@@ -981,10 +1693,13 @@ FUNCTION D_PSI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSE
LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: D_PSI3DRDZ_O_DDRDZ
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PSI3DRDZ_O_DDRDZ',0,ZHOOK_HANDLE)
D_PSI3DRDZ_O_DDRDZ = D_PHI3DTDZ_O_DDTDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV)
!
!C'est ok?!
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PSI3DRDZ_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_PSI3DRDZ_O_DDRDZ
!----------------------------------------------------------------------------
FUNCTION D_PSI3DTDZ_O_DDTDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV)
@@ -997,8 +1712,11 @@ FUNCTION D_PSI3DTDZ_O_DDTDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSE
LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: D_PSI3DTDZ_O_DDTDZ
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PSI3DTDZ_O_DDTDZ',0,ZHOOK_HANDLE)
D_PSI3DTDZ_O_DDTDZ = D_PHI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PSI3DTDZ_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_PSI3DTDZ_O_DDTDZ
!----------------------------------------------------------------------------
FUNCTION D_PSI3DRDZ2_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDRDZ,HTURBDIM,OUSERV)
@@ -1012,8 +1730,11 @@ FUNCTION D_PSI3DRDZ2_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDRDZ,HTURBD
LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: D_PSI3DRDZ2_O_DDRDZ
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PSI3DRDZ2_O_DDRDZ',0,ZHOOK_HANDLE)
D_PSI3DRDZ2_O_DDRDZ = D_PHI3DTDZ2_O_DDTDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDRDZ,HTURBDIM,OUSERV)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_PSI3DRDZ2_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_PSI3DRDZ2_O_DDRDZ
!----------------------------------------------------------------------------
FUNCTION M3_WR_WR2(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
@@ -1024,8 +1745,11 @@ FUNCTION M3_WR_WR2(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WR_WR2
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_WR2',0,ZHOOK_HANDLE)
M3_WR_WR2 = M3_WTH_WTH2(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_WR2',1,ZHOOK_HANDLE)
END FUNCTION M3_WR_WR2
!----------------------------------------------------------------------------
FUNCTION D_M3_WR_WR2_O_DDRDZ(PM3_WR_WR2,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
@@ -1037,11 +1761,17 @@ FUNCTION D_M3_WR_WR2_O_DDRDZ(PM3_WR_WR2,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WR_WR2_O_DDRDZ
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_WR2_O_DDRDZ',0,ZHOOK_HANDLE)
D_M3_WR_WR2_O_DDRDZ = D_M3_WTH_WTH2_O_DDTDZ(PM3_WR_WR2,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_WR2_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_WR_WR2_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WR_W2R(PREDR1,PREDTH1,PD,PKEFF,PTKE)
+FUNCTION M3_WR_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1049,11 +1779,17 @@ FUNCTION M3_WR_W2R(PREDR1,PREDTH1,PD,PKEFF,PTKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WR_W2R
!
-M3_WR_W2R = M3_WTH_W2TH(PREDR1,PREDTH1,PD,PKEFF,PTKE)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_W2R',0,ZHOOK_HANDLE)
+M3_WR_W2R = M3_WTH_W2TH(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_W2R',1,ZHOOK_HANDLE)
END FUNCTION M3_WR_W2R
!----------------------------------------------------------------------------
-FUNCTION D_M3_WR_W2R_O_DDRDZ(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PKEFF,PTKE)
+FUNCTION D_M3_WR_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PKEFF,PTKE)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1063,11 +1799,17 @@ FUNCTION D_M3_WR_W2R_O_DDRDZ(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PKEFF,PTKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WR_W2R_O_DDRDZ
!
-D_M3_WR_W2R_O_DDRDZ = D_M3_WTH_W2TH_O_DDTDZ(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PKEFF,PTKE)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_W2R_O_DDRDZ',0,ZHOOK_HANDLE)
+D_M3_WR_W2R_O_DDRDZ = D_M3_WTH_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PKEFF,PTKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_W2R_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_WR_W2R_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WR_W2TH(PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+FUNCTION M3_WR_W2TH(KKA,KKU,KKL,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
@@ -1076,11 +1818,17 @@ FUNCTION M3_WR_W2TH(PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WR_W2TH
!
-M3_WR_W2TH = M3_WTH_W2R(PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_W2TH',0,ZHOOK_HANDLE)
+M3_WR_W2TH = M3_WTH_W2R(KKA,KKU,KKL,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_W2TH',1,ZHOOK_HANDLE)
END FUNCTION M3_WR_W2TH
!----------------------------------------------------------------------------
-FUNCTION D_M3_WR_W2TH_O_DDRDZ(PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA)
+FUNCTION D_M3_WR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1090,11 +1838,17 @@ FUNCTION D_M3_WR_W2TH_O_DDRDZ(PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WR_W2TH_O_DDRDZ
!
-D_M3_WR_W2TH_O_DDRDZ = D_M3_WTH_W2R_O_DDTDZ(PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_W2TH_O_DDRDZ',0,ZHOOK_HANDLE)
+D_M3_WR_W2TH_O_DDRDZ = D_M3_WTH_W2R_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_W2TH_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_WR_W2TH_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WR_WTH2(PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ)
+FUNCTION M3_WR_WTH2(KKA,KKU,KKL,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
@@ -1106,11 +1860,17 @@ FUNCTION M3_WR_WTH2(PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WR_WTH2
!
-M3_WR_WTH2 = M3_WTH_WR2(PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_WTH2',0,ZHOOK_HANDLE)
+M3_WR_WTH2 = M3_WTH_WR2(KKA,KKU,KKL,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_WTH2',1,ZHOOK_HANDLE)
END FUNCTION M3_WR_WTH2
!----------------------------------------------------------------------------
-FUNCTION D_M3_WR_WTH2_O_DDRDZ(PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA)
+FUNCTION D_M3_WR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1123,11 +1883,17 @@ FUNCTION D_M3_WR_WTH2_O_DDRDZ(PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PB
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WR_WTH2_O_DDRDZ
!
-D_M3_WR_WTH2_O_DDRDZ = D_M3_WTH_WR2_O_DDTDZ(PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_WTH2_O_DDRDZ',0,ZHOOK_HANDLE)
+D_M3_WR_WTH2_O_DDRDZ = D_M3_WTH_WR2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_WTH2_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_WR_WTH2_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_WR_WTHR(PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETHETA)
+FUNCTION M3_WR_WTHR(KKA,KKU,KKL,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETHETA)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
@@ -1138,11 +1904,17 @@ FUNCTION M3_WR_WTHR(PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETHETA)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WR_WTHR
!
-M3_WR_WTHR = M3_WTH_WTHR(PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETHETA)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_WTHR',0,ZHOOK_HANDLE)
+M3_WR_WTHR = M3_WTH_WTHR(KKA,KKU,KKL,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETHETA)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_WR_WTHR',1,ZHOOK_HANDLE)
END FUNCTION M3_WR_WTHR
!----------------------------------------------------------------------------
-FUNCTION D_M3_WR_WTHR_O_DDRDZ(PM3_WR_WTHR,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
+FUNCTION D_M3_WR_WTHR_O_DDRDZ(KKA,KKU,KKL,PM3_WR_WTHR,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PM3_WR_WTHR
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
@@ -1151,11 +1923,17 @@ FUNCTION D_M3_WR_WTHR_O_DDRDZ(PM3_WR_WTHR,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WR_WTHR_O_DDRDZ
!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_WTHR_O_DDRDZ',0,ZHOOK_HANDLE)
D_M3_WR_WTHR_O_DDRDZ = D_M3_WTH_WTHR_O_DDTDZ(PM3_WR_WTHR,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_WR_WTHR_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_WR_WTHR_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_R2_W2R(PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE)
+FUNCTION M3_R2_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1165,11 +1943,17 @@ FUNCTION M3_R2_W2R(PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_R2_W2R
!
-M3_R2_W2R = M3_TH2_W2TH(PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_W2R',0,ZHOOK_HANDLE)
+M3_R2_W2R = M3_TH2_W2TH(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_W2R',1,ZHOOK_HANDLE)
END FUNCTION M3_R2_W2R
!----------------------------------------------------------------------------
-FUNCTION D_M3_R2_W2R_O_DDRDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV)
+FUNCTION D_M3_R2_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1179,11 +1963,17 @@ FUNCTION D_M3_R2_W2R_O_DDRDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV)
LOGICAL, INTENT(IN) :: OUSERV
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_R2_W2R_O_DDRDZ
!
-D_M3_R2_W2R_O_DDRDZ = D_M3_TH2_W2TH_O_DDTDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_W2R_O_DDRDZ',0,ZHOOK_HANDLE)
+D_M3_R2_W2R_O_DDRDZ = D_M3_TH2_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_W2R_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_R2_W2R_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_R2_WR2(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE)
+FUNCTION M3_R2_WR2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1191,11 +1981,17 @@ FUNCTION M3_R2_WR2(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_R2_WR2
!
-M3_R2_WR2 = M3_TH2_WTH2(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_WR2',0,ZHOOK_HANDLE)
+M3_R2_WR2 = M3_TH2_WTH2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_WR2',1,ZHOOK_HANDLE)
END FUNCTION M3_R2_WR2
!----------------------------------------------------------------------------
-FUNCTION D_M3_R2_WR2_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+FUNCTION D_M3_R2_WR2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1205,11 +2001,17 @@ FUNCTION D_M3_R2_WR2_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_R2_WR2_O_DDRDZ
!
-D_M3_R2_WR2_O_DDRDZ = D_M3_TH2_WTH2_O_DDTDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_WR2_O_DDRDZ',0,ZHOOK_HANDLE)
+D_M3_R2_WR2_O_DDRDZ = D_M3_TH2_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_WR2_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_R2_WR2_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_R2_W2TH(PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+FUNCTION M3_R2_W2TH(KKA,KKU,KKL,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
@@ -1219,11 +2021,17 @@ FUNCTION M3_R2_W2TH(PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_R2_W2TH
!
-M3_R2_W2TH = M3_TH2_W2R(PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_W2TH',0,ZHOOK_HANDLE)
+M3_R2_W2TH = M3_TH2_W2R(KKA,KKU,KKL,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_W2TH',1,ZHOOK_HANDLE)
END FUNCTION M3_R2_W2TH
!----------------------------------------------------------------------------
-FUNCTION D_M3_R2_W2TH_O_DDRDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+FUNCTION D_M3_R2_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1235,11 +2043,17 @@ FUNCTION D_M3_R2_W2TH_O_DDRDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_R2_W2TH_O_DDRDZ
!
-D_M3_R2_W2TH_O_DDRDZ = D_M3_TH2_W2R_O_DDTDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_W2TH_O_DDRDZ',0,ZHOOK_HANDLE)
+D_M3_R2_W2TH_O_DDRDZ = D_M3_TH2_W2R_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_W2TH_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_R2_W2TH_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_R2_WTH2(PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+FUNCTION M3_R2_WTH2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
@@ -1248,11 +2062,17 @@ FUNCTION M3_R2_WTH2(PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_R2_WTH2
!
-M3_R2_WTH2 = M3_TH2_WR2(PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_WTH2',0,ZHOOK_HANDLE)
+M3_R2_WTH2 = M3_TH2_WR2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_WTH2',1,ZHOOK_HANDLE)
END FUNCTION M3_R2_WTH2
!----------------------------------------------------------------------------
-FUNCTION D_M3_R2_WTH2_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+FUNCTION D_M3_R2_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1263,11 +2083,17 @@ FUNCTION D_M3_R2_WTH2_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_R2_WTH2_O_DDRDZ
!
-D_M3_R2_WTH2_O_DDRDZ = D_M3_TH2_WR2_O_DDTDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_WTH2_O_DDRDZ',0,ZHOOK_HANDLE)
+D_M3_R2_WTH2_O_DDRDZ = D_M3_TH2_WR2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_WTH2_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_R2_WTH2_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_R2_WTHR(PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+FUNCTION M3_R2_WTHR(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
@@ -1277,11 +2103,17 @@ FUNCTION M3_R2_WTHR(PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_R2_WTHR
!
-M3_R2_WTHR = M3_TH2_WTHR(PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_WTHR',0,ZHOOK_HANDLE)
+M3_R2_WTHR = M3_TH2_WTHR(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_R2_WTHR',1,ZHOOK_HANDLE)
END FUNCTION M3_R2_WTHR
!----------------------------------------------------------------------------
-FUNCTION D_M3_R2_WTHR_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+FUNCTION D_M3_R2_WTHR_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1292,11 +2124,17 @@ FUNCTION D_M3_R2_WTHR_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_R2_WTHR_O_DDRDZ
!
-D_M3_R2_WTHR_O_DDRDZ = D_M3_TH2_WTHR_O_DDTDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_WTHR_O_DDRDZ',0,ZHOOK_HANDLE)
+D_M3_R2_WTHR_O_DDRDZ = D_M3_TH2_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_R2_WTHR_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_R2_WTHR_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_WTHR_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+FUNCTION D_M3_THR_WTHR_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1306,11 +2144,17 @@ FUNCTION D_M3_THR_WTHR_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_WTHR_O_DDRDZ
!
-D_M3_THR_WTHR_O_DDRDZ = D_M3_THR_WTHR_O_DDTDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTHR_O_DDRDZ',0,ZHOOK_HANDLE)
+D_M3_THR_WTHR_O_DDRDZ = D_M3_THR_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WTHR_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_THR_WTHR_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION M3_THR_WR2(PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+FUNCTION M3_THR_WR2(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
@@ -1320,11 +2164,17 @@ FUNCTION M3_THR_WR2(PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_THR_WR2
!
-M3_THR_WR2 = M3_THR_WTH2(PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_WR2',0,ZHOOK_HANDLE)
+M3_THR_WR2 = M3_THR_WTH2(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_WR2',1,ZHOOK_HANDLE)
END FUNCTION M3_THR_WR2
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_WR2_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+FUNCTION D_M3_THR_WR2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1335,11 +2185,17 @@ FUNCTION D_M3_THR_WR2_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_WR2_O_DDRDZ
!
-D_M3_THR_WR2_O_DDRDZ = D_M3_THR_WTH2_O_DDTDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WR2_O_DDRDZ',0,ZHOOK_HANDLE)
+D_M3_THR_WR2_O_DDRDZ = D_M3_THR_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WR2_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_THR_WR2_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_WR2_O_DDTDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+FUNCTION D_M3_THR_WR2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1349,11 +2205,17 @@ FUNCTION D_M3_THR_WR2_O_DDTDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_WR2_O_DDTDZ
!
-D_M3_THR_WR2_O_DDTDZ = D_M3_THR_WTH2_O_DDRDZ(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WR2_O_DDTDZ',0,ZHOOK_HANDLE)
+D_M3_THR_WR2_O_DDTDZ = D_M3_THR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_WR2_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_THR_WR2_O_DDTDZ
!----------------------------------------------------------------------------
-FUNCTION M3_THR_W2R(PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ)
+FUNCTION M3_THR_W2R(KKA,KKU,KKL,PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
@@ -1362,11 +2224,17 @@ FUNCTION M3_THR_W2R(PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_THR_W2R
!
-M3_THR_W2R = M3_THR_W2TH(PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_W2R',0,ZHOOK_HANDLE)
+M3_THR_W2R = M3_THR_W2TH(KKA,KKU,KKL,PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:M3_THR_W2R',1,ZHOOK_HANDLE)
END FUNCTION M3_THR_W2R
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_W2R_O_DDRDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDTDZ,PEMOIST)
+FUNCTION D_M3_THR_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDTDZ,PEMOIST)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1378,11 +2246,17 @@ FUNCTION D_M3_THR_W2R_O_DDRDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDTDZ,PE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_W2R_O_DDRDZ
!
-D_M3_THR_W2R_O_DDRDZ = D_M3_THR_W2TH_O_DDTDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDTDZ,PEMOIST)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2R_O_DDRDZ',0,ZHOOK_HANDLE)
+D_M3_THR_W2R_O_DDRDZ = D_M3_THR_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDTDZ,PEMOIST)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2R_O_DDRDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_THR_W2R_O_DDRDZ
!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_W2R_O_DDTDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE)
+FUNCTION D_M3_THR_W2R_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE)
+ INTEGER, INTENT(IN) :: KKA
+ INTEGER, INTENT(IN) :: KKU
+ INTEGER, INTENT(IN) :: KKL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
@@ -1391,9 +2265,13 @@ FUNCTION D_M3_THR_W2R_O_DDTDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_W2R_O_DDTDZ
!
-D_M3_THR_W2R_O_DDTDZ = D_M3_THR_W2TH_O_DDRDZ(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2R_O_DDTDZ',0,ZHOOK_HANDLE)
+D_M3_THR_W2R_O_DDTDZ = D_M3_THR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE)
!
+IF (LHOOK) CALL DR_HOOK('MODE_PRANDTL:D_M3_THR_W2R_O_DDTDZ',1,ZHOOK_HANDLE)
END FUNCTION D_M3_THR_W2R_O_DDTDZ
!----------------------------------------------------------------------------
!
END MODULE MODE_PRANDTL
+
diff --git a/src/mesonh/turb/mode_sbl.f90 b/src/mesonh/turb/mode_sbl.f90
deleted file mode 100644
index 1c5e1da7f4600a7d6fe0a5a228b4708bab55c526..0000000000000000000000000000000000000000
--- a/src/mesonh/turb/mode_sbl.f90
+++ /dev/null
@@ -1,457 +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 mode 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-! ###############
- MODULE MODE_SBL
-! ###############
-!
-!!**** *MODE_SBL * - contains Surface Boundary Layer characteristics functions
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Businger et al 1971, Wyngaard and Cote 1974
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 13/10/99
-!! V. Masson 06/11/02 optimization and add Businger fonction for TKE
-!! V. Masson 01/01/03 use PAULSON_PSIM function
-!-----------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-!
-!
-INTERFACE BUSINGER_PHIM
- MODULE PROCEDURE BUSINGER_PHIM_0D
- MODULE PROCEDURE BUSINGER_PHIM_1D
- MODULE PROCEDURE BUSINGER_PHIM_2D
- MODULE PROCEDURE BUSINGER_PHIM_3D
-END INTERFACE
-INTERFACE BUSINGER_PHIH
- MODULE PROCEDURE BUSINGER_PHIH_0D
- MODULE PROCEDURE BUSINGER_PHIH_1D
- MODULE PROCEDURE BUSINGER_PHIH_2D
- MODULE PROCEDURE BUSINGER_PHIH_3D
-END INTERFACE
-INTERFACE BUSINGER_PHIE
- MODULE PROCEDURE BUSINGER_PHIE_3D
-END INTERFACE
-INTERFACE PAULSON_PSIM
- MODULE PROCEDURE PAULSON_PSIM_0D
- MODULE PROCEDURE PAULSON_PSIM_1D
- MODULE PROCEDURE PAULSON_PSIM_2D
-END INTERFACE
-INTERFACE LMO
- MODULE PROCEDURE LMO_0D
- MODULE PROCEDURE LMO_1D
- MODULE PROCEDURE LMO_2D
-END INTERFACE
-INTERFACE USTAR
- MODULE PROCEDURE USTAR_0D
- MODULE PROCEDURE USTAR_1D
- MODULE PROCEDURE USTAR_2D
-END INTERFACE
-!
-!-------------------------------------------------------------------------------
-CONTAINS
-!-------------------------------------------------------------------------------
-!
-FUNCTION BUSINGER_PHIM_3D(PZ_O_LMO)
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PZ_O_LMO
- REAL, DIMENSION(SIZE(PZ_O_LMO,1), &
- SIZE(PZ_O_LMO,2),SIZE(PZ_O_LMO,3)) :: BUSINGER_PHIM_3D
-!
- WHERE ( PZ_O_LMO(:,:,:) < 0. )
- BUSINGER_PHIM_3D(:,:,:) = (1.-15.*PZ_O_LMO)**(-0.25)
- ELSEWHERE
- BUSINGER_PHIM_3D(:,:,:) = 1. + 4.7 * PZ_O_LMO
- END WHERE
-END FUNCTION BUSINGER_PHIM_3D
-!
-!-------------------------------------------------------------------------------
-!
-FUNCTION BUSINGER_PHIM_2D(PZ_O_LMO)
- REAL, DIMENSION(:,:), INTENT(IN) :: PZ_O_LMO
- REAL, DIMENSION(SIZE(PZ_O_LMO,1),SIZE(PZ_O_LMO,2)) :: BUSINGER_PHIM_2D
-!
- WHERE ( PZ_O_LMO(:,:) < 0. )
- BUSINGER_PHIM_2D(:,:) = (1.-15.*PZ_O_LMO)**(-0.25)
- ELSEWHERE
- BUSINGER_PHIM_2D(:,:) = 1. + 4.7 * PZ_O_LMO
- END WHERE
-END FUNCTION BUSINGER_PHIM_2D
-!
-!-------------------------------------------------------------------------------
-!
-FUNCTION BUSINGER_PHIM_1D(PZ_O_LMO)
- REAL, DIMENSION(:), INTENT(IN) :: PZ_O_LMO
- REAL, DIMENSION(SIZE(PZ_O_LMO)) :: BUSINGER_PHIM_1D
-!
- WHERE ( PZ_O_LMO(:) < 0. )
- BUSINGER_PHIM_1D(:) = (1.-15.*PZ_O_LMO)**(-0.25)
- ELSEWHERE
- BUSINGER_PHIM_1D(:) = 1. + 4.7 * PZ_O_LMO
- END WHERE
-END FUNCTION BUSINGER_PHIM_1D
-!
-!-------------------------------------------------------------------------------
-!
-FUNCTION BUSINGER_PHIM_0D(PZ_O_LMO)
- REAL, INTENT(IN) :: PZ_O_LMO
- REAL :: BUSINGER_PHIM_0D
-!
- IF ( PZ_O_LMO < 0. ) THEN
- BUSINGER_PHIM_0D = (1.-15.*PZ_O_LMO)**(-0.25)
- ELSE
- BUSINGER_PHIM_0D = 1. + 4.7 * PZ_O_LMO
- END IF
-END FUNCTION BUSINGER_PHIM_0D
-!
-!-------------------------------------------------------------------------------
-!-------------------------------------------------------------------------------
-!
-FUNCTION BUSINGER_PHIH_3D(PZ_O_LMO)
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PZ_O_LMO
- REAL, DIMENSION(SIZE(PZ_O_LMO,1), &
- SIZE(PZ_O_LMO,2),SIZE(PZ_O_LMO,3)) :: BUSINGER_PHIH_3D
-!
- WHERE ( PZ_O_LMO(:,:,:) < 0. )
- BUSINGER_PHIH_3D(:,:,:) = 0.74 * (1.-9.*PZ_O_LMO)**(-0.5)
- ELSEWHERE
- BUSINGER_PHIH_3D(:,:,:) = 0.74 + 4.7 * PZ_O_LMO
- END WHERE
-END FUNCTION BUSINGER_PHIH_3D
-!
-!-------------------------------------------------------------------------------
-!
-FUNCTION BUSINGER_PHIH_2D(PZ_O_LMO)
- REAL, DIMENSION(:,:), INTENT(IN) :: PZ_O_LMO
- REAL, DIMENSION(SIZE(PZ_O_LMO,1),SIZE(PZ_O_LMO,2)) :: BUSINGER_PHIH_2D
-!
- WHERE ( PZ_O_LMO(:,:) < 0. )
- BUSINGER_PHIH_2D(:,:) = 0.74 * (1.-9.*PZ_O_LMO)**(-0.5)
- ELSEWHERE
- BUSINGER_PHIH_2D(:,:) = 0.74 + 4.7 * PZ_O_LMO
- END WHERE
-END FUNCTION BUSINGER_PHIH_2D
-!
-!-------------------------------------------------------------------------------
-!
-FUNCTION BUSINGER_PHIH_1D(PZ_O_LMO)
- REAL, DIMENSION(:), INTENT(IN) :: PZ_O_LMO
- REAL, DIMENSION(SIZE(PZ_O_LMO)) :: BUSINGER_PHIH_1D
-!
- WHERE ( PZ_O_LMO(:) < 0. )
- BUSINGER_PHIH_1D(:) = 0.74 * (1.-9.*PZ_O_LMO)**(-0.5)
- ELSEWHERE
- BUSINGER_PHIH_1D(:) = 0.74 + 4.7 * PZ_O_LMO
- END WHERE
-END FUNCTION BUSINGER_PHIH_1D
-!
-!-------------------------------------------------------------------------------
-!
-FUNCTION BUSINGER_PHIH_0D(PZ_O_LMO)
- REAL, INTENT(IN) :: PZ_O_LMO
- REAL :: BUSINGER_PHIH_0D
-!
- IF ( PZ_O_LMO < 0. ) THEN
- BUSINGER_PHIH_0D = 0.74 * (1.-9.*PZ_O_LMO)**(-0.5)
- ELSE
- BUSINGER_PHIH_0D = 0.74 + 4.7 * PZ_O_LMO
- END IF
-END FUNCTION BUSINGER_PHIH_0D
-!
-!-------------------------------------------------------------------------------
-!-------------------------------------------------------------------------------
-!
-FUNCTION BUSINGER_PHIE_3D(PZ_O_LMO)
- USE MODD_CTURB
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PZ_O_LMO
- REAL, DIMENSION(SIZE(PZ_O_LMO,1), &
- SIZE(PZ_O_LMO,2),SIZE(PZ_O_LMO,3)) :: BUSINGER_PHIE_3D
-!
- WHERE ( PZ_O_LMO(:,:,:) < 0. )
- BUSINGER_PHIE_3D(:,:,:) = (1.+(-PZ_O_LMO)**(2./3.)/XALPSBL) &
- * (1.-15.*PZ_O_LMO)**(0.5)
- ELSEWHERE
- BUSINGER_PHIE_3D(:,:,:) = 1./(1. + 4.7 * PZ_O_LMO)**2
- END WHERE
-END FUNCTION BUSINGER_PHIE_3D
-!
-!-------------------------------------------------------------------------------
-!-------------------------------------------------------------------------------
-!
-FUNCTION PAULSON_PSIM_2D(PZ_O_LMO)
- USE MODD_CST
- REAL, DIMENSION(:,:), INTENT(IN) :: PZ_O_LMO
- REAL, DIMENSION(SIZE(PZ_O_LMO,1),SIZE(PZ_O_LMO,2)) :: PAULSON_PSIM_2D
-!
- REAL, DIMENSION(SIZE(PZ_O_LMO,1),SIZE(PZ_O_LMO,2)) :: ZX
-
- ZX=1.
- WHERE ( PZ_O_LMO(:,:) < 0. )
- ZX=(1.-15.*PZ_O_LMO)**(0.25)
- PAULSON_PSIM_2D(:,:) = LOG( (1.+ZX**2)*(1+ZX)**2/8. ) - 2.*ATAN(ZX) + XPI/2.
- ELSEWHERE
- PAULSON_PSIM_2D(:,:) = - 4.7 * PZ_O_LMO
- END WHERE
-END FUNCTION PAULSON_PSIM_2D
-!
-!-------------------------------------------------------------------------------
-!
-FUNCTION PAULSON_PSIM_1D(PZ_O_LMO)
- USE MODD_CST
- REAL, DIMENSION(:), INTENT(IN) :: PZ_O_LMO
- REAL, DIMENSION(SIZE(PZ_O_LMO,1)) :: PAULSON_PSIM_1D
-!
- REAL, DIMENSION(SIZE(PZ_O_LMO,1)) :: ZX
-
- ZX=1.
- WHERE ( PZ_O_LMO(:) < 0. )
- ZX=(1.-15.*PZ_O_LMO)**(0.25)
- PAULSON_PSIM_1D(:) = LOG( (1.+ZX**2)*(1+ZX)**2/8. ) - 2.*ATAN(ZX) + XPI/2.
- ELSEWHERE
- PAULSON_PSIM_1D(:) = - 4.7 * PZ_O_LMO
- END WHERE
-END FUNCTION PAULSON_PSIM_1D
-!
-!-------------------------------------------------------------------------------
-!
-FUNCTION PAULSON_PSIM_0D(PZ_O_LMO)
- USE MODD_CST
- REAL, INTENT(IN) :: PZ_O_LMO
- REAL :: PAULSON_PSIM_0D
-!
- REAL :: ZX
-
- ZX=1.
- IF ( PZ_O_LMO < 0. ) THEN
- ZX=(1.-15.*PZ_O_LMO)**(0.25)
- PAULSON_PSIM_0D = LOG( (1.+ZX**2)*(1+ZX)**2/8. ) - 2.*ATAN(ZX) + XPI/2.
- ELSE
- PAULSON_PSIM_0D = - 4.7 * PZ_O_LMO
- END IF
-END FUNCTION PAULSON_PSIM_0D
-!
-!-------------------------------------------------------------------------------
-!-------------------------------------------------------------------------------
-!
-FUNCTION LMO_2D(PUSTAR,PTHETA,PRV,PSFTH,PSFRV)
- USE MODD_CST
- USE MODD_PARAMETERS
- REAL, DIMENSION(:,:), INTENT(IN) :: PUSTAR
- REAL, DIMENSION(:,:), INTENT(IN) :: PTHETA
- REAL, DIMENSION(:,:), INTENT(IN) :: PRV
- REAL, DIMENSION(:,:), INTENT(IN) :: PSFTH
- REAL, DIMENSION(:,:), INTENT(IN) :: PSFRV
- REAL, DIMENSION(SIZE(PUSTAR,1),SIZE(PUSTAR,2)) :: LMO_2D
-!
- REAL, DIMENSION(SIZE(PUSTAR,1),SIZE(PUSTAR,2)) :: ZTHETAV
- REAL, DIMENSION(SIZE(PUSTAR,1),SIZE(PUSTAR,2)) :: ZQ0
- REAL :: ZEPS
-!
-!
- ZEPS=(XRV-XRD)/XRD
- ZTHETAV(:,:) = PTHETA(:,:) * ( 1. +ZEPS * PRV(:,:))
- ZQ0 (:,:) = PSFTH(:,:) + ZTHETAV(:,:) * ZEPS * PSFRV(:,:)
-!
- LMO_2D(:,:) = XUNDEF
- WHERE ( ZQ0(:,:) /=0. ) &
- LMO_2D(:,:) = - MAX(PUSTAR(:,:),1.E-6)**3 &
- / ( XKARMAN * XG / ZTHETAV(:,:) *ZQ0(:,:) )
-
-END FUNCTION LMO_2D
-!
-!-------------------------------------------------------------------------------
-!
-FUNCTION LMO_1D(PUSTAR,PTHETA,PRV,PSFTH,PSFRV)
- USE MODD_CST
- USE MODD_PARAMETERS
- REAL, DIMENSION(:), INTENT(IN) :: PUSTAR
- REAL, DIMENSION(:), INTENT(IN) :: PTHETA
- REAL, DIMENSION(:), INTENT(IN) :: PRV
- REAL, DIMENSION(:), INTENT(IN) :: PSFTH
- REAL, DIMENSION(:), INTENT(IN) :: PSFRV
- REAL, DIMENSION(SIZE(PUSTAR)) :: LMO_1D
-!
- REAL, DIMENSION(SIZE(PUSTAR)) :: ZTHETAV
- REAL :: ZEPS
-!
-!
- ZEPS=(XRV-XRD)/XRD
-!
- ZTHETAV(:) = PTHETA(:) * ( 1. +ZEPS * PRV(:))
-!
- LMO_1D(:) = XUNDEF
- WHERE ( PSFTH(:)/ZTHETAV(:)+ZEPS*PSFRV(:)/=0. ) &
- LMO_1D(:) = - MAX(PUSTAR(:),1.E-6)**3 &
- / ( XKARMAN * ( XG / ZTHETAV(:) * PSFTH(:) &
- + XG * ZEPS * PSFRV(:) ) )
-END FUNCTION LMO_1D
-!
-!-------------------------------------------------------------------------------
-!
-FUNCTION LMO_0D(PUSTAR,PTHETA,PRV,PSFTH,PSFRV)
- USE MODD_CST
- USE MODD_PARAMETERS
- REAL, INTENT(IN) :: PUSTAR
- REAL, INTENT(IN) :: PTHETA
- REAL, INTENT(IN) :: PRV
- REAL, INTENT(IN) :: PSFTH
- REAL, INTENT(IN) :: PSFRV
- REAL :: LMO_0D
-!
- REAL :: ZTHETAV
- REAL :: ZEPS
-!
-!
- ZEPS=(XRV-XRD)/XRD
-!
-!
- ZTHETAV = PTHETA * ( 1. +ZEPS * PRV)
-!
- LMO_0D = XUNDEF
- IF ( PSFTH/ZTHETAV+ZEPS*PSFRV/=0. ) &
- LMO_0D = - MAX(PUSTAR,1.E-6)**3 &
- / ( XKARMAN * ( XG / ZTHETAV * PSFTH &
- + XG * ZEPS * PSFRV ) )
-END FUNCTION LMO_0D
-!
-!-------------------------------------------------------------------------------
-!-------------------------------------------------------------------------------
-!
-FUNCTION USTAR_2D(PU,PV,PZ,PZ0,PLMO)
- USE MODD_CST
- USE MODD_PARAMETERS
- REAL, DIMENSION(:,:), INTENT(IN) :: PU
- REAL, DIMENSION(:,:), INTENT(IN) :: PV
- REAL, DIMENSION(:,:), INTENT(IN) :: PZ
- REAL, DIMENSION(:,:), INTENT(IN) :: PZ0
- REAL, DIMENSION(:,:), INTENT(IN) :: PLMO
- REAL, DIMENSION(SIZE(PU,1),SIZE(PU,2)) :: USTAR_2D
-
- REAL, DIMENSION(SIZE(PU,1),SIZE(PU,2)) :: ZZ_O_LMO
- REAL, DIMENSION(SIZE(PU,1),SIZE(PU,2)) :: ZZ0_O_LMO
-!
-!* purely unstable case
- USTAR_2D(:,:) = 0.
- ZZ_O_LMO(:,:) = XUNDEF
- ZZ0_O_LMO(:,:) = XUNDEF
-!
-!* general case
- WHERE(ABS(PLMO) > 1.E-20 .AND. PLMO/=XUNDEF)
- ZZ_O_LMO = PZ(:,:) / PLMO(:,:)
- ZZ0_O_LMO = PZ0(:,:) / PLMO(:,:)
- USTAR_2D(:,:) = SQRT( PU(:,:)**2+PV(:,:)**2 ) &
- * XKARMAN / ( LOG(PZ(:,:)/PZ0(:,:)) &
- - PAULSON_PSIM(ZZ_O_LMO(:,:)) &
- + PAULSON_PSIM(ZZ0_O_LMO(:,:)) )
- END WHERE
-!
-!* purely neutral case
- WHERE(PLMO==XUNDEF)
- ZZ_O_LMO = 0.
- USTAR_2D(:,:) = SQRT( PU(:,:)**2+PV(:,:)**2 ) &
- * XKARMAN / LOG(PZ(:,:)/PZ0(:,:))
- END WHERE
-!
-END FUNCTION USTAR_2D
-!
-!-------------------------------------------------------------------------------
-!
-FUNCTION USTAR_1D(PU,PV,PZ,PZ0,PLMO)
- USE MODD_CST
- USE MODD_PARAMETERS
- REAL, DIMENSION(:), INTENT(IN) :: PU
- REAL, DIMENSION(:), INTENT(IN) :: PV
- REAL, DIMENSION(:), INTENT(IN) :: PZ
- REAL, DIMENSION(:), INTENT(IN) :: PZ0
- REAL, DIMENSION(:), INTENT(IN) :: PLMO
- REAL, DIMENSION(SIZE(PU)) :: USTAR_1D
-
- REAL, DIMENSION(SIZE(PU)) :: ZZ_O_LMO
- REAL, DIMENSION(SIZE(PU)) :: ZZ0_O_LMO
-!
-!* purely unstable case
- USTAR_1D(:) = 0.
- ZZ_O_LMO(:) = XUNDEF
- ZZ0_O_LMO(:) = XUNDEF
-!
-!* general case
- WHERE(ABS(PLMO) > 1.E-20 .AND. PLMO/=XUNDEF)
- ZZ_O_LMO = PZ(:) / PLMO(:)
- ZZ0_O_LMO = PZ0(:) / PLMO(:)
- USTAR_1D(:) = SQRT( PU(:)**2+PV(:)**2 ) &
- * XKARMAN / ( LOG(PZ(:)/PZ0(:)) &
- - PAULSON_PSIM(ZZ_O_LMO(:)) &
- + PAULSON_PSIM(ZZ0_O_LMO(:)) )
- END WHERE
-!
-!* purely neutral case
- WHERE(PLMO==XUNDEF)
- ZZ_O_LMO = 0.
- USTAR_1D(:) = SQRT( PU(:)**2+PV(:)**2 ) &
- * XKARMAN / LOG(PZ(:)/PZ0(:))
- END WHERE
-!
-END FUNCTION USTAR_1D
-!
-!-------------------------------------------------------------------------------
-!
-FUNCTION USTAR_0D(PU,PV,PZ,PZ0,PLMO)
- USE MODD_CST
- USE MODD_PARAMETERS
- REAL, INTENT(IN) :: PU
- REAL, INTENT(IN) :: PV
- REAL, INTENT(IN) :: PZ
- REAL, INTENT(IN) :: PZ0
- REAL, INTENT(IN) :: PLMO
- REAL :: USTAR_0D
-!
-!* purely unstable case
- USTAR_0D = 0.
-!
-!* general case
- IF ( ABS(PLMO) >= 1.E-20 .AND. PLMO/=XUNDEF) &
- USTAR_0D = SQRT( PU**2+PV**2 ) &
- * XKARMAN / ( LOG(PZ/PZ0) &
- - PAULSON_PSIM(PZ/PLMO) &
- + PAULSON_PSIM(PZ0/PLMO))
-!
-!* purely neutral case
- IF (PLMO==XUNDEF) &
- USTAR_0D = SQRT( PU**2+PV**2 ) &
- * XKARMAN / LOG(PZ/PZ0)
-
-END FUNCTION USTAR_0D
-!
-!-------------------------------------------------------------------------------
-!
-END MODULE MODE_SBL
diff --git a/src/mesonh/turb/modn_turb.f90 b/src/mesonh/turb/modn_turb.f90
deleted file mode 100644
index a7c794abd940f90b7eb71a1aa84b5e0158ce2531..0000000000000000000000000000000000000000
--- a/src/mesonh/turb/modn_turb.f90
+++ /dev/null
@@ -1,47 +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 modn 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-! ###################
- MODULE MODN_TURB
-! ###################
-!
-!!**** *MODN_TURB* - declaration of namelist NAM_TURB
-!!
-!! PURPOSE
-!! -------
-! The purpose of this module is to specify the namelist NAM_TURB
-! which concern the parameters of the turbulence scheme for all models
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original November 2005
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CTURB
-!
-IMPLICIT NONE
-!
-NAMELIST/NAM_TURB/XPHI_LIM, XSBL_O_BL, XFTOP_O_FSURF
-!
-END MODULE MODN_TURB
diff --git a/src/mesonh/turb/modn_turb_cloud.f90 b/src/mesonh/turb/modn_turb_cloud.f90
deleted file mode 100644
index f4929a58cadf6d1dae0e84f8e0d9a2ff542af502..0000000000000000000000000000000000000000
--- a/src/mesonh/turb/modn_turb_cloud.f90
+++ /dev/null
@@ -1,49 +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 modn 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-! ##################
- MODULE MODN_TURB_CLOUD
-! ##################
-!
-!!**** *MODN_TURB_CLOUD* - declaration of namelist NAM_TURB_CLOUD
-!!
-!! PURPOSE
-!! -------
-! The purpose of this module is to specify the namelist NAM_TURB_CLOUD
-! which concern the parameters of the cloud mixing length for a given model.
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_TURB_CLOUD
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! M. Tomasini *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original September, 2004
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_TURB_CLOUD
-!
-IMPLICIT NONE
-!
-NAMELIST/NAM_TURB_CLOUD/NMODEL_CLOUD, CTURBLEN_CLOUD, &
- XCOEF_AMPL_SAT, XCEI_MIN, XCEI_MAX
-!
-END MODULE MODN_TURB_CLOUD
diff --git a/src/mesonh/turb/modn_turbn.f90 b/src/mesonh/turb/modn_turbn.f90
deleted file mode 100644
index 3e777d2da81815862ba89818f858227e14421550..0000000000000000000000000000000000000000
--- a/src/mesonh/turb/modn_turbn.f90
+++ /dev/null
@@ -1,167 +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 MODN_TURB_n
-! ###################
-!
-!!**** *MODN_TURB$n* - declaration of namelist NAM_TURBn
-!!
-!! PURPOSE
-!! -------
-! The purpose of this module is to specify the namelist NAM_TURBn
-! which concern the parameters of the turbulence scheme for one nested
-! model.
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_TURB$n : contains declaration of turbulence scheme
-!! variables entering by a namelist
-!!
-!! XIMPL,CTURBLEN,CTURBDIM,LTURB_FLX
-!! LTURB_DIAG,LSUBG_COND,LTGT_FLX
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of documentation of Meso-NH (module MODD_TURBn)
-!!
-!! AUTHOR
-!! ------
-!! J. Cuxart and J. Stein * I.N.M. and Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original January 9, 1995
-!! J.Cuxart February 15, 1995 add the switches for diagnostic storages
-!! J. Stein June 14, 1995 add the subgrid condensation switch
-!! J. Stein October, 1999 add the tangential fluxes switch
-!! M. Tomasini Jul 05, 2001 add the subgrid autoconversion
-!! P. Bechtold Feb 11, 2002 add switch for Sigma_s computation
-!! P. Jabouille Apr 4, 2002 add switch for Sigma_s convection
-!! V. Masson Nov 13 2002 add switch for SBL lengths
-!! D. Ricard May, 2021 add switch for Leonard Terms
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_TURB_n, ONLY: &
- XIMPL_n => XIMPL, &
- XKEMIN_n => XKEMIN, &
- XCEDIS_n => XCEDIS, &
- XCADAP_n => XCADAP, &
- CTURBLEN_n => CTURBLEN, &
- CTURBDIM_n => CTURBDIM, &
- LTURB_FLX_n => LTURB_FLX, &
- LTURB_DIAG_n => LTURB_DIAG, &
- LSUBG_COND_n => LSUBG_COND, &
- LSIGMAS_n => LSIGMAS, &
- LSIG_CONV_n => LSIG_CONV, &
- LRMC01_n => LRMC01, &
- CTOM_n => CTOM, &
- CSUBG_AUCV_n => CSUBG_AUCV, &
- VSIGQSAT_n => VSIGQSAT, &
- CSUBG_AUCV_RI_n => CSUBG_AUCV_RI, &
- CCONDENS_n => CCONDENS, &
- CLAMBDA3_n => CLAMBDA3, &
- CSUBG_MF_PDF_n => CSUBG_MF_PDF, &
- LHGRAD_n => LHGRAD, &
- XCOEFHGRADTHL_n => XCOEFHGRADTHL, &
- XCOEFHGRADRM_n => XCOEFHGRADRM, &
- XALTHGRAD_n => XALTHGRAD, &
- XCLDTHOLD_n => XCLDTHOLD
-!
-IMPLICIT NONE
-!
-REAL,SAVE :: XIMPL
-REAL,SAVE :: XKEMIN
-REAL,SAVE :: XCEDIS
-REAL,SAVE :: XCADAP
-CHARACTER (LEN=4),SAVE :: CTURBLEN
-CHARACTER (LEN=4),SAVE :: CTURBDIM
-LOGICAL,SAVE :: LTURB_FLX
-LOGICAL,SAVE :: LTURB_DIAG
-LOGICAL,SAVE :: LSUBG_COND
-LOGICAL,SAVE :: LSIGMAS
-LOGICAL,SAVE :: LSIG_CONV
-LOGICAL,SAVE :: LRMC01
-CHARACTER (LEN=4),SAVE :: CTOM
-CHARACTER (LEN=4),SAVE :: CSUBG_AUCV
-CHARACTER (LEN=80),SAVE :: CSUBG_AUCV_RI
-CHARACTER (LEN=80),SAVE :: CCONDENS
-CHARACTER (LEN=4),SAVE :: CLAMBDA3
-CHARACTER (LEN=80),SAVE :: CSUBG_MF_PDF
-REAL,SAVE :: VSIGQSAT
-LOGICAL,SAVE :: LHGRAD
-REAL,SAVE :: XCOEFHGRADTHL
-REAL,SAVE :: XCOEFHGRADRM
-REAL,SAVE :: XALTHGRAD
-REAL,SAVE :: XCLDTHOLD
-!
-NAMELIST/NAM_TURBn/XIMPL,CTURBLEN,CTURBDIM,LTURB_FLX,LTURB_DIAG, &
- LSUBG_COND,LSIGMAS,LSIG_CONV,LRMC01,CTOM,CSUBG_AUCV,&
- XKEMIN,VSIGQSAT,XCEDIS,XCADAP,CSUBG_AUCV_RI,CCONDENS,&
- CLAMBDA3,CSUBG_MF_PDF,LHGRAD,XCOEFHGRADTHL, XCOEFHGRADRM, &
- XALTHGRAD, XCLDTHOLD
-
-!
-CONTAINS
-!
-SUBROUTINE INIT_NAM_TURBn
- XIMPL = XIMPL_n
- XKEMIN = XKEMIN_n
- XCEDIS = XCEDIS_n
- XCADAP = XCADAP_n
- CTURBLEN = CTURBLEN_n
- CTURBDIM = CTURBDIM_n
- LTURB_FLX = LTURB_FLX_n
- LTURB_DIAG = LTURB_DIAG_n
- LSUBG_COND = LSUBG_COND_n
- LSIGMAS = LSIGMAS_n
- LSIG_CONV = LSIG_CONV_n
- LRMC01 = LRMC01_n
- CTOM = CTOM_n
- CSUBG_AUCV = CSUBG_AUCV_n
- VSIGQSAT = VSIGQSAT_n
- CSUBG_AUCV_RI = CSUBG_AUCV_RI_n
- CCONDENS = CCONDENS_n
- CLAMBDA3 = CLAMBDA3_n
- CSUBG_MF_PDF = CSUBG_MF_PDF_n
- LHGRAD = LHGRAD_n
- XCOEFHGRADTHL = XCOEFHGRADTHL_n
- XCOEFHGRADRM = XCOEFHGRADRM_n
- XALTHGRAD = XALTHGRAD_n
- XCLDTHOLD = XCLDTHOLD_n
-END SUBROUTINE INIT_NAM_TURBn
-
-SUBROUTINE UPDATE_NAM_TURBn
- XIMPL_n = XIMPL
- XKEMIN_n = XKEMIN
- XCEDIS_n = XCEDIS
- XCADAP_n = XCADAP
- CTURBLEN_n = CTURBLEN
- CTURBDIM_n = CTURBDIM
- LTURB_FLX_n = LTURB_FLX
- LTURB_DIAG_n = LTURB_DIAG
- LSUBG_COND_n = LSUBG_COND
- LSIGMAS_n = LSIGMAS
- LSIG_CONV_n = LSIG_CONV
- LRMC01_n = LRMC01
- CTOM_n = CTOM
- CSUBG_AUCV_n = CSUBG_AUCV
- VSIGQSAT_n = VSIGQSAT
- CSUBG_AUCV_RI_n = CSUBG_AUCV_RI
- CCONDENS_n = CCONDENS
- CLAMBDA3_n = CLAMBDA3
- CSUBG_MF_PDF_n = CSUBG_MF_PDF
- LHGRAD_n = LHGRAD
- XCOEFHGRADTHL_n = XCOEFHGRADTHL
- XCOEFHGRADRM_n = XCOEFHGRADRM
- XALTHGRAD_n = XALTHGRAD
- XCLDTHOLD_n = XCLDTHOLD
-END SUBROUTINE UPDATE_NAM_TURBn
-
-END MODULE MODN_TURB_n
diff --git a/src/mesonh/turb/prandtl.f90 b/src/mesonh/turb/prandtl.f90
deleted file mode 100644
index fbfe0a7621714cebb151faee288c99338a4a555b..0000000000000000000000000000000000000000
--- a/src/mesonh/turb/prandtl.f90
+++ /dev/null
@@ -1,609 +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_PRANDTL
-! ###################
-!
-INTERFACE
-!
- SUBROUTINE PRANDTL(KKA,KKU,KKL,KRR,KRRI,OTURB_DIAG, &
- HTURBDIM, &
- TPFILE, &
- PDXX,PDYY,PDZZ,PDZX,PDZY, &
- PTHVREF,PLOCPEXNM,PATHETA,PAMOIST, &
- PLM,PLEPS,PTKEM,PTHLM,PRM,PSVM,PSRCM, &
- PREDTH1,PREDR1, &
- PRED2TH3, PRED2R3, PRED2THR3, &
- PREDS1,PRED2THS3, PRED2RS3, &
- PBLL_O_E, &
- PETHETA, PEMOIST )
-!
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-INTEGER, INTENT(IN) :: KRRI ! number of ice var.
-!
-LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
- ! diagnostic fields in the syncronous FM-file
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Kind of turbulence param.
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
- ! metric coefficients
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential Temp.
- ! of the reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turbulent Mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! Dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM,PTKEM! Conservative Potential
- ! Temperature and TKE at t-1
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios at t-1
- ! with PRM(:,:,:,1) = cons.
- ! mixing ratio
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Scalars at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM
- ! s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PREDTH1 ! Redelsperger number R_theta
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PREDR1 ! Redelsperger number R_q
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2TH3 ! Redelsperger number R*2_theta
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2R3 ! Redelsperger number R*2_q
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2THR3! Redelsperger number R*2_thq
-REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PREDS1 ! Redelsperger number R_sv
-REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PRED2THS3! Redelsperger number R*2_thsv
-REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PRED2RS3 ! Redelsperger number R*2_qsv
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBLL_O_E! beta*Lk*Leps/tke
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PETHETA ! coefficient E_theta
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEMOIST ! coefficient E_moist
-!
-END SUBROUTINE PRANDTL
-!
-END INTERFACE
-!
-END MODULE MODI_PRANDTL
-!
-!
-!
-! ###########################################################
- SUBROUTINE PRANDTL(KKA,KKU,KKL,KRR,KRRI,OTURB_DIAG, &
- HTURBDIM, &
- TPFILE, &
- PDXX,PDYY,PDZZ,PDZX,PDZY, &
- PTHVREF,PLOCPEXNM,PATHETA,PAMOIST, &
- PLM,PLEPS,PTKEM,PTHLM,PRM,PSVM,PSRCM, &
- PREDTH1,PREDR1, &
- PRED2TH3, PRED2R3, PRED2THR3, &
- PREDS1,PRED2THS3, PRED2RS3, &
- PBLL_O_E, &
- PETHETA, PEMOIST )
-! ###########################################################
-!
-!
-!!**** *PRANDTL* - routine to compute the Prandtl turbulent numbers
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to compute the Redelsperger
-! numbers and then get the turbulent Prandtl and Schmidt numbers:
-! * for the heat fluxes - PHI3 = 1/ Prandtl
-! * for the moisture fluxes - PSI3 = 1/ Schmidt
-!
-!!** METHOD
-!! ------
-!! The following steps are performed:
-!!
-!! 1 - default values of 1 are taken for phi3 and psi3 and different masks
-!! are defined depending on the presence of turbulence, stratification and
-!! humidity. The 1D Redelsperger numbers are computed
-!! * ZREDTH1 : (g / THVREF ) (LT**2 / TKE ) ETHETA (D Theta / Dz)
-!! * ZREDR1 : (g / THVREF ) (LT**2 / TKE ) EMOIST (D TW / Dz)
-!! 2 - 3D Redelsperger numbers are computed only for turbulent
-!! grid points where ZREDTH1 or ZREDR1 are > 0.
-!! 3 - PHI3 is computed only for turbulent grid points where ZREDTH1 > 0
-!! (turbulent thermally stratified points)
-!! 4 - PSI3 is computed only for turbulent grid points where ZREDR1 > 0
-!! (turbulent moist points)
-!!
-!!
-!! EXTERNAL
-!! --------
-!! FUNCTIONs ETHETA and EMOIST :
-!! allows to compute the coefficients
-!! for the turbulent correlation between any variable
-!! and the virtual potential temperature, of its correlations
-!! with the conservative potential temperature and the humidity
-!! conservative variable:
-!! ------- ------- -------
-!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
-!!
-!! GX_M_M, GY_M_M, GZ_M_M : Cartesian gradient operators
-!! MZM : Shuman function (mean operator in the z direction)
-!! Module MODI_ETHETA : interface module for ETHETA
-!! Module MODI_EMOIST : interface module for EMOIST
-!! Module MODI_SHUMAN : interface module for Shuman operators
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CST : contains physical constants
-!! XG : gravity constant
-!!
-!! Module MODD_CTURB: contains the set of constants for
-!! the turbulence scheme
-!! XCTV,XCPR2 : constants for the turbulent prandtl numbers
-!! XTKEMIN : minimum value allowed for the TKE
-!!
-!! Module MODD_PARAMETERS
-!! JPVEXT_TURB : number of vertical marginal points
-!!
-!! REFERENCE
-!! ---------
-!! Book 2 of documentation (routine PRANDTL)
-!! Book 1 of documentation (Chapter: Turbulence)
-!!
-!! AUTHOR
-!! ------
-!! Joan Cuxart * INM and Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 18/10/94
-!! Modifications: Feb 14, 1995 (J.Cuxart and J.Stein)
-!! Doctorization and Optimization
-!! Modifications: March 21, 1995 (J.M. Carriere)
-!! Introduction of cloud water
-!! Modifications: March 21, 1995 (J. Cuxart and J.Stein)
-!! Phi3 and Psi3 at w point + cleaning
-!! Modifications: July 2, 1995 (J.Cuxart and Ph.Bougeault)
-!! change the value of Phi3 and Psi3 if negative
-!! Modifications: Sept 20, 1995 (J. Stein, J. Cuxart, J.L. Redelsperger)
-!! remove the Where + use REDTH1+REDR1 for the tests
-!! Modifications: October 10, 1995 (J. Cuxart and J.Stein)
-!! Psi3 for tPREDS1he scalar variables
-!! Modifications: February 27, 1996 (J.Stein) optimization
-!! Modifications: June 15, 1996 (P.Jabouille) return to the previous
-!! computation of Phi3 and Psi3
-!! Modifications: October 10, 1996 (J. Stein) change the temporal
-!! discretization
-!! Modifications: May 23, 1997 (J. Stein) bug in 3D Redels number at ground
-!! with orography
-!! Modifications: Feb 20, 1998 (J. Stein) bug in all the 3D cases due to
-!! the use of ZW1 instead of ZW2
-!! Feb 20, 2003 (JP Pinty) Add PFRAC_ICE
-!! July 2005 (Tomas, Masson) implicitation of PHI3 and PSI3
-!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
-!! change of YCOMMENT
-!! 2012-02 Y. Seity, add possibility to run with reversed
-!! vertical levels
-!! 2017-09 J.Escobar, use epsilon XMNH_TINY_12 for R*4
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! JL Redelsperger 03/2021 : adding Ocean case for temperature only
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-USE MODD_CONF
-USE MODD_CTURB
-USE MODD_DYN_n, ONLY: LOCEAN
-use modd_field, only: tfielddata, TYPEREAL
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PARAMETERS
-!
-USE MODI_GRADIENT_M
-USE MODI_EMOIST
-USE MODI_ETHETA
-USE MODI_SHUMAN
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-INTEGER, INTENT(IN) :: KRRI ! number of ice var.
-!
-LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
- ! diagnostic fields in the syncronous FM-file
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Kind of turbulence param.
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
- ! metric coefficients
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential Temp.
- ! of the reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turbulent Mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! Dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM,PTKEM! Conservative Potential
- ! Temperature and TKE at t-1
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios at t-1
- ! with PRM(:,:,:,1) = cons.
- ! mixing ratio
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Scalars at t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM
- ! s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PREDTH1 ! Redelsperger number R_theta
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PREDR1 ! Redelsperger number R_q
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2TH3 ! Redelsperger number R*2_theta
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2R3 ! Redelsperger number R*2_q
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRED2THR3! Redelsperger number R*2_thq
-REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PREDS1 ! Redelsperger number R_s
-REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PRED2THS3! Redelsperger number R*2_thsv
-REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PRED2RS3 ! Redelsperger number R*2_qsv
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBLL_O_E! beta*Lk*Leps/tke
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PETHETA ! coefficient E_theta
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEMOIST ! coefficient E_moist
-!
-!
-! 0.2 declaration of local variables
-!
-REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
- ZW1, ZW2
-! working variables
-!
-INTEGER :: IKB ! vertical index value for the first inner mass point
-INTEGER :: IKE ! vertical index value for the last inner mass point
-INTEGER:: ISV ! number of scalar variables
-INTEGER:: JSV ! loop index for the scalar variables
-
-INTEGER :: JLOOP
-REAL :: ZMINVAL
-TYPE(TFIELDDATA) :: TZFIELD
-! ---------------------------------------------------------------------------
-!
-!* 1. DEFAULT VALUES, 1D REDELSPERGER NUMBERS
-! ----------------------------------------
-!
-IKB = KKA+JPVEXT_TURB*KKL
-IKE = KKU-JPVEXT_TURB*KKL
-ISV =SIZE(PSVM,4)
-!
-PETHETA(:,:,:) = MZM( ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM) )
-PEMOIST(:,:,:) = MZM( EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM) )
-PETHETA(:,:,KKA) = 2.*PETHETA(:,:,IKB) - PETHETA(:,:,IKB+KKL)
-PEMOIST(:,:,KKA) = 2.*PEMOIST(:,:,IKB) - PEMOIST(:,:,IKB+KKL)
-!
-!---------------------------------------------------------------------------
-!
-! 1.3 1D Redelsperger numbers
-!
-IF (LOCEAN) THEN
- PBLL_O_E(:,:,:) = MZM(XG *XALPHAOC* PLM(:,:,:) * PLEPS(:,:,:) / PTKEM(:,:,:) )
- PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * GZ_M_W(KKA,KKU,KKL,PTHLM,PDZZ)
- PREDR1(:,:,:) = 0.
-ELSE
- PBLL_O_E(:,:,:) = MZM(XG / PTHVREF(:,:,:) * PLM(:,:,:) * PLEPS(:,:,:) / PTKEM(:,:,:) )
- IF (KRR /= 0) THEN ! moist case
- PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * PETHETA(:,:,:) * &
- & GZ_M_W(KKA,KKU,KKL,PTHLM,PDZZ)
- PREDR1(:,:,:) = XCTV*PBLL_O_E(:,:,:) * PEMOIST(:,:,:) * &
- & GZ_M_W(KKA,KKU,KKL,PRM(:,:,:,1),PDZZ)
- ELSE ! dry case
- PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * GZ_M_W(KKA,KKU,KKL,PTHLM,PDZZ)
- PREDR1(:,:,:) = 0.
- END IF
-!
-END IF
-!
-! 3. Limits on 1D Redelperger numbers
-! --------------------------------
-!
-ZMINVAL = (1.-1./XPHI_LIM)
-!
-ZW1 = 1.
-ZW2 = 1.
-!
-WHERE (PREDTH1+PREDR1<-ZMINVAL)
- ZW1 = (-ZMINVAL) / (PREDTH1+PREDR1)
-END WHERE
-!
-WHERE (PREDTH1<-ZMINVAL)
- ZW2 = (-ZMINVAL) / (PREDTH1)
-END WHERE
-ZW2 = MIN(ZW1,ZW2)
-!
-ZW1 = 1.
-WHERE (PREDR1<-ZMINVAL)
- ZW1 = (-ZMINVAL) / (PREDR1)
-END WHERE
-ZW1 = MIN(ZW2,ZW1)
-!
-!
-! 3. Modification of Mixing length and dissipative length
-! ----------------------------------------------------
-!
-PBLL_O_E(:,:,:) = PBLL_O_E(:,:,:) * ZW1(:,:,:)
-PREDTH1 (:,:,:) = PREDTH1 (:,:,:) * ZW1(:,:,:)
-PREDR1 (:,:,:) = PREDR1 (:,:,:) * ZW1(:,:,:)
-!
-! 4. Threshold for very small (in absolute value) Redelperger numbers
-! ----------------------------------------------------------------
-!
-ZW2=SIGN(1.,PREDTH1(:,:,:))
-PREDTH1(:,:,:)= ZW2(:,:,:) * MAX(XMNH_TINY_12, ZW2(:,:,:)*PREDTH1(:,:,:))
-!
-IF (.NOT.LOCEAN) THEN
- IF (KRR /= 0) THEN ! dry case
- ZW2=SIGN(1.,PREDR1(:,:,:))
- PREDR1(:,:,:)= ZW2(:,:,:) * MAX(XMNH_TINY_12, ZW2(:,:,:)*PREDR1(:,:,:))
- END IF
-END IF
-!
-!
-!---------------------------------------------------------------------------
-!
-! For the scalar variables
-DO JSV=1,ISV
- PREDS1(:,:,:,JSV)=XCTV*PBLL_O_E(:,:,:)*GZ_M_W(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDZZ)
-END DO
-!
-DO JSV=1,ISV
- ZW2=SIGN(1.,PREDS1(:,:,:,JSV))
- PREDS1(:,:,:,JSV)= ZW2(:,:,:) * MAX(XMNH_TINY_12, ZW2(:,:,:)*PREDS1(:,:,:,JSV))
-END DO
-!
-!---------------------------------------------------------------------------
-!
-!* 2. 3D REDELSPERGER NUMBERS
-! ------------------------
-!
-IF(HTURBDIM=='1DIM') THEN ! 1D case
-!
-!
- PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2
-!
- PRED2R3(:,:,:) = PREDR1(:,:,:) **2
-!
- PRED2THR3(:,:,:) = PREDTH1(:,:,:) * PREDR1(:,:,:)
-!
-ELSE IF (L2D) THEN ! 3D case in a 2D model
-!
- IF (KRR /= 0) THEN ! moist 3D case
- PRED2TH3(:,:,:)= PREDTH1(:,:,:)**2+(XCTV*PBLL_O_E(:,:,:)*PETHETA(:,:,:) )**2 * &
- MZM( GX_M_M(PTHLM,PDXX,PDZZ,PDZX)**2 )
- PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
-!
- PRED2R3(:,:,:)= PREDR1(:,:,:)**2 + (XCTV*PBLL_O_E(:,:,:)*PEMOIST(:,:,:))**2 * &
- MZM( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)**2 )
- PRED2R3(:,:,IKB)=PRED2R3(:,:,IKB+KKL)
-!
- PRED2THR3(:,:,:)= PREDR1(:,:,:) * PREDTH1(:,:,:) + XCTV**2*PBLL_O_E(:,:,:)**2 * &
- PEMOIST(:,:,:) * PETHETA(:,:,:) * &
- MZM( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)* &
- GX_M_M(PTHLM,PDXX,PDZZ,PDZX))
- PRED2THR3(:,:,IKB)=PRED2THR3(:,:,IKB+KKL)
-!
- ELSE ! dry 3D case in a 2D model
- PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2 + XCTV**2*PBLL_O_E(:,:,:)**2 * &
- MZM( GX_M_M(PTHLM,PDXX,PDZZ,PDZX)**2 )
- PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
-!
- PRED2R3(:,:,:) = 0.
-!
- PRED2THR3(:,:,:) = 0.
-!
- END IF
-!
-ELSE ! 3D case in a 3D model
-!
- IF (KRR /= 0) THEN ! moist 3D case
- PRED2TH3(:,:,:)= PREDTH1(:,:,:)**2 + ( XCTV*PBLL_O_E(:,:,:)*PETHETA(:,:,:) )**2 * &
- MZM( GX_M_M(PTHLM,PDXX,PDZZ,PDZX)**2 &
- + GY_M_M(PTHLM,PDYY,PDZZ,PDZY)**2 )
- PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
-!
- PRED2R3(:,:,:)= PREDR1(:,:,:)**2 + (XCTV*PBLL_O_E(:,:,:)*PEMOIST(:,:,:))**2 * &
- MZM( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)**2 + &
- GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY)**2 )
- PRED2R3(:,:,IKB)=PRED2R3(:,:,IKB+KKL)
-!
- PRED2THR3(:,:,:)= PREDR1(:,:,:) * PREDTH1(:,:,:) + XCTV**2*PBLL_O_E(:,:,:)**2 * &
- PEMOIST(:,:,:) * PETHETA(:,:,:) * &
- MZM( GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX)* &
- GX_M_M(PTHLM,PDXX,PDZZ,PDZX)+ &
- GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY)* &
- GY_M_M(PTHLM,PDYY,PDZZ,PDZY) )
- PRED2THR3(:,:,IKB)=PRED2THR3(:,:,IKB+KKL)
-!
- ELSE ! dry 3D case in a 3D model
- PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2 + XCTV**2*PBLL_O_E(:,:,:)**2 * &
- MZM( GX_M_M(PTHLM,PDXX,PDZZ,PDZX)**2 &
- + GY_M_M(PTHLM,PDYY,PDZZ,PDZY)**2 )
- PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
-!
- PRED2R3(:,:,:) = 0.
-!
- PRED2THR3(:,:,:) = 0.
-!
- END IF
-!
-END IF ! end of the if structure on the turbulence dimensionnality
-!
-!
-!---------------------------------------------------------------------------
-!
-! 5. Prandtl numbers for scalars
-! ---------------------------
-IF(HTURBDIM=='1DIM') THEN
-! 1D case
- DO JSV=1,ISV
- PRED2THS3(:,:,:,JSV) = PREDS1(:,:,:,JSV) * PREDTH1(:,:,:)
- IF (KRR /= 0) THEN
- PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) *PREDS1(:,:,:,JSV)
- ELSE
- PRED2RS3(:,:,:,JSV) = 0.
- END IF
- ENDDO
-!
-ELSE IF (L2D) THEN ! 3D case in a 2D model
-!
- IF (LOCEAN) THEN
- IF (KRR /= 0) THEN
- ZW1 = MZM((XG *XALPHAOC * PLM * PLEPS / PTKEM)**2 ) *PETHETA
- ELSE
- ZW1 = MZM((XG *XALPHAOC * PLM * PLEPS / PTKEM)**2)
- END IF
- ELSE
- DO JSV=1,ISV
- IF (KRR /= 0) THEN
- ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2 ) *PETHETA
- ELSE
- ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2)
- END IF
- PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + &
- ZW1* &
- MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
- GX_M_M(PTHLM,PDXX,PDZZ,PDZX) &
- )
-!
- IF (KRR /= 0) THEN
- PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
- ZW1 * PEMOIST * &
- MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
- GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) &
- )
- ELSE
- PRED2RS3(:,:,:,JSV) = 0.
- END IF
- ENDDO
- END IF
-!
-ELSE ! 3D case in a 3D model
-!
- IF (LOCEAN) THEN
- IF (KRR /= 0) THEN
- ZW1 = MZM((XG *XALPHAOC * PLM * PLEPS / PTKEM)**2 ) *PETHETA
- ELSE
- ZW1 = MZM((XG *XALPHAOC * PLM * PLEPS / PTKEM)**2)
- END IF
- ELSE
- DO JSV=1,ISV
- IF (KRR /= 0) THEN
- ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2 ) *PETHETA
- ELSE
- ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2)
- END IF
- PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + &
- ZW1* &
- MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
- GX_M_M(PTHLM,PDXX,PDZZ,PDZX) &
- +GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)* &
- GY_M_M(PTHLM,PDYY,PDZZ,PDZY) &
- )
-!
- IF (KRR /= 0) THEN
- PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
- ZW1 * PEMOIST * &
- MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
- GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) &
- +GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)* &
- GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY) &
- )
- ELSE
- PRED2RS3(:,:,:,JSV) = 0.
- END IF
- ENDDO
- END IF
-!
-END IF ! end of HTURBDIM if-block
-!
-!
-!---------------------------------------------------------------------------
-!
-!* 6. SAVES THE REDELSPERGER NUMBERS
-! ------------------------------
-!
-IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
- !
- ! stores the RED_TH1
- TZFIELD%CMNHNAME = 'RED_TH1'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'RED_TH1'
- TZFIELD%CUNITS = '1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_Z_RED_TH1'
- TZFIELD%NGRID = 4
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PREDTH1)
- !
- ! stores the RED_R1
- TZFIELD%CMNHNAME = 'RED_R1'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'RED_R1'
- TZFIELD%CUNITS = '1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_Z_RED_R1'
- TZFIELD%NGRID = 4
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PREDR1)
- !
- ! stores the RED2_TH3
- TZFIELD%CMNHNAME = 'RED2_TH3'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'RED2_TH3'
- TZFIELD%CUNITS = '1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_Z_RED2_TH3'
- TZFIELD%NGRID = 4
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PRED2TH3)
- !
- ! stores the RED2_R3
- TZFIELD%CMNHNAME = 'RED2_R3'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'RED2_R3'
- TZFIELD%CUNITS = '1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_Z_RED2_R3'
- TZFIELD%NGRID = 4
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PRED2R3)
- !
- ! stores the RED2_THR3
- TZFIELD%CMNHNAME = 'RED2_THR3'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'RED2_THR3'
- TZFIELD%CUNITS = '1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_Z_RED2_THR3'
- TZFIELD%NGRID = 4
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PRED2THR3)
- !
-END IF
-!
-!---------------------------------------------------------------------------
-!
-END SUBROUTINE PRANDTL
diff --git a/src/mesonh/turb/shallow_mf.f90 b/src/mesonh/turb/shallow_mf.f90
deleted file mode 100644
index c79dfa879b44a11e2b799680deae67cd47360865..0000000000000000000000000000000000000000
--- a/src/mesonh/turb/shallow_mf.f90
+++ /dev/null
@@ -1,320 +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 SHALLOW_MF(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- HMF_UPDRAFT, HMF_CLOUD, HFRAC_ICE, OMIXUV, &
- ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
- PIMPL_MF, PTSTEP, &
- PDZZ, PZZ, &
- PRHODJ, PRHODREF, &
- PPABSM, PEXNM, &
- PSFTH,PSFRV, &
- PTHM,PRM,PUM,PVM,PTKEM,PSVM, &
- PDUDT_MF,PDVDT_MF, &
- PDTHLDT_MF,PDRTDT_MF,PDSVDT_MF, &
- PSIGMF,PRC_MF,PRI_MF,PCF_MF,PFLXZTHVMF, &
- PFLXZTHMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, &
- PTHL_UP,PRT_UP,PRV_UP,PRC_UP,PRI_UP, &
- PU_UP, PV_UP, PTHV_UP, PW_UP, &
- PFRAC_UP,PEMF,PDETR,PENTR, &
- KKLCL,KKETL,KKCTL,PDX,PDY )
-
-! #################################################################
-!!
-!!**** *SHALLOW_MF* -
-!!
-!!
-!! PURPOSE
-!! -------
-!!**** The purpose of this routine is
-!!
-!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! J.Pergaud
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original
-!! V.Masson 09/2010 : optimization
-!! S. Riette 18 May 2010 interface changed due to ice correction
-!! S.Riette DUAL case
-!! S. Riette Jan 2012: support for both order of vertical levels
-!! R.Honnert 07/2012 : elemnts of Rio according to Bouteloup
-!! R.Honnert 07/2012 : MF gray zone
-!! R.Honnert 10/2016 : SURF=gray zone initilisation + EDKF
-!! R.Honnert 10/2016 : Update with Arome
-!! S. Riette Nov 2016: HFRAC_ICE support
-!! Philippe Wautelet 28/05/2018: corrected truncated integer division (2/3 -> 2./3.)
-!! Q.Rodier 01/2019 : support RM17 mixing length
-!! R.Honnert 1/2019 : remove SURF
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-! R. Honnert 04/2021: remove HRIO and BOUT schemes
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-USE MODD_PARAMETERS, ONLY: JPVEXT
-USE MODD_NEB, ONLY: NEB
-USE MODD_PARAM_MFSHALL_n
-
-USE MODI_THL_RT_FROM_TH_R_MF
-USE MODE_COMPUTE_UPDRAFT, ONLY: COMPUTE_UPDRAFT
-USE MODE_COMPUTE_UPDRAFT_RHCJ10, ONLY: COMPUTE_UPDRAFT_RHCJ10
-USE MODE_COMPUTE_UPDRAFT_RAHA, ONLY: COMPUTE_UPDRAFT_RAHA
-USE MODE_MF_TURB, ONLY: MF_TURB
-USE MODE_MF_TURB_EXPL, ONLY: MF_TURB_EXPL
-USE MODE_COMPUTE_MF_CLOUD, ONLY: COMPUTE_MF_CLOUD
-USE MODE_MSG, ONLY: PRINT_MSG, NVERB_FATAL
-USE PARKIND1, ONLY : JPRB
-USE YOMHOOK , ONLY : LHOOK, DR_HOOK
-!
-IMPLICIT NONE
-
-!* 0.1 Declaration of Arguments
-!
-!
-!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-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.
-CHARACTER(LEN=4), INTENT(IN) :: HMF_UPDRAFT ! Type of Mass Flux Scheme
- ! 'NONE' if no parameterization
-CHARACTER(LEN=4), INTENT(IN) :: HMF_CLOUD ! Type of statistical cloud
- ! scheme
-CHARACTER(LEN=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
-LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
-LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
-INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
-INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
-REAL, INTENT(IN) :: PIMPL_MF ! degre of implicitness
-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) :: PEXNM ! 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(OUT):: PDUDT_MF ! tendency of U by massflux scheme
-REAL, DIMENSION(:,:), INTENT(OUT):: PDVDT_MF ! tendency of V by massflux scheme
-REAL, DIMENSION(:,:), INTENT(OUT):: PDTHLDT_MF ! tendency of thl by massflux scheme
-REAL, DIMENSION(:,:), INTENT(OUT):: PDRTDT_MF ! tendency of rt by massflux scheme
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PDSVDT_MF ! tendency of Sv by massflux scheme
-
-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, DIMENSION(:,:), INTENT(OUT) :: PFLXZTHMF
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZRMF
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZUMF
-REAL, DIMENSION(:,:), INTENT(OUT) :: PFLXZVMF
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHL_UP ! Thl updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRT_UP ! Rt updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRV_UP ! Vapor updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PU_UP ! U wind updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PV_UP ! V wind updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRC_UP ! cloud content updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PRI_UP ! ice content updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PTHV_UP ! Thv updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PW_UP ! vertical speed updraft characteristics
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PFRAC_UP ! updraft fraction
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PEMF ! updraft mass flux
-REAL, DIMENSION(:,:), INTENT(OUT) :: PDETR ! updraft detrainment
-REAL, DIMENSION(:,:), INTENT(OUT) :: PENTR ! updraft entrainment
-INTEGER,DIMENSION(:), INTENT(OUT) :: KKLCL,KKETL,KKCTL ! level of LCL,ETL and CTL
-REAL, INTENT(IN) :: PDX, PDY
-!
-! 0.2 Declaration of local variables
-!
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: &
- ZTHLM, & !
- ZRTM, & !
- ZTHVM, & !
- ZEMF_O_RHODREF, & ! entrainment/detrainment
- ZBUO_INTEG ! integrated buoyancy
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZFRAC_ICE
-
-REAL, DIMENSION(SIZE(PSVM,1),SIZE(PSVM,2),SIZE(PSVM,3)) :: &
- ZSV_UP,& ! updraft scalar var.
- ZFLXZSVMF ! Flux
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZDEPTH ! Deepness of cloud
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZFRAC_ICE_UP ! liquid/solid fraction in updraft
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZRSAT_UP ! Rsat in updraft
-
-LOGICAL :: GENTR_DETR ! flag to recompute entrainment, detrainment and mass flux
-INTEGER :: IKB ! near ground physical index
-INTEGER :: IKE ! uppest atmosphere physical index
-INTEGER, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: IERR
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!------------------------------------------------------------------------
-
-!!! 1. Initialisation
-IF (LHOOK) CALL DR_HOOK('SHALLOW_MF',0,ZHOOK_HANDLE)
-
-! vertical boundaries
-IKB=KKA+KKL*JPVEXT
-IKE=KKU-KKL*JPVEXT
-
-! updraft governing variables
-IF (HMF_UPDRAFT == 'EDKF' .OR. HMF_UPDRAFT == 'RHCJ') THEN
- PENTR = 1.E20
- PDETR = 1.E20
- PEMF = 1.E20
- ZBUO_INTEG = 1.E20
-ENDIF
-
-! Thermodynamics functions
-ZFRAC_ICE(:,:) = 0.
-IF (SIZE(PRM,3).GE.4) THEN
- WHERE(PRM(:,:,2)+PRM(:,:,4) > 1.E-20)
- ZFRAC_ICE(:,:) = PRM(:,:,4) / (PRM(:,:,2)+PRM(:,:,4))
- ENDWHERE
-ENDIF
-CALL COMPUTE_FRAC_ICE(HFRAC_ICE,NEB,ZFRAC_ICE(:,:),PTHM(:,:)*PEXNM(:,:), IERR(:,:))
-
-! Conservative variables at t-dt
-CALL THL_RT_FROM_TH_R_MF(KRR,KRRL,KRRI, &
- PTHM, PRM, PEXNM, &
- ZTHLM, ZRTM )
-
-! Virtual potential temperature at t-dt
-ZTHVM(:,:) = PTHM(:,:)*((1.+XRV / XRD *PRM(:,:,1))/(1.+ZRTM(:,:)))
-
-!
-!!! 2. Compute updraft
-!!! ---------------
-!
-IF (HMF_UPDRAFT == 'EDKF') THEN
- GENTR_DETR = .TRUE.
- CALL COMPUTE_UPDRAFT(KKA,IKB,IKE,KKU,KKL,HFRAC_ICE,GENTR_DETR,OMIXUV,&
- ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
- PZZ,PDZZ, &
- PSFTH,PSFRV,PPABSM,PRHODREF, &
- PUM,PVM,PTKEM, &
- PTHM,PRM(:,:,1),ZTHLM,ZRTM,PSVM, &
- PTHL_UP,PRT_UP,PRV_UP,PRC_UP,PRI_UP, &
- PTHV_UP, PW_UP, PU_UP, PV_UP, ZSV_UP, &
- PFRAC_UP,ZFRAC_ICE_UP,ZRSAT_UP,PEMF,PDETR,&
- PENTR,ZBUO_INTEG,KKLCL,KKETL,KKCTL,ZDEPTH,&
- PDX,PDY)
-ELSEIF (HMF_UPDRAFT == 'RHCJ') THEN
- GENTR_DETR = .TRUE.
- CALL COMPUTE_UPDRAFT_RHCJ10(KKA,IKB,IKE,KKU,KKL,HFRAC_ICE,GENTR_DETR,OMIXUV,&
- ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
- PZZ,PDZZ, &
- PSFTH,PSFRV,PPABSM,PRHODREF, &
- PUM,PVM,PTKEM, &
- PTHM,PRM(:,:,1),ZTHLM,ZRTM,PSVM, &
- PTHL_UP,PRT_UP,PRV_UP,PRC_UP,PRI_UP, &
- PTHV_UP, PW_UP, PU_UP, PV_UP, ZSV_UP, &
- PFRAC_UP,ZFRAC_ICE_UP,ZRSAT_UP,PEMF,PDETR,&
- PENTR,ZBUO_INTEG,KKLCL,KKETL,KKCTL,ZDEPTH )
-ELSEIF (HMF_UPDRAFT == 'RAHA') THEN
- CALL COMPUTE_UPDRAFT_RAHA(KKA,IKB,IKE,KKU,KKL,HFRAC_ICE, &
- GENTR_DETR,OMIXUV, &
- ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
- PZZ,PDZZ, &
- PSFTH,PSFRV, &
- PPABSM,PRHODREF,PUM,PVM,PTKEM, &
- PEXNM,PTHM,PRM(:,:,1),ZTHLM,ZRTM, &
- PSVM,PTHL_UP,PRT_UP, &
- PRV_UP,PRC_UP,PRI_UP, PTHV_UP, &
- PW_UP, PU_UP, PV_UP, ZSV_UP, &
- PFRAC_UP,ZFRAC_ICE_UP,ZRSAT_UP, &
- PEMF,PDETR,PENTR, &
- ZBUO_INTEG,KKLCL,KKETL,KKCTL, &
- ZDEPTH )
-ELSEIF (HMF_UPDRAFT == 'DUAL') THEN
- !Updraft characteristics are already computed and received by interface
-ELSE
- CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'SHALLOW_MF', 'no updraft model for EDKF: CMF_UPDRAFT='//TRIM(HMF_UPDRAFT) )
-ENDIF
-
-!!! 5. Compute diagnostic convective cloud fraction and content
-!!! --------------------------------------------------------
-!
-CALL COMPUTE_MF_CLOUD(KKA,IKB,IKE,KKU,KKL,KRR,KRRL,KRRI,&
- HMF_CLOUD,ZFRAC_ICE, &
- PRC_UP,PRI_UP,PEMF, &
- PTHL_UP,PRT_UP,PFRAC_UP, &
- PTHV_UP,ZFRAC_ICE_UP, &
- ZRSAT_UP,PEXNM,ZTHLM,ZRTM, &
- PTHM, ZTHVM, PRM, &
- PDZZ,PZZ,KKLCL, &
- PPABSM,PRHODREF, &
- PRC_MF,PRI_MF,PCF_MF,PSIGMF,ZDEPTH)
-
-
-!!! 3. Compute fluxes of conservative variables and their divergence = tendency
-!!! ------------------------------------------------------------------------
-!
-ZEMF_O_RHODREF=PEMF/PRHODREF
-
-IF ( PIMPL_MF > 1.E-10 ) THEN
- CALL MF_TURB(KKA, IKB, IKE, KKU, KKL, OMIXUV, &
- ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
- PIMPL_MF, PTSTEP, &
- PDZZ, &
- PRHODJ, &
- ZTHLM,ZTHVM,ZRTM,PUM,PVM,PSVM, &
- PDTHLDT_MF,PDRTDT_MF,PDUDT_MF,PDVDT_MF,PDSVDT_MF, &
- ZEMF_O_RHODREF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP,ZSV_UP,&
- PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, &
- ZFLXZSVMF )
-ELSE
- CALL MF_TURB_EXPL(KKA, IKB, IKE, KKU, KKL, OMIXUV, &
- PRHODJ, &
- ZTHLM,ZTHVM,ZRTM,PUM,PVM, &
- PDTHLDT_MF,PDRTDT_MF,PDUDT_MF,PDVDT_MF, &
- ZEMF_O_RHODREF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP, &
- PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF)
-ENDIF
-
-! security in the case HMF_UPDRAFT = 'DUAL'
-! to be modified if 'DUAL' is evolving (momentum mixing for example)
-IF( HMF_UPDRAFT == 'DUAL') THEN
- ! Now thetav_up from vdfhghtnn is used!
- PFLXZTHVMF=0.
- ! Yes/No UV mixing!
-! PDUDT_MF=0.
-! PDVDT_MF=0.
-ENDIF
-!
-IF (LHOOK) CALL DR_HOOK('SHALLOW_MF',1,ZHOOK_HANDLE)
-!
-CONTAINS
-INCLUDE "compute_frac_ice.func.h"
-!
-END SUBROUTINE SHALLOW_MF
diff --git a/src/mesonh/turb/thl_rt_from_th_r_mf.f90 b/src/mesonh/turb/thl_rt_from_th_r_mf.f90
deleted file mode 100644
index 1fb982a1a082c9812051d3242c7c92387cef8354..0000000000000000000000000000000000000000
--- a/src/mesonh/turb/thl_rt_from_th_r_mf.f90
+++ /dev/null
@@ -1,146 +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.
-! ######spl
- MODULE MODI_THL_RT_FROM_TH_R_MF
-! ###############################
-!
-INTERFACE
-! #################################################################
- SUBROUTINE THL_RT_FROM_TH_R_MF( KRR,KRRL,KRRI, &
- PTH, PR, PEXN, &
- PTHL, PRT )
-! #################################################################
-!
-!
-!* 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.
-
-REAL, DIMENSION(:,:), INTENT(IN) :: PTH ! theta
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PR ! water species
-REAL, DIMENSION(:,:), INTENT(IN) :: PEXN ! exner function
-
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL ! th_l
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRT ! total non precip. water
-!
-END SUBROUTINE THL_RT_FROM_TH_R_MF
-
-END INTERFACE
-!
-END MODULE MODI_THL_RT_FROM_TH_R_MF
-! #################################################################
- SUBROUTINE THL_RT_FROM_TH_R_MF( KRR,KRRL,KRRI, &
- PTH, PR, PEXN, &
- PTHL, PRT )
-! #################################################################
-!
-!!
-!!**** *THL_RT_FROM_TH_R* - computes the conservative variables THL and RT
-!! from TH and the non precipitating water species
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 20/09/02
-!! Externalisation of computations done in TURB and MF_TURB (Malardel and Pergaud, fev. 2007)
-!! V.Masson : Optimization
-!! S. Riette 2011 suppression of PLVOCPEXN and PLSOCPEXN
-!!
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations 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.
-
-REAL, DIMENSION(:,:), INTENT(IN) :: PTH ! theta
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PR ! water species
-REAL, DIMENSION(:,:), INTENT(IN) :: PEXN ! exner function
-
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL ! th_l
-REAL, DIMENSION(:,:), INTENT(OUT) :: PRT ! total non precip. water
-!
-!-------------------------------------------------------------------------------
-!
-! 0.2 declaration of local variables
-!
-
-!----------------------------------------------------------------------------
-REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2)) :: ZCP, ZT
-REAL, DIMENSION(SIZE(PTH,1),SIZE(PTH,2)) :: ZLVOCPEXN, ZLSOCPEXN
-INTEGER :: JRR
-!----------------------------------------------------------------------------
-!
-!
-!temperature
-ZT(:,:) = PTH(:,:) * PEXN(:,:)
-
-!Cp
-ZCP=XCPD
-IF (KRR > 0) ZCP(:,:) = ZCP(:,:) + XCPV * PR(:,:,1)
-DO JRR = 2,1+KRRL ! loop on the liquid components
- ZCP(:,:) = ZCP(:,:) + XCL * PR(:,:,JRR)
-END DO
-DO JRR = 2+KRRL,1+KRRL+KRRI ! loop on the solid components
- ZCP(:,:) = ZCP(:,:) + XCI * PR(:,:,JRR)
-END DO
-
-IF ( KRRL >= 1 ) THEN
- IF ( KRRI >= 1 ) THEN
- !ZLVOCPEXN and ZLSOCPEXN
- ZLVOCPEXN(:,:)=(XLVTT + (XCPV-XCL) * (ZT(:,:)-XTT) ) / ZCP(:,:) / PEXN(:,:)
- ZLSOCPEXN(:,:)=(XLSTT + (XCPV-XCI) * (ZT(:,:)-XTT) ) / ZCP(:,:) / PEXN(:,:)
- ! Rnp
- PRT(:,:) = PR(:,:,1) + PR(:,:,2) + PR(:,:,4)
- ! Theta_l
- PTHL(:,:) = PTH(:,:) - ZLVOCPEXN(:,:) * PR(:,:,2) &
- - ZLSOCPEXN(:,:) * PR(:,:,4)
- ELSE
- !ZLVOCPEXN
- ZLVOCPEXN(:,:)=(XLVTT + (XCPV-XCL) * (ZT(:,:)-XTT) ) / ZCP(:,:) / PEXN(:,:)
- ! Rnp
- PRT(:,:) = PR(:,:,1) + PR(:,:,2)
- ! Theta_l
- PTHL(:,:) = PTH(:,:) - ZLVOCPEXN(:,:) * PR(:,:,2)
- END IF
-ELSE
- ! Rnp = rv
- PRT(:,:) = PR(:,:,1)
- ! Theta_l = Theta
- PTHL(:,:) = PTH(:,:)
-END IF
-END SUBROUTINE THL_RT_FROM_TH_R_MF
diff --git a/src/mesonh/turb/turb_cloud_index.f90 b/src/mesonh/turb/turb_cloud_index.f90
deleted file mode 100644
index c194db61154a5c3fe6fcf2308dae47d01720856c..0000000000000000000000000000000000000000
--- a/src/mesonh/turb/turb_cloud_index.f90
+++ /dev/null
@@ -1,344 +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_TURB_CLOUD_INDEX
-! ################
-!
-INTERFACE
-!
- SUBROUTINE TURB_CLOUD_INDEX(PTSTEP,TPFILE, &
- OTURB_DIAG,KRRI, &
- PRRS,PRM,PRHODJ,PDXX,PDYY,PDZZ,PDZX,PDZY, &
- PCEI )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
- ! diagnostic fields in the syncronous FM-file
-INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRRS ! Sources term of RR
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Variable at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Jacobian * dry density of
- ! the reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
- ! metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PCEI ! Cloud Entrainment instability
- ! index to emphasize locally
- ! turbulent fluxes
-!
-END SUBROUTINE TURB_CLOUD_INDEX
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_CLOUD_INDEX
-!
-! #######################
- SUBROUTINE TURB_CLOUD_INDEX(PTSTEP,TPFILE, &
- OTURB_DIAG,KRRI, &
- PRRS,PRM,PRHODJ,PDXX,PDYY,PDZZ,PDZX,PDZY, &
- PCEI )
-! #######################
- !
-!! PURPOSE
-!! -------
-!! CEI (cloud Entrainment Instability) index calculation
-!! It permits to localize cloudy points where a different mixing length
-!! from the one in clear sky can be applicated
-!! It permits to quantify also, at those cloudy points, an instability
-!! that can emphasize sub-grid turbulence.
-!! If such an instability exists, mixing length is increased proportionnaly
-!! to that CEI criterium
-!!
-!!** METHOD
-!! ------
-!!
-!! Criteria: For a cloudy point or a point adjacent to a cloudy point,
-!! G = NORM( dVAR/dx_j ) > threshold
-!! Q_j = DG_j/Dt of the same sign as G_j
-!! where VAR=rv+rc+ri and j=x or y
-!! then CEI= NORM(Q)
-!!
-!! EXTERNAL
-!! --------
-!! GX_M_M, GY_M_M : Cartesian gradient operators
-!! FMWRIT : FM-routine to write a record
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODI_GRADIENT_M : GX_M_M, GY_M_M
-!!
-!! AUTHOR
-!! ------
-!! M. Tomasini * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 15/09/94
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!
-!-------------------------------------------------------------------------------
-!
-use modd_field, only: tfielddata, TYPEREAL
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PARAMETERS, ONLY: JPVEXT
-!
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
-use mode_tools_ll, only: GET_INDICE_ll
-!
-USE MODI_GRADIENT_M
-!
-IMPLICIT NONE
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!* 0.1 declarations of arguments
-!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
- ! diagnostic fields in the syncronous FM-file
-INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRRS ! Sources term of RR
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Variable at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Jacobian * dry density of
- ! the reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
- ! metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PCEI ! Cloud Entrainment instability
- ! index to emphasize locally
- ! turbulent fluxes
-!
-!* 0.2 declarations of local variables
-!
-REAL, DIMENSION(SIZE(PRM,1),SIZE(PRM,2),SIZE(PRM,3)) :: ZWORK,ZRVCI0 ! Work arrays
-REAL, DIMENSION(SIZE(PRM,1),SIZE(PRM,2),SIZE(PRM,3)) :: ZCLOUD
- ! rc+ri at time after ADVECTION routine
- ! for the CEI criterium
-REAL, DIMENSION(SIZE(PRM,1),SIZE(PRM,2),SIZE(PRM,3)) :: ZRVCI,ZGNORM_RVCI,ZQNORM_RVCI
- ! rv+rc+ri at time after ADVECTION routine
- ! horizontal norm of the vector PG_RVCI
- ! horizontal norm of the vector PQ_RVCI
-REAL, DIMENSION(SIZE(PRM,1),SIZE(PRM,2),SIZE(PRM,3),2) :: ZG_RVCI,ZQ_RVCI
- ! x and y gradient of rv+rc+ri
- ! x and y gradient of the advection of rv+rc+ri
-!
-INTEGER :: JI,JJ,JK ! loop counters
-INTEGER :: IIB,IJB,IKB ! Begin of physical dimensions
-INTEGER :: IIE,IJE,IKE ! End of physical dimensions
-INTEGER, DIMENSION(SIZE(PRM,1),SIZE(PRM,2),SIZE(PRM,3)) :: IMASK_CLOUD
- ! 0 except cloudy points or adjacent points (1)
-TYPE(TFIELDDATA) :: TZFIELD
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. INITIALISATION
-! --------------
-!
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IKB = 1 + JPVEXT
-IKE = SIZE(PRM,3) - JPVEXT
-!
-IMASK_CLOUD(:,:,:) = 0
-PCEI(:,:,:) = 0.
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. CALCULATION
-! -----------
-!* 2.1 Gradients calculation of the variable :
-! VAR at time (t+1)=VAR at time (t-1) + 2*dt*ADV at time t
-! VAR is a source term (i.e. x by RHODJ)
-!
-! To avoid negative mixing ratios at external points
-! but also in the physical domain !
-ZRVCI0(:,:,:) = MAX ( PRRS(:,:,:,1) , 0. ) + MAX ( PRRS(:,:,:,2) , 0. )
-IF (KRRI>=1) ZRVCI0(:,:,:) = ZRVCI0(:,:,:) + MAX ( PRRS(:,:,:,4) , 0. )
-!
-ZRVCI(:,:,:)= PTSTEP *ZRVCI0(:,:,:) /PRHODJ(:,:,:)
-ZG_RVCI(:,:,:,1) = GX_M_M(ZRVCI,PDXX,PDZZ,PDZX)
-ZG_RVCI(:,:,:,2) = GY_M_M(ZRVCI,PDYY,PDZZ,PDZY)
-!
-ZGNORM_RVCI(:,:,:) = SQRT( ZG_RVCI(:,:,:,1)*ZG_RVCI(:,:,:,1) + &
- ZG_RVCI(:,:,:,2)*ZG_RVCI(:,:,:,2) )
-!
-!
-!* 2.2 Frontogenetic terms calculation
-! (gradient of the advection)
-! Q_j=DG_j/Dt=d(DVAR/Dt)dx_j - d(u_k*dVAR/dx_k)/dx_j
-! As DVAR/Dt=0 if the VAR is conserved during the movement,
-! Q_j = dADV/dx_j
-! VAR=rv+rc+ri
-!
-ZWORK(:,:,:) = ZRVCI0 / PRHODJ(:,:,:) - &
- ( PRM(:,:,:,1)+ PRM(:,:,:,2) ) / PTSTEP
-IF (KRRI>=1) ZWORK(:,:,:) = ZWORK(:,:,:) - PRM(:,:,:,4) / PTSTEP
-!
-ZQ_RVCI(:,:,:,1) = GX_M_M(ZWORK,PDXX,PDZZ,PDZX)
-ZQ_RVCI(:,:,:,2) = GY_M_M(ZWORK,PDYY,PDZZ,PDZY)
-!
-ZQNORM_RVCI(:,:,:) = SQRT( ZQ_RVCI(:,:,:,1)*ZQ_RVCI(:,:,:,1) + &
- ZQ_RVCI(:,:,:,2)*ZQ_RVCI(:,:,:,2) )
-!
-!
-!* 2.3 Cloud mask
-!
-ZCLOUD(:,:,:)= MAX ( PRRS(:,:,:,2) , 0. )
-IF (KRRI>=1) ZCLOUD(:,:,:) = ZCLOUD(:,:,:) + MAX ( PRRS(:,:,:,4) , 0. )
-ZCLOUD(:,:,:) = PTSTEP * ZCLOUD / PRHODJ(:,:,:)
-!
-DO JK=IKB,IKE
-DO JJ=IJB,IJE
-DO JI=IIB,IIE
- ! rc+ri threshold to avoid white noise and calculations
- IF ( ZCLOUD(JI,JJ,JK) > 1.E-6 ) THEN
- IMASK_CLOUD(JI-1,JJ ,JK ) = 1
- IMASK_CLOUD(JI ,JJ ,JK ) = 1
- IMASK_CLOUD(JI+1,JJ ,JK ) = 1
- IMASK_CLOUD(JI ,JJ-1,JK ) = 1
- IMASK_CLOUD(JI ,JJ+1,JK ) = 1
- IMASK_CLOUD(JI ,JJ ,JK-1) = 1
- IMASK_CLOUD(JI ,JJ ,JK+1) = 1
- ! The cloudy points where the criteria will not be satisfied
- ! will have the cloudy mixing length not amplified
- ! We put in the CEI index a negative number to mark those points
- ! in turb.f90
- PCEI(JI,JJ,JK) = -1.
- ENDIF
-ENDDO
-ENDDO
-ENDDO
-!
-!* 2.4 Cloud Entrainment Instability index
-!
-! CEI(:,:,:)=NORM_Q
-!
-! if the considered point is cloudy or surrounded by at least one cloudy point
-!
-! and if the characteristic time >0 in at least one direction that is to say
-! |grad(rv+rc+ri)| increasing with time that is to say
-! grad(rv+rc+ri) has the same sign as Q_RVCI
-!
-! and if NORM_G_RVCI >= 0.1 g/kg/km
-!
-DO JK=IKB,IKE
-DO JJ=IJB,IJE
-DO JI=IIB,IIE
- IF ( IMASK_CLOUD(JI,JJ,JK) == 1 ) THEN
- IF ( ZGNORM_RVCI(JI,JJ,JK) >= 1.E-07 ) THEN
- IF ( SIGN(1.0,ZG_RVCI(JI,JJ,JK,1))==SIGN(1.0,ZQ_RVCI(JI,JJ,JK,1)) .OR. &
- SIGN(1.0,ZG_RVCI(JI,JJ,JK,2))==SIGN(1.0,ZQ_RVCI(JI,JJ,JK,2)) ) THEN
- PCEI(JI,JJ,JK) = ZQNORM_RVCI(JI,JJ,JK)
- ENDIF
- ENDIF
- ENDIF
-ENDDO
-ENDDO
-ENDDO
-!
-!* 2.5 Writing
-!
-IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
- TZFIELD%CMNHNAME = 'RVCI'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'RVCI'
- TZFIELD%CUNITS = 'kg kg-1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_Z_RVCI'
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZRVCI)
- !
- TZFIELD%CMNHNAME = 'GX_RVCI'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'GX_RVCI'
- TZFIELD%CUNITS = 'kg kg-1 m-1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_Z_GX_RVCI'
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZG_RVCI(:,:,:,1))
- !
- TZFIELD%CMNHNAME = 'GY_RVCI'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'GY_RVCI'
- TZFIELD%CUNITS = 'kg kg-1 m-1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_Z_GY_RVCI'
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZG_RVCI(:,:,:,2))
- !
- TZFIELD%CMNHNAME = 'GNORM_RVCI'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'GNORM_RVCI'
- TZFIELD%CUNITS = 'kg kg-1 m-1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_Z_NORM G'
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZGNORM_RVCI)
- !
- TZFIELD%CMNHNAME = 'QX_RVCI'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'QX_RVCI'
- TZFIELD%CUNITS = 'kg kg-1 m-1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_Z_QX_RVCI'
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZQ_RVCI(:,:,:,1))
- !
- TZFIELD%CMNHNAME = 'QY_RVCI'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'QY_RVCI'
- TZFIELD%CUNITS = 'kg kg-1 m-1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_Z_QY_RVCI'
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZQ_RVCI(:,:,:,2))
- !
- TZFIELD%CMNHNAME = 'QNORM_RVCI'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'QNORM_RVCI'
- TZFIELD%CUNITS = 'kg kg-1 m-1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_Z_QNORM_RVCI'
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZQNORM_RVCI)
- !
- TZFIELD%CMNHNAME = 'CEI'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'CEI'
- TZFIELD%CUNITS = 'kg kg-1 m-1 s-1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_Z_CEI'
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,PCEI)
-END IF
-!
-END SUBROUTINE TURB_CLOUD_INDEX
diff --git a/src/mesonh/turb/turb_ver.f90 b/src/mesonh/turb/turb_ver.f90
deleted file mode 100644
index 4117d8191eb9def704b654e606eba90307fe65ec..0000000000000000000000000000000000000000
--- a/src/mesonh/turb/turb_ver.f90
+++ /dev/null
@@ -1,746 +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_TURB_VER
-! ####################
-!
-INTERFACE
-!
- SUBROUTINE TURB_VER(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- OTURB_FLX, &
- HTURBDIM,HTOM,PIMPL,PEXPL, &
- PTSTEP, TPFILE, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
- PCOSSLOPE,PSINSLOPE, &
- PRHODJ,PTHVREF, &
- PSFTHM,PSFRM,PSFSVM,PSFTHP,PSFRP,PSFSVP, &
- PCDUEFF,PTAU11M,PTAU12M,PTAU33M, &
- PUM,PVM,PWM,PUSLOPEM,PVSLOPEM,PTHLM,PRM,PSVM, &
- PTKEM,PLM,PLEPS, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
- PFWTH,PFWR,PFTH2,PFR2,PFTHR,PBL_DEPTH, &
- PSBL_DEPTH,PLMO, &
- PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS, &
- PDP,PTP,PSIGS,PWTH,PWRC,PWSV )
-
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-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.
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-CHARACTER(len=4), INTENT(IN) :: HTOM ! type of Third Order Moment
-REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
-REAL, INTENT(IN) :: PTSTEP ! timestep
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
- ! normal to the ground surface
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitudes at flux points
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
- ! between i and the slope vector
-REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
- ! between i and the slope vector
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state Virtual
- ! Potential Temperature
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM ! surface fluxes at time
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! t - deltat
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHP,PSFRP ! surface fluxes at time
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVP ! t + deltat
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU11M ! <uu> in the axes linked
- ! to the maximum slope direction and the surface normal and the binormal
- ! at time t - dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU12M ! <uv> in the same axes
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHLM
- ! Wind and potential temperature at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios
- ! at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-Delta t
-REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
- ! maximum slope direction
-REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
- ! direction normal to the maximum slope one
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exner at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
- ! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFRAC_ICE ! ri fraction of rc+ri
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWTH ! d(w'2th' )/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWR ! d(w'2r' )/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTH2 ! d(w'th'2 )/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFR2 ! d(w'r'2 )/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTHR ! d(w'th'r')/dz
-REAL, DIMENSION(:,:), INTENT(INOUT):: PBL_DEPTH ! BL depth
-REAL, DIMENSION(:,:), INTENT(INOUT):: PSBL_DEPTH ! SBL depth
-REAL, DIMENSION(:,:), INTENT(IN) :: PLMO ! Monin-Obukhov length
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS, PRTHLS
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS,PRRS
- ! cumulated sources for the prognostic variables
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDP,PTP ! Dynamic and thermal
- ! TKE production terms
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS ! Vert. part of Sigma_s at t
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTH ! heat flux
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWRC ! cloud water flux
-REAL, DIMENSION(:,:,:,:),INTENT(OUT) :: PWSV ! scalar flux
-
-!
-!
-END SUBROUTINE TURB_VER
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_VER
-!
-!
-! ###############################################################
- SUBROUTINE TURB_VER(KKA,KKU,KKL,KRR, KRRL, KRRI, &
- OTURB_FLX, &
- HTURBDIM,HTOM,PIMPL,PEXPL, &
- PTSTEP, TPFILE, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
- PCOSSLOPE,PSINSLOPE, &
- PRHODJ,PTHVREF, &
- PSFTHM,PSFRM,PSFSVM,PSFTHP,PSFRP,PSFSVP, &
- PCDUEFF,PTAU11M,PTAU12M,PTAU33M, &
- PUM,PVM,PWM,PUSLOPEM,PVSLOPEM,PTHLM,PRM,PSVM, &
- PTKEM,PLM,PLEPS, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
- PFWTH,PFWR,PFTH2,PFR2,PFTHR,PBL_DEPTH, &
- PSBL_DEPTH,PLMO, &
- PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS, &
- PDP,PTP,PSIGS,PWTH,PWRC,PWSV )
-! ###############################################################
-!
-!
-!!**** *TURB_VER* -compute the source terms due to the vertical turbulent
-!! fluxes.
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to compute the vertical turbulent
-! fluxes of the evolutive variables and give back the source
-! terms to the main program. In the case of large horizontal meshes,
-! the divergence of these vertical turbulent fluxes represent the whole
-! effect of the turbulence but when the three-dimensionnal version of
-! the turbulence scheme is activated (CTURBDIM="3DIM"), these divergences
-! are completed in the next routine TURB_HOR.
-! An arbitrary degree of implicitness has been implemented for the
-! temporal treatment of these diffusion terms.
-! The vertical boundary conditions are as follows:
-! * at the bottom, the surface fluxes are prescribed at the same
-! as the other turbulent fluxes
-! * at the top, the turbulent fluxes are set to 0.
-! It should be noted that the condensation has been implicitely included
-! in this turbulence scheme by using conservative variables and computing
-! the subgrid variance of a statistical variable s indicating the presence
-! or not of condensation in a given mesh.
-!
-!!** METHOD
-!! ------
-!! 1D type calculations are made;
-!! The vertical turbulent fluxes are computed in an off-centered
-!! implicit scheme (a Crank-Nicholson type with coefficients different
-!! than 0.5), which allows to vary the degree of implicitness of the
-!! formulation.
-!! The different prognostic variables are treated one by one.
-!! The contributions of each turbulent fluxes are cumulated into the
-!! tendency PRvarS, and into the dynamic and thermal production of
-!! TKE if necessary.
-!!
-!! In section 2 and 3, the thermodynamical fields are considered.
-!! Only the turbulent fluxes of the conservative variables
-!! (Thetal and Rnp stored in PRx(:,:,:,1)) are computed.
-!! Note that the turbulent fluxes at the vertical
-!! boundaries are given either by the soil scheme for the surface one
-!! ( at the same instant as the others fluxes) and equal to 0 at the
-!! top of the model. The thermal production is computed by vertically
-!! averaging the turbulent flux and multiply this flux at the mass point by
-!! a function ETHETA or EMOIST, which preform the transformation from the
-!! conservative variables to the virtual potential temperature.
-!!
-!! In section 4, the variance of the statistical variable
-!! s indicating presence or not of condensation, is determined in function
-!! of the turbulent moments of the conservative variables and its
-!! squarred root is stored in PSIGS. This information will be completed in
-!! the horizontal turbulence if the turbulence dimensionality is not
-!! equal to "1DIM".
-!!
-!! In section 5, the x component of the stress tensor is computed.
-!! The surface flux <u'w'> is computed from the value of the surface
-!! fluxes computed in axes linked to the orography ( i", j" , k"):
-!! i" is parallel to the surface and in the direction of the maximum
-!! slope
-!! j" is also parallel to the surface and in the normal direction of
-!! the maximum slope
-!! k" is the normal to the surface
-!! In order to prevent numerical instability, the implicit scheme has
-!! been extended to the surface flux regarding to its dependence in
-!! function of U. The dependence in function of the other components
-!! introduced by the different rotations is only explicit.
-!! The turbulent fluxes are used to compute the dynamic production of
-!! TKE. For the last TKE level ( located at PDZZ(:,:,IKB)/2 from the
-!! ground), an harmonic extrapolation from the dynamic production at
-!! PDZZ(:,:,IKB) is used to avoid an evaluation of the gradient of U
-!! in the surface layer.
-!!
-!! In section 6, the same steps are repeated but for the y direction
-!! and in section 7, a diagnostic computation of the W variance is
-!! performed.
-!!
-!! In section 8, the turbulent fluxes for the scalar variables are
-!! computed by the same way as the conservative thermodynamical variables
-!!
-!!
-!! EXTERNAL
-!! --------
-!! GX_U_M, GY_V_M, GZ_W_M : cartesian gradient operators
-!! GX_U_UW,GY_V_VW (X,Y,Z) represent the direction of the gradient
-!! _(M,U,...)_ represent the localization of the
-!! field to be derivated
-!! _(M,UW,...) represent the localization of the
-!! field derivated
-!!
-!! SUBROUTINE TRIDIAG : to compute the split implicit evolution
-!! of a variable located at a mass point
-!!
-!! SUBROUTINE TRIDIAG_WIND: to compute the split implicit evolution
-!! of a variable located at a wind point
-!!
-!! FUNCTIONs ETHETA and EMOIST :
-!! allows to compute:
-!! - the coefficients for the turbulent correlation between
-!! any variable and the virtual potential temperature, of its
-!! correlations with the conservative potential temperature and
-!! the humidity conservative variable:
-!! ------- ------- -------
-!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CST : contains physical constants
-!!
-!! XG : gravity constant
-!!
-!! Module MODD_CTURB: contains the set of constants for
-!! the turbulence scheme
-!!
-!! XCMFS,XCMFB : cts for the momentum flux
-!! XCSHF : ct for the sensible heat flux
-!! XCHF : ct for the moisture flux
-!! XCTV,XCHV : cts for the T and moisture variances
-!!
-!! Module MODD_PARAMETERS
-!!
-!! JPVEXT_TURB : number of vertical external points
-!! JPHEXT : number of horizontal external points
-!!
-!!
-!! REFERENCE
-!! ---------
-!! Book 1 of documentation (Chapter: Turbulence)
-!!
-!! AUTHOR
-!! ------
-!! Joan Cuxart * INM and Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original August 19, 1994
-!! Modifications: February 14, 1995 (J.Cuxart and J.Stein)
-!! Doctorization and Optimization
-!! Modifications: March 21, 1995 (J.M. Carriere)
-!! Introduction of cloud water
-!! Modifications: June 14, 1995 (J.Cuxart and J. Stein)
-!! Phi3 and Psi3 at w-point + bug in the all
-!! or nothing condens.
-!! Modifications: Sept 15, 1995 (J.Cuxart and J. Stein)
-!! Change the DP computation at the ground
-!! Modifications: October 10, 1995 (J.Cuxart and J. Stein)
-!! Psi for scal var and LES tools
-!! Modifications: November 10, 1995 (J. Stein)
-!! change the surface relations
-!! Modifications: February 20, 1995 (J. Stein) optimization
-!! Modifications: May 21, 1996 (J. Stein)
-!! bug in the vertical flux of the V wind
-!! component for explicit computation
-!! Modifications: May 21, 1996 (N. wood)
-!! modify the computation of the vertical
-!! part or the surface tangential flux
-!! Modifications: May 21, 1996 (P. Jabouille)
-!! same modification in the Y direction
-!!
-!! Modifications: Sept 17, 1996 (J. Stein) change the moist case by using
-!! Pi instead of Piref + use Atheta and Amoist
-!!
-!! Modifications: Nov 24, 1997 (V. Masson) removes the DO loops
-!! Modifications: Mar 31, 1998 (V. Masson) splits the routine TURB_VER
-!! Nov 06, 2002 (V. Masson) LES budgets
-!! Feb 20, 2003 (JP Pinty) Add PFRAC_ICE
-!! July 2005 (S. Tomas, V. Masson)
-!! Add 3rd order moments and
-!! implicitation of PHI3, PSI3
-!! Oct.2009 (C.Lac) Introduction of different PTSTEP according to the
-!! advection schemes
-!! Feb. 2012 (Y. Seity) add possibility to run with
-!! reversed vertical levels
-!! 10/2012 (J.Escobar) Bypass PGI bug , redefine some allocatable array inplace of automatic
-!! 08/2014 (J.Escobar) Bypass PGI memory leak bug , replace IF statement with IF THEN ENDIF
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! JL Redelsperger 03/2021 : add Ocean LES case
-!!--------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-USE MODD_CTURB
-USE MODD_DYN_n, ONLY: LOCEAN
-use modd_field, only: tfielddata, TYPEREAL
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PARAMETERS
-USE MODD_LES
-USE MODD_NSV, ONLY: NSV
-!
-USE MODI_PRANDTL
-USE MODI_EMOIST
-USE MODI_ETHETA
-USE MODI_GRADIENT_M
-USE MODI_GRADIENT_W
-USE MODI_TURB
-USE MODI_TURB_VER_THERMO_FLUX
-USE MODI_TURB_VER_THERMO_CORR
-USE MODI_TURB_VER_DYN_FLUX
-USE MODI_TURB_VER_SV_FLUX
-USE MODI_TURB_VER_SV_CORR
-USE MODI_LES_MEAN_SUBGRID
-USE MODI_SBL_DEPTH
-!
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODE_PRANDTL
-!
-USE MODI_SECOND_MNH
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-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.
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-CHARACTER(len=4), INTENT(IN) :: HTOM ! type of Third Order Moment
-REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
-REAL, INTENT(IN) :: PTSTEP ! timestep
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX, PDYY, PDZZ, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
- ! normal to the ground surface
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitudes at flux points
-REAL, DIMENSION(:,:), INTENT(IN) :: PCOSSLOPE ! cosinus of the angle
- ! between i and the slope vector
-REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
- ! between i and the slope vector
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state Virtual
- ! Potential Temperature
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM ! surface fluxes at time
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! t - deltat
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHP,PSFRP ! surface fluxes at time
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVP ! t + deltat
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PCDUEFF ! Cd * || u || at time t
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU11M ! <uu> in the axes linked
- ! to the maximum slope direction and the surface normal and the binormal
- ! at time t - dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU12M ! <uv> in the same axes
-REAL, DIMENSION(:,:), INTENT(IN) :: PTAU33M ! <ww> in the same axes
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM,PVM,PWM,PTHLM
- ! Wind and potential temperature at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios
- ! at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-Delta t
-REAL, DIMENSION(:,:), INTENT(IN) :: PUSLOPEM ! wind component along the
- ! maximum slope direction
-REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along the
- ! direction normal to the maximum slope one
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
- ! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFRAC_ICE ! ri fraction of rc+ri
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWTH ! d(w'2th' )/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWR ! d(w'2r' )/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTH2 ! d(w'th'2 )/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFR2 ! d(w'r'2 )/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTHR ! d(w'th'r')/dz
-REAL, DIMENSION(:,:), INTENT(INOUT):: PBL_DEPTH ! BL depth
-REAL, DIMENSION(:,:), INTENT(INOUT):: PSBL_DEPTH ! SBL depth
-REAL, DIMENSION(:,:), INTENT(IN) :: PLMO ! Monin-Obukhov length
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS, PRTHLS
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS,PRRS
- ! cumulated sources for the prognostic variables
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDP,PTP ! Dynamic and thermal
- ! TKE production terms
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS ! Vert. part of Sigma_s at t
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTH ! heat flux
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWRC ! cloud water flux
-REAL, DIMENSION(:,:,:,:),INTENT(OUT) :: PWSV ! scalar flux
-
-!
-!
-!
-!
-!* 0.2 declaration of local variables
-!
-!JUAN BUG PGI
-!!$REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
-REAL, ALLOCATABLE, DIMENSION(:,:,:) :: &
- ZBETA, & ! buoyancy coefficient
- ZSQRT_TKE,& ! sqrt(e)
- ZDTH_DZ, & ! d(th)/dz
- ZDR_DZ, & ! d(rt)/dz
- ZRED2TH3, & ! 3D Redeslperger number R*2_th
- ZRED2R3, & ! 3D Redeslperger number R*2_r
- ZRED2THR3,& ! 3D Redeslperger number R*2_thr
- ZBLL_O_E, & ! beta * Lk * Leps / tke
- ZETHETA, & ! Coefficient for theta in theta_v computation
- ZEMOIST, & ! Coefficient for r in theta_v computation
- ZREDTH1, & ! 1D Redelsperger number for Th
- ZREDR1, & ! 1D Redelsperger number for r
- ZPHI3, & ! phi3 Prandtl number
- ZPSI3, & ! psi3 Prandtl number for vapor
- ZD, & ! denominator in phi3 terms
- ZWTHV, & ! buoyancy flux
- ZWU, & ! (u'w')
- ZWV, & ! (v'w')
- ZTHLP, & ! guess of potential temperature due to vert. turbulent flux
- ZRP ! guess of total water due to vert. turbulent flux
-
-!!$REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV) :: &
-REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: &
- ZPSI_SV, & ! Prandtl number for scalars
- ZREDS1, & ! 1D Redelsperger number R_sv
- ZRED2THS, & ! 3D Redelsperger number R*2_thsv
- ZRED2RS ! 3D Redelsperger number R*2_rsv
-!
-LOGICAL :: GUSERV ! flag to use water vapor
-INTEGER :: IKB,IKE ! index value for the Beginning
- ! and the End of the physical domain for the mass points
-INTEGER :: JSV ! loop counter on scalar variables
-REAL :: ZTIME1
-REAL :: ZTIME2
-TYPE(TFIELDDATA) :: TZFIELD
-!----------------------------------------------------------------------------
-ALLOCATE ( ZBETA(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZSQRT_TKE(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)),&
- ZDTH_DZ(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZDR_DZ(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZRED2TH3(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZRED2R3(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZRED2THR3(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)),&
- ZBLL_O_E(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZETHETA(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZEMOIST(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZREDTH1(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZREDR1(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZPHI3(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZPSI3(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZD(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZWTHV(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZWU(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZWV(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZTHLP(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZRP(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) )
-
-ALLOCATE ( &
- ZPSI_SV(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV), &
- ZREDS1(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV), &
- ZRED2THS(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV), &
- ZRED2RS(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV) )
-
-!----------------------------------------------------------------------------
-!
-!* 1. PRELIMINARIES
-! -------------
-!
-IKB=KKA+JPVEXT_TURB*KKL
-IKE=KKU-JPVEXT_TURB*KKL
-!
-!
-! 3D Redelsperger numbers
-!
-!
-CALL PRANDTL(KKA,KKU,KKL,KRR,KRRI,OTURB_FLX, &
- HTURBDIM, &
- TPFILE, &
- PDXX,PDYY,PDZZ,PDZX,PDZY, &
- PTHVREF,PLOCPEXNM,PATHETA,PAMOIST, &
- PLM,PLEPS,PTKEM,PTHLM,PRM,PSVM,PSRCM, &
- ZREDTH1, ZREDR1, &
- ZRED2TH3, ZRED2R3, ZRED2THR3, &
- ZREDS1,ZRED2THS, ZRED2RS, &
- ZBLL_O_E, &
- ZETHETA, ZEMOIST )
-!
-! Buoyancy coefficient
-!
-IF (LOCEAN) THEN
- ZBETA = XG*XALPHAOC
-ELSE
- ZBETA = XG/PTHVREF
-END IF
-!
-! Square root of Tke
-!
-ZSQRT_TKE = SQRT(PTKEM)
-!
-! gradients of mean quantities at previous time-step
-!
-ZDTH_DZ = GZ_M_W(KKA,KKU,KKL,PTHLM(:,:,:),PDZZ)
-ZDR_DZ = 0.
-IF (KRR>0) THEN
-ZDR_DZ = GZ_M_W(KKA,KKU,KKL,PRM(:,:,:,1),PDZZ)
-ENDIF
-!
-!
-! Denominator factor in 3rd order terms
-!
-ZD(:,:,:) = (1.+ZREDTH1+ZREDR1) * (1.+0.5*(ZREDTH1+ZREDR1))
-!
-! Phi3 and Psi3 Prandtl numbers
-!
-GUSERV = KRR/=0
-!
-ZPHI3 = PHI3(ZREDTH1,ZREDR1,ZRED2TH3,ZRED2R3,ZRED2THR3,HTURBDIM,GUSERV)
-IF(KRR/=0) THEN
-ZPSI3 = PSI3(ZREDR1,ZREDTH1,ZRED2R3,ZRED2TH3,ZRED2THR3,HTURBDIM,GUSERV)
-ENDIF
-!
-! Prandtl numbers for scalars
-!
-ZPSI_SV = PSI_SV(ZREDTH1,ZREDR1,ZREDS1,ZRED2THS,ZRED2RS,ZPHI3,ZPSI3)
-!
-! LES diagnostics
-!
-IF (LLES_CALL) THEN
- CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID(ZPHI3,X_LES_SUBGRID_PHI3)
- IF(KRR/=0) THEN
- CALL LES_MEAN_SUBGRID(ZPSI3,X_LES_SUBGRID_PSI3)
- END IF
- CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
-END IF
-!----------------------------------------------------------------------------
-!
-!
-!* 2. SOURCES OF CONSERVATIVE POTENTIAL TEMPERATURE AND
-! PARTIAL THERMAL PRODUCTION
-! ---------------------------------------------------------------
-!
-!* 3. SOURCES OF CONSERVATIVE AND CLOUD MIXING RATIO AND
-! COMPLETE THERMAL PRODUCTION
-! ------------------------------------------------------
-!
-!* 4. TURBULENT CORRELATIONS : <w Rc>, <THl THl>, <THl Rnp>, <Rnp Rnp>
-! ----------------------------------------------------------------
-!
-!
- CALL TURB_VER_THERMO_FLUX(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- OTURB_FLX,HTURBDIM,HTOM, &
- PIMPL,PEXPL,PTSTEP, &
- TPFILE, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
- PRHODJ,PTHVREF, &
- PSFTHM,PSFRM,PSFTHP,PSFRP, &
- PWM,PTHLM,PRM,PSVM, &
- PTKEM,PLM,PLEPS, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
- ZBETA, ZSQRT_TKE, ZDTH_DZ, ZDR_DZ, ZRED2TH3, &
- ZRED2R3, ZRED2THR3, ZBLL_O_E, ZETHETA, &
- ZEMOIST, ZREDTH1, ZREDR1, ZPHI3, ZPSI3, ZD, &
- PFWTH,PFWR,PFTH2,PFR2,PFTHR,PBL_DEPTH,ZWTHV, &
- PRTHLS,PRRS,ZTHLP,ZRP,PTP,PWTH,PWRC )
-!
- CALL TURB_VER_THERMO_CORR(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- OTURB_FLX,HTURBDIM,HTOM, &
- PIMPL,PEXPL, &
- TPFILE, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW, &
- PRHODJ,PTHVREF, &
- PSFTHM,PSFRM,PSFTHP,PSFRP, &
- PWM,PTHLM,PRM,PSVM, &
- PTKEM,PLM,PLEPS, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM, &
- ZBETA, ZSQRT_TKE, ZDTH_DZ, ZDR_DZ, ZRED2TH3, &
- ZRED2R3, ZRED2THR3, ZBLL_O_E, ZETHETA, &
- ZEMOIST, ZREDTH1, ZREDR1, ZPHI3, ZPSI3, ZD, &
- PFWTH,PFWR,PFTH2,PFR2,PFTHR, &
- ZTHLP,ZRP,PSIGS )
-!
-!----------------------------------------------------------------------------
-!
-!
-!
-!* 5. SOURCES OF U,W WIND COMPONENTS AND PARTIAL DYNAMIC PRODUCTION
-! -------------------------------------------------------------
-!
-!* 6. SOURCES OF V,W WIND COMPONENTS AND COMPLETE 1D DYNAMIC PRODUCTION
-! -----------------------------------------------------------------
-!
-!* 7. DIAGNOSTIC COMPUTATION OF THE 1D <W W> VARIANCE
-! -----------------------------------------------
-!
-CALL TURB_VER_DYN_FLUX(KKA,KKU,KKL, &
- OTURB_FLX,KRR, &
- HTURBDIM,PIMPL,PEXPL,PTSTEP, &
- TPFILE, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
- PCOSSLOPE,PSINSLOPE, &
- PRHODJ, &
- PCDUEFF,PTAU11M,PTAU12M,PTAU33M, &
- PTHLM,PRM,PSVM,PUM,PVM,PWM,PUSLOPEM,PVSLOPEM, &
- PTKEM,PLM,ZWU,ZWV, &
- PRUS,PRVS,PRWS, &
- PDP,PTP )
-!
-!----------------------------------------------------------------------------
-!
-!
-!* 8. SOURCES OF PASSIVE SCALAR VARIABLES
-! -----------------------------------
-!
-IF (SIZE(PSVM,4)>0) &
-CALL TURB_VER_SV_FLUX(KKA,KKU,KKL, &
- OTURB_FLX,HTURBDIM, &
- PIMPL,PEXPL,PTSTEP, &
- TPFILE, &
- PDZZ,PDIRCOSZW, &
- PRHODJ,PWM, &
- PSFSVM,PSFSVP, &
- PSVM, &
- PTKEM,PLM,ZPSI_SV, &
- PRSVS,PWSV )
-!
-!
-IF (SIZE(PSVM,4)>0 .AND. LLES_CALL) &
-CALL TURB_VER_SV_CORR(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- PDZZ, &
- PTHLM,PRM,PTHVREF, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM,ZPHI3,ZPSI3, &
- PWM,PSVM, &
- PTKEM,PLM,PLEPS,ZPSI_SV )
-!
-!
-!----------------------------------------------------------------------------
-!
-!* 9. DIAGNOSTIC OF Surface Boundary Layer Depth
-! ------------------------------------------
-!
-IF (SIZE(PSBL_DEPTH)>0) CALL SBL_DEPTH(IKB,IKE,PZZ,ZWU,ZWV,ZWTHV,PLMO,PSBL_DEPTH)
-!
-!----------------------------------------------------------------------------
-!
-!
-!* 10. PRINTS
-! ------
-!
-!
-IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
-!
-! stores the Turbulent Prandtl number
-!
- TZFIELD%CMNHNAME = 'PHI3'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'PHI3'
- TZFIELD%CUNITS = '1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'Turbulent Prandtl number'
- TZFIELD%NGRID = 4
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZPHI3)
-!
-! stores the Turbulent Schmidt number
-!
- TZFIELD%CMNHNAME = 'PSI3'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'PSI3'
- TZFIELD%CUNITS = '1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'Turbulent Schmidt number'
- TZFIELD%NGRID = 4
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZPSI3)
-!
-!
-! stores the Turbulent Schmidt number for the scalar variables
-!
- TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = '1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%NGRID = 4
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- DO JSV=1,NSV
- WRITE(TZFIELD%CMNHNAME, '("PSI_SV_",I3.3)') JSV
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
- CALL IO_Field_write(TPFILE,TZFIELD,ZPSI_SV(:,:,:,JSV))
- END DO
-!
-END IF
-!
-!
-!----------------------------------------------------------------------------
-END SUBROUTINE TURB_VER
diff --git a/src/mesonh/turb/turb_ver_sv_corr.f90 b/src/mesonh/turb/turb_ver_sv_corr.f90
deleted file mode 100644
index b62268e7e82a28d876844fb7abbbcaa02f3e87d0..0000000000000000000000000000000000000000
--- a/src/mesonh/turb/turb_ver_sv_corr.f90
+++ /dev/null
@@ -1,223 +0,0 @@
-!MNH_LIC Copyright 2002-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_TURB_VER_SV_CORR
-! ####################
-!
-INTERFACE
-!
- SUBROUTINE TURB_VER_SV_CORR(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- PDZZ, &
- PTHLM,PRM,PTHVREF, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PPHI3,PPSI3, &
- PWM,PSVM, &
- PTKEM,PLM,PLEPS,PPSI_SV )
-!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-INTEGER, INTENT(IN) :: KRRL ! number of liquid var.
-INTEGER, INTENT(IN) :: KRRI ! number of ice var.
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ
- ! Metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM ! potential temperature at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios at t-Delta t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! reference Thv
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
- ! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3 ! Inv.Turb.Sch.for temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3 ! Inv.Turb.Sch.for humidity
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM ! w at time t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-Delta t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PPSI_SV ! Inv.Turb.Sch.for scalars
- ! cumulated sources for the prognostic variables
-!
-!
-END SUBROUTINE TURB_VER_SV_CORR
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_VER_SV_CORR
-!
-!
-! ###############################################################
- SUBROUTINE TURB_VER_SV_CORR(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- PDZZ, &
- PTHLM,PRM,PTHVREF, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PPHI3,PPSI3, &
- PWM,PSVM, &
- PTKEM,PLM,PLEPS,PPSI_SV )
-! ###############################################################
-!
-!
-!!**** *TURB_VER_SV_CORR* -compute the subgrid Sv2 and SvThv terms
-!!
-!! PURPOSE
-!! -------
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! FUNCTIONs ETHETA and EMOIST :
-!! allows to compute:
-!! - the coefficients for the turbulent correlation between
-!! any variable and the virtual potential temperature, of its
-!! correlations with the conservative potential temperature and
-!! the humidity conservative variable:
-!! ------- ------- -------
-!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original October 29, 2002
-!! JP Pinty Feb 20, 2003 Add PFRAC_ICE
-!!--------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-USE MODD_CTURB
-USE MODD_PARAMETERS
-USE MODD_LES
-USE MODD_CONF
-USE MODD_NSV, ONLY : NSV,NSV_LGBEG,NSV_LGEND
-USE MODD_BLOWSNOW
-!
-!
-USE MODI_GRADIENT_U
-USE MODI_GRADIENT_V
-USE MODI_GRADIENT_W
-USE MODI_GRADIENT_M
-USE MODI_SHUMAN
-USE MODI_EMOIST
-USE MODI_ETHETA
-USE MODI_LES_MEAN_SUBGRID
-!
-USE MODI_SECOND_MNH
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-INTEGER, INTENT(IN) :: KRR ! number of moist var.
-INTEGER, INTENT(IN) :: KRRL ! number of liquid var.
-INTEGER, INTENT(IN) :: KRRI ! number of ice var.
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ
- ! Metric coefficients
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM ! potential temperature at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios at t-Delta t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! reference Thv
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
- ! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3 ! Inv.Turb.Sch.for temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3 ! Inv.Turb.Sch.for humidity
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM ! w at time t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-Delta t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PPSI_SV ! Inv.Turb.Sch.for scalars
- ! cumulated sources for the prognostic variables
-!
-!
-!
-!
-!* 0.2 declaration of local variables
-!
-!
-REAL, DIMENSION(SIZE(PSVM,1),SIZE(PSVM,2),SIZE(PSVM,3)) :: &
- ZA, ZFLXZ
-!
-REAL :: ZCSV !constant for the scalar flux
-!
-INTEGER :: JSV ! loop counters
-!
-REAL :: ZTIME1, ZTIME2
-!
-REAL :: ZCSVD = 1.2 ! constant for scalar variance dissipation
-REAL :: ZCTSVD = 2.4 ! constant for temperature - scalar covariance dissipation
-REAL :: ZCQSVD = 2.4 ! constant for humidity - scalar covariance dissipation
-!----------------------------------------------------------------------------
-!
-CALL SECOND_MNH(ZTIME1)
-!
-IF(LBLOWSNOW) THEN
-! See Vionnet (PhD, 2012) for a complete discussion around the value of the Schmidt number for blowing snow variables
- ZCSV= XCHF/XRSNOW
-ELSE
- ZCSV= XCHF
-ENDIF
-!
-DO JSV=1,NSV
- !
- IF (LNOMIXLG .AND. JSV >= NSV_LGBEG .AND. JSV<= NSV_LGEND) CYCLE
- !
- ! variance Sv2
- !
- IF (LLES_CALL) THEN
- ! approximation: diagnosed explicitely (without implicit term)
- ZFLXZ(:,:,:) = PPSI_SV(:,:,:,JSV)*GZ_M_W(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDZZ)**2
- ZFLXZ(:,:,:) = ZCSV / ZCSVD * PLM * PLEPS * MZF(ZFLXZ(:,:,:) )
- CALL LES_MEAN_SUBGRID( -2.*ZCSVD*SQRT(PTKEM)*ZFLXZ/PLEPS, X_LES_SUBGRID_DISS_Sv2(:,:,:,JSV) )
- CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLXZ, X_LES_RES_W_SBG_Sv2(:,:,:,JSV) )
- END IF
- !
- ! covariance ThvSv
- !
- IF (LLES_CALL) THEN
- ! approximation: diagnosed explicitely (without implicit term)
- ZA(:,:,:) = ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM)
- ZFLXZ(:,:,:)= ( XCSHF * PPHI3 + ZCSV * PPSI_SV(:,:,:,JSV) ) &
- * GZ_M_W(KKA,KKU,KKL,PTHLM,PDZZ) &
- * GZ_M_W(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDZZ)
- ZFLXZ(:,:,:)= PLM * PLEPS / (2.*ZCTSVD) * MZF(ZFLXZ)
- CALL LES_MEAN_SUBGRID( ZA*ZFLXZ, X_LES_SUBGRID_SvThv(:,:,:,JSV) )
- CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLXZ, X_LES_SUBGRID_SvPz(:,:,:,JSV), .TRUE.)
- !
- IF (KRR>=1) THEN
- ZA(:,:,:) = EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM)
- ZFLXZ(:,:,:)= ( XCHF * PPSI3 + ZCSV * PPSI_SV(:,:,:,JSV) ) &
- * GZ_M_W(KKA,KKU,KKL,PRM(:,:,:,1),PDZZ) &
- * GZ_M_W(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDZZ)
- ZFLXZ(:,:,:)= PLM * PLEPS / (2.*ZCQSVD) * MZF(ZFLXZ)
- CALL LES_MEAN_SUBGRID( ZA*ZFLXZ, X_LES_SUBGRID_SvThv(:,:,:,JSV) , .TRUE.)
- CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLXZ, X_LES_SUBGRID_SvPz(:,:,:,JSV), .TRUE.)
- END IF
- END IF
- !
-END DO ! end of scalar loop
-!
-CALL SECOND_MNH(ZTIME2)
-XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
-!----------------------------------------------------------------------------
-!
-END SUBROUTINE TURB_VER_SV_CORR
diff --git a/src/mesonh/turb/turb_ver_sv_flux.f90 b/src/mesonh/turb/turb_ver_sv_flux.f90
deleted file mode 100644
index 23d8bee0342d4fc3a6f28f73733d8f35c27308bc..0000000000000000000000000000000000000000
--- a/src/mesonh/turb/turb_ver_sv_flux.f90
+++ /dev/null
@@ -1,490 +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_TURB_VER_SV_FLUX
-! ####################
-!
-INTERFACE
-!
- SUBROUTINE TURB_VER_SV_FLUX(KKA,KKU,KKL, &
- OTURB_FLX,HTURBDIM, &
- PIMPL,PEXPL, &
- PTSTEP, &
- TPFILE, &
- PDZZ,PDIRCOSZW, &
- PRHODJ,PWM, &
- PSFSVM,PSFSVP, &
- PSVM, &
- PTKEM,PLM,PPSI_SV, &
- PRSVS,PWSV )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=AR
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
-REAL, INTENT(IN) :: PTSTEP ! Double Time Step
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ
- ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
- ! normal to the ground surface
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! t - deltat
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVP ! t + deltat
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-Delta t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM ! vertical wind
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PPSI_SV ! Inv.Turb.Sch.for scalars
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
- ! cumulated sources for the prognostic variables
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PWSV ! scalar flux
-
-!
-!
-END SUBROUTINE TURB_VER_SV_FLUX
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_VER_SV_FLUX
-!
-!
-! ###############################################################
- SUBROUTINE TURB_VER_SV_FLUX(KKA,KKU,KKL, &
- OTURB_FLX,HTURBDIM, &
- PIMPL,PEXPL, &
- PTSTEP, &
- TPFILE, &
- PDZZ,PDIRCOSZW, &
- PRHODJ,PWM, &
- PSFSVM,PSFSVP, &
- PSVM, &
- PTKEM,PLM,PPSI_SV, &
- PRSVS,PWSV )
-!
-
-!
-!
-!!**** *TURB_VER_SV_FLUX* -compute the source terms due to the vertical turbulent
-!! fluxes.
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to compute the vertical turbulent
-! fluxes of the evolutive variables and give back the source
-! terms to the main program. In the case of large horizontal meshes,
-! the divergence of these vertical turbulent fluxes represent the whole
-! effect of the turbulence but when the three-dimensionnal version of
-! the turbulence scheme is activated (CTURBDIM="3DIM"), these divergences
-! are completed in the next routine TURB_HOR.
-! An arbitrary degree of implicitness has been implemented for the
-! temporal treatment of these diffusion terms.
-! The vertical boundary conditions are as follows:
-! * at the bottom, the surface fluxes are prescribed at the same
-! as the other turbulent fluxes
-! * at the top, the turbulent fluxes are set to 0.
-! It should be noted that the condensation has been implicitely included
-! in this turbulence scheme by using conservative variables and computing
-! the subgrid variance of a statistical variable s indicating the presence
-! or not of condensation in a given mesh.
-!
-!!** METHOD
-!! ------
-!! 1D type calculations are made;
-!! The vertical turbulent fluxes are computed in an off-centered
-!! implicit scheme (a Crank-Nicholson type with coefficients different
-!! than 0.5), which allows to vary the degree of implicitness of the
-!! formulation.
-!! The different prognostic variables are treated one by one.
-!! The contributions of each turbulent fluxes are cumulated into the
-!! tendency PRvarS, and into the dynamic and thermal production of
-!! TKE if necessary.
-!!
-!! In section 2 and 3, the thermodynamical fields are considered.
-!! Only the turbulent fluxes of the conservative variables
-!! (Thetal and Rnp stored in PRx(:,:,:,1)) are computed.
-!! Note that the turbulent fluxes at the vertical
-!! boundaries are given either by the soil scheme for the surface one
-!! ( at the same instant as the others fluxes) and equal to 0 at the
-!! top of the model. The thermal production is computed by vertically
-!! averaging the turbulent flux and multiply this flux at the mass point by
-!! a function ETHETA or EMOIST, which preform the transformation from the
-!! conservative variables to the virtual potential temperature.
-!!
-!! In section 4, the variance of the statistical variable
-!! s indicating presence or not of condensation, is determined in function
-!! of the turbulent moments of the conservative variables and its
-!! squarred root is stored in PSIGS. This information will be completed in
-!! the horizontal turbulence if the turbulence dimensionality is not
-!! equal to "1DIM".
-!!
-!! In section 5, the x component of the stress tensor is computed.
-!! The surface flux <u'w'> is computed from the value of the surface
-!! fluxes computed in axes linked to the orography ( i", j" , k"):
-!! i" is parallel to the surface and in the direction of the maximum
-!! slope
-!! j" is also parallel to the surface and in the normal direction of
-!! the maximum slope
-!! k" is the normal to the surface
-!! In order to prevent numerical instability, the implicit scheme has
-!! been extended to the surface flux regarding to its dependence in
-!! function of U. The dependence in function of the other components
-!! introduced by the different rotations is only explicit.
-!! The turbulent fluxes are used to compute the dynamic production of
-!! TKE. For the last TKE level ( located at PDZZ(:,:,IKB)/2 from the
-!! ground), an harmonic extrapolation from the dynamic production at
-!! PDZZ(:,:,IKB) is used to avoid an evaluation of the gradient of U
-!! in the surface layer.
-!!
-!! In section 6, the same steps are repeated but for the y direction
-!! and in section 7, a diagnostic computation of the W variance is
-!! performed.
-!!
-!! In section 8, the turbulent fluxes for the scalar variables are
-!! computed by the same way as the conservative thermodynamical variables
-!!
-!!
-!! EXTERNAL
-!! --------
-!! GX_U_M, GY_V_M, GZ_W_M : cartesian gradient operators
-!! GX_U_UW,GY_V_VW (X,Y,Z) represent the direction of the gradient
-!! _(M,U,...)_ represent the localization of the
-!! field to be derivated
-!! _(M,UW,...) represent the localization of the
-!! field derivated
-!!
-!!
-!! MXM,MXF,MYM,MYF,MZM,MZF
-!! : Shuman functions (mean operators)
-!! DXF,DYF,DZF,DZM
-!! : Shuman functions (difference operators)
-!!
-!! SUBROUTINE TRIDIAG : to compute the split implicit evolution
-!! of a variable located at a mass point
-!!
-!! SUBROUTINE TRIDIAG_WIND: to compute the split implicit evolution
-!! of a variable located at a wind point
-!!
-!! FUNCTIONs ETHETA and EMOIST :
-!! allows to compute:
-!! - the coefficients for the turbulent correlation between
-!! any variable and the virtual potential temperature, of its
-!! correlations with the conservative potential temperature and
-!! the humidity conservative variable:
-!! ------- ------- -------
-!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CST : contains physical constants
-!!
-!! XG : gravity constant
-!!
-!! Module MODD_CTURB: contains the set of constants for
-!! the turbulence scheme
-!!
-!! XCMFS,XCMFB : cts for the momentum flux
-!! XCSHF : ct for the sensible heat flux
-!! XCHF : ct for the moisture flux
-!! XCTV,XCHV : cts for the T and moisture variances
-!!
-!! Module MODD_PARAMETERS
-!!
-!! JPVEXT_TURB : number of vertical external points
-!! JPHEXT : number of horizontal external points
-!!
-!!
-!! REFERENCE
-!! ---------
-!! Book 1 of documentation (Chapter: Turbulence)
-!!
-!! AUTHOR
-!! ------
-!! Joan Cuxart * INM and Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original August 19, 1994
-!! Modifications: February 14, 1995 (J.Cuxart and J.Stein)
-!! Doctorization and Optimization
-!! Modifications: March 21, 1995 (J.M. Carriere)
-!! Introduction of cloud water
-!! Modifications: June 14, 1995 (J.Cuxart and J. Stein)
-!! Phi3 and Psi3 at w-point + bug in the all
-!! or nothing condens.
-!! Modifications: Sept 15, 1995 (J.Cuxart and J. Stein)
-!! Change the DP computation at the ground
-!! Modifications: October 10, 1995 (J.Cuxart and J. Stein)
-!! Psi for scal var and LES tools
-!! Modifications: November 10, 1995 (J. Stein)
-!! change the surface relations
-!! Modifications: February 20, 1995 (J. Stein) optimization
-!! Modifications: May 21, 1996 (J. Stein)
-!! bug in the vertical flux of the V wind
-!! component for explicit computation
-!! Modifications: May 21, 1996 (N. wood)
-!! modify the computation of the vertical
-!! part or the surface tangential flux
-!! Modifications: May 21, 1996 (P. Jabouille)
-!! same modification in the Y direction
-!!
-!! Modifications: Sept 17, 1996 (J. Stein) change the moist case by using
-!! Pi instead of Piref + use Atheta and Amoist
-!!
-!! Modifications: Nov 24, 1997 (V. Masson) removes the DO loops
-!! Modifications: Mar 31, 1998 (V. Masson) splits the routine TURB_VER_SV_FLUX
-!! Modifications: Dec 01, 2000 (V. Masson) conservation of scalar emission
-!! from surface in 1DIM case
-!! when slopes are present
-!! Jun 20, 2001 (J Stein) case of lagragian variables
-!! Nov 06, 2002 (V. Masson) LES budgets
-!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
-!! change of YCOMMENT
-!! Feb 2012(Y. Seity) add possibility to run with reversed
-!! vertical levels
-!! Feb 2017(M. Leriche) add initialisation of ZSOURCE
-!! to avoid unknwon values outside physical domain
-!! and avoid negative values in sv tendencies
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!--------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-USE MODD_CTURB
-use modd_field, only: tfielddata, TYPEREAL
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PARAMETERS
-USE MODD_LES
-USE MODD_CONF
-USE MODD_NSV, ONLY: XSVMIN, NSV_LGBEG, NSV_LGEND
-USE MODD_BLOWSNOW
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
-!
-USE MODI_GRADIENT_U
-USE MODI_GRADIENT_V
-USE MODI_GRADIENT_W
-USE MODI_GRADIENT_M
-USE MODI_SHUMAN
-USE MODI_TRIDIAG
-USE MODI_TRIDIAG_WIND
-USE MODI_EMOIST
-USE MODI_ETHETA
-USE MODI_LES_MEAN_SUBGRID
-!
-USE MODI_SECOND_MNH
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
-REAL, INTENT(IN) :: PTSTEP ! Double Time Step
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ
- ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
- ! normal to the ground surface
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVM ! t - deltat
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSVP ! t + deltat
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-Delta t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM ! vertical wind
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PPSI_SV ! Inv.Turb.Sch.for scalars
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
- ! cumulated sources for the prognostic variables
-REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PWSV ! scalar flux
-!
-!
-!
-!
-!* 0.2 declaration of local variables
-!
-!
-REAL, DIMENSION(SIZE(PSVM,1),SIZE(PSVM,2),SIZE(PSVM,3)) :: &
- ZA, & ! under diagonal elements of the tri-diagonal matrix involved
- ! in the temporal implicit scheme (also used to store coefficient
- ! J in Section 5)
- ZRES, & ! guess of the treated variable at t+ deltat when the turbu-
- ! lence is the only source of evolution added to the ones
- ! considered in ZSOURCE
- ZFLXZ, & ! vertical flux of the treated variable
- ZSOURCE, & ! source of evolution for the treated variable
- ZKEFF ! effectif diffusion coeff = LT * SQRT( TKE )
-INTEGER :: IKB,IKE ! I index values for the Beginning and End
- ! mass points of the domain in the 3 direct.
-INTEGER :: IKT ! array size in k direction
-INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
-INTEGER :: JSV ! loop counters
-INTEGER :: JK ! loop
-INTEGER :: ISV ! number of scalar var.
-!
-REAL :: ZTIME1, ZTIME2
-
-REAL :: ZCSVP = 4.0 ! constant for scalar flux presso-correlation (RS81)
-REAL :: ZCSV !constant for the scalar flux
-!
-TYPE(TFIELDDATA) :: TZFIELD
-!----------------------------------------------------------------------------
-!
-!* 1. PRELIMINARIES
-! -------------
-!
-IKB=KKA+JPVEXT_TURB*KKL
-IKE=KKU-JPVEXT_TURB*KKL
-IKT=SIZE(PSVM,3)
-IKTE =IKT-JPVEXT_TURB
-IKTB =1+JPVEXT_TURB
-!
-ISV=SIZE(PSVM,4)
-!
-ZKEFF(:,:,:) = MZM( PLM(:,:,:) * SQRT(PTKEM(:,:,:)) )
-!
-IF(LBLOWSNOW) THEN
-! See Vionnet (PhD, 2012) for a complete discussion around the value of the Schmidt number for blowing snow variables
- ZCSV= XCHF/XRSNOW
-ELSE
- ZCSV= XCHF
-ENDIF
-!----------------------------------------------------------------------------
-!
-!* 8. SOURCES OF PASSIVE SCALAR VARIABLES
-! -----------------------------------
-!
-DO JSV=1,ISV
-!
- IF (LNOMIXLG .AND. JSV >= NSV_LGBEG .AND. JSV<= NSV_LGEND) CYCLE
-!
-! Preparation of the arguments for TRIDIAG
- ZA(:,:,:) = -PTSTEP*ZCSV*PPSI_SV(:,:,:,JSV) * &
- ZKEFF * MZM(PRHODJ) / &
- PDZZ**2
- ZSOURCE(:,:,:) = 0.
-!
-! Compute the sources for the JSVth scalar variable
-
-!* in 3DIM case, a part of the flux goes vertically, and another goes horizontally
-! (in presence of slopes)
-!* in 1DIM case, the part of energy released in horizontal flux
-! is taken into account in the vertical part
- IF (HTURBDIM=='3DIM') THEN
- ZSOURCE(:,:,IKB) = (PIMPL*PSFSVP(:,:,JSV) + PEXPL*PSFSVM(:,:,JSV)) / &
- PDZZ(:,:,IKB) * PDIRCOSZW(:,:) &
- * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
- ELSE
-
- ZSOURCE(:,:,IKB) = (PIMPL*PSFSVP(:,:,JSV) + PEXPL*PSFSVM(:,:,JSV)) / &
- PDZZ(:,:,IKB) / PDIRCOSZW(:,:) &
- * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
- END IF
- ZSOURCE(:,:,IKTB+1:IKTE-1) = 0.
- ZSOURCE(:,:,IKE) = 0.
-!
-! Obtention of the split JSV scalar variable at t+ deltat
- CALL TRIDIAG(KKA,KKU,KKL,PSVM(:,:,:,JSV),ZA,PTSTEP,PEXPL,PIMPL,PRHODJ,ZSOURCE,ZRES)
-!
-! Compute the equivalent tendency for the JSV scalar variable
- PRSVS(:,:,:,JSV)= PRSVS(:,:,:,JSV)+ &
- PRHODJ(:,:,:)*(ZRES(:,:,:)-PSVM(:,:,:,JSV))/PTSTEP
-! PRSVS(:,:,:,JSV)= MAX((PRSVS(:,:,:,JSV)+ &
-! PRHODJ(:,:,:)*(ZRES(:,:,:)-PSVM(:,:,:,JSV))/PTSTEP),XSVMIN(JSV))
-!
- IF ( (OTURB_FLX .AND. tpfile%lopened) .OR. LLES_CALL ) THEN
- ! Diagnostic of the cartesian vertical flux
- !
- ZFLXZ(:,:,:) = -ZCSV * PPSI_SV(:,:,:,JSV) * MZM(PLM*SQRT(PTKEM)) / PDZZ * &
- DZM( PIMPL*ZRES(:,:,:) + PEXPL*PSVM(:,:,:,JSV) )
- ! surface flux
- !* in 3DIM case, a part of the flux goes vertically, and another goes horizontally
- ! (in presence of slopes)
- !* in 1DIM case, the part of energy released in horizontal flux
- ! is taken into account in the vertical part
- IF (HTURBDIM=='3DIM') THEN
- ZFLXZ(:,:,IKB) = (PIMPL*PSFSVP(:,:,JSV) + PEXPL*PSFSVM(:,:,JSV)) &
- * PDIRCOSZW(:,:)
- ELSE
- ZFLXZ(:,:,IKB) = (PIMPL*PSFSVP(:,:,JSV) + PEXPL*PSFSVM(:,:,JSV)) &
- / PDIRCOSZW(:,:)
- END IF
- ! extrapolates the flux under the ground so that the vertical average with
- ! the IKB flux gives the ground value
- ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
- DO JK=IKTB+1,IKTE-1
- PWSV(:,:,JK,JSV)=0.5*(ZFLXZ(:,:,JK)+ZFLXZ(:,:,JK+KKL))
- END DO
- PWSV(:,:,IKB,JSV)=0.5*(ZFLXZ(:,:,IKB)+ZFLXZ(:,:,IKB+KKL))
- PWSV(:,:,IKE,JSV)=PWSV(:,:,IKE-KKL,JSV)
- END IF
- !
- IF (OTURB_FLX .AND. tpfile%lopened) THEN
- ! stores the JSVth vertical flux
- WRITE(TZFIELD%CMNHNAME,'("WSV_FLX_",I3.3)') JSV
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- !PW: TODO: use the correct units of the JSV variable (and multiply it by m s-1)
- TZFIELD%CUNITS = 'SVUNIT m s-1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME)
- TZFIELD%NGRID = 4
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- !
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
- END IF
- !
- ! Storage in the LES configuration
- !
- IF (LLES_CALL) THEN
- CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( MZF(ZFLXZ), X_LES_SUBGRID_WSv(:,:,:,JSV) )
- CALL LES_MEAN_SUBGRID( GZ_W_M(PWM,PDZZ)*MZF(ZFLXZ), &
- X_LES_RES_ddxa_W_SBG_UaSv(:,:,:,JSV) )
- CALL LES_MEAN_SUBGRID( MZF(GZ_M_W(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDZZ)*ZFLXZ), &
- X_LES_RES_ddxa_Sv_SBG_UaSv(:,:,:,JSV) )
- CALL LES_MEAN_SUBGRID( -ZCSVP*SQRT(PTKEM)/PLM*MZF(ZFLXZ), X_LES_SUBGRID_SvPz(:,:,:,JSV) )
- CALL LES_MEAN_SUBGRID( MZF(PWM*ZFLXZ), X_LES_RES_W_SBG_WSv(:,:,:,JSV) )
- CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
- END IF
- !
-END DO ! end of scalar loop
-!
-!----------------------------------------------------------------------------
-!
-END SUBROUTINE TURB_VER_SV_FLUX
diff --git a/src/mesonh/turb/turb_ver_thermo_corr.f90 b/src/mesonh/turb/turb_ver_thermo_corr.f90
deleted file mode 100644
index bdd074e5c52af78809d84b8fa5077d56e12a76d5..0000000000000000000000000000000000000000
--- a/src/mesonh/turb/turb_ver_thermo_corr.f90
+++ /dev/null
@@ -1,848 +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_TURB_VER_THERMO_CORR
-! ####################
-!
-INTERFACE
-!
- SUBROUTINE TURB_VER_THERMO_CORR(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- OTURB_FLX,HTURBDIM,HTOM, &
- PIMPL,PEXPL, &
- TPFILE, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW, &
- PRHODJ,PTHVREF, &
- PSFTHM,PSFRM,PSFTHP,PSFRP, &
- PWM,PTHLM,PRM,PSVM, &
- PTKEM,PLM,PLEPS, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM, &
- PBETA, PSQRT_TKE, PDTH_DZ, PDR_DZ, PRED2TH3, &
- PRED2R3, PRED2THR3, PBLL_O_E, PETHETA, &
- PEMOIST, PREDTH1, PREDR1, PPHI3, PPSI3, PD, &
- PFWTH,PFWR,PFTH2,PFR2,PFTHR, &
- PTHLP,PRP,PSIGS )
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=AR
-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.
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-CHARACTER(len=4), INTENT(IN) :: HTOM ! type of Third Order Moment
-REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ, PDXX, PDYY, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
- ! normal to the ground surface
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state Virtual
- ! Potential Temperature
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM ! surface fluxes at time
-! ! t - deltat
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHP,PSFRP ! surface fluxes at time
-! ! t + deltat
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM
-! Vertical wind
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
-! potential temperature at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios
- ! at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Mixing ratios
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
- ! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PBETA ! buoyancy coefficient
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE ! sqrt(e)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTH_DZ ! d(th)/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDR_DZ ! d(rt)/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2TH3 ! 3D Redeslperger number R*2_th
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2R3 ! 3D Redeslperger number R*2_r
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2THR3 ! 3D Redeslperger number R*2_thr
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E ! beta * Lk * Leps / tke
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA ! Coefficient for theta in theta_v computation
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST ! Coefficient for r in theta_v computation
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1 ! 1D Redelsperger number for Th
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1 ! 1D Redelsperger number for r
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3 ! Prandtl number for temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3 ! Prandtl number for vapor
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PD ! Denominator in Prandtl numbers
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWTH ! d(w'2th' )/dz (at flux point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWR ! d(w'2r' )/dz (at flux point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTH2 ! d(w'th'2 )/dz (at mass point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFR2 ! d(w'r'2 )/dz (at mass point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTHR ! d(w'th'r')/dz (at mass point)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLP ! guess of thl at t+ deltat
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRP ! guess of r at t+ deltat
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS ! Vert. part of Sigma_s at t
-!
-!
-!
-END SUBROUTINE TURB_VER_THERMO_CORR
-!
-END INTERFACE
-!
-END MODULE MODI_TURB_VER_THERMO_CORR
-!
-!
-! ###############################################################
- SUBROUTINE TURB_VER_THERMO_CORR(KKA,KKU,KKL,KRR, KRRL, KRRI, &
- OTURB_FLX,HTURBDIM,HTOM, &
- PIMPL,PEXPL, &
- TPFILE, &
- PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW, &
- PRHODJ,PTHVREF, &
- PSFTHM,PSFRM,PSFTHP,PSFRP, &
- PWM,PTHLM,PRM,PSVM, &
- PTKEM,PLM,PLEPS, &
- PLOCPEXNM,PATHETA,PAMOIST,PSRCM, &
- PBETA, PSQRT_TKE, PDTH_DZ, PDR_DZ, PRED2TH3, &
- PRED2R3, PRED2THR3, PBLL_O_E, PETHETA, &
- PEMOIST, PREDTH1, PREDR1, PPHI3, PPSI3, PD, &
- PFWTH,PFWR,PFTH2,PFR2,PFTHR, &
- PTHLP,PRP,PSIGS )
-! ###############################################################
-!
-!
-!!**** *TURB_VER_THERMO_FLUX* -compute the source terms due to the vertical turbulent
-!! fluxes.
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to compute the vertical turbulent
-! fluxes of the evolutive variables and give back the source
-! terms to the main program. In the case of large horizontal meshes,
-! the divergence of these vertical turbulent fluxes represent the whole
-! effect of the turbulence but when the three-dimensionnal version of
-! the turbulence scheme is activated (CTURBDIM="3DIM"), these divergences
-! are completed in the next routine TURB_HOR.
-! An arbitrary degree of implicitness has been implemented for the
-! temporal treatment of these diffusion terms.
-! The vertical boundary conditions are as follows:
-! * at the bottom, the surface fluxes are prescribed at the same
-! as the other turbulent fluxes
-! * at the top, the turbulent fluxes are set to 0.
-! It should be noted that the condensation has been implicitely included
-! in this turbulence scheme by using conservative variables and computing
-! the subgrid variance of a statistical variable s indicating the presence
-! or not of condensation in a given mesh.
-!
-!!** METHOD
-!! ------
-!! 1D type calculations are made;
-!! The vertical turbulent fluxes are computed in an off-centered
-!! implicit scheme (a Crank-Nicholson type with coefficients different
-!! than 0.5), which allows to vary the degree of implicitness of the
-!! formulation.
-!! The different prognostic variables are treated one by one.
-!! The contributions of each turbulent fluxes are cumulated into the
-!! tendency PRvarS, and into the dynamic and thermal production of
-!! TKE if necessary.
-!!
-!! In section 2 and 3, the thermodynamical fields are considered.
-!! Only the turbulent fluxes of the conservative variables
-!! (Thetal and Rnp stored in PRx(:,:,:,1)) are computed.
-!! Note that the turbulent fluxes at the vertical
-!! boundaries are given either by the soil scheme for the surface one
-!! ( at the same instant as the others fluxes) and equal to 0 at the
-!! top of the model. The thermal production is computed by vertically
-!! averaging the turbulent flux and multiply this flux at the mass point by
-!! a function ETHETA or EMOIST, which preform the transformation from the
-!! conservative variables to the virtual potential temperature.
-!!
-!! In section 4, the variance of the statistical variable
-!! s indicating presence or not of condensation, is determined in function
-!! of the turbulent moments of the conservative variables and its
-!! squarred root is stored in PSIGS. This information will be completed in
-!! the horizontal turbulence if the turbulence dimensionality is not
-!! equal to "1DIM".
-!!
-!! In section 5, the x component of the stress tensor is computed.
-!! The surface flux <u'w'> is computed from the value of the surface
-!! fluxes computed in axes linked to the orography ( i", j" , k"):
-!! i" is parallel to the surface and in the direction of the maximum
-!! slope
-!! j" is also parallel to the surface and in the normal direction of
-!! the maximum slope
-!! k" is the normal to the surface
-!! In order to prevent numerical instability, the implicit scheme has
-!! been extended to the surface flux regarding to its dependence in
-!! function of U. The dependence in function of the other components
-!! introduced by the different rotations is only explicit.
-!! The turbulent fluxes are used to compute the dynamic production of
-!! TKE. For the last TKE level ( located at PDZZ(:,:,IKB)/2 from the
-!! ground), an harmonic extrapolation from the dynamic production at
-!! PDZZ(:,:,IKB) is used to avoid an evaluation of the gradient of U
-!! in the surface layer.
-!!
-!! In section 6, the same steps are repeated but for the y direction
-!! and in section 7, a diagnostic computation of the W variance is
-!! performed.
-!!
-!! In section 8, the turbulent fluxes for the scalar variables are
-!! computed by the same way as the conservative thermodynamical variables
-!!
-!!
-!! EXTERNAL
-!! --------
-!! GX_U_M, GY_V_M, GZ_W_M : cartesian gradient operators
-!! GX_U_UW,GY_V_VW (X,Y,Z) represent the direction of the gradient
-!! _(M,U,...)_ represent the localization of the
-!! field to be derivated
-!! _(M,UW,...) represent the localization of the
-!! field derivated
-!!
-!!
-!! MXM,MXF,MYM,MYF,MZM,MZF
-!! : Shuman functions (mean operators)
-!! DXF,DYF,DZF,DZM
-!! : Shuman functions (difference operators)
-!!
-!! SUBROUTINE TRIDIAG : to compute the split implicit evolution
-!! of a variable located at a mass point
-!!
-!! SUBROUTINE TRIDIAG_WIND: to compute the split implicit evolution
-!! of a variable located at a wind point
-!!
-!! FUNCTIONs ETHETA and EMOIST :
-!! allows to compute:
-!! - the coefficients for the turbulent correlation between
-!! any variable and the virtual potential temperature, of its
-!! correlations with the conservative potential temperature and
-!! the humidity conservative variable:
-!! ------- ------- -------
-!! A' Thv' = ETHETA A' Thl' + EMOIST A' Rnp'
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CST : contains physical constants
-!!
-!! XG : gravity constant
-!!
-!! Module MODD_CTURB: contains the set of constants for
-!! the turbulence scheme
-!!
-!! XCMFS,XCMFB : cts for the momentum flux
-!! XCSHF : ct for the sensible heat flux
-!! XCHF : ct for the moisture flux
-!! XCTV,XCHV : cts for the T and moisture variances
-!!
-!! Module MODD_PARAMETERS
-!!
-!! JPVEXT_TURB : number of vertical external points
-!! JPHEXT : number of horizontal external points
-!!
-!!
-!! REFERENCE
-!! ---------
-!! Book 1 of documentation (Chapter: Turbulence)
-!!
-!! AUTHOR
-!! ------
-!! Joan Cuxart * INM and Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original August 19, 1994
-!! Modifications: February 14, 1995 (J.Cuxart and J.Stein)
-!! Doctorization and Optimization
-!! Modifications: March 21, 1995 (J.M. Carriere)
-!! Introduction of cloud water
-!! Modifications: June 14, 1995 (J.Cuxart and J. Stein)
-!! Phi3 and Psi3 at w-point + bug in the all
-!! or nothing condens.
-!! Modifications: Sept 15, 1995 (J.Cuxart and J. Stein)
-!! Change the DP computation at the ground
-!! Modifications: October 10, 1995 (J.Cuxart and J. Stein)
-!! Psi for scal var and LES tools
-!! Modifications: November 10, 1995 (J. Stein)
-!! change the surface relations
-!! Modifications: February 20, 1995 (J. Stein) optimization
-!! Modifications: May 21, 1996 (J. Stein)
-!! bug in the vertical flux of the V wind
-!! component for explicit computation
-!! Modifications: May 21, 1996 (N. wood)
-!! modify the computation of the vertical
-!! part or the surface tangential flux
-!! Modifications: May 21, 1996 (P. Jabouille)
-!! same modification in the Y direction
-!!
-!! Modifications: Sept 17, 1996 (J. Stein) change the moist case by using
-!! Pi instead of Piref + use Atheta and Amoist
-!!
-!! Modifications: Nov 24, 1997 (V. Masson) removes the DO loops
-!! Modifications: Mar 31, 1998 (V. Masson) splits the routine TURB_VER_THERMO_FLUX
-!! Modifications: Oct 18, 2000 (V. Masson) LES computations
-!! Modifications: Dec 01, 2000 (V. Masson) conservation of energy from
-!! surface flux in 1DIM case
-!! when slopes are present
-!! Nov 06, 2002 (V. Masson) LES budgets
-!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
-!! change of YCOMMENT
-!! 2012-02 (Y. Seity) add possibility to run with reversed
-!! vertical levels
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!--------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-USE MODD_CTURB
-use modd_field, only: tfielddata, TYPEREAL
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PARAMETERS
-USE MODD_CONF
-USE MODD_LES
-!
-USE MODI_GRADIENT_U
-USE MODI_GRADIENT_V
-USE MODI_GRADIENT_W
-USE MODI_GRADIENT_M
-USE MODI_SHUMAN
-USE MODI_TRIDIAG
-USE MODI_LES_MEAN_SUBGRID
-USE MODI_PRANDTL
-USE MODI_TRIDIAG_THERMO
-!
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODE_PRANDTL
-!
-USE MODI_SECOND_MNH
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-INTEGER, INTENT(IN) :: KKA !near ground array index
-INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-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.
-LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
- ! turbulent fluxes in the syncronous FM-file
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
- ! turbulence scheme
-CHARACTER(len=4), INTENT(IN) :: HTOM ! type of Third Order Moment
-REAL, INTENT(IN) :: PIMPL, PEXPL ! Coef. for temporal disc.
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ, PDXX, PDYY, PDZX, PDZY
- ! Metric coefficients
-REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW ! Director Cosinus of the
- ! normal to the ground surface
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * grid volum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state Virtual
- ! Potential Temperature
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM ! surface fluxes at time
-! ! t - deltat
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHP,PSFRP ! surface fluxes at time
-! ! t + deltat
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM
-! Vertical wind
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
-! potential temperature at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Mixing ratios
- ! at t-Delta t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! Mixing ratios
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS ! dissipative length
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PLOCPEXNM ! Lv(T)/Cp/Exnref at time t-1
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! coefficients between
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! s and Thetal and Rnp
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! normalized
-! 2nd-order flux s'r'c/2Sigma_s2 at t-1 multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PBETA ! buoyancy coefficient
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE ! sqrt(e)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTH_DZ ! d(th)/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDR_DZ ! d(rt)/dz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2TH3 ! 3D Redeslperger number R*2_th
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2R3 ! 3D Redeslperger number R*2_r
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2THR3 ! 3D Redeslperger number R*2_thr
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E ! beta * Lk * Leps / tke
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA ! Coefficient for theta in theta_v computation
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST ! Coefficient for r in theta_v computation
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1 ! 1D Redelsperger number for Th
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1 ! 1D Redelsperger number for r
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3 ! Prandtl number for temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3 ! Prandtl number for vapor
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PD ! Denominator in Prandtl numbers
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWTH ! d(w'2th' )/dz (at flux point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFWR ! d(w'2r' )/dz (at flux point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTH2 ! d(w'th'2 )/dz (at mass point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFR2 ! d(w'r'2 )/dz (at mass point)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFTHR ! d(w'th'r')/dz (at mass point)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLP ! guess of thl at t+ deltat
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRP ! guess of r at t+ deltat
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS ! Vert. part of Sigma_s at t
-!
-!
-!
-!* 0.2 declaration of local variables
-!
-!
-REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
- ZA, & ! work variable for wrc
- ZFLXZ, & ! vertical flux of the treated variable
- ZSOURCE, & ! source of evolution for the treated variable
- ZKEFF, & ! effectif diffusion coeff = LT * SQRT( TKE )
- ZF, & ! Flux in dTh/dt =-dF/dz (evaluated at t-1)(or rt instead of Th)
- ZDFDDTDZ, & ! dF/d(dTh/dz)
- ZDFDDRDZ, & ! dF/d(dr/dz)
- Z3RDMOMENT ! 3 order term in flux or variance equation
-INTEGER :: IKB,IKE ! I index values for the Beginning and End
- ! mass points of the domain in the 3 direct.
-INTEGER :: I1,I2 ! For ZCOEFF allocation
-REAL, DIMENSION(:,:,:),ALLOCATABLE :: ZCOEFF
- ! coefficients for the uncentred gradient
- ! computation near the ground
-!
-REAL :: ZTIME1, ZTIME2
-!
-LOGICAL :: GUSERV ! flag to use water
-LOGICAL :: GFTH2 ! flag to use w'th'2
-LOGICAL :: GFWTH ! flag to use w'2th'
-LOGICAL :: GFR2 ! flag to use w'r'2
-LOGICAL :: GFWR ! flag to use w'2r'
-LOGICAL :: GFTHR ! flag to use w'th'r'
-TYPE(TFIELDDATA) :: TZFIELD
-!----------------------------------------------------------------------------
-!
-!* 1. PRELIMINARIES
-! -------------
-!
-IKB=KKA+JPVEXT_TURB*KKL
-IKE=KKU-JPVEXT_TURB*KKL
-I1=MIN(KKA+JPVEXT_TURB*KKL,KKA+JPVEXT_TURB*KKL+2*KKL)
-I2=MAX(KKA+JPVEXT_TURB*KKL,KKA+JPVEXT_TURB*KKL+2*KKL)
-
-ALLOCATE(ZCOEFF(SIZE(PDZZ,1),SIZE(PDZZ,2),I1:I2))
-!
-GUSERV = (KRR/=0)
-!
-! compute the coefficients for the uncentred gradient computation near the
-! ground
-ZCOEFF(:,:,IKB+2*KKL)= - PDZZ(:,:,IKB+KKL) / &
- ( (PDZZ(:,:,IKB+2*KKL)+PDZZ(:,:,IKB+KKL)) * PDZZ(:,:,IKB+2*KKL) )
-ZCOEFF(:,:,IKB+KKL)= (PDZZ(:,:,IKB+2*KKL)+PDZZ(:,:,IKB+KKL)) / &
- ( PDZZ(:,:,IKB+KKL) * PDZZ(:,:,IKB+2*KKL) )
-ZCOEFF(:,:,IKB)= - (PDZZ(:,:,IKB+2*KKL)+2.*PDZZ(:,:,IKB+KKL)) / &
- ( (PDZZ(:,:,IKB+2*KKL)+PDZZ(:,:,IKB+KKL)) * PDZZ(:,:,IKB+KKL) )
-!
-ZKEFF(:,:,:) = MZM( PLM(:,:,:) * SQRT(PTKEM(:,:,:)) )
-!
-! Flags for 3rd order quantities
-!
-GFTH2 = .FALSE.
-GFR2 = .FALSE.
-GFTHR = .FALSE.
-GFWTH = .FALSE.
-GFWR = .FALSE.
-!
-IF (HTOM/='NONE') THEN
- GFTH2 = ANY(PFTH2/=0.)
- GFR2 = ANY(PFR2 /=0.) .AND. GUSERV
- GFTHR = ANY(PFTHR/=0.) .AND. GUSERV
- GFWTH = ANY(PFWTH/=0.)
- GFWR = ANY(PFWR /=0.) .AND. GUSERV
-END IF
-!----------------------------------------------------------------------------
-!
-!
-!* 4. TURBULENT CORRELATIONS : <THl THl>, <THl Rnp>, <Rnp Rnp>
-! --------------------------------------------------------
-!
-!
-!* 4.2 <THl THl>
-!
-! Compute the turbulent variance F and F' at time t-dt.
- ZF (:,:,:) = XCTV*PLM*PLEPS*MZF(PPHI3*PDTH_DZ**2)
- ZDFDDTDZ(:,:,:) = 0. ! this term, because of discretization, is treated separately
- !
- ! Effect of 3rd order terms in temperature flux (at mass point)
- !
- ! d(w'th'2)/dz
- IF (GFTH2) THEN
- ZF = ZF + M3_TH2_WTH2(PREDTH1,PREDR1,PD,PLEPS,&
- & PSQRT_TKE) * PFTH2
- ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_WTH2_O_DDTDZ(PREDTH1,PREDR1,&
- & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA) * PFTH2
- END IF
- !
- ! d(w'2th')/dz
- IF (GFWTH) THEN
- ZF = ZF + M3_TH2_W2TH(PREDTH1,PREDR1,PD,PDTH_DZ,&
- & PLM,PLEPS,PTKEM) * MZF(PFWTH)
- ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_W2TH_O_DDTDZ(PREDTH1,PREDR1,PD,&
- & PLM,PLEPS,PTKEM,GUSERV) * MZF(PFWTH)
- END IF
- !
- IF (KRR/=0) THEN
- ! d(w'r'2)/dz
- IF (GFR2) THEN
- ZF = ZF + M3_TH2_WR2(PD,PLEPS,PSQRT_TKE,PBLL_O_E,&
- & PEMOIST,PDTH_DZ) * PFR2
- ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_WR2_O_DDTDZ(PREDTH1,PREDR1,PD,&
- & PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTH_DZ) * PFR2
- END IF
- !
- ! d(w'2r')/dz
- IF (GFWR) THEN
- ZF = ZF + M3_TH2_W2R(PD,PLM,PLEPS,PTKEM,PBLL_O_E,&
- & PEMOIST,PDTH_DZ) * MZF(PFWR)
- ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_W2R_O_DDTDZ(PREDTH1,PREDR1,PD,&
- & PLM,PLEPS,PTKEM,PBLL_O_E,PEMOIST,PDTH_DZ) * MZF(PFWR)
- END IF
- !
- ! d(w'th'r')/dz
- IF (GFTHR) THEN
- ZF = ZF + M3_TH2_WTHR(PREDR1,PD,PLEPS,PSQRT_TKE,&
- & PBLL_O_E,PEMOIST,PDTH_DZ) * PFTHR
- ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_WTHR_O_DDTDZ(PREDTH1,PREDR1,&
- & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTH_DZ) * PFTHR
- END IF
-
- END IF
- !
- ZFLXZ(:,:,:) = ZF &
- ! + PIMPL * XCTV*PLM*PLEPS &
- ! *MZF(D_PHI3DTDZ2_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,PDTH_DZ,HTURBDIM,GUSERV) &
- ! *DZM(PTHLP - PTHLM) / PDZZ ) &
- + PIMPL * ZDFDDTDZ * MZF(DZM(PTHLP - PTHLM) / PDZZ )
- !
- ! special case near the ground ( uncentred gradient )
- ZFLXZ(:,:,IKB) = XCTV * PPHI3(:,:,IKB+KKL) * PLM(:,:,IKB) &
- * PLEPS(:,:,IKB) &
- *( PEXPL * &
- ( ZCOEFF(:,:,IKB+2*KKL)*PTHLM(:,:,IKB+2*KKL) &
- +ZCOEFF(:,:,IKB+KKL )*PTHLM(:,:,IKB+KKL ) &
- +ZCOEFF(:,:,IKB )*PTHLM(:,:,IKB ) )**2 &
- +PIMPL * &
- ( ZCOEFF(:,:,IKB+2*KKL)*PTHLP(:,:,IKB+2*KKL) &
- +ZCOEFF(:,:,IKB+KKL )*PTHLP(:,:,IKB+KKL ) &
- +ZCOEFF(:,:,IKB )*PTHLP(:,:,IKB ) )**2 &
- )
- !
- ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
- !
- ZFLXZ = MAX(0., ZFLXZ)
- !
- IF (KRRL > 0) THEN
- PSIGS(:,:,:) = ZFLXZ(:,:,:) * PATHETA(:,:,:)**2
- END IF
- !
- !
- ! stores <THl THl>
- IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
- TZFIELD%CMNHNAME = 'THL_VVAR'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'THL_VVAR'
- TZFIELD%CUNITS = 'K2'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_Z_THL_VVAR'
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
- END IF
-!
-! and we store in LES configuration
-!
- IF (LLES_CALL) THEN
- CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( ZFLXZ, X_LES_SUBGRID_Thl2 )
- CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLXZ, X_LES_RES_W_SBG_Thl2 )
- CALL LES_MEAN_SUBGRID( -2.*XCTD*PSQRT_TKE*ZFLXZ/PLEPS, X_LES_SUBGRID_DISS_Thl2 )
- CALL LES_MEAN_SUBGRID( PETHETA*ZFLXZ, X_LES_SUBGRID_ThlThv )
- CALL LES_MEAN_SUBGRID( -XA3*PBETA*PETHETA*ZFLXZ, X_LES_SUBGRID_ThlPz, .TRUE. )
- CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
- END IF
-!
- IF ( KRR /= 0 ) THEN
-!
-!* 4.3 <THl Rnp>
-!
-!
- ! Compute the turbulent variance F and F' at time t-dt.
- ZF (:,:,:) = XCTV*PLM*PLEPS*MZF(0.5*(PPHI3+PPSI3)*PDTH_DZ*PDR_DZ)
- ZDFDDTDZ(:,:,:) = 0. ! this term, because of discretization, is treated separately
- ZDFDDRDZ(:,:,:) = 0. ! this term, because of discretization, is treated separately
- !
- ! Effect of 3rd order terms in temperature flux (at mass point)
- !
- ! d(w'th'2)/dz
- IF (GFTH2) THEN
- ZF = ZF + M3_THR_WTH2(PREDR1,PD,PLEPS,PSQRT_TKE,&
- & PBLL_O_E,PETHETA,PDR_DZ) * PFTH2
- ZDFDDTDZ = ZDFDDTDZ + D_M3_THR_WTH2_O_DDTDZ(PREDTH1,PREDR1,&
- & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ) * PFTH2
- ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_WTH2_O_DDRDZ(PREDTH1,PREDR1,&
- & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA) * PFTH2
- END IF
- !
- ! d(w'2th')/dz
- IF (GFWTH) THEN
- ZF = ZF + M3_THR_W2TH(PREDR1,PD,PLM,PLEPS,PTKEM,&
- & PDR_DZ) * MZF(PFWTH)
- ZDFDDTDZ = ZDFDDTDZ + D_M3_THR_W2TH_O_DDTDZ(PREDTH1,PREDR1,&
- & PD,PLM,PLEPS,PTKEM,PBLL_O_E,PDR_DZ,PETHETA) * MZF(PFWTH)
- ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_W2TH_O_DDRDZ(PREDTH1,PREDR1,&
- & PD,PLM,PLEPS,PTKEM) * MZF(PFWTH)
- END IF
- !
- ! d(w'r'2)/dz
- IF (GFR2) THEN
- ZF = ZF + M3_THR_WR2(PREDTH1,PD,PLEPS,PSQRT_TKE,&
- & PBLL_O_E,PEMOIST,PDTH_DZ) * PFR2
- ZDFDDTDZ = ZDFDDTDZ + D_M3_THR_WR2_O_DDTDZ(PREDR1,PREDTH1,PD,&
- & PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST) * PFR2
- ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_WR2_O_DDRDZ(PREDR1,PREDTH1,PD,&
- & PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTH_DZ) * PFR2
- END IF
- !
- ! d(w'2r')/dz
- IF (GFWR) THEN
- ZF = ZF + M3_THR_W2R(PREDTH1,PD,PLM,PLEPS,PTKEM,&
- & PDTH_DZ) * MZF(PFWR)
- ZDFDDTDZ = ZDFDDTDZ + D_M3_THR_W2R_O_DDTDZ(PREDR1,PREDTH1,PD,&
- & PLM,PLEPS,PTKEM) * MZF(PFWR)
- ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_W2R_O_DDRDZ(PREDR1,PREDTH1,PD,&
- & PLM,PLEPS,PTKEM,PBLL_O_E,PDTH_DZ,PEMOIST) * MZF(PFWR)
- END IF
- !
- ! d(w'th'r')/dz
- IF (GFTHR) THEN
- ZF = ZF + M3_THR_WTHR(PREDTH1,PREDR1,PD,PLEPS,&
- & PSQRT_TKE) * PFTHR
- ZDFDDTDZ = ZDFDDTDZ + D_M3_THR_WTHR_O_DDTDZ(PREDTH1,PREDR1,&
- & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA) * PFTHR
- ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_WTHR_O_DDRDZ(PREDR1,PREDTH1,&
- & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST) * PFTHR
- END IF
- !
- ZFLXZ(:,:,:) = ZF &
- + PIMPL * XCTV*PLM*PLEPS*0.5 &
- * MZF( ( D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,GUSERV) & ! d(phi3*dthdz)/ddthdz term
- +D_PSI3DTDZ_O_DDTDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,GUSERV) & ! d(psi3*dthdz)/ddthdz term
- ) *PDR_DZ *DZM(PTHLP - PTHLM ) / PDZZ &
- +( D_PHI3DRDZ_O_DDRDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,GUSERV) & ! d(phi3*drdz )/ddrdz term
- +D_PSI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,GUSERV) & ! d(psi3*drdz )/ddrdz term
- ) *PDTH_DZ *DZM(PRP - PRM(:,:,:,1)) / PDZZ &
- ) &
- + PIMPL * ZDFDDTDZ * MZF(DZM(PTHLP - PTHLM(:,:,:)) / PDZZ ) &
- + PIMPL * ZDFDDRDZ * MZF(DZM(PRP - PRM(:,:,:,1)) / PDZZ )
- !
- ! special case near the ground ( uncentred gradient )
- ZFLXZ(:,:,IKB) = &
- (XCHT1 * PPHI3(:,:,IKB+KKL) + XCHT2 * PPSI3(:,:,IKB+KKL)) &
- *( PEXPL * &
- ( ZCOEFF(:,:,IKB+2*KKL)*PTHLM(:,:,IKB+2*KKL) &
- +ZCOEFF(:,:,IKB+KKL )*PTHLM(:,:,IKB+KKL ) &
- +ZCOEFF(:,:,IKB )*PTHLM(:,:,IKB )) &
- *( ZCOEFF(:,:,IKB+2*KKL)*PRM(:,:,IKB+2*KKL,1) &
- +ZCOEFF(:,:,IKB+KKL )*PRM(:,:,IKB+KKL,1 ) &
- +ZCOEFF(:,:,IKB )*PRM(:,:,IKB ,1 )) &
- +PIMPL * &
- ( ZCOEFF(:,:,IKB+2*KKL)*PTHLP(:,:,IKB+2*KKL) &
- +ZCOEFF(:,:,IKB+KKL )*PTHLP(:,:,IKB+KKL ) &
- +ZCOEFF(:,:,IKB )*PTHLP(:,:,IKB )) &
- *( ZCOEFF(:,:,IKB+2*KKL)*PRP(:,:,IKB+2*KKL ) &
- +ZCOEFF(:,:,IKB+KKL )*PRP(:,:,IKB+KKL ) &
- +ZCOEFF(:,:,IKB )*PRP(:,:,IKB )) &
- )
- !
- ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
- !
- IF ( KRRL > 0 ) THEN
- PSIGS(:,:,:) = PSIGS(:,:,:) + &
- 2. * PATHETA(:,:,:) * PAMOIST(:,:,:) * ZFLXZ(:,:,:)
- END IF
- ! stores <THl Rnp>
- IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
- TZFIELD%CMNHNAME = 'THLRCONS_VCOR'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'THLRCONS_VCOR'
- TZFIELD%CUNITS = 'K kg kg-1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_Z_THLRCONS_VCOR'
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
- END IF
-!
-! and we store in LES configuration
-!
- IF (LLES_CALL) THEN
- CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( ZFLXZ, X_LES_SUBGRID_THlRt )
- CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLXZ, X_LES_RES_W_SBG_ThlRt )
- CALL LES_MEAN_SUBGRID( -2.*XCTD*PSQRT_TKE*ZFLXZ/PLEPS, X_LES_SUBGRID_DISS_ThlRt )
- CALL LES_MEAN_SUBGRID( PETHETA*ZFLXZ, X_LES_SUBGRID_RtThv )
- CALL LES_MEAN_SUBGRID( -XA3*PBETA*PETHETA*ZFLXZ, X_LES_SUBGRID_RtPz, .TRUE. )
- CALL LES_MEAN_SUBGRID( PEMOIST*ZFLXZ, X_LES_SUBGRID_ThlThv , .TRUE. )
- CALL LES_MEAN_SUBGRID( -XA3*PBETA*PEMOIST*ZFLXZ, X_LES_SUBGRID_ThlPz, .TRUE. )
- CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
- END IF
-!
-!
-!* 4.4 <Rnp Rnp>
-!
-!
- ! Compute the turbulent variance F and F' at time t-dt.
- ZF (:,:,:) = XCTV*PLM*PLEPS*MZF(PPSI3*PDR_DZ**2)
- ZDFDDRDZ(:,:,:) = 0. ! this term, because of discretization, is treated separately
- !
- ! Effect of 3rd order terms in temperature flux (at mass point)
- !
- ! d(w'r'2)/dz
- IF (GFR2) THEN
- ZF = ZF + M3_R2_WR2(PREDR1,PREDTH1,PD,PLEPS,&
- & PSQRT_TKE) * PFR2
- ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_WR2_O_DDRDZ(PREDR1,PREDTH1,&
- & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST) * PFR2
- END IF
- !
- ! d(w'2r')/dz
- IF (GFWR) THEN
- ZF = ZF + M3_R2_W2R(PREDR1,PREDTH1,PD,PDR_DZ,&
- & PLM,PLEPS,PTKEM) * MZF(PFWR)
- ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_W2R_O_DDRDZ(PREDR1,PREDTH1,&
- & PD,PLM,PLEPS,PTKEM,GUSERV) * MZF(PFWR)
- END IF
- !
- IF (KRR/=0) THEN
- ! d(w'r'2)/dz
- IF (GFTH2) THEN
- ZF = ZF + M3_R2_WTH2(PD,PLEPS,PSQRT_TKE,&
- & PBLL_O_E,PETHETA,PDR_DZ) * PFTH2
- ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_WTH2_O_DDRDZ(PREDR1,&
- & PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ) * PFTH2
- END IF
- !
- ! d(w'2r')/dz
- IF (GFWTH) THEN
- ZF = ZF + M3_R2_W2TH(PD,PLM,PLEPS,PTKEM,&
- & PBLL_O_E,PETHETA,PDR_DZ) * MZF(PFWTH)
- ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_W2TH_O_DDRDZ(PREDR1,PREDTH1,&
- & PD,PLM,PLEPS,PTKEM,PBLL_O_E,PETHETA,PDR_DZ) * MZF(PFWTH)
- END IF
- !
- ! d(w'th'r')/dz
- IF (GFTHR) THEN
- ZF = ZF + M3_R2_WTHR(PREDTH1,PD,PLEPS,&
- & PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ) * PFTHR
- ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_WTHR_O_DDRDZ(PREDR1,PREDTH1,&
- & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ) * PFTHR
- END IF
-
- END IF
- !
- ZFLXZ(:,:,:) = ZF &
- + PIMPL * XCTV*PLM*PLEPS &
- *MZF(D_PSI3DRDZ2_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDR_DZ,HTURBDIM,GUSERV) &
- *DZM(PRP - PRM(:,:,:,1)) / PDZZ ) &
- + PIMPL * ZDFDDRDZ * MZF(DZM(PRP - PRM(:,:,:,1)) / PDZZ )
- !
- ! special case near the ground ( uncentred gradient )
- ZFLXZ(:,:,IKB) = XCHV * PPSI3(:,:,IKB+KKL) * PLM(:,:,IKB) &
- * PLEPS(:,:,IKB) &
- *( PEXPL * &
- ( ZCOEFF(:,:,IKB+2*KKL)*PRM(:,:,IKB+2*KKL,1) &
- +ZCOEFF(:,:,IKB+KKL )*PRM(:,:,IKB+KKL,1 ) &
- +ZCOEFF(:,:,IKB )*PRM(:,:,IKB ,1 ))**2 &
- +PIMPL * &
- ( ZCOEFF(:,:,IKB+2*KKL)*PRP(:,:,IKB+2*KKL) &
- +ZCOEFF(:,:,IKB+KKL )*PRP(:,:,IKB+KKL ) &
- +ZCOEFF(:,:,IKB )*PRP(:,:,IKB ))**2 &
- )
- !
- ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
- !
- IF ( KRRL > 0 ) THEN
- PSIGS(:,:,:) = PSIGS(:,:,:) + PAMOIST(:,:,:) **2 * ZFLXZ(:,:,:)
- END IF
- ! stores <Rnp Rnp>
- IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
- TZFIELD%CMNHNAME = 'RTOT_VVAR'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'RTOT_VVAR'
- TZFIELD%CUNITS = 'kg2 kg-2'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_Z_RTOT_VVAR'
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZFLXZ)
- END IF
- !
- ! and we store in LES configuration
- !
- IF (LLES_CALL) THEN
- CALL SECOND_MNH(ZTIME1)
- CALL LES_MEAN_SUBGRID( ZFLXZ, X_LES_SUBGRID_Rt2 )
- CALL LES_MEAN_SUBGRID( MZF(PWM)*ZFLXZ, X_LES_RES_W_SBG_Rt2 )
- CALL LES_MEAN_SUBGRID( PEMOIST*ZFLXZ, X_LES_SUBGRID_RtThv , .TRUE. )
- CALL LES_MEAN_SUBGRID( -XA3*PBETA*PEMOIST*ZFLXZ, X_LES_SUBGRID_RtPz, .TRUE. )
- CALL LES_MEAN_SUBGRID( -2.*XCTD*PSQRT_TKE*ZFLXZ/PLEPS, X_LES_SUBGRID_DISS_Rt2 )
- CALL SECOND_MNH(ZTIME2)
- XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
- END IF
- !
- END IF ! end if KRR ne 0
-!
-!
-! 4.5 Vertical part of Sigma_s
-!
- IF ( KRRL > 0 ) THEN
- ! Extrapolate PSIGS at the ground and at the top
- PSIGS(:,:,KKA) = PSIGS(:,:,IKB)
- PSIGS(:,:,KKU) = PSIGS(:,:,IKE)
- PSIGS(:,:,:) = SQRT( MAX (PSIGS(:,:,:) , 1.E-12) )
- END IF
-
-!
-! 4.6 Deallocate
-!
- DEALLOCATE(ZCOEFF)
-!----------------------------------------------------------------------------
-END SUBROUTINE TURB_VER_THERMO_CORR